[SCM] snd/master: New upstream version 17.5
umlaeute at users.alioth.debian.org
umlaeute at users.alioth.debian.org
Wed Aug 16 19:53:17 UTC 2017
The following commit has been merged in the master branch:
commit 5a088b89e9cce5dce3daf2aca5e8c2ed3dd59fff
Author: IOhannes m zmölnig <zmoelnig at umlautQ.umlaeute.mur.at>
Date: Wed Aug 16 20:26:21 2017 +0200
New upstream version 17.5
diff --git a/HISTORY.Snd b/HISTORY.Snd
index 8b4d5bb..0212ed4 100644
--- a/HISTORY.Snd
+++ b/HISTORY.Snd
@@ -1,5 +1,9 @@
Snd change log
+ 16-Jun: Snd 17.5.
+ 6-May: Snd 17.4. New clm optimizer.
+ 28-Mar: Snd 17.3.
+ 22-Feb: Snd 17.2.
16-Jan: Snd 17.1.
2017 ----------------------------------------------------------------
diff --git a/NEWS b/NEWS
index 23979ac..364c170 100644
--- a/NEWS
+++ b/NEWS
@@ -1,14 +1,11 @@
-Snd 17.1:
+Snd 17.5:
-*rootlet-redefinition-hook*
-{apply_values} -> apply-values, {list} -> list-values, {append} -> append
-a case clause without a result returns the selector
-(*s7* 'autoloading) to turn the autoloader on and off
-sandbox in stuff.scm for protected evaluation
+s7: s7_history and s7_add_to_history (Kjetil's suggestion).
+ (*s7* 'history) for non-error scheme-side access to the history info
+ lambda* keyword argument handling changed slightly.
+ multithread sanity-checks thanks to Kjetil.
+ Kjetil also ported s7 to mingw.
-in clm: clm.asd updated by Tito Latini.
-
-checked: gsl 2.2.1, gtk 3.89.2, sbcl 1.13.3, FreeBSD 11.0
-
-Thanks!: Tito Latini, Kjetil Matheussen, Juan Cerillo, Mike Scholz.
+checked: gtk 3.91.0, sbcl 1.3.18, FC 26 (gcc 7.1.1)
+Thanks!: Kjetil Matheussen, Rick Taube
diff --git a/README.Snd b/README.Snd
index 487bbff..b3bbe7f 100644
--- a/README.Snd
+++ b/README.Snd
@@ -30,8 +30,9 @@ The configure script has a bunch of arguments:
mv ruby.pc /usr/local/lib/pkgconfig/ruby.pc
You may also have to set PKG_CONFIG_PATH:
PKG_CONFIG_PATH=.:/opt/X11/lib/pkgconfig/ ./configure --with-gtk --with-ruby --with-portaudio
+ (Debian: ruby-dev)
- --with-forth use Forth (Mike Scholz's FTH) as the extension language.
+ --with-forth use Forth (Mike Scholz's FTH) as the extension language. (libfth or fth at sourceforge)
--without-extension-language build Snd without any extension language
@@ -45,17 +46,17 @@ The configure script has a bunch of arguments:
in *BSD, pkg install open-motif, or perhaps use pkgin?
in Debian, apt-get install libmotif4, libmotif-dev, libxt-dev, libxpm-dev
- --with-gtk use Gtk+
+ --with-gtk use Gtk+ (Debian package libgtk-3-dev).
--with-gui make Snd with graphics support (actually intended for use as --without-gui)
- --with-gl include support for OpenGL (default: no, Motif only)
+ --with-gl include support for OpenGL (default: no, Motif only) (debian: libgl-dev libglu-dev)
--with-gl2ps include gl2ps (postscript output from OpenGL graphics)
Audio:
- --with-alsa use ALSA if possible (the default in Linux)
+ --with-alsa use ALSA if possible (the default in Linux) (Debian: libasound2-dev)
--with-oss use OSS (not tested in a long time)
@@ -70,8 +71,10 @@ The configure script has a bunch of arguments:
Other options:
--with-gmp use gmp, mpfr, and mpc to implement multiprecision arithmetic
+ (Debian: libgmp-dev libmpfr-dev libmpc-dev)
--with-ladspa include LADSPA plugin support (default: yes in Linux)
+ (get ladaps.h and put it in /usr/local/include or some such directory)
--with-temp-dir directory to use for temp files (default: ".")
--with-save-dir directory to use for saved-state files (default: ".")
@@ -383,6 +386,10 @@ tab on /Applications, adapt the Path by adding Object and typing /usr/local/bin/
Create your shortcut in XQuartz so it will start immediately by typing Command-s
+Later this update:
+./configure CFLAGS="-arch x86_64 -I/opt/X11/include" LDFLAGS="-L/opt/X11/lib -lmx -bind_at_load" --with-motif
+
+
---- old, possibly out-of-date instructions
You can use either Motif or Gtk running under X11; to start Snd from an
@@ -606,10 +613,10 @@ There is also a port in /usr/ports/audio/snd with version 13.0 from August
-------- Debian --------
-The last time I installed Debian (via netinstall) I installed the following
+The last time I installed Debian (25-Jan-17) I installed the following
Snd-related packages by hand:
- libgmp-dev fftw-dev libgtk-3-dev libmpfr-dev libmpc-dev
- libgsl0-dev libasound2-dev libgl1-mesa-dev
+ libfftw3-3 libgsl2 libgtk-3-dev libmotif-dev libxpm-dev libxt-dev libmpfr-dev libmpc-dev
+ libgsl-dev libfftw3-dev libgl-dev libglu-dev libutf8proc-dev libjack-dev ruby-dev libasound2-dev
and for Fedora Core 22:
diff --git a/_sndlib.h b/_sndlib.h
index 3edb47c..6c215e1 100644
--- a/_sndlib.h
+++ b/_sndlib.h
@@ -21,6 +21,29 @@
#define is_power_of_2(x) ((((x) - 1) & (x)) == 0)
+#if 0
+#define clear_floats(Arr, Len) memset((void *)(Arr), 0, (Len) * sizeof(mus_float_t))
+#define copy_floats(Dst, Src, Len) memcpy((void *)(Dst), (void *)(Src), (Len) * sizeof(mus_float_t))
+#else
+#define clear_floats(Arr, Len) \
+ do { \
+ mus_long_t K; \
+ mus_float_t *dst; \
+ dst = Arr; \
+ for (K = Len; K > 0; K--) \
+ *dst++ = 0.0; \
+ } while (0)
+#define copy_floats(Dst, Src, Len) \
+ do { \
+ mus_long_t K; \
+ mus_float_t *dst, *src; \
+ dst = Dst; \
+ src = Src; \
+ for (K = Len; K > 0; K--) \
+ *dst++ = *src++; \
+ } while (0)
+#endif
+
#define MUS_MAX_MALLOC_DEFAULT (1 << 26)
#define MUS_MAX_TABLE_SIZE_DEFAULT (1024 * 1024 * 20) /* delay line allocation etc */
@@ -86,6 +109,7 @@
#define MUS_JACK_API 2
#define G7XX 0
+#define MUS_MAX_CHANS 256
#include "sndlib.h"
#include "xen.h"
diff --git a/analog-filter.scm b/analog-filter.scm
index 64a466c..d507e56 100644
--- a/analog-filter.scm
+++ b/analog-filter.scm
@@ -376,9 +376,10 @@ fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandstop 8 .1 .4 9
((= i n))
(do ((step (/ (- xmax xmin) (- n 1.0)))
(j 0 (+ j 1))
- (s xmin (+ s step)))
+ (s xmin))
((= j (- n 1)))
- (float-vector-set! x j s))
+ (float-vector-set! x j s)
+ (set! s (+ s step)))
(set! (x (- n 1)) xmax)
(do ((j 0 (+ j 1)))
((= j n))
diff --git a/animals.scm b/animals.scm
index 1c2f42d..63173f5 100644
--- a/animals.scm
+++ b/animals.scm
@@ -688,7 +688,7 @@
(do ((k 0 (+ k 1)))
((= k pulse-out))
- (set! (rk k) (rk!cos gen1 (env pulse-frqf))))
+ (float-vector-set! rk k (rk!cos gen1 (env pulse-frqf))))
(do ((k i (+ k 1)))
((= k reset-stop))
@@ -1347,7 +1347,7 @@
(outa n (* pulse-amp
(env pulse-ampf)
(+ (* (env low-ampf)
- (polywave gp (ina k saved-frq)))
+ (polywave gp (float-vector-ref saved-frq k)))
(polywave gen1 (env frqf))))))
(mus-reset pulse-ampf)
(set! (mus-location ampf) (- i attack-stop))
diff --git a/bess1.scm b/bess1.scm
index f4f2ddd..20991d7 100644
--- a/bess1.scm
+++ b/bess1.scm
@@ -27,7 +27,7 @@
(with-let *motif*
-(set! *clm-srate* 22050)
+;(set! *clm-srate* 22050)
(define *clm-sample-type* mus-lfloat)
(define *clm-rt-bufsize* 1024)
diff --git a/bird.scm b/bird.scm
index 8fe061c..c8d15b7 100644
--- a/bird.scm
+++ b/bird.scm
@@ -42,14 +42,14 @@
(define bird-amp '(0.0 0.0 .25 1.0 .75 1.0 1.0 .0))
(define b-orchard-oriole
- (let ((documentation "(orchard-oriole beg) produces an orchard oriole call at time 'beg'"))
+ (let ((documentation "(orchard-oriole beg) produces an orchard oriole call at time 'beg'")
+ (oriup '(0.0 0.0 1.0 1.0))
+ (oridwn '(0.0 1.0 1.0 .0))
+ (oriupdwna '(0.0 0.0 .60 1.0 1.0 .60))
+ (oriupdwnb '(0.0 .50 .30 1.0 1.0 .0))
+ (oriamp '(0.0 0.0 .10 1.0 1.0 .0)))
(lambda (beg)
- (let ((oriup '(0.0 0.0 1.0 1.0))
- (oridwn '(0.0 1.0 1.0 .0))
- (oriupdwna '(0.0 0.0 .60 1.0 1.0 .60))
- (oriupdwnb '(0.0 .50 .30 1.0 1.0 .0))
- (oriamp '(0.0 0.0 .10 1.0 1.0 .0)))
- (set! beg (- beg .38))
+ (let ((beg (- beg .38)))
(bird (+ beg .38) .03 3700 100 .05 oridwn main-amp)
(bird (+ beg .41) .05 2500 1000 .1 oriup main-amp)
(bigbird (+ beg .5) .1 2000 800 .2 oriupdwna main-amp '(1 1 2 .02 3 .05))
@@ -67,57 +67,57 @@
(bird (+ beg 2.2) .02 2200 3000 .04 oriup main-amp)
(bird (+ beg 2.28) .02 2200 3000 .04 oriup main-amp)
(bigbird (+ beg 2.4) .17 2000 1000 .2 oriupdwna oriamp '(1 1 2 .04))))))
-
+
(define b-cassins-kingbird
- (let ((documentation "(cassins-kingbird beg) produces a cassins kingbird call at time 'beg'"))
+ (let ((documentation "(cassins-kingbird beg) produces a cassins kingbird call at time 'beg'")
+ (kingfirst '(0.0 .30 .45 1.0 .90 .10 1.0 .0))
+ (kingsecond '(0.0 0.0 .02 .50 .04 0.0 .06 .55 .08 .05 .10 .60 .12 .05 .14 .65 .16 .10 .18 .70 .20 .10 .22 .75 .24 .15 .26 .80 .28 .20 .30 .85 .32 .25 .34 .90 .36 .30 .38 .95 .40 .40 .42 1.0 .44 .50 .46 1.0 .48 .45 .50 1.0 .52 .50 .54 1.0 .56 .40 .58 .95 .60 .40 .62 .90 .64 .40 .66 .85 .68 .35 .70 .80 .72 .30 .74 .75 .76 .25 .78 .70 .80 .20 .82 .65 .84 .10 .86 .60 .88 0.0 .90 .55 .92 0.0 .94 .50 .96 0.0 1.0 .40)))
(lambda (beg)
- (let ((kingfirst '(0.0 .30 .45 1.0 .90 .10 1.0 .0))
- (kingsecond '(0.0 0.0 .02 .50 .04 0.0 .06 .55 .08 .05 .10 .60 .12 .05 .14 .65 .16 .10 .18 .70 .20 .10 .22 .75 .24 .15 .26 .80 .28 .20 .30 .85 .32 .25 .34 .90 .36 .30 .38 .95 .40 .40 .42 1.0 .44 .50 .46 1.0 .48 .45 .50 1.0 .52 .50 .54 1.0 .56 .40 .58 .95 .60 .40 .62 .90 .64 .40 .66 .85 .68 .35 .70 .80 .72 .30 .74 .75 .76 .25 .78 .70 .80 .20 .82 .65 .84 .10 .86 .60 .88 0.0 .90 .55 .92 0.0 .94 .50 .96 0.0 1.0 .40)))
- (set! beg (- beg .03))
+ (let ((beg (- beg .03)))
(bigbird (+ beg .03) .04 1700 1200 .15 kingfirst main-amp '(1 1 2 .5 3 0 4 .2))
(bigbird (+ beg .12) .18 1700 900 .25 kingsecond main-amp '(1 1 2 .01 3 0 4 .1))))))
-
+
(define b-chipping-sparrow
- (let ((documentation "(chipping-sparrow beg) produces a chipping sparrow call at time 'beg'"))
+ (let ((documentation "(chipping-sparrow beg) produces a chipping sparrow call at time 'beg'")
+ (chip-up '(0.0 .80 .15 1.0 .75 .30 1.0 .0)))
(lambda (beg)
- (let ((chip-up '(0.0 .80 .15 1.0 .75 .30 1.0 .0)))
- (bird beg .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .06) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .12) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .18) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .24) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .30) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .36) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .42) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .48) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .54) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .60) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .66) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .72) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .78) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .84) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .90) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .96) .05 4000 2400 .2 chip-up main-amp)))))
+ (bird beg .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .06) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .12) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .18) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .24) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .30) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .36) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .42) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .48) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .54) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .60) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .66) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .72) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .78) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .84) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .90) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .96) .05 4000 2400 .2 chip-up main-amp))))
(define b-bobwhite
- (let ((documentation "(bobwhite beg) produces a bobwhite call at time 'beg'"))
+ (let ((documentation "(bobwhite beg) produces a bobwhite call at time 'beg'")
+ (bobup1 '(0.0 0.0 .40 1.0 1.0 1.0))
+ (bobup2 '(0.0 0.0 .65 .50 1.0 1.0)))
(lambda (beg)
- (let ((bobup1 '(0.0 0.0 .40 1.0 1.0 1.0))
- (bobup2 '(0.0 0.0 .65 .50 1.0 1.0)))
- (set! beg (- beg .4))
+ (let ((beg (- beg .4)))
(bigbird (+ beg .4) .2 1800 200 .1 bobup1 main-amp '(1 1 2 .02))
(bigbird (+ beg 1) .20 1800 1200 .2 bobup2 main-amp '(1 1 2 .02))))))
(define b-western-meadowlark
- (let ((documentation "(western-meadowlark beg) produces a western meadowlark call at time 'beg'"))
+ (let ((documentation "(western-meadowlark beg) produces a western meadowlark call at time 'beg'")
+ (down-skw '(0.0 1.0 .40 .40 1.0 .0))
+ (fas-down '(0.0 1.0 1.0 .0)))
(lambda (beg)
- (let ((down-skw '(0.0 1.0 .40 .40 1.0 .0))
- (fas-down '(0.0 1.0 1.0 .0)))
- (set! beg (- beg .8))
+ (let ((beg (- beg .8)))
(bigbird (+ beg 0.8) 0.1 2010.0 0.0 0.1 '(0.0 0.0 1.0 0.0) main-amp '(1 1 2 0.04))
(bigbird (+ beg 1.100) .15 3000.000 100.000 .110 down-skw main-amp '(1 1 2 .04))
(bigbird (+ beg 1.300) .25 2000.000 150.000 .200 down-skw main-amp '(1 1 2 .04))
@@ -145,63 +145,62 @@
(define b-black-throated-gray-warbler
- (let ((documentation "(black-throated-gray-warbler beg) produces a black throated gray warbler call at time 'beg'"))
+ (let ((documentation "(black-throated-gray-warbler beg) produces a black throated gray warbler call at time 'beg'")
+ (grayone '(0.0 .50 .02 .60 .04 .45 .06 .62 .08 .40 .10 .65 .12 .35 .14 .70 .18 .30 .20 .70 .22 .30 .24 .70 .25 .20 .30 .80 .35 .10 .40 .90 .45 0.0 .50 1.0 .55 0.0 .60 1.0 .65 0.0 .70 1.0 .75 0.0 .80 1.0 .85 0.0 .90 1.0 .95 0.0 1.0 .50))
+ (graytwo '(0.0 0.0 .01 .40 .02 0.0 .03 .40 .04 0.0 .05 .40 .06 0.0 .07 .40 .08 0.0 .09 .40 .10 0.0 .25 .80 .40 .30 .55 1.0 .70 0.0 .85 .80 1.0 .40))
+ (grayfour '(0.0 0.0 1.0 1.0)))
(lambda (beg)
- (let ((grayone '(0.0 .50 .02 .60 .04 .45 .06 .62 .08 .40 .10 .65 .12 .35 .14 .70 .18 .30 .20 .70 .22 .30 .24 .70 .25 .20 .30 .80 .35 .10 .40 .90 .45 0.0 .50 1.0 .55 0.0 .60 1.0 .65 0.0 .70 1.0 .75 0.0 .80 1.0 .85 0.0 .90 1.0 .95 0.0 1.0 .50))
- (graytwo '(0.0 0.0 .01 .40 .02 0.0 .03 .40 .04 0.0 .05 .40 .06 0.0 .07 .40 .08 0.0 .09 .40 .10 0.0 .25 .80 .40 .30 .55 1.0 .70 0.0 .85 .80 1.0 .40))
- (grayfour '(0.0 0.0 1.0 1.0)))
- (bird beg .12 3700 600 .05 grayone main-amp)
- (bird (+ beg .18) .08 3000 800 .07 graytwo main-amp)
- (bird (+ beg .28) .12 3700 600 .12 grayone main-amp)
- (bird (+ beg .44) .08 3000 800 .15 graytwo main-amp)
- (bird (+ beg .54) .12 3700 600 .20 grayone main-amp)
- (bird (+ beg .72) .08 3000 800 .25 graytwo main-amp)
- (bird (+ beg .82) .12 3700 600 .25 grayone main-amp)
- (bird (+ beg .96) .2 3000 2000 .2 '(0.0 1.0 .01 .60 .02 1.0 .03 .60 .04 1.0 .05 .60 .06 1.0 .07 .60 .08 1.0 .09 .60 .10 1.0 .11 .60 .12 1.0 .13 .60 .14 1.0 .15 .60 .16 1.0 .17 .60 .18 1.0 .19 .60 .20 1.0 .21 .55 .22 1.0 .23 .50 .24 1.0 .25 .50 .26 1.0 .27 .50 .28 1.0 .29 .50 .30 1.0 .31 .50 .32 1.0 .33 .50 .34 1.0 .35 .50 .36 1.0 .37 .50 .38 1.0 .39 .50 .40 1.0 .41 .50 .42 1.0 .43 .50 .44 1.0 .45 .50 .46 1.0 .47 .50 .48 1.0 .49 .50 .50 1.0 .51 .50 .52 1.0 .53 .50 .54 1.0 .55 .50 .56 1.0 .57 .50 .58 1.0 .59 .50 .60 1.0 1.0 .0) main-amp)
- (bird (+ beg 1.2) .02 4500 500 .05 grayfour main-amp)
- (bird (+ beg 1.25) .02 4200 800 .05 grayfour main-amp)
- (bird (+ beg 1.3) .02 4000 900 .05 grayfour main-amp)))))
+ (bird beg .12 3700 600 .05 grayone main-amp)
+ (bird (+ beg .18) .08 3000 800 .07 graytwo main-amp)
+ (bird (+ beg .28) .12 3700 600 .12 grayone main-amp)
+ (bird (+ beg .44) .08 3000 800 .15 graytwo main-amp)
+ (bird (+ beg .54) .12 3700 600 .20 grayone main-amp)
+ (bird (+ beg .72) .08 3000 800 .25 graytwo main-amp)
+ (bird (+ beg .82) .12 3700 600 .25 grayone main-amp)
+ (bird (+ beg .96) .2 3000 2000 .2 '(0.0 1.0 .01 .60 .02 1.0 .03 .60 .04 1.0 .05 .60 .06 1.0 .07 .60 .08 1.0 .09 .60 .10 1.0 .11 .60 .12 1.0 .13 .60 .14 1.0 .15 .60 .16 1.0 .17 .60 .18 1.0 .19 .60 .20 1.0 .21 .55 .22 1.0 .23 .50 .24 1.0 .25 .50 .26 1.0 .27 .50 .28 1.0 .29 .50 .30 1.0 .31 .50 .32 1.0 .33 .50 .34 1.0 .35 .50 .36 1.0 .37 .50 .38 1.0 .39 .50 .40 1.0 .41 .50 .42 1.0 .43 .50 .44 1.0 .45 .50 .46 1.0 .47 .50 .48 1.0 .49 .50 .50 1.0 .51 .50 .52 1.0 .53 .50 .54 1.0 .55 .50 .56 1.0 .57 .50 .58 1.0 .59 .50 .60 1.0 1.0 .0) main-amp)
+ (bird (+ beg 1.2) .02 4500 500 .05 grayfour main-amp)
+ (bird (+ beg 1.25) .02 4200 800 .05 grayfour main-amp)
+ (bird (+ beg 1.3) .02 4000 900 .05 grayfour main-amp))))
(define b-yellow-warbler
- (let ((documentation "(yellow-warbler beg) produces a yellow warbler call at time 'beg'"))
+ (let ((documentation "(yellow-warbler beg) produces a yellow warbler call at time 'beg'")
+ (yellow-swirl '(0.0 1.0 .05 1.0 .60 0.0 .80 .30 1.0 .10))
+ (yellow-down '(0.0 1.0 1.0 .0))
+ (swirl-amp '(0.0 0.0 .90 1.0 1.0 .0)))
(lambda (beg)
- (let ((yellow-swirl '(0.0 1.0 .05 1.0 .60 0.0 .80 .30 1.0 .10))
- (yellow-down '(0.0 1.0 1.0 .0))
- (swirl-amp '(0.0 0.0 .90 1.0 1.0 .0)))
- (bird beg 0.05 5600 400 0.05 '(0.0 0.0 0.6 1.0 1.0 0.5) main-amp)
- (bird (+ beg .23) .12 5000 1500 .15 yellow-swirl swirl-amp)
- (bird (+ beg .45) .13 5000 1700 .17 yellow-swirl swirl-amp)
- (bird (+ beg .62) .16 5000 2000 .20 yellow-swirl swirl-amp)
- (bird (+ beg .85) .15 5000 2000 .20 yellow-swirl swirl-amp)
- (bird (+ beg 1.05) .075 3700 1000 .20 yellow-down main-amp)
- (bird (+ beg 1.15) .075 3700 800 .15 yellow-down main-amp)
- (bird (+ beg 1.25) .075 3700 800 .15 yellow-down main-amp)
- (bird (+ beg 1.4) .2 3700 2000 .2 '(0.0 0.0 .30 .20 .80 .70 1.0 1.0) swirl-amp)))))
+ (bird beg 0.05 5600 400 0.05 '(0.0 0.0 0.6 1.0 1.0 0.5) main-amp)
+ (bird (+ beg .23) .12 5000 1500 .15 yellow-swirl swirl-amp)
+ (bird (+ beg .45) .13 5000 1700 .17 yellow-swirl swirl-amp)
+ (bird (+ beg .62) .16 5000 2000 .20 yellow-swirl swirl-amp)
+ (bird (+ beg .85) .15 5000 2000 .20 yellow-swirl swirl-amp)
+ (bird (+ beg 1.05) .075 3700 1000 .20 yellow-down main-amp)
+ (bird (+ beg 1.15) .075 3700 800 .15 yellow-down main-amp)
+ (bird (+ beg 1.25) .075 3700 800 .15 yellow-down main-amp)
+ (bird (+ beg 1.4) .2 3700 2000 .2 '(0.0 0.0 .30 .20 .80 .70 1.0 1.0) swirl-amp))))
(define b-black-necked-stilt
- (let ((documentation "(black-necked-stilt beg) produces a black necked stilt call at time 'beg'"))
+ (let ((documentation "(black-necked-stilt beg) produces a black necked stilt call at time 'beg'")
+ ;; have to guess about upper partials (cut off by spectrograph)
+ ;; "birds" book has piping sound coming back down whereas "songs
+ ;; of western birds" just shows it going up.
+ ;;
+ (upamp '(0.0 0.0 .90 1.0 1.0 .0))
+ (rampup '(0.0 0.0 .50 1.0 1.0 .20)))
(lambda (beg)
- (let (
- ;; have to guess about upper partials (cut off by spectrograph)
- ;; "birds" book has piping sound coming back down whereas "songs
- ;; of western birds" just shows it going up.
- ;;
- (upamp '(0.0 0.0 .90 1.0 1.0 .0))
- (rampup '(0.0 0.0 .50 1.0 1.0 .20)))
- (bigbird beg .1 900 100 .2 rampup upamp '( 1 .5 2 1 3 .75 4 .5 5 .1))
- (bigbird (+ beg .30) .1 900 200 .2 rampup upamp '( 1 .5 2 1 3 .75 4 .5 5 .1))
- (bigbird (+ beg .60) .1 900 250 .2 rampup upamp '( 1 .5 2 1 3 .75 4 .5 5 .1))))))
+ (bigbird beg .1 900 100 .2 rampup upamp '( 1 .5 2 1 3 .75 4 .5 5 .1))
+ (bigbird (+ beg .30) .1 900 200 .2 rampup upamp '( 1 .5 2 1 3 .75 4 .5 5 .1))
+ (bigbird (+ beg .60) .1 900 250 .2 rampup upamp '( 1 .5 2 1 3 .75 4 .5 5 .1)))))
(define b-chestnut-sided-warbler
- (let ((documentation "(chestnut-sided-warbler beg) produces a chestnut sided warbler call at time 'beg'"))
+ (let ((documentation "(chestnut-sided-warbler beg) produces a chestnut sided warbler call at time 'beg'")
+ (ycurve '(0.0 1.0 .30 .50 .60 1.0 .80 .20 1.0 .0))
+ (vcurve '(0.0 .20 .50 1.0 1.0 .0))
+ (louder '(0.0 0.0 .90 1.0 1.0 .0)))
(lambda (beg)
- (let ((ycurve '(0.0 1.0 .30 .50 .60 1.0 .80 .20 1.0 .0))
- (vcurve '(0.0 .20 .50 1.0 1.0 .0))
- (louder '(0.0 0.0 .90 1.0 1.0 .0)))
- (set! beg (- beg .1))
+ (let ((beg (- beg .1)))
(bigbird (+ beg .1) .1 4050 1200 .05 ycurve main-amp '(1 1 2 .1))
(bigbird (+ beg .25) .03 3900 300 .075 vcurve main-amp '(1 1 2 .1))
(bigbird (+ beg .3) .1 4050 1200 .15 ycurve louder '(1 1 2 .1))
@@ -220,59 +219,59 @@
(define b-grasshopper-sparrow
- (let ((documentation "(grasshopper-sparrow beg) produces a grasshopper sparrow call at time 'beg'"))
+ (let ((documentation "(grasshopper-sparrow beg) produces a grasshopper sparrow call at time 'beg'")
+ (grasstwo '(0.0 0.0 .10 1.0 .20 0.0 .30 1.0 .40 0.0 .50 1.0 .60 0.0 .70 1.0 .80 0.0 .90 1.0 1.0 .0)))
(lambda (beg)
- (let ((grasstwo '(0.0 0.0 .10 1.0 .20 0.0 .30 1.0 .40 0.0 .50 1.0 .60 0.0 .70 1.0 .80 0.0 .90 1.0 1.0 .0)))
- (bird beg .01 8000 100 .1 grasstwo main-amp)
- (bird (+ beg .11) .01 5700 300 .1 grasstwo main-amp)
- (bird (+ beg .43) .01 3900 100 .1 grasstwo main-amp))
- (bird (+ beg .51) 1.4 6000 2500 .2 '(0.0 .50 .02 .80 .04 .30 .06 .80 .07 .10 .08 .90 .10 0.0 .11 .90 .12 0.0 .13 .90 .14 .10 .15 1.0 .16 .10 .17 1.0 .18 .10 .19 1.0 .20 .10 .21 1.0 .22 .10 .23 1.0 .24 .10 .25 1.0 .26 .10 .27 1.0 .28 .10 .29 1.0 .30 .10 .31 1.0 .32 .10 .33 1.0 .34 .10 .35 1.0 .36 .10 .37 1.0 .38 .10 .39 1.0 .40 .10 .41 1.0 .42 .10 .43 1.0 .44 .10 .45 1.0 .46 .10 .47 1.0 .48 .10 .49 1.0 .50 .10 .51 1.0 .52 .10 .53 1.0 .54 .10 .55 1.0 .56 .10 .57 1.0 .58 .10 .59 1.0 .60 .10 .61 1.0 .62 .10 .63 1.0 .64 .10 .65 1.0 .66 .10 .67 1.0 .68 .10 .69 1.0 .70 .10 .71 1.0 .72 .10 .73 1.0 .74 .10 .75 1.0 .76 .10 .77 1.0 .78 .10 .79 1.0 .80 .10 .81 1.0 .82 .10 .83 1.0 .84 .10 .85 1.0 .86 .10 .87 1.0 .88 .10 .89 1.0 .90 .10 .91 1.0 .92 .10 .93 1.0 .94 .10 .95 1.0 .96 .10 .97 1.0 .98 .10 1.0 1.0)main-amp))))
+ (bird beg .01 8000 100 .1 grasstwo main-amp)
+ (bird (+ beg .11) .01 5700 300 .1 grasstwo main-amp)
+ (bird (+ beg .43) .01 3900 100 .1 grasstwo main-amp)
+ (bird (+ beg .51) 1.4 6000 2500 .2 '(0.0 .50 .02 .80 .04 .30 .06 .80 .07 .10 .08 .90 .10 0.0 .11 .90 .12 0.0 .13 .90 .14 .10 .15 1.0 .16 .10 .17 1.0 .18 .10 .19 1.0 .20 .10 .21 1.0 .22 .10 .23 1.0 .24 .10 .25 1.0 .26 .10 .27 1.0 .28 .10 .29 1.0 .30 .10 .31 1.0 .32 .10 .33 1.0 .34 .10 .35 1.0 .36 .10 .37 1.0 .38 .10 .39 1.0 .40 .10 .41 1.0 .42 .10 .43 1.0 .44 .10 .45 1.0 .46 .10 .47 1.0 .48 .10 .49 1.0 .50 .10 .51 1.0 .52 .10 .53 1.0 .54 .10 .55 1.0 .56 .10 .57 1.0 .58 .10 .59 1.0 .60 .10 .61 1.0 .62 .10 .63 1.0 .64 .10 .65 1.0 .66 .10 .67 1.0 .68 .10 .69 1.0 .70 .10 .71 1.0 .72 .10 .73 1.0 .74 .10 .75 1.0 .76 .10 .77 1.0 .78 .10 .79 1.0 .80 .10 .81 1.0 .82 .10 .83 1.0 .84 .10 .85 1.0 .86 .10 .87 1.0 .88 .10 .89 1.0 .90 .10 .91 1.0 .92 .10 .93 1.0 .94 .10 .95 1.0 .96 .10 .97 1.0 .98 .10 1.0 1.0) main-amp))))
(define b-swamp-sparrow
- (let ((documentation "(swamp-sparrow beg) produces a swamp sparrow call at time 'beg'"))
+ (let ((documentation "(swamp-sparrow beg) produces a swamp sparrow call at time 'beg'")
+ (swamp-up '(0.0 0.0 .60 .70 1.0 1.0))
+ (swamp-down '(0.0 1.0 .50 .50 .60 .60 1.0 .0)))
(lambda (beg)
- (let ((swamp-up '(0.0 0.0 .60 .70 1.0 1.0))
- (swamp-down '(0.0 1.0 .50 .50 .60 .60 1.0 .0)))
- (bird beg .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .035) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .08) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .1) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .135) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .18) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .2) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .235) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .28) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .3) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .335) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .38) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .4) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .435) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .48) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .5) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .535) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .58) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .6) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .635) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .68) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .7) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .735) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .78) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .8) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .835) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .88) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .9) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .935) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .98) .025 3700 0 .1 main-amp main-amp)))))
+ (bird beg .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .035) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .08) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .1) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .135) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .18) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .2) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .235) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .28) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .3) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .335) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .38) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .4) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .435) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .48) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .5) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .535) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .58) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .6) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .635) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .68) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .7) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .735) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .78) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .8) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .835) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .88) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .9) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .935) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .98) .025 3700 0 .1 main-amp main-amp))))
(define b-golden-crowned-sparrow
@@ -286,14 +285,14 @@
(define b-indigo-bunting
- (let ((documentation "(indigo-bunting beg) produces a indigo bunting call at time 'beg'"))
+ (let ((documentation "(indigo-bunting beg) produces a indigo bunting call at time 'beg'")
+ (buntdwn '(0.0 1.0 1.0 .0))
+ (buntv '(0.0 0.0 .50 1.0 1.0 .0))
+ (bunty '(0.0 1.0 .50 0.0 1.0 .90))
+ (buntn '(0.0 .80 .30 1.0 .70 .20 1.0 .0))
+ (buntup '(0.0 0.0 1.0 1.0)))
(lambda (beg)
- (let ((buntdwn '(0.0 1.0 1.0 .0))
- (buntv '(0.0 0.0 .50 1.0 1.0 .0))
- (bunty '(0.0 1.0 .50 0.0 1.0 .90))
- (buntn '(0.0 .80 .30 1.0 .70 .20 1.0 .0))
- (buntup '(0.0 0.0 1.0 1.0)))
- (set! beg (- beg .4))
+ (let ((beg (- beg .4)))
(bird (+ beg .4) .08 3000 700 .25 buntdwn main-amp)
(bird (+ beg .52) .02 6200 1000 .05 buntdwn main-amp)
(bird (+ beg .55) .15 3500 2300 .1 buntv main-amp)
@@ -316,11 +315,11 @@
(define b-hooded-warbler
- (let ((documentation "(hooded-warbler beg) produces a hooded warbler call at time 'beg'"))
+ (let ((documentation "(hooded-warbler beg) produces a hooded warbler call at time 'beg'")
+ (hoodup '(0.0 0.0 1.0 1.0))
+ (hooddown '(0.0 1.0 1.0 .0)))
(lambda (beg)
- (let ((hoodup '(0.0 0.0 1.0 1.0))
- (hooddown '(0.0 1.0 1.0 .0)))
- (set! beg (- beg .6))
+ (let ((beg (- beg .6)))
(bird (+ beg .6) .03 3900 1600 .05 hooddown main-amp)
(bird (+ beg .64) .03 3900 1700 .05 hooddown main-amp)
(bird (+ beg .8) .03 3900 2000 .10 hooddown main-amp)
@@ -351,31 +350,31 @@
(define b-american-widgeon
- (let ((documentation "(american-widgeon beg) produces an american widgeon call at time 'beg'"))
+ (let ((documentation "(american-widgeon beg) produces an american widgeon call at time 'beg'")
+ (widgeon '(0.0 0.0 .50 1.0 1.0 .0)))
(lambda (beg)
- (let ((widgeon '(0.0 0.0 .50 1.0 1.0 .0)))
- (bigbird beg .07 1900 300 .15 widgeon widgeon '(1 1 2 .02))
- (bigbird (+ beg .1) .11 1700 1400 .25 widgeon widgeon '(1 .7 2 1 3 .02))
- (bigbird (+ beg .25) .07 1900 300 .15 widgeon widgeon '(1 1 2 .02))))))
+ (bigbird beg .07 1900 300 .15 widgeon widgeon '(1 1 2 .02))
+ (bigbird (+ beg .1) .11 1700 1400 .25 widgeon widgeon '(1 .7 2 1 3 .02))
+ (bigbird (+ beg .25) .07 1900 300 .15 widgeon widgeon '(1 1 2 .02)))))
(define b-louisiana-waterthrush
- (let ((documentation "(louisiana-waterthrush beg) produces a louisiana waterthrush call at time 'beg'"))
+ (let ((documentation "(louisiana-waterthrush beg) produces a louisiana waterthrush call at time 'beg'")
+ (water-four '(0.0 0.0 1.0 1.0))
+ (water-damp '(0.0 0.0 .90 1.0 1.0 .0)))
(lambda (beg)
- (let ((water-four '(0.0 0.0 1.0 1.0))
- (water-damp '(0.0 0.0 .90 1.0 1.0 .0)))
- (let ((water-one '(0.0 .80 .35 .40 .45 .90 .50 1.0 .75 1.0 1.0 .10))
- (water-amp '(0.0 0.0 .35 1.0 .50 .20 .90 1.0 1.0 .0)))
- (bird beg .17 4100 2000 .2 water-one water-amp)
- (bird (+ beg .32) .18 4050 2050 .3 water-one water-amp)
- (bird (+ beg .64) .20 4000 1900 .25 water-one water-amp))
- (bird (+ beg .9) .2 3900 2000 .3 '(0.0 1.0 .40 0.0 .60 .10 1.0 .80) bird-tap)
- (bird (+ beg 1.25) 0.12 3000 3000 0.25 '(0.0 1.0 0.95 0.0 1.0 0.0) water-damp)
- (bird (+ beg 1.4) .1 2700 1500 .2 water-four water-damp)
- (let ((water-five '(0.0 1.0 1.0 .0)))
- (bird (+ beg 1.58) .02 5200 1000 .1 water-five main-amp)
- (bird (+ beg 1.65) .02 5200 1000 .1 water-five main-amp))
- (bird (+ beg 1.7) .035 3200 1000 .1 water-four water-damp)))))
+ (let ((water-one '(0.0 .80 .35 .40 .45 .90 .50 1.0 .75 1.0 1.0 .10))
+ (water-amp '(0.0 0.0 .35 1.0 .50 .20 .90 1.0 1.0 .0)))
+ (bird beg .17 4100 2000 .2 water-one water-amp)
+ (bird (+ beg .32) .18 4050 2050 .3 water-one water-amp)
+ (bird (+ beg .64) .20 4000 1900 .25 water-one water-amp))
+ (bird (+ beg .9) .2 3900 2000 .3 '(0.0 1.0 .40 0.0 .60 .10 1.0 .80) bird-tap)
+ (bird (+ beg 1.25) 0.12 3000 3000 0.25 '(0.0 1.0 0.95 0.0 1.0 0.0) water-damp)
+ (bird (+ beg 1.4) .1 2700 1500 .2 water-four water-damp)
+ (let ((water-five '(0.0 1.0 1.0 .0)))
+ (bird (+ beg 1.58) .02 5200 1000 .1 water-five main-amp)
+ (bird (+ beg 1.65) .02 5200 1000 .1 water-five main-amp))
+ (bird (+ beg 1.7) .035 3200 1000 .1 water-four water-damp))))
(define b-robin
@@ -399,45 +398,45 @@
(define b-pigeon-hawk
- (let ((documentation "(pigeon-hawk beg) produces a pigeon hawk (merlin) call at time 'beg'"))
+ (let ((documentation "(pigeon-hawk beg) produces a pigeon hawk (merlin) call at time 'beg'")
+ (hupdown '(0.0 0.0 .30 1.0 .70 1.0 1.0 .0)))
(lambda (beg)
- (let ((hupdown '(0.0 0.0 .30 1.0 .70 1.0 1.0 .0)))
- (bigbird beg .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg .12) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg .13) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg .25) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg .26) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg .38) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg .39) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg .51) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg .52) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg .64) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg .65) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg .77) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg .78) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg .90) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg .91) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg 1.03) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg 1.04) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg 1.16) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg 1.17) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg 1.29) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg 1.30) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg 1.42) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg 1.43) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg 1.55) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg 1.56) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg 1.68) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg 1.69) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg 1.81) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg 1.82) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))))))
+ (bigbird beg .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg .12) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg .13) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg .25) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg .26) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg .38) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg .39) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg .51) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg .52) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg .64) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg .65) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg .77) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg .78) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg .90) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg .91) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg 1.03) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg 1.04) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg 1.16) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg 1.17) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg 1.29) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg 1.30) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg 1.42) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg 1.43) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg 1.55) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg 1.56) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg 1.68) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg 1.69) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg 1.81) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg 1.82) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1)))))
(define b-cerulean-warbler
- (let ((documentation "(cerulean-warbler beg) produces a cerulean warbler call at time 'beg'"))
+ (let ((documentation "(cerulean-warbler beg) produces a cerulean warbler call at time 'beg'")
+ (w-up '(0.0 0.0 1.0 1.0)))
(lambda (beg)
- (let ((w-up '(0.0 0.0 1.0 1.0)))
- (set! beg (- beg .27))
+ (let ((beg (- beg .27)))
(let ((w-down '(0.0 1.0 1.0 .0)))
(bird (+ beg .27) .05 3000 1000 .05 w-down main-amp)
(bird (+ beg .33) .05 3000 800 .075 w-up main-amp)
@@ -484,13 +483,13 @@
(define b-nashville-warbler
- (let ((documentation "(nashville-warbler beg) produces a nashville warbler call at time 'beg'"))
+ (let ((documentation "(nashville-warbler beg) produces a nashville warbler call at time 'beg'")
+ (nash-blip '(0.0 .60 .35 1.0 1.0 .0))
+ (nash-down '(0.0 .90 .05 1.0 .10 .90 .65 .50 1.0 .0))
+ (nash-up '(0.0 0.0 .15 .20 .25 .05 .90 .95 1.0 1.0))
+ (nash-amp '(0.0 0.0 .80 1.0 1.0 .0)))
(lambda (beg)
- (let ((nash-blip '(0.0 .60 .35 1.0 1.0 .0))
- (nash-down '(0.0 .90 .05 1.0 .10 .90 .65 .50 1.0 .0))
- (nash-up '(0.0 0.0 .15 .20 .25 .05 .90 .95 1.0 1.0))
- (nash-amp '(0.0 0.0 .80 1.0 1.0 .0)))
- (set! beg (- beg .15))
+ (let ((beg (- beg .15)))
(bird (+ beg .15) .025 3900 300 .3 nash-blip main-amp)
(bird (+ beg .24) .16 4200 3800 .15 nash-down nash-amp)
(bird (+ beg .42) .025 3900 300 .3 nash-blip main-amp)
@@ -504,23 +503,23 @@
(bird (+ beg 1.57) .1 3800 2200 .1 nash-up main-amp)
(bird (+ beg 1.7) .1 3800 2150 .125 nash-up main-amp)
(bird (+ beg 1.85) .075 3900 1800 .1 nash-up nash-amp)))))
-
+
(define b-eastern-phoebe
- (let ((documentation "(eastern-phoebe beg) produces an eastern-phoebe call at time 'beg'"))
+ (let ((documentation "(eastern-phoebe beg) produces an eastern-phoebe call at time 'beg'")
+ (phoebe-amp '(0.0 0.0 .10 1.0 1.0 .0)))
(lambda (beg)
- (let ((phoebe-amp '(0.0 0.0 .10 1.0 1.0 .0)))
- (bird beg .225 3000 1300 .3 '(0.0 0.0 .30 .30 .35 .50 .55 .40 .70 .80 .75 .70 .80 1.0 .95 .90 1.0 .0) main-amp)
- (bird (+ beg .35) .12 3000 500 .1 '(0.0 0.0 .50 1.0 1.0 .0) phoebe-amp)
- (bird (+ beg .4) .10 3000 1500 .2 '(0.0 0.0 .10 .40 .80 1.0 1.0 .10) phoebe-amp)
- (bird (+ beg .55) .05 3000 1400 .2 '(0.0 1.0 .50 .70 1.0 .0) phoebe-amp)))))
+ (bird beg .225 3000 1300 .3 '(0.0 0.0 .30 .30 .35 .50 .55 .40 .70 .80 .75 .70 .80 1.0 .95 .90 1.0 .0) main-amp)
+ (bird (+ beg .35) .12 3000 500 .1 '(0.0 0.0 .50 1.0 1.0 .0) phoebe-amp)
+ (bird (+ beg .4) .10 3000 1500 .2 '(0.0 0.0 .10 .40 .80 1.0 1.0 .10) phoebe-amp)
+ (bird (+ beg .55) .05 3000 1400 .2 '(0.0 1.0 .50 .70 1.0 .0) phoebe-amp))))
(define b-painted-bunting
- (let ((documentation "(painted-bunting beg) produces a painted bunting call at time 'beg'"))
+ (let ((documentation "(painted-bunting beg) produces a painted bunting call at time 'beg'")
+ (b-one '(0.0 0.0 1.0 1.0)))
(lambda (beg)
- (let ((b-one '(0.0 0.0 1.0 1.0)))
- (set! beg (- beg .05))
+ (let ((beg (- beg .05)))
(bird (+ beg .05) .10 3100 900 .05 b-one '(0.0 0.0 .90 1.0 1.0 .0))
(bird (+ beg .21) .07 4100 700 .15 '(0.0 1.0 1.0 .0) main-amp)
(bird (+ beg .36) .12 3700 1000 .20 '(0.0 0.0 .50 1.0 1.0 .0) main-amp)
@@ -545,64 +544,64 @@
'(0.0 0.0 .10 .50 .50 .50 .90 1.0 1.0 .0))))))
(define b-western-flycatcher
- (let ((documentation "(western-flycatcher beg) produces a western flycatcher call at time 'beg'"))
+ (let ((documentation "(western-flycatcher beg) produces a western flycatcher call at time 'beg'")
+ (f-one '(0.0 0.0 .10 1.0 .20 .40 .95 .10 1.0 .0))
+ (a-one '(0.0 0.0 .10 .20 .20 .10 .30 1.0 .90 1.0 1.0 .0))
+ (f-two '(0.0 .50 .25 1.0 .50 0.0 .60 0.0 .95 .30 1.0 .60))
+ (a-two '(0.0 0.0 .10 1.0 .20 1.0 .50 .10 .60 .10 .90 1.0 1.0 .0)))
(lambda (beg)
- (let ((f-one '(0.0 0.0 .10 1.0 .20 .40 .95 .10 1.0 .0))
- (a-one '(0.0 0.0 .10 .20 .20 .10 .30 1.0 .90 1.0 1.0 .0))
- (f-two '(0.0 .50 .25 1.0 .50 0.0 .60 0.0 .95 .30 1.0 .60))
- (a-two '(0.0 0.0 .10 1.0 .20 1.0 .50 .10 .60 .10 .90 1.0 1.0 .0)))
- (bigbird beg .2 2000 2200 .2 f-one a-one '(1 1 2 .02 3 .1 4 .01))
- (bigbird (+ beg .3) .2 2000 1100 .2 f-two a-two '(1 1 2 .02 3 .1 4 .01))))))
+ (bigbird beg .2 2000 2200 .2 f-one a-one '(1 1 2 .02 3 .1 4 .01))
+ (bigbird (+ beg .3) .2 2000 1100 .2 f-two a-two '(1 1 2 .02 3 .1 4 .01)))))
(define b-bachmans-sparrow
- (let ((documentation "(bachmans-sparrow beg) produces a bachmans sparrow call at time 'beg'"))
+ (let ((documentation "(bachmans-sparrow beg) produces a bachmans sparrow call at time 'beg'")
+ (sup '(0.0 .10 .35 0.0 1.0 1.0))
+ (sdwn '(0.0 1.0 .40 .50 1.0 .0)))
(lambda (beg)
- (let ((sup '(0.0 .10 .35 0.0 1.0 1.0))
- (sdwn '(0.0 1.0 .40 .50 1.0 .0)))
- (bird beg .51 4900 200 .3 '(0.0 1.0 .10 .50 .90 .50 1.0 .0) main-amp)
- (bird (+ beg .52) .015 3800 200 .1 sup main-amp)
- (bird (+ beg .52) .015 3750 250 .1 sup main-amp)
- (bird (+ beg .54) .015 3600 300 .1 sup main-amp)
- (bird (+ beg .56) .015 3500 250 .1 sup main-amp)
- (bird (+ beg .58) .015 3400 200 .1 sup main-amp)
- (bird (+ beg .60) .015 3200 200 .1 sup main-amp)
- (bird (+ beg .62) .015 3800 100 .1 sup main-amp)
-
- (bird (+ beg .65) .07 3000 750 .2 sup main-amp)
- (bird (+ beg .73) .03 5000 1000 .1 sdwn main-amp)
- (bird (+ beg .80) .07 3000 750 .2 sup main-amp)
- (bird (+ beg .88) .03 5000 1000 .1 sdwn main-amp)
- (bird (+ beg .95) .07 3000 750 .2 sup main-amp)
- (bird (+ beg 1.03) .03 5000 1000 .1 sdwn main-amp)
- (bird (+ beg 1.10) .07 3000 750 .2 sup main-amp)
- (bird (+ beg 1.18) .03 5000 1000 .1 sdwn main-amp)
- (bird (+ beg 1.25) .07 3000 750 .2 sup main-amp)
- (bird (+ beg 1.33) .03 5000 1000 .1 sdwn main-amp)
- (bird (+ beg 1.40) .07 3000 750 .2 sup main-amp)
- (bird (+ beg 1.48) .03 5000 1000 .1 sdwn main-amp)
- (bird (+ beg 1.55) .07 3000 750 .2 sup main-amp)
- (bird (+ beg 1.63) .03 5000 1000 .1 sdwn main-amp)
-
- (let ((supn '(0.0 0.0 1.0 1.0)))
- (bird (+ beg 2.8) .06 4000 1700 .1 supn main-amp)
- (bird (+ beg 2.87) .01 5200 0 .2 supn main-amp)
- (bird (+ beg 2.9) .06 4000 1700 .1 supn main-amp)
- (bird (+ beg 2.97) .01 5200 0 .2 supn main-amp)
- (bird (+ beg 3.0) .06 4000 1700 .1 supn main-amp)
- (bird (+ beg 3.07) .01 5200 0 .2 supn main-amp)
- (bird (+ beg 3.1) .06 4000 1700 .1 supn main-amp)
- (bird (+ beg 3.17) .01 5200 0 .2 supn main-amp)
- (bird (+ beg 3.2) .06 4000 1700 .1 supn main-amp)
- (bird (+ beg 3.27) .01 5200 0 .2 supn main-amp))
-
- (let ((slast '(0.0 1.0 .25 0.0 .75 .40 1.0 .50)))
- (bird (+ beg 3.4) .15 3000 1000 .2 slast main-amp)
- (bird (+ beg 3.6) .15 3000 1000 .2 slast main-amp)
- (bird (+ beg 3.8) .15 3000 1000 .2 slast main-amp)
- (bird (+ beg 4.0) .15 3000 1000 .2 slast main-amp)
- (bird (+ beg 4.2) .15 3000 1000 .2 slast main-amp)
- (bird (+ beg 4.4) .15 3000 1000 .2 slast main-amp))))))
+ (bird beg .51 4900 200 .3 '(0.0 1.0 .10 .50 .90 .50 1.0 .0) main-amp)
+ (bird (+ beg .52) .015 3800 200 .1 sup main-amp)
+ (bird (+ beg .52) .015 3750 250 .1 sup main-amp)
+ (bird (+ beg .54) .015 3600 300 .1 sup main-amp)
+ (bird (+ beg .56) .015 3500 250 .1 sup main-amp)
+ (bird (+ beg .58) .015 3400 200 .1 sup main-amp)
+ (bird (+ beg .60) .015 3200 200 .1 sup main-amp)
+ (bird (+ beg .62) .015 3800 100 .1 sup main-amp)
+
+ (bird (+ beg .65) .07 3000 750 .2 sup main-amp)
+ (bird (+ beg .73) .03 5000 1000 .1 sdwn main-amp)
+ (bird (+ beg .80) .07 3000 750 .2 sup main-amp)
+ (bird (+ beg .88) .03 5000 1000 .1 sdwn main-amp)
+ (bird (+ beg .95) .07 3000 750 .2 sup main-amp)
+ (bird (+ beg 1.03) .03 5000 1000 .1 sdwn main-amp)
+ (bird (+ beg 1.10) .07 3000 750 .2 sup main-amp)
+ (bird (+ beg 1.18) .03 5000 1000 .1 sdwn main-amp)
+ (bird (+ beg 1.25) .07 3000 750 .2 sup main-amp)
+ (bird (+ beg 1.33) .03 5000 1000 .1 sdwn main-amp)
+ (bird (+ beg 1.40) .07 3000 750 .2 sup main-amp)
+ (bird (+ beg 1.48) .03 5000 1000 .1 sdwn main-amp)
+ (bird (+ beg 1.55) .07 3000 750 .2 sup main-amp)
+ (bird (+ beg 1.63) .03 5000 1000 .1 sdwn main-amp)
+
+ (let ((supn '(0.0 0.0 1.0 1.0)))
+ (bird (+ beg 2.8) .06 4000 1700 .1 supn main-amp)
+ (bird (+ beg 2.87) .01 5200 0 .2 supn main-amp)
+ (bird (+ beg 2.9) .06 4000 1700 .1 supn main-amp)
+ (bird (+ beg 2.97) .01 5200 0 .2 supn main-amp)
+ (bird (+ beg 3.0) .06 4000 1700 .1 supn main-amp)
+ (bird (+ beg 3.07) .01 5200 0 .2 supn main-amp)
+ (bird (+ beg 3.1) .06 4000 1700 .1 supn main-amp)
+ (bird (+ beg 3.17) .01 5200 0 .2 supn main-amp)
+ (bird (+ beg 3.2) .06 4000 1700 .1 supn main-amp)
+ (bird (+ beg 3.27) .01 5200 0 .2 supn main-amp))
+
+ (let ((slast '(0.0 1.0 .25 0.0 .75 .40 1.0 .50)))
+ (bird (+ beg 3.4) .15 3000 1000 .2 slast main-amp)
+ (bird (+ beg 3.6) .15 3000 1000 .2 slast main-amp)
+ (bird (+ beg 3.8) .15 3000 1000 .2 slast main-amp)
+ (bird (+ beg 4.0) .15 3000 1000 .2 slast main-amp)
+ (bird (+ beg 4.2) .15 3000 1000 .2 slast main-amp)
+ (bird (+ beg 4.4) .15 3000 1000 .2 slast main-amp)))))
(define b-cedar-waxwing
@@ -613,59 +612,59 @@
'(0.0 0.0 .20 1.0 .40 1.0 1.0 .0)))))
(define b-bairds-sparrow
- (let ((documentation "(bairds-sparrow beg) produces a bairds sparrow call at time 'beg'"))
+ (let ((documentation "(bairds-sparrow beg) produces a bairds sparrow call at time 'beg'")
+ (bairdend '(0.0 0.0 .25 1.0 .50 0.0 .75 1.0 1.0 .0)))
(lambda (beg)
- (let ((bairdend '(0.0 0.0 .25 1.0 .50 0.0 .75 1.0 1.0 .0)))
- (let ((bairdstart '(0.0 .50 .05 1.0 .10 0.0 .15 1.0 .20 0.0 .25 1.0 .30 0.0 .35 1.0 .40 0.0 .45 1.0
- .50 0.0 .55 1.0 .60 0.0 .65 1.0 .70 0.0 .75 1.0 .80 0.0 .85 1.0 .90 0.0 .95 1.0 1.0 .0)))
- (bird beg .09 6500 1500 .2 bairdstart main-amp)
- (bird (+ beg .22) .01 5900 100 .2 bairdend main-amp)
- (bird (+ beg .25) .09 6000 1000 .2 bairdstart main-amp)
- (bird (+ beg .45) .01 4200 100 .2 bairdend main-amp)
- (bird (+ beg .50) .08 4200 600 .2 bairdstart main-amp)
- (bird (+ beg .59) .01 4400 100 .2 bairdend main-amp)
- (bird (+ beg .60) .01 4400 100 .2 bairdend main-amp)
- (bird (+ beg .68) .07 5400 700 .2 bairdstart main-amp))
- (bird (+ beg .75) .01 4200 100 .2 bairdend main-amp)
- (bird (+ beg .79) .01 4400 100 .2 bairdend main-amp)
- (bird (+ beg .83) .01 4200 100 .19 bairdend main-amp)
- (bird (+ beg .87) .01 4400 100 .19 bairdend main-amp)
- (bird (+ beg .91) .01 4200 100 .18 bairdend main-amp)
- (bird (+ beg .95) .01 4400 100 .18 bairdend main-amp)
- (bird (+ beg .99) .01 4200 100 .17 bairdend main-amp)
- (bird (+ beg 1.03) .01 4400 100 .17 bairdend main-amp)
- (bird (+ beg 1.07) .01 4200 100 .16 bairdend main-amp)
- (bird (+ beg 1.11) .01 4400 100 .16 bairdend main-amp)
- (bird (+ beg 1.15) .01 4200 100 .15 bairdend main-amp)
- (bird (+ beg 1.19) .01 4400 100 .15 bairdend main-amp)
- (bird (+ beg 1.23) .01 4200 100 .14 bairdend main-amp)
- (bird (+ beg 1.27) .01 4400 100 .14 bairdend main-amp)
- (bird (+ beg 1.31) .01 4200 100 .13 bairdend main-amp)
- (bird (+ beg 1.35) .01 4400 100 .13 bairdend main-amp)
- (bird (+ beg 1.39) .01 4200 100 .12 bairdend main-amp)
- (bird (+ beg 1.43) .01 4400 100 .12 bairdend main-amp)
- (bird (+ beg 1.47) .01 4200 100 .11 bairdend main-amp)
- (bird (+ beg 1.51) .01 4400 100 .11 bairdend main-amp)
- (bird (+ beg 1.55) .01 4200 100 .10 bairdend main-amp)
- (bird (+ beg 1.59) .01 4400 100 .10 bairdend main-amp)
- (bird (+ beg 1.63) .01 4200 100 .09 bairdend main-amp)
- (bird (+ beg 1.67) .01 4400 100 .09 bairdend main-amp)
- (bird (+ beg 1.71) .01 4200 100 .08 bairdend main-amp)
- (bird (+ beg 1.75) .01 4400 100 .08 bairdend main-amp)
- (bird (+ beg 1.79) .01 4200 100 .07 bairdend main-amp)
- (bird (+ beg 1.83) .01 4400 100 .07 bairdend main-amp)
- (bird (+ beg 1.87) .01 4200 100 .06 bairdend main-amp)
- (bird (+ beg 1.92) .01 4400 100 .06 bairdend main-amp)
- (bird (+ beg 1.97) .01 4200 100 .05 bairdend main-amp)))))
+ (let ((bairdstart '(0.0 .50 .05 1.0 .10 0.0 .15 1.0 .20 0.0 .25 1.0 .30 0.0 .35 1.0 .40 0.0 .45 1.0
+ .50 0.0 .55 1.0 .60 0.0 .65 1.0 .70 0.0 .75 1.0 .80 0.0 .85 1.0 .90 0.0 .95 1.0 1.0 .0)))
+ (bird beg .09 6500 1500 .2 bairdstart main-amp)
+ (bird (+ beg .22) .01 5900 100 .2 bairdend main-amp)
+ (bird (+ beg .25) .09 6000 1000 .2 bairdstart main-amp)
+ (bird (+ beg .45) .01 4200 100 .2 bairdend main-amp)
+ (bird (+ beg .50) .08 4200 600 .2 bairdstart main-amp)
+ (bird (+ beg .59) .01 4400 100 .2 bairdend main-amp)
+ (bird (+ beg .60) .01 4400 100 .2 bairdend main-amp)
+ (bird (+ beg .68) .07 5400 700 .2 bairdstart main-amp))
+ (bird (+ beg .75) .01 4200 100 .2 bairdend main-amp)
+ (bird (+ beg .79) .01 4400 100 .2 bairdend main-amp)
+ (bird (+ beg .83) .01 4200 100 .19 bairdend main-amp)
+ (bird (+ beg .87) .01 4400 100 .19 bairdend main-amp)
+ (bird (+ beg .91) .01 4200 100 .18 bairdend main-amp)
+ (bird (+ beg .95) .01 4400 100 .18 bairdend main-amp)
+ (bird (+ beg .99) .01 4200 100 .17 bairdend main-amp)
+ (bird (+ beg 1.03) .01 4400 100 .17 bairdend main-amp)
+ (bird (+ beg 1.07) .01 4200 100 .16 bairdend main-amp)
+ (bird (+ beg 1.11) .01 4400 100 .16 bairdend main-amp)
+ (bird (+ beg 1.15) .01 4200 100 .15 bairdend main-amp)
+ (bird (+ beg 1.19) .01 4400 100 .15 bairdend main-amp)
+ (bird (+ beg 1.23) .01 4200 100 .14 bairdend main-amp)
+ (bird (+ beg 1.27) .01 4400 100 .14 bairdend main-amp)
+ (bird (+ beg 1.31) .01 4200 100 .13 bairdend main-amp)
+ (bird (+ beg 1.35) .01 4400 100 .13 bairdend main-amp)
+ (bird (+ beg 1.39) .01 4200 100 .12 bairdend main-amp)
+ (bird (+ beg 1.43) .01 4400 100 .12 bairdend main-amp)
+ (bird (+ beg 1.47) .01 4200 100 .11 bairdend main-amp)
+ (bird (+ beg 1.51) .01 4400 100 .11 bairdend main-amp)
+ (bird (+ beg 1.55) .01 4200 100 .10 bairdend main-amp)
+ (bird (+ beg 1.59) .01 4400 100 .10 bairdend main-amp)
+ (bird (+ beg 1.63) .01 4200 100 .09 bairdend main-amp)
+ (bird (+ beg 1.67) .01 4400 100 .09 bairdend main-amp)
+ (bird (+ beg 1.71) .01 4200 100 .08 bairdend main-amp)
+ (bird (+ beg 1.75) .01 4400 100 .08 bairdend main-amp)
+ (bird (+ beg 1.79) .01 4200 100 .07 bairdend main-amp)
+ (bird (+ beg 1.83) .01 4400 100 .07 bairdend main-amp)
+ (bird (+ beg 1.87) .01 4200 100 .06 bairdend main-amp)
+ (bird (+ beg 1.92) .01 4400 100 .06 bairdend main-amp)
+ (bird (+ beg 1.97) .01 4200 100 .05 bairdend main-amp))))
(define b-kentucky-warbler
- (let ((documentation "(kentucky-warbler beg) produces a kentucky warbler call at time 'beg'"))
+ (let ((documentation "(kentucky-warbler beg) produces a kentucky warbler call at time 'beg'")
+ (kenstart '(0.0 .30 .50 1.0 1.0 .0))
+ (kendwn '(0.0 .90 .10 1.0 1.0 .0))
+ (kentrill '(0.0 1.0 .25 0.0 .50 0.0 .75 1.0 1.0 .0)))
(lambda (beg)
- (let ((kenstart '(0.0 .30 .50 1.0 1.0 .0))
- (kendwn '(0.0 .90 .10 1.0 1.0 .0))
- (kentrill '(0.0 1.0 .25 0.0 .50 0.0 .75 1.0 1.0 .0)))
- (set! beg (- beg .6))
+ (let ((beg (- beg .6)))
(bigbird (+ beg .6) .02 3800 200 .05 kenstart main-amp '(1 1 2 .03))
(bigbird (+ beg .65) .03 4300 200 .15 '(0.0 0.0 1.0 1.0) main-amp '(1 1 2 .1))
(bigbird (+ beg .73) .02 3200 100 .1 kendwn main-amp '(1 1 2 .1))
@@ -700,13 +699,13 @@
(define b-rufous-sided-towhee
- (let ((documentation "(rufous-sided-towhee beg) produces a rufous sided towhee call at time 'beg'"))
+ (let ((documentation "(rufous-sided-towhee beg) produces a rufous sided towhee call at time 'beg'")
+ (towhee-two '(0.0 0.0 1.0 1.0))
+ (towhee-three '(0.0 1.0 1.0 .0)))
(lambda (beg)
- (let ((towhee-two '(0.0 0.0 1.0 1.0))
- (towhee-three '(0.0 1.0 1.0 .0)))
- (set! beg (- beg .25))
+ (let ((beg (- beg .25)))
(let ((towhee-one '(0.0 .10 .02 .05 .04 .15 .06 .05 .08 .20 .10 .04 .12 .25 .14 .03 .16 .30 .18 .02 .20 .35 .22 .01 .24
- .40 .26 0.0 .28 .45 .30 0.0 .32 .50 .34 0.0 .36 .50 .80 1.0 1.0 .0)))
+ .40 .26 0.0 .28 .45 .30 0.0 .32 .50 .34 0.0 .36 .50 .80 1.0 1.0 .0)))
(bigbird (+ beg .25) .13 1400 1100 .2 towhee-one main-amp '(1 .03 2 1 3 .03))
(bigbird (+ beg .45) .13 1400 1100 .2 towhee-one main-amp '(1 .03 2 1 3 .03))
(bigbird (+ beg .60) .13 1400 1100 .2 towhee-one main-amp '(1 .03 2 1 3 .03))
@@ -764,12 +763,12 @@
(define b-prothonotary-warbler
- (let ((documentation "(prothonotary-warbler beg) produces a prothonotary warbler call at time 'beg'"))
+ (let ((documentation "(prothonotary-warbler beg) produces a prothonotary warbler call at time 'beg'")
+ (pro-one '(0.0 .10 .20 0.0 1.0 1.0))
+ (pro-two '(0.0 0.0 1.0 1.0))
+ (pro-amp '(0.0 0.0 .20 1.0 .40 .50 1.0 .0)))
(lambda (beg)
- (let ((pro-one '(0.0 .10 .20 0.0 1.0 1.0))
- (pro-two '(0.0 0.0 1.0 1.0))
- (pro-amp '(0.0 0.0 .20 1.0 .40 .50 1.0 .0)))
- (set! beg (- beg .76))
+ (let ((beg (- beg .76)))
(bird (+ beg .76) .08 3000 3000 .05 pro-one pro-amp)
(bird (+ beg .85) .05 4000 2500 .06 pro-two bird-amp)
@@ -793,12 +792,12 @@
(define b-audubons-warbler
- (let ((documentation "(audubons-warbler beg) produces an audubons warbler (yellow-rumped warbler) call at time 'beg'"))
+ (let ((documentation "(audubons-warbler beg) produces an audubons warbler (yellow-rumped warbler) call at time 'beg'")
+ (w-up '(0.0 0.0 1.0 1.0))
+ (w-down '(0.0 1.0 1.0 .0))
+ (w-updown '(0.0 .10 .50 1.0 1.0 .0)))
(lambda (beg) ; (yellow-rumped say the revisionists))
- (let ((w-up '(0.0 0.0 1.0 1.0))
- (w-down '(0.0 1.0 1.0 .0))
- (w-updown '(0.0 .10 .50 1.0 1.0 .0)))
- (set! beg (- beg .75))
+ (let ((beg (- beg .75)))
(bird (+ beg .75) .04 2400 200 .05 w-down bird-amp)
(bird (+ beg .83) .03 3200 200 .1 w-up bird-amp)
(bird (+ beg .90) .04 2500 300 .15 w-up bird-amp)
@@ -823,11 +822,11 @@
(define b-lark-bunting
- (let ((documentation "(lark-bunting beg) produces a lark bunting call at time 'beg'"))
+ (let ((documentation "(lark-bunting beg) produces a lark bunting call at time 'beg'")
+ (b-down '(0.0 1.0 1.0 .0))
+ (b-up '(0.0 0.0 1.0 1.0)))
(lambda (beg)
- (let ((b-down '(0.0 1.0 1.0 .0))
- (b-up '(0.0 0.0 1.0 1.0)))
- (set! beg (- beg .1))
+ (let ((beg (- beg .1)))
(bird (+ beg .1) .03 1800 100 .1 b-up bird-amp)
(bird (+ beg .2) .12 3700 400 .2 b-up bird-amp)
@@ -866,10 +865,10 @@
(define b-eastern-bluebird
- (let ((documentation "(eastern-bluebird beg) produces an eastern bluebird call at time 'beg'"))
+ (let ((documentation "(eastern-bluebird beg) produces an eastern bluebird call at time 'beg'")
+ (blue-one '(0.0 0.0 1.0 1.0)))
(lambda (beg)
- (let ((blue-one '(0.0 0.0 1.0 1.0)))
- (set! beg (- beg .75))
+ (let ((beg (- beg .75)))
(bird (+ beg .75) .02 2000 1600 .1 blue-one bird-amp)
(bird (+ beg .80) .02 2000 1600 .1 blue-one bird-amp)
(bird (+ beg .86) .02 2000 1600 .1 blue-one bird-amp)
@@ -878,7 +877,7 @@
(bird (+ beg 1.68) .03 2200 400 .1 blue-one bird-amp)
(bird (+ beg 1.72) .10 1950 100 .15 '(0.0 0.0 .50 1.0 1.0 .0) bird-amp)
(bird (+ beg 1.96) .15 2000 600 .20 '(0.0 .50 .10 1.0 .20 0.0 .35 1.0 .50 0.0 .65 1.0 .80 0.0 .95 1.0 1.0 .50) bird-amp)))))
-
+
(define b-chuck-wills-widow
(let ((documentation "(chuck-wills-widow beg) produces a chuck wills widow call at time 'beg'"))
@@ -889,11 +888,11 @@
(define b-blue-gray-gnatcatcher
- (let ((documentation "(blue-gray-gnatcatcher beg) produces a blue gray gnatcatcher call at time 'beg'"))
+ (let ((documentation "(blue-gray-gnatcatcher beg) produces a blue gray gnatcatcher call at time 'beg'")
+ (gskw1 '(0.0 0.0 .15 1.0 .75 .80 .90 1.0 1.0 .70))
+ (gskw2 '(0.0 0.0 .25 1.0 .75 .70 1.0 .0)))
(lambda (beg)
- (let ((gskw1 '(0.0 0.0 .15 1.0 .75 .80 .90 1.0 1.0 .70))
- (gskw2 '(0.0 0.0 .25 1.0 .75 .70 1.0 .0)))
- (set! beg (- beg .5))
+ (let ((beg (- beg .5)))
(bigbird (+ beg .5) .20 4000 1000 .2 gskw1 bird-amp '(1 .4 2 1 3 .1))
(bigbird (+ beg .8) .13 4000 800 .2 gskw2 bird-amp '(1 .4 2 1 3 .2))
@@ -904,11 +903,11 @@
(define b-black-throated-sparrow
- (let ((documentation "(black-throated-sparrow beg) produces a black throated sparrow call at time 'beg'"))
+ (let ((documentation "(black-throated-sparrow beg) produces a black throated sparrow call at time 'beg'")
+ (black-up '(0.0 0.0 1.0 1.0))
+ (black-amp '(0.0 0.0 .50 1.0 1.0 .0)))
(lambda (beg)
- (let ((black-up '(0.0 0.0 1.0 1.0))
- (black-amp '(0.0 0.0 .50 1.0 1.0 .0)))
- (set! beg (- beg .8))
+ (let ((beg (- beg .8)))
(let ((black-down '(0.0 1.0 1.0 .0)))
(bird (+ beg .8) .02 2200 1000 .1 black-down bird-amp)
(bird (+ beg .83) .01 3000 200 .05 black-up bird-amp)
@@ -918,8 +917,8 @@
(bird (+ beg 1.15) .05 5700 400 .25 black-up bird-amp)
(bird (+ beg 1.25) .25 2000 900 .2
'(0.0 0.0 .03 .70 .06 0.0 .09 .75 .12 0.0 .15 .80 .18 .05 .21 .85 .24 .10 .27 .90
- .30 .10 .33 1.0 .36 .10 .39 1.0 .42 .10 .45 1.0 .48 .10 .51 1.0 .54 .10 .57 1.0
- .60 .10 .63 1.0 .66 .10 .69 1.0 .72 .10 .75 1.0 .78 .10 .81 1.0 .84 .10 .87 1.0 .90 0.0 .93 .95 .96 0.0 1.0 .90)
+ .30 .10 .33 1.0 .36 .10 .39 1.0 .42 .10 .45 1.0 .48 .10 .51 1.0 .54 .10 .57 1.0
+ .60 .10 .63 1.0 .66 .10 .69 1.0 .72 .10 .75 1.0 .78 .10 .81 1.0 .84 .10 .87 1.0 .90 0.0 .93 .95 .96 0.0 1.0 .90)
bird-amp)
(bird (+ beg 1.52) .05 5600 400 .15 '(0.0 0.0 .50 1.0 1.0 .20) bird-amp)
@@ -952,13 +951,13 @@
(bird (+ beg 2.13) .01 1900 100 .10 black-up black-amp)
(bird (+ beg 2.16) .03 3800 300 .1 black-up bird-amp)))))
-
-
+
+
(define b-black-chinned-sparrow
- (let ((documentation "(black-chinned-sparrow beg) produces a black chinned sparrow call at time 'beg'"))
+ (let ((documentation "(black-chinned-sparrow beg) produces a black chinned sparrow call at time 'beg'")
+ (chin-up '(0.0 0.0 1.0 1.0)))
(lambda (beg)
- (let ((chin-up '(0.0 0.0 1.0 1.0)))
- (set! beg (- beg .6))
+ (let ((beg (- beg .6)))
(bird (+ beg .6) .2 4200 100 .1 chin-up bird-amp)
(let ((chin-up2 '(0.0 0.0 .30 .20 1.0 1.0)))
(bird (+ beg 1.0) .09 3800 2000 .1 chin-up2 bird-amp)
@@ -979,12 +978,12 @@
(define various-gull-cries-from-end-of-colony-5
- (let ((documentation "(various-gull-cries-from-end-of-colony-5 beg) produces a various gull cries at time 'beg'"))
+ (let ((documentation "(various-gull-cries-from-end-of-colony-5 beg) produces a various gull cries at time 'beg'")
+ (gullstart '(0 0 10 1 20 .5000 40 .6000 60 .5000 100 0))
+ (gullend '(0 0 5 1 10 .5000 90 .4000 100 0))
+ (gull-frq '(1 .1 2 1 3 .1 4 .01 5 .09 6 .01 7 .01)))
(lambda (beg)
- (let ((gullstart '(0 0 10 1 20 .5000 40 .6000 60 .5000 100 0))
- (gullend '(0 0 5 1 10 .5000 90 .4000 100 0))
- (gull-frq '(1 .1 2 1 3 .1 4 .01 5 .09 6 .01 7 .01)))
- (set! beg (- beg .25))
+ (let ((beg (- beg .25)))
(bigbird (+ beg .250) .80 1180 1180 .08 gullend bird-amp gull-frq)
(bigbird (+ beg 1.500) .90 1180 1180 .07 gullend bird-amp gull-frq)
(bigbird (+ beg 2.750) 1.0 1050 1050 .08 gullend bird-amp gull-frq)
diff --git a/clean.scm b/clean.scm
index b4ca1d6..a3fb66b 100644
--- a/clean.scm
+++ b/clean.scm
@@ -312,7 +312,7 @@
(float-vector->channel data)
(let ((dc (goertzel 0.0))
(sig (goertzel 35.0)))
- (let ((dcflt (make-filter 2 (float-vector 1 -1) (float-vector 0 -0.99))))
+ (let ((dcflt (make-filter 2 #r(1 -1) #r(0 -0.99))))
(map-channel (lambda (y) (filter dcflt y)))
(let ((ndc (goertzel 0.0))
(nsig (goertzel 35.0)))
@@ -410,7 +410,7 @@
;; look for DC
(let ((dc (check-freq 0.0 snd chn)))
(if (> dc 30.0)
- (let ((dcflt (make-filter 2 (float-vector 1 -1) (float-vector 0 -0.99))))
+ (let ((dcflt (make-filter 2 #r(1 -1) #r(0 -0.99))))
(map-channel (lambda (y) (filter dcflt y)) 0 (framples snd chn) snd chn)
(format () "~%; block DC: ~A -> ~A" dc (check-freq 0.0 snd chn)))))
diff --git a/clm-ins.scm b/clm-ins.scm
index 21479e3..c591f17 100644
--- a/clm-ins.scm
+++ b/clm-ins.scm
@@ -682,18 +682,18 @@ is a physical model of a flute:
(definstrument (fm-drum start-time duration frequency amplitude index
high (degree 0.0) (distance 1.0) (reverb-amount 0.01))
(let (;; many of the following variables were originally passed as arguments
- (casrat (if high 8.525 3.515))
- (fmrat (if high 3.414 1.414))
- (glsfun '(0 0 25 0 75 1 100 1))
(indxfun '(0 0 5 .014 10 .033 15 .061 20 .099
25 .153 30 .228 35 .332 40 .477
45 .681 50 .964 55 .681 60 .478 65 .332
70 .228 75 .153 80 .099 85 .061
90 .033 95 .0141 100 0))
(indxpt (- 100 (* 100 (/ (- duration .1) duration))))
- (ampfun '(0 0 3 .05 5 .2 7 .8 8 .95 10 1.0 12 .95 20 .3 30 .1 100 0))
(atdrpt (* 100 (/ (if high .01 .015) duration))))
- (let ((divindxf (stretch-envelope indxfun 50 atdrpt 65 indxpt)))
+ (let ((divindxf (stretch-envelope indxfun 50 atdrpt 65 indxpt))
+ (ampfun '(0 0 3 .05 5 .2 7 .8 8 .95 10 1.0 12 .95 20 .3 30 .1 100 0))
+ (casrat (if high 8.525 3.515))
+ (fmrat (if high 3.414 1.414))
+ (glsfun '(0 0 25 0 75 1 100 1)))
(let ((beg (seconds->samples start-time))
(end (seconds->samples (+ start-time duration)))
(glsf (make-env glsfun :scaler (if high (hz->radians 66) 0.0) :duration duration))
@@ -795,6 +795,7 @@ is a physical model of a flute:
(outa i (* scale x))))))
+
;;; -------- PQW
(definstrument (pqw start dur spacing-freq carrier-freq amplitude ampfun indexfun partials
(degree 0.0)
@@ -1348,7 +1349,7 @@ is a physical model of a flute:
(definstrument (lbj-piano begin-time duration frequency amplitude pfreq
(degree 45) (reverb-amount 0) (distance 1))
- (define (get-piano-partials freq)
+ (define get-piano-partials
(let ((piano-spectra #((1.97 .0326 2.99 .0086 3.95 .0163 4.97 .0178 5.98 .0177 6.95 .0315 8.02 .0001
8.94 .0076 9.96 .0134 10.99 .0284 11.98 .0229 13.02 .0229 13.89 .0010 15.06 .0090 16.00 .0003
17.08 .0078 18.16 .0064 19.18 .0129 20.21 .0085 21.27 .0225 22.32 .0061 23.41 .0102 24.48 .0005
@@ -1750,9 +1751,9 @@ is a physical model of a flute:
(1.00 .0080 2.00 .0005 3.19 .0001)
- (1.01 .0298 2.01 .0005)))
- (pitch (round (* 12 (log (/ freq 32.703) 2)))))
- (piano-spectra pitch)))
+ (1.01 .0298 2.01 .0005))))
+ (lambda (freq)
+ (piano-spectra (round (* 12 (log (/ freq 32.703) 2)))))))
(let ((*piano-attack-duration* .04)
(*piano-release-duration* .2))
diff --git a/clm.c b/clm.c
index c99d1f6..590bccb 100644
--- a/clm.c
+++ b/clm.c
@@ -238,7 +238,6 @@ mus_float_t mus_samples_to_seconds(mus_long_t samps) {return((mus_float_t)((mus_
#define DESCRIBE_BUFFER_SIZE 2048
#define STR_SIZE 128
-
static char *float_array_to_string(mus_float_t *arr, int len, int loc)
{
/* %g is needed here rather than %f -- otherwise the number strings can be any size */
@@ -371,6 +370,7 @@ static char *int_array_to_string(int *arr, int num_ints, const char *name)
}
+
/* ---------------- generic functions ---------------- */
#define check_gen(Ptr, Name) ((Ptr) ? true : (!mus_error(MUS_NO_GEN, "null generator passed to %s", Name)))
@@ -1375,7 +1375,6 @@ static void free_oscil_bank(mus_any *ptr)
static mus_any *ob_copy(mus_any *ptr)
{
ob *g, *p;
- int bytes;
p = (ob *)ptr;
g = (ob *)malloc(sizeof(ob));
@@ -1386,6 +1385,7 @@ static mus_any *ob_copy(mus_any *ptr)
#if HAVE_SINCOS
if (g->sn1)
{
+ int bytes;
bytes = g->size * sizeof(double);
g->sn1 = (double *)malloc(bytes);
memcpy((void *)(g->sn1), (void *)(p->sn1), bytes);
@@ -1401,11 +1401,10 @@ static mus_any *ob_copy(mus_any *ptr)
}
#endif
- bytes = g->size * sizeof(mus_float_t);
/* we have to make a new phases array -- otherwise the original and copy step on each other */
g->free_phases = true;
- g->phases = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->phases), (void *)(p->phases), bytes);
+ g->phases = (mus_float_t *)malloc(g->size * sizeof(mus_float_t));
+ copy_floats(g->phases, p->phases, g->size);
return((mus_any *)g);
}
@@ -1442,7 +1441,7 @@ static void oscil_bank_reset(mus_any *ptr)
{
ob *p = (ob *)ptr;
p->size = p->orig_size;
- memset((void *)(p->phases), 0, p->orig_size * sizeof(mus_float_t));
+ clear_floats(p->phases, p->orig_size);
}
@@ -2795,7 +2794,7 @@ mus_float_t *mus_partials_to_wave(mus_float_t *partial_data, int partials, mus_f
{
int partial, k;
if (!table) return(NULL);
- memset((void *)table, 0, table_size * sizeof(mus_float_t));
+ clear_floats(table, table_size);
for (partial = 0, k = 1; partial < partials; partial++, k += 2)
{
mus_float_t amp;
@@ -2819,7 +2818,7 @@ mus_float_t *mus_phase_partials_to_wave(mus_float_t *partial_data, int partials,
{
int partial, k, n;
if (!table) return(NULL);
- memset((void *)table, 0, table_size * sizeof(mus_float_t));
+ clear_floats(table, table_size);
for (partial = 0, k = 1, n = 2; partial < partials; partial++, k += 3, n += 3)
{
mus_float_t amp;
@@ -3003,16 +3002,14 @@ static void free_table_lookup(mus_any *ptr)
static mus_any *tbl_copy(mus_any *ptr)
{
- mus_long_t bytes;
tbl *g, *p;
p = (tbl *)ptr;
g = (tbl *)malloc(sizeof(tbl));
memcpy((void *)g, (void *)ptr, sizeof(tbl));
- bytes = g->table_size * sizeof(mus_float_t);
- g->table = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->table), (void *)(p->table), bytes);
+ g->table = (mus_float_t *)malloc(g->table_size * sizeof(mus_float_t));
+ copy_floats(g->table, p->table, g->table_size);
g->table_allocated = true;
return((mus_any *)g);
@@ -4107,13 +4104,11 @@ static mus_float_t *wt_set_data(mus_any *ptr, mus_float_t *data) {((wt *)ptr)->w
static mus_any *wt_copy(mus_any *ptr)
{
wt *g, *p;
- int bytes;
p = (wt *)ptr;
g = (wt *)malloc(sizeof(wt));
memcpy((void *)g, (void *)ptr, sizeof(wt));
- bytes = g->out_data_size * sizeof(mus_float_t);
- g->out_data = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->out_data), (void *)(p->out_data), bytes);
+ g->out_data = (mus_float_t *)malloc(g->out_data_size * sizeof(mus_float_t));
+ copy_floats(g->out_data, p->out_data, g->out_data_size);
/* g->wave is caller's data */
return((mus_any *)g);
}
@@ -4172,9 +4167,9 @@ static mus_float_t mus_wave_train_any(mus_any *ptr, mus_float_t fm)
mus_long_t good_samps;
good_samps = gen->out_data_size - gen->out_pos;
memmove((void *)out_data, (void *)(out_data + gen->out_pos), good_samps * sizeof(mus_float_t));
- memset((void *)(out_data + good_samps), 0, gen->out_pos * sizeof(mus_float_t));
+ clear_floats(out_data + good_samps, gen->out_pos);
}
- else memset((void *)out_data, 0, gen->out_data_size * sizeof(mus_float_t));
+ else clear_floats(out_data, gen->out_data_size);
if (gen->interp_type == MUS_INTERP_LINEAR)
{
/* gen->phase doesn't change, and i is an int, so we can precalculate the fractional part, etc
@@ -4262,7 +4257,7 @@ static void wt_reset(mus_any *ptr)
{
wt *gen = (wt *)ptr;
gen->phase = 0.0;
- memset((void *)(gen->out_data), 0, gen->out_data_size * sizeof(mus_float_t));
+ clear_floats(gen->out_data, gen->out_data_size);
gen->out_pos = gen->out_data_size;
gen->next_wave_time = 0.0;
gen->first_time = true;
@@ -4477,7 +4472,6 @@ static void free_delay(mus_any *gen)
static mus_any *dly_copy(mus_any *ptr)
{
dly *g, *p;
- mus_long_t bytes;
p = (dly *)ptr;
if (dly_free_list)
{
@@ -4487,9 +4481,8 @@ static mus_any *dly_copy(mus_any *ptr)
else g = (dly *)malloc(sizeof(dly));
memcpy((void *)g, (void *)ptr, sizeof(dly));
- bytes = g->size * sizeof(mus_float_t);
- g->line = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->line), (void *)(p->line), bytes);
+ g->line = (mus_float_t *)malloc(g->size * sizeof(mus_float_t));
+ copy_floats(g->line, p->line, g->size);
g->line_allocated = true;
if (p->filt)
@@ -4602,7 +4595,7 @@ static void delay_reset(mus_any *ptr)
gen->loc = 0;
gen->zloc = 0;
gen->yn1 = 0.0;
- memset((void *)(gen->line), 0, gen->zsize * sizeof(mus_float_t));
+ clear_floats(gen->line, gen->zsize);
}
@@ -6605,7 +6598,7 @@ static mus_float_t rand_interp_unmodulated_with_distribution(mus_any *ptr)
if (gen->phase >= TWO_PI)
{
gen->phase -= TWO_PI;
- gen->incr = (random_any(gen) - gen->output) / (ceil(TWO_PI / gen->freq));
+ gen->incr = (random_any(gen) - gen->output) * gen->norm;
}
gen->phase += gen->freq;
return(gen->output);
@@ -6620,8 +6613,7 @@ static mus_float_t rand_interp_unmodulated(mus_any *ptr)
if (gen->phase >= TWO_PI)
{
gen->phase -= TWO_PI;
- randx = randx * 1103515245 + 12345;
- gen->incr = ((gen->base * ((mus_float_t)((unsigned int)(randx >> 16) & 32767) * INVERSE_MAX_RAND - 1.0)) - gen->output) * gen->norm;
+ gen->incr = (mus_random(gen->base) - gen->output) * gen->norm;
}
return(gen->output);
}
@@ -6712,8 +6704,8 @@ static mus_float_t randi_set_scaler(mus_any *ptr, mus_float_t val)
static void noi_reset(mus_any *ptr)
{
noi *gen = (noi *)ptr;
- gen->phase = 0.0;
- gen->output = 0.0;
+ gen->phase = TWO_PI; /* 2*pi is the trigger, otherwise value after mus-reset is always 0.0, as Tito Latini noticed */
+ gen->output = mus_is_rand_interp(ptr) ? random_any(gen) - gen->incr : 0.0;
}
@@ -6824,7 +6816,7 @@ mus_any *mus_make_rand(mus_float_t freq, mus_float_t base)
gen->freq = mus_hz_to_radians(freq);
gen->base = base;
gen->incr = 0.0;
- gen->output = random_any(gen); /* this was always starting at 0.0 (changed 23-Dec-06) */
+ gen->output = mus_random(base); /* this was always starting at 0.0 (changed 23-Dec-06) */
return((mus_any *)gen);
}
@@ -6832,9 +6824,14 @@ mus_any *mus_make_rand(mus_float_t freq, mus_float_t base)
mus_any *mus_make_rand_with_distribution(mus_float_t freq, mus_float_t base, mus_float_t *distribution, int distribution_size)
{
noi *gen;
- gen = (noi *)mus_make_rand(freq, base);
+ gen = (noi *)calloc(1, sizeof(noi));
+ gen->core = &RAND_CLASS;
gen->distribution = distribution;
gen->distribution_size = distribution_size;
+ if (freq < 0.0) freq = -freq;
+ gen->freq = mus_hz_to_radians(freq);
+ gen->base = base;
+ gen->incr = 0.0;
gen->output = random_any(gen);
return((mus_any *)gen);
}
@@ -6849,8 +6846,9 @@ mus_any *mus_make_rand_interp(mus_float_t freq, mus_float_t base)
if (freq < 0.0) freq = -freq;
gen->freq = mus_hz_to_radians(freq);
gen->base = base;
- gen->incr = mus_random(base) * freq / sampling_rate;
- gen->output = 0.0;
+ gen->output = mus_random(base);
+ gen->incr = (mus_random(base) - gen->output) * freq / sampling_rate;
+ gen->output -= gen->incr;
if (gen->freq != 0.0)
gen->norm = 1.0 / (ceil(TWO_PI / gen->freq));
else gen->norm = 1.0;
@@ -6862,9 +6860,19 @@ mus_any *mus_make_rand_interp(mus_float_t freq, mus_float_t base)
mus_any *mus_make_rand_interp_with_distribution(mus_float_t freq, mus_float_t base, mus_float_t *distribution, int distribution_size)
{
noi *gen;
- gen = (noi *)mus_make_rand_interp(freq, base);
+ gen = (noi *)calloc(1, sizeof(noi));
+ gen->core = &RAND_INTERP_CLASS;
gen->distribution = distribution;
gen->distribution_size = distribution_size;
+ if (freq < 0.0) freq = -freq;
+ gen->freq = mus_hz_to_radians(freq);
+ gen->base = base;
+ gen->output = random_any(gen);
+ gen->incr = (random_any(gen) - gen->output) * freq / sampling_rate;
+ gen->output -= gen->incr;
+ if (gen->freq != 0.0)
+ gen->norm = 1.0 / (ceil(TWO_PI / gen->freq));
+ else gen->norm = 1.0;
gen->ran_unmod = ((base == 0.0) ? zero_unmodulated : rand_interp_unmodulated_with_distribution);
return((mus_any *)gen);
}
@@ -7480,24 +7488,24 @@ static mus_any *frm_bank_copy(mus_any *ptr)
bytes = g->size * sizeof(mus_float_t);
g->x0 = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->x0), (void *)(p->x0), bytes);
+ copy_floats(g->x0, p->x0, g->size);
g->x1 = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->x1), (void *)(p->x1), bytes);
+ copy_floats(g->x1, p->x1, g->size);
g->x2 = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->x2), (void *)(p->x2), bytes);
+ copy_floats(g->x2, p->x2, g->size);
g->y0 = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->y0), (void *)(p->y0), bytes);
+ copy_floats(g->y0, p->y0, g->size);
g->y1 = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->y1), (void *)(p->y1), bytes);
+ copy_floats(g->y1, p->y1, g->size);
g->y2 = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->y2), (void *)(p->y2), bytes);
+ copy_floats(g->y2, p->y2, g->size);
g->rr = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->rr), (void *)(p->rr), bytes);
+ copy_floats(g->rr, p->rr, g->size);
g->fdbk = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->fdbk), (void *)(p->fdbk), bytes);
+ copy_floats(g->fdbk, p->fdbk, g->size);
g->gain = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->gain), (void *)(p->gain), bytes);
+ copy_floats(g->gain, p->gain, g->size);
return((mus_any *)g);
}
@@ -7517,14 +7525,12 @@ static mus_long_t formant_bank_length(mus_any *ptr)
static void formant_bank_reset(mus_any *ptr)
{
frm_bank *f = (frm_bank *)ptr;
- int size;
- size = f->size * sizeof(mus_float_t);
- memset((void *)(f->x0), 0, size);
- memset((void *)(f->x1), 0, size);
- memset((void *)(f->x2), 0, size);
- memset((void *)(f->y0), 0, size);
- memset((void *)(f->y1), 0, size);
- memset((void *)(f->y2), 0, size);
+ clear_floats((f->x0), f->size);
+ clear_floats((f->x1), f->size);
+ clear_floats((f->x2), f->size);
+ clear_floats((f->y0), f->size);
+ clear_floats((f->y1), f->size);
+ clear_floats((f->y2), f->size);
}
@@ -8819,17 +8825,15 @@ static void free_filter(mus_any *ptr)
static mus_any *flt_copy(mus_any *ptr)
{
flt *g, *p;
- int bytes;
p = (flt *)ptr;
g = (flt *)malloc(sizeof(flt));
memcpy((void *)g, (void *)ptr, sizeof(flt));
/* we have to make a new state array -- otherwise the original and copy step on each other */
- bytes = p->order * 2 * sizeof(mus_float_t);
g->state_allocated = true;
- g->state = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->state), (void *)(p->state), bytes);
+ g->state = (mus_float_t *)malloc(p->order * 2 * sizeof(mus_float_t));
+ copy_floats(g->state, p->state, p->order * 2);
return((mus_any *)g);
}
@@ -8902,7 +8906,7 @@ static char *describe_iir_filter(mus_any *ptr)
static void filter_reset(mus_any *ptr)
{
flt *gen = (flt *)ptr;
- memset((void *)(gen->state), 0, gen->allocated_size * 2 * sizeof(mus_float_t));
+ clear_floats(gen->state, gen->allocated_size * 2);
}
@@ -9147,7 +9151,7 @@ mus_float_t *mus_make_fir_coeffs(int order, mus_float_t *envl, mus_float_t *aa)
rl = (mus_float_t *)calloc(fsize, sizeof(mus_float_t));
im = (mus_float_t *)calloc(fsize, sizeof(mus_float_t));
lim = order / 2;
- memcpy((void *)rl, (void *)envl, lim * sizeof(mus_float_t));
+ copy_floats(rl, envl, lim);
mus_fft(rl, im, fsize, 1);
@@ -9199,9 +9203,9 @@ static mus_any *onepall_copy(mus_any *ptr)
bytes = g->size * sizeof(mus_float_t);
g->x = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->x), (void *)(p->x), bytes);
+ copy_floats(g->x, p->x, g->size);
g->y = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->y), (void *)(p->y), bytes);
+ copy_floats(g->y, p->y, g->size);
return((mus_any *)g);
}
@@ -9222,10 +9226,8 @@ static mus_long_t onepall_length(mus_any *ptr)
static void onepall_reset(mus_any *ptr)
{
onepall *f = (onepall *)ptr;
- int size;
- size = f->size;
- memset((void *)(f->x), 0, size * sizeof(mus_float_t));
- memset((void *)(f->y), 0, size * sizeof(mus_float_t));
+ clear_floats(f->x, f->size);
+ clear_floats(f->y, f->size);
}
@@ -9738,9 +9740,8 @@ static mus_any *seg_copy(mus_any *ptr)
if (p->rates)
{
int bytes;
- bytes = p->size * sizeof(mus_float_t);
- e->rates = (mus_float_t *)malloc(bytes);
- memcpy((void *)(e->rates), (void *)(p->rates), bytes);
+ e->rates = (mus_float_t *)malloc(p->size * sizeof(mus_float_t));
+ copy_floats(e->rates, p->rates, p->size);
bytes = (p->size + 1) * sizeof(mus_long_t);
e->locs = (mus_long_t *)malloc(bytes);
@@ -9755,7 +9756,7 @@ static mus_any *seg_copy(mus_any *ptr)
bytes = p->size * sizeof(mus_float_t);
r = e->rates;
- memcpy((void *)r, (void *)(p->rates), bytes);
+ copy_floats(r, p->rates, p->size);
bytes = (p->size + 1) * sizeof(mus_long_t);
l = e->locs;
@@ -10389,7 +10390,7 @@ static mus_any *rdin_copy(mus_any *ptr)
mus_long_t len;
len = make_ibufs(g);
for (i = 0; i < g->chans; i++)
- memcpy((void *)(g->ibufs[i]), (void *)(p->ibufs[i]), len * sizeof(mus_float_t));
+ copy_floats(g->ibufs[i], p->ibufs[i], len);
}
return((mus_any *)g);
}
@@ -10950,13 +10951,11 @@ static mus_any *rdout_copy(mus_any *ptr)
if (p->obufs)
{
int i;
- mus_long_t bytes;
- bytes = clm_file_buffer_size * sizeof(mus_float_t);
g->obufs = (mus_float_t **)malloc(g->chans * sizeof(mus_float_t *));
for (i = 0; i < g->chans; i++)
{
- g->obufs[i] = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->obufs[i]), (void *)(p->obufs[i]), bytes);
+ g->obufs[i] = (mus_float_t *)malloc(clm_file_buffer_size * sizeof(mus_float_t));
+ copy_floats(g->obufs[i], p->obufs[i], clm_file_buffer_size);
}
g->obuf0 = g->obufs[0];
if (g->chans > 1)
@@ -11262,7 +11261,7 @@ mus_any *mus_sample_to_file_add(mus_any *out1, mus_any *out2)
mus_long_t i;
for (i = 0; i < min_framples; i++)
dest->obufs[chn][i] += in_coming->obufs[chn][i];
- memset((void *)(in_coming->obufs[chn]), 0, min_framples * sizeof(mus_float_t));
+ clear_floats(in_coming->obufs[chn], min_framples);
}
if (min_framples > dest->out_end)
@@ -11293,7 +11292,7 @@ mus_float_t mus_out_any_to_file(mus_any *ptr, mus_long_t samp, int chan, mus_flo
if (samp < 0) return(val);
flush_buffers(gen);
for (j = 0; j < gen->chans; j++)
- memset((void *)(gen->obufs[j]), 0, clm_file_buffer_size * sizeof(mus_float_t));
+ clear_floats(gen->obufs[j], clm_file_buffer_size);
gen->data_start = samp;
gen->data_end = samp + clm_file_buffer_size - 1;
gen->obufs[chan][0] += val;
@@ -11323,7 +11322,7 @@ static void mus_out_chans_to_file(rdout *gen, mus_long_t samp, int chans, mus_fl
if (samp < 0) return;
flush_buffers(gen);
for (j = 0; j < gen->chans; j++)
- memset((void *)(gen->obufs[j]), 0, clm_file_buffer_size * sizeof(mus_float_t));
+ clear_floats(gen->obufs[j], clm_file_buffer_size);
gen->data_start = samp;
gen->data_end = samp + clm_file_buffer_size - 1;
for (i = 0; i < chans; i++)
@@ -11354,7 +11353,7 @@ static mus_float_t mus_outa_to_file(mus_any *ptr, mus_long_t samp, mus_float_t v
if (samp < 0) return(val);
flush_buffers(gen);
for (j = 0; j < gen->chans; j++)
- memset((void *)(gen->obufs[j]), 0, clm_file_buffer_size * sizeof(mus_float_t));
+ clear_floats(gen->obufs[j], clm_file_buffer_size);
gen->data_start = samp;
gen->data_end = samp + clm_file_buffer_size - 1;
gen->obuf0[0] += val;
@@ -11385,7 +11384,7 @@ static mus_float_t mus_outb_to_file(mus_any *ptr, mus_long_t samp, mus_float_t v
if (samp < 0) return(val);
flush_buffers(gen);
for (j = 0; j < gen->chans; j++)
- memset((void *)(gen->obufs[j]), 0, clm_file_buffer_size * sizeof(mus_float_t));
+ clear_floats(gen->obufs[j], clm_file_buffer_size);
gen->data_start = samp;
gen->data_end = samp + clm_file_buffer_size - 1;
gen->obuf1[0] += val;
@@ -11555,7 +11554,7 @@ mus_float_t mus_safe_out_any_to_file(mus_long_t samp, mus_float_t val, int chan,
if (samp < 0) return(val);
flush_buffers(gen);
for (j = 0; j < gen->chans; j++)
- memset((void *)(gen->obufs[j]), 0, clm_file_buffer_size * sizeof(mus_float_t));
+ clear_floats(gen->obufs[j], clm_file_buffer_size);
gen->data_start = samp;
gen->data_end = samp + clm_file_buffer_size - 1;
gen->obufs[chan][0] += val;
@@ -11811,23 +11810,23 @@ static mus_any *locs_copy(mus_any *ptr)
if (p->outn)
{
g->outn = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->outn), (void *)(p->outn), bytes);
+ copy_floats(g->outn, p->outn, g->chans);
}
if (p->outf)
{
g->outf = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->outf), (void *)(p->outf), bytes);
+ copy_floats(g->outf, p->outf, g->chans);
}
bytes = g->rev_chans * sizeof(mus_float_t);
if (p->revn)
{
g->revn = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->revn), (void *)(p->revn), bytes);
+ copy_floats(g->revn, p->revn, g->rev_chans);
}
if (p->revf)
{
g->revf = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->revf), (void *)(p->revf), bytes);
+ copy_floats(g->revf, p->revf, g->rev_chans);
}
return((mus_any *)g);
}
@@ -11856,8 +11855,8 @@ void mus_locsig_set_detour(mus_any *ptr, void (*detour)(mus_any *ptr, mus_long_t
static void locsig_reset(mus_any *ptr)
{
locs *gen = (locs *)ptr;
- if (gen->outn) memset((void *)(gen->outn), 0, gen->chans * sizeof(mus_float_t));
- if (gen->revn) memset((void *)(gen->revn), 0, gen->rev_chans * sizeof(mus_float_t));
+ if (gen->outn) clear_floats(gen->outn, gen->chans);
+ if (gen->revn) clear_floats(gen->revn, gen->rev_chans);
}
@@ -12464,11 +12463,11 @@ void mus_move_locsig(mus_any *ptr, mus_float_t degree, mus_float_t distance)
if (gen->rev_chans > 0)
{
if (gen->rev_chans > 2)
- memset((void *)(gen->revn), 0, gen->rev_chans * sizeof(mus_float_t));
+ clear_floats(gen->revn, gen->rev_chans);
mus_locsig_fill(gen->revn, gen->rev_chans, degree, (gen->reverb * sqrt(dist)), gen->type);
}
if (gen->chans > 2)
- memset((void *)(gen->outn), 0, gen->chans * sizeof(mus_float_t));
+ clear_floats(gen->outn, gen->chans);
mus_locsig_fill(gen->outn, gen->chans, degree, dist, gen->type);
}
@@ -12606,13 +12605,13 @@ static mus_any *dloc_copy(mus_any *ptr)
{
bytes = p->out_channels * sizeof(mus_float_t);
g->outf = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->outf), (void *)(p->outf), bytes);
+ copy_floats(g->outf, p->outf, p->out_channels);
}
if (p->revf)
{
bytes = p->rev_channels * sizeof(mus_float_t);
g->revf = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->revf), (void *)(p->revf), bytes);
+ copy_floats(g->revf, p->revf, p->rev_channels);
}
g->free_arrays = true;
@@ -12998,13 +12997,13 @@ static mus_any *sr_copy(mus_any *ptr)
bytes = (2 * g->lim + 1) * sizeof(mus_float_t);
g->data = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->data), (void *)(p->data), bytes);
+ copy_floats(g->data, p->data, 2 * g->lim + 1);
if (p->coeffs)
{
bytes = p->lim * sizeof(mus_float_t);
g->coeffs = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->coeffs), (void *)(p->coeffs), bytes);
+ copy_floats(g->coeffs, p->coeffs, p->lim);
}
return((mus_any *)g);
}
@@ -13038,7 +13037,7 @@ static mus_float_t *src_sinc_table(mus_any *rd) {return(((sr *)rd)->sinc_table);
static void src_reset(mus_any *ptr)
{
sr *gen = (sr *)ptr;
- memset((void *)(gen->data), 0, (gen->lim + 1) * sizeof(mus_float_t));
+ clear_floats(gen->data, gen->lim + 1);
gen->x = 0.0;
/* center the data if possible */
if (gen->feeder)
@@ -13623,13 +13622,13 @@ static mus_any *grn_info_copy(mus_any *ptr)
bytes = g->out_data_len * sizeof(mus_float_t);
g->out_data = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->out_data), (void *)(p->out_data), bytes);
+ copy_floats(g->out_data, p->out_data, g->out_data_len);
bytes = g->in_data_len * sizeof(mus_float_t);
g->in_data = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->in_data), (void *)(p->in_data), bytes);
+ copy_floats(g->in_data, p->in_data, g->in_data_len);
g->grain = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->grain), (void *)(p->grain), bytes);
+ copy_floats(g->grain, p->grain, g->in_data_len);
return((mus_any *)g);
}
@@ -13694,9 +13693,9 @@ static void grn_reset(mus_any *ptr)
grn_info *gen = (grn_info *)ptr;
gen->cur_out = 0;
gen->ctr = 0;
- memset((void *)(gen->out_data), 0, gen->out_data_len * sizeof(mus_float_t));
- memset((void *)(gen->in_data), 0, gen->in_data_len * sizeof(mus_float_t));
- memset((void *)(gen->grain), 0, gen->in_data_len * sizeof(mus_float_t));
+ clear_floats(gen->out_data, gen->out_data_len);
+ clear_floats(gen->in_data, gen->in_data_len);
+ clear_floats(gen->grain, gen->in_data_len);
gen->first_samp = true;
}
@@ -13844,7 +13843,7 @@ mus_float_t mus_granulate_with_editor(mus_any *ptr, mus_float_t (*input)(void *a
if (spd->cur_out >= spd->out_data_len)
{
/* entire buffer has been output, and in fact we've been sending 0's for awhile to fill out hop */
- memset((void *)(spd->out_data), 0, spd->out_data_len * sizeof(mus_float_t)); /* so zero the entire thing (it's all old) */
+ clear_floats(spd->out_data, spd->out_data_len); /* so zero the entire thing (it's all old) */
}
else
{
@@ -13852,7 +13851,7 @@ mus_float_t mus_granulate_with_editor(mus_any *ptr, mus_float_t (*input)(void *a
int good_samps;
good_samps = (spd->out_data_len - spd->cur_out);
memmove((void *)(spd->out_data), (void *)(spd->out_data + spd->cur_out), good_samps * sizeof(mus_float_t));
- memset((void *)(spd->out_data + good_samps), 0, spd->cur_out * sizeof(mus_float_t)); /* must be cur_out trailing samples to 0 */
+ clear_floats(spd->out_data + good_samps, spd->cur_out); /* must be cur_out trailing samples to 0 */
}
/* align input buffer */
@@ -13898,7 +13897,7 @@ mus_float_t mus_granulate_with_editor(mus_any *ptr, mus_float_t (*input)(void *a
else
{
if (lim < spd->grain_len)
- memset((void *)(spd->grain), 0, (spd->grain_len - lim) * sizeof(mus_float_t));
+ clear_floats(spd->grain, spd->grain_len - lim);
}
if (spd->rmp > 0)
{
@@ -13926,7 +13925,7 @@ mus_float_t mus_granulate_with_editor(mus_any *ptr, mus_float_t (*input)(void *a
{
/* ramp is 0.0, so just scale the input buffer by the current amp */
if (spd->amp == 1.0)
- memcpy((void *)(spd->grain), (void *)(spd->in_data + curstart), lim * sizeof(mus_float_t));
+ copy_floats(spd->grain, spd->in_data + curstart, lim);
else
{
for (i = 0, j = curstart; i < lim; i++, j++)
@@ -14882,7 +14881,7 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
}
else
{
- memcpy((void *)window, (void *)rl, size * sizeof(mus_float_t));
+ copy_floats(window, rl, size);
}
free(rl);
@@ -14952,7 +14951,7 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
}
else
{
- memcpy((void *)window, (void *)rl, size * sizeof(mus_float_t));
+ copy_floats(window, rl, size);
}
free(rl);
free(im);
@@ -15010,7 +15009,7 @@ mus_float_t *mus_spectrum(mus_float_t *rdat, mus_float_t *idat, mus_float_t *win
for (i = 0; i < n; i++)
rdat[i] *= window[i];
}
- memset((void *)idat, 0, n * sizeof(mus_float_t));
+ clear_floats(idat, n);
mus_fft(rdat, idat, n, 1);
lowest = 0.000001;
@@ -15062,7 +15061,7 @@ mus_float_t *mus_autocorrelate(mus_float_t *data, mus_long_t n)
mus_fft(data, im, n, 1);
for (i = 0; i < n; i++)
data[i] = data[i] * data[i] + im[i] * im[i];
- memset((void *)im, 0, n * sizeof(mus_float_t));
+ clear_floats(im, n);
mus_fft(data, im, n, -1);
for (i = 0; i <= n2; i++)
@@ -15121,7 +15120,7 @@ mus_float_t *mus_cepstrum(mus_float_t *data, mus_long_t n)
rl = (mus_float_t *)malloc(n * sizeof(mus_float_t));
im = (mus_float_t *)calloc(n, sizeof(mus_float_t));
- memcpy((void *)rl, (void *)data, n * sizeof(mus_float_t));
+ copy_floats(rl, data, n);
mus_fft(rl, im, n, 1);
@@ -15132,7 +15131,7 @@ mus_float_t *mus_cepstrum(mus_float_t *data, mus_long_t n)
rl[i] = -10.0;
else rl[i] = log(sqrt(rl[i]));
}
- memset((void *)im, 0, n * sizeof(mus_float_t));
+ clear_floats(im, n);
mus_fft(rl, im, n, -1);
@@ -15240,11 +15239,11 @@ static mus_any *conv_copy(mus_any *ptr)
memcpy((void *)g, (void *)ptr, sizeof(conv));
bytes = g->fftsize * sizeof(mus_float_t);
g->rl1 = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->rl1), (void *)(p->rl1), bytes);
+ copy_floats(g->rl1, p->rl1, g->fftsize);
g->rl2 = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->rl2), (void *)(p->rl2), bytes);
+ copy_floats(g->rl2, p->rl2, g->fftsize);
g->buf = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->buf), (void *)(p->buf), bytes);
+ copy_floats(g->buf, p->buf, g->fftsize);
return((mus_any *)g);
}
@@ -15259,9 +15258,9 @@ static void convolve_reset(mus_any *ptr)
{
conv *gen = (conv *)ptr;
gen->ctr = gen->fftsize2;
- memset((void *)(gen->rl1), 0, gen->fftsize * sizeof(mus_float_t));
- memset((void *)(gen->rl2), 0, gen->fftsize * sizeof(mus_float_t));
- memset((void *)(gen->buf), 0, gen->fftsize * sizeof(mus_float_t));
+ clear_floats(gen->rl1, gen->fftsize);
+ clear_floats(gen->rl2, gen->fftsize);
+ clear_floats(gen->buf, gen->fftsize);
}
@@ -15297,18 +15296,15 @@ mus_float_t mus_convolve(mus_any *ptr, mus_float_t (*input)(void *arg, int direc
if (gen->ctr >= gen->fftsize2)
{
mus_long_t i, N;
- size_t bytes;
-
N = gen->fftsize2;
- bytes = N * sizeof(mus_float_t);
if (input) {gen->feeder = input; gen->block_feeder = NULL;}
- memset((void *)(gen->rl2), 0, bytes * 2);
- memcpy((void *)(gen->rl2), (void *)(gen->filter), gen->filtersize * sizeof(mus_float_t));
+ clear_floats(gen->rl2, N * 2);
+ copy_floats(gen->rl2, gen->filter, gen->filtersize);
- memcpy((void *)(gen->buf), (void *)(gen->buf + N), bytes);
- memset((void *)(gen->buf + N), 0, bytes);
- memset((void *)(gen->rl1 + N), 0, bytes);
+ copy_floats(gen->buf, gen->buf + N, N);
+ clear_floats(gen->buf + N, N);
+ clear_floats(gen->rl1 + N, N);
if (gen->block_feeder)
gen->block_feeder(gen->closure, 1, gen->rl1, 0, N);
@@ -15328,7 +15324,7 @@ mus_float_t mus_convolve(mus_any *ptr, mus_float_t (*input)(void *arg, int direc
gen->buf[i] += gen->rl1[i]; i++;
gen->buf[i] += gen->rl1[i]; i++;
}
- memcpy((void *)(gen->buf + N), (void *)(gen->rl1 + N), bytes);
+ copy_floats(gen->buf + N, gen->rl1 + N, N);
gen->ctr = 0;
}
result = gen->buf[gen->ctr];
@@ -15457,8 +15453,8 @@ void mus_convolve_files(const char *file1, const char *file2, mus_float_t maxamp
c2++;
if (c2 >= file2_chans) c2 = 0;
- memset((void *)data1, 0, fftlen * sizeof(mus_float_t));
- memset((void *)data2, 0, fftlen * sizeof(mus_float_t));
+ clear_floats(data1, fftlen);
+ clear_floats(data2, fftlen);
}
for (i = 0; i < totallen; i++)
@@ -15569,26 +15565,26 @@ static mus_any *pv_info_copy(mus_any *ptr)
bytes = p->N * sizeof(mus_float_t);
g->freqs = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->freqs), (void *)(p->freqs), bytes);
+ copy_floats(g->freqs, p->freqs, p->N);
g->ampinc = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->ampinc), (void *)(p->ampinc), bytes);
+ copy_floats(g->ampinc, p->ampinc, p->N);
g->win = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->win), (void *)(p->win), bytes);
+ copy_floats(g->win, p->win, p->N);
if (p->in_data)
{
g->in_data = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->in_data), (void *)(p->in_data), bytes);
+ copy_floats(g->in_data, p->in_data, p->N);
}
bytes = (p->N / 2) * sizeof(mus_float_t);
g->amps = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->amps), (void *)(p->amps), bytes);
+ copy_floats(g->amps, p->amps, p->N / 2);
g->phases = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->phases), (void *)(p->phases), bytes);
+ copy_floats(g->phases, p->phases, p->N / 2);
g->lastphase = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->lastphase), (void *)(p->lastphase), bytes);
+ copy_floats(g->lastphase, p->lastphase, p->N / 2);
g->phaseinc = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->phaseinc), (void *)(p->phaseinc), bytes);
+ copy_floats(g->phaseinc, p->phaseinc, p->N / 2);
#if HAVE_SINCOS
bytes = (p->N / 2) * sizeof(int);
@@ -15644,12 +15640,12 @@ static void pv_reset(mus_any *ptr)
gen->in_data = NULL;
gen->outctr = gen->interp;
gen->filptr = 0;
- memset((void *)(gen->ampinc), 0, gen->N * sizeof(mus_float_t));
- memset((void *)(gen->freqs), 0, gen->N * sizeof(mus_float_t));
- memset((void *)(gen->amps), 0, (gen->N / 2) * sizeof(mus_float_t));
- memset((void *)(gen->phases), 0, (gen->N / 2) * sizeof(mus_float_t));
- memset((void *)(gen->lastphase), 0, (gen->N / 2) * sizeof(mus_float_t));
- memset((void *)(gen->phaseinc), 0, (gen->N / 2) * sizeof(mus_float_t));
+ clear_floats(gen->ampinc, gen->N);
+ clear_floats(gen->freqs, gen->N);
+ clear_floats(gen->amps, gen->N / 2);
+ clear_floats(gen->phases, gen->N / 2);
+ clear_floats(gen->lastphase, gen->N / 2);
+ clear_floats(gen->phaseinc, gen->N / 2);
}
@@ -15714,8 +15710,8 @@ mus_any *mus_make_phase_vocoder(mus_float_t (*input)(void *arg, int direction),
pv->outctr = interp;
pv->filptr = 0;
pv->pitch = pitch;
- pv->ampinc = (mus_float_t *)malloc(fftsize * sizeof(mus_float_t));
- pv->freqs = (mus_float_t *)malloc(fftsize * sizeof(mus_float_t));
+ pv->ampinc = (mus_float_t *)calloc(fftsize, sizeof(mus_float_t));
+ pv->freqs = (mus_float_t *)calloc(fftsize, sizeof(mus_float_t));
pv->amps = (mus_float_t *)calloc(N2, sizeof(mus_float_t));
pv->phases = (mus_float_t *)calloc(N2, sizeof(mus_float_t));
pv->lastphase = (mus_float_t *)calloc(N2, sizeof(mus_float_t));
@@ -15732,7 +15728,7 @@ mus_any *mus_make_phase_vocoder(mus_float_t (*input)(void *arg, int direction),
if ((fftsize == pv_last_fftsize) && (pv_last_window))
{
pv->win = (mus_float_t *)malloc(fftsize * sizeof(mus_float_t));
- memcpy((void *)(pv->win), (const void *)pv_last_window, fftsize * sizeof(mus_float_t));
+ copy_floats(pv->win, pv_last_window, fftsize);
}
else
{
@@ -15745,7 +15741,7 @@ mus_any *mus_make_phase_vocoder(mus_float_t (*input)(void *arg, int direction),
scl = 2.0 / (0.54 * (mus_float_t)fftsize);
for (i = 0; i < fftsize; i++)
pv->win[i] *= scl;
- memcpy((void *)pv_last_window, (const void *)(pv->win), fftsize * sizeof(mus_float_t));
+ copy_floats(pv_last_window, pv->win, fftsize);
}
#if HAVE_SINCOS
@@ -15753,10 +15749,10 @@ mus_any *mus_make_phase_vocoder(mus_float_t (*input)(void *arg, int direction),
* in Linux at least, sincos is faster than sin+sin -- in my timing tests, although
* callgrind is crazy, the actual runtimes are about 25% faster (sincos vs sin+sin).
*/
- pv->cs = (double *)malloc(fftsize * sizeof(double));
- pv->sn = (double *)malloc(fftsize * sizeof(double));
+ pv->cs = (double *)calloc(fftsize, sizeof(double));
+ pv->sn = (double *)calloc(fftsize, sizeof(double));
pv->sc_safe = (bool *)calloc(fftsize, sizeof(bool));
- pv->indices = (int *)malloc(N2 * sizeof(int));
+ pv->indices = (int *)calloc(N2, sizeof(int));
#endif
return((mus_any *)pv);
}
@@ -15791,7 +15787,7 @@ mus_float_t mus_phase_vocoder_with_editors(mus_any *ptr,
((*pv_analyze)(pv->closure, pv->input)))
{
int buf;
- memset((void *)(pv->freqs), 0, pv->N * sizeof(mus_float_t));
+ clear_floats(pv->freqs, pv->N);
if (!pv->in_data)
{
pv->in_data = (mus_float_t *)malloc(pv->N * sizeof(mus_float_t));
@@ -15840,8 +15836,28 @@ mus_float_t mus_phase_vocoder_with_editors(mus_any *ptr,
mus_float_t diff;
diff = pv->freqs[i] - pv->lastphase[i];
pv->lastphase[i] = pv->freqs[i];
- while (diff > M_PI) diff -= TWO_PI;
- while (diff < -M_PI) diff += TWO_PI;
+
+ /* this used to be two while loops adding/subtracting two pi, but that can get into an infinite loop
+ * while (diff > M_PI) diff -= TWO_PI;
+ * while (diff < -M_PI) diff += TWO_PI;
+ * (anything to avoid fmod!)
+ */
+ if (diff > M_PI)
+ {
+ diff -= TWO_PI;
+ if (diff > M_PI)
+ diff = fmod(diff, TWO_PI);
+ }
+ if (diff < -M_PI)
+ {
+ diff += TWO_PI;
+ if (diff < -M_PI)
+ {
+ diff = fmod(diff, TWO_PI);
+ if (diff < -M_PI)
+ diff += TWO_PI;
+ }
+ }
pv->freqs[i] = pv->pitch * (diff * pscl + ks);
}
}
@@ -16191,7 +16207,7 @@ static mus_any *ssbam_copy(mus_any *ptr)
bytes = p->size * sizeof(mus_float_t);
g->coeffs = (mus_float_t *)malloc(bytes);
- memcpy((void *)(g->coeffs), (void *)(p->coeffs), bytes);
+ copy_floats(g->coeffs, p->coeffs, p->size);
return((mus_any *)g);
}
@@ -16387,7 +16403,7 @@ mus_any *mus_make_ssb_am(mus_float_t freq, int order)
if ((flen == ssb_am_last_flen) && (ssb_am_last_coeffs))
{
gen->coeffs = (mus_float_t *)malloc(flen * sizeof(mus_float_t));
- memcpy((void *)(gen->coeffs), (const void *)ssb_am_last_coeffs, flen * sizeof(mus_float_t));
+ copy_floats(gen->coeffs, ssb_am_last_coeffs, flen);
}
else
{
@@ -16408,7 +16424,7 @@ mus_any *mus_make_ssb_am(mus_float_t freq, int order)
if (ssb_am_last_coeffs) free(ssb_am_last_coeffs);
ssb_am_last_flen = flen;
ssb_am_last_coeffs = (mus_float_t *)malloc(flen * sizeof(mus_float_t));
- memcpy((void *)(ssb_am_last_coeffs), (const void *)(gen->coeffs), flen * sizeof(mus_float_t));
+ copy_floats(ssb_am_last_coeffs, gen->coeffs, flen);
}
gen->hilbert = mus_make_fir_filter(flen, gen->coeffs, NULL);
diff --git a/clm2xen.c b/clm2xen.c
index 553152a..63bbafc 100644
--- a/clm2xen.c
+++ b/clm2xen.c
@@ -50,6 +50,8 @@
#endif
#endif
+static Xen xen_float_zero;
+
/* -------------------------------------------------------------------------------- */
#if HAVE_SCHEME
@@ -74,9 +76,6 @@ static bool mus_simple_out_any_to_file(mus_long_t samp, mus_float_t val, int cha
struct mus_xen {
mus_any *gen;
int nvcts;
-#if HAVE_SCHEME
- bool free_data;
-#endif
Xen *vcts; /* one for each accessible mus_float_t array (wrapped up here in a vct) */
struct mus_xen *next;
};
@@ -101,22 +100,12 @@ static mus_xen *mx_alloc(int vcts)
if (vcts > 0)
p->vcts = (Xen *)malloc(vcts * sizeof(Xen));
else p->vcts = NULL;
-#if HAVE_SCHEME
- p->free_data = false;
-#endif
return(p);
}
static void mx_free(mus_xen *p)
{
-#if HAVE_SCHEME
- if (p->free_data)
- {
- s7_xf_attach(s7, (void *)(p->vcts[MUS_INPUT_DATA]));
- p->free_data = false;
- }
-#endif
p->next = mx_free_lists[p->nvcts];
mx_free_lists[p->nvcts] = p;
}
@@ -177,6 +166,18 @@ static Xen clm_mus_error(int type, const char *msg, const char *caller)
}
+#if HAVE_SCHEME
+static s7_pointer mus_error_symbol, clm_error_info;
+#define CLM_ERROR mus_error_symbol
+static void clm_error(const char *caller, const char *msg, Xen val)
+{
+ s7_list_set(s7, clm_error_info, 1, s7_make_string(s7, caller));
+ s7_list_set(s7, clm_error_info, 2, s7_make_string(s7, msg));
+ s7_list_set(s7, clm_error_info, 3, val);
+ s7_error(s7, mus_error_symbol, clm_error_info);
+}
+#else
+
#define CLM_ERROR Xen_make_error_type("mus-error")
static void clm_error(const char *caller, const char *msg, Xen val)
@@ -187,10 +188,14 @@ static void clm_error(const char *caller, const char *msg, Xen val)
C_string_to_Xen_string(msg),
val));
}
+#endif
/* ---------------- optional-key ---------------- */
+#if HAVE_SCHEME
+ static s7_pointer extra_args_string;
+#endif
int mus_optkey_unscramble(const char *caller, int nkeys, Xen *keys, Xen *args, int *orig)
{
@@ -220,8 +225,16 @@ int mus_optkey_unscramble(const char *caller, int nkeys, Xen *keys, Xen *args, i
/* type checking on the actual values has to be the caller's problem */
if (arg_ctr >= nkeys) /* we aren't handling a keyword arg, so the underlying args should only take nkeys args */
+#if HAVE_SCHEME
+ {
+ s7_list_set(s7, clm_error_info, 1, s7_make_string(s7, caller));
+ s7_list_set(s7, clm_error_info, 2, extra_args_string);
+ s7_list_set(s7, clm_error_info, 3, key);
+ s7_error(s7, mus_error_symbol, clm_error_info);
+ }
+#else
clm_error(caller, "extra trailing args?", key);
-
+#endif
keys[arg_ctr] = key;
orig[arg_ctr] = arg_ctr + 1;
arg_ctr++;
@@ -934,35 +947,6 @@ data in " S_vct "s rl and im from polar (spectrum) to rectangular (fft)"
return(g_fft_window_1(G_POLAR_RECTANGULAR, val1, val2, Xen_undefined, S_polar_to_rectangular));
}
-#if HAVE_SCHEME
-#if (!WITH_GMP)
-#define PF2_TO_PF(CName, Cfnc) \
- static s7_pointer CName ## _pf_a(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pf_t f; \
- s7_pointer x, y; \
- f = (s7_pf_t)(**p); (*p)++; \
- x = f(sc, p); \
- f = (s7_pf_t)(**p); (*p)++; \
- y = f(sc, p); \
- return(Cfnc); \
- } \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) \
- { \
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) && \
- (s7_arg_to_pf(sc, s7_cadr(expr))) && \
- (s7_arg_to_pf(sc, s7_caddr(expr)))) \
- return(CName ## _pf_a); \
- return(NULL); \
- }
-
-PF2_TO_PF(rectangular_to_polar, g_rectangular_to_polar(x, y))
-PF2_TO_PF(polar_to_rectangular, g_polar_to_rectangular(x, y))
-PF2_TO_PF(rectangular_to_magnitudes, g_rectangular_to_magnitudes(x, y))
-#endif
-#endif
-
-
static Xen g_mus_fft(Xen url, Xen uim, Xen len, Xen usign)
{
#define H_mus_fft "(" S_mus_fft " rl im (len) (dir 1)): return the fft of " S_vct "s rl and im which contain \
@@ -1331,17 +1315,6 @@ static Xen_object_mark_t mark_mus_xen(Xen obj)
int i, lim;
lim = MUS_SELF_WRAPPER;
if (ms->nvcts < lim) lim = ms->nvcts;
-#if HAVE_SCHEME
- if (ms->free_data) /* set if rf functions are using these two vct slots */
- {
- for (i = 0; i < lim; i++)
- if ((i != MUS_INPUT_FUNCTION) &&
- (i != MUS_INPUT_DATA) &&
- (Xen_is_bound(ms->vcts[i])))
- xen_gc_mark(ms->vcts[i]);
- return;
- }
-#endif
for (i = 0; i < lim; i++)
if (Xen_is_bound(ms->vcts[i]))
xen_gc_mark(ms->vcts[i]);
@@ -1662,9 +1635,11 @@ static Xen g_mus_reset(Xen gen)
if (s7_is_float_vector(gen))
{
s7_int len;
- len = s7_vector_length(gen);
- if (len > 0)
- memset((void *)s7_float_vector_elements(gen), 0, len * sizeof(s7_double));
+ s7_double *dst;
+ dst = s7_float_vector_elements(gen);
+ /* memset((void *)s7_float_vector_elements(gen), 0, len * sizeof(s7_double)); */
+ for (len = s7_vector_length(gen); len > 0; len--)
+ *dst++ = 0.0;
return(gen);
}
{
@@ -2435,7 +2410,34 @@ static Xen g_mus_set_length(Xen gen, Xen val)
return(val);
}
-
+#if HAVE_SCHEME && (!WITH_GMP)
+#define D_METHOD(Func) \
+ static s7_double mus_ ## Func ## _dp(s7_pointer o) \
+ { \
+ return(mus_ ## Func(Xen_to_mus_any(o))); \
+ }
+D_METHOD(scaler)
+D_METHOD(phase)
+D_METHOD(frequency)
+D_METHOD(offset)
+D_METHOD(width)
+D_METHOD(increment)
+D_METHOD(feedforward)
+D_METHOD(feedback)
+
+#define I_METHOD(Func) \
+ static s7_int mus_ ## Func ## _ip(s7_pointer o) \
+ { \
+ return(mus_ ## Func(Xen_to_mus_any(o))); \
+ }
+I_METHOD(length)
+I_METHOD(order)
+I_METHOD(location)
+I_METHOD(channel)
+I_METHOD(channels)
+I_METHOD(ramp)
+I_METHOD(hop)
+#endif
@@ -2487,7 +2489,6 @@ static Xen g_make_oscil(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
static Xen g_oscil(Xen osc, Xen fm, Xen pm)
{
#define H_oscil "(" S_oscil " gen (fm 0.0) (pm 0.0)): next sample from " S_oscil " gen: val = sin(phase + pm); phase += (freq + fm)"
- #define Q_oscil s7_make_circular_signature(s7, 2, 3, s7_make_symbol(s7, "float?"), s7_make_symbol(s7, S_is_oscil), s7_make_symbol(s7, "real?"))
mus_float_t fm1;
mus_any *g = NULL;
@@ -2756,7 +2757,7 @@ static Xen g_make_delay_1(xclm_delay_t choice, Xen arglist)
for (i = 0; i < max_size; i++)
line[i] = initial_element;
}
- else memset((void *)line, 0, max_size * sizeof(mus_float_t));
+ else clear_floats(line, max_size);
}
else
{
@@ -2984,7 +2985,7 @@ static Xen g_make_moving_any(xclm_moving_t choice, const char *caller, Xen argli
line[i] = initial_element;
sum = initial_element * size;
}
- else memset((void *)line, 0, size * sizeof(mus_float_t));
+ else clear_floats(line, size);
}
else
{
@@ -4898,7 +4899,7 @@ static Xen g_pink_noise(Xen gens)
v = Xen_to_vct(gens);
size = mus_vct_length(v);
if (size == 0)
- return(XEN_ZERO); /* needs to be upper case for Forth/Ruby */
+ return(xen_float_zero);
Xen_check_type((size & 1) == 0, gens, 1, S_pink_noise, "an even length " S_vct);
return(C_double_to_Xen_real(mus_pink_noise(v)));
@@ -4923,6 +4924,13 @@ static Xen g_piano_noise(Xen gen, XEN amp)
return(C_double_to_Xen_real(piano_noise(s7_int_vector_elements(gen), Xen_real_to_C_double(amp))));
}
+#if (!WITH_GMP)
+static s7_double piano_noise_d_pd(s7_pointer v, s7_double x)
+{
+ return(piano_noise(s7_int_vector_elements(v), x));
+}
+#endif
+
#define S_singer_filter "singer-filter"
static Xen g_singer_filter(Xen start, Xen end, Xen tmp, Xen dline1, Xen dline2, Xen coeffs)
@@ -5987,7 +5995,7 @@ static Xen g_make_rxyk(bool sin_case, const char *caller, Xen arglist)
static Xen g_make_rxyksin(Xen arglist)
{
- #define H_make_rxyksin "(" S_make_rxyksin " (frequency *clm-default-frequency*) (initial-phase 0.0) (ratio 1.0) (r 0.5)): \
+ #define H_make_rxyksin "(" S_make_rxyksin " (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5)): \
return a new rxyksin generator."
return(g_make_rxyk(true, S_make_rxyksin, arglist));
@@ -5995,7 +6003,7 @@ return a new rxyksin generator."
static Xen g_make_rxykcos(Xen arglist)
{
- #define H_make_rxykcos "(" S_make_rxykcos " (frequency *clm-default-frequency*) (initial-phase 0.0) (ratio 1.0) (r 0.5)): \
+ #define H_make_rxykcos "(" S_make_rxykcos " (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5)): \
return a new rxykcos generator."
return(g_make_rxyk(false, S_make_rxykcos, arglist));
@@ -6521,7 +6529,7 @@ static Xen g_envelope_interp(Xen ux, Xen e, Xen ubase)
Xen_check_type(Xen_is_list(e), e, 2, S_envelope_interp, "a list");
if (Xen_is_null(e))
- return(Xen_integer_zero);
+ return(xen_float_zero);
x = Xen_real_to_C_double(ux);
if (Xen_is_bound(ubase)) base = Xen_real_to_C_double(ubase);
@@ -6669,29 +6677,18 @@ static Xen g_is_frample_to_file(Xen obj)
static mus_float_t (*in_any_2)(mus_long_t pos, int chn);
#endif
-static Xen g_in_any_1(const char *caller, Xen frample, int in_chan, Xen inp)
+static mus_float_t in_any_3(const char *caller, mus_long_t pos, int in_chan, Xen inp)
{
- mus_long_t pos;
-
- Xen_check_type(Xen_is_integer(frample), frample, 1, caller, "an integer");
-
- pos = Xen_llong_to_C_llong(frample);
- if (pos < 0)
- Xen_out_of_range_error(caller, 1, frample, "location should be >= 0");
-
- if (in_chan < 0)
- Xen_out_of_range_error(caller, 2, C_int_to_Xen_integer(in_chan), "must be >= 0");
-
#if HAVE_SCHEME
- if (Xen_is_false(inp)) return(C_double_to_Xen_real(0.0)); /* ws.scm default for *clm-reverb* is #f */
+ if (Xen_is_false(inp)) return(0.0); /* ws.scm default for *clm-reverb* is #f */
if (inp == CLM_REVERB)
- return(s7_make_real(s7, in_any_2(pos, in_chan)));
+ return(in_any_2(pos, in_chan));
#endif
if (mus_is_xen(inp))
{
Xen_check_type(mus_is_input(Xen_to_mus_any(inp)), inp, 3, caller, "an input generator");
- return(C_double_to_Xen_real(mus_in_any(pos, in_chan, (mus_any *)Xen_to_mus_any(inp))));
+ return(mus_in_any(pos, in_chan, (mus_any *)Xen_to_mus_any(inp)));
}
if (mus_is_vct(inp))
@@ -6699,29 +6696,51 @@ static Xen g_in_any_1(const char *caller, Xen frample, int in_chan, Xen inp)
#if HAVE_SCHEME
if (pos < s7_vector_length(inp))
{
+ s7_double *els;
+ els = s7_float_vector_elements(inp);
if (s7_vector_rank(inp) > 1)
- return(s7_vector_ref_n(s7, inp, 2, in_chan, pos));
- return(s7_vector_ref(s7, inp, pos));
+ {
+ s7_int *offsets;
+ offsets = s7_vector_offsets(inp);
+ return(els[in_chan * offsets[0] + pos]);
+ }
+ return(els[pos]);
}
- return(C_double_to_Xen_real(0.0));
+ return(0.0);
#else
vct *v;
mus_float_t *vdata;
v = Xen_to_vct(inp);
vdata = mus_vct_data(v);
if (pos < mus_vct_length(v))
- return(C_double_to_Xen_real(vdata[pos]));
- return(C_double_to_Xen_real(0.0));
+ return(vdata[pos]);
+ return(0.0);
#endif
}
if (Xen_is_vector(inp))
{
if (pos < Xen_vector_length(inp))
- return(Xen_vector_ref(inp, pos));
+ return(Xen_real_to_C_double(Xen_vector_ref(inp, pos)));
}
- return(C_double_to_Xen_real(0.0));
+ return(0.0);
+}
+
+static Xen g_in_any_1(const char *caller, Xen frample, int in_chan, Xen inp)
+{
+ mus_long_t pos;
+
+ Xen_check_type(Xen_is_integer(frample), frample, 1, caller, "an integer");
+
+ pos = Xen_llong_to_C_llong(frample);
+ if (pos < 0)
+ Xen_out_of_range_error(caller, 1, frample, "location should be >= 0");
+
+ if (in_chan < 0)
+ Xen_out_of_range_error(caller, 2, C_int_to_Xen_integer(in_chan), "must be >= 0");
+
+ return(C_double_to_Xen_real(in_any_3(caller, pos, in_chan, inp)));
}
@@ -6760,7 +6779,7 @@ static Xen fallback_out_any_2(Xen outp, mus_long_t pos, mus_float_t inv, int chn
{
/* mus_out_any will check the writer so output_p is pointless */
mus_out_any(pos, inv, chn, mus_xen_to_mus_any(gn));
- return(Xen_integer_zero);
+ return(xen_float_zero);
}
if (mus_is_vct(outp))
@@ -6787,7 +6806,7 @@ static Xen fallback_out_any_2(Xen outp, mus_long_t pos, mus_float_t inv, int chn
vdata[pos] += inv;
}
#endif
- return(Xen_integer_zero);
+ return(xen_float_zero);
}
if (Xen_is_vector(outp))
@@ -6796,7 +6815,7 @@ static Xen fallback_out_any_2(Xen outp, mus_long_t pos, mus_float_t inv, int chn
Xen_vector_set(outp, pos, C_double_to_Xen_real(Xen_real_to_C_double(Xen_vector_ref(outp, pos)) + inv));
}
- return(Xen_integer_zero);
+ return(xen_float_zero);
}
#if HAVE_SCHEME
@@ -6813,14 +6832,14 @@ static vct *clm_output_vct;
static Xen out_any_2_to_mus_xen(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
{
mus_out_any(pos, inv, chn, clm_output_gen);
- return(xen_zero);
+ return(xen_float_zero);
}
static Xen safe_out_any_2_to_mus_xen(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
{
if (!mus_simple_out_any_to_file(pos, inv, chn, clm_output_gen))
mus_safe_out_any_to_file(pos, inv, chn, clm_output_gen);
- return(xen_zero);
+ return(xen_float_zero);
}
@@ -6853,7 +6872,7 @@ static Xen out_any_2_to_vct(mus_long_t pos, mus_float_t inv, int chn, const char
}
}
#endif
- return(xen_zero);
+ return(xen_float_zero);
}
@@ -6861,12 +6880,12 @@ static Xen out_any_2_to_vector(mus_long_t pos, mus_float_t inv, int chn, const c
{
if (pos < Xen_vector_length(CLM_OUTPUT))
Xen_vector_set(CLM_OUTPUT, pos, C_double_to_Xen_real(Xen_real_to_C_double(Xen_vector_ref(CLM_OUTPUT, pos)) + inv));
- return(xen_zero);
+ return(xen_float_zero);
}
static Xen out_any_2_no_op(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
{
- return(xen_zero);
+ return(xen_float_zero);
}
static s7_pointer g_clm_output_set(s7_scheme *sc, s7_pointer args)
@@ -7066,7 +7085,6 @@ static Xen g_outa(Xen frample, Xen val, Xen outp)
return(g_out_any_1(S_outa, frample, 0, val, outp));
}
-
static Xen g_outb(Xen frample, Xen val, Xen outp)
{
#define H_outb "(" S_outb " frample val stream): add val to output stream at frample in channel 1"
@@ -8196,42 +8214,6 @@ static mus_float_t as_needed_input_func(void *ptr, int direction) /* intended fo
return(0.0);
}
-#if HAVE_SCHEME
-static mus_float_t as_needed_input_rf(void *ptr, int direction)
-{
- mus_xen *gn = (mus_xen *)ptr;
- if (gn)
- {
- s7_rf_t rf;
- s7_pointer *top, *p;
- rf = (s7_rf_t)(gn->vcts[MUS_INPUT_FUNCTION]);
- top = s7_xf_top(s7, (void *)(gn->vcts[MUS_INPUT_DATA]));
- p = top;
- return(rf(s7, &p));
- }
- return(0.0);
-}
-
-static mus_float_t as_needed_block_input_rf(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
-{
- mus_xen *gn = (mus_xen *)ptr;
- if (gn)
- {
- mus_long_t i;
- s7_rf_t rf;
- s7_pointer *top, *p;
- rf = (s7_rf_t)(gn->vcts[MUS_INPUT_FUNCTION]);
- top = s7_xf_top(s7, (void *)(gn->vcts[MUS_INPUT_DATA]));
- for (i = start; i < end; i++)
- {
- p = top;
- data[i] = rf(s7, &p);
- }
- }
- return(0.0);
-}
-#endif
-
static void set_as_needed_input_choices(mus_any *gen, Xen obj, mus_xen *gn)
{
/* fprintf(stderr, "set_as_needed_input for %s: %s\n", mus_name(gen), DISPLAY(obj)); */
@@ -8271,32 +8253,6 @@ static void set_as_needed_input_choices(mus_any *gen, Xen obj, mus_xen *gn)
}
if (s7_is_pair(res))
{
- if (s7_is_symbol(s7_car(res)))
- {
- s7_pointer fcar;
- fcar = s7_symbol_value(s7, s7_car(res));
- if (s7_rf_function(s7, fcar))
- {
- s7_rf_t rf;
- s7_pointer old_e, e;
- e = s7_sublet(s7, s7_closure_let(s7, obj), s7_nil(s7));
- old_e = s7_set_curlet(s7, e);
- s7_xf_new(s7, e);
- rf = s7_rf_function(s7, fcar)(s7, res);
- if (rf)
- {
- gn->vcts[MUS_SAVED_FUNCTION] = gn->vcts[MUS_INPUT_FUNCTION]; /* needed for GC protection */
- gn->vcts[MUS_INPUT_DATA] = (s7_pointer)s7_xf_detach(s7);
- gn->vcts[MUS_INPUT_FUNCTION] = (s7_pointer)rf;
- gn->free_data = true;
- mus_generator_set_feeders(gen, as_needed_input_rf, as_needed_block_input_rf);
- s7_set_curlet(s7, old_e);
- return;
- }
- s7_xf_free(s7);
- s7_set_curlet(s7, old_e);
- }
- }
#if USE_SND
{
s7_pointer arg;
@@ -9631,12 +9587,6 @@ Xen_wrap_no_args(g_get_internal_real_time_w, g_get_internal_real_time)
#if HAVE_SCHEME
#if (!WITH_GMP)
-#define car(E) s7_car(E)
-#define cdr(E) s7_cdr(E)
-#define cadr(E) s7_cadr(E)
-#define caddr(E) s7_caddr(E)
-#define cadddr(E) s7_cadddr(E)
-#define cadddr(E) s7_cadddr(E)
static mus_float_t mus_nsin_unmodulated(mus_any *p) {return(mus_nsin(p, 0.0));}
static mus_float_t mus_ncos_unmodulated(mus_any *p) {return(mus_ncos(p, 0.0));}
@@ -9649,2489 +9599,657 @@ static mus_float_t mus_sawtooth_wave_unmodulated(mus_any *p) {return(mus_sawtoot
static mus_float_t mus_src_simple(mus_any *p) {return(mus_src(p, 0.0, NULL));}
static mus_float_t mus_src_two(mus_any *p, mus_float_t x) {return(mus_src(p, x, NULL));}
-static mus_float_t mus_granulate_simple(mus_any *p) {return(mus_granulate_with_editor(p, NULL, NULL));}
+/* static mus_float_t mus_granulate_simple(mus_any *p) {return(mus_granulate_with_editor(p, NULL, NULL));} */
static mus_float_t mus_convolve_simple(mus_any *p) {return(mus_convolve(p, NULL));}
-static mus_float_t mus_phase_vocoder_simple(mus_any *p) {return(mus_phase_vocoder(p, NULL));}
-
-#define mus_oscil_rf mus_oscil_unmodulated
-#define mus_polywave_rf mus_polywave_unmodulated
-#define mus_ncos_rf mus_ncos_unmodulated
-#define mus_nsin_rf mus_nsin_unmodulated
-#define mus_nrxycos_rf mus_nrxycos_unmodulated
-#define mus_nrxysin_rf mus_nrxysin_unmodulated
-#define mus_rxykcos_rf mus_rxykcos_unmodulated
-#define mus_rxyksin_rf mus_rxyksin_unmodulated
-#define mus_rand_rf mus_rand_unmodulated
-#define mus_rand_interp_rf mus_rand_interp_unmodulated
-#define mus_readin_rf mus_readin
-#define mus_env_rf mus_env
-#define mus_pulsed_env_rf mus_pulsed_env_unmodulated
-#define mus_oscil_bank_rf mus_oscil_bank
-#define mus_table_lookup_rf mus_table_lookup_unmodulated
-#define mus_sawtooth_wave_rf mus_sawtooth_wave_unmodulated
-#define mus_pulse_train_rf mus_pulse_train_unmodulated
-#define mus_triangle_wave_rf mus_triangle_wave_unmodulated
-#define mus_square_wave_rf mus_square_wave_unmodulated
-#define mus_wave_train_rf mus_wave_train_unmodulated
-
-#define mus_convolve_rf mus_convolve_simple
-#define mus_src_rf mus_src_simple
-#define mus_granulate_rf mus_granulate_simple
-#define mus_phase_vocoder_rf mus_phase_vocoder_simple
-
-static mus_float_t mus_one_pole_rf(mus_any *p) {return(mus_one_pole(p, 0.0));}
-static mus_float_t mus_two_pole_rf(mus_any *p) {return(mus_two_pole(p, 0.0));}
-static mus_float_t mus_one_zero_rf(mus_any *p) {return(mus_one_zero(p, 0.0));}
-static mus_float_t mus_two_zero_rf(mus_any *p) {return(mus_two_zero(p, 0.0));}
-static mus_float_t mus_delay_rf(mus_any *p) {return(mus_delay_unmodulated(p, 0.0));}
-static mus_float_t mus_comb_rf(mus_any *p) {return(mus_comb_unmodulated(p, 0.0));}
-static mus_float_t mus_comb_bank_rf(mus_any *p) {return(mus_comb_bank(p, 0.0));}
-static mus_float_t mus_all_pass_bank_rf(mus_any *p) {return(mus_all_pass_bank(p, 0.0));}
-static mus_float_t mus_notch_rf(mus_any *p) {return(mus_notch_unmodulated(p, 0.0));}
-static mus_float_t mus_all_pass_rf(mus_any *p) {return(mus_all_pass_unmodulated(p, 0.0));}
-static mus_float_t mus_one_pole_all_pass_rf(mus_any *p) {return(mus_one_pole_all_pass(p, 0.0));}
-static mus_float_t mus_moving_average_rf(mus_any *p) {return(mus_moving_average(p, 0.0));}
-static mus_float_t mus_moving_max_rf(mus_any *p) {return(mus_moving_max(p, 0.0));}
-static mus_float_t mus_moving_norm_rf(mus_any *p) {return(mus_moving_norm(p, 0.0));}
-static mus_float_t mus_filter_rf(mus_any *p) {return(mus_filter(p, 0.0));}
-static mus_float_t mus_fir_filter_rf(mus_any *p) {return(mus_fir_filter(p, 0.0));}
-static mus_float_t mus_iir_filter_rf(mus_any *p) {return(mus_iir_filter(p, 0.0));}
-static mus_float_t mus_polyshape_rf(mus_any *p) {return(mus_polyshape_unmodulated(p, 1.0));}
-static mus_float_t mus_filtered_comb_rf(mus_any *p) {return(mus_filtered_comb_unmodulated(p, 0.0));}
-static mus_float_t mus_filtered_comb_bank_rf(mus_any *p) {return(mus_filtered_comb_bank(p, 0.0));}
-static mus_float_t mus_asymmetric_fm_rf(mus_any *p) {return(mus_asymmetric_fm_unmodulated(p, 0.0));}
-static mus_float_t mus_formant_rf(mus_any *p) {return(mus_formant(p, 0.0));}
-static mus_float_t mus_firmant_rf(mus_any *p) {return(mus_firmant(p, 0.0));}
-
-static mus_float_t mus_ssb_am_rf_1(mus_any *p) {return(mus_ssb_am(p, 0.0, 0.0));}
-
-static mus_any *cadr_gen(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer sym, o;
- mus_xen *gn;
-
- sym = s7_cadr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- if (s7_xf_is_stepper(sc, sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- return(gn->gen);
-}
-
-static s7_rf_t caddr_rf(s7_scheme *sc, s7_pointer a2, s7_rf_t func)
-{
- s7_int loc;
- s7_pointer val_sym, val;
- s7_rf_t rf;
- s7_rp_t rp;
+/* static mus_float_t mus_phase_vocoder_simple(mus_any *p) {return(mus_phase_vocoder(p, NULL));} */
- val_sym = car(a2);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- rp = s7_rf_function(sc, val);
- if (!rp) return(NULL);
- loc = s7_xf_store(sc, NULL);
- rf = rp(sc, a2);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
- return(func);
-}
+#define GEN_1(Type, Func) \
+ static bool is_ ## Type ## _b(s7_pointer p) \
+ { \
+ return((mus_is_xen(p)) && (mus_is_ ## Type(Xen_to_mus_any(p)))); \
+ } \
+ static s7_double mus_ ## Type ## _dv(void *o) \
+ { \
+ mus_xen *gn = (mus_xen *)o; \
+ return(Func(gn->gen)); \
+ } \
+ static s7_double mus_ ## Type ## _dp(s7_pointer p) \
+ { \
+ mus_xen *gn; \
+ gn = (mus_xen *)s7_object_value(p); \
+ return(Func(gn->gen)); \
+ }
-#define GEN_RF_1(Type, Func) \
- static s7_double Type ## _rf_g(s7_scheme *sc, s7_pointer **p) \
+#define GEN_2(Type, Func1, Func2) \
+ static bool is_ ## Type ## _b(s7_pointer p) \
{ \
- mus_any *g; g = (mus_any *)(**p); (*p)++; \
- return(Func(g)); \
+ return((mus_is_xen(p)) && (mus_is_ ## Type(Xen_to_mus_any(p)))); \
} \
- static s7_rf_t Type ## _rf(s7_scheme *sc, s7_pointer expr) \
+ static s7_double mus_ ## Type ## _dv(void *o) \
{ \
- mus_any *g; \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- g = cadr_gen(sc, expr); \
- if ((g) && (mus_is_ ## Type(g))) {s7_xf_store(sc, (s7_pointer)g); return(Type ## _rf_g);} \
- return(NULL); \
+ mus_xen *gn = (mus_xen *)o; \
+ return(Func1(gn->gen)); \
} \
- static s7_pointer is_ ## Type ## _pf_g(s7_scheme *sc, s7_pointer **p) \
+ static s7_double mus_ ## Type ## _dp(s7_pointer p) \
{ \
mus_xen *gn; \
- s7_pf_t pf; pf = (s7_pf_t)(**p); (*p)++; \
- gn = (mus_xen *)s7_object_value_checked(pf(sc, p), mus_xen_tag); \
- return(s7_make_boolean(sc, (gn) && (mus_is_ ## Type(gn->gen)))); \
+ gn = (mus_xen *)s7_object_value(p); \
+ return(Func1(gn->gen)); \
+ } \
+ static s7_double mus_ ## Type ## _dvd(void *o, s7_double d) \
+ { \
+ mus_xen *gn = (mus_xen *)o; \
+ return(Func2(gn->gen, d)); \
} \
- static s7_pf_t is_ ## Type ## _pf(s7_scheme *sc, s7_pointer expr) \
+ static s7_double mus_ ## Type ## _dpd(s7_pointer p, s7_double d) \
{ \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- if (s7_arg_to_pf(sc, s7_cadr(expr))) return(is_ ## Type ## _pf_g); \
- return(NULL); \
+ mus_xen *gn = (mus_xen *)s7_object_value(p); \
+ return(Func2(gn->gen, d)); \
}
-#define GEN_RF(Type, Func1, Func2) \
- static s7_double Type ## _rf_g(s7_scheme *sc, s7_pointer **p) \
- { \
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++; \
- return(Func1(g)); \
- } \
- static s7_double Type ## _rf_gr(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pointer a2; \
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++; \
- a2 = (**p); (*p)++; \
- return(Func2(g, s7_number_to_real(sc, a2))); \
- } \
- static s7_double Type ## _rf_gs(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_double a2; \
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++; \
- a2 = s7_slot_real_value(sc, **p, #Type); (*p)++; \
- return(Func2(g, a2)); \
- } \
- static s7_double Type ## _rf_gx(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_rf_t f; \
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++; \
- f = (s7_rf_t)(**p); (*p)++; \
- return(Func2(g, f(sc, p))); \
- } \
- static s7_rf_t Type ## _rf(s7_scheme *sc, s7_pointer expr) \
+#define GEN_3(Type, Func1, Func2, Func3) \
+ static bool is_ ## Type ## _b(s7_pointer p) \
+ { \
+ return((mus_is_xen(p)) && (mus_is_ ## Type(Xen_to_mus_any(p)))); \
+ } \
+ static s7_double mus_ ## Type ## _dv(void *o) \
{ \
- mus_any *g; \
- g = cadr_gen(sc, expr); \
- if ((g) && (mus_is_ ## Type(g))) \
- { \
- s7_pointer a2; \
- s7_xf_store(sc, (s7_pointer)g); \
- if (s7_is_null(sc, s7_cddr(expr))) return(Type ## _rf_g); \
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL); \
- a2 = caddr(expr); \
- if (s7_is_real(a2)) {s7_xf_store(sc, a2); return(Type ## _rf_gr);} \
- if (s7_is_symbol(a2)) \
- { \
- s7_pointer slot; \
- slot = s7_slot(sc, a2); \
- if (slot != xen_undefined) {s7_xf_store(sc, (s7_pointer)slot); return(Type ## _rf_gs);} \
- return(NULL); \
- } \
- if (s7_is_pair(a2)) \
- return(caddr_rf(sc, a2, Type ## _rf_gx)); \
- } \
- return(NULL); \
+ mus_xen *gn = (mus_xen *)o; \
+ return(Func1(gn->gen)); \
} \
- static s7_pointer is_ ## Type ## _pf_g(s7_scheme *sc, s7_pointer **p) \
+ static s7_double mus_ ## Type ## _dp(s7_pointer p) \
{ \
mus_xen *gn; \
- s7_pf_t pf; pf = (s7_pf_t)(**p); (*p)++; \
- gn = (mus_xen *)s7_object_value_checked(pf(sc, p), mus_xen_tag); \
- return(s7_make_boolean(sc, (gn) && (mus_is_ ## Type(gn->gen)))); \
+ gn = (mus_xen *)s7_object_value(p); \
+ return(Func1(gn->gen)); \
+ } \
+ static s7_double mus_ ## Type ## _dvd(void *o, s7_double d) \
+ { \
+ mus_xen *gn = (mus_xen *)o; \
+ return(Func2(gn->gen, d)); \
+ } \
+ static s7_double mus_ ## Type ## _dpd(s7_pointer p, s7_double d) \
+ { \
+ mus_xen *gn = (mus_xen *)s7_object_value(p); \
+ return(Func2(gn->gen, d)); \
} \
- static s7_pf_t is_ ## Type ## _pf(s7_scheme *sc, s7_pointer expr) \
+ static s7_double mus_ ## Type ## _dvdd(void *o, s7_double x1, s7_double x2) \
{ \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- if (s7_arg_to_pf(sc, s7_cadr(expr))) return(is_ ## Type ## _pf_g); \
- return(NULL); \
+ mus_xen *gn = (mus_xen *)o; \
+ return(Func3(gn->gen, x1, x2)); \
}
-GEN_RF(all_pass, mus_all_pass_rf, mus_all_pass_unmodulated)
-GEN_RF(asymmetric_fm, mus_asymmetric_fm_rf, mus_asymmetric_fm_unmodulated)
-GEN_RF(comb, mus_comb_rf, mus_comb_unmodulated)
-GEN_RF(comb_bank, mus_comb_bank_rf, mus_comb_bank)
-GEN_RF(all_pass_bank, mus_all_pass_bank_rf, mus_all_pass_bank)
-GEN_RF_1(convolve, mus_convolve_rf)
-GEN_RF(delay, mus_delay_rf, mus_delay_unmodulated)
-GEN_RF_1(env, mus_env_rf)
-GEN_RF(filter, mus_filter_rf, mus_filter)
-GEN_RF(filtered_comb, mus_filtered_comb_rf, mus_filtered_comb_unmodulated)
-GEN_RF(filtered_comb_bank, mus_filtered_comb_bank_rf, mus_filtered_comb_bank)
-GEN_RF(fir_filter, mus_fir_filter_rf, mus_fir_filter)
-GEN_RF(firmant, mus_firmant_rf, mus_firmant)
-GEN_RF(formant, mus_formant_rf, mus_formant)
-GEN_RF_1(granulate, mus_granulate_rf)
-GEN_RF(iir_filter, mus_iir_filter_rf, mus_iir_filter)
-GEN_RF(moving_average, mus_moving_average_rf, mus_moving_average)
-GEN_RF(moving_max, mus_moving_max_rf, mus_moving_max)
-GEN_RF(moving_norm, mus_moving_norm_rf, mus_moving_norm)
-GEN_RF(ncos, mus_ncos_rf, mus_ncos)
-GEN_RF(notch, mus_notch_rf, mus_notch_unmodulated)
-GEN_RF(nrxycos, mus_nrxycos_rf, mus_nrxycos)
-GEN_RF(nrxysin, mus_nrxysin_rf, mus_nrxysin)
-GEN_RF(nsin, mus_nsin_rf, mus_nsin)
-GEN_RF(one_pole, mus_one_pole_rf, mus_one_pole)
-GEN_RF(one_pole_all_pass, mus_one_pole_all_pass_rf, mus_one_pole_all_pass)
-GEN_RF(one_zero, mus_one_zero_rf, mus_one_zero)
-GEN_RF(oscil, mus_oscil_rf, mus_oscil_fm)
-GEN_RF_1(oscil_bank, mus_oscil_bank_rf)
-GEN_RF_1(phase_vocoder, mus_phase_vocoder_rf)
-GEN_RF(polyshape, mus_polyshape_rf, mus_polyshape_unmodulated)
-GEN_RF(polywave, mus_polywave_rf, mus_polywave)
-GEN_RF(pulse_train, mus_pulse_train_rf, mus_pulse_train)
-GEN_RF(pulsed_env, mus_pulsed_env_rf, mus_pulsed_env)
-GEN_RF(rand, mus_rand_rf, mus_rand)
-GEN_RF(rand_interp, mus_rand_interp_rf, mus_rand_interp)
-GEN_RF_1(readin, mus_readin_rf)
-GEN_RF(rxykcos, mus_rxykcos_rf, mus_rxykcos)
-GEN_RF(rxyksin, mus_rxyksin_rf, mus_rxyksin)
-GEN_RF(sawtooth_wave, mus_sawtooth_wave_rf, mus_sawtooth_wave)
-GEN_RF(square_wave, mus_square_wave_rf, mus_square_wave)
-GEN_RF(src, mus_src_rf, mus_src_two)
-GEN_RF(table_lookup, mus_table_lookup_rf, mus_table_lookup)
-GEN_RF(triangle_wave, mus_triangle_wave_rf, mus_triangle_wave)
-GEN_RF(two_pole, mus_two_pole_rf, mus_two_pole)
-GEN_RF(two_zero, mus_two_zero_rf, mus_two_zero)
-GEN_RF(wave_train, mus_wave_train_rf, mus_wave_train)
-GEN_RF(ssb_am, mus_ssb_am_rf_1, mus_ssb_am_unmodulated)
-GEN_RF(tap, mus_tap_unmodulated, mus_tap)
-
-static s7_double oscil_rf_sxx(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t rf1, rf2;
- s7_double v1, v2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- rf2 = (s7_rf_t)(**p); (*p)++;
- v2 = rf2(sc, p);
- return(mus_oscil(g, v1, v2));
-}
-
-static s7_double oscil_rf_ssx(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t rf1;
- s7_pointer s1;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- return(mus_oscil(g, s7_slot_real_value(sc, s1, S_oscil), v1));
-}
-
-static s7_double oscil_rf_sss(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1, s2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- s2 = (**p); (*p)++;
- return(mus_oscil(g, s7_slot_real_value(sc, s1, S_oscil), s7_slot_real_value(sc, s2, S_oscil)));
-}
-
-static s7_double oscil_rf_srs(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1, s2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- s2 = (**p); (*p)++;
- return(mus_oscil(g, s7_number_to_real(sc, s1), s7_slot_real_value(sc, s2, S_oscil)));
-}
-
-static s7_double oscil_rf_srx(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t rf1;
- s7_pointer s1;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- return(mus_oscil(g, s7_number_to_real(sc, s1), v1));
-}
-
-
-static s7_rf_t oscil_rf_3(s7_scheme *sc, s7_pointer expr)
-{
- mus_any *g;
- int len;
-
- len = s7_list_length(sc, expr);
- g = cadr_gen(sc, expr);
- if (!g) return(NULL);
- if (len < 4) return(oscil_rf(sc, expr));
- if (len > 5) return(NULL);
-
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, oscil_rf_srs, oscil_rf_sss, NULL, oscil_rf_srx, oscil_rf_ssx, oscil_rf_sxx));
-}
-
-
-static s7_double comb_rf_sxx(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t rf1, rf2;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- rf2 = (s7_rf_t)(**p); (*p)++;
- return(mus_comb(g, v1, rf2(sc, p)));
-}
+static mus_float_t mus_one_pole_0(mus_any *p) {return(mus_one_pole(p, 0.0));}
+static mus_float_t mus_two_pole_0(mus_any *p) {return(mus_two_pole(p, 0.0));}
+static mus_float_t mus_one_zero_0(mus_any *p) {return(mus_one_zero(p, 0.0));}
+static mus_float_t mus_two_zero_0(mus_any *p) {return(mus_two_zero(p, 0.0));}
+static mus_float_t mus_delay_0(mus_any *p) {return(mus_delay_unmodulated(p, 0.0));}
+static mus_float_t mus_comb_0(mus_any *p) {return(mus_comb_unmodulated(p, 0.0));}
+static mus_float_t mus_comb_bank_0(mus_any *p) {return(mus_comb_bank(p, 0.0));}
+static mus_float_t mus_all_pass_bank_0(mus_any *p) {return(mus_all_pass_bank(p, 0.0));}
+static mus_float_t mus_notch_0(mus_any *p) {return(mus_notch_unmodulated(p, 0.0));}
+static mus_float_t mus_all_pass_0(mus_any *p) {return(mus_all_pass_unmodulated(p, 0.0));}
+static mus_float_t mus_one_pole_all_pass_0(mus_any *p) {return(mus_one_pole_all_pass(p, 0.0));}
+static mus_float_t mus_moving_average_0(mus_any *p) {return(mus_moving_average(p, 0.0));}
+static mus_float_t mus_moving_max_0(mus_any *p) {return(mus_moving_max(p, 0.0));}
+static mus_float_t mus_moving_norm_0(mus_any *p) {return(mus_moving_norm(p, 0.0));}
+static mus_float_t mus_filter_0(mus_any *p) {return(mus_filter(p, 0.0));}
+static mus_float_t mus_fir_filter_0(mus_any *p) {return(mus_fir_filter(p, 0.0));}
+static mus_float_t mus_iir_filter_0(mus_any *p) {return(mus_iir_filter(p, 0.0));}
+static mus_float_t mus_polyshape_0(mus_any *p) {return(mus_polyshape_unmodulated(p, 1.0));}
+static mus_float_t mus_filtered_comb_0(mus_any *p) {return(mus_filtered_comb_unmodulated(p, 0.0));}
+static mus_float_t mus_filtered_comb_bank_0(mus_any *p) {return(mus_filtered_comb_bank(p, 0.0));}
+static mus_float_t mus_asymmetric_fm_0(mus_any *p) {return(mus_asymmetric_fm_unmodulated(p, 0.0));}
+static mus_float_t mus_formant_0(mus_any *p) {return(mus_formant(p, 0.0));}
+static mus_float_t mus_firmant_0(mus_any *p) {return(mus_firmant(p, 0.0));}
+static mus_float_t mus_ssb_am_0(mus_any *p) {return(mus_ssb_am(p, 0.0, 0.0));}
+
+GEN_3(all_pass, mus_all_pass_0, mus_all_pass_unmodulated, mus_all_pass)
+GEN_2(asymmetric_fm, mus_asymmetric_fm_0, mus_asymmetric_fm_unmodulated)
+GEN_3(comb, mus_comb_0, mus_comb_unmodulated, mus_comb)
+GEN_2(comb_bank, mus_comb_bank_0, mus_comb_bank)
+GEN_2(all_pass_bank, mus_all_pass_bank_0, mus_all_pass_bank)
+GEN_1(convolve, mus_convolve_simple)
+GEN_3(delay, mus_delay_0, mus_delay_unmodulated, mus_delay)
+GEN_1(env, mus_env)
+GEN_2(filter, mus_filter_0, mus_filter)
+GEN_2(filtered_comb, mus_filtered_comb_0, mus_filtered_comb_unmodulated)
+GEN_2(filtered_comb_bank, mus_filtered_comb_bank_0, mus_filtered_comb_bank)
+GEN_2(fir_filter, mus_fir_filter_0, mus_fir_filter)
+GEN_3(firmant, mus_firmant_0, mus_firmant, mus_firmant_with_frequency)
+GEN_3(formant, mus_formant_0, mus_formant, mus_formant_with_frequency)
+/* GEN_1(granulate, mus_granulate_simple) */
+GEN_2(iir_filter, mus_iir_filter_0, mus_iir_filter)
+GEN_2(moving_average, mus_moving_average_0, mus_moving_average)
+GEN_2(moving_max, mus_moving_max_0, mus_moving_max)
+GEN_2(moving_norm, mus_moving_norm_0, mus_moving_norm)
+GEN_2(ncos, mus_ncos_unmodulated, mus_ncos)
+GEN_3(notch, mus_notch_0, mus_notch_unmodulated, mus_notch)
+GEN_2(nrxycos, mus_nrxycos_unmodulated, mus_nrxycos)
+GEN_2(nrxysin, mus_nrxysin_unmodulated, mus_nrxysin)
+GEN_2(nsin, mus_nsin_unmodulated, mus_nsin)
+GEN_2(one_pole, mus_one_pole_0, mus_one_pole)
+GEN_2(one_pole_all_pass, mus_one_pole_all_pass_0, mus_one_pole_all_pass)
+GEN_2(one_zero, mus_one_zero_0, mus_one_zero)
+GEN_3(oscil, mus_oscil_unmodulated, mus_oscil_fm, mus_oscil)
+GEN_1(oscil_bank, mus_oscil_bank)
+/* GEN_1(phase_vocoder, mus_phase_vocoder_simple) */
+GEN_2(polyshape, mus_polyshape_0, mus_polyshape_unmodulated)
+GEN_2(polywave, mus_polywave_unmodulated, mus_polywave)
+GEN_2(pulse_train, mus_pulse_train_unmodulated, mus_pulse_train)
+GEN_2(pulsed_env, mus_pulsed_env_unmodulated, mus_pulsed_env)
+GEN_2(rand, mus_rand_unmodulated, mus_rand)
+GEN_2(rand_interp, mus_rand_interp_unmodulated, mus_rand_interp)
+GEN_1(readin, mus_readin)
+GEN_2(rxykcos, mus_rxykcos_unmodulated, mus_rxykcos)
+GEN_2(rxyksin, mus_rxyksin_unmodulated, mus_rxyksin)
+GEN_2(sawtooth_wave, mus_sawtooth_wave_unmodulated, mus_sawtooth_wave)
+GEN_2(square_wave, mus_square_wave_unmodulated, mus_square_wave)
+GEN_2(src, mus_src_simple, mus_src_two)
+GEN_2(table_lookup, mus_table_lookup_unmodulated, mus_table_lookup)
+GEN_2(triangle_wave, mus_triangle_wave_unmodulated, mus_triangle_wave)
+GEN_2(two_pole, mus_two_pole_0, mus_two_pole)
+GEN_2(two_zero, mus_two_zero_0, mus_two_zero)
+GEN_2(wave_train, mus_wave_train_unmodulated, mus_wave_train)
+GEN_3(ssb_am, mus_ssb_am_0, mus_ssb_am_unmodulated, mus_ssb_am)
+GEN_2(tap, mus_tap_unmodulated, mus_tap)
+
+/* convolve and phase-vocoder are omitted because their editing functions can
+ * involve loops, causing the optimizer to step on itself. Ideally, and
+ * maybe eventually, the optimized program would be sequestered, but for
+ * now these two generators will run slower. One quick fix would be to
+ * have a simple-granulate|phase-vocoder that had no internal lambdas.
+ * All we need is the name. (Also I'm assuming that if src|convolve
+ * have input functions, they won't involve loops -- here also we really
+ * need a simple version of the generator).
+ */
-static s7_double comb_rf_ssx(s7_scheme *sc, s7_pointer **p)
+static s7_double file_to_sample_dpi(s7_pointer p, s7_int index)
{
- s7_rf_t rf1;
- s7_pointer s1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- return(mus_comb(g, s7_slot_real_value(sc, s1, S_comb), rf1(sc, p)));
+ mus_any *g = NULL;
+ mus_xen *gn;
+ Xen_to_C_generator(p, gn, g, mus_is_file_to_sample, S_file_to_sample, "a file->sample generator");
+ return(mus_file_to_sample(g, index, 0));
}
-static s7_double comb_rf_sss(s7_scheme *sc, s7_pointer **p)
+static s7_double outa_did(s7_int pos, s7_double x)
{
- s7_pointer s1, s2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- s2 = (**p); (*p)++;
- return(mus_comb(g, s7_slot_real_value(sc, s1, S_comb), s7_slot_real_value(sc, s2, S_comb)));
+ out_any_2(pos, x, 0, S_outa);
+ return(x);
}
-static s7_rf_t comb_rf_3(s7_scheme *sc, s7_pointer expr)
+static s7_double outb_did(s7_int pos, s7_double x)
{
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(comb_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_comb(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, comb_rf_sss, NULL, NULL, comb_rf_ssx, comb_rf_sxx));
+ out_any_2(pos, x, 1, S_outb);
+ return(x);
}
-static s7_double notch_rf_sxx(s7_scheme *sc, s7_pointer **p)
+static s7_double outc_did(s7_int pos, s7_double x)
{
- s7_rf_t rf1, rf2;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- rf2 = (s7_rf_t)(**p); (*p)++;
- return(mus_notch(g, v1, rf2(sc, p)));
+ out_any_2(pos, x, 2, S_outc);
+ return(x);
}
-static s7_rf_t notch_rf_3(s7_scheme *sc, s7_pointer expr)
+static s7_double outd_did(s7_int pos, s7_double x)
{
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(notch_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_notch(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, NULL, NULL, NULL,NULL, notch_rf_sxx));
+ out_any_2(pos, x, 3, S_outd);
+ return(x);
}
-static s7_double delay_rf_sxx(s7_scheme *sc, s7_pointer **p)
+#if 0
+/* need s7_d_idi_t */
+static s7_double out_any_did(s7_int pos, s7_double x, s7_int i)
{
- s7_rf_t rf1, rf2;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- rf2 = (s7_rf_t)(**p); (*p)++;
- return(mus_delay(g, v1, rf2(sc, p)));
+ out_any_2(pos, x, i, S_out_any);
+ return(x);
}
+#endif
-static s7_rf_t delay_rf_3(s7_scheme *sc, s7_pointer expr)
+static s7_double ina_dip(s7_int pos, s7_pointer p)
{
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(delay_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_delay(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, NULL, NULL, NULL,NULL, delay_rf_sxx));
+ return(in_any_3(S_ina, pos, 0, p));
}
-static s7_double all_pass_rf_sxx(s7_scheme *sc, s7_pointer **p)
+static s7_double inb_dip(s7_int pos, s7_pointer p)
{
- s7_rf_t rf1, rf2;
- s7_double v1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- v1 = rf1(sc, p);
- rf2 = (s7_rf_t)(**p); (*p)++;
- return(mus_all_pass(g, v1, rf2(sc, p)));
+ return(in_any_3(S_inb, pos, 1, p));
}
-static s7_rf_t all_pass_rf_3(s7_scheme *sc, s7_pointer expr)
-{
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(all_pass_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_all_pass(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, NULL, NULL, NULL,NULL, all_pass_rf_sxx));
-}
-static s7_double ssb_am_rf_sss(s7_scheme *sc, s7_pointer **p)
+static s7_double locsig_d_vid(void *obj, s7_int ind, s7_double x)
{
- s7_pointer s1, s2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- s2 = (**p); (*p)++;
- return(mus_ssb_am(g, s7_slot_real_value(sc, s1, S_ssb_am), s7_slot_real_value(sc, s2, S_ssb_am)));
+ mus_xen *gn = (mus_xen *)obj;
+ mus_locsig(gn->gen, ind, x); /* clm.c's mus_locsig is a void func? */
+ return(x);
}
-static s7_rf_t ssb_am_rf_3(s7_scheme *sc, s7_pointer expr)
+static s7_double locsig_set_d_vid(void *obj, s7_int ind, s7_double x)
{
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(ssb_am_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_ssb_am(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, ssb_am_rf_sss, NULL, NULL, NULL, NULL));
+ mus_xen *gn = (mus_xen *)obj;
+ mus_locsig_set(gn->gen, ind, x); /* clm.c's mus_locsig is a void func? */
+ return(x);
}
-static s7_double formant_rf_ssx(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t rf1;
- s7_pointer s1;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- rf1 = (s7_rf_t)(**p); (*p)++;
- return(mus_formant_with_frequency(g, s7_slot_real_value(sc, s1, S_formant), rf1(sc, p)));
-}
-static s7_double formant_rf_sss(s7_scheme *sc, s7_pointer **p)
+static s7_double mus_formant_bank_dvd(void *o, s7_double x)
{
- s7_pointer s1, s2;
- mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
- s1 = (**p); (*p)++;
- s2 = (**p); (*p)++;
- return(mus_formant_with_frequency(g, s7_slot_real_value(sc, s1, S_formant), s7_slot_real_value(sc, s2, S_formant)));
+ mus_xen *gn = (mus_xen *)o;
+ return(mus_formant_bank(gn->gen, x));
}
-static s7_rf_t formant_rf_3(s7_scheme *sc, s7_pointer expr)
+static s7_double mus_formant_bank_dpd(s7_pointer p, s7_double x)
{
- mus_any *g;
- int len;
- len = s7_list_length(sc, expr);
- if (len < 4) return(formant_rf(sc, expr));
- if (len > 5) return(NULL);
- g = cadr_gen(sc, expr);
- if ((!g) || (!mus_is_formant(g))) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, formant_rf_sss, NULL, NULL, formant_rf_ssx, NULL));
-}
-
-
- /* formant-bank: c g r, or v for with_inputs */
-static s7_double formant_bank_rf_s(s7_scheme *sc, s7_pointer **p)
-{
- mus_any *bank;
- s7_pointer slot;
- bank = (mus_any *)(**p); (*p)++;
- slot = (**p); (*p)++;
- return(mus_formant_bank(bank, s7_slot_real_value(sc, slot, S_formant_bank)));
-}
-
-static s7_double formant_bank_rf_r(s7_scheme *sc, s7_pointer **p)
-{
- mus_any *bank;
- s7_pointer slot;
- bank = (mus_any *)(**p); (*p)++;
- slot = (**p); (*p)++;
- return(mus_formant_bank(bank, s7_number_to_real(sc, slot)));
-}
-
-static s7_double formant_bank_rf_x(s7_scheme *sc, s7_pointer **p)
-{
- mus_any *bank;
- s7_rf_t r1;
- bank = (mus_any *)(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(mus_formant_bank(bank, r1(sc, p)));
-}
-
-static s7_double formant_bank_rf_v(s7_scheme *sc, s7_pointer **p)
-{
- mus_any *bank;
- s7_double *els;
- bank = (mus_any *)(**p); (*p)++;
- els = (s7_double *)(**p); (*p)++;
- return(mus_formant_bank_with_inputs(bank, els));
-}
-
-static s7_rf_t formant_bank_rf(s7_scheme *sc, s7_pointer expr)
-{
- mus_any *g;
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
- g = cadr_gen(sc, expr);
- if ((g) && (mus_is_formant_bank(g)))
- {
- s7_pointer a1, val_sym, val;
- s7_int loc;
- s7_rf_t rf;
-
- s7_xf_store(sc, (s7_pointer)g);
- a1 = caddr(expr);
- if (s7_is_symbol(a1))
- {
- s7_pointer slot;
- slot = s7_slot(sc, a1);
- if (slot == xen_undefined) return(NULL);
- val = s7_slot_value(slot);
- if (s7_is_real(val))
- {
- s7_xf_store(sc, (s7_pointer)slot);
- return(formant_bank_rf_s);
- }
- if (s7_is_float_vector(val))
- {
- s7_xf_store(sc, (s7_pointer)s7_float_vector_elements(val));
- return(formant_bank_rf_v);
- }
- return(NULL);
- }
- if (s7_is_real(a1))
- {
- s7_xf_store(sc, a1);
- return(formant_bank_rf_r);
- }
- if (!s7_is_pair(a1)) return(NULL);
- val_sym = car(a1);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, a1);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
- return(formant_bank_rf_x);
- }
- return(NULL);
+ mus_xen *gn = (mus_xen *)s7_object_value(p);
+ return(mus_formant_bank(gn->gen, x));
}
-
-static s7_double set_formant_frequency_rf_x(s7_scheme *sc, s7_pointer **p)
-{
- mus_any *f;
- s7_rf_t r1;
- f = (mus_any *)(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(mus_set_formant_frequency(f, r1(sc, p)));
-}
-
-static s7_rf_t set_formant_frequency_rf(s7_scheme *sc, s7_pointer expr)
+static s7_double mus_formant_bank_dv(void *o)
{
- mus_any *g;
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
- g = cadr_gen(sc, expr);
- if ((g) && (mus_is_formant(g)))
- {
- s7_pointer a1;
- a1 = s7_caddr(expr);
- if (s7_is_pair(a1))
- {
- s7_int loc;
- s7_pointer val, val_sym;
- s7_rf_t rf;
- val_sym = car(a1);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
- s7_xf_store(sc, (s7_pointer)g);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, a1);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
- return(set_formant_frequency_rf_x);
- }
- }
- return(NULL);
+ mus_xen *gn = (mus_xen *)o;
+ return(mus_formant_bank(gn->gen, 0.0));
}
-
-static s7_double outa_x_rf(s7_scheme *sc, s7_pointer **p)
+static s7_double mus_formant_bank_dp(s7_pointer p)
{
- s7_int ind;
- s7_double val;
- s7_rf_t rf;
-
- ind = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- out_any_2(ind, val, 0, S_outa);
- return(val);
+ mus_xen *gn = (mus_xen *)s7_object_value(p);
+ return(mus_formant_bank(gn->gen, 0.0));
}
-static s7_double outa_x_rf_checked(s7_scheme *sc, s7_pointer **p)
+static s7_double mus_set_formant_frequency_dvd(void *o, s7_double x)
{
- s7_pointer ind;
- s7_double val;
- s7_rf_t rf;
-
- ind = s7_slot_value(**p); (*p)++;
- if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_outa, 1, ind, "an integer");
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- out_any_2(s7_integer(ind), val, 0, S_outa);
- return(val);
+ mus_xen *gn = (mus_xen *)o;
+ return(mus_set_formant_frequency(gn->gen, x));
}
-static s7_double outa_s_rf(s7_scheme *sc, s7_pointer **p)
+static s7_double mus_set_formant_frequency_dpd(s7_pointer p, s7_double x)
{
- s7_double val;
- s7_int ind;
-
- ind = s7_slot_integer_value(**p); (*p)++;
- val = s7_slot_real_value(sc, **p, S_outa); (*p)++;
- out_any_2(ind, val, 0, S_outa);
- return(val);
+ mus_xen *gn = (mus_xen *)s7_object_value(p);
+ return(mus_set_formant_frequency(gn->gen, x));
}
-static s7_double outa_s_rf_checked(s7_scheme *sc, s7_pointer **p)
+static s7_double mus_set_formant_radius_and_frequency_dvdd(void *o, s7_double x1, s7_double x2)
{
- s7_double val;
- s7_pointer ind;
-
- ind = s7_slot_value(**p); (*p)++;
- if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_outa, 1, ind, "an integer");
- val = s7_slot_real_value(sc, **p, S_outa); (*p)++;
- out_any_2(s7_integer(ind), val, 0, S_outa);
- return(val);
+ mus_xen *gn = (mus_xen *)o;
+ mus_set_formant_radius_and_frequency(gn->gen, x1, x2);
+ return(x2);
}
-static s7_double outa_x_rf_to_mus_xen(s7_scheme *sc, s7_pointer **p)
-{
- s7_double val;
- s7_int pos;
- s7_rf_t rf;
-
- pos = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
-
- if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
- mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
- return(val);
-}
-static s7_double outa_s_rf_to_mus_xen(s7_scheme *sc, s7_pointer **p)
+static s7_double out_bank_d_pid(s7_pointer gens, s7_int loc, s7_double x)
{
- s7_double val;
- s7_int pos;
-
- pos = s7_slot_integer_value(**p); (*p)++;
- val = s7_slot_real_value(sc, **p, S_outa); (*p)++;
- if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
- mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
- return(val);
+ int i, len;
+ s7_pointer *els;
+ 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);
+ return(x);
}
-static s7_double outb_x_rf(s7_scheme *sc, s7_pointer **p)
+static s7_double polynomial_d_pd(s7_pointer v, s7_double x)
{
- s7_int ind;
- s7_double val;
- s7_rf_t rf;
-
- ind = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- out_any_2(ind, val, 1, S_outb);
- return(val);
+ return(mus_polynomial(s7_float_vector_elements(v), x, s7_vector_length(v)));
}
-static s7_double outb_s_rf(s7_scheme *sc, s7_pointer **p)
-{
- s7_int ind;
- s7_double val;
- ind = s7_slot_integer_value(**p); (*p)++;
- val = s7_slot_real_value(sc, **p, S_outb); (*p)++;
- out_any_2(ind, val, 1, S_outb);
- return(val);
-}
+#define DF_1(Call) static s7_double mus_ ## Call ## _d(s7_double x) {return((s7_double)mus_ ## Call((mus_float_t)x));}
+#define DF_2(Call) static s7_double mus_ ## Call ## _d(s7_double x1, s7_double x2) {return((s7_double)mus_ ## Call((mus_float_t)x1, (mus_float_t)x2));}
-static s7_double mul_env_x_rf(s7_scheme *sc, s7_pointer **p);
-static s7_double mul_env_polywave_x_rf(s7_scheme *sc, s7_pointer **p);
+DF_1(odd_weight)
+DF_1(even_weight)
+DF_1(hz_to_radians)
+DF_1(radians_to_hz)
+DF_1(db_to_linear)
+DF_1(linear_to_db)
+DF_1(radians_to_degrees)
+DF_1(degrees_to_radians)
+DF_1(random)
-static s7_double outa_mul_env_x_rf(s7_scheme *sc, s7_pointer **p)
-{
- s7_double val;
- s7_int pos;
- s7_rf_t r2;
- mus_any *g;
+DF_2(contrast_enhancement)
+DF_2(odd_multiple)
+DF_2(even_multiple)
+DF_2(ring_modulate)
+#endif /* gmp */
- pos = s7_slot_integer_value(**p); (*p) += 3;
- g = (mus_any *)(**p); (*p)++;
- r2 = (s7_rf_t)(**p); (*p)++;
- val = mus_env(g) * r2(sc, p);
- if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
- mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
- return(val);
-}
-static s7_double outa_mul_env_polywave_x_rf(s7_scheme *sc, s7_pointer **p)
+static void init_choosers(s7_scheme *sc)
{
- s7_double val;
- s7_int pos;
- s7_rf_t r2;
- mus_any *e, *o;
-
- pos = s7_slot_integer_value(**p); (*p) += 3;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- r2 = (s7_rf_t)(**p); (*p)++;
- val = mus_env(e) * mus_polywave(o, r2(sc, p));
-
- if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
- mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
- return(val);
-}
-
+ env_symbol = s7_make_symbol(sc, S_env);
+ comb_bank_symbol = s7_make_symbol(sc, S_comb_bank);
+ vector_ref_symbol = s7_make_symbol(sc, "vector-ref");
+ polywave_symbol = s7_make_symbol(sc, S_polywave);
+ triangle_wave_symbol = s7_make_symbol(sc, S_triangle_wave);
+ rand_interp_symbol = s7_make_symbol(sc, S_rand_interp);
+ oscil_symbol = s7_make_symbol(sc, S_oscil);
+ multiply_symbol = s7_make_symbol(sc, "*");
+ add_symbol = s7_make_symbol(sc, "+");
+ quote_symbol = s7_make_symbol(sc, "quote");
+ cos_symbol = s7_make_symbol(sc, "cos");
+ mus_copy_symbol = s7_make_symbol(sc, "mus-copy");
+ copy_function = s7_name_to_value(sc, "copy");
-static s7_double outa_mul_env_polywave_env_rf(s7_scheme *sc, s7_pointer **p)
-{
- s7_double val;
- s7_int pos;
- mus_any *e, *o, *fe;
+ sym_frequency = s7_make_symbol(sc, S_mus_frequency);
+ sym_phase = s7_make_symbol(sc, S_mus_phase);
+ sym_scaler = s7_make_symbol(sc, S_mus_scaler);
+ sym_increment = s7_make_symbol(sc, S_mus_increment);
+ sym_width = s7_make_symbol(sc, S_mus_width);
+ sym_offset = s7_make_symbol(sc, S_mus_offset);
+ sym_feedforward = s7_make_symbol(sc, S_mus_feedforward);
+ sym_feedback = s7_make_symbol(sc, S_mus_feedback);
- pos = s7_slot_integer_value(**p); (*p) += 3;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p) += 2;
- fe = (mus_any *)(**p); (*p)++;
- val = mus_env(e) * mus_polywave(o, mus_env(fe));
+#if (!WITH_GMP)
+ s7_set_d_function(s7_name_to_value(sc, S_mus_srate), mus_srate);
+ s7_set_d_function(s7_name_to_value(sc, S_mus_float_equal_fudge_factor), mus_float_equal_fudge_factor);
+
+ s7_set_d_v_function(s7_name_to_value(sc, S_all_pass), mus_all_pass_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_all_pass_bank), mus_all_pass_bank_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_asymmetric_fm), mus_asymmetric_fm_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_comb), mus_comb_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_comb_bank), mus_comb_bank_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_convolve), mus_convolve_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_delay), mus_delay_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_env), mus_env_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_filter), mus_filter_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_filtered_comb), mus_filtered_comb_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_filtered_comb_bank), mus_filtered_comb_bank_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_fir_filter), mus_fir_filter_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_firmant), mus_firmant_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_formant), mus_formant_dv);
+ /* s7_set_d_v_function(s7_name_to_value(sc, S_granulate), mus_granulate_dv); */
+ s7_set_d_v_function(s7_name_to_value(sc, S_iir_filter), mus_iir_filter_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_moving_average), mus_moving_average_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_moving_max), mus_moving_max_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_moving_norm), mus_moving_norm_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_ncos), mus_ncos_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_notch), mus_notch_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_nrxycos), mus_nrxycos_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_nrxysin), mus_nrxysin_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_nsin), mus_nsin_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_one_pole), mus_one_pole_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_one_pole_all_pass), mus_one_pole_all_pass_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_one_zero), mus_one_zero_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_oscil), mus_oscil_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_oscil_bank), mus_oscil_bank_dv);
+ /* s7_set_d_v_function(s7_name_to_value(sc, S_phase_vocoder), mus_phase_vocoder_dv); */
+ s7_set_d_v_function(s7_name_to_value(sc, S_polyshape), mus_polyshape_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_polywave), mus_polywave_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_pulse_train), mus_pulse_train_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_pulsed_env), mus_pulsed_env_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_rand), mus_rand_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_rand_interp), mus_rand_interp_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_readin), mus_readin_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_rxykcos), mus_rxykcos_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_rxyksin), mus_rxyksin_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_sawtooth_wave), mus_sawtooth_wave_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_square_wave), mus_square_wave_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_src), mus_src_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_ssb_am), mus_ssb_am_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_table_lookup), mus_table_lookup_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_tap), mus_tap_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_triangle_wave), mus_triangle_wave_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_two_pole), mus_two_pole_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_two_zero), mus_two_zero_dv);
+ s7_set_d_v_function(s7_name_to_value(sc, S_wave_train), mus_wave_train_dv);
+
+ s7_set_d_p_function(s7_name_to_value(sc, S_all_pass), mus_all_pass_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_all_pass_bank), mus_all_pass_bank_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_asymmetric_fm), mus_asymmetric_fm_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_comb), mus_comb_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_comb_bank), mus_comb_bank_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_convolve), mus_convolve_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_delay), mus_delay_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_env), mus_env_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_filter), mus_filter_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_filtered_comb), mus_filtered_comb_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_filtered_comb_bank), mus_filtered_comb_bank_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_fir_filter), mus_fir_filter_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_firmant), mus_firmant_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_formant), mus_formant_dp);
+ /* s7_set_d_p_function(s7_name_to_value(sc, S_granulate), mus_granulate_dp); */
+ s7_set_d_p_function(s7_name_to_value(sc, S_iir_filter), mus_iir_filter_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_moving_average), mus_moving_average_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_moving_max), mus_moving_max_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_moving_norm), mus_moving_norm_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_ncos), mus_ncos_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_notch), mus_notch_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_nrxycos), mus_nrxycos_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_nrxysin), mus_nrxysin_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_nsin), mus_nsin_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_one_pole), mus_one_pole_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_one_pole_all_pass), mus_one_pole_all_pass_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_one_zero), mus_one_zero_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_oscil), mus_oscil_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_oscil_bank), mus_oscil_bank_dp);
+ /* s7_set_d_p_function(s7_name_to_value(sc, S_phase_vocoder), mus_phase_vocoder_dp); */
+ s7_set_d_p_function(s7_name_to_value(sc, S_polyshape), mus_polyshape_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_polywave), mus_polywave_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_pulse_train), mus_pulse_train_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_pulsed_env), mus_pulsed_env_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_rand), mus_rand_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_rand_interp), mus_rand_interp_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_readin), mus_readin_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_rxykcos), mus_rxykcos_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_rxyksin), mus_rxyksin_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_sawtooth_wave), mus_sawtooth_wave_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_square_wave), mus_square_wave_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_src), mus_src_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_ssb_am), mus_ssb_am_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_table_lookup), mus_table_lookup_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_tap), mus_tap_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_triangle_wave), mus_triangle_wave_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_two_pole), mus_two_pole_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_two_zero), mus_two_zero_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_wave_train), mus_wave_train_dp);
+
+ s7_set_d_vd_function(s7_name_to_value(sc, S_all_pass), mus_all_pass_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_all_pass_bank), mus_all_pass_bank_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_asymmetric_fm), mus_asymmetric_fm_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_comb), mus_comb_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_comb_bank), mus_comb_bank_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_delay), mus_delay_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_filter), mus_filter_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_filtered_comb), mus_filtered_comb_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_filtered_comb_bank), mus_filtered_comb_bank_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_fir_filter), mus_fir_filter_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_firmant), mus_firmant_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_formant), mus_formant_dvd);
+ s7_set_d_v_function(s7_name_to_value(sc, S_formant_bank), mus_formant_bank_dv);
+ s7_set_d_p_function(s7_name_to_value(sc, S_formant_bank), mus_formant_bank_dp);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_formant_bank), mus_formant_bank_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_iir_filter), mus_iir_filter_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_moving_average), mus_moving_average_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_moving_max), mus_moving_max_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_moving_norm), mus_moving_norm_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_ncos), mus_ncos_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_notch), mus_notch_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_nrxycos), mus_nrxycos_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_nrxysin), mus_nrxysin_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_nsin), mus_nsin_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_one_pole), mus_one_pole_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_one_pole_all_pass), mus_one_pole_all_pass_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_one_zero), mus_one_zero_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_oscil), mus_oscil_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_polyshape), mus_polyshape_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_polywave), mus_polywave_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_pulse_train), mus_pulse_train_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_pulsed_env), mus_pulsed_env_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_rand), mus_rand_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_rand_interp), mus_rand_interp_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_rxykcos), mus_rxykcos_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_rxyksin), mus_rxyksin_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_sawtooth_wave), mus_sawtooth_wave_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_square_wave), mus_square_wave_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_src), mus_src_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_ssb_am), mus_ssb_am_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_table_lookup), mus_table_lookup_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_tap), mus_tap_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_triangle_wave), mus_triangle_wave_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_two_pole), mus_two_pole_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_two_zero), mus_two_zero_dvd);
+ s7_set_d_vd_function(s7_name_to_value(sc, S_wave_train), mus_wave_train_dvd);
+
+ s7_set_d_vd_function(s7_name_to_value(sc, S_mus_set_formant_frequency), mus_set_formant_frequency_dvd);
+ s7_set_d_vdd_function(s7_name_to_value(sc, S_mus_set_formant_radius_and_frequency), mus_set_formant_radius_and_frequency_dvdd);
+
+ s7_set_d_pd_function(s7_name_to_value(sc, S_all_pass), mus_all_pass_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_all_pass_bank), mus_all_pass_bank_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_asymmetric_fm), mus_asymmetric_fm_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_comb), mus_comb_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_comb_bank), mus_comb_bank_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_delay), mus_delay_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_filter), mus_filter_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_filtered_comb), mus_filtered_comb_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_filtered_comb_bank), mus_filtered_comb_bank_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_fir_filter), mus_fir_filter_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_firmant), mus_firmant_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_formant), mus_formant_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_formant_bank), mus_formant_bank_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_iir_filter), mus_iir_filter_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_moving_average), mus_moving_average_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_moving_max), mus_moving_max_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_moving_norm), mus_moving_norm_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_ncos), mus_ncos_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_notch), mus_notch_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_nrxycos), mus_nrxycos_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_nrxysin), mus_nrxysin_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_nsin), mus_nsin_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_one_pole), mus_one_pole_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_one_pole_all_pass), mus_one_pole_all_pass_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_one_zero), mus_one_zero_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_oscil), mus_oscil_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_polyshape), mus_polyshape_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_polywave), mus_polywave_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_pulse_train), mus_pulse_train_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_pulsed_env), mus_pulsed_env_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_rand), mus_rand_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_rand_interp), mus_rand_interp_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_rxykcos), mus_rxykcos_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_rxyksin), mus_rxyksin_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_sawtooth_wave), mus_sawtooth_wave_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_square_wave), mus_square_wave_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_src), mus_src_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_ssb_am), mus_ssb_am_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_table_lookup), mus_table_lookup_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_tap), mus_tap_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_triangle_wave), mus_triangle_wave_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_two_pole), mus_two_pole_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_two_zero), mus_two_zero_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_wave_train), mus_wave_train_dpd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_mus_set_formant_frequency), mus_set_formant_frequency_dpd);
+
+ s7_set_d_vdd_function(s7_name_to_value(sc, S_oscil), mus_oscil_dvdd);
+ s7_set_d_vdd_function(s7_name_to_value(sc, S_all_pass), mus_all_pass_dvdd);
+ s7_set_d_vdd_function(s7_name_to_value(sc, S_comb), mus_comb_dvdd);
+ s7_set_d_vdd_function(s7_name_to_value(sc, S_notch), mus_notch_dvdd);
+ s7_set_d_vdd_function(s7_name_to_value(sc, S_ssb_am), mus_ssb_am_dvdd);
+ s7_set_d_vdd_function(s7_name_to_value(sc, S_formant), mus_formant_dvdd);
+ s7_set_d_vdd_function(s7_name_to_value(sc, S_firmant), mus_firmant_dvdd);
+ s7_set_d_vdd_function(s7_name_to_value(sc, S_delay), mus_delay_dvdd);
+
+ s7_set_d_d_function(s7_name_to_value(sc, S_odd_weight), mus_odd_weight_d);
+ s7_set_d_d_function(s7_name_to_value(sc, S_even_weight), mus_even_weight_d);
+ s7_set_d_d_function(s7_name_to_value(sc, S_hz_to_radians), mus_hz_to_radians_d);
+ s7_set_d_d_function(s7_name_to_value(sc, S_radians_to_hz), mus_radians_to_hz_d);
+ s7_set_d_d_function(s7_name_to_value(sc, S_db_to_linear), mus_db_to_linear_d);
+ s7_set_d_d_function(s7_name_to_value(sc, S_linear_to_db), mus_linear_to_db_d);
+ s7_set_d_d_function(s7_name_to_value(sc, S_radians_to_degrees), mus_radians_to_degrees_d);
+ s7_set_d_d_function(s7_name_to_value(sc, S_degrees_to_radians), mus_degrees_to_radians_d);
+ s7_set_d_d_function(s7_name_to_value(sc, S_mus_random), mus_random_d);
+
+ s7_set_d_dd_function(s7_name_to_value(sc, S_even_multiple), mus_even_multiple_d);
+ s7_set_d_dd_function(s7_name_to_value(sc, S_odd_multiple), mus_odd_multiple_d);
+ s7_set_d_dd_function(s7_name_to_value(sc, S_ring_modulate), mus_ring_modulate_d);
+ s7_set_d_dd_function(s7_name_to_value(sc, S_contrast_enhancement), mus_contrast_enhancement_d);
+
+ s7_set_d_id_function(s7_name_to_value(sc, S_outa), outa_did);
+ s7_set_d_id_function(s7_name_to_value(sc, S_outb), outb_did);
+ s7_set_d_id_function(s7_name_to_value(sc, S_outc), outc_did);
+ s7_set_d_id_function(s7_name_to_value(sc, S_outd), outd_did);
+
+ s7_set_d_ip_function(s7_name_to_value(sc, S_ina), ina_dip);
+ s7_set_d_ip_function(s7_name_to_value(sc, S_inb), inb_dip);
+
+ s7_set_d_pi_function(s7_name_to_value(sc, S_file_to_sample), file_to_sample_dpi);
+
+ s7_set_d_p_function(s7_name_to_value(sc, S_pink_noise), mus_pink_noise);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_piano_noise), piano_noise_d_pd);
+ s7_set_d_pd_function(s7_name_to_value(sc, S_polynomial), polynomial_d_pd);
+
+ s7_set_d_vid_function(s7_name_to_value(sc, S_locsig), locsig_d_vid);
+ s7_set_d_vid_function(s7_name_to_value(sc, S_locsig_set), locsig_set_d_vid);
+
+ s7_set_d_pid_function(s7_name_to_value(sc, S_out_bank), out_bank_d_pid);
+
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_all_pass), is_all_pass_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_asymmetric_fm), is_asymmetric_fm_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_comb), is_comb_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_comb_bank), is_comb_bank_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_all_pass_bank), is_all_pass_bank_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_convolve), is_convolve_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_delay), is_delay_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_env), is_env_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_filter), is_filter_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_filtered_comb), is_filtered_comb_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_filtered_comb_bank), is_filtered_comb_bank_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_fir_filter), is_fir_filter_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_firmant), is_firmant_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_formant), is_formant_b);
+ /* s7_set_b_p_function(s7_name_to_value(sc, S_is_granulate), is_granulate_b); */
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_iir_filter), is_iir_filter_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_moving_average), is_moving_average_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_moving_max), is_moving_max_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_moving_norm), is_moving_norm_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_ncos), is_ncos_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_notch), is_notch_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_nrxycos), is_nrxycos_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_nrxysin), is_nrxysin_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_nsin), is_nsin_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_one_pole), is_one_pole_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_one_pole_all_pass), is_one_pole_all_pass_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_one_zero), is_one_zero_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_oscil), is_oscil_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_oscil_bank), is_oscil_bank_b);
+ /* s7_set_b_p_function(s7_name_to_value(sc, S_is_phase_vocoder), is_phase_vocoder_b); */
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_polyshape), is_polyshape_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_polywave), is_polywave_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_pulse_train), is_pulse_train_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_pulsed_env), is_pulsed_env_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_rand), is_rand_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_rand_interp), is_rand_interp_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_readin), is_readin_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_rxykcos), is_rxykcos_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_rxyksin), is_rxyksin_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_sawtooth_wave), is_sawtooth_wave_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_square_wave), is_square_wave_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_src), is_src_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_table_lookup), is_table_lookup_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_triangle_wave), is_triangle_wave_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_two_pole), is_two_pole_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_two_zero), is_two_zero_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_wave_train), is_wave_train_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_ssb_am), is_ssb_am_b);
+ s7_set_b_p_function(s7_name_to_value(sc, S_is_tap), is_tap_b);
+
+ s7_set_d_p_function(s7_name_to_value(sc, S_mus_scaler), mus_scaler_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_mus_phase), mus_phase_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_mus_frequency), mus_frequency_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_mus_offset), mus_offset_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_mus_width), mus_width_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_mus_increment), mus_increment_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_mus_feedforward), mus_feedforward_dp);
+ s7_set_d_p_function(s7_name_to_value(sc, S_mus_feedback), mus_feedback_dp);
+
+ s7_set_i_p_function(s7_name_to_value(sc, S_mus_length), mus_length_ip);
+ s7_set_i_p_function(s7_name_to_value(sc, S_mus_order), mus_order_ip);
+ s7_set_i_p_function(s7_name_to_value(sc, S_mus_location), mus_location_ip);
+ s7_set_i_p_function(s7_name_to_value(sc, S_mus_channel), mus_channel_ip);
+ s7_set_i_p_function(s7_name_to_value(sc, S_mus_channels), mus_channels_ip);
+ s7_set_i_p_function(s7_name_to_value(sc, S_mus_ramp), mus_ramp_ip);
+ s7_set_i_p_function(s7_name_to_value(sc, S_mus_hop), mus_hop_ip);
- if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
- mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
- return(val);
+#endif /* gmp */
}
-
-
-static s7_rf_t out_rf(s7_scheme *sc, s7_pointer expr, int chan)
-{
- s7_pointer ind_sym, ind, ind_slot, val_sym, val, val_expr;
- s7_rf_t rf = NULL;
-
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
- ind_sym = s7_cadr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if (ind_slot == xen_undefined) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
- if (ind < 0) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- val_expr = s7_caddr(expr);
- if (s7_is_symbol(val_expr))
- {
- s7_pointer slot;
- slot = s7_slot(sc, val_expr);
- if (slot == xen_undefined) return(NULL);
- s7_xf_store(sc, slot);
- }
- else
- {
- s7_int loc;
- if (!s7_is_pair(val_expr)) return(NULL);
- val_sym = car(val_expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, val_expr);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
- }
-
- if (s7_is_stepper(ind_slot))
- {
- if (chan == 0)
- {
- if (out_any_2 == safe_out_any_2_to_mus_xen)
- {
- if (rf == mul_env_polywave_x_rf)
- {
- s7_pointer fm;
- fm = s7_caddr(s7_caddr(val_expr));
- if ((s7_is_pair(fm)) &&
- (s7_car(fm) == env_symbol) &&
- (s7_is_symbol(s7_cadr(fm))))
- return(outa_mul_env_polywave_env_rf);
- return(outa_mul_env_polywave_x_rf);
- }
- if (rf == mul_env_x_rf)
- return(outa_mul_env_x_rf);
- return((rf) ? outa_x_rf_to_mus_xen : outa_s_rf_to_mus_xen);
- }
- return((rf) ? outa_x_rf : outa_s_rf);
- }
- return((rf) ? outb_x_rf : outb_s_rf);
- }
-
- if (chan == 0)
- return((rf) ? outa_x_rf_checked : outa_s_rf_checked);
- return(NULL);
-}
-
-static s7_rf_t outa_rf(s7_scheme *sc, s7_pointer expr)
-{
- return(out_rf(sc, expr, 0));
-}
-
-static s7_rf_t outb_rf(s7_scheme *sc, s7_pointer expr)
-{
- return(out_rf(sc, expr, 1));
-}
-
-
-static s7_double sample_to_file_rf_g(s7_scheme *sc, s7_pointer **p)
-{
- /* (sample->file obj samp chan[always int] val) */
- s7_int ind, chan;
- mus_any *lc;
- s7_double val;
- s7_rf_t rf;
-
- lc = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- chan = s7_integer(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- mus_sample_to_file(lc, ind, chan, val);
- return(val);
-}
-
-static s7_rf_t sample_to_file_rf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer ind_sym, ind, ind_slot, chan, val_sym, val, val_expr;
- s7_int loc;
- s7_rf_t rf;
- mus_any *lc;
-
- lc = cadr_gen(sc, expr);
- if ((!lc) || (!mus_is_sample_to_file(lc))) return(NULL);
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
-
- chan = s7_cadddr(expr);
- if (!s7_is_integer(chan)) return(NULL);
-
- val_expr = s7_car(s7_cddddr(expr));
- if (!s7_is_pair(val_expr)) return(NULL);
- val_sym = s7_car(val_expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
-
- s7_xf_store(sc, (s7_pointer)lc);
- s7_xf_store(sc, ind_slot);
- s7_xf_store(sc, chan);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, val_expr);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
-
- return(sample_to_file_rf_g);
-}
-
-
-static s7_double locsig_rf_x(s7_scheme *sc, s7_pointer **p)
-{
- s7_int ind;
- mus_any *lc;
- s7_double val;
- s7_rf_t rf;
-
- lc = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- mus_locsig(lc, ind, val);
- return(val);
-}
-
-static s7_double locsig_rf_x_checked(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer ind;
- mus_any *lc;
- s7_double val;
- s7_rf_t rf;
-
- lc = (mus_any *)(**p); (*p)++;
- ind = s7_slot_value(**p); (*p)++;
- if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_locsig, 2, ind, "an integer");
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- mus_locsig(lc, s7_integer(ind), val);
- return(val);
-}
-
-static s7_double fm_violin_rf(s7_scheme *sc, s7_pointer **p);
-
-static s7_double locsig_fm_violin_rf(s7_scheme *sc, s7_pointer **p)
-{
- s7_int ind;
- mus_any *lc, *e, *o, *fp, *a;
- s7_double val, vib;
-
- lc = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p) += 3;
-
- /* fm_violin_rf */
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p) += 2;
- vib = s7_slot_real_value(sc, **p, S_oscil); (*p) += 3;
- a = (mus_any *)(**p); (*p) += 2;
- fp = (mus_any *)(**p); (*p)++;
- val = mus_env(e) * mus_oscil_fm(o, vib + (mus_env(a) * mus_polywave(fp, vib)));
-
- mus_locsig(lc, ind, val);
- return(val);
-}
-
-static s7_rf_t locsig_rf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer ind_sym, ind, ind_slot, val_sym, val, val_expr;
- s7_int loc;
- s7_rf_t rf;
- mus_any *lc;
-
- lc = cadr_gen(sc, expr);
- if ((!lc) || (!mus_is_locsig(lc))) return(NULL);
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if (ind_slot == xen_undefined) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
-
- val_expr = s7_cadddr(expr);
- if (!s7_is_pair(val_expr)) return(NULL);
- val_sym = s7_car(val_expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
-
- s7_xf_store(sc, (s7_pointer)lc);
- s7_xf_store(sc, ind_slot);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, val_expr);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
-
- if (rf == fm_violin_rf)
- return(locsig_fm_violin_rf);
- return((s7_is_stepper(ind_slot)) ? locsig_rf_x : locsig_rf_x_checked);
-}
-
-
-static s7_double move_sound_rf_g(s7_scheme *sc, s7_pointer **p)
-{
- s7_int ind;
- mus_any *lc;
- s7_double val;
- s7_rf_t rf;
-
- lc = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- mus_move_sound(lc, ind, val);
- return(val);
-}
-
-static s7_rf_t move_sound_rf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer ind_sym, ind, ind_slot, val_sym, val, val_expr;
- s7_int loc;
- s7_rf_t rf;
- mus_any *lc;
-
- lc = cadr_gen(sc, expr);
- if ((!lc) || (!mus_is_move_sound(lc))) return(NULL);
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
-
- val_expr = s7_cadddr(expr);
- if (!s7_is_pair(val_expr)) return(NULL);
- val_sym = s7_car(val_expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
-
- s7_xf_store(sc, (s7_pointer)lc);
- s7_xf_store(sc, ind_slot);
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, val_expr);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
-
- return(move_sound_rf_g);
-}
-
-
-static s7_double out_bank_rf_1(s7_scheme *sc, s7_pointer **p)
-{
- s7_double val;
- s7_rf_t rf;
- s7_int loc;
- mus_any *g1;
-
- g1 = (mus_any *)(**p); (*p)++;
- loc = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- if (mus_is_delay(g1))
- out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
- else out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
- return(val);
-}
-
-static s7_double mul_s_comb_bank_x_rf(s7_scheme *sc, s7_pointer **p);
-
-static s7_double out_bank_rf_comb_bank_1(s7_scheme *sc, s7_pointer **p)
-{
- s7_double val, s1;
- s7_rf_t rf;
- s7_int loc;
- mus_any *g1, *o;
-
- g1 = (mus_any *)(**p); (*p)++;
- loc = s7_slot_integer_value(**p); (*p) += 2;
-
- s1 = s7_slot_real_value(sc, **p, "out-bank"); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = s1 * mus_comb_bank(o, rf(sc, p));
-
- if (mus_is_delay(g1))
- out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
- else out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
- return(val);
-}
-
-static s7_double out_bank_rf_comb_bank_2(s7_scheme *sc, s7_pointer **p)
-{
- s7_double val, s1;
- s7_rf_t rf;
- s7_int loc;
- mus_any *g1, *g2, *o;
-
- g1 = (mus_any *)(**p); (*p)++;
- g2 = (mus_any *)(**p); (*p)++;
- loc = s7_slot_integer_value(**p); (*p) += 2;
-
- s1 = s7_slot_real_value(sc, **p, "out-bank"); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = s1 * mus_comb_bank(o, rf(sc, p));
-
- if (mus_is_delay(g1))
- {
- out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_delay_unmodulated_noz(g2, val), 1, "out-bank");
- }
- else
- {
- out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_all_pass_unmodulated_noz(g2, val), 1, "out-bank");
- }
- return(val);
-}
-
-static s7_double out_bank_rf_2(s7_scheme *sc, s7_pointer **p)
-{
- s7_double val;
- s7_rf_t rf;
- s7_int loc;
- mus_any *g1, *g2;
-
- g1 = (mus_any *)(**p); (*p)++;
- g2 = (mus_any *)(**p); (*p)++;
- loc = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- if (mus_is_delay(g1))
- {
- out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_delay_unmodulated_noz(g2, val), 1, "out-bank");
- }
- else
- {
- out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_all_pass_unmodulated_noz(g2, val), 1, "out-bank");
- }
- return(val);
-}
-
-static s7_double out_bank_rf_4(s7_scheme *sc, s7_pointer **p)
-{
- s7_double val;
- s7_rf_t rf;
- s7_int loc;
- mus_any *g1, *g2, *g3, *g4;
-
- g1 = (mus_any *)(**p); (*p)++;
- g2 = (mus_any *)(**p); (*p)++;
- g3 = (mus_any *)(**p); (*p)++;
- g4 = (mus_any *)(**p); (*p)++;
- loc = s7_slot_integer_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- if (mus_is_delay(g1))
- {
- out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_delay_unmodulated_noz(g2, val), 1, "out-bank");
- out_any_2(loc, mus_delay_unmodulated_noz(g3, val), 2, "out-bank");
- out_any_2(loc, mus_delay_unmodulated_noz(g4, val), 3, "out-bank");
- }
- else
- {
- out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
- out_any_2(loc, mus_all_pass_unmodulated_noz(g2, val), 1, "out-bank");
- out_any_2(loc, mus_all_pass_unmodulated_noz(g3, val), 2, "out-bank");
- out_any_2(loc, mus_all_pass_unmodulated_noz(g4, val), 3, "out-bank");
- }
- return(val);
-}
-
-static s7_rf_t out_bank_rf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer ind_sym, ind, ind_slot, val_sym, val, val_expr, filts;
- s7_int loc;
- s7_rf_t rf;
- s7_int i, len;
- mus_xen *gn;
- mus_any *g;
- s7_pointer *els;
-
- filts = s7_cadr(expr);
- if (!s7_is_symbol(filts)) return(NULL);
- filts = s7_symbol_value(sc, filts);
- if (!s7_is_vector(filts)) return(NULL);
- len = s7_vector_length(filts);
- if ((len != 1) && (len != 2) && (len != 4)) return(NULL);
- els = s7_vector_elements(filts);
- gn = (mus_xen *)s7_object_value_checked(els[0], mus_xen_tag);
- if (!gn) return(NULL);
- g = gn->gen;
- if ((!mus_is_delay(g)) && (!mus_is_all_pass(g))) return(NULL);
- for (i = 0; i < len; i++)
- s7_xf_store(sc, (s7_pointer)((mus_xen *)s7_object_value(els[i]))->gen);
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- val_expr = s7_cadddr(expr);
- if (!s7_is_pair(val_expr)) return(NULL);
- val_sym = s7_car(val_expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- if (!s7_rf_function(sc, val)) return(NULL);
-
- loc = s7_xf_store(sc, NULL);
- rf = s7_rf_function(sc, val)(sc, val_expr);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
-
- if (len == 1)
- {
- if (rf == mul_s_comb_bank_x_rf)
- return(out_bank_rf_comb_bank_1);
- return(out_bank_rf_1);
- }
- if (len == 2)
- {
- if (rf == mul_s_comb_bank_x_rf)
- return(out_bank_rf_comb_bank_2);
- return(out_bank_rf_2);
- }
- return(out_bank_rf_4);
-}
-
-
-static s7_double file_to_sample_rf_ss(s7_scheme *sc, s7_pointer **p)
-{
- s7_int ind;
- mus_any *stream;
- stream = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- return(mus_file_to_sample(stream, ind, 0));
-}
-
-static s7_rf_t file_to_sample_rf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer ind_sym, ind_slot, ind, sym, o;
- mus_xen *gn;
-
- sym = s7_cadr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- s7_xf_store(sc, (s7_pointer)(gn->gen));
-
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- return(file_to_sample_rf_ss);
-}
-
-
-static s7_pointer file_to_frample_pf_sss(s7_scheme *sc, s7_pointer **p)
-{
- /* (file->frample gen loc fv) -> fv */
- s7_pointer fv;
- s7_int ind;
- mus_any *stream;
-
- stream = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- fv = s7_slot_value(**p); (*p)++;
- mus_file_to_frample(stream, ind, s7_float_vector_elements(fv));
- return(fv);
-}
-
-static s7_pf_t file_to_frample_pf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer ind_sym, ind_slot, fv_slot, fv_sym, sym, o;
- mus_xen *gn;
-
- if (!s7_is_null(sc, s7_cddddr(expr))) return(NULL);
-
- sym = s7_cadr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- s7_xf_store(sc, (s7_pointer)(gn->gen));
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- if (!s7_is_integer(s7_slot_value(ind_slot))) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- fv_sym = s7_cadddr(expr);
- if (!s7_is_symbol(fv_sym)) return(NULL);
- fv_slot = s7_slot(sc, fv_sym);
- if (fv_slot == xen_undefined) return(NULL);
- if (!s7_is_float_vector(s7_slot_value(fv_slot))) return(NULL);
- s7_xf_store(sc, fv_slot);
-
- return(file_to_frample_pf_sss);
-}
-
-
-static s7_pointer frample_to_file_pf_sss(s7_scheme *sc, s7_pointer **p)
-{
- /* (frample->file gen loc fv) -> fv */
- s7_pointer fv;
- s7_int ind;
- mus_any *stream;
-
- stream = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- fv = s7_slot_value(**p); (*p)++;
- mus_frample_to_file(stream, ind, s7_float_vector_elements(fv));
- return(fv);
-}
-
-static s7_pointer frample_to_file_pf_ssx(s7_scheme *sc, s7_pointer **p)
-{
- /* (frample->file gen loc fv) -> fv */
- s7_pointer fv;
- s7_int ind;
- s7_pf_t pf;
- mus_any *stream;
-
- stream = (mus_any *)(**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- pf = (s7_pf_t)(**p); (*p)++;
- fv = pf(sc, p);
- mus_frample_to_file(stream, ind, s7_float_vector_elements(fv));
- return(fv);
-}
-
-static s7_pf_t frample_to_file_pf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer ind_sym, ind_slot, fv_slot, fv_sym, sym, o;
- mus_xen *gn;
- if (!s7_is_null(sc, s7_cddddr(expr))) return(NULL);
-
- sym = s7_cadr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- s7_xf_store(sc, (s7_pointer)(gn->gen));
-
- ind_sym = s7_caddr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- if (!s7_is_integer(s7_slot_value(ind_slot))) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- fv_sym = s7_cadddr(expr);
- if (s7_is_symbol(fv_sym))
- {
- fv_slot = s7_slot(sc, fv_sym);
- if (fv_slot == xen_undefined) return(NULL);
- if (!s7_is_float_vector(s7_slot_value(fv_slot))) return(NULL);
- s7_xf_store(sc, fv_slot);
- return(frample_to_file_pf_sss);
- }
- if (s7_is_pair(fv_sym))
- {
- s7_pp_t pp;
- s7_pf_t pf;
- s7_int loc;
- pp = s7_pf_function(sc, s7_symbol_value(sc, s7_car(fv_sym)));
- if (!pp) return(NULL);
- loc = s7_xf_store(sc, NULL);
- pf = pp(sc, fv_sym);
- if (!pf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)pf);
- return(frample_to_file_pf_ssx);
- }
- return(NULL);
-}
-
-
-static s7_pointer frample_to_frample_pf_all_s(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer matrix, in_data, in_chans, out_data, out_chans;
- matrix = s7_slot_value(**p); (*p)++;
- in_data = s7_slot_value(**p); (*p)++;
- in_chans = s7_slot_value(**p); (*p)++;
- out_data = s7_slot_value(**p); (*p)++;
- out_chans = s7_slot_value(**p); (*p)++;
-
- mus_frample_to_frample(s7_float_vector_elements(matrix), (int)sqrt(s7_vector_length(matrix)),
- s7_float_vector_elements(in_data), s7_integer(in_chans),
- s7_float_vector_elements(out_data), s7_integer(out_chans));
- return(out_data);
-}
-
-static s7_pf_t frample_to_frample_pf(s7_scheme *sc, s7_pointer expr)
-{
- s7_int i;
- s7_pointer p;
- for (i = 0, p = s7_cdr(expr); (s7_is_pair(p)) && (i < 5); i++, p = s7_cdr(p))
- {
- if (s7_is_symbol(s7_car(p)))
- {
- s7_pointer slot;
- slot = s7_slot(sc, s7_car(p));
- if (slot == xen_undefined) return(NULL);
- s7_xf_store(sc, slot);
- }
- else return(NULL);
- }
- if ((i == 5) && (s7_is_null(sc, p)))
- return(frample_to_frample_pf_all_s);
- return(NULL);
-}
-
-static s7_double ina_rf_ss(s7_scheme *sc, s7_pointer **p)
-{
- s7_int ind;
- mus_any *stream;
- ind = s7_slot_integer_value(**p); (*p)++;
- stream = (mus_any *)(**p); (*p)++;
- return(mus_in_any(ind, 0, stream));
-}
-
-static s7_double ina_rf_ss_checked(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer ind;
- mus_any *stream;
- ind = s7_slot_value(**p); (*p)++;
- if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_ina, 1, ind, "an integer");
- stream = (mus_any *)(**p); (*p)++;
- return(mus_in_any(s7_integer(ind), 0, stream));
-}
-
-static s7_double inb_rf_ss(s7_scheme *sc, s7_pointer **p)
-{
- s7_int ind;
- mus_any *stream;
- ind = s7_slot_integer_value(**p); (*p)++;
- stream = (mus_any *)(**p); (*p)++;
- return(mus_in_any(ind, 1, stream));
-}
-
-static s7_double inb_rf_ss_checked(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer ind;
- mus_any *stream;
- ind = s7_slot_value(**p); (*p)++;
- if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_inb, 1, ind, "an integer");
- stream = (mus_any *)(**p); (*p)++;
- return(mus_in_any(s7_integer(ind), 1, stream));
-}
-
-static s7_double ina_rf_fv(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer fv;
- s7_int index;
- index = s7_slot_integer_value(**p); (*p)++;
- fv = (**p); (*p)++;
- if ((index >= 0) && (index < s7_vector_length(fv)))
- return(s7_float_vector_elements(fv)[index]);
- return(0.0);
-}
-
-static s7_rf_t in_rf(s7_scheme *sc, s7_pointer expr, int chan)
-{
- s7_pointer ind_sym, ind_slot, ind, sym, o;
- mus_xen *gn;
-
- if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
- ind_sym = s7_cadr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if (ind_slot == xen_undefined) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- sym = s7_caddr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- if (s7_is_float_vector(o))
- {
- if ((chan == 0) &&
- (s7_is_stepper(ind_slot)))
- {
- s7_xf_store(sc, o);
- return(ina_rf_fv);
- }
- return(NULL);
- }
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- s7_xf_store(sc, (s7_pointer)(gn->gen));
- if (s7_is_stepper(ind_slot))
- {
- if (chan == 0)
- return(ina_rf_ss);
- return(inb_rf_ss);
- }
- if (chan == 0)
- return(ina_rf_ss_checked);
- return(inb_rf_ss_checked);
-}
-
-static s7_rf_t ina_rf(s7_scheme *sc, s7_pointer expr)
-{
- return(in_rf(sc, expr, 0));
-}
-
-static s7_rf_t inb_rf(s7_scheme *sc, s7_pointer expr)
-{
- return(in_rf(sc, expr, 1));
-}
-
-static s7_double in_any_rf_srs(s7_scheme *sc, s7_pointer **p)
-{
- s7_int ind, chan;
- mus_any *stream;
- ind = s7_slot_integer_value(**p); (*p)++;
- chan = s7_integer(**p); (*p)++;
- stream = (mus_any *)(**p); (*p)++;
- return(mus_in_any(ind, chan, stream));
-}
-
-static s7_rf_t in_any_rf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer ind_sym, ind_slot, ind, sym, o, chan;
- mus_xen *gn;
-
- if (!s7_is_null(sc, s7_cddddr(expr))) return(NULL);
- ind_sym = s7_cadr(expr);
- if (!s7_is_symbol(ind_sym)) return(NULL);
- ind_slot = s7_slot(sc, ind_sym);
- if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
- ind = s7_slot_value(ind_slot);
- if (!s7_is_integer(ind)) return(NULL);
- s7_xf_store(sc, ind_slot);
-
- chan = s7_caddr(expr);
- if (!s7_is_integer(chan)) return(NULL);
- s7_xf_store(sc, chan);
-
- sym = s7_cadddr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
- if (!gn) return(NULL);
- s7_xf_store(sc, (s7_pointer)(gn->gen));
- return(in_any_rf_srs);
-}
-
-
-#define RF2_TO_RF(CName, Rfnc) \
- static s7_double CName ## _rf_r2(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_rf_t f; \
- s7_double x, y; \
- f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); \
- f = (s7_rf_t)(**p); (*p)++; y = f(sc, p); \
- return(Rfnc); \
- } \
- static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) && \
- (s7_arg_to_rf(sc, s7_cadr(expr))) && \
- (s7_arg_to_rf(sc, s7_caddr(expr)))) \
- return(CName ## _rf_r2); \
- return(NULL); \
- }
-
-#define RF_0(Call) \
- static s7_double Call ## _rf_0(s7_scheme *sc, s7_pointer **p) \
- { \
- return(mus_ ## Call()); \
- } \
- static s7_rf_t Call ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- if (!s7_is_null(sc, s7_cdr(expr))) return(NULL); \
- return(Call ## _rf_0); \
- }
-
-RF_0(srate)
-
-
-#define RF_1(Call) \
- static s7_double Call ## _rf_s(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pointer slot; \
- slot = (**p); (*p)++; \
- return(mus_ ## Call(s7_slot_real_value(sc, slot, #Call))); \
- } \
- static s7_double Call ## _rf_c(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pointer slot; \
- slot = (**p); (*p)++; \
- return(mus_ ## Call(s7_number_to_real(sc, slot))); \
- } \
- static s7_double Call ## _rf_r(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_rf_t r; \
- r = (s7_rf_t)(**p); (*p)++; \
- return(mus_ ## Call(r(sc, p))); \
- } \
- static s7_rf_t Call ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- return(s7_rf_1(sc, expr, Call ## _rf_c, Call ## _rf_s, Call ## _rf_r)); \
- }
-
-RF_1(odd_weight)
-RF_1(even_weight)
-RF_1(hz_to_radians)
-RF_1(radians_to_hz)
-RF_1(db_to_linear)
-RF_1(linear_to_db)
-RF_1(radians_to_degrees)
-RF_1(degrees_to_radians)
-RF_1(random)
-
-RF2_TO_RF(contrast_enhancement, mus_contrast_enhancement(x, y))
-RF2_TO_RF(odd_multiple, mus_odd_multiple(x, y))
-RF2_TO_RF(even_multiple, mus_even_multiple(x, y))
-RF2_TO_RF(ring_modulate, x * y)
-
-
-static s7_double polynomial_rf_ss(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1;
- s7_double s2;
- s1 = s7_slot_value(**p); (*p)++;
- s2 = s7_slot_real_value(sc, **p, "polynomial"); (*p)++;
- return(mus_polynomial(s7_float_vector_elements(s1), s2, s7_vector_length(s1)));
-}
-
-static s7_double polynomial_rf_sx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1;
- s7_rf_t r1;
- s1 = s7_slot_value(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(mus_polynomial(s7_float_vector_elements(s1), r1(sc, p), s7_vector_length(s1)));
-}
-
-static s7_rf_t polynomial_rf(s7_scheme *sc, s7_pointer expr)
-{
- if ((s7_is_symbol(s7_cadr(expr))) &&
- (s7_is_float_vector(s7_symbol_value(sc, s7_cadr(expr)))))
- return(s7_rf_2(sc, expr, NULL, NULL, NULL, NULL, polynomial_rf_ss, NULL, NULL, polynomial_rf_sx, NULL));
- return(NULL);
-}
-
-static s7_double pink_noise_rf_v(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1;
- s1 = s7_slot_value(**p); (*p)++;
- return(mus_pink_noise(s1));
-}
-
-static s7_rf_t pink_noise_rf(s7_scheme *sc, s7_pointer expr)
-{
- if (s7_is_symbol(s7_cadr(expr)))
- {
- s7_pointer slot;
- slot = s7_slot(sc, s7_cadr(expr));
- if (s7_is_float_vector(s7_slot_value(slot)))
- {
- s7_xf_store(sc, slot);
- return(pink_noise_rf_v);
- }
- }
- return(NULL);
-}
-
-static s7_double piano_noise_rf_vr(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1;
- s7_double s2;
- s1 = s7_slot_value(**p); (*p)++;
- s2 = s7_slot_real_value(sc, **p, "piano-noise"); (*p)++;
- return(piano_noise(s7_int_vector_elements(s1), s2));
-}
-
-static s7_rf_t piano_noise_rf(s7_scheme *sc, s7_pointer expr)
-{
- if ((s7_is_symbol(s7_cadr(expr))) &&
- (s7_is_symbol(s7_caddr(expr))))
- {
- s7_pointer slot1, slot2;
- slot1 = s7_slot(sc, s7_cadr(expr));
- slot2 = s7_slot(sc, s7_caddr(expr));
- if ((s7_is_int_vector(s7_slot_value(slot1))) &&
- (s7_is_real(s7_slot_value(slot2))))
- {
- s7_xf_store(sc, slot1);
- s7_xf_store(sc, slot2);
- return(piano_noise_rf_vr);
- }
- }
- return(NULL);
-}
-
-
-static s7_double array_interp_rf_sxr(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1;
- s7_int c2;
- s7_rf_t r1;
- s7_double x;
- s1 = s7_slot_value(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- c2 = s7_integer(**p); (*p)++;
- return(mus_array_interp(s7_float_vector_elements(s1), x, c2));
-}
-
-static s7_double array_interp_rf_sxs(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1;
- s7_int s2;
- s7_rf_t r1;
- s7_double x;
- s1 = s7_slot_value(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- s2 = s7_slot_integer_value(**p); (*p)++;
- return(mus_array_interp(s7_float_vector_elements(s1), x, s2));
-}
-
-static s7_rf_t array_interp_rf(s7_scheme *sc, s7_pointer expr)
-{
- if (s7_is_symbol(s7_cadr(expr)))
- {
- s7_pointer rst, fv;
- rst = cdr(expr);
- fv = s7_slot(sc, s7_car(rst));
- if ((fv != xen_undefined) &&
- (s7_is_float_vector(s7_slot_value(fv))))
- {
- if ((!s7_is_null(sc, s7_cddr(rst))) &&
- (s7_is_null(sc, s7_cdddr(rst))))
- {
- s7_xf_store(sc, fv);
- return(s7_rf_2(sc, rst, NULL, NULL, array_interp_rf_sxr, NULL, NULL, array_interp_rf_sxs, NULL, NULL, NULL));
- }
- }
- }
- return(NULL);
-}
-
-static s7_double am_rf_rsx(s7_scheme *sc, s7_pointer **p)
-{
- s7_double c1, c2;
- s7_rf_t r1;
- c1 = s7_number_to_real(sc, **p); (*p)++;
- c2 = s7_slot_real_value(sc, **p, "amplitude-modulation"); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(mus_amplitude_modulate(c1, c2, r1(sc, p)));
-}
-
-static s7_rf_t am_rf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer a1, a2, a3;
- a1 = s7_cadr(expr);
- a2 = s7_caddr(expr);
- a3 = s7_cadddr(expr);
- if ((s7_is_real(a1)) &&
- (s7_is_symbol(a2)) &&
- (s7_is_pair(a3)))
- {
- s7_rp_t rp;
- s7_rf_t rf;
- s7_int loc;
- s7_pointer sym, val;
-
- s7_xf_store(sc, a1);
- val = s7_slot(sc, a2);
- if (val == xen_undefined) return(NULL);
- s7_xf_store(sc, val);
-
- sym = car(a3);
- if (!s7_is_symbol(sym)) return(NULL);
- val = s7_symbol_value(sc, sym);
- rp = s7_rf_function(sc, val);
- if (!rp) return(NULL);
- loc = s7_xf_store(sc, NULL);
- rf = rp(sc, a3);
- if (!rf) return(NULL);
- s7_xf_store_at(sc, loc, (s7_pointer)rf);
-
- return(am_rf_rsx);
- }
- return(NULL);
-}
-
-
-static s7_double mul_env_x_rf(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t r2;
- mus_any *g;
- (*p)++;
- g = (mus_any *)(**p); (*p)++;
- r2 = (s7_rf_t)(**p); (*p)++;
- return(mus_env(g) * r2(sc, p));
-}
-
-static s7_double mul_env_oscil_x_rf(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t r2;
- mus_any *e, *o;
- (*p)++;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- r2 = (s7_rf_t)(**p); (*p)++;
- return(mus_env(e) * mus_oscil_fm(o, r2(sc, p)));
-}
-
-static s7_double fm_violin_rf(s7_scheme *sc, s7_pointer **p)
-{
- mus_any *e, *o, *fp, *a;
- s7_double vib;
- (*p)++;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p) += 2;
- vib = s7_slot_real_value(sc, **p, S_oscil); (*p) += 3;
- a = (mus_any *)(**p); (*p) += 2;
- fp = (mus_any *)(**p); (*p)++;
- return(mus_env(e) * mus_oscil_fm(o, vib + (mus_env(a) * mus_polywave(fp, vib))));
-}
-
-static s7_double mul_env_polywave_x_rf(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t r2;
- mus_any *e, *o;
- (*p)++;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- r2 = (s7_rf_t)(**p); (*p)++;
- return(mus_env(e) * mus_polywave(o, r2(sc, p)));
-}
-
-static s7_double mul_env_polywave_s_rf(s7_scheme *sc, s7_pointer **p)
-{
- s7_double s1;
- mus_any *e, *o;
- (*p)++;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- s1 = s7_slot_real_value(sc, **p, S_polywave); (*p)++;
- return(mus_env(e) * mus_polywave(o, s1));
-}
-
-static s7_double mul_s_comb_bank_x_rf(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t r1;
- s7_double s1;
- mus_any *o;
- s1 = s7_slot_real_value(sc, **p, S_comb_bank); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(s1 * mus_comb_bank(o, r1(sc, p)));
-}
-
-static s7_rp_t initial_multiply_rf;
-static s7_rf_t clm_multiply_rf(s7_scheme *sc, s7_pointer expr)
-{
- s7_rf_t f;
- f = initial_multiply_rf(sc, expr);
- if ((f) &&
- (s7_is_null(sc, s7_cdddr(expr))))
- {
- s7_pointer a1, a2;
- a1 = s7_cadr(expr);
- a2 = s7_caddr(expr);
- if (s7_is_pair(a1))
- {
- if ((s7_car(a1) == env_symbol) &&
- (s7_is_pair(a2)) &&
- (s7_is_symbol(s7_cadr(a1))) &&
- (s7_is_null(sc, s7_cdddr(expr))))
- {
- if ((s7_is_symbol(s7_cadr(a2))) &&
- (s7_is_null(sc, s7_cdddr(a2))))
- {
- if (s7_is_pair(s7_caddr(a2)))
- {
- if (s7_car(a2) == oscil_symbol)
- {
- s7_pointer fm;
- fm = s7_caddr(a2);
- if ((s7_car(fm) == add_symbol) &&
- (s7_is_symbol(s7_cadr(fm))) &&
- (s7_is_pair(s7_caddr(fm))))
- {
- s7_pointer vib_sym;
- vib_sym = s7_cadr(fm);
- fm = s7_caddr(fm);
- if ((s7_car(fm) == multiply_symbol) &&
- (s7_is_pair(s7_cadr(fm))) &&
- (s7_caadr(fm) == env_symbol) &&
- (s7_is_pair(s7_caddr(fm))) &&
- (s7_is_null(sc, s7_cdddr(fm))))
- {
- fm = s7_caddr(fm);
- if ((s7_car(fm) == polywave_symbol) &&
- (s7_is_symbol(s7_cadr(fm))) &&
- (s7_is_symbol(s7_caddr(fm))) &&
- (s7_caddr(fm) == vib_sym))
- return(fm_violin_rf);
- }
- }
- return(mul_env_oscil_x_rf);
- }
- else
- {
- if (s7_car(a2) == polywave_symbol)
- return(mul_env_polywave_x_rf);
- }
- }
- if (s7_is_symbol(s7_caddr(a2)))
- {
- if (s7_car(a2) == polywave_symbol)
- return(mul_env_polywave_s_rf);
- }
- }
- return(mul_env_x_rf);
- }
- }
- else
- {
- if ((s7_is_symbol(a1)) &&
- (s7_is_pair(a2)) &&
- (s7_is_symbol(s7_cadr(a2))) &&
- (s7_car(a2) == comb_bank_symbol) &&
- (s7_is_pair(s7_caddr(a2))) &&
- (s7_is_null(sc, s7_cdddr(a2))))
- return(mul_s_comb_bank_x_rf);
- }
- }
- return(f);
-}
-
-
-static s7_double add_env_ri_rf(s7_scheme *sc, s7_pointer **p)
-{
- mus_any *e, *o;
- (*p)++;
- e = (mus_any *)(**p); (*p) += 2;
- o = (mus_any *)(**p); (*p)++;
- return(mus_env(e) + mus_rand_interp_unmodulated(o));
-}
-
-static s7_double add_tri_ri_rf(s7_scheme *sc, s7_pointer **p)
-{
- mus_any *e, *o;
- (*p)++; /* triangle-wave */
- e = (mus_any *)(**p); (*p) += 2; /* rand-interp */
- o = (mus_any *)(**p); (*p)++;
- return(mus_triangle_wave_unmodulated(e) + mus_rand_interp_unmodulated(o));
-}
-
-static s7_rp_t initial_add_rf;
-static s7_rf_t clm_add_rf(s7_scheme *sc, s7_pointer expr)
-{
- s7_rf_t f;
- f = initial_add_rf(sc, expr);
- if (f)
- {
- s7_pointer a1, a2;
- a1 = s7_cadr(expr);
- a2 = s7_caddr(expr);
- if ((s7_is_pair(a1)) &&
- (s7_is_pair(a2)) &&
- (s7_car(a2) == rand_interp_symbol) &&
- (s7_is_symbol(s7_cadr(a1))) &&
- (s7_is_symbol(s7_cadr(a2))) &&
- (s7_is_null(sc, s7_cddr(a1))) &&
- (s7_is_null(sc, s7_cddr(a2))) &&
- (s7_is_null(sc, s7_cdddr(expr))))
- {
- if (s7_car(a1) == triangle_wave_symbol)
- return(add_tri_ri_rf);
- if (s7_car(a1) == env_symbol)
- return(add_env_ri_rf);
- }
- }
- return(f);
-}
-
-
-static s7_double env_rf_v(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer v;
- mus_xen *gn;
- s7_Int ind;
-
- v = (**p); (*p)++;
- ind = s7_slot_integer_value(**p); (*p)++;
- if ((ind < 0) || (ind >= s7_vector_length(v)))
- s7_out_of_range_error(s7, "vector-ref", 2, s7_make_integer(sc, ind), "must fit in vector");
-
- gn = (mus_xen *)s7_object_value_checked(s7_vector_elements(v)[ind], mus_xen_tag);
- return(mus_env(gn->gen));
-}
-
-static s7_rf_t env_rf_1(s7_scheme *sc, s7_pointer expr)
-{
- if ((s7_is_pair(expr)) &&
- (s7_is_pair(cdr(expr))) &&
- (s7_is_pair(cadr(expr))))
- {
- s7_pointer a1;
- a1 = s7_cadr(expr);
- if ((s7_car(a1) == vector_ref_symbol) &&
- (s7_is_symbol(s7_cadr(a1))) &&
- (s7_is_symbol(s7_caddr(a1))) &&
- (s7_is_null(sc, s7_cdddr(a1))))
- {
- s7_pointer s1, s2, v, ind;
- s7_pointer *els;
- int i, vlen;
-
- s1 = s7_cadr(a1);
- s2 = s7_caddr(a1);
-
- v = s7_symbol_value(sc, s1);
- if (!s7_is_vector(v)) return(NULL);
- vlen = s7_vector_length(v);
- els = s7_vector_elements(v);
- for (i= 0; i < vlen; i++)
- {
- mus_xen *gn;
- gn = (mus_xen *)s7_object_value_checked(els[i], mus_xen_tag);
- if ((!gn) || (!(gn->gen)) || (!mus_is_env(gn->gen))) return(NULL);
- }
-
- ind = s7_slot(sc, s2);
- if ((ind == xen_undefined) || (!s7_is_integer(s7_slot_value(ind)))) return(NULL);
-
- s7_xf_store(sc, v);
- s7_xf_store(sc, ind);
- return(env_rf_v);
- }
- }
- return(env_rf(sc, expr));
-}
-
-
-static s7_double chebyshev_t_rf_a(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t rf;
- s7_pf_t pf;
- s7_double x;
- s7_pointer fv;
- rf = (s7_rf_t)(**p); (*p)++;
- x = rf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- fv = pf(sc, p);
- return(mus_chebyshev_t_sum(x, s7_vector_length(fv), s7_float_vector_elements(fv)));
-}
-
-static s7_rf_t chebyshev_t_rf(s7_scheme *sc, s7_pointer expr)
-{
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) &&
- (s7_arg_to_rf(sc, s7_cadr(expr))) &&
- (s7_arg_to_pf(sc, s7_caddr(expr))))
- return(chebyshev_t_rf_a);
- return(NULL);
-}
-
-static s7_double chebyshev_u_rf_a(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t rf;
- s7_pf_t pf;
- s7_double x;
- s7_pointer fv;
- rf = (s7_rf_t)(**p); (*p)++;
- x = rf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- fv = pf(sc, p);
- return(mus_chebyshev_u_sum(x, s7_vector_length(fv), s7_float_vector_elements(fv)));
-}
-
-static s7_rf_t chebyshev_u_rf(s7_scheme *sc, s7_pointer expr)
-{
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) &&
- (s7_arg_to_rf(sc, s7_cadr(expr))) &&
- (s7_arg_to_pf(sc, s7_caddr(expr))))
- return(chebyshev_u_rf_a);
- return(NULL);
-}
-
-static s7_double chebyshev_tu_rf_a(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t rf;
- s7_pf_t pf;
- s7_double x;
- s7_pointer t, u;
- rf = (s7_rf_t)(**p); (*p)++;
- x = rf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- t = pf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- u = pf(sc, p);
- return(mus_chebyshev_tu_sum(x, s7_vector_length(t), s7_float_vector_elements(t), s7_float_vector_elements(u)));
-}
-
-static s7_rf_t chebyshev_tu_rf(s7_scheme *sc, s7_pointer expr)
-{
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_pair(s7_cdddr(expr))) && (s7_is_null(sc, s7_cddddr(expr))) &&
- (s7_arg_to_rf(sc, s7_cadr(expr))) &&
- (s7_arg_to_pf(sc, s7_caddr(expr))) &&
- (s7_arg_to_pf(sc, s7_cadddr(expr))))
- return(chebyshev_tu_rf_a);
- return(NULL);
-}
-
-
-#define PF2_TO_RF(CName, Cfnc) \
- static s7_double CName ## _rf_a(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pf_t f; \
- s7_pointer x, y; \
- f = (s7_pf_t)(**p); (*p)++; \
- x = f(sc, p); \
- f = (s7_pf_t)(**p); (*p)++; \
- y = f(sc, p); \
- return(Cfnc); \
- } \
- static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) && \
- (s7_arg_to_pf(sc, s7_cadr(expr))) && \
- (s7_arg_to_pf(sc, s7_caddr(expr)))) \
- return(CName ## _rf_a); \
- return(NULL); \
- }
-
-static s7_double c_dot_product(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- s7_int len, lim;
- len = s7_vector_length(x);
- lim = s7_vector_length(y);
- if (lim < len) len = lim;
- if (len == 0) return(0.0);
- return(mus_dot_product(s7_float_vector_elements(x), s7_float_vector_elements(y), len));
-}
-
-PF2_TO_RF(dot_product, c_dot_product(sc, x, y))
-
-static s7_pointer mus_fft_pf_i2(s7_scheme *sc, s7_pointer **p)
-{
- s7_pf_t pf;
- s7_if_t xf;
- s7_pointer rl, im;
- s7_int size, dir;
- pf = (s7_pf_t)(**p); (*p)++; rl = pf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++; im = pf(sc, p);
- xf = (s7_if_t)(**p); (*p)++; size = xf(sc, p);
- xf = (s7_if_t)(**p); (*p)++; dir = xf(sc, p);
- mus_fft(s7_float_vector_elements(rl), s7_float_vector_elements(im), size, dir);
- return(rl);
-}
-
-static s7_pointer mus_fft_pf_i1(s7_scheme *sc, s7_pointer **p)
-{
- s7_pf_t pf;
- s7_if_t xf;
- s7_pointer rl, im;
- s7_int size;
- pf = (s7_pf_t)(**p); (*p)++; rl = pf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++; im = pf(sc, p);
- xf = (s7_if_t)(**p); (*p)++; size = xf(sc, p);
- mus_fft(s7_float_vector_elements(rl), s7_float_vector_elements(im), size, 1);
- return(rl);
-}
-
-static s7_pointer mus_fft_pf_i0(s7_scheme *sc, s7_pointer **p)
-{
- s7_pf_t pf;
- s7_pointer rl, im;
- pf = (s7_pf_t)(**p); (*p)++; rl = pf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++; im = pf(sc, p);
- mus_fft(s7_float_vector_elements(rl), s7_float_vector_elements(im), s7_vector_length(rl), 1);
- return(rl);
-}
-
-static s7_pf_t mus_fft_pf(s7_scheme *sc, s7_pointer expr)
-{
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))))
- {
- s7_pointer trailers;
- if (!s7_arg_to_pf(sc, s7_cadr(expr))) return(NULL);
- if (!s7_arg_to_pf(sc, s7_caddr(expr))) return(NULL);
- trailers = s7_cdddr(expr);
- if (s7_is_null(sc, trailers)) return(mus_fft_pf_i0);
- if (!s7_arg_to_if(sc, s7_car(trailers))) return(NULL);
- if (s7_is_null(sc, s7_cdr(trailers))) return(mus_fft_pf_i1);
- if (!s7_arg_to_if(sc, s7_cadr(trailers))) return(NULL);
- if (!s7_is_null(sc, s7_cddr(trailers))) return(NULL);
- return(mus_fft_pf_i2);
- }
- return(NULL);
-}
-
-
-#define MG_RF(Method, Func) \
- static s7_double mus_ ## Method ## _rf_g(s7_scheme *sc, s7_pointer **p) \
- { \
- mus_any *g; g = (mus_any *)(**p); (*p)++; \
- return(Func(g)); \
- } \
- static s7_rf_t mus_ ## Method ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- mus_any *g; \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- g = cadr_gen(sc, expr); \
- if (g) {s7_xf_store(sc, (s7_pointer)g); return(mus_ ## Method ## _rf_g);} \
- return(NULL); \
- }
-
-#define MG_IF(Method, Func) \
- static s7_int mus_ ## Method ## _if_g(s7_scheme *sc, s7_pointer **p) \
- { \
- mus_any *g; g = (mus_any *)(**p); (*p)++; \
- return(Func(g)); \
- } \
- static s7_if_t mus_ ## Method ## _if(s7_scheme *sc, s7_pointer expr) \
- { \
- mus_any *g; \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- g = cadr_gen(sc, expr); \
- if (g) {s7_xf_store(sc, (s7_pointer)g); return(mus_ ## Method ## _if_g);} \
- return(NULL); \
- }
-
-#define PF_PF(Method, Func) \
- static s7_pointer mus_ ## Method ## _pf_g(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pf_t f; \
- s7_pointer g; \
- f = (s7_pf_t)(**p); (*p)++; \
- g = f(sc, p); \
- return(Func(g)); \
- } \
- static s7_pf_t mus_ ## Method ## _pf(s7_scheme *sc, s7_pointer expr) \
- { \
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
- if (s7_arg_to_pf(sc, s7_cadr(expr))) return(mus_ ## Method ## _pf_g); \
- return(NULL); \
- }
-
-MG_RF(scaler, mus_scaler)
-MG_RF(phase, mus_phase)
-MG_RF(frequency, mus_frequency)
-MG_RF(offset, mus_offset)
-MG_RF(width, mus_width)
-MG_RF(increment, mus_increment)
-MG_RF(feedforward, mus_feedforward)
-MG_RF(feedback, mus_feedback)
-
-MG_IF(length, mus_length)
-MG_IF(order, mus_order)
-MG_IF(location, mus_location)
-MG_IF(channel, mus_channel)
-MG_IF(channels, mus_channels)
-MG_IF(ramp, mus_ramp)
-MG_IF(hop, mus_hop)
-
-
-PF_PF(data, g_mus_data)
-PF_PF(reset, g_mus_reset)
-
-#if 0
-MG_RFIF(xcoeff, mus_xcoeff)
-MG_RFIF(ycoeff, mus_ycoeff)
-MG_PF(xcoeffs, c_mus_xcoeffs) -- x|ycoeffs are complicated and may involve wrapper creation
-MG_PF(ycoeffs, c_mus_ycoeffs)
-MG_PF(file_name, c_mus_file_name) -- requires c->xen string creation
-MG_PF(copy, c_mus_copy) -- allocation
-#endif
-#endif /* gmp */
-
-
-static void init_choosers(s7_scheme *sc)
-{
-#if (!WITH_GMP)
- s7_pointer f;
-#endif
-
- env_symbol = s7_make_symbol(sc, S_env);
- comb_bank_symbol = s7_make_symbol(sc, S_comb_bank);
- vector_ref_symbol = s7_make_symbol(sc, "vector-ref");
- polywave_symbol = s7_make_symbol(sc, S_polywave);
- triangle_wave_symbol = s7_make_symbol(sc, S_triangle_wave);
- rand_interp_symbol = s7_make_symbol(sc, S_rand_interp);
- oscil_symbol = s7_make_symbol(sc, S_oscil);
- multiply_symbol = s7_make_symbol(sc, "*");
- add_symbol = s7_make_symbol(sc, "+");
- quote_symbol = s7_make_symbol(sc, "quote");
- cos_symbol = s7_make_symbol(sc, "cos");
- mus_copy_symbol = s7_make_symbol(sc, "mus-copy");
- copy_function = s7_name_to_value(sc, "copy");
-
- sym_frequency = s7_make_symbol(sc, S_mus_frequency);
- sym_phase = s7_make_symbol(sc, S_mus_phase);
- sym_scaler = s7_make_symbol(sc, S_mus_scaler);
- sym_increment = s7_make_symbol(sc, S_mus_increment);
- sym_width = s7_make_symbol(sc, S_mus_width);
- sym_offset = s7_make_symbol(sc, S_mus_offset);
- sym_feedforward = s7_make_symbol(sc, S_mus_feedforward);
- sym_feedback = s7_make_symbol(sc, S_mus_feedback);
-
-#if (!WITH_GMP)
- f = s7_name_to_value(sc, "*");
- initial_multiply_rf = s7_rf_function(sc, f);
- s7_rf_set_function(f, clm_multiply_rf);
-
- f = s7_name_to_value(sc, "+");
- initial_add_rf = s7_rf_function(sc, f);
- s7_rf_set_function(f, clm_add_rf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_outa), outa_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_outb), outb_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_ina), ina_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_file_to_sample), file_to_sample_rf);
- s7_pf_set_function(s7_name_to_value(sc, S_file_to_frample), file_to_frample_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_frample_to_file), frample_to_file_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_frample_to_frample), frample_to_frample_pf);
- s7_rf_set_function(s7_name_to_value(sc, S_oscil), oscil_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_polywave), polywave_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_wave_train), wave_train_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_granulate), granulate_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_ncos), ncos_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_nrxycos), nrxycos_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_env), env_rf_1);
- s7_rf_set_function(s7_name_to_value(sc, S_readin), readin_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_one_pole), one_pole_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_moving_average), moving_average_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_moving_max), moving_max_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_fir_filter), fir_filter_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_triangle_wave), triangle_wave_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_pulse_train), pulse_train_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_rand_interp), rand_interp_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_formant), formant_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_one_pole_all_pass), one_pole_all_pass_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_delay), delay_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_formant_bank), formant_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_oscil_bank), oscil_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_rand), rand_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_filter), filter_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_table_lookup), table_lookup_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_src), src_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_sawtooth_wave), sawtooth_wave_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_inb), inb_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_in_any), in_any_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_polynomial), polynomial_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_pink_noise), pink_noise_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_piano_noise), piano_noise_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_nsin), nsin_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_nrxysin), nrxysin_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_rxyksin), rxyksin_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_rxykcos), rxykcos_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_tap), tap_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_comb), comb_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_comb_bank), comb_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_notch), notch_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_two_zero), two_zero_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_one_zero), one_zero_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_two_pole), two_pole_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_moving_norm), moving_norm_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_iir_filter), iir_filter_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_square_wave), square_wave_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_firmant), firmant_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_all_pass), all_pass_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_all_pass_bank), all_pass_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_polyshape), polyshape_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_pulsed_env), pulsed_env_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_ssb_am), ssb_am_rf_3);
- s7_rf_set_function(s7_name_to_value(sc, S_asymmetric_fm), asymmetric_fm_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_filtered_comb), filtered_comb_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_filtered_comb_bank), filtered_comb_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_move_sound), move_sound_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_locsig), locsig_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_out_bank), out_bank_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_phase_vocoder), phase_vocoder_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_convolve), convolve_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_sample_to_file), sample_to_file_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_srate), srate_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_contrast_enhancement), contrast_enhancement_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_set_formant_frequency), set_formant_frequency_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_odd_weight), odd_weight_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_even_weight), even_weight_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_odd_multiple), odd_multiple_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_even_multiple), even_multiple_rf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_hz_to_radians), hz_to_radians_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_radians_to_hz), radians_to_hz_rf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_radians_to_degrees), radians_to_degrees_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_degrees_to_radians), degrees_to_radians_rf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_db_to_linear), db_to_linear_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_linear_to_db), linear_to_db_rf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_mus_random), random_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_amplitude_modulate), am_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_ring_modulate), ring_modulate_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_array_interp), array_interp_rf);
-
- s7_pf_set_function(s7_name_to_value(sc, S_is_all_pass), is_all_pass_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_asymmetric_fm), is_asymmetric_fm_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_comb), is_comb_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_comb_bank), is_comb_bank_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_all_pass_bank), is_all_pass_bank_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_convolve), is_convolve_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_delay), is_delay_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_env), is_env_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_filter), is_filter_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_filtered_comb), is_filtered_comb_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_filtered_comb_bank), is_filtered_comb_bank_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_fir_filter), is_fir_filter_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_firmant), is_firmant_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_formant), is_formant_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_granulate), is_granulate_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_iir_filter), is_iir_filter_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_moving_average), is_moving_average_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_moving_max), is_moving_max_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_moving_norm), is_moving_norm_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_ncos), is_ncos_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_notch), is_notch_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_nrxycos), is_nrxycos_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_nrxysin), is_nrxysin_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_nsin), is_nsin_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_one_pole), is_one_pole_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_one_pole_all_pass), is_one_pole_all_pass_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_one_zero), is_one_zero_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_oscil), is_oscil_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_oscil_bank), is_oscil_bank_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_phase_vocoder), is_phase_vocoder_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_polyshape), is_polyshape_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_polywave), is_polywave_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_pulse_train), is_pulse_train_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_pulsed_env), is_pulsed_env_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_rand), is_rand_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_rand_interp), is_rand_interp_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_readin), is_readin_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_rxykcos), is_rxykcos_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_rxyksin), is_rxyksin_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_sawtooth_wave), is_sawtooth_wave_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_square_wave), is_square_wave_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_src), is_src_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_table_lookup), is_table_lookup_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_triangle_wave), is_triangle_wave_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_two_pole), is_two_pole_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_two_zero), is_two_zero_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_wave_train), is_wave_train_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_ssb_am), is_ssb_am_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_is_tap), is_tap_pf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_dot_product), dot_product_rf);
- s7_pf_set_function(s7_name_to_value(sc, S_mus_fft), mus_fft_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_rectangular_to_polar), rectangular_to_polar_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_polar_to_rectangular), polar_to_rectangular_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_rectangular_to_magnitudes), rectangular_to_magnitudes_pf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_chebyshev_t_sum), chebyshev_t_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_chebyshev_u_sum), chebyshev_u_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_chebyshev_tu_sum), chebyshev_tu_rf);
-
- s7_pf_set_function(s7_name_to_value(sc, S_mus_data), mus_data_pf);
- s7_pf_set_function(s7_name_to_value(sc, S_mus_reset), mus_reset_pf);
-
- s7_rf_set_function(s7_name_to_value(sc, S_mus_scaler), mus_scaler_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_phase), mus_phase_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_frequency), mus_frequency_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_offset), mus_offset_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_width), mus_width_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_increment), mus_increment_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_feedforward), mus_feedforward_rf);
- s7_rf_set_function(s7_name_to_value(sc, S_mus_feedback), mus_feedback_rf);
-
- s7_if_set_function(s7_name_to_value(sc, S_mus_length), mus_length_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_order), mus_order_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_location), mus_location_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_channel), mus_channel_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_channels), mus_channels_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_ramp), mus_ramp_if);
- s7_if_set_function(s7_name_to_value(sc, S_mus_hop), mus_hop_if);
-#endif /* gmp */
-}
-#endif /*s7 */
+#endif /*s7 */
Xen_wrap_no_args(g_mus_srate_w, g_mus_srate)
@@ -12492,8 +10610,8 @@ static void mus_xen_init(void)
#if HAVE_SCHEME
s7_pointer s, i, p, t, r, c, f, v, b, d, j;
- s7_pointer pl_rcr, pl_bt, pl_ir, pl_cc, pl_ccic, pl_ccrr, pl_fc, pl_fcif, pl_cs, pl_ff, pl_tt, pl_fffifi, pl_ffftii, pl_fffi,
- pl_fti, pl_fif, pl_fiir, pl_fttb, pl_ic, pl_rciir, pl_rcir, pl_ririt, pl_rcrr, pl_rirt, pl_riirfff, pl_rirfff, pl_rrpr,
+ s7_pointer pl_bt, pl_ir, pl_cc, pl_ccic, pl_ccrr, pl_fc, pl_fcif, pl_cs, pl_ff, pl_tt, pl_fffifi, pl_ffftii, pl_fffi,
+ pl_fti, pl_fif, pl_fiir, pl_fttb, pl_ic, pl_rciir, pl_rcir, pl_ririt, pl_dirt, pl_riirfff, pl_rirfff, pl_rrpr,
pl_sc, pl_sssrs, pl_tc, pl_ici, pl_i, pl_fcf, pl_dcr, pl_dr, pl_dffi, pl_dfri, pl_dirfir, pl_dc, pl_dci, pl_dcir, pl_dv,
pl_dvir, pl_drf, pl_drc, pl_diit, pl_dit, pl_dct, pl_d, pl_djr, pl_it, pl_iti;
#endif
@@ -12508,6 +10626,13 @@ static void mus_xen_init(void)
Xen_GC_protect(as_needed_arglist);
s7_set_object_print_readably(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));
+ s7_gc_protect(s7, clm_error_info);
+
+ extra_args_string = s7_make_string(s7, "extra trailing args?");
+ s7_gc_protect(s7, extra_args_string);
+
s = s7_make_symbol(s7, "string?");
i = s7_make_symbol(s7, "integer?");
p = s7_make_symbol(s7, "pair?");
@@ -12521,7 +10646,6 @@ static void mus_xen_init(void)
d = s7_make_symbol(s7, "float?");
pl_bt = s7_make_signature(s7, 2, b, t);
- pl_rcr = s7_make_signature(s7, 3, r, c, r);
pl_d = s7_make_signature(s7, 1, d);
pl_dcr = s7_make_circular_signature(s7, 2, 3, d, c, r);
@@ -12565,8 +10689,7 @@ static void mus_xen_init(void)
pl_rciir = s7_make_signature(s7, 5, r, c, i, i, r);
pl_rcir = s7_make_signature(s7, 4, r, c, i, r);
pl_ririt = s7_make_signature(s7,5, r, i, r, i, t);
- pl_rcrr = s7_make_signature(s7, 4, r, c, r, r);
- pl_rirt = s7_make_signature(s7, 4, r, i, r, t);
+ pl_dirt = s7_make_signature(s7, 4, d, i, r, t);
pl_riirfff = s7_make_signature(s7, 7, r, i, i, r, f, f, f);
pl_rirfff = s7_make_signature(s7, 6, r, i, r, f, f, f);
pl_rrpr = s7_make_signature(s7, 4, r, r, p, r);
@@ -12582,6 +10705,8 @@ static void mus_xen_init(void)
Xen_GC_protect(xen_one);
xen_minus_one = C_int_to_Xen_integer(-1);
Xen_GC_protect(xen_minus_one);
+ xen_float_zero = C_double_to_Xen_real(0.0);
+ Xen_GC_protect(xen_float_zero);
#if HAVE_FORTH
fth_set_object_inspect(mus_xen_tag, print_mus_xen);
@@ -12781,10 +10906,14 @@ static void mus_xen_init(void)
Xen_define_typed_procedure(S_mus_xcoeffs, g_mus_xcoeffs_w, 1, 0, 0, H_mus_xcoeffs, pl_fc);
Xen_define_typed_procedure(S_mus_ycoeffs, g_mus_ycoeffs_w, 1, 0, 0, H_mus_ycoeffs, pl_fc);
+
Xen_define_typed_procedure(S_is_oscil, g_is_oscil_w, 1, 0, 0, H_is_oscil, pl_bt);
- Xen_define_typed_procedure(S_oscil, g_oscil_w, 1, 2, 0, H_oscil, Q_oscil);
+ Xen_define_typed_procedure(S_oscil, g_oscil_w, 1, 2, 0, H_oscil,
+ s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_oscil), r));
+
Xen_define_typed_procedure(S_is_oscil_bank, g_is_oscil_bank_w, 1, 0, 0, H_is_oscil_bank, pl_bt);
- Xen_define_typed_procedure(S_oscil_bank, g_oscil_bank_w, 1, 0, 0, H_oscil_bank, pl_dc);
+ Xen_define_typed_procedure(S_oscil_bank, g_oscil_bank_w, 1, 0, 0, H_oscil_bank,
+ s7_make_signature(s7, 2, d, s7_make_symbol(s7, S_is_oscil_bank)));
Xen_define_typed_procedure(S_mus_apply, g_mus_apply_w, 0, 0, 1, H_mus_apply, pl_dcr);
@@ -12809,7 +10938,7 @@ static void mus_xen_init(void)
Xen_define_typed_procedure(S_delay_tick, g_delay_tick_w, 1, 1, 0, H_delay_tick,
s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_delay), r));
Xen_define_typed_procedure(S_tap, g_tap_w, 1, 1, 0, H_tap,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_delay), r));
+ s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_tap), r));
Xen_define_typed_procedure(S_notch, g_notch_w, 1, 2, 0, H_notch,
s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_notch), r));
Xen_define_typed_procedure(S_comb, g_comb_w, 1, 2, 0, H_comb,
@@ -12980,9 +11109,10 @@ static void mus_xen_init(void)
Xen_define_typed_procedure(S_one_pole_all_pass, g_one_pole_all_pass_w, 1, 1, 0, H_one_pole_all_pass,
s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_one_pole_all_pass), r));
- Xen_define_typed_procedure(S_mus_set_formant_frequency, g_set_formant_frequency_w, 2, 0, 0, H_mus_set_formant_frequency, pl_rcr);
- Xen_define_typed_procedure(S_mus_set_formant_radius_and_frequency, g_set_formant_radius_and_frequency_w, 3, 0, 0, H_mus_set_formant_radius_and_frequency, pl_rcrr);
-
+ Xen_define_typed_procedure(S_mus_set_formant_frequency, g_set_formant_frequency_w, 2, 0, 0, H_mus_set_formant_frequency,
+ s7_make_signature(s7, 3, d, s7_make_symbol(s7, S_is_formant), r));
+ Xen_define_typed_procedure(S_mus_set_formant_radius_and_frequency, g_set_formant_radius_and_frequency_w, 3, 0, 0, H_mus_set_formant_radius_and_frequency,
+ s7_make_signature(s7, 4, d, s7_make_symbol(s7, S_is_formant), r, r));
Xen_define_typed_procedure(S_make_polyshape, g_make_polyshape_w, 0, 0, 1, H_make_polyshape,
s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_polyshape), t));
@@ -13050,11 +11180,11 @@ static void mus_xen_init(void)
s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_env), t));
Xen_define_typed_procedure(S_env_interp, g_env_interp_w, 2, 0, 0, H_env_interp, pl_drc);
Xen_define_typed_procedure(S_envelope_interp, g_envelope_interp_w, 2, 1, 0, H_envelope_interp, pl_rrpr);
- Xen_define_typed_procedure(S_env_any, g_env_any_w, 2, 0, 0, H_env_any, pl_dct);
+ Xen_define_unsafe_typed_procedure(S_env_any, g_env_any_w, 2, 0, 0, H_env_any, pl_dct);
Xen_define_typed_procedure(S_is_locsig, g_is_locsig_w, 1, 0, 0, H_is_locsig, pl_bt);
Xen_define_typed_procedure(S_locsig, g_locsig_w, 3, 0, 0, H_locsig,
- s7_make_circular_signature(s7, 2, 3, r, s7_make_symbol(s7, S_is_locsig), r));
+ s7_make_signature(s7, 4, r, s7_make_symbol(s7, S_is_locsig), i, r));
Xen_define_typed_procedure(S_make_locsig, g_make_locsig_w, 0, 0, 1, H_make_locsig,
s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_locsig), t));
Xen_define_typed_procedure(S_move_locsig, g_move_locsig_w, 3, 0, 0, H_move_locsig, pl_ccrr);
@@ -13065,7 +11195,8 @@ static void mus_xen_init(void)
Xen_define_procedure(S_locsig_reverb_ref, g_locsig_reverb_ref_w, 2, 0, 0, H_locsig_reverb_ref);
#endif
- Xen_define_typed_procedure(S_locsig_set, g_locsig_set_w, 3, 0, 0, H_locsig_set, pl_rcir);
+ Xen_define_typed_procedure(S_locsig_set, g_locsig_set_w, 3, 0, 0, H_locsig_set,
+ s7_make_signature(s7, 4, d, s7_make_symbol(s7, S_is_locsig), i, r));
#if HAVE_SCHEME || HAVE_FORTH
Xen_define_typed_dilambda(S_locsig_ref, g_locsig_ref_w, H_locsig_ref,
@@ -13112,10 +11243,10 @@ static void mus_xen_init(void)
Xen_define_typed_procedure(S_ina, g_ina_w, 2, 0, 0, H_ina, pl_dit);
Xen_define_typed_procedure(S_inb, g_inb_w, 2, 0, 0, H_inb, pl_dit);
Xen_define_typed_procedure(S_out_any, g_out_any_w, 3, 1, 0, H_out_any, pl_ririt);
- Xen_define_typed_procedure(S_outa, g_outa_w, 2, 1, 0, H_outa, pl_rirt);
- Xen_define_typed_procedure(S_outb, g_outb_w, 2, 1, 0, H_outb, pl_rirt);
- Xen_define_typed_procedure(S_outc, g_outc_w, 2, 1, 0, H_outc, pl_rirt);
- Xen_define_typed_procedure(S_outd, g_outd_w, 2, 1, 0, H_outd, pl_rirt);
+ Xen_define_typed_procedure(S_outa, g_outa_w, 2, 1, 0, H_outa, pl_dirt);
+ Xen_define_typed_procedure(S_outb, g_outb_w, 2, 1, 0, H_outb, pl_dirt);
+ Xen_define_typed_procedure(S_outc, g_outc_w, 2, 1, 0, H_outc, pl_dirt);
+ Xen_define_typed_procedure(S_outd, g_outd_w, 2, 1, 0, H_outd, pl_dirt);
Xen_define_typed_procedure(S_mus_close, g_mus_close_w, 1, 0, 0, H_mus_close, pl_tc);
Xen_define_typed_dilambda(S_mus_file_buffer_size, g_mus_file_buffer_size_w, H_mus_file_buffer_size,
@@ -13136,7 +11267,7 @@ static void mus_xen_init(void)
S_set S_mus_increment, g_mus_set_increment_w, 1, 0, 2, 0, pl_dc, pl_dcr);
Xen_define_typed_procedure(S_is_granulate, g_is_granulate_w, 1, 0, 0, H_is_granulate, pl_bt);
- Xen_define_typed_procedure(S_granulate, g_granulate_w, 1, 2, 0, H_granulate,
+ Xen_define_unsafe_typed_procedure(S_granulate, g_granulate_w, 1, 2, 0, H_granulate,
s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_granulate), t));
Xen_define_typed_procedure(S_make_granulate, g_make_granulate_w, 0, 0, 1, H_make_granulate,
s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_granulate), t));
@@ -13147,22 +11278,22 @@ static void mus_xen_init(void)
Xen_define_typed_procedure(S_clear_sincs, g_mus_clear_sincs_w, 0, 0, 0, "clears out any sinc tables", NULL);
Xen_define_typed_procedure(S_is_src, g_is_src_w, 1, 0, 0, H_is_src, pl_bt);
- Xen_define_typed_procedure(S_src, g_src_w, 1, 2, 0, H_src,
+ Xen_define_unsafe_typed_procedure(S_src, g_src_w, 1, 2, 0, H_src,
s7_make_signature(s7, 4, d, s7_make_symbol(s7, S_is_src), r, t));
Xen_define_typed_procedure(S_make_src, g_make_src_w, 0, 6, 0, H_make_src,
s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_src), t));
Xen_define_typed_procedure(S_is_convolve, g_is_convolve_w, 1, 0, 0, H_is_convolve, pl_bt);
- Xen_define_typed_procedure(S_convolve, g_convolve_w, 1, 1, 0, H_convolve_gen,
+ Xen_define_unsafe_typed_procedure(S_convolve, g_convolve_w, 1, 1, 0, H_convolve_gen,
s7_make_signature(s7, 3, d, s7_make_symbol(s7, S_is_convolve), t));
Xen_define_typed_procedure(S_make_convolve, g_make_convolve_w, 0, 0, 1, H_make_convolve,
s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_convolve), t));
Xen_define_typed_procedure(S_convolve_files, g_convolve_files_w, 2, 2, 0, H_convolve_files, pl_sssrs);
Xen_define_typed_procedure(S_is_phase_vocoder, g_is_phase_vocoder_w, 1, 0, 0, H_is_phase_vocoder, pl_bt);
- Xen_define_typed_procedure(S_phase_vocoder, g_phase_vocoder_w, 1, 4, 0, H_phase_vocoder,
- s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_phase_vocoder), t));
+ Xen_define_unsafe_typed_procedure(S_phase_vocoder, g_phase_vocoder_w, 1, 4, 0, H_phase_vocoder,
+ s7_make_circular_signature(s7, 2, 3, d, s7_make_symbol(s7, S_is_phase_vocoder), t));
Xen_define_typed_procedure(S_make_phase_vocoder, g_make_phase_vocoder_w, 0, 0, 1, H_make_phase_vocoder,
s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_phase_vocoder), t));
Xen_define_typed_procedure(S_phase_vocoder_amp_increments, g_phase_vocoder_amp_increments_w, 1, 0, 0, H_phase_vocoder_amp_increments, pl_fc);
diff --git a/cload.scm b/cload.scm
index ef91a8e..aa47bc1 100644
--- a/cload.scm
+++ b/cload.scm
@@ -218,8 +218,8 @@
(macros ()) ; these are protected by #ifdef ... #endif
(inits ()) ; C code (a string in s7) inserted in the library initialization function
(p #f)
- (if-funcs ()) ; if-functions (guaranteed to return int, so we can optimize away make-integer etc)
- (rf-funcs ()) ; rf-functions
+ (int-funcs ()) ; functions guaranteed to return int
+ (double-funcs ()) ; functions returning double
(sig-symbols (list (cons 'integer? 0) (cons 'boolean? 0) (cons 'real? 0) (cons 'float? 0)
(cons 'char? 0) (cons 'string? 0) (cons 'c-pointer? 0) (cons 't 0)))
(signatures (make-hash-table)))
@@ -363,44 +363,58 @@
(format p "}~%"))
;; add optimizer connection
- (when (and (eq? return-type 'double) ; double (f double) -- s7_rf_t: double f(s7, s7_pointer **p)
- (eq? (car arg-types) 'double)
- (or (= num-args 1)
- (and (= num-args 2) ; double (f double double)
- (eq? (cadr arg-types) 'double))))
- (set! rf-funcs (cons (cons func-name scheme-name) rf-funcs))
- (format p (if (= num-args 1)
- "static s7_double ~A_rf_r(s7_scheme *sc, s7_pointer **p)~
- {s7_rf_t f; s7_double x; f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); return(~A(x));}~%"
- "static s7_double ~A_rf_r(s7_scheme *sc, s7_pointer **p)~% ~
- {s7_rf_t f; s7_double x, y; f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); f = (s7_rf_t)(**p); (*p)++; y = f(sc, p); return(~A(x, y));}~%")
- func-name func-name)
- (format p "static s7_rf_t ~A_rf(s7_scheme *sc, s7_pointer expr) ~
- {if (s7_arg_to_rf(sc, s7_cadr(expr))) return(~A_rf_r); return(NULL);}~%"
- func-name func-name))
+ (define (sig-every? f sequence)
+ (do ((arg sequence (cdr arg)))
+ ((not (and (pair? arg)
+ (f (car arg))))
+ (null? arg))))
+
+ (when (and (eq? return-type 'double)
+ (< num-args 5)
+ (sig-every? (lambda (p) (eq? p 'double)) arg-types))
+ (let ((local-name #f))
+ (case num-args
+ ((0)
+ (set! local-name "_d")
+ (format p "static s7_double ~A~A(void) {return(~A());}~%" func-name local-name func-name))
+ ((1)
+ (set! local-name "_d_d")
+ (format p "static s7_double ~A~A(s7_double x) {return(~A(x));}~%" func-name local-name func-name))
+ ((2)
+ (set! local-name "_d_dd")
+ (format p "static s7_double ~A~A(s7_double x1, s7_double x2) {return(~A(x1, x2));}~%" func-name local-name func-name))
+ ((3)
+ (set! local-name "_d_ddd")
+ (format p "static s7_double ~A~A(s7_double x1, s7_double x2, s7_double x3) {return(~A(x1, x2, x3));}~%" func-name local-name func-name))
+ ((4)
+ (set! local-name "_d_dddd")
+ (format p "static s7_double ~A~A(s7_double x1, s7_double x2, s7_double x3, s7_double x4) {return(~A(x1, x2, x3, x4));}~%" func-name local-name func-name)))
+ (set! double-funcs (cons (list func-name scheme-name local-name) double-funcs))))
(when (and (eq? return-type 'int) ; int (f int|double|void)
- (memq (car arg-types) '(int double void))
- (<= num-args 1))
- (set! if-funcs (cons (cons func-name scheme-name) if-funcs))
- (case (car arg-types)
- ((double)
- (format p "static s7_int ~A_if_r(s7_scheme *sc, s7_pointer **p)~
- {s7_rf_t f; s7_double x; f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); return(~A(x));}~%"
- func-name func-name)
- (format p "static s7_if_t ~A_if(s7_scheme *sc, s7_pointer expr) ~
- {if (s7_arg_to_if(sc, s7_cadr(expr))) return(~A_if_r); return(NULL);}~%"
- func-name func-name))
- ((int)
- (format p "static s7_int ~A_if_i(s7_scheme *sc, s7_pointer **p)~
- {s7_if_t f; s7_int x; f = (s7_if_t)(**p); (*p)++; x = f(sc, p); return(~A(x));}~%"
- func-name (if (string=? func-name "abs") "llabs" func-name))
- (format p "static s7_if_t ~A_if(s7_scheme *sc, s7_pointer expr) ~
- {if (s7_arg_to_if(sc, s7_cadr(expr))) return(~A_if_i); return(NULL);}~%"
- func-name func-name))
- ((void)
- (format p "static s7_int ~A_if_i(s7_scheme *sc, s7_pointer **p) {return(~A());}~%" func-name func-name)
- (format p "static s7_if_t ~A_if(s7_scheme *sc, s7_pointer expr) {return(~A_if_i);}~%" func-name func-name))))
+ (or ;(= num-args 0)
+ (and (= num-args 1)
+ (memq (car arg-types) '(int double)))
+ (and (= num-args 2)
+ (eq? (car arg-types) 'int)
+ (eq? (cadr arg-types) 'int))))
+ (let ((local-name #f))
+ (case (car arg-types)
+ ((void)
+ (set! local-name "_i")
+ (format p "static s7_int ~A~A(void) {return(~A());}~%" func-name local-name func-name))
+ ((double)
+ (set! local-name "_i_d")
+ (format p "static s7_int ~A~A(s7_double x) {return(~A(x));}~%" func-name local-name func-name))
+ ((int)
+ (if (= num-args 1)
+ (begin
+ (set! local-name "_i_i")
+ (format p "static s7_int ~A~A(s7_int i1) {return(~A(i1));}~%" func-name local-name (if (string=? func-name "abs") "llabs" func-name)))
+ (begin
+ (set! local-name "_i_ii")
+ (format p "static s7_int ~A~A(s7_int i1, s7_int i2) {return(~A(i1, i2));}~%" func-name local-name func-name)))))
+ (set! int-funcs (cons (list func-name scheme-name local-name) int-funcs))))
(format p "~%")
(set! functions (cons (list scheme-name base-name
@@ -518,19 +532,19 @@
functions)
;; optimizer connection
- (when (pair? rf-funcs)
- (format p "~% /* rf optimizer connections */~%")
+ (when (pair? double-funcs)
+ (format p "~% /* double optimizer connections */~%")
(for-each
(lambda (f)
- (format p " s7_rf_set_function(s7_name_to_value(sc, ~S), ~A_rf);~%" (cdr f) (car f)))
- rf-funcs))
+ (format p " s7_set~A_function(s7_name_to_value(sc, ~S), ~A~A);~%" (caddr f) (cadr f) (car f) (caddr f)))
+ double-funcs))
- (when (pair? if-funcs)
- (format p "~% /* if optimizer connections */~%")
+ (when (pair? int-funcs)
+ (format p "~% /* int optimizer connections */~%")
(for-each
(lambda (f)
- (format p " s7_if_set_function(s7_name_to_value(sc, ~S), ~A_if);~%" (cdr f) (car f)))
- if-funcs))
+ (format p " s7_set~A_function(s7_name_to_value(sc, ~S), ~A~A);~%" (caddr f) (cadr f) (car f) (caddr f)))
+ int-funcs))
(format p "}~%")
(close-output-port p)
diff --git a/configure b/configure
index d3c56f3..168c60f 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.1.
+# Generated by GNU Autoconf 2.69 for snd 17.5.
#
# Report bugs to <bil at 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.1'
-PACKAGE_STRING='snd 17.1'
+PACKAGE_VERSION='17.5'
+PACKAGE_STRING='snd 17.5'
PACKAGE_BUGREPORT='bil at ccrma.stanford.edu'
PACKAGE_URL=''
@@ -711,6 +711,7 @@ infodir
docdir
oldincludedir
includedir
+runstatedir
localstatedir
sharedstatedir
sysconfdir
@@ -808,6 +809,7 @@ datadir='${datarootdir}'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
+runstatedir='${localstatedir}/run'
includedir='${prefix}/include'
oldincludedir='/usr/include'
docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'
@@ -1060,6 +1062,15 @@ do
| -silent | --silent | --silen | --sile | --sil)
silent=yes ;;
+ -runstatedir | --runstatedir | --runstatedi | --runstated \
+ | --runstate | --runstat | --runsta | --runst | --runs \
+ | --run | --ru | --r)
+ ac_prev=runstatedir ;;
+ -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \
+ | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \
+ | --run=* | --ru=* | --r=*)
+ runstatedir=$ac_optarg ;;
+
-sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
ac_prev=sbindir ;;
-sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
@@ -1197,7 +1208,7 @@ fi
for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \
datadir sysconfdir sharedstatedir localstatedir includedir \
oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
- libdir localedir mandir
+ libdir localedir mandir runstatedir
do
eval ac_val=\$$ac_var
# Remove trailing slashes.
@@ -1310,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.1 to adapt to many kinds of systems.
+\`configure' configures snd 17.5 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1350,6 +1361,7 @@ Fine tuning of the installation directories:
--sysconfdir=DIR read-only single-machine data [PREFIX/etc]
--sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
--localstatedir=DIR modifiable single-machine data [PREFIX/var]
+ --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run]
--libdir=DIR object code libraries [EPREFIX/lib]
--includedir=DIR C header files [PREFIX/include]
--oldincludedir=DIR C header files for non-gcc [/usr/include]
@@ -1380,7 +1392,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of snd 17.1:";;
+ short | recursive ) echo "Configuration of snd 17.5:";;
esac
cat <<\_ACEOF
@@ -1496,7 +1508,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-snd configure 17.1
+snd configure 17.5
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
@@ -1957,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.1, which was
+It was created by snd $as_me 17.5, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
@@ -3304,7 +3316,7 @@ LOCAL_LANGUAGE="None"
GRAPHICS_TOOLKIT="None"
PACKAGE=Snd
-VERSION=17.1
+VERSION=17.5
#--------------------------------------------------------------------------------
# configuration options
@@ -5185,7 +5197,7 @@ if test "$with_ruby" = yes ; then
if $PKG_CONFIG ruby-2.2 --exists ; then
$as_echo "#define HAVE_RUBY 1" >>confdefs.h
- XEN_CFLAGS="`$PKG_CONFIG ruby-2.2 --cflags`"
+ XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby-2.2 --cflags`"
# this depends on building ruby itself with the --enable-shared flag
XEN_LIBS="`$PKG_CONFIG ruby-2.2 --libs`"
LOCAL_LANGUAGE="Ruby"
@@ -5197,7 +5209,7 @@ if test "$with_ruby" = yes ; then
if $PKG_CONFIG ruby-2.1 --exists ; then
$as_echo "#define HAVE_RUBY 1" >>confdefs.h
- XEN_CFLAGS="`$PKG_CONFIG ruby-2.1 --cflags`"
+ XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby-2.1 --cflags`"
# this depends on building ruby itself with the --enable-shared flag
XEN_LIBS="`$PKG_CONFIG ruby-2.1 --libs`"
LOCAL_LANGUAGE="Ruby"
@@ -5209,7 +5221,7 @@ if test "$with_ruby" = yes ; then
if $PKG_CONFIG ruby-2.0 --exists ; then
$as_echo "#define HAVE_RUBY 1" >>confdefs.h
- XEN_CFLAGS="`$PKG_CONFIG ruby-2.0 --cflags`"
+ XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby-2.0 --cflags`"
# this depends on building ruby itself with the --enable-shared flag
XEN_LIBS="`$PKG_CONFIG ruby-2.0 --libs`"
LOCAL_LANGUAGE="Ruby"
@@ -5221,7 +5233,7 @@ if test "$with_ruby" = yes ; then
if $PKG_CONFIG ruby --exists ; then
$as_echo "#define HAVE_RUBY 1" >>confdefs.h
- XEN_CFLAGS="`$PKG_CONFIG ruby --cflags`"
+ XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby --cflags`"
# this depends on building ruby itself with the --enable-shared flag
XEN_LIBS="`$PKG_CONFIG ruby --libs`"
LOCAL_LANGUAGE="Ruby"
@@ -5233,7 +5245,7 @@ if test "$with_ruby" = yes ; then
if $PKG_CONFIG ruby-1.9.3 --exists ; then
$as_echo "#define HAVE_RUBY 1" >>confdefs.h
- XEN_CFLAGS="`$PKG_CONFIG ruby-1.9.3 --cflags`"
+ XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby-1.9.3 --cflags`"
# this depends on building ruby itself with the --enable-shared flag
XEN_LIBS="`$PKG_CONFIG ruby-1.9.3 --libs`"
LOCAL_LANGUAGE="Ruby"
@@ -5245,7 +5257,7 @@ if test "$with_ruby" = yes ; then
if $PKG_CONFIG ruby-1.9 --exists ; then
$as_echo "#define HAVE_RUBY 1" >>confdefs.h
- XEN_CFLAGS="`$PKG_CONFIG ruby-1.9 --cflags`"
+ XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby-1.9 --cflags`"
# this depends on building ruby itself with the --enable-shared flag
XEN_LIBS="`$PKG_CONFIG ruby-1.9 --libs`"
LOCAL_LANGUAGE="Ruby"
@@ -5257,7 +5269,7 @@ if test "$with_ruby" = yes ; then
if $PKG_CONFIG ruby-1.8 --exists ; then
$as_echo "#define HAVE_RUBY 1" >>confdefs.h
- XEN_CFLAGS="`$PKG_CONFIG ruby-1.8 --cflags`"
+ XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby-1.8 --cflags`"
# this depends on building ruby itself with the --enable-shared flag
XEN_LIBS="`$PKG_CONFIG ruby-1.8 --libs`"
LOCAL_LANGUAGE="Ruby"
@@ -6691,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.1, which was
+This file was extended by snd $as_me 17.5, which was
generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -6753,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.1
+snd config.status 17.5
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
diff --git a/configure.ac b/configure.ac
index 38b612d..41b512a 100644
--- a/configure.ac
+++ b/configure.ac
@@ -5,7 +5,7 @@
# gmp, mpfr, and mpc deliberately have none!
-AC_INIT(snd, 17.1, bil at ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-17.tar.gz)
+AC_INIT(snd, 17.5, bil at 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.1
+VERSION=17.5
#--------------------------------------------------------------------------------
# configuration options
@@ -378,7 +378,7 @@ if test "$with_ruby" = yes ; then
if test "$ac_snd_extension_language" = none ; then
if $PKG_CONFIG ruby_version --exists ; then
AC_DEFINE(HAVE_RUBY)
- XEN_CFLAGS="`$PKG_CONFIG ruby_version --cflags`"
+ XEN_CFLAGS="-fPIC `$PKG_CONFIG ruby_version --cflags`"
# this depends on building ruby itself with the --enable-shared flag
XEN_LIBS="`$PKG_CONFIG ruby_version --libs`"
LOCAL_LANGUAGE="Ruby"
diff --git a/dlocsig.scm b/dlocsig.scm
index 79b87b8..198d366 100644
--- a/dlocsig.scm
+++ b/dlocsig.scm
@@ -989,27 +989,29 @@
;;; Nearest point in a line
(define nearest-point
- (let ((vcos (lambda (a0 b0 c0 a1 b1 c1)
- (/ (+ (* a0 a1) (* b0 b1) (* c0 c1))
- (* (distance a0 b0 c0) (distance a1 b1 c1)))))
- (same (lambda (a0 b0 c0 a1 b1 c1)
- (and (= a0 a1) (= b0 b1) (= c0 c1)))))
+ (let ((same (lambda (a0 b0 c0 a1 b1 c1)
+ (and (= a0 a1)
+ (= b0 b1)
+ (= c0 c1)))))
(lambda (x0 y0 z0 x1 y1 z1 px py pz)
(cond ((same x0 y0 z0 px py pz) (list x0 y0 z0))
((same x1 y1 z1 px py pz) (list x1 y1 z1))
((same x0 y0 z0 x1 y1 z1) (list x0 y0 z0))
- (else (let* ((xm0 (- x1 x0))
- (ym0 (- y1 y0))
- (zm0 (- z1 z0))
- (ratio (let ((p (let ((xm1 (- px x0))
- (ym1 (- py y0))
- (zm1 (- pz z0)))
- (* (distance xm1 ym1 zm1)
- (vcos xm0 ym0 zm0 xm1 ym1 zm1)))))
- (/ p (distance xm0 ym0 zm0)))))
- (list (+ x0 (* xm0 ratio))
- (+ y0 (* ym0 ratio))
- (+ z0 (* zm0 ratio)))))))))
+ (else (let ((xm0 (- x1 x0))
+ (ym0 (- y1 y0))
+ (zm0 (- z1 z0)))
+ (let ((ratio (let ((p (let ((xm1 (- px x0))
+ (ym1 (- py y0))
+ (zm1 (- pz z0))
+ (vcos (lambda (a0 b0 c0 a1 b1 c1)
+ (/ (+ (* a0 a1) (* b0 b1) (* c0 c1))
+ (* (distance a0 b0 c0) (distance a1 b1 c1))))))
+ (* (distance xm1 ym1 zm1)
+ (vcos xm0 ym0 zm0 xm1 ym1 zm1)))))
+ (/ p (distance xm0 ym0 zm0)))))
+ (list (+ x0 (* xm0 ratio))
+ (+ y0 (* ym0 ratio))
+ (+ z0 (* zm0 ratio))))))))))
;;; Bezier curve fitting auxilliary functions
@@ -1378,51 +1380,6 @@
(fit-path path))
(let ((xrx ()) (xry ()) (xrz ()) (xrv ()))
- (define (berny xl yl zl xh yh zh ul u uh c err)
- ;; Create a linear segment rendering of a bezier segment
-
- (define (bezier-point u c)
- ;; Evaluate a point at parameter u in bezier segment
- (let ((u1 (- 1 u))
- (cr (vector (make-vector 3 0.0) (make-vector 3 0.0) (make-vector 3 0.0))))
- (do ((j 0 (+ j 1)))
- ((= j 3))
- (set! (cr 0 j) (+ (* u1 (c 0 j)) (* u (c 0 (+ j 1)))))
- (set! (cr 1 j) (+ (* u1 (c 1 j)) (* u (c 1 (+ j 1)))))
- (set! (cr 2 j) (+ (* u1 (c 2 j)) (* u (c 2 (+ j 1))))))
- (do ((i 1 (- i 1)))
- ((< i 0))
- (do ((j 0 (+ j 1)))
- ((> j i))
- (set! (cr 0 j) (+ (* u1 (cr 0 j)) (* u (cr 0 (+ j 1)))))
- (set! (cr 1 j) (+ (* u1 (cr 1 j)) (* u (cr 1 (+ j 1)))))
- (set! (cr 2 j) (+ (* u1 (cr 2 j)) (* u (cr 2 (+ j 1)))))))
- (list (cr 0 0)
- (cr 1 0)
- (cr 2 0))))
-
- (let ((vals (bezier-point u c)))
- (let ((x (car vals))
- (y (cadr vals))
- (z (caddr vals)))
- (let ((val1 (nearest-point xl yl zl xh yh zh x y z)))
- (let ((xn (car val1))
- (yn (cadr val1))
- (zn (caddr val1)))
- (if (<= (distance (- xn x) (- yn y) (- zn z)) err)
- (list () () ())
- (let ((val2 (berny xl yl zl x y z ul (/ (+ ul u) 2) u c err))
- (val3 (berny x y z xh yh zh u (/ (+ u uh) 2) uh c err)))
- (let ((xi (car val2))
- (yi (cadr val2))
- (zi (caddr val2))
- (xj (car val3))
- (yj (cadr val3))
- (zj (caddr val3)))
- (list (append xi (cons x xj))
- (append yi (cons y yj))
- (append zi (cons z zj)))))))))))
-
;; Create linear segment approximations of the bezier segments
;; make sure there are initial and final velocity values
(if (not (pair? (bezier-v path)))
@@ -1457,6 +1414,52 @@
(yf-bz (y-bz (- (length y-bz) 1)))
(zi-bz (car z-bz))
(zf-bz (z-bz (- (length z-bz) 1))))
+
+ (define berny
+ ;; Create a linear segment rendering of a bezier segment
+ (let ((bezier-point
+ (lambda (u c)
+ ;; Evaluate a point at parameter u in bezier segment
+ (let ((u1 (- 1 u))
+ (cr (vector (make-vector 3 0.0) (make-vector 3 0.0) (make-vector 3 0.0))))
+ (do ((j 0 (+ j 1)))
+ ((= j 3))
+ (set! (cr 0 j) (+ (* u1 (c 0 j)) (* u (c 0 (+ j 1)))))
+ (set! (cr 1 j) (+ (* u1 (c 1 j)) (* u (c 1 (+ j 1)))))
+ (set! (cr 2 j) (+ (* u1 (c 2 j)) (* u (c 2 (+ j 1))))))
+ (do ((i 1 (- i 1)))
+ ((< i 0))
+ (do ((j 0 (+ j 1)))
+ ((> j i))
+ (set! (cr 0 j) (+ (* u1 (cr 0 j)) (* u (cr 0 (+ j 1)))))
+ (set! (cr 1 j) (+ (* u1 (cr 1 j)) (* u (cr 1 (+ j 1)))))
+ (set! (cr 2 j) (+ (* u1 (cr 2 j)) (* u (cr 2 (+ j 1)))))))
+ (list (cr 0 0)
+ (cr 1 0)
+ (cr 2 0))))))
+ (lambda (xl yl zl xh yh zh ul u uh c err)
+ (let ((vals (bezier-point u c)))
+ (let ((x (car vals))
+ (y (cadr vals))
+ (z (caddr vals)))
+ (let ((val1 (nearest-point xl yl zl xh yh zh x y z)))
+ (let ((xn (car val1))
+ (yn (cadr val1))
+ (zn (caddr val1)))
+ (if (<= (distance (- xn x) (- yn y) (- zn z)) err)
+ (list () () ())
+ (let ((val2 (berny xl yl zl x y z ul (/ (+ ul u) 2) u c err))
+ (val3 (berny x y z xh yh zh u (/ (+ u uh) 2) uh c err)))
+ (let ((xi (car val2))
+ (yi (cadr val2))
+ (zi (caddr val2))
+ (xj (car val3))
+ (yj (cadr val3))
+ (zj (caddr val3)))
+ (list (append xi (cons x xj))
+ (append yi (cons y yj))
+ (append zi (cons z zj)))))))))))))
+
(let ((vals (berny xi-bz yi-bz zi-bz xf-bz yf-bz zf-bz 0.0 0.5 1.0
(vector (apply vector x-bz)
(apply vector y-bz)
@@ -1526,12 +1529,12 @@
(set! tseg (cons seg tseg))))
dseg))
(set! ti (car tseg))
- (set! times (append times (reverse tseg)))
- (set! xseg (list x))
- (set! yseg (list y))
- (set! zseg (list z))
- (set! vseg (list v))
- (set! vi v))))))))
+ (set! times (append times (reverse tseg))))))
+ (set! xseg (list x))
+ (set! yseg (list y))
+ (set! zseg (list z))
+ (set! vseg (list v))
+ (set! vi v)))))
(set! (path-rx path) xrx)
(set! (path-ry path) xry)
@@ -1625,12 +1628,12 @@
(set! tseg (cons seg tseg))))
dseg))
(set! ti (car tseg))
- (set! times (append times (reverse tseg)))
- (set! xseg (list x))
- (set! yseg (list y))
- (set! zseg (list z))
- (set! vseg (list v))
- (set! vi v)))))))
+ (set! times (append times (reverse tseg))))))
+ (set! xseg (list x))
+ (set! yseg (list y))
+ (set! zseg (list z))
+ (set! vseg (list v))
+ (set! vi v))))
(set! (path-rt path) (let ((val ())
(tf (times (- (length times) 1))))
@@ -1741,48 +1744,48 @@
;; Derive a rotation matrix from an axis vector and an angle
- (define (rotation-matrix x y z angle)
+ (define rotation-matrix
;; translated from C routine by David Eberly
;; (http://www.magic-software.com/)
+
+ (let ((normalize (lambda (a b c)
+ (let ((mag (distance a b c)))
+ (list (/ a mag) (/ b mag) (/ c mag))))))
- (define (normalize a b c)
- (let ((mag (distance a b c)))
- (list (/ a mag) (/ b mag) (/ c mag))))
-
- (let ((rotate (vector (vector 0.0 0.0 0.0) (vector 0.0 0.0 0.0) (vector 0.0 0.0 0.0)))
- (I (vector (vector 1.0 0.0 0.0) (vector 0.0 1.0 0.0) (vector 0.0 0.0 1.0)))
- (A (let ((vals (normalize x y z)))
- (let ((dx (car vals))
- (dy (cadr vals))
- (dz (caddr vals)))
- (vector (vector 0.0 dz (- dy)) (vector (- dz) 0.0 dx) (vector dy (- dx) 0.0)))))
- (AA (vector (vector 0.0 0.0 0.0) (vector 0.0 0.0 0.0) (vector 0.0 0.0 0.0)))
- (sn (sin (- angle)))
- (omcs (- 1 (cos angle)))) ; (cos (- angle)) == (cos angle)
-
- (do ((row 0 (+ 1 row)))
- ((= row 3))
- (do ((col 0 (+ 1 col)))
- ((= col 3))
- (set! (AA row col) 0.0)
- (do ((mid 0 (+ 1 mid)))
- ((= mid 3))
- (set! (AA row col)
- (+ (AA row col)
- (* (A row mid)
- (A mid col)))))))
-
- ;; rotation matrix is I+sin(angle)*A+[1-cos(angle)]*A*A
- (do ((row 0 (+ 1 row)))
- ((= row 3))
- (do ((col 0 (+ 1 col)))
- ((= col 3))
- (set! (rotate row col)
- (+ (I row col)
- (* sn (A row col))
- (* omcs (AA row col))))))
- rotate))
-
+ (lambda (x y z angle)
+ (let ((rotate (vector (vector 0.0 0.0 0.0) (vector 0.0 0.0 0.0) (vector 0.0 0.0 0.0)))
+ (I (vector (vector 1.0 0.0 0.0) (vector 0.0 1.0 0.0) (vector 0.0 0.0 1.0)))
+ (A (let ((vals (normalize x y z)))
+ (let ((dx (car vals))
+ (dy (cadr vals))
+ (dz (caddr vals)))
+ (vector (vector 0.0 dz (- dy)) (vector (- dz) 0.0 dx) (vector dy (- dx) 0.0)))))
+ (AA (vector (vector 0.0 0.0 0.0) (vector 0.0 0.0 0.0) (vector 0.0 0.0 0.0)))
+ (sn (sin (- angle)))
+ (omcs (- 1 (cos angle)))) ; (cos (- angle)) == (cos angle)
+
+ (do ((row 0 (+ 1 row)))
+ ((= row 3))
+ (do ((col 0 (+ 1 col)))
+ ((= col 3))
+ (set! (AA row col) 0.0)
+ (do ((mid 0 (+ 1 mid)))
+ ((= mid 3))
+ (set! (AA row col)
+ (+ (AA row col)
+ (* (A row mid)
+ (A mid col)))))))
+
+ ;; rotation matrix is I+sin(angle)*A+[1-cos(angle)]*A*A
+ (do ((row 0 (+ 1 row)))
+ ((= row 3))
+ (do ((col 0 (+ 1 col)))
+ ((= col 3))
+ (set! (rotate row col)
+ (+ (I row col)
+ (* sn (A row col))
+ (* omcs (AA row col))))))
+ rotate))))
(if (not-rendered path)
(render-path path))
@@ -2219,10 +2222,8 @@
(for-each
(lambda (group)
(let ((vals (find-gains x y z group)))
- (let ((inside (car vals))
- (gains (cadr vals)))
- (if inside
- (return (list group gains))))))
+ (if (car vals) ; inside
+ (return (list group (cadr vals)))))) ; gains
(speaker-config-groups speakers))
(list #f #f))))
@@ -2737,9 +2738,9 @@
((= i len))
(let ((signal (let ((s (spkrs i)))
(* dlocsig-ambisonics-scaler
- (+ (* attW point707)
- (if (zero? dist)
- 0
+ (if (zero? dist)
+ (* attW point707)
+ (+ (* attW point707)
(/ (* att (+ (* x (car s))
(* y (cadr s))
(* z (caddr s))))
@@ -2761,8 +2762,9 @@
((= i rev-channels))
(let ((signal (let ((s ((speaker-config-coords speakers) i)))
(* dlocsig-ambisonics-scaler
- (+ (* rattW point707)
- (if (zero? dist) 0
+ (if (zero? dist)
+ (* rattW point707)
+ (+ (* rattW point707)
(/ (* ratt (+ (* x (car s))
(* y (cadr s))
(* z (caddr s))))
diff --git a/dsp.scm b/dsp.scm
index 6870486..80a9dc2 100644
--- a/dsp.scm
+++ b/dsp.scm
@@ -79,11 +79,12 @@
(do ((den (/ 1.0 (cosh (* N (acosh alpha)))))
(freq (/ pi N))
(i 0 (+ i 1))
- (phase 0.0 (+ phase freq)))
+ (phase 0.0))
((= i N))
(let ((val (* den (cos (* N (acos (* alpha (cos phase))))))))
(set! (rl i) (real-part val))
- (set! (im i) (imag-part val))))) ;this is always essentially 0.0
+ (set! (im i) (imag-part val))) ;this is always essentially 0.0
+ (set! phase (+ phase freq))))
(fft rl im -1) ;direction could also be 1
(float-vector-scale! rl (/ 1.0 (float-vector-peak rl)))
(do ((i 0 (+ i 1))
@@ -107,9 +108,10 @@
(freq (/ pi N))
(mult -1 (- mult))
(i 0 (+ i 1))
- (phase (* -0.5 pi) (+ phase freq)))
+ (phase (* -0.5 pi)))
((= i N))
- (set! (vals i) (* mult den (cos (* N (acos (* alpha (cos phase)))))))))
+ (set! (vals i) (* mult den (cos (* N (acos (* alpha (cos phase)))))))
+ (set! phase (+ phase freq))))
;; now take the DFT
(let ((pk 0.0)
(w (make-vector N)))
@@ -1825,7 +1827,7 @@ and replaces it with the spectrum given in coeffs")
(pcoeffs (partials->polynomial coeffs))
(peaks (make-vector pairs))
(peaks2 (make-vector pairs))
- (flt (make-filter 2 (float-vector 1 -1) (float-vector 0 -0.9)))
+ (flt (make-filter 2 #r(1 -1) #r(0 -0.9)))
(old-mx (maxamp))
(len (- (or dur (framples snd chn edpos)) beg)))
(let ((summer (make-float-vector len))
diff --git a/env.scm b/env.scm
index fcea76a..86f1249 100644
--- a/env.scm
+++ b/env.scm
@@ -47,7 +47,7 @@ end: (window-envelope 1.0 3.0 '(0.0 0.0 5.0 1.0)) -> '(1.0 0.2 3.0 0.6)"))
((<= x end)
(set! nenv (append nenv (list x y)))
(if (= x end) (return-early nenv)))
- ((> x end)
+ (else ;(> x end)
(return-early
(append nenv (list end (envelope-interp end e))))))))
(append nenv (list end lasty))))))))
@@ -58,37 +58,35 @@ end: (window-envelope 1.0 3.0 '(0.0 0.0 5.0 1.0)) -> '(1.0 0.2 3.0 0.6)"))
(define map-envelopes
(let ((documentation "(map-envelopes func env1 env2) maps func over the breakpoints in env1 and env2 returning a new envelope"))
(lambda (op e1 e2)
- (let ((xs ()))
- (let ((at0
- (lambda (e)
- (let* ((diff (car e))
- (len (length e))
- (lastx (e (- len 2)))
- (newe (copy e)))
- (do ((i 0 (+ i 2)))
- ((>= i len) newe)
- (let ((x (/ (- (newe i) diff) lastx)))
- (set! xs (cons x xs))
- (set! (newe i) x)))))))
- (if (null? e1)
- (at0 e2)
- (if (null? e2)
- (at0 e1)
- (let ((ee1 (at0 e1))
- (ee2 (at0 e2))
- (newe ()))
- (set! xs (sort!
- (let rem-dup ((lst xs)
- (nlst ()))
- (cond ((null? lst) nlst)
- ((member (car lst) nlst) (rem-dup (cdr lst) nlst))
- (else (rem-dup (cdr lst) (cons (car lst) nlst)))))
- <))
- (do ((len (length xs))
- (i 0 (+ i 1)))
- ((= i len) newe)
- (let ((x (xs i)))
- (set! newe (append newe (list x (op (envelope-interp x ee1) (envelope-interp x ee2)))))))))))))))
+ (let* ((xs ())
+ (at0 (lambda (e)
+ (let* ((diff (car e))
+ (len (length e))
+ (lastx (e (- len 2)))
+ (newe (copy e)))
+ (do ((i 0 (+ i 2)))
+ ((>= i len) newe)
+ (let ((x (/ (- (newe i) diff) lastx)))
+ (set! xs (cons x xs))
+ (set! (newe i) x)))))))
+ (if (null? e1)
+ (at0 e2)
+ (if (null? e2)
+ (at0 e1)
+ (let ((ee1 (at0 e1))
+ (ee2 (at0 e2))
+ (newe ()))
+ (set! xs (let ((lxs (let rem-dup ((lst xs)
+ (nlst ()))
+ (cond ((null? lst) nlst)
+ ((member (car lst) nlst) (rem-dup (cdr lst) nlst))
+ (else (rem-dup (cdr lst) (cons (car lst) nlst)))))))
+ (sort! lxs <)))
+ (do ((len (length xs))
+ (i 0 (+ i 1)))
+ ((= i len) newe)
+ (let ((x (xs i)))
+ (set! newe (append newe (list x (op (envelope-interp x ee1) (envelope-interp x ee2))))))))))))))
;;; -------- multiply-envelopes, add-envelopes
@@ -432,7 +430,7 @@ each segment: (powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))"))
(x-max (e (- (length e) 2))))
(do ((x-incr (* 1.0 (/ (- x-max x-min) xgrid)))
(new-e ())
- (x x-min (+ x x-incr)))
+ (x x-min))
((>= x x-max)
(reverse new-e))
(let ((y (envelope-interp x e)))
@@ -441,7 +439,8 @@ each segment: (powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))"))
(+ mn
(* largest-diff
(expt (/ (- y mn) largest-diff) power))))
- (cons x new-e))))))))))
+ (cons x new-e)))
+ (set! x (+ x x-incr)))))))))
;;; rms-envelope
@@ -560,4 +559,4 @@ each segment: (powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))"))
(set! qy ty)
(set! qtx ttx)
(set! qty tty)))))))))
-
\ No newline at end of file
+
diff --git a/enved.scm b/enved.scm
index c33510e..9de7b6c 100644
--- a/enved.scm
+++ b/enved.scm
@@ -35,7 +35,7 @@
(define mouse-down 0)
(define mouse-up 0)
-(define click-time 10) ; .1 sec?
+(define click-time (/ internal-time-units-per-second 10.0)) ; sets whether a mouse motion is a click or a drag
(define mouse-pos 0)
(define mouse-new #f)
@@ -104,15 +104,12 @@
(- (list-ref cur-env (+ mouse-pos 2)) .001))))))
(ly (max 0.0 (min y 1.0))))
(set! (channel-envelope snd chn)
- (let ((pos mouse-pos)
- (x lx)
- (y ly))
- (do ((new-env ())
- (e cur-env (cddr e))
- (npos 0 (+ npos 2)))
- ((= npos pos)
- (append new-env (list x y) (cddr e)))
- (set! new-env (append new-env (list (car e) (cadr e)))))))
+ (do ((new-env ())
+ (e cur-env (cddr e))
+ (npos 0 (+ npos 2)))
+ ((= npos mouse-pos)
+ (append new-env (list lx ly) (cddr e)))
+ (set! new-env (append new-env (list (car e) (cadr e))))))
(update-lisp-graph snd chn)))))
@@ -128,13 +125,12 @@
(= mouse-pos 0)
(>= mouse-pos (- (length cur-env) 2))))
(set! (channel-envelope snd chn)
- (let ((pos mouse-pos)
- (new-env ()))
+ (let ((new-env ()))
(let search-point ((e cur-env)
(npos 0))
(if (null? e)
new-env
- (if (= pos npos)
+ (if (= mouse-pos npos)
(append new-env (cddr e))
(begin
(set! new-env (append new-env (list (car e) (cadr e))))
diff --git a/examp.scm b/examp.scm
index 538048f..f2a8045 100644
--- a/examp.scm
+++ b/examp.scm
@@ -296,7 +296,7 @@
(snd-print (format #f "odd: ~S is using a reserved layer description" mpgfile)))
(let ((chans (if (= channel-mode 3) 1 2))
(mpeg-layer (case layer ((3) 1) ((2)) (else 3)))
- (srate (/ (#(44100 48000 32000 0) srate-index)
+ (srate (/ (#i(44100 48000 32000 0) srate-index)
(case id ((0) 4) ((2)) (else 1)))))
(snd-print (format #f "~S: ~A Hz, ~A, MPEG-~A~%"
mpgfile srate (if (= chans 1) "mono" "stereo") mpeg-layer))
@@ -574,7 +574,7 @@ otherwise it moves the cursor to the first offending sample"))
(call-with-exit
(lambda (quit)
(do ((i 0 (+ i 1)))
- ((= i len) #t)
+ ((= i len)) ; returns #t
(if (not (proc (next-sample reader)))
(begin
(set! (cursor) i)
@@ -901,9 +901,10 @@ section: (float-vector->channel (fft-smoother .1 (cursor) 400) (cursor) 400)"))
(do ((incr (let ((offset1 (- old1 new1)))
(if (= offset1 offset0) 0.0 (/ (- offset1 offset0) samps))))
(i 0 (+ i 1))
- (trend offset0 (+ trend incr)))
+ (trend offset0))
((= i samps))
- (set! (rl i) (+ (rl i) trend)))
+ (set! (rl i) (+ (rl i) trend))
+ (set! trend (+ trend incr)))
rl))))))))))
@@ -1062,7 +1063,7 @@ formants, then calls map-channel: (osc-formants .99 (float-vector 400.0 800.0 12
(define flecho
(let ((documentation "(flecho scaler secs) returns a low-pass filtered echo maker: (map-channel (flecho .5 .9) 0 75000)"))
(lambda (scaler secs)
- (let ((flt (make-fir-filter :order 4 :xcoeffs (float-vector .125 .25 .25 .125)))
+ (let ((flt (make-fir-filter :order 4 :xcoeffs #r(.125 .25 .25 .125)))
(del (make-delay (round (* secs (srate))))))
(lambda (inval)
(+ inval
diff --git a/extensions.scm b/extensions.scm
index ef45a6d..ee2ded1 100644
--- a/extensions.scm
+++ b/extensions.scm
@@ -159,20 +159,14 @@ a list (file-name-or-sound-object [beg [channel]])."))
;; a virtual mix -- use simplest method available
((sound? input) ; sound object case
- (let ((input-snd input)
- (input-chn input-channel)
- (input-len len)
- (output-snd snd)
- (output-chn chn)
- (output-beg start))
- (if (< input-len 1000000)
- (mix-float-vector (channel->float-vector input-beg input-len input-snd input-chn) output-beg output-snd output-chn #t)
- (let* ((output-name (snd-tempnam))
- (output (new-sound output-name :size input-len)))
- (float-vector->channel (samples input-beg input-len input-snd input-chn) 0 input-len output 0)
- (save-sound output)
- (close-sound output)
- (mix output-name output-beg 0 output-snd output-chn #t #t)))))
+ (if (< len 1000000)
+ (mix-float-vector (channel->float-vector input-beg len input input-channel) start snd chn #t)
+ (let* ((output-name (snd-tempnam))
+ (output (new-sound output-name :size len)))
+ (float-vector->channel (samples input-beg len input input-channel) 0 len output 0)
+ (save-sound output)
+ (close-sound output)
+ (mix output-name start 0 snd chn #t #t))))
((and (= start 0) ; file input
(= len (framples input)))
diff --git a/extsnd.html b/extsnd.html
index 6419a60..8a6bbe3 100644
--- a/extsnd.html
+++ b/extsnd.html
@@ -186,7 +186,7 @@ related documentation:
<li><a href="#sndobjects">Snd's objects</a>
<ul>
<li><a href="#samplers">Samplers</a>
- <li><a href="#Vcts">Vcts, Float-vectors</a>
+ <li><a href="#Floatvectors">Float-vectors, vcts</a>
<li><a href="#extsndlib">Sndlib</a>
<li><a href="#sndmarks">Marks</a>
<li><a href="#sndmixes">Mixes</a>
@@ -1580,7 +1580,7 @@ samplers, regions, and players, all of which should be compared with equal?, not
<a href="#regionchans">region-chans</a>,
the current selection (<a href="#selectionchans">selection-chans</a>),
<a href="sndclm.html#genericfunctions">mus-channels</a>,
-<a href="#sndmixes">mixes</a>, <a href="#Vcts">vcts</a>, and vectors (always 1 channel), and
+<a href="#sndmixes">mixes</a>, <a href="#Floatvectors">float-vectors</a>, and vectors (always 1 channel), and
<a href="#sndsounds">sounds</a> (as objects or as integers).
</p>
<div class="spacer"></div>
@@ -1671,7 +1671,7 @@ and <a href="#regionframples">region-framples</a>.
<p id="genericmaxamp">maxamp can handle a sound (via the regular <a href="#maxamp">maxamp</a> function),
string (treated as a sound file name, <a href="#mussoundmaxamp">mus-sound-maxamp</a>),
-generator (maxamp of the mus-data vct, if any),
+generator (maxamp of the mus-data float-vector, if any),
float-vector,
region (<a href="#regionmaxamp">region-maxamp</a>),
the current selection (<a href="#selectionmaxamp">selection-maxamp</a>),
@@ -3392,7 +3392,7 @@ demands on memory.
</pre>
<p>make-mix-sampler creates a mix-sampler reading 'mix' starting (in the mix input) at 'beg'.
-See <a href="sndscm.html#mixtovct">mix->float-vector</a> in mix.scm.
+See <a href="sndscm.html#mixtofv">mix->float-vector</a> in mix.scm.
</p>
<div class="spacer"></div>
@@ -3669,35 +3669,35 @@ If *reverb* is a snd->sample generator, for example,
-<!-- INDEX Vcts:Vcts -->
+<!-- INDEX Floatvectors:Float-vectors -->
-<div class="header" id="Vcts">Vcts or float-vectors</div>
+<div class="header" id="Floatvectors">float-vectors or vcts</div>
<p>These are arrays of floats. In s7, use "float-vector", and in Forth and
Ruby use "vct".
</p>
-<!-- VCT TABLE -->
+<!-- FLOATVECTOR TABLE -->
<div class="spacer"></div>
-<!-- list->vct -->
+<!-- list->float-vector -->
<pre class="indented">
-<em class=def id="listtovct">list->vct</em> lst
<em class=def id="listtofv">list->float-vector</em> lst
+<em class=emdef>list->vct</em> lst
</pre>
-<p>return a new float-vector with elements of list 'lst' (equivalent to the <a href="#vct">float-vector</a> function).
+<p>return a new float-vector with elements of list 'lst' (equivalent to the <a href="#fv">float-vector</a> function).
</p>
<div class="spacer"></div>
-<!-- make-vct -->
+<!-- make-float-vector -->
<pre class="indented">
-<em class=def id="makevct">make-vct</em> len (initial-element 0.0)
<em class=def id="makefv">make-float-vector</em> len (initial-element 0.0)
+<em class=emdef>make-vct</em> len (initial-element 0.0)
</pre>
<p>make-float-vector creates a float-vector of size 'len'.
@@ -3705,10 +3705,10 @@ Ruby use "vct".
<div class="spacer"></div>
-<!-- vct -->
+<!-- float-vector -->
<pre class="indented">
-<em class=def id="vct">vct</em> :rest args
<em class=def id="fv">float-vector</em> :rest args
+<em class=emdef>vct</em> :rest args
</pre>
<p>float-vector is equivalent to list->float-vector with 'args' as the list: <code>(float-vector 0.0 0.1 0.2)</code>.
@@ -3716,10 +3716,10 @@ Ruby use "vct".
<div class="spacer"></div>
-<!-- vct? -->
+<!-- float-vector? -->
<pre class="indented">
-<em class=def id="vctp">vct?</em> v
<em class=def id="fvp">float-vector?</em> v
+<em class=emdef>vct?</em> v
</pre>
<p>float-vector? returns #t if 'v' is a float-vector.
@@ -3727,10 +3727,10 @@ Ruby use "vct".
<div class="spacer"></div>
-<!-- vct-abs! -->
+<!-- float-vector-abs! -->
<pre class="indented">
-<em class=def id="vctabs">vct-abs!</em> v
<em class=def id="fvabs">float-vector-abs!</em> v
+<em class=emdef>vct-abs!</em> v
</pre>
<p>float-vector-abs! replaces each element of 'v' with its absolute value.
@@ -3738,10 +3738,10 @@ Ruby use "vct".
<div class="spacer"></div>
-<!-- vct-add! -->
+<!-- float-vector-add! -->
<pre class="indented">
-<em class=def id="vctadd">vct-add!</em> v1 v2 (off 0)
<em class=def id="fvadd">float-vector-add!</em> v1 v2 (off 0)
+<em class=emdef>vct-add!</em> v1 v2 (off 0)
</pre>
<p>float-vector-add! performs element-wise add: v1[i + off] += v2[i], returning 'v1'.
@@ -3749,10 +3749,10 @@ Ruby use "vct".
<div class="spacer"></div>
-<!-- vct-copy -->
+<!-- float-vector-copy -->
<pre class="indented">
-<em class=def id="vctcopy">vct-copy</em> v
-<em class=def id="fvcopy">float-vector-copy</em> v
+<em class=def id="fvcopy">copy</em> v
+<em class=emdef>vct-copy</em> v
</pre>
<p>float-vector-copy returns a copy of the float-vector 'v'.
@@ -3766,22 +3766,22 @@ Ruby use "vct".
copy file: in Scheme: copy-file, in Ruby: File.copy or File.syscopy<br>
copy string: in Forth: string-copy<br>
copy list: in Forth: list-copy or copy-tree<br>
-copy mix: <a href="sndscm.html#mixtovct">mix->float-vector</a><br>
+copy mix: <a href="sndscm.html#mixtofv">mix->float-vector</a><br>
copy sampler: <a href="#copysampler">copy-sampler</a><br>
copy (clone) current sound edit state: <a href="#clonesoundas">clone-sound-as</a><br>
-copy channel data: <a href="#channeltovct">channel->float-vector</a>, or <a href="#savesoundas">save-sound-as</a><br>
-copy selection data: <a href="#selection2vct">selection->float-vector</a> or <a href="#saveselection">save-selection</a><br>
-copy region data: <a href="#regiontovct">region->float-vector</a>, <a href="#saveregion">save-region</a><br>
-copy transform data: <a href="#transformtovct">transform->float-vector</a><br>
+copy channel data: <a href="#channeltofv">channel->float-vector</a>, or <a href="#savesoundas">save-sound-as</a><br>
+copy selection data: <a href="#selection2fv">selection->float-vector</a> or <a href="#saveselection">save-selection</a><br>
+copy region data: <a href="#regiontofv">region->float-vector</a>, <a href="#saveregion">save-region</a><br>
+copy transform data: <a href="#transformtofv">transform->float-vector</a><br>
</small></blockquote>
</td></tr></TABLE>
<div class="spacer"></div>
-<!-- vct-equal? -->
+<!-- float-vector-equal? -->
<pre class="indented">
-<em class=def id="vctequal">vct-equal?</em> v1 v2 diff
<em class=def id="fvequal">float-vector-equal?</em> v1 v2 diff
+<em class=emdef>vct-equal?</em> v1 v2 diff
</pre>
<p>float-vector-equal? is an element-wise relative difference check.
@@ -3792,10 +3792,10 @@ are of different lengths, the overlapping portion is checked.
<div class="spacer"></div>
-<!-- vct-fill! -->
+<!-- float-vector-fill! -->
<pre class="indented">
-<em class=def id="vctfill">vct-fill!</em> v val
<em class=def id="fvfill">float-vector-fill!</em> v val
+<em class=emdef>vct-fill!</em> v val
</pre>
<p>float-vector-fill! sets each element of 'v' to 'val': v[i] = val. It returns 'v'.
@@ -3803,10 +3803,10 @@ are of different lengths, the overlapping portion is checked.
<div class="spacer"></div>
-<!-- vct-length -->
+<!-- float-vector-length -->
<pre class="indented">
-<em class=def id="vctlength">vct-length</em> v
<em class=def id="fvlength">float-vector-length</em> v
+<em class=emdef>vct-length</em> v
</pre>
<p>float-vector-length returns the length of 'v'.
@@ -3814,10 +3814,10 @@ are of different lengths, the overlapping portion is checked.
<div class="spacer"></div>
-<!-- vct-max -->
+<!-- float-vector-max -->
<pre class="indented">
-<em class=def id="vctmax">vct-max</em> v
<em class=def id="fvmax">float-vector-max</em> v
+<em class=emdef>vct-max</em> v
</pre>
<p>float-vector-max returns the maximum value of the elements of 'v'.
@@ -3825,10 +3825,10 @@ are of different lengths, the overlapping portion is checked.
<div class="spacer"></div>
-<!-- vct-min -->
+<!-- float-vector-min -->
<pre class="indented">
-<em class=def id="vctmin">vct-min</em> v
<em class=def id="fvmin">float-vector-min</em> v
+<em class=emdef>vct-min</em> v
</pre>
<p>float-vector-min returns the minimum value of the elements of 'v'.
@@ -3836,10 +3836,10 @@ are of different lengths, the overlapping portion is checked.
<div class="spacer"></div>
-<!-- vct-move! -->
+<!-- float-vector-move! -->
<pre class="indented">
-<em class=def id="vctmove">vct-move!</em> v new old backwards
<em class=def id="fvmove">float-vector-move!</em> v new old backwards
+<em class=emdef>vct-move!</em> v new old backwards
</pre>
<p>float-vector-move moves a block of values within a float-vector: v[new++] = v[old++], or
@@ -3848,10 +3848,10 @@ if 'backwards' is #t: v[new--] = v[old--]. It returns 'v'.
<div class="spacer"></div>
-<!-- vct-multiply! -->
+<!-- float-vector-multiply! -->
<pre class="indented">
-<em class=def id="vctmultiply">vct-multiply!</em> v1 v2
<em class=def id="fvmultiply">float-vector-multiply!</em> v1 v2
+<em class=emdef>vct-multiply!</em> v1 v2
</pre>
<p>float-vector-multiply! performs element-wise multiply of two float-vectors: v1[i] *= v2[i]. It returns 'v1'.
@@ -3859,10 +3859,10 @@ if 'backwards' is #t: v[new--] = v[old--]. It returns 'v'.
<div class="spacer"></div>
-<!-- vct-offset! -->
+<!-- float-vector-offset! -->
<pre class="indented">
-<em class=def id="vctoffset">vct-offset!</em> v val
<em class=def id="fvoffset">float-vector-offset!</em> v val
+<em class=emdef>vct-offset!</em> v val
</pre>
<p>float-vector-offset! adds 'val' to each element of 'v': v[i] += val. It returns 'v'.
@@ -3870,10 +3870,10 @@ if 'backwards' is #t: v[new--] = v[old--]. It returns 'v'.
<div class="spacer"></div>
-<!-- vct-peak -->
+<!-- float-vector-peak -->
<pre class="indented">
-<em class=def id="vctpeak">vct-peak</em> v
<em class=def id="fvpeak">float-vector-peak</em> v
+<em class=emdef>vct-peak</em> v
</pre>
<p>float-vector-peak returns the maximum absolute value of the elements of 'v'.
@@ -3881,10 +3881,10 @@ if 'backwards' is #t: v[new--] = v[old--]. It returns 'v'.
<div class="spacer"></div>
-<!-- vct-ref -->
+<!-- float-vector-ref -->
<pre class="indented">
-<em class=def id="vctref">vct-ref</em> v pos
<em class=def id="fvref">float-vector-ref</em> v pos
+<em class=emdef>vct-ref</em> v pos
</pre>
<p>float-vector-ref returns the element 'pos' in 'v': v[pos].
@@ -3892,10 +3892,10 @@ if 'backwards' is #t: v[new--] = v[old--]. It returns 'v'.
<div class="spacer"></div>
-<!-- vct-reverse! -->
+<!-- float-vector-reverse! -->
<pre class="indented">
-<em class=def id="vctreverse">vct-reverse!</em> v size
<em class=def id="fvreverse">float-vector-reverse!</em> v size
+<em class=emdef>vct-reverse!</em> v size
</pre>
<p>float-vector-reverse! reverses the elements of 'v' (in-place), returning 'v'.
@@ -3904,10 +3904,10 @@ If 'size' is given, the reversal centers around it.
<div class="spacer"></div>
-<!-- vct-scale! -->
+<!-- float-vector-scale! -->
<pre class="indented">
-<em class=def id="vctscale">vct-scale!</em> v scl
<em class=def id="fvscale">float-vector-scale!</em> v scl
+<em class=emdef>vct-scale!</em> v scl
</pre>
<p>float-vector-scale! multiplies each element of 'v' by 'scl': v[i] *= scl. It returns 'v'.
@@ -3915,10 +3915,10 @@ If 'size' is given, the reversal centers around it.
<div class="spacer"></div>
-<!-- vct-set! -->
+<!-- float-vector-set! -->
<pre class="indented">
-<em class=def id="vctset">vct-set!</em> v pos val
<em class=def id="fvset">float-vector-set!</em> v pos val
+<em class=emdef>vct-set!</em> v pos val
</pre>
<p>float-vector-set! sets the float-vector 'v' element at 'pos' to 'val': v[pos] = val.
@@ -3927,10 +3927,10 @@ In Scheme, this is the same as (set! (v pos) val).
<div class="spacer"></div>
-<!-- vct-subtract! -->
+<!-- float-vector-subtract! -->
<pre class="indented">
-<em class=def id="vctsubtract">vct-subtract!</em> v1 v2
<em class=def id="fvsubtract">float-vector-subtract!</em> v1 v2
+<em class=emdef>vct-subtract!</em> v1 v2
</pre>
<p>float-vector-subtract! performs an element-wise subtract: v1[i] -= v2[i]. It returns 'v1'.
@@ -3938,10 +3938,10 @@ In Scheme, this is the same as (set! (v pos) val).
<div class="spacer"></div>
-<!-- vct-subseq -->
+<!-- float-vector-subseq -->
<pre class="indented">
-<em class=def id="vctsubseq">vct-subseq</em> v start (end len) nv
<em class=def id="fvsubseq">float-vector-subseq</em> v start (end len) nv
+<em class=emdef>vct-subseq</em> v start (end len) nv
</pre>
<p>float-vector-subseq returns a new float-vector (or 'nv' if given) with the elements of 'v' between 'start' and 'end' inclusive. 'end' defaults
@@ -3950,10 +3950,10 @@ to the end of 'v'.
<div class="spacer"></div>
-<!-- vct+ -->
+<!-- float-vector+ -->
<pre class="indented">
-<em class=def id="vctplus">vct+</em> obj1 obj2
<em class=def id="fvplus">float-vector+</em> obj1 obj2
+<em class=emdef>vct+</em> obj1 obj2
</pre>
<p>float-vector+ combines float-vector-add! and float-vector-offset!,
@@ -3962,10 +3962,10 @@ depending on the type of its arguments.
<div class="spacer"></div>
-<!-- vct* -->
+<!-- float-vector* -->
<pre class="indented">
-<em class=def id="vcttimes">vct*</em> obj1 obj2
<em class=def id="fvtimes">float-vector*</em> obj1 obj2
+<em class=emdef>vct*</em> obj1 obj2
</pre>
<p>float-vector* combines float-vector-multiply! and float-vector-scale!,
@@ -3974,10 +3974,10 @@ depending on the type of its arguments.
<div class="spacer"></div>
-<!-- vct->channel -->
+<!-- float-vector->channel -->
<pre class="indented">
-<em class=def id="vcttochannel">vct->channel</em> v (beg 0) dur snd chn edpos origin
<em class=def id="fvtochannel">float-vector->channel</em> v (beg 0) dur snd chn edpos origin
+<em class=emdef>vct->channel</em> v (beg 0) dur snd chn edpos origin
</pre>
<p>float-vector->channel sets the samples from 'beg' to 'beg' + 'dur' from the values in 'v'.
@@ -3986,10 +3986,10 @@ This changes (edits) the channel, so 'origin' provides a way to name the edit (f
<div class="spacer"></div>
-<!-- vct->list -->
+<!-- float-vector->list -->
<pre class="indented">
-<em class=def id="vcttolist">vct->list</em> v
<em class=def id="fvtolist">float-vector->list</em> v
+<em class=emdef>vct->list</em> v
</pre>
<p>float-vector->list returns a list with elements of 'v'.
@@ -3997,10 +3997,10 @@ This changes (edits) the channel, so 'origin' provides a way to name the edit (f
<div class="spacer"></div>
-<!-- vct->string -->
+<!-- float-vector->string -->
<pre class="indented">
-<em class=def id="vcttostring">vct->string</em> v
<em class=def id="fvtostring">float-vector->string</em> v
+<em class=emdef>vct->string</em> v
</pre>
<p>float-vector->string returns a string describing 'v'.
@@ -4010,7 +4010,7 @@ This changes (edits) the channel, so 'origin' provides a way to name the edit (f
<!-- vct->vector -->
<pre class="indented">
-<em class=def id="vcttovector">vct->vector</em> v
+<em class=emdef>vct->vector</em> v
</pre>
<p>vct->vector returns a vector with the elements of 'v'.
@@ -4020,7 +4020,7 @@ This changes (edits) the channel, so 'origin' provides a way to name the edit (f
<!-- vector->vct -->
<pre class="indented">
-<em class=def id="vectortovct">vector->vct</em> vect
+<em class=emdef>vector->vct</em> vect
</pre>
<p>vector->vct returns a vct with elements of vector 'vect'.
@@ -5156,7 +5156,7 @@ the Mix Dialog, various hooks, and various mouse-related actions.
</p>
<p>A mix is an object that represents a channel (one channel in and one channel out) of a sound mix.
-Various mixing functions create these objects (mix-vct for example). In the old days, mixes were identified
+Various mixing functions create these objects (mix-float-vector for example). In the old days, mixes were identified
by integers, so for conversion you can use mix->integer and integer->mix.
Say we have a mix object stored in the variable "id":
</p>
@@ -5370,7 +5370,7 @@ red; but (set! (mix-color mx) red) sets only mix mx's waveform to red.
> (mix-home mx)
(#<sound 0> 0 "/home/bil/cl/pistol.snd" 0)
;; (list output-sound-index output-channel input-filename input-channel)
-> (set! mx (mix-vct (make-vct 100 .1) 2000))
+> (set! mx (mix-float-vector (make-float-vector 100 .1) 2000))
#<mix 1>
> (mix-home mx)
(#<sound 0> 0 #f 0)
@@ -5619,16 +5619,16 @@ example, if you know the frequency of the mix sound, you can reflect that in the
<div class="spacer"></div>
-<!-- mix-vct -->
+<!-- mix-float-vector -->
<pre class="indented">
-<em class=def id="mixvct">mix-vct</em> vct beg snd chn with-mix-tags origin
+<em class=def id="mixfv">mix-float-vector</em> v beg snd chn with-mix-tags origin
</pre>
-<p>mix-vct is one of the basic mixing functions. It
-mixes the contents of 'vct' into the given channel starting at sample 'beg'.
+<p>mix-float-vector is one of the basic mixing functions. It
+mixes the contents of 'v' into the given channel starting at sample 'beg'.
If 'with-mix-tags' is #f (the default is #t), the data is
mixed without creating any mix tags.
-mix-vct returns the id of the new mix, or -1 (a simple mix, no tag).
+mix-float-vector returns the id of the new mix, or -1 (a simple mix, no tag).
</p>
<div class="spacer"></div>
@@ -5681,11 +5681,11 @@ mix sound file: <a href="extsnd.html#mix">mix</a> or drag-and-drop it where you
mix channel: see <a href="sndscm.html#mixchannel">mix-channel</a> in extensions.scm<br>
mix region: <a href="extsnd.html#mixregion">mix-region</a><br>
mix selection: <a href="extsnd.html#mixselection">mix-selection</a><br>
-mix vct: <a href="extsnd.html#mixvct">mix-vct</a><br>
+mix float-vector: <a href="extsnd.html#mixfv">mix-float-vector</a><br>
enveloped mix: see <a href="sndscm.html#envelopedmix">enveloped-mix</a> in extensions.scm<br>
read mix samples: <a href="extsnd.html#makemixsampler">make-mix-sampler</a><br>
mix data maxamp: <a href="sndscm.html#mixmaxamp">mix-maxamp</a><br>
-mix data to vct: <a href="sndscm.html#mixtovct">mix->vct</a><br>
+mix data to float-vector: <a href="sndscm.html#mixtofv">mix->float-vector</a><br>
save mix data in file: <a href="extsnd.html#savemix">save-mix</a><br>
mix property list: <a href="extsnd.html#mixproperty">mix-property</a> in mix.scm<br>
pan mono sound into stereo: see <a href="sndscm.html#placesound">place-sound</a> in examp.scm<br>
@@ -5922,19 +5922,19 @@ data, and its length in framples.
<div class="spacer"></div>
-<!-- region->vct -->
+<!-- region->float-vector -->
<pre class="indented">
-<em class=def id="regiontovct">region->vct</em> reg samp samps chan v
+<em class=def id="regiontofv">region->float-vector</em> reg samp samps chan v
</pre>
-<p>region->vct returns a vct containing 'samps' samples starting at 'samp' in channel 'chan' of the region 'reg'.
-If 'v' (a vct) is provided, it is filled,
-rather than creating a new vct.
+<p>region->float-vector returns a float-vector containing 'samps' samples starting at 'samp' in channel 'chan' of the region 'reg'.
+If 'v' (a float-vector) is provided, it is filled,
+rather than creating a new one.
</p>
<pre class="indented">
(define (region-rms n)
- (let* ((data (<em class=red>region->vct</em> (integer->region 0) 0 #f n))
+ (let* ((data (<em class=red>region->float-vector</em> (integer->region 0) 0 #f n))
(len (length data)))
(sqrt (/ (<a class=quiet href="sndclm.html#dot-product">dot-product</a> data data len) len))))
</pre>
@@ -6070,7 +6070,7 @@ These are equivalent:
<p>filter-selection applies an FIR filter of order 'order' and frequency response 'env'
to the selection. 'env' can be the filter coefficients
-themselves in a vct with at least 'order' elements, or
+themselves in a float-vector with at least 'order' elements, or
a CLM filtering generator (see <a href="#filtersound">filter-sound</a>).
If 'truncate' is #t (the default), the filter output is truncated at the selection
end. If 'truncate' is #f, the extra output ('order' samples worth) is mixed into the stuff following the selection.
@@ -6157,7 +6157,7 @@ saving them in files named 'base'.n: (brksnd 1.0 \"sec\")"))
</pre>
<p>scale-selection-by scales (multiplies) the selection by 'scalers' which can be either a float,
-a list of floats, or a vct. In a multichannel selection, each member of the vct or list
+a list of floats, or a float-vector. In a multichannel selection, each member of the float-vector or list
is applied to the next channel in the selection. (scale-selection-by '(0.0 2.0)) scales
the first channel by 0.0, the second (if any) by 2.0. (scale-selection-by 2.0) scales
all channels by 2.0. Normally the order of channels follows the order of the sounds.
@@ -6171,7 +6171,7 @@ all channels by 2.0. Normally the order of channels follows the order of the so
</pre>
<p>scale-selection-to normalizes the selection to peak amplitude 'norms' which can be either a float,
-a list of floats, or a vct.
+a list of floats, or a float-vector.
</p>
<div class="spacer"></div>
@@ -6501,7 +6501,7 @@ The following substitutions can be made:
<a href="#reversesound">reverse-sound</a> s c e <a href="#reversechannel">reverse-channel</a> beg dur s c e
<A href="#scaleby">scale-by</A> scls s c <a href="#scalechannel">scale-channel</a> scl beg dur s c e
<A href="#scaleto">scale-to</A> scls s c <a href="#normalizechannel">normalize-channel</a> norm beg dur s c e
-<a href="#setsamples">set-samples</a> beg dur data s c trunc origin fchan <a href="#vcttochannel">vct->channel</a> vct beg dur s c e
+<a href="#setsamples">set-samples</a> beg dur data s c trunc origin fchan <a href="#fvtochannel">float-vector->channel</a> v beg dur s c e
<a href="#smoothsound">smooth-sound</a> beg dur s c <a href="#smoothchannel">smooth-channel</a> beg dur s c e
<a href="#srcsound">src-sound</a> num base s c e <a href="#srcchannel">src-channel</a> ratio-or-env beg dur s c e
<a href="#undo">undo</a> edits s c <a href="#undochannel">undo-channel</a> edits s c
@@ -6660,7 +6660,7 @@ See <a href="#snpmark">snap-mark-to-beat</a>, or <a href="sndscm.html#snapmixtob
<em class=def id="channelampenvs">channel-amp-envs</em> file chan size peak-file-func work-proc-func
</pre>
-<p>channel-amp-envs returns two vcts of length 'size' containing the peak-amp envelopes of the channel 'chan' of file 'file'.
+<p>channel-amp-envs returns two float-vectors of length 'size' containing the peak-amp envelopes of the channel 'chan' of file 'file'.
'peak-file-func' (if any) is used to get the name of the associated peak-env file if the file is very large.
'work-proc-func' is called when the amp envs are ready if the amp envs are gathered in the background.
If 'file' is a sound, 'size' is an edit-position, and the current amp envs (if any) are returned.
@@ -6768,12 +6768,12 @@ The following code sets the 'unite' button if the current sound has more than 4
<div class="separator"></div>
-<!-- channel->vct -->
+<!-- channel->float-vector -->
<pre class="indented">
-<em class=def id="channeltovct">channel->vct</em> beg dur snd chn edpos
+<em class=def id="channeltofv">channel->float-vector</em> beg dur snd chn edpos
</pre>
-<p id="selection2vct">channel->vct returns a vct with the specified data. In Ruby, the "->" in a function name is translated to "2",
+<p id="selection2fv">channel->float-vector returns a float-vector with the specified data. In Ruby, the "->" in a function name is translated to "2",
so the function call is:
</p>
@@ -6781,16 +6781,16 @@ so the function call is:
</pre>
<pre class="indented">
-(define* (selection->vct snd chn)
+(define* (selection->float-vector snd chn)
(cond ((selection-member? snd chn)
- (channel->vct (selection-position snd chn) (selection-framples snd chn) snd chn))
+ (channel->float-vector (selection-position snd chn) (selection-framples snd chn) snd chn))
((selection?)
(error 'no-such-channel
- (list "selection->vct"
+ (list "selection->float-vector"
(format #f "snd ~A channel ~D is not a member of the selection" snd chn))))
(else
- (error 'no-active-selection (list "selection->vct")))))
+ (error 'no-active-selection (list "selection->float-vector")))))
</pre>
<p>See also mark-explode in marks.scm.
@@ -7337,7 +7337,7 @@ if you don't want all the directory junk. See examp.scm for many examples.
<p>The regularized version of filter-sound. If the end of the filtered portion is not the end of the sound,
the 'trunc' argument determines whether the filtered sound is truncated at that point (the default: #t),
or mixed with the overlapping section, similar to the truncate argument to <a href="#filterselection">filter-selection</a>.
-'env' can be either the frequency response envelope, or a vct containing the desired coefficients.
+'env' can be either the frequency response envelope, or a float-vector containing the desired coefficients.
</p>
<div class="separator"></div>
@@ -7349,7 +7349,7 @@ or mixed with the overlapping section, similar to the truncate argument to <a hr
<p>filter-sound applies an FIR filter of order 'order' (actually one more than the nominal order)
and frequency response 'env'
-to the given channel. 'env' can also be a vct containing the filter coefficients,
+to the given channel. 'env' can also be a float-vector containing the filter coefficients,
or any CLM filtering generator
(e.g. comb, formant, one-pole, iir-filter, etc). The generator
is called in C, not Scheme, so this is the fastest way to apply
@@ -7518,7 +7518,7 @@ associated with channel 'chn' in 'snd'.
</pre>
<p id="xdisplayenergy">The current slider values can be read from <a href="#xpositionslider">x-position-slider</a>,
-<a href="#xzoomslider">x-zoom-slider</a>, etc. The 'data' argument can be a list of vcts; each is graphed at the same time, following the sequence of
+<a href="#xzoomslider">x-zoom-slider</a>, etc. The 'data' argument can be a list of float-vectors; each is graphed at the same time, following the sequence of
colors used when channels are superimposed. If 'data'
is a list of numbers, it is assumed to be an envelope (a list of breakpoints).
If 'force-display' is #f (the default is #t), the graph is not
@@ -7649,7 +7649,7 @@ insert some portion of a channel: <a href="sndscm.html#insertchannel">insert-cha
insert a silence: <a href="extsnd.html#padchannel">pad-channel</a>, <a href="extsnd.html#insertsilence">insert-silence</a>, <a href="sndscm.html#padsound">pad-sound</a><br>
insert a region: <a href="extsnd.html#insertregion">insert-region</a><br>
insert the selection: <a href="extsnd.html#insertselection">insert-selection</a><br>
-insert a vct of samples: <a href="extsnd.html#insertsamples">insert-samples</a><br>
+insert a float-vector of samples: <a href="extsnd.html#insertsamples">insert-samples</a><br>
insert a sound: <a href="extsnd.html#insertsound">insert-sound</a><br>
append a sound and silence: <a href="extsnd.html#appendsound">append-sound</a><br>
</small></blockquote>
@@ -7663,7 +7663,7 @@ append a sound and silence: <a href="extsnd.html#appendsound">append-sound</a><b
<em class=def id="insertsamples">insert-samples</em> samp samps data snd chn edpos auto-delete origin
</pre>
-<p>This inserts 'samps' samples of 'data' (normally a vct) starting at sample 'samp' in the given channel.
+<p>This inserts 'samps' samples of 'data' (normally a float-vector) starting at sample 'samp' in the given channel.
'data' can be a filename.
The regularized version of this is:
</p>
@@ -7864,7 +7864,7 @@ can return #f, which means that the data passed in is
deleted (replaced by nothing), or a number which replaces the
current sample,
or #t which halts the mapping operation, leaving trailing samples
-unaffected, or a vct
+unaffected, or a float-vector
the contents of which are spliced into the edited version, effectively
replacing the current sample with any number of samples. This sounds
more complicated than it is! Basically, a map-channel function receives
@@ -8184,7 +8184,7 @@ file ok:
<p>There are
other ways to get at sound file data: <a class=quiet href="#makesampler">make-sampler</a> can be given a filename,
-rather than a sound; file->vct in examp.scm;
+rather than a sound; file->float-vector in examp.scm;
<a class=quiet href="#mussoundopeninput">mus-sound-open-input</a> and
there are a variety of CLM-based functions such as
<a class=quiet href="sndclm.html#filetosample">file->sample</a> and
@@ -8621,7 +8621,7 @@ reverse via FFT: <a href="extsnd.html#sillyreverse">silly-reverse</a><br>
reverse order of channels: <a href="extsnd.html#reversechannels">reverse-channels</a><br>
reverse a list: reverse and reverse!<br>
reverse a string: in Ruby: reverse<br>
-reverse vct: <a href="extsnd.html#vctreverse">vct-reverse!</a><br>
+reverse float-vector: reverse!<br>
</small></blockquote>
</td></tr></TABLE>
<div class="separator"></div>
@@ -8709,7 +8709,7 @@ samples at 'samp', so:
<em class=def id="samples">samples</em> samp samps snd chn edpos
</pre>
-<p>This returns a vct of 'samps' samples starting at 'samp' in the given channel.
+<p>This returns a float-vector of 'samps' samples starting at 'samp' in the given channel.
'samp' defaults to 0. 'samps' defaults to framples - 'samp' (i.e. read to the end of the data).
'pos' is the edit history position to read (it defaults to the current position).
This is settable (as is <a href="#sample">sample</a>):
@@ -8717,9 +8717,9 @@ This is settable (as is <a href="#sample">sample</a>):
<pre class="indented">
> (samples 1000 10)
-#<vct[len=10]: 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004>
-> (set! (samples 1000 10) (make-vct 10 .1))
-#<vct[len=10]: 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100>
+#<float-vector[len=10]: 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004>
+> (set! (samples 1000 10) (make-float-vector 10 .1))
+#<float-vector[len=10]: 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100>
</pre>
<div class="separator"></div>
@@ -8916,7 +8916,7 @@ Forth:
<p>scale-by <a href="snd.html#scaling">scales</a> the amplitude of 'snd' by 'scalers'. Unlike most of these functions,
scale-by follows the 'sync' buttons and affects all currently sync'd
-channels. 'scalers' can be either a float, a list, or a vct.
+channels. 'scalers' can be either a float, a list, or a float-vector.
In the latter case, the values are used one by one, applying each as
scale-by moves through the channels. If 'sync' is off, channel 'chn'
is scaled (it defaults to the currently selected channel). <code>(scale-by 2.0)</code> doubles all samples.
@@ -9005,7 +9005,7 @@ There are approximately a bazillion ways to scale samples in Snd; here's a potpo
<p>scale-to <a href="snd.html#scaling">normalizes</a> 'snd' to 'norms' (following <a class=quiet href="#sync">sync</a> as in <a href="#scaleby">scale-by</a>).
(scale-to 0.5) scales the current channel so that its maxamp is 0.5.
If all the sound's samples are 0.0, scale-to returns #f and does not perform any edit.
-'norms' can be a number, a list of numbers, or a vct.
+'norms' can be a number, a list of numbers, or a float-vector.
</p>
<div class="separator"></div>
@@ -9122,7 +9122,7 @@ If 'samp' is beyond the end of the file, the file is first zero-padded to reach
</pre>
<p>replaces 10000 samples with data from oboe.snd.
-If 'data' is a vct, set-samples is identical to <a href="#vcttochannel">vct->channel</a>.
+If 'data' is a float-vector, set-samples is identical to <a href="#fvtochannel">float-vector->channel</a>.
If 'trunc' is #t and 'samp' is 0, the
sound is truncated (if necessary) to reflect the end of 'data'.
If the in-coming data file has more than one channel, 'infile-chan'
@@ -10034,13 +10034,13 @@ autocorrelation walsh-transform cepstrum
<div class="separator"></div>
-<!-- transform->vct -->
+<!-- transform->float-vector -->
<pre class="indented">
-<em class=def id="transformtovct">transform->vct</em> snd chn v
+<em class=def id="transformtofv">transform->float-vector</em> snd chn v
</pre>
-<p>This returns a vct with the transform data from the given channel.
-If 'v' (a vct) is provided, it is filled, rather than creating a new vct.
+<p>This returns a float-vector with the transform data from the given channel.
+If 'v' (a float-vector) is provided, it is filled, rather than creating a new one.
See <a href="#fftpeak">fft-peak</a> for an example.
</p>
<div class="separator"></div>
@@ -10649,7 +10649,7 @@ rattling effect.
</pre>
<p>The <a class=quiet href="snd.html#filtercontrol">filter</a> coefficients (read-only currently). It is
-a vct suitable for use with the <a href="sndclm.html#filter">filter generator</a> or with
+a float-vector suitable for use with the <a href="sndclm.html#filter">filter generator</a> or with
<a href="#filtersound">filter-sound</a>.
</p>
<div class="spacer"></div>
@@ -11282,7 +11282,7 @@ of the resultant graph. 'lo' and 'hi' set which portion of the returned data
to graph (normally 0.0 to 1.0). 'proc' is a function of two
arguments, the length of the desired transform, and a sampler that
can be used to get the current data. Do not free the sampler!
-The function should return a vct containing the transform data.
+The function should return a float-vector containing the transform data.
add-transform returns the new transform's transform-type (an object).
Here's an example that displays a histogram of the current values in 16 bins:
</p>
@@ -11331,11 +11331,11 @@ Here's an example that displays a histogram of the current values in 16 bins:
<em class=def id="fft">fft</em> rl im sgn
</pre>
-<p>This performs an FFT on vcts 'rl' and 'im' (the real and imaginary parts of the
+<p>This performs an FFT on float-vectors 'rl' and 'im' (the real and imaginary parts of the
input data). 'sgn' is 1 for an FFT, -1 for an inverse FFT; (the default is 1).
The CLM <a href="sndclm.html#fft">fft</a> function is called mus-fft in Snd.
The only difference between the two is that Snd's fft determines the fft size from
-the size of the vcts passed to it, whereas CLM's takes the size as an argument.
+the size of the float-vectors passed to it, whereas CLM's takes the size as an argument.
Here's an example that uses the fft to produce a sum of sinusoids each with arbitrary amplitude
and initial-phase:
</p>
@@ -11373,7 +11373,7 @@ and initial-phase:
<em class=def id="sndspectrum">snd-spectrum</em> data window length (linear #t) (beta 0.0) in-place (normalized #t)
</pre>
-<p>This returns the spectrum (as a vct) of 'data' (also a vct) using the fft window 'win'.
+<p>This returns the spectrum (as a float-vector) of 'data' (also a float-vector) using the fft window 'win'.
'length' is the number of samples
of data.
</p>
@@ -11385,7 +11385,7 @@ of data.
<p>If 'linear' is #f (its default is #t), the spectrum is in dB.
'beta' is the fft data window family parameter; it is scaled internally so here it should be between 0.0 and 1.0.
-If 'in-place' is #t, the spectrum is in 'data', otherwise snd-spectrum returns a new vct.
+If 'in-place' is #t, the spectrum is in 'data', otherwise snd-spectrum returns a new float-vector.
</p>
<div class="spacer"></div>
@@ -11414,7 +11414,7 @@ If 'in-place' is #t, the spectrum is in 'data', otherwise snd-spectrum returns a
<p>Other related variables and functions:</p>
<pre class="indented">
<a href="#transformgraphp">transform-graph?</a> <a href="#showtransformpeaks">show-transform-peaks</a> <a href="#transformsample">transform-sample</a>
-<a href="#fftbeta">fft-window-beta</a> <a href="#showselectiontransform">show-selection-transform</a> <a href="#transformtovct">transform->vct</a>
+<a href="#fftbeta">fft-window-beta</a> <a href="#showselectiontransform">show-selection-transform</a> <a href="#transformtofv">transform->float-vector</a>
<a href="#aftertransformhook">after-transform-hook</a> <a href="#spectrumend">spectrum-end</a> <a href="#transformframples">transform-framples</a>
<a href="#fftlogfrequency">fft-log-frequency</a> <a href="#spectrohop">spectro-hop</a> <a href="#transformtype">transform-type</a>
<a href="#fftlogmagnitude">fft-log-magnitude</a> <a href="#spectrumstart">spectrum-start</a> <a href="#updatetransformgraph">update-transform-graph</a>
@@ -13750,7 +13750,7 @@ use with <a href="#colormap">colormap</a> or <a href="#colormapref">colormap-ref
'func' is a function of one argument, the desired colormap size; it will be
called whenever the new colormap's values are needed or the colormap size changes,
so that the colormap needs to be recomputed. It should return a list of
-three vcts, each vct containing 'size' values representing respectively
+three float-vectors, each float-vector containing 'size' values representing respectively
the red, green, and blue values (each a number between 0.0 and 1.0).
In the following code, the fields are set from envelopes (this is a loose translation
of FractInt's royal colormap):
@@ -14023,7 +14023,7 @@ or the local envelope editor code in xm-enved.scm.
</pre>
<p>This draws dots of size 'dot-size' from the (x y) pairs in the vector 'positions' in the specified context.
-draw-dots, draw-lines, and fill-polygon take vectors, rather than vcts (which would be more consistent
+draw-dots, draw-lines, and fill-polygon take vectors, rather than float-vectors (which would be more consistent
with the rest of Snd) because the values passed are supposed to be short ints.
</p>
<div class="spacer"></div>
@@ -14223,8 +14223,8 @@ The 'alpha' argument only matters in Gtk.
<p id="displaydb">Use make-graph-data to get the currently displayed data (i.e. the waveform displayed
in the graph, which can be based on an overall peak envelope rather than the
individual samples).
-It returns either a vct (if the graph has one trace), or a
-list of two vcts (the two sides of the peak envelope graph).
+It returns either a float-vector (if the graph has one trace), or a
+list of two float-vectors (the two sides of the peak envelope graph).
'edit-position' defaults to the current edit history position,
'low-sample' defaults to the current window left sample, and
'high-sample' defaults to the current rightmost sample.
@@ -14260,8 +14260,8 @@ The result can be used in the lisp graph:
presenting the same thing in dB in the lisp graph. <a href="sndscm.html#displayenergy">display-energy</a>
in draw.scm is another example. But the real power of this function
comes from its use with graph-data.
-The latter takes its argument (either a vct or a list of two
-vcts), and displays it in any channel's time domain graph using its current graph-style.
+The latter takes its argument (either a float-vector or a list of two
+float-vectors), and displays it in any channel's time domain graph using its current graph-style.
</p>
<div class="spacer"></div>
diff --git a/gl.c b/gl.c
index 1a70901..853c34d 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_trrrrt, pl_tr, pl_t, 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_bit, pl_bi, pl_pit, pl_piiit, pl_piit, pl_tb, pl_bt, pl_prrrt, pl_prrrrtttrrt, 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;
+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;
#if USE_MOTIF
static s7_pointer pl_tttti, pl_ttttb, pl_pttit, pl_pt;
#endif
@@ -4465,9 +4465,11 @@ static s7_pointer pl_tttti, pl_ttttb, pl_pttit, pl_pt;
s_real = s7_make_symbol(s7, "real?");
s_any = s7_t(s7);
- 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_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_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);
@@ -4480,15 +4482,6 @@ 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_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_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_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_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_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);
@@ -4497,6 +4490,8 @@ 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);
@@ -4517,6 +4512,11 @@ 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_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);
@@ -5731,7 +5731,7 @@ void Init_libgl(void)
define_integers();
define_functions();
Xen_provide_feature("gl");
- Xen_define("gl-version", C_string_to_Xen_string("13-Jan-17"));
+ Xen_define("gl-version", C_string_to_Xen_string("25-Jun-17"));
gl_already_inited = true;
}
}
diff --git a/grfsnd.html b/grfsnd.html
index 314cd43..ca35498 100644
--- a/grfsnd.html
+++ b/grfsnd.html
@@ -178,7 +178,7 @@ related documentation:
<li><a href="extsnd.html#sndobjects">Snd's objects</a>
<ul>
<li><a href="extsnd.html#samplers">Samplers</a>
- <li><a href="extsnd.html#Vcts">Vcts</a>
+ <li><a href="extsnd.html#Floatvectors">Float-vectors</a>
<li><a href="extsnd.html#extsndlib">Sndlib</a>
<li><a href="extsnd.html#sndmarks">Marks</a>
<li><a href="extsnd.html#sndmixes">Mixes</a>
@@ -2254,7 +2254,7 @@ at configuration time, and use the <a href="extsnd.html#glgraphtops">gl-graph-&g
<!-- gsl-eigenvectors -->
<div class="bluish"><em class=emdef>gsl-eigenvectors</em> <code>matrix</code></div>
<p>
-gsl-eigenvectors returns the eigenvalues and corresponding eigenvectors of "matrix", a float-vector in s7, a vct otherwise.
+gsl-eigenvectors returns the eigenvalues and corresponding eigenvectors of "matrix", a float-vector in s7.
The value returned is a list of two elements. The first is a vector containing
the eigenvalues, the second is a vector containing the corresponding eigenvectors (as vectors).
</p>
diff --git a/gtk-effects-utils.scm b/gtk-effects-utils.scm
index b714e1e..350126e 100644
--- a/gtk-effects-utils.scm
+++ b/gtk-effects-utils.scm
@@ -33,7 +33,6 @@
(if (defined? 'gtk_widget_set_clip) ; gtk 3.14.0
(gtk_window_set_transient_for (GTK_WINDOW new-dialog) (GTK_WINDOW ((main-widgets) 1))))
(gtk_window_set_title (GTK_WINDOW new-dialog) label)
- ;(gtk_container_set_border_width (GTK_CONTAINER new-dialog) 10)
(gtk_window_set_default_size (GTK_WINDOW new-dialog) -1 -1)
(gtk_window_set_resizable (GTK_WINDOW new-dialog) #t)
(gtk_widget_realize new-dialog)
diff --git a/gtk-effects.scm b/gtk-effects.scm
index 217b0b1..952cc5c 100644
--- a/gtk-effects.scm
+++ b/gtk-effects.scm
@@ -473,7 +473,7 @@
(map-chan-over-target-with-sync
(lambda (input-samps)
(let ((flt (make-fir-filter :order 4
- :xcoeffs (float-vector .125 .25 .25 .125)))
+ :xcoeffs #r(.125 .25 .25 .125)))
(del (make-delay (round (* flecho-delay (srate)))))
(genv (make-env (list 0.0 1.0 input-samps 1.0 (+ input-samps 1) 0.0 (+ input-samps 100) 0.0)
:length (+ input-samps 100))))
@@ -2521,4 +2521,4 @@ the synthesis amplitude, the FFT size, and the radius value."))
(add-to-menu effects-menu "Reverse" reverse-sound)
(add-to-menu effects-menu "Null phase" zero-phase)
- ) ; *gtk*
\ No newline at end of file
+ ) ; *gtk*
diff --git a/index.html b/index.html
index 356fcaa..b6f1280 100644
--- a/index.html
+++ b/index.html
@@ -37,360 +37,352 @@
</head>
<body class="body">
<div class="topheader">Index</div>
-<!-- created 07-Dec-16 11:45 PST -->
+<!-- created 11-May-17 05:26 PDT -->
<table>
- <tr><td><em class=tab><a href="s7.html#sharpreaders">*#readers*</a></em></td><td></td><td><em class=tab><a href="s7.html#errorhook">*error-hook*</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebirds">make-birds</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#secondstosamples">seconds->samples</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#erssb">erssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-blackman">make-blackman</a></em></td><td></td><td><em class=tab><a href="sndclm.html#n1cos">n1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectall">select-all</a></em></td></tr>
- <tr><td class="green"><div class="centered">A</div></td><td></td><td><em class=tab><a href="sndclm.html#erssb?">erssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-brown-noise">make-brown-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#n1cos?">n1cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannel">select-channel</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#evenmultiple">even-multiple</a></em></td><td></td><td><em class=tab><a href="s7.html#makebytevector">make-byte-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nameclickhook">name-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannelhook">select-channel-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#abcos">abcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#evenweight">even-weight</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makedropsite">make-channel-drop-site</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nchoosekcos">nchoosekcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsound">select-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#abcos?">abcos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#everysample">every-sample?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makecolor">make-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nchoosekcos?">nchoosekcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsoundhook">select-sound-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#abort">abort</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exit">exit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-comb">make-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos">ncos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedchannel">selected-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#absin">absin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exithook">exit-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makecombbank">make-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos2?">ncos2?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selecteddatacolor">selected-data-color</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#absin?">absin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrol">expand-control</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-convolve">make-convolve</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos4?">ncos4?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedgraphcolor">selected-graph-color</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#addampcontrols">add-amp-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolbounds">expand-control-bounds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-delay">make-delay</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos?">ncos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedsound">selected-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addcolormap">add-colormap</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolhop">expand-control-hop</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makedifferentiator">make-differentiator</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsound">new-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selection">selection</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#adddeleteoption">add-delete-option</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontroljitter">expand-control-jitter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-env">make-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsounddialog">new-sound-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectiontomix">selection->mix</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#adddirectorytoviewfileslist">add-directory-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrollength">expand-control-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-eoddcos">make-eoddcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsoundhook">new-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionchans">selection-chans</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addfilefilter">add-file-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolramp">expand-control-ramp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ercos">make-ercos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newwidgethook">new-widget-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncolor">selection-color</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addfilesorter">add-file-sorter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolp">expand-control?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-erssb">make-erssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nextsample">next-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncontext">selection-context</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addfiletoviewfileslist">add-file-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="sndscm.html#explodesf2">explode-sf2</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fft-window">make-fft-window</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssb">nkssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncreatesregion">selection-creates-region</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addmark">add-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#exponentially-weighted-moving-average">exponentially-weighted-moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetoframple">make-file->frample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssbinterp">nkssb-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionframples">selection-framples</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#addmarkpane">add-mark-pane</a></em></td><td></td><td><em class=tab><a href="sndscm.html#expsnd">expsnd</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetosample">make-file->sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssb?">nkssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxamp">selection-maxamp</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addplayer">add-player</a></em></td><td></td><td><em class=tab><a href="sndscm.html#expsrc">expsrc</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filter">make-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddcos">noddcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxampposition">selection-maxamp-position</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addsoundfileextension">add-sound-file-extension</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-filtered-comb">make-filtered-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddcos?">noddcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmember">selection-member?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addsourcefileextension">add-source-file-extension</a></em></td><td></td><td class="green"><div class="centered">F</div></td><td></td><td><em class=tab><a href="sndclm.html#makefilteredcombbank">make-filtered-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddsin">noddsin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectionmembers">selection-members</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addtomainmenu">add-to-main-menu</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-fir-coeffs">make-fir-coeffs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddsin?">noddsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionposition">selection-position</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addtomenu">add-to-menu</a></em></td><td></td><td><em class=tab><a href="s7.html#featureslist">*features*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fir-filter">make-fir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddssb">noddssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectionrms">selection-rms</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#addtooltip">add-tooltip</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cellon">feedback fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-firmant">make-firmant</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddssb?">noddssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionsrate">selection-srate</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addtransform">add-transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fft">fft</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makefv">make-float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noid">noid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionok">selection?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#spectra">additive synthesis</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftcancel">fft-cancel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-flocsig">make-flocsig</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cleandoc"><b>Noise Reduction</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionstuff"><b>Selections</b></a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#adjustable-sawtooth-wave">adjustable-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftedit">fft-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fmssb">make-fmssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizechannel">normalize-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#setsamples">set-samples</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#adjustable-sawtooth-wave?">adjustable-sawtooth-wave?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftenvedit">fft-env-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-formant">make-formant</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizeenvelope">normalize-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#shortfilename">short-file-name</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#adjustable-square-wave">adjustable-square-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftenvinterp">fft-env-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makeformantbank">make-formant-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#normalizepartials">normalize-partials</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showaxes">show-axes</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#adjustable-square-wave?">adjustable-square-wave?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogfrequency">fft-log-frequency</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-frampletofile">make-frample->file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizesound">normalize-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showcontrols">show-controls</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#adjustable-triangle-wave">adjustable-triangle-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogmagnitude">fft-log-magnitude</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-granulate">make-granulate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizedmix">normalized-mix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#showdiskspace">show-disk-space</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#adjustable-triangle-wave?">adjustable-triangle-wave?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsmoother">fft-smoother</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makegraphdata">make-graph-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch">notch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showfullduration">show-full-duration</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#afterapplycontrolshook">after-apply-controls-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsquelch">fft-squelch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-green-noise">make-green-noise</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchchannel">notch-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showfullrange">show-full-range</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#afteredithook">after-edit-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwindow">fft-window</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-green-noise-interp">make-green-noise-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchselection">notch-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showgrid">show-grid</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#aftergraphhook">after-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftalpha">fft-window-alpha</a></em></td><td></td><td><em class=tab><a href="s7.html#makehashtable">make-hash-table</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchsound">notch-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showindices">show-indices</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#afterlispgraphhook">after-lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftbeta">fft-window-beta</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehighpass">make-highpass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch?">notch?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showlistener">show-listener</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#afteropenhook">after-open-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwithphases">fft-with-phases</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehilberttransform">make-hilbert-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#npcos?">npcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmarks">show-marks</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#aftersaveashook">after-save-as-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftexamples"><b>FFTs</b></a></em></td><td></td><td><em class=tab><a href="s7.html#makehook">make-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrcos">nrcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmixwaveforms">show-mix-waveforms</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#aftersavestatehook">after-save-state-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nbdoc">file database</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-iir-filter">make-iir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrcos?">nrcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselection">show-selection</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#aftertransformhook">after-transform-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoarray">file->array</a></em></td><td></td><td><em class=tab><a href="s7.html#makeintvector">make-int-vector</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nrev">nrev</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselectiontransform">show-selection-transform</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#allchans">all-chans</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframple">file->frample</a></em></td><td></td><td><em class=tab><a href="s7.html#makeiterator">make-iterator</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrsin">nrsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showsonogramcursor">show-sonogram-cursor</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#all-pass">all-pass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframple?">file->frample?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-izcos">make-izcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrsin?">nrsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showtransformpeaks">show-transform-peaks</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#allpassbank">all-pass-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample">file->sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j0evencos">make-j0evencos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssb">nrssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showwidget">show-widget</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#allpassbankp">all-pass-bank?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample?">file->sample?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j0j1cos">make-j0j1cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssbinterp">nrssb-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showyzero">show-y-zero</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#all-pass?">all-pass?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filename">file-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j2cos">make-j2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssb?">nrssb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silenceallmixes">silence-all-mixes</a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#sndandalsa"><b>Alsa</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfilename"><b>file-name (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jjcos">make-jjcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos">nrxycos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silencemixes">silence-mixes</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#ampcontrol">amp-control</a></em></td><td></td><td><em class=tab><a href="s7.html#fillb">fill!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jncos">make-jncos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos?">nrxycos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train">sinc-train</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#ampcontrolbounds">amp-control-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfill"><b>fill! (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jpcos">make-jpcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin">nrxysin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train?">sinc-train?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#amplitude-modulate">amplitude-modulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fillpolygon">fill-polygon</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jycos">make-jycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin?">nrxysin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sincwidth">sinc-width</a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#analyseladspa">analyse-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fillrectangle">fill-rectangle</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2cos">make-k2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin">nsin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineenvchannel">sine-env-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#anoi">anoi</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter">filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2sin">make-k2sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin?">nsin?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineramp">sine-ramp</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#anyenvchannel">any-env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterchannel">filter-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2ssb">make-k2ssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsincos">nsincos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">singer</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#anyrandom">any-random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolcoeffs">filter-control-coeffs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k3sin">make-k3sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsincos?">nsincos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothchannel">smooth-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#applycontrols">apply-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolenvelope">filter-control-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-krksin">make-krksin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nssb">nssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothselection">smooth-selection</a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#applyladspa">apply-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolindB">filter-control-in-dB</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig">make-locsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nssb?">nssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothsound">smooth-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#aritablep">aritable?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolinhz">filter-control-in-hz</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makelowpass">make-lowpass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1cos">nxy1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothexamples"><b>Smoothing</b></a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#arity">arity</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolorder">filter-control-order</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makemixsampler">make-mix-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1cos?">nxy1cos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">SMS synthesis</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#arraytofile">array->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterwaveformcolor">filter-control-waveform-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-move-sound">make-move-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1sin">nxy1sin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmarktobeat">snap-mark-to-beat</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#array-interp">array-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolp">filter-control?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-autocorrelation">make-moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1sin?">nxy1sin?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmarks">snap-marks</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#asoneedit">as-one-edit</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filterfft">filter-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-average">make-moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxycos">nxycos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmixtobeat">snap-mix-to-beat</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#askaboutunsavededits">ask-about-unsaved-edits</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterselection">filter-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-fft">make-moving-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxycos?">nxycos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosample">snd->sample</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#askbeforeoverwrite">ask-before-overwrite</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filterselectionandsmooth">filter-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-max">make-moving-max</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxysin">nxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosamplep">snd->sample?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#asyfmI">asyfm-I</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtersound">filter-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-norm">make-moving-norm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxysin?">nxysin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndcolor">snd-color</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#asyfmJ">asyfm-J</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter?">filter?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-pitch">make-moving-pitch</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#snderror">snd-error</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#asyfm?">asyfm?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb">filtered-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-scentroid">make-moving-scentroid</a></em></td><td></td><td class="green"><div class="centered">O</div></td><td></td><td><em class=tab><a href="extsnd.html#snderrorhook">snd-error-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm">asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filteredcombbank">filtered-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-spectrum">make-moving-spectrum</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sndfont">snd-font</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm?">asymmetric-fm?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filteredcombbankp">filtered-comb-bank?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-n1cos">make-n1cos</a></em></td><td></td><td><em class=tab><a href="s7.html#objecttolet">object->let</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndgcs">snd-gcs</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#autoresize">auto-resize</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb?">filtered-comb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nchoosekcos">make-nchoosekcos</a></em></td><td></td><td><em class=tab><a href="s7.html#objecttostring">object->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhelp">snd-help</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#autosavedoc">auto-save</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtersinsnd"><b>Filters</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ncos">make-ncos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oddmultiple">odd-multiple</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndscmhooks">snd-hooks</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#autoupdate">auto-update</a></em></td><td></td><td><em class=tab><a href="extsnd.html#finddialog">find-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nkssb">make-nkssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oddweight">odd-weight</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndopenedsound">*snd-opened-sound*</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#autoupdateinterval">auto-update-interval</a></em></td><td></td><td><em class=tab><a href="extsnd.html#findmark">find-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noddcos">make-noddcos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetchannel">offset-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndprint">snd-print</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#autocorrelate">autocorrelate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#findmix">find-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noddsin">make-noddsin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetsound">offset-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndspectrum">snd-spectrum</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#autoload"><b>autoload</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#findsound">find-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noddssb">make-noddssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole">one-pole</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtempnam">snd-tempnam</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#axiscolor">axis-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#finfo">finfo</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noid">make-noid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole-all-pass">one-pole-all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurl">snd-url</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#axisinfo">axis-info</a></em></td><td></td><td><em class=tab><a href="extsnd.html#finishprogressreport">finish-progress-report</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-notch">make-notch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole-all-pass?">one-pole-all-pass?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurls">snd-urls</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#axislabelfont">axis-label-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter">fir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrcos">make-nrcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole?">one-pole?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndversion">snd-version</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#axisnumbersfont">axis-numbers-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter?">fir-filter?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrsin">make-nrsin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero">one-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarning">snd-warning</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#firmant">firmant</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrssb">make-nrssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero?">one-zero?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarninghook">snd-warning-hook</a></em></td></tr>
- <tr><td class="green"><div class="centered">B</div></td><td></td><td><em class=tab><a href="sndclm.html#firmant?">firmant?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrxycos">make-nrxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialog">open-file-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndwarp">sndwarp</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#fitselectionbetweenmarks">fit-selection-between-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrxysin">make-nrxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialogdirectory">open-file-dialog-directory</a></em></td><td></td><td><em class=tab><a href="s7.html#sortb">sort!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#backgroundgradient">background-gradient</a></em></td><td></td><td><em class=tab><a href="sndscm.html#flattenpartials">flatten-partials</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nsin">make-nsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openhook">open-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig"><b>Sound placement</b></a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#badheaderhook">bad-header-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fv">float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nsincos">make-nsincos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#opennextfileindirectory">open-next-file-in-directory</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundtoamp_env">sound->amp-env</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#bagpipe">bagpipe</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtimes">float-vector*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nssb">make-nssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsound">open-raw-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundtointeger">sound->integer</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#basiccolor">basic-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvplus">float-vector+</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxy1cos">make-nxy1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsoundhook">open-raw-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfileextensions">sound-file-extensions</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beatspermeasure">beats-per-measure</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtochannel">float-vector->channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxy1sin">make-nxy1sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#opensound">open-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilep">sound-file?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beatsperminute">beats-per-minute</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtolist">float-vector->list</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxycos">make-nxycos</a></em></td><td></td><td><em class=tab><a href="s7.html#openlet">openlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilesindirectory">sound-files-in-directory</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforeclosehook">before-close-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtostring">float-vector->string</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxysin">make-nxysin</a></em></td><td></td><td><em class=tab><a href="s7.html#openletp">openlet?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundinterp">sound-interp</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforeexithook">before-exit-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvabs">float-vector-abs!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-pole">make-one-pole</a></em></td><td></td><td><em class=tab><a href="extsnd.html#orientationhook">orientation-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundloopinfo">sound-loop-info</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforesaveashook">before-save-as-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvadd">float-vector-add!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-pole-all-pass">make-one-pole-all-pass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil">oscil</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperties">sound-properties</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforesavestatehook">before-save-state-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvcopy">float-vector-copy</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-zero">make-one-zero</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil-bank">oscil-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperty">sound-property</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforetransformhook">before-transform-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvequal">float-vector-equal?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil">make-oscil</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil-bank?">oscil-bank?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundwidgets">sound-widgets</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#besj0">bes-j0</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvfill">float-vector-fill!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil-bank">make-oscil-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil?">oscil?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundp">sound?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#bess">bess</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvlength">float-vector-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-phase-vocoder">make-phase-vocoder</a></em></td><td></td><td><em class=tab><a href="sndclm.html#out-any">out-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfontinfo">soundfont-info</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#bess?">bess?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmax">float-vector-max</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pink-noise">make-pink-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#outbank">out-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounds">sounds</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">bessel filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmin">float-vector-min</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makepixmap">make-pixmap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#outa">outa</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundstosegmentdata">sounds->segment-data</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#bigbird">bigbird</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmove">float-vector-move!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeplayer">make-player</a></em></td><td></td><td><em class=tab><a href="s7.html#outlet">outlet</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectra">spectra</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#bignum">bignum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmultiply">float-vector-multiply!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyoid">make-polyoid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*output*">*output*</a></em></td><td></td><td><em class=tab><a href="sndscm.html#twotab">spectral interpolation</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#bignump">bignum?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvoffset">float-vector-offset!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyshape">make-polyshape</a></em></td><td></td><td><em class=tab><a href="extsnd.html#outputcommenthook">output-comment-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectralpolynomial">spectral-polynomial</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#binaryiodoc">binary files</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvpeak">float-vector-peak</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polywave">make-polywave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#overlayrmsenv">overlay-rms-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrohop">spectro-hop</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#bindkey">bind-key</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vctpolynomial">float-vector-polynomial</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pulse-train">make-pulse-train</a></em></td><td></td><td><em class=tab><a href="s7.html#owlet">owlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxangle">spectro-x-angle</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#bird">bird</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvref">float-vector-ref</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pulsed-env">make-pulsed-env</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxscale">spectro-x-scale</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#blackman">blackman</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvreverse">float-vector-reverse!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-r2k!cos">make-r2k!cos</a></em></td><td></td><td class="green"><div class="centered">P</div></td><td></td><td><em class=tab><a href="extsnd.html#spectroyangle">spectro-y-angle</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#blackman4envchannel">blackman4-env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvscale">float-vector-scale!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-r2k2cos">make-r2k2cos</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyscale">spectro-y-scale</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#blackman?">blackman?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvset">float-vector-set!</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeramp">make-ramp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#padchannel">pad-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozangle">spectro-z-angle</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#boldpeaksfont">bold-peaks-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvsubseq">float-vector-subseq</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand">make-rand</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padmarks">pad-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozscale">spectro-z-scale</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#break">break</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvsubtract">float-vector-subtract!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand-interp">make-rand-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padsound">pad-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#spectrum">spectrum</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#brown-noise">brown-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvp">float-vector?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rcos">make-rcos</a></em></td><td></td><td><em class=tab><a href="s7.html#pairfilename">pair-filename</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectrumtocoeffs">spectrum->coeffs</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#brown-noise?">brown-noise?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig">flocsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-readin">make-readin</a></em></td><td></td><td><em class=tab><a href="s7.html#pairlinenumber">pair-line-number</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumend">spectrum-end</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">butterworth filters</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig?">flocsig?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregion">make-region</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmix">pan-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumstart">spectrum-start</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#bytevector">byte-vector</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereoflute">flute model</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregionsampler">make-region-sampler</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmixvct">pan-mix-float-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrol">speed-control</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#bytevectorref">byte-vector-ref</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmbell">fm-bell</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rk!cos">make-rk!cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstopolynomial">partials->polynomial</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrolbounds">speed-control-bounds</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#bytevectorset">byte-vector-set!</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmdrum">fm-drum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rk!ssb">make-rk!ssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstowave">partials->wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedstyle">speed-control-style</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#bytevectorp">byte-vector?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmnoise">fm-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkcos">make-rkcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#pausing">pausing</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedtones">speed-control-tones</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#fmparallelcomponent">fm-parallel-component</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkoddssb">make-rkoddssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peakenvdir">peak-env-dir</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spotfreq">spot-freq</a></em></td></tr>
- <tr><td class="green"><div class="centered">C</div></td><td></td><td><em class=tab><a href="sndscm.html#fmvox">fm-talker</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rksin">make-rksin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaks">peaks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave">square-wave</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#fmtrumpet">fm-trumpet</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkssb">make-rkssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaksfont">peaks-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave?">square-wave?</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#definecfunction">c-define</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vdoc">fm-violin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-round-interp">make-round-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-partialstowave">phase-partials->wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#squelchupdate">squelch-update</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cgp">c-g?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvoice">fm-voice</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rssb">make-rssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder">phase-vocoder</a></em></td><td></td><td><em class=tab><a href="sndscm.html#squelchvowels">squelch-vowels</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#cobject">c-object?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fmssb">fmssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxycos">make-rxycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder?">phase-vocoder?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srate">srate</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#cpoint">c-pointer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fmssb?">fmssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxyk!cos">make-rxyk!cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#prc95doc"><b>Physical Models</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsrate"><b>srate (generic)</b></a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#cpointer">c-pointer?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#focuswidget">focus-widget</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxyk!sin">make-rxyk!sin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pianodoc">piano model</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src">src</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#callwithexit">call-with-exit</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fofins">FOF synthesis</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxysin">make-rxysin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise">pink-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcchannel">src-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#bagpipe">canter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fofins">fofins</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sampletofile">make-sample->file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise?">pink-noise?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcduration">src-duration</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#cascadetocanonical">cascade->canonical</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachchild">for-each-child</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesampler">make-sampler</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">pins</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcfitenvelope">src-fit-envelope</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#catch">catch</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachsoundfile">for-each-sound-file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sawtooth-wave">make-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#placesound">place-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcmixes">src-mixes</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#cellon">cellon</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fp">Forbidden Planet</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeselection">make-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#play">play</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsoundselection">src-selection</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#chaindsps">chain-dsps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#foregroundcolor">foreground-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sinc-train">make-sinc-train</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericplay"><b>play (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsound">src-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channeltovct">channel->vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#forgetregion">forget-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesndtosample">make-snd->sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playarrowsize">play-arrow-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src?">src?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelampenvs">channel-amp-envs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant">formant</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makesoundbox">make-sound-box</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playbetweenmarks">play-between-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am">ssb-am</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channeldata">channel-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formantbank">formant-bank</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makespencerfilter">make-spencer-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playhook">play-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am?">ssb-am?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelenvelope">channel-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formantbankp">formant-bank?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-square-wave">make-square-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playmixes">play-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbank">ssb-bank</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelpolynomial">channel-polynomial</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant?">formant?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-src">make-src</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playoften">play-often</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbankenv">ssb-bank-env</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelproperties">channel-properties</a></em></td><td></td><td><em class=tab><a href="s7.html#format">format</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ssb-am">make-ssb-am</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playregionforever">play-region-forever</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbfm">ssb-fm</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelproperty">channel-property</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandforth"><b>Forth</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-table-lookup">make-table-lookup</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsine">play-sine</a></em></td><td></td><td><em class=tab><a href="sndscm.html#startdac">start-dac</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelrms">channel-rms</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fp">fp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-table-lookup-with-env">make-table-lookup-with-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsines">play-sines</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplaying">start-playing</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelstyle">channel-style</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fractionalfouriertransform">fractional-fourier-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-tanhsin">make-tanhsin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsyncdmarks">play-syncd-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayinghook">start-playing-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelsync">channel-sync</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletofile">frample->file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-triangle-wave">make-triangle-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playuntilcg">play-until-c-g</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayingselectionhook">start-playing-selection-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelwidgets">channel-widgets</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletofile?">frample->file?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-pole">make-two-pole</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playwithenvs">play-with-envs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startprogressreport">start-progress-report</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channels">channels</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletoframple">frample->frample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-zero">make-two-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerhome">player-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#statusreport">status-report</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#genericchannels"><b>channels (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#framples">framples</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makevariabledisplay">make-variable-display</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerQ">player?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stdinprompt">stdin-prompt</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelsequal">channels-equal?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericframples"><b>framples (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#makevariablegraph">make-variable-graph</a></em></td><td></td><td><em class=tab><a href="extsnd.html#players">players</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereotomono">stereo->mono</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelseq">channels=?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freeplayer">free-player</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makevct">make-vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playexamples"><b>Playing</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereoflute">stereo-flute</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#chans">chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freesampler">free-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-wave-train">make-wave-train</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playing">playing</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayer">stop-player</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#charposition">char-position</a></em></td><td></td><td><em class=tab><a href="sndscm.html#freeverb">freeverb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-wave-train-with-env">make-wave-train-with-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pluck">pluck</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplaying">stop-playing</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#chebyhka">cheby-hka</a></em></td><td></td><td><em class=tab><a href="fm.html#fmintro"><b>Frequency Modulation</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mapchannel">map-channel</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandladspa"><b>Plugins</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayinghook">stop-playing-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">chebyshev filters</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fullmix">fullmix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mapsoundfiles">map-sound-files</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polartorectangular">polar->rectangular</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayingselectionhook">stop-playing-selection-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#checkmixtags">check-mix-tags</a></em></td><td></td><td><em class=tab><a href="s7.html#funclet">funclet</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maracadoc">maracas</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polynomial">polynomial</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stretchenvelope">stretch-envelope</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#chordalize">chordalize</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#marktointeger">mark->integer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#polydoc">polynomial operations</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stretchsoundviadft">stretch-sound-via-dft</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#chorus">chorus</a></em></td><td></td><td class="green"><div class="centered">G</div></td><td></td><td><em class=tab><a href="extsnd.html#markclickhook">mark-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid">polyoid</a></em></td><td></td><td><em class=tab><a href="s7.html#stringtobytevector">string->byte-vector</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#cleanchannel">clean-channel</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#markclickinfo">mark-click-info</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoidenv">polyoid-env</a></em></td><td></td><td><em class=tab><a href="s7.html#stringposition">string-position</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#cleansound">clean-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#gaussiandistribution">gaussian-distribution</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markcolor">mark-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid?">polyoid?</a></em></td><td></td><td><em class=tab><a href="s7.html#sublet">sublet</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#clearlistener">clear-listener</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcoff">gc-off</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markcontext">mark-context</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape">polyshape</a></em></td><td></td><td><em class=tab><a href="sndscm.html#superimposeffts">superimpose-ffts</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cliphook">clip-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcon">gc-on</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markdraghook">mark-drag-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape?">polyshape?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#swapchannels">swap-channels</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#clipping">clipping</a></em></td><td></td><td><em class=tab><a href="sndclm.html#generators"><b>Generators</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#markexplode">mark-explode</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave">polywave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#swapselectionchannels">swap-selection-channels</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#clmchannel">clm-channel</a></em></td><td></td><td><em class=tab><a href="s7.html#gensym">gensym</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhome">mark-home</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave?">polywave?</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltodynamicvalue">symbol->dynamic-value</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#clmexpsrc">clm-expsrc</a></em></td><td></td><td><em class=tab><a href="s7.html#gensym?">gensym?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhook">mark-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#portfilename">port-filename</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltovalue">symbol->value</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#closehook">close-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#glgraphtops">gl-graph->ps</a></em></td><td></td><td><em class=tab><a href="sndscm.html#markloops">mark-loops</a></em></td><td></td><td><em class=tab><a href="s7.html#portlinenumber">port-line-number</a></em></td><td></td><td><em class=tab><a href="s7.html#symbolaccess">symbol-access</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#closesound">close-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#glspectrogram">glSpectrogram</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markname">mark-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontox">position->x</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltable">symbol-table</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colortolist">color->list</a></em></td><td></td><td><em class=tab><a href="sndscm.html#goertzel">goertzel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#marknametoid">mark-name->id</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontoy">position->y</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sync">sync</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorcutoff">color-cutoff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gotolistenerend">goto-listener-end</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperties">mark-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positioncolor">position-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsync"><b>sync (generic)</b></a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorhook">color-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#grani">grani</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperty">mark-property</a></em></td><td></td><td><em class=tab><a href="sndscm.html#powerenv">power-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sync-everything">sync-everything</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorinverted">color-inverted</a></em></td><td></td><td><em class=tab><a href="sndclm.html#grains"><b>Granular synthesis</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksample">mark-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqw">pqw</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncmax">sync-max</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#colormixes">color-mixes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate">granulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksync">mark-sync</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqwvox">pqw-vox</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncstyle">sync-style</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colororientationdialog">color-orientation-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate?">granulate?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#marksynccolor">mark-sync-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#preferencesdialog">preferences-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncdmarks">syncd-marks</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorscale">color-scale</a></em></td><td></td><td><em class=tab><a href="sndscm.html#granulatedsoundinterp">granulated-sound-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksyncmax">mark-sync-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#previoussample">previous-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#syncdmixes">syncd-mixes</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorp">color?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graph">graph</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagheight">mark-tag-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printdialog">print-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#syncup">syncup</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormap">colormap</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphtops">graph->ps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagwidth">mark-tag-width</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printlength">print-length</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormaptointeger">colormap->integer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcolor">graph-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markp">mark?</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduredocumentation">procedure-documentation</a></em></td><td></td><td class="green"><div class="centered">T</div></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormapname">colormap-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcursor">graph-cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markstuff"><b>Marking</b></a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresetter">procedure-setter</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormapref">colormap-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphdata">graph-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#emarks">marks</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresignature">procedure-signature</a></em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup">table-lookup</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormapsize">colormap-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphhook">graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#matchsoundfiles">match-sound-files</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresource">procedure-source</a></em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup?">table-lookup?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormapp">colormap?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphstyle">graph-style</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maxenvelope">max-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#progressreport">progress-report</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tanhsin">tanhsin</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colors"><b>Colors</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#grapheq">graphic equalizer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxregions">max-regions</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train">pulse-train</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tanhsin?">tanhsin?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#comb">comb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphshorizontal">graphs-horizontal</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxfftpeaks">max-transform-peaks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train?">pulse-train?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tap">tap</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#combbank">comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise">green-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxamp">maxamp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulsedenv">pulsed-env</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tap?">tap?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#combbankp">comb-bank?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp">green-noise-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericmaxamp"><b>maxamp (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulsedenv?">pulsed-env?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#telephone">telephone</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#comb?">comb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp?">green-noise-interp?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxampposition">maxamp-position</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#tempdir">temp-dir</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#combineddatacolor">combined-data-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise?">green-noise?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxampexamples"><b>Maxamps</b></a></em></td><td></td><td class="green"><div class="centered">R</div></td><td></td><td><em class=tab><a href="extsnd.html#textfocuscolor">text-focus-color</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#comment">comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#griddensity">grid-density</a></em></td><td></td><td><em class=tab><a href="extsnd.html#menuwidgets">menu-widgets</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphstyle">time-graph-style</a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#sndwithcm"><b>Common Music</b></a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#menusdoc">menus, optional</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k!cos">r2k!cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphtype">time-graph-type</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#complexify">complexify</a></em></td><td></td><td class="green"><div class="centered">H</div></td><td></td><td><em class=tab><a href="extsnd.html#mindb">min-dB</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k!cos?">r2k!cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphp">time-graph?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#concatenateenvelopes">concatenate-envelopes</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mix">mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k2cos">r2k2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#timestosamples">times->samples</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#constantp">constant?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#harmonicizer">harmonicizer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixtovct">mix->float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k2cos?">r2k2cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#tinyfont">tiny-font</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#continuationp">continuation?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dht">Hartley transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtointeger">mix->integer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstodegrees">radians->degrees</a></em></td><td></td><td><em class=tab><a href="sndscm.html#telephone">touch-tone</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#continue-frampletofile">continue-frample->file</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtable">hash-table</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixamp">mix-amp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstohz">radians->hz</a></em></td><td></td><td><em class=tab><a href="s7.html#trace">trace</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#continue-sampletofile">continue-sample->file</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtablestar">hash-table*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixampenv">mix-amp-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rampchannel">ramp-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursors"><b>Tracking cursors</b></a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#contrastchannel">contrast-channel</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableentries">hash-table-entries</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixchannel">mix-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand">rand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursorstyle">tracking-cursor-style</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#contrastcontrol">contrast-control</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableref">hash-table-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixclickhook">mix-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp">rand-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtointeger">transform->integer</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#contrastcontrolamp">contrast-control-amp</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableset">hash-table-set!</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixclickinfo">mix-click-info</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp?">rand-interp?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtovct">transform->vct</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#contrastcontrolbounds">contrast-control-bounds</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtablep">hash-table?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixclicksetsamp">mix-click-sets-amp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand?">rand?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformdialog">transform-dialog</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#contrastcontrolp">contrast-control?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#headertype">header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixcolor">mix-color</a></em></td><td></td><td><em class=tab><a href="s7.html#random">random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformframples">transform-framples</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#contrast-enhancement">contrast-enhancement</a></em></td><td></td><td><em class=tab><a href="snd.html#formats"><b>Headers and sample types</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdialogmix">mix-dialog-mix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#allrandomnumbers"><b>Random Numbers</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphstyle">transform-graph-style</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#contrastsound">contrast-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hellodentist">hello-dentist</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdraghook">mix-drag-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#randomstate">random-state</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphtype">transform-graph-type</a></em></td></tr>
- <tr><td><em class=tab><a href="snd.html#controls"><b>Control Panel</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#helpdialog">help-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixfiledialog">mix-file-dialog</a></em></td><td></td><td><em class=tab><a href="s7.html#randomstatep">random-state?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphp">transform-graph?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#controlstochannel">controls->channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helphook">help-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixhome">mix-home</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rcos">rcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizefft">transform-normalization</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#convolution">convolution</a></em></td><td></td><td><em class=tab><a href="extsnd.html#hidewidget">hide-widget</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixlength">mix-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rcos?">rcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsample">transform-sample</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolution reverb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#highlightcolor">highlight-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixmaxamp">mix-maxamp</a></em></td><td></td><td><em class=tab><a href="s7.html#readerrorhook">*read-error-hook*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsize">transform-size</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#convolve">convolve</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hilberttransform">hilbert-transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixname">mix-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readhook">read-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtype">transform-type</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#convolvefiles">convolve-files</a></em></td><td></td><td><em class=tab><a href="s7.html#hookfunctions">hook-functions</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixnametoid">mix-name->id</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readmixsample">read-mix-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformp">transform?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#convolveselectionwith">convolve-selection-with</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hookmember">hook-member</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixposition">mix-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readonly">read-only</a></em></td><td></td><td><em class=tab><a href="sndscm.html#transposemixes">transpose-mixes</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolve-with</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhooks"><b>Hooks</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixproperties">mix-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readregionsample">read-region-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave">triangle-wave</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#convolve?">convolve?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#html">html</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixproperty">mix-property</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readsample">read-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave?">triangle-wave?</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#s7copy">copy</a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmldir">html-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixregion">mix-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readsamplewithdirection">read-sample-with-direction</a></em></td><td></td><td><em class=tab><a href="sndscm.html#tubebell">tubebell</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#genericcopy"><b>copy (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmlprogram">html-program</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixreleasehook">mix-release-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#readercond">reader-cond</a></em></td><td></td><td><em class=tab><a href="sndscm.html#tubebell">tubular bell</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#copycontext">copy-context</a></em></td><td></td><td><em class=tab><a href="sndclm.html#hztoradians">hz->radians</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsamplerQ">mix-sampler?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin">readin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole">two-pole</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#copysampler">copy-sampler</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mixselection">mix-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin?">readin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole?">two-pole?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#copying"><b>Copying</b></a></em></td><td></td><td class="green"><div class="centered">I</div></td><td></td><td><em class=tab><a href="sndscm.html#mixsound">mix-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartomagnitudes">rectangular->magnitudes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#twotab">two-tab</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#correlate">correlate</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mixspeed">mix-speed</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartopolar">rectangular->polar</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero">two-zero</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#coverlet">coverlet</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter">iir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsync">mix-sync</a></em></td><td></td><td><em class=tab><a href="extsnd.html#redo">redo</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero?">two-zero?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#mixdoc">cross-fade (amplitude)</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter?">iir-filter?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsyncmax">mix-sync-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontointeger">region->integer</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#fadedoc">cross-fade (frequency domain)</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gin">in</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagheight">mix-tag-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontovct">region->vct</a></em></td><td></td><td class="green"><div class="centered">U</div></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#crosssynthesis">cross-synthesis</a></em></td><td></td><td><em class=tab><a href="sndclm.html#in-any">in-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagwidth">mix-tag-width</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionchans">region-chans</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="s7.html#curlet">curlet</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ina">ina</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagy">mix-tag-y</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionframples">region-framples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#unbindkey">unbind-key</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#currentfont">current-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#inb">inb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixvct">mix-vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiongraphstyle">region-graph-style</a></em></td><td></td><td><em class=tab><a href="s7.html#unboundvariablehook">*unbound-variable-hook*</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursor">cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#infodialog">info-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixwaveformheight">mix-waveform-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionhome">region-home</a></em></td><td></td><td><em class=tab><a href="sndscm.html#unclipchannel">unclip-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorcolor">cursor-color</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#initladspa">init-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixp">mix?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxamp">region-maxamp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undo">undo</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorcontext">cursor-context</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialbeg">initial-beg</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixes">mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxampposition">region-maxamp-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undoexamples"><b>Undo and Redo</b></a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorlocationoffset">cursor-location-offset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialdur">initial-dur</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndmixes"><b>Mixing</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionplaylist">region-play-list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undohook">undo-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorposition">cursor-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialgraphhook">initial-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#monotostereo">mono->stereo</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionposition">region-position</a></em></td><td></td><td><em class=tab><a href="s7.html#unlet">unlet</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorsize">cursor-size</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndinitfile"><b>Initialization file</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#moogfilter">moog-filter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionrms">region-rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#unselectall">unselect-all</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorstyle">cursor-style</a></em></td><td></td><td><em class=tab><a href="s7.html#inlet">inlet</a></em></td><td></td><td><em class=tab><a href="s7.html#morallyequalp">morally-equal?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsample">region-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#updategraphs">update-graphs</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorupdateinterval">cursor-update-interval</a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertchannel">insert-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseclickhook">mouse-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsamplerQ">region-sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatehook">update-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorexamples"><b>Cursors</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertfiledialog">insert-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousedraghook">mouse-drag-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsrate">region-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatelispgraph">update-lisp-graph</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#cutlet">cutlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertregion">insert-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentergraphhook">mouse-enter-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionok">region?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatesound">update-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#cyclicsequences">cyclic-sequences</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsample">insert-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlabelhook">mouse-enter-label-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#eregions">regions</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetimegraph">update-time-graph</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#insertsamples">insert-samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlistenerhook">mouse-enter-listener-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionstuff"><b>Regions</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetransformgraph">update-transform-graph</a></em></td></tr>
- <tr><td class="green"><div class="centered">D</div></td><td></td><td><em class=tab><a href="extsnd.html#insertselection">insert-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentertexthook">mouse-enter-text-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#remembersoundstate">remember-sound-state</a></em></td><td></td><td><em class=tab><a href="sndscm.html#uponsaveyourself">upon-save-yourself</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#insertsilence">insert-silence</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavegraphhook">mouse-leave-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#removeclicks">remove-clicks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndmotifdoc">user interface extensions</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dacfolding">dac-combines-channels</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsound">insert-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavelabelhook">mouse-leave-label-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#removefrommenu">remove-from-menu</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dacsize">dac-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertionexamples"><b>Insertions</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavelistenerhook">mouse-leave-listener-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#replacewithselection">replace-with-selection</a></em></td><td></td><td class="green"><div class="centered">V</div></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#datacolor">data-color</a></em></td><td></td><td><em class=tab><a href="s7.html#intvector">int-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavetexthook">mouse-leave-text-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reportmarknames">report-mark-names</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#datalocation">data-location</a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorref">int-vector-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousepresshook">mouse-press-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#requires7">require</a></em></td><td></td><td><em class=tab><a href="sndscm.html#variabledisplay">variable-display</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#datasize">data-size</a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorset">int-vector-set!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-locsig">move-locsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resampleexamples"><b>Resampling</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#variablegraphp">variable-graph?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#dbtolinear">db->linear</a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorp">int-vector?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#movemixes">move-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#resetallhooks">reset-all-hooks</a></em></td><td></td><td><em class=tab><a href="s7.html#varlet">varlet</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cdebugging"><b>Debugging (C)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertocolormap">integer->colormap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound">move-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetcontrols">reset-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vct">vct</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#variabledisplay"><b>Debugging (instruments)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomark">integer->mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound?">move-sound?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetlistenercursor">reset-listener-cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttimes">vct*</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#snderrors"><b>Debugging (Scheme)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomix">integer->mix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#movesyncdmarks">move-syncd-marks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reson">reson</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctplus">vct+</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defaultoutputchans">default-output-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertoregion">integer->region</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation">moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="extsnd.html#restorecontrols">restore-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttochannel">vct->channel</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defaultoutputheadertype">default-output-header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertosound">integer->sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation?">moving-autocorrelation?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reverbexamples"><b>Reverb</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttolist">vct->list</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defaultoutputsampletype">default-output-sample-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertotransform">integer->transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average">moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*reverb*">*reverb*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttostring">vct->string</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defaultoutputsrate">default-output-srate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#integrateenvelope">integrate-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average?">moving-average?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbdecay">reverb-control-decay</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttovector">vct->vector</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#defgenerator">defgenerator</a></em></td><td></td><td><em class=tab><a href="sndscm.html#invertfilter">invert-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft">moving-fft</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolfeedback">reverb-control-feedback</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctabs">vct-abs!</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#definestar">define*</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndswitches"><b>Invocation flags</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft?">moving-fft?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollength">reverb-control-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctadd">vct-add!</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#defineconstant">define-constant</a></em></td><td></td><td><em class=tab><a href="s7.html#iterate">iterate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-length">moving-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollengthbounds">reverb-control-length-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctcopy">vct-copy</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defineenvelope">define-envelope</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratoratend">iterator-at-end?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-max">moving-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollowpass">reverb-control-lowpass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctequal">vct-equal?</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#expansion">define-expansion</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratorsequence">iterator-sequence</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-max?">moving-max?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscale">reverb-control-scale</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctfill">vct-fill!</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#definemacro">define-macro</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratorp">iterator?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-norm">moving-norm</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscalebounds">reverb-control-scale-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctlength">vct-length</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#definemacrostar">define-macro*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#izcos">izcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-norm?">moving-norm?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolp">reverb-control?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmax">vct-max</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#defineselectionviamarks">define-selection-via-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#izcos?">izcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch">moving-pitch</a></em></td><td></td><td><em class=tab><a href="s7.html#reverseb">reverse!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmin">vct-min</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#definedp">defined?</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch?">moving-pitch?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reversebyblocks">reverse-by-blocks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmove">vct-move!</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#degreestoradians">degrees->radians</a></em></td><td></td><td class="green"><div class="centered">J</div></td><td></td><td><em class=tab><a href="sndclm.html#moving-rms">moving-rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reversechannel">reverse-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmultiply">vct-multiply!</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#delay">delay</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid">moving-scentroid</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reverseenvelope">reverse-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctoffset">vct-offset!</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#delaychannelmixes">delay-channel-mixes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0evencos">j0evencos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid?">moving-scentroid?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseselection">reverse-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctpeak">vct-peak</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#delaytick">delay-tick</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0evencos?">j0evencos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum">moving-spectrum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reversesound">reverse-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctref">vct-ref</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#delay?">delay?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0j1cos">j0j1cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum?">moving-spectrum?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseexamples"><b>Reversing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctreverse">vct-reverse!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletecolormap">delete-colormap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0j1cos?">j0j1cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-sum">moving-sum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#revertsound">revert-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctscale">vct-scale!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletefilefilter">delete-file-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j2cos">j2cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mpg">mpg</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rightsample">right-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctset">vct-set!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletefilesorter">delete-file-sorter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j2cos?">j2cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffersize">mus-alsa-buffer-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ring-modulate">ring-modulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctsubseq">vct-subseq</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletemark">delete-mark</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandjack"><b>Jack</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffers">mus-alsa-buffers</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!cos">rk!cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctsubtract">vct-subtract!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletemarks">delete-marks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#jcreverb">jc-reverb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsacapturedevice">mus-alsa-capture-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!cos?">rk!cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctp">vct?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletesample">delete-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jjcos">jjcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsadevice">mus-alsa-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!ssb">rk!ssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#Vcts"><b>Vcts</b></a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletesamples">delete-samples</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jjcos?">jjcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsaplaybackdevice">mus-alsa-playback-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!ssb?">rk!ssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vectortovct">vector->vct</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletesamplesandsmooth">delete-samples-and-smooth</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jncos">jncos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsasquelchwarning">mus-alsa-squelch-warning</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkcos">rkcos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vibratinguniformcircularstring">vibrating-uniform-circular-string</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deleteselection">delete-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jncos?">jncos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musarrayprintlength">mus-array-print-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkcos?">rkcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesamp">view-files-amp</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deleteselectionandsmooth">delete-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jpcos">jpcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musbytespersample">mus-bytes-per-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkoddssb">rkoddssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesampenv">view-files-amp-env</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletetransform">delete-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jpcos?">jpcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channel">mus-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkoddssb?">rkoddssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesdialog">view-files-dialog</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletionexamples"><b>Deletions</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#justsounds">just-sounds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channels">mus-channels</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin">rksin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesfiles">view-files-files</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#describehook">describe-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jycos">jycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-chebyshev-tu-sum">mus-chebyshev-tu-sum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin?">rksin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselecthook">view-files-select-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#describemark">describe-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jycos?">jycos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musclipping">mus-clipping</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkssb">rkssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselectedfiles">view-files-selected-files</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#dht">dht</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-close">mus-close</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkssb?">rkssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilessort">view-files-sort</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dialogwidgets">dialog-widgets</a></em></td><td></td><td class="green"><div class="centered">K</div></td><td></td><td><em class=tab><a href="sndclm.html#mus-copy">mus-copy</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeed">view-files-speed</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#dilambda">dilambda</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-data">mus-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms, gain, balance gens</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeedstyle">view-files-speed-style</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#disablecontrolpanel">disable-control-panel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2cos">k2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-describe">mus-describe</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsenvelope">rms-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewmixesdialog">view-mixes-dialog</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#displaybarkfft">display-bark-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2cos?">k2cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrorhook">mus-error-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#rootlet">rootlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewregionsdialog">view-regions-dialog</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#displaycorrelation">display-correlation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2sin">k2sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrortypetostring">mus-error-type->string</a></em></td><td></td><td><em class=tab><a href="s7.html#rootletredefinitionhook">*rootlet-redefinition-hook*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewsound">view-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#displaydb">display-db</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2sin?">k2sin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musexpandfilename">mus-expand-filename</a></em></td><td></td><td><em class=tab><a href="sndclm.html#round-interp">round-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">voice physical model</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#displayedits">display-edits</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2ssb">k2ssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedback">mus-feedback</a></em></td><td></td><td><em class=tab><a href="sndclm.html#round-interp?">round-interp?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#voicedtounvoiced">voiced->unvoiced</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#displayenergy">display-energy</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2ssb?">k2ssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedforward">mus-feedforward</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssb">rssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#volterrafilter">volterra-filter</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#dissolvefade">dissolve-fade</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k3sin">k3sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fft">mus-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssbinterp">rssb-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvox">vox</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#ditherchannel">dither-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k3sin?">k3sin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musfilebuffersize">mus-file-buffer-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssb?">rssb?</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#dithersound">dither-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#kalmanfilterchannel">kalman-filter-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musfileclipping">mus-file-clipping</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rubbersound">rubber-sound</a></em></td><td></td><td class="green"><div class="centered">W</div></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#dolph">dolph</a></em></td><td></td><td><em class=tab><a href="extsnd.html#key">key</a></em></td><td></td><td><em class=tab><a href="sndscm.html#musfilemix">mus-file-mix</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandruby"><b>Ruby</b></a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#dot-product">dot-product</a></em></td><td></td><td><em class=tab><a href="extsnd.html#keybinding">key-binding</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-file-name">mus-file-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxycos">rxycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train">wave-train</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dotsize">dot-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#keypresshook">key-press-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musfloatequalfudgefactor">mus-float-equal-fudge-factor</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxycos?">rxycos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train?">wave-train?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#downoct">down-oct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#krksin">krksin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-frequency">mus-frequency</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!cos">rxyk!cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavelettype">wavelet-type</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawaxes">draw-axes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#krksin?">krksin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musgeneratorp">mus-generator?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!cos?">rxyk!cos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqwvox">waveshaping voice</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawdot">draw-dot</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#musheaderrawdefaults">mus-header-raw-defaults</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!sin">rxyk!sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavohop">wavo-hop</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawdots">draw-dots</a></em></td><td></td><td class="green"><div class="centered">L</div></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypetostring">mus-header-type->string</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!sin?">rxyk!sin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavotrace">wavo-trace</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawline">draw-line</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypename">mus-header-type-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxysin">rxysin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#weighted-moving-average">weighted-moving-average</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawlines">draw-lines</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#ladspadescriptor">ladspa-descriptor</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-hop">mus-hop</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxysin?">rxysin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetposition">widget-position</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawmarkhook">draw-mark-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ladspadir">ladspa-dir</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-increment">mus-increment</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#widgetsize">widget-size</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawmixhook">draw-mix-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#lambdastar">lambda*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-input?">mus-input?</a></em></td><td></td><td class="green"><div class="centered">S</div></td><td></td><td><em class=tab><a href="extsnd.html#widgettext">widget-text</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawstring">draw-string</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lbjpiano">lbj-piano</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interp-type">mus-interp-type</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#movingwindows"><b>Window size and position</b></a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#drone">drone</a></em></td><td></td><td><em class=tab><a href="extsnd.html#leftsample">left-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interpolate">mus-interpolate</a></em></td><td></td><td><em class=tab><a href="s7.html#s7doc"><b>s7 scheme</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowheight">window-height</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#makedropsite">drop sites</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericlength"><b>length (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-length">mus-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sample">sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#windowsamples">window-samples</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drophook">drop-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#lettolist">let->list</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-location">mus-location</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile">sample->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowwidth">window-width</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#duringopenhook">during-open-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#letref">let-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musmaxmalloc">mus-max-malloc</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile?">sample->file?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowx">window-x</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="s7.html#letset">let-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musmaxtablesize">mus-max-table-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sampletype">sample-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowy">window-y</a></em></td></tr>
- <tr><td class="green"><div class="centered">E</div></td><td></td><td><em class=tab><a href="s7.html#lettemporarily">let-temporarily</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-name">mus-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sampleratendQ">sampler-at-end?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withbackgroundprocesses">with-background-processes</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="s7.html#letp">let?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-offset">mus-offset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerhome">sampler-home</a></em></td><td></td><td><em class=tab><a href="s7.html#withbaffle">with-baffle</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editlists"><b>Edit lists</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#lineartodb">linear->db</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-order">mus-order</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerposition">sampler-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withfilemonitor">with-file-monitor</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editfragment">edit-fragment</a></em></td><td></td><td><em class=tab><a href="sndscm.html#linearsrcchannel">linear-src-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musosssetbuffers">mus-oss-set-buffers</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerQ">sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withgl">with-gl</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editheaderdialog">edit-header-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lintdoc">lint for scheme</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-output?">mus-output?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplers"><b>samplers</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#withinsetgraph">with-inset-graph</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#edithook">edit-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphhook">lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-phase">mus-phase</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samples">samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withinterrupts">with-interrupts</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editlisttofunction">edit-list->function</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphstyle">lisp-graph-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ramp">mus-ramp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#samplestoseconds">samples->seconds</a></em></td><td></td><td><em class=tab><a href="s7.html#with-let">with-let</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editposition">edit-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphp">lisp-graph?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-rand-seed">mus-rand-seed</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sashcolor">sash-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withlocalhook">with-local-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editproperties">edit-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listtofv">list->float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-random">mus-random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveasdialogautocomment">save-as-dialog-auto-comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withmenuicons">with-menu-icons</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editproperty">edit-property</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listtovct">list->vct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-reset">mus-reset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveasdialogsrc">save-as-dialog-src</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withmixtags">with-mix-tags</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#edittree">edit-tree</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#listladspa">list-ladspa</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-run">mus-run</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savecontrols">save-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withpointerfocus">with-pointer-focus</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#edits">edits</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerclickhook">listener-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussampletypetostring">mus-sample-type->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savedir">save-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withrelativepanes">with-relative-panes</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#edot-product">edot-product</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenercolor">listener-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussampletypename">mus-sample-type-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveedithistory">save-edit-history</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withsmptelabel">with-smpte-label</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#effectshook">effects-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenercolorized">listener-colorized</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-scaler">mus-scaler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveenvelopes">save-envelopes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withsound">with-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">elliptic filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerfont">listener-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundchans">mus-sound-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savehook">save-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withtemporaryselection">with-temporary-selection</a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#emacssnd"><b>Emacs and Snd</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerprompt">listener-prompt</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcloseinput">mus-sound-close-input</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savelistener">save-listener</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtoolbar">with-toolbar</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#env">env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerselection">listener-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcloseoutput">mus-sound-close-output</a></em></td><td></td><td><em class=tab><a href="sndscm.html#savemarkproperties">save-mark-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtooltips">with-tooltips</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#env-any">env-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenertextcolor">listener-text-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcomment">mus-sound-comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemarks">save-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtrackingcursor">with-tracking-cursor</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envchannel">env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#littleendianp">little-endian?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatalocation">mus-sound-data-location</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemix">save-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withverbosecursor">with-verbose-cursor</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envchannelwithbase">env-channel-with-base</a></em></td><td></td><td><em class=tab><a href="s7.html#loadhook">*load-hook*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatumsize">mus-sound-datum-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregion">save-region</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#envexptchannel">env-expt-channel</a></em></td><td></td><td><em class=tab><a href="s7.html#loadpath">*load-path*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundduration">mus-sound-duration</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregiondialog">save-region-dialog</a></em></td><td></td><td class="green"><div class="centered">X</div></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#env-interp">env-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#locatezero">locate-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundforget">mus-sound-forget</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveselection">save-selection</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#envmixes">env-mixes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig">locsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundframples">mus-sound-framples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveselectiondialog">save-selection-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xtoposition">x->position</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envselection">env-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-ref">locsig-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundheadertype">mus-sound-header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesound">save-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xaxislabel">x-axis-label</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envsound">env-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-reverb-ref">locsig-reverb-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundlength">mus-sound-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesoundas">save-sound-as</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xaxisstyle">x-axis-style</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#envsoundinterp">env-sound-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-reverb-set!">locsig-reverb-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundloopinfo">mus-sound-loop-info</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesounddialog">save-sound-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xbounds">x-bounds</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#envsquaredchannel">env-squared-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-set!">locsig-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmarkinfo">mus-sound-mark-info</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestate">save-state</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xpositionslider">x-position-slider</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#env?">env?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-type">locsig-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxamp">mus-sound-maxamp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatefile">save-state-file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xzoomslider">x-zoom-slider</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedbase">enved-base</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig?">locsig?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxampexists">mus-sound-maxamp-exists?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatehook">save-state-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#xbopen">xb-open</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedclipping">enved-clip?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#logfreqstart">log-freq-start</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundopeninput">mus-sound-open-input</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveexamples"><b>Saving</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#xrampchannel">xramp-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#enveddialog">enved-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpccoeffs">lpc-coeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundopenoutput">mus-sound-open-output</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sgfilter">savitzky-golay-filter</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedenvelope">enved-envelope</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpcpredict">lpc-predict</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundpath">mus-sound-path</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave">sawtooth-wave</a></em></td><td></td><td class="green"><div class="centered">Y</div></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#filterenv">enved-filter</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundpreload">mus-sound-preload</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave?">sawtooth-wave?</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#filterenvorder">enved-filter-order</a></em></td><td></td><td class="green"><div class="centered">M</div></td><td></td><td><em class=tab><a href="extsnd.html#mussoundprune">mus-sound-prune</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleby">scale-by</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ytoposition">y->position</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedhook">enved-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundread">mus-sound-read</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scalechannel">scale-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yaxislabel">y-axis-label</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedin-dB">enved-in-dB</a></em></td><td></td><td><em class=tab><a href="s7.html#macrop">macro?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreopenoutput">mus-sound-reopen-output</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaleenvelope">scale-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ybounds">y-bounds</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedpower">enved-power</a></em></td><td></td><td><em class=tab><a href="s7.html#macroexpand">macroexpand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreportcache">mus-sound-report-cache</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalemixes">scale-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ypositionslider">y-position-slider</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedstyle">enved-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainmenu">main-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsampletype">mus-sound-sample-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionby">scale-selection-by</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yzoomslider">y-zoom-slider</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedtarget">enved-target</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainwidgets">main-widgets</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsamples">mus-sound-samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionto">scale-selection-to</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedwaving">enved-wave?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-abcos">make-abcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundseekframple">mus-sound-seek-frample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalesound">scale-sound</a></em></td><td></td><td class="green"><div class="centered">Z</div></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedwaveformcolor">enved-waveform-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-absin">make-absin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsrate">mus-sound-srate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaletempo">scale-tempo</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#envelopeinterp">envelope-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-sawtooth-wave">make-adjustable-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundtypespecifier">mus-sound-type-specifier</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleto">scale-to</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ztransform">z-transform</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#envelopedmix">enveloped-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-square-wave">make-adjustable-square-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwrite">mus-sound-write</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scanchannel">scan-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zecho">zecho</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envexamples"><b>Envelopes</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-triangle-wave">make-adjustable-triangle-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwritedate">mus-sound-write-date</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dspdocscanned">scanned synthesis</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zeroplus">zero+</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#eoddcos">eoddcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-all-pass">make-all-pass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mussrate">mus-srate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scentroid">scentroid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zeropad">zero-pad</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#eoddcos?">eoddcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makeallpassbank">make-all-pass-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-width">mus-width</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scratch">scratch</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zerophase">zero-phase</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#epsbottommargin">eps-bottom-margin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asyfm">make-asyfm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeff">mus-xcoeff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptarg">script-arg</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipsound">zip-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#epsfile">eps-file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asymmetric-fm">make-asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeffs">mus-xcoeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptargs">script-args</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipper">zipper</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#epsleftmargin">eps-left-margin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandpass">make-bandpass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeff">mus-ycoeff</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndwithnogui"><b>Scripting</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomcolor">zoom-color</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#epssize">eps-size</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandstop">make-bandstop</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeffs">mus-ycoeffs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#searchforclick">search-for-click</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomfocusstyle">zoom-focus-style</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#ercos">ercos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-bess">make-bess</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#searchprocedure">search-procedure</a></em></td><td></td>
-</tr>
- <tr><td><em class=tab><a href="sndclm.html#ercos?">ercos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebiquad">make-biquad</a></em></td><td></td><td class="green"><div class="centered">N</div></td><td></td><td><em class=tab><a href="extsnd.html#searchexamples"><b>Searching</b></a></em></td><td></td>
-</tr>
-
+ <tr><td><em class=tab><a href="s7.html#sharpreaders">*#readers*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#eoddcos?">eoddcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-absin">make-absin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreopenoutput">mus-sound-reopen-output</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveexamples"><b>Saving</b></a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#epsbottommargin">eps-bottom-margin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-sawtooth-wave">make-adjustable-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreportcache">mus-sound-report-cache</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sgfilter">savitzky-golay-filter</a></em></td></tr>
+ <tr><td class="green"><div class="centered">A</div></td><td></td><td><em class=tab><a href="extsnd.html#epsfile">eps-file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-square-wave">make-adjustable-square-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsampletype">mus-sound-sample-type</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave">sawtooth-wave</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#epsleftmargin">eps-left-margin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-triangle-wave">make-adjustable-triangle-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsamples">mus-sound-samples</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave?">sawtooth-wave?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#abcos">abcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#epssize">eps-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-all-pass">make-all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundseekframple">mus-sound-seek-frample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleby">scale-by</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#abcos?">abcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ercos">ercos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makeallpassbank">make-all-pass-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsrate">mus-sound-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scalechannel">scale-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#abort">abort</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ercos?">ercos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asyfm">make-asyfm</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundtypespecifier">mus-sound-type-specifier</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaleenvelope">scale-envelope</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#absin">absin</a></em></td><td></td><td><em class=tab><a href="s7.html#errorhook">*error-hook*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asymmetric-fm">make-asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwrite">mus-sound-write</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalemixes">scale-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#absin?">absin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#erssb">erssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandpass">make-bandpass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwritedate">mus-sound-write-date</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionby">scale-selection-by</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#addampcontrols">add-amp-controls</a></em></td><td></td><td><em class=tab><a href="sndclm.html#erssb?">erssb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandstop">make-bandstop</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mussrate">mus-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionto">scale-selection-to</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addcolormap">add-colormap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#evenmultiple">even-multiple</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-bess">make-bess</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-width">mus-width</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalesound">scale-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#adddeleteoption">add-delete-option</a></em></td><td></td><td><em class=tab><a href="sndclm.html#evenweight">even-weight</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebiquad">make-biquad</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeff">mus-xcoeff</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaletempo">scale-tempo</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#adddirectorytoviewfileslist">add-directory-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="sndscm.html#everysample">every-sample?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebirds">make-birds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeffs">mus-xcoeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleto">scale-to</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addfilefilter">add-file-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exit">exit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-blackman">make-blackman</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeff">mus-ycoeff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scanchannel">scan-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addfilesorter">add-file-sorter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exithook">exit-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-brown-noise">make-brown-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeffs">mus-ycoeffs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dspdocscanned">scanned synthesis</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addfiletoviewfileslist">add-file-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrol">expand-control</a></em></td><td></td><td><em class=tab><a href="s7.html#makebytevector">make-byte-vector</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#scentroid">scentroid</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addmark">add-mark</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolbounds">expand-control-bounds</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makedropsite">make-channel-drop-site</a></em></td><td></td><td class="green"><div class="centered">N</div></td><td></td><td><em class=tab><a href="sndscm.html#scratch">scratch</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#addmarkpane">add-mark-pane</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolhop">expand-control-hop</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makecolor">make-color</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#scriptarg">script-arg</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addplayer">add-player</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontroljitter">expand-control-jitter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-comb">make-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#n1cos">n1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptargs">script-args</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addsoundfileextension">add-sound-file-extension</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrollength">expand-control-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makecombbank">make-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#n1cos?">n1cos?</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndwithnogui"><b>Scripting</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addsourcefileextension">add-source-file-extension</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolramp">expand-control-ramp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-convolve">make-convolve</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nameclickhook">name-click-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#searchforclick">search-for-click</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addtomainmenu">add-to-main-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolp">expand-control?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-delay">make-delay</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nchoosekcos">nchoosekcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#searchprocedure">search-procedure</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addtomenu">add-to-menu</a></em></td><td></td><td><em class=tab><a href="sndscm.html#explodesf2">explode-sf2</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makedifferentiator">make-differentiator</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nchoosekcos?">nchoosekcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#searchexamples"><b>Searching</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#addtooltip">add-tooltip</a></em></td><td></td><td><em class=tab><a href="sndclm.html#exponentially-weighted-moving-average">exponentially-weighted-moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-env">make-env</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos">ncos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#secondstosamples">seconds->samples</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addtransform">add-transform</a></em></td><td></td><td><em class=tab><a href="sndscm.html#expsnd">expsnd</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-eoddcos">make-eoddcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos2?">ncos2?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectall">select-all</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#spectra">additive synthesis</a></em></td><td></td><td><em class=tab><a href="sndscm.html#expsrc">expsrc</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ercos">make-ercos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos4?">ncos4?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannel">select-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-sawtooth-wave">adjustable-sawtooth-wave</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-erssb">make-erssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos?">ncos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannelhook">select-channel-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-sawtooth-wave?">adjustable-sawtooth-wave?</a></em></td><td></td><td class="green"><div class="centered">F</div></td><td></td><td><em class=tab><a href="sndclm.html#make-fft-window">make-fft-window</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsound">new-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsound">select-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-square-wave">adjustable-square-wave</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetoframple">make-file->frample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsounddialog">new-sound-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsoundhook">select-sound-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-square-wave?">adjustable-square-wave?</a></em></td><td></td><td><em class=tab><a href="s7.html#featureslist">*features*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetosample">make-file->sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsoundhook">new-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedchannel">selected-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-triangle-wave">adjustable-triangle-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cellon">feedback fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filter">make-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newwidgethook">new-widget-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selecteddatacolor">selected-data-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-triangle-wave?">adjustable-triangle-wave?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fft">fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filtered-comb">make-filtered-comb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nextsample">next-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedgraphcolor">selected-graph-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#afterapplycontrolshook">after-apply-controls-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftcancel">fft-cancel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makefilteredcombbank">make-filtered-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssb">nkssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedsound">selected-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#afteredithook">after-edit-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftedit">fft-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fir-coeffs">make-fir-coeffs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssbinterp">nkssb-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selection">selection</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#aftergraphhook">after-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftenvedit">fft-env-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fir-filter">make-fir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssb?">nkssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectiontomix">selection->mix</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#afterlispgraphhook">after-lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftenvinterp">fft-env-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-firmant">make-firmant</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddcos">noddcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionchans">selection-chans</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#afteropenhook">after-open-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogfrequency">fft-log-frequency</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makefv">make-float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddcos?">noddcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncolor">selection-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#aftersaveashook">after-save-as-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogmagnitude">fft-log-magnitude</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-flocsig">make-flocsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddsin">noddsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncontext">selection-context</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#aftersavestatehook">after-save-state-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsmoother">fft-smoother</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fmssb">make-fmssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddsin?">noddsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncreatesregion">selection-creates-region</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#aftertransformhook">after-transform-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsquelch">fft-squelch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-formant">make-formant</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddssb">noddssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionframples">selection-framples</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#allchans">all-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwindow">fft-window</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makeformantbank">make-formant-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddssb?">noddssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxamp">selection-maxamp</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#all-pass">all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftalpha">fft-window-alpha</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-frampletofile">make-frample->file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noid">noid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxampposition">selection-maxamp-position</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#allpassbank">all-pass-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftbeta">fft-window-beta</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-granulate">make-granulate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cleandoc"><b>Noise Reduction</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmember">selection-member?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#allpassbankp">all-pass-bank?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwithphases">fft-with-phases</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makegraphdata">make-graph-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizechannel">normalize-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectionmembers">selection-members</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#all-pass?">all-pass?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftexamples"><b>FFTs</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-green-noise">make-green-noise</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizeenvelope">normalize-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionposition">selection-position</a></em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#sndandalsa"><b>Alsa</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#nbdoc">file database</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-green-noise-interp">make-green-noise-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#normalizepartials">normalize-partials</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectionrms">selection-rms</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#ampcontrol">amp-control</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoarray">file->array</a></em></td><td></td><td><em class=tab><a href="s7.html#makehashtable">make-hash-table</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizesound">normalize-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionsrate">selection-srate</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#ampcontrolbounds">amp-control-bounds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframple">file->frample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehighpass">make-highpass</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizedmix">normalized-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionok">selection?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#amplitude-modulate">amplitude-modulate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframple?">file->frample?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehilberttransform">make-hilbert-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch">notch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionstuff"><b>Selections</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#analyseladspa">analyse-ladspa</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample">file->sample</a></em></td><td></td><td><em class=tab><a href="s7.html#makehook">make-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchchannel">notch-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#setsamples">set-samples</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#anoi">anoi</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample?">file->sample?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-iir-filter">make-iir-filter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchselection">notch-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#shortfilename">short-file-name</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#anyenvchannel">any-env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filename">file-name</a></em></td><td></td><td><em class=tab><a href="s7.html#makeintvector">make-int-vector</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchsound">notch-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showaxes">show-axes</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#anyrandom">any-random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfilename"><b>file-name (generic)</b></a></em></td><td></td><td><em class=tab><a href="s7.html#makeiterator">make-iterator</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch?">notch?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showcontrols">show-controls</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#applycontrols">apply-controls</a></em></td><td></td><td><em class=tab><a href="s7.html#fillb">fill!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-izcos">make-izcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#npcos?">npcos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#showdiskspace">show-disk-space</a></em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#applyladspa">apply-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfill"><b>fill! (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j0evencos">make-j0evencos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrcos">nrcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showfullduration">show-full-duration</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#aritablep">aritable?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fillpolygon">fill-polygon</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j0j1cos">make-j0j1cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrcos?">nrcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showfullrange">show-full-range</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#arity">arity</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fillrectangle">fill-rectangle</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j2cos">make-j2cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nrev">nrev</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showgrid">show-grid</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#arraytofile">array->file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter">filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jjcos">make-jjcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrsin">nrsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showindices">show-indices</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#array-interp">array-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterchannel">filter-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jncos">make-jncos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrsin?">nrsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showlistener">show-listener</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#asoneedit">as-one-edit</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolcoeffs">filter-control-coeffs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jpcos">make-jpcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssb">nrssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmarks">show-marks</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#askaboutunsavededits">ask-about-unsaved-edits</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolenvelope">filter-control-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jycos">make-jycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssbinterp">nrssb-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmixwaveforms">show-mix-waveforms</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#askbeforeoverwrite">ask-before-overwrite</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolindB">filter-control-in-dB</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2cos">make-k2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssb?">nrssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselection">show-selection</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#asyfmI">asyfm-I</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolinhz">filter-control-in-hz</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2sin">make-k2sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos">nrxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselectiontransform">show-selection-transform</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#asyfmJ">asyfm-J</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolorder">filter-control-order</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2ssb">make-k2ssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos?">nrxycos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showsonogramcursor">show-sonogram-cursor</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#asyfm?">asyfm?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterwaveformcolor">filter-control-waveform-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k3sin">make-k3sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin">nrxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showtransformpeaks">show-transform-peaks</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm">asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolp">filter-control?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-krksin">make-krksin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin?">nrxysin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showwidget">show-widget</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm?">asymmetric-fm?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filterfft">filter-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig">make-locsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin">nsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showyzero">show-y-zero</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#autoresize">auto-resize</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterselection">filter-selection</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makelowpass">make-lowpass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin?">nsin?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silenceallmixes">silence-all-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#autosavedoc">auto-save</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filterselectionandsmooth">filter-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makemixsampler">make-mix-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsincos">nsincos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silencemixes">silence-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#autoupdate">auto-update</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtersound">filter-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-move-sound">make-move-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsincos?">nsincos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train">sinc-train</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#autoupdateinterval">auto-update-interval</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter?">filter?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-autocorrelation">make-moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nssb">nssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train?">sinc-train?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#autocorrelate">autocorrelate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb">filtered-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-average">make-moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nssb?">nssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sincwidth">sinc-width</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#autoload"><b>autoload</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#filteredcombbank">filtered-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-fft">make-moving-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1cos">nxy1cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineenvchannel">sine-env-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#axiscolor">axis-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filteredcombbankp">filtered-comb-bank?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-max">make-moving-max</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1cos?">nxy1cos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineramp">sine-ramp</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#axisinfo">axis-info</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb?">filtered-comb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-norm">make-moving-norm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1sin">nxy1sin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">singer</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#axislabelfont">axis-label-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtersinsnd"><b>Filters</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-pitch">make-moving-pitch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1sin?">nxy1sin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothchannel">smooth-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#axisnumbersfont">axis-numbers-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#finddialog">find-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-scentroid">make-moving-scentroid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxycos">nxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothselection">smooth-selection</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#findmark">find-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-spectrum">make-moving-spectrum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxycos?">nxycos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothsound">smooth-sound</a></em></td></tr>
+ <tr><td class="green"><div class="centered">B</div></td><td></td><td><em class=tab><a href="sndscm.html#findmix">find-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-n1cos">make-n1cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxysin">nxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothexamples"><b>Smoothing</b></a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#findsound">find-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nchoosekcos">make-nchoosekcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxysin?">nxysin?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">SMS synthesis</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#backgroundgradient">background-gradient</a></em></td><td></td><td><em class=tab><a href="sndscm.html#finfo">finfo</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ncos">make-ncos</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#snapmarktobeat">snap-mark-to-beat</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#badheaderhook">bad-header-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#finishprogressreport">finish-progress-report</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nkssb">make-nkssb</a></em></td><td></td><td class="green"><div class="centered">O</div></td><td></td><td><em class=tab><a href="sndscm.html#snapmarks">snap-marks</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#bagpipe">bagpipe</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter">fir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noddcos">make-noddcos</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#snapmixtobeat">snap-mix-to-beat</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#basiccolor">basic-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter?">fir-filter?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noddsin">make-noddsin</a></em></td><td></td><td><em class=tab><a href="s7.html#objecttolet">object->let</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosample">snd->sample</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beatspermeasure">beats-per-measure</a></em></td><td></td><td><em class=tab><a href="sndclm.html#firmant">firmant</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noddssb">make-noddssb</a></em></td><td></td><td><em class=tab><a href="s7.html#objecttostring">object->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosamplep">snd->sample?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beatsperminute">beats-per-minute</a></em></td><td></td><td><em class=tab><a href="sndclm.html#firmant?">firmant?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noid">make-noid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oddmultiple">odd-multiple</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndcolor">snd-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforeclosehook">before-close-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fitselectionbetweenmarks">fit-selection-between-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-notch">make-notch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oddweight">odd-weight</a></em></td><td></td><td><em class=tab><a href="extsnd.html#snderror">snd-error</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforeexithook">before-exit-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#flattenpartials">flatten-partials</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrcos">make-nrcos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetchannel">offset-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#snderrorhook">snd-error-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforesaveashook">before-save-as-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fv">float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrsin">make-nrsin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetsound">offset-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndfont">snd-font</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforesavestatehook">before-save-state-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtimes">float-vector*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrssb">make-nrssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole">one-pole</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndgcs">snd-gcs</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforetransformhook">before-transform-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvplus">float-vector+</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrxycos">make-nrxycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole-all-pass">one-pole-all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhelp">snd-help</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#besj0">bes-j0</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtochannel">float-vector->channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrxysin">make-nrxysin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole-all-pass?">one-pole-all-pass?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndscmhooks">snd-hooks</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#bess">bess</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtolist">float-vector->list</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nsin">make-nsin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole?">one-pole?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndopenedsound">*snd-opened-sound*</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#bess?">bess?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtostring">float-vector->string</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nsincos">make-nsincos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero">one-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndprint">snd-print</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">bessel filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvabs">float-vector-abs!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nssb">make-nssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero?">one-zero?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndspectrum">snd-spectrum</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#bigbird">bigbird</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvadd">float-vector-add!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxy1cos">make-nxy1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialog">open-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtempnam">snd-tempnam</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#bignum">bignum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvequal">float-vector-equal?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxy1sin">make-nxy1sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialogdirectory">open-file-dialog-directory</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurl">snd-url</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#bignump">bignum?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvfill">float-vector-fill!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxycos">make-nxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openhook">open-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurls">snd-urls</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#binaryiodoc">binary files</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvlength">float-vector-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxysin">make-nxysin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#opennextfileindirectory">open-next-file-in-directory</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndversion">snd-version</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#bindkey">bind-key</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmax">float-vector-max</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-pole">make-one-pole</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsound">open-raw-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarning">snd-warning</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#bird">bird</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmin">float-vector-min</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-pole-all-pass">make-one-pole-all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsoundhook">open-raw-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarninghook">snd-warning-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#blackman">blackman</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmove">float-vector-move!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-zero">make-one-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#opensound">open-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndwarp">sndwarp</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#blackman4envchannel">blackman4-env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmultiply">float-vector-multiply!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil">make-oscil</a></em></td><td></td><td><em class=tab><a href="s7.html#openlet">openlet</a></em></td><td></td><td><em class=tab><a href="s7.html#sortb">sort!</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#blackman?">blackman?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvoffset">float-vector-offset!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil-bank">make-oscil-bank</a></em></td><td></td><td><em class=tab><a href="s7.html#openletp">openlet?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig"><b>Sound placement</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#boldpeaksfont">bold-peaks-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvpeak">float-vector-peak</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-phase-vocoder">make-phase-vocoder</a></em></td><td></td><td><em class=tab><a href="extsnd.html#orientationhook">orientation-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundtoamp_env">sound->amp-env</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#break">break</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fvpolynomial">float-vector-polynomial</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pink-noise">make-pink-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil">oscil</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundtointeger">sound->integer</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#brown-noise">brown-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvref">float-vector-ref</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makepixmap">make-pixmap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil-bank">oscil-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfileextensions">sound-file-extensions</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#brown-noise?">brown-noise?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvreverse">float-vector-reverse!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeplayer">make-player</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil-bank?">oscil-bank?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilep">sound-file?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">butterworth filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvscale">float-vector-scale!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyoid">make-polyoid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil?">oscil?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilesindirectory">sound-files-in-directory</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#bytevector">byte-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvset">float-vector-set!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyshape">make-polyshape</a></em></td><td></td><td><em class=tab><a href="sndclm.html#out-any">out-any</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundinterp">sound-interp</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#bytevectorref">byte-vector-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvsubseq">float-vector-subseq</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polywave">make-polywave</a></em></td><td></td><td><em class=tab><a href="sndclm.html#outbank">out-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundloopinfo">sound-loop-info</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#bytevectorset">byte-vector-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvsubtract">float-vector-subtract!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pulse-train">make-pulse-train</a></em></td><td></td><td><em class=tab><a href="sndclm.html#outa">outa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperties">sound-properties</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#bytevectorp">byte-vector?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvp">float-vector?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pulsed-env">make-pulsed-env</a></em></td><td></td><td><em class=tab><a href="s7.html#outlet">outlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperty">sound-property</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#Floatvectors"><b>Float-vectors</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-r2k!cos">make-r2k!cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*output*">*output*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundwidgets">sound-widgets</a></em></td></tr>
+ <tr><td class="green"><div class="centered">C</div></td><td></td><td><em class=tab><a href="sndclm.html#flocsig">flocsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-r2k2cos">make-r2k2cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#outputcommenthook">output-comment-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundp">sound?</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig?">flocsig?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeramp">make-ramp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#overlayrmsenv">overlay-rms-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfontinfo">soundfont-info</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#definecfunction">c-define</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereoflute">flute model</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand">make-rand</a></em></td><td></td><td><em class=tab><a href="s7.html#owlet">owlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounds">sounds</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cgp">c-g?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmbell">fm-bell</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand-interp">make-rand-interp</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#soundstosegmentdata">sounds->segment-data</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#cobject">c-object?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmdrum">fm-drum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rcos">make-rcos</a></em></td><td></td><td class="green"><div class="centered">P</div></td><td></td><td><em class=tab><a href="sndscm.html#spectra">spectra</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#cpoint">c-pointer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmnoise">fm-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-readin">make-readin</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#twotab">spectral interpolation</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#cpointer">c-pointer?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmparallelcomponent">fm-parallel-component</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregion">make-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#padchannel">pad-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectralpolynomial">spectral-polynomial</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#callwithexit">call-with-exit</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvox">fm-talker</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregionsampler">make-region-sampler</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padmarks">pad-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrohop">spectro-hop</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#bagpipe">canter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmtrumpet">fm-trumpet</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rk!cos">make-rk!cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padsound">pad-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxangle">spectro-x-angle</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#cascadetocanonical">cascade->canonical</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vdoc">fm-violin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rk!ssb">make-rk!ssb</a></em></td><td></td><td><em class=tab><a href="s7.html#pairfilename">pair-filename</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxscale">spectro-x-scale</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#catch">catch</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvoice">fm-voice</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkcos">make-rkcos</a></em></td><td></td><td><em class=tab><a href="s7.html#pairlinenumber">pair-line-number</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyangle">spectro-y-angle</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#cellon">cellon</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fmssb">fmssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkoddssb">make-rkoddssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmix">pan-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyscale">spectro-y-scale</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#chaindsps">chain-dsps</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fmssb?">fmssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rksin">make-rksin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmixfv">pan-mix-float-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozangle">spectro-z-angle</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channeltofv">channel->float-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#focuswidget">focus-widget</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkssb">make-rkssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstopolynomial">partials->polynomial</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozscale">spectro-z-scale</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelampenvs">channel-amp-envs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fofins">FOF synthesis</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-round-interp">make-round-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstowave">partials->wave</a></em></td><td></td><td><em class=tab><a href="sndclm.html#spectrum">spectrum</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channeldata">channel-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fofins">fofins</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rssb">make-rssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#pausing">pausing</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectrumtocoeffs">spectrum->coeffs</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelenvelope">channel-envelope</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachchild">for-each-child</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxycos">make-rxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peakenvdir">peak-env-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumend">spectrum-end</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelpolynomial">channel-polynomial</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachsoundfile">for-each-sound-file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxyk!cos">make-rxyk!cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaks">peaks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumstart">spectrum-start</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelproperties">channel-properties</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fp">Forbidden Planet</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxyk!sin">make-rxyk!sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaksfont">peaks-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrol">speed-control</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelproperty">channel-property</a></em></td><td></td><td><em class=tab><a href="extsnd.html#foregroundcolor">foreground-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxysin">make-rxysin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-partialstowave">phase-partials->wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrolbounds">speed-control-bounds</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelrms">channel-rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#forgetregion">forget-region</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sampletofile">make-sample->file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder">phase-vocoder</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedstyle">speed-control-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelstyle">channel-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant">formant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesampler">make-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder?">phase-vocoder?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedtones">speed-control-tones</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelsync">channel-sync</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formantbank">formant-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sawtooth-wave">make-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#prc95doc"><b>Physical Models</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#spotfreq">spot-freq</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelwidgets">channel-widgets</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formantbankp">formant-bank?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeselection">make-selection</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pianodoc">piano model</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave">square-wave</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channels">channels</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant?">formant?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sinc-train">make-sinc-train</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise">pink-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave?">square-wave?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#genericchannels"><b>channels (generic)</b></a></em></td><td></td><td><em class=tab><a href="s7.html#format">format</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesndtosample">make-snd->sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise?">pink-noise?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#squelchupdate">squelch-update</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelsequal">channels-equal?</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandforth"><b>Forth</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#makesoundbox">make-sound-box</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">pins</a></em></td><td></td><td><em class=tab><a href="sndscm.html#squelchvowels">squelch-vowels</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelseq">channels=?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fp">fp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makespencerfilter">make-spencer-filter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#placesound">place-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srate">srate</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#chans">chans</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fractionalfouriertransform">fractional-fourier-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-square-wave">make-square-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#play">play</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsrate"><b>srate (generic)</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#charposition">char-position</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletofile">frample->file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-src">make-src</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericplay"><b>play (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#src">src</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#chebyhka">cheby-hka</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletofile?">frample->file?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ssb-am">make-ssb-am</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playarrowsize">play-arrow-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcchannel">src-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">chebyshev filters</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletoframple">frample->frample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-table-lookup">make-table-lookup</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playbetweenmarks">play-between-marks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcduration">src-duration</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#checkmixtags">check-mix-tags</a></em></td><td></td><td><em class=tab><a href="extsnd.html#framples">framples</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-table-lookup-with-env">make-table-lookup-with-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playhook">play-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcfitenvelope">src-fit-envelope</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#chordalize">chordalize</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericframples"><b>framples (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-tanhsin">make-tanhsin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playmixes">play-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcmixes">src-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#chorus">chorus</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freeplayer">free-player</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-triangle-wave">make-triangle-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playoften">play-often</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsoundselection">src-selection</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#cleanchannel">clean-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freesampler">free-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-pole">make-two-pole</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playregionforever">play-region-forever</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsound">src-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#cleansound">clean-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#freeverb">freeverb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-zero">make-two-zero</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsine">play-sine</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src?">src?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#clearlistener">clear-listener</a></em></td><td></td><td><em class=tab><a href="fm.html#fmintro"><b>Frequency Modulation</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#makevariabledisplay">make-variable-display</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsines">play-sines</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am">ssb-am</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cliphook">clip-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fullmix">fullmix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makevariablegraph">make-variable-graph</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsyncdmarks">play-syncd-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am?">ssb-am?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#clipping">clipping</a></em></td><td></td><td><em class=tab><a href="s7.html#funclet">funclet</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-wave-train">make-wave-train</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playuntilcg">play-until-c-g</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbank">ssb-bank</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#clmchannel">clm-channel</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-wave-train-with-env">make-wave-train-with-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playwithenvs">play-with-envs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbankenv">ssb-bank-env</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#clmexpsrc">clm-expsrc</a></em></td><td></td><td class="green"><div class="centered">G</div></td><td></td><td><em class=tab><a href="extsnd.html#mapchannel">map-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerhome">player-home</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbfm">ssb-fm</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#closehook">close-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#mapsoundfiles">map-sound-files</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerQ">player?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#startdac">start-dac</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#closesound">close-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#gaussiandistribution">gaussian-distribution</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maracadoc">maracas</a></em></td><td></td><td><em class=tab><a href="extsnd.html#players">players</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplaying">start-playing</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colortolist">color->list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcoff">gc-off</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktointeger">mark->integer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playing">playing</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayinghook">start-playing-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorcutoff">color-cutoff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcon">gc-on</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markclickhook">mark-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playexamples"><b>Playing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayingselectionhook">start-playing-selection-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorhook">color-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#generators"><b>Generators</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#markclickinfo">mark-click-info</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pluck">pluck</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startprogressreport">start-progress-report</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorinverted">color-inverted</a></em></td><td></td><td><em class=tab><a href="s7.html#gensym">gensym</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markcolor">mark-color</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandladspa"><b>Plugins</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#statusreport">status-report</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#colormixes">color-mixes</a></em></td><td></td><td><em class=tab><a href="s7.html#gensym?">gensym?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markcontext">mark-context</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polartorectangular">polar->rectangular</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stdinprompt">stdin-prompt</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colororientationdialog">color-orientation-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#glgraphtops">gl-graph->ps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markdraghook">mark-drag-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polynomial">polynomial</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereotomono">stereo->mono</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorscale">color-scale</a></em></td><td></td><td><em class=tab><a href="extsnd.html#glspectrogram">glSpectrogram</a></em></td><td></td><td><em class=tab><a href="sndscm.html#markexplode">mark-explode</a></em></td><td></td><td><em class=tab><a href="sndscm.html#polydoc">polynomial operations</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereoflute">stereo-flute</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorp">color?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#goertzel">goertzel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhome">mark-home</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid">polyoid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayer">stop-player</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormap">colormap</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gotolistenerend">goto-listener-end</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhook">mark-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoidenv">polyoid-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplaying">stop-playing</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormaptointeger">colormap->integer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#grani">grani</a></em></td><td></td><td><em class=tab><a href="sndscm.html#markloops">mark-loops</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid?">polyoid?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayinghook">stop-playing-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormapname">colormap-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#grains"><b>Granular synthesis</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#markname">mark-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape">polyshape</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayingselectionhook">stop-playing-selection-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormapref">colormap-ref</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate">granulate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#marknametoid">mark-name->id</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape?">polyshape?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stretchenvelope">stretch-envelope</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormapsize">colormap-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate?">granulate?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperties">mark-properties</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave">polywave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stretchsoundviadft">stretch-sound-via-dft</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormapp">colormap?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#granulatedsoundinterp">granulated-sound-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperty">mark-property</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave?">polywave?</a></em></td><td></td><td><em class=tab><a href="s7.html#stringtobytevector">string->byte-vector</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colors"><b>Colors</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#graph">graph</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksample">mark-sample</a></em></td><td></td><td><em class=tab><a href="s7.html#portfilename">port-filename</a></em></td><td></td><td><em class=tab><a href="s7.html#stringposition">string-position</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#comb">comb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphtops">graph->ps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksync">mark-sync</a></em></td><td></td><td><em class=tab><a href="s7.html#portlinenumber">port-line-number</a></em></td><td></td><td><em class=tab><a href="s7.html#sublet">sublet</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#combbank">comb-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcolor">graph-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#marksynccolor">mark-sync-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontox">position->x</a></em></td><td></td><td><em class=tab><a href="sndscm.html#superimposeffts">superimpose-ffts</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#combbankp">comb-bank?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcursor">graph-cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksyncmax">mark-sync-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontoy">position->y</a></em></td><td></td><td><em class=tab><a href="extsnd.html#swapchannels">swap-channels</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#comb?">comb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphdata">graph-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagheight">mark-tag-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positioncolor">position-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#swapselectionchannels">swap-selection-channels</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#combineddatacolor">combined-data-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphhook">graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagwidth">mark-tag-width</a></em></td><td></td><td><em class=tab><a href="sndscm.html#powerenv">power-env</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltodynamicvalue">symbol->dynamic-value</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#comment">comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphstyle">graph-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markp">mark?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqw">pqw</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltovalue">symbol->value</a></em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#sndwithcm"><b>Common Music</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#grapheq">graphic equalizer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markstuff"><b>Marking</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqwvox">pqw-vox</a></em></td><td></td><td><em class=tab><a href="s7.html#symbolaccess">symbol-access</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#complexify">complexify</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphshorizontal">graphs-horizontal</a></em></td><td></td><td><em class=tab><a href="extsnd.html#emarks">marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#preferencesdialog">preferences-dialog</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltable">symbol-table</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#concatenateenvelopes">concatenate-envelopes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise">green-noise</a></em></td><td></td><td><em class=tab><a href="sndscm.html#matchsoundfiles">match-sound-files</a></em></td><td></td><td><em class=tab><a href="extsnd.html#previoussample">previous-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sync">sync</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#constantp">constant?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp">green-noise-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maxenvelope">max-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printdialog">print-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsync"><b>sync (generic)</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#continuationp">continuation?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp?">green-noise-interp?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxregions">max-regions</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printlength">print-length</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sync-everything">sync-everything</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#continue-frampletofile">continue-frample->file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise?">green-noise?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxfftpeaks">max-transform-peaks</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduredocumentation">procedure-documentation</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncmax">sync-max</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#continue-sampletofile">continue-sample->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#griddensity">grid-density</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxamp">maxamp</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresetter">procedure-setter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncstyle">sync-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#contrastchannel">contrast-channel</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#genericmaxamp"><b>maxamp (generic)</b></a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresignature">procedure-signature</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncdmarks">syncd-marks</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#contrastcontrol">contrast-control</a></em></td><td></td><td class="green"><div class="centered">H</div></td><td></td><td><em class=tab><a href="extsnd.html#maxampposition">maxamp-position</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresource">procedure-source</a></em></td><td></td><td><em class=tab><a href="sndscm.html#syncdmixes">syncd-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#contrastcontrolamp">contrast-control-amp</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#maxampexamples"><b>Maxamps</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#progressreport">progress-report</a></em></td><td></td><td><em class=tab><a href="sndscm.html#syncup">syncup</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#contrastcontrolbounds">contrast-control-bounds</a></em></td><td></td><td><em class=tab><a href="sndscm.html#harmonicizer">harmonicizer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#menuwidgets">menu-widgets</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train">pulse-train</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#contrastcontrolp">contrast-control?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dht">Hartley transform</a></em></td><td></td><td><em class=tab><a href="sndscm.html#menusdoc">menus, optional</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train?">pulse-train?</a></em></td><td></td><td class="green"><div class="centered">T</div></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#contrast-enhancement">contrast-enhancement</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtable">hash-table</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mindb">min-dB</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulsedenv">pulsed-env</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#contrastsound">contrast-sound</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtablestar">hash-table*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mix">mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulsedenv?">pulsed-env?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup">table-lookup</a></em></td></tr>
+ <tr><td><em class=tab><a href="snd.html#controls"><b>Control Panel</b></a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableentries">hash-table-entries</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixtofv">mix->float-vector</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup?">table-lookup?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#controlstochannel">controls->channel</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableref">hash-table-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtointeger">mix->integer</a></em></td><td></td><td class="green"><div class="centered">R</div></td><td></td><td><em class=tab><a href="sndclm.html#tanhsin">tanhsin</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#convolution">convolution</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableset">hash-table-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixamp">mix-amp</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#tanhsin?">tanhsin?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolution reverb</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtablep">hash-table?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixampenv">mix-amp-env</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k!cos">r2k!cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tap">tap</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#convolve">convolve</a></em></td><td></td><td><em class=tab><a href="extsnd.html#headertype">header-type</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixchannel">mix-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k!cos?">r2k!cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tap?">tap?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#convolvefiles">convolve-files</a></em></td><td></td><td><em class=tab><a href="snd.html#formats"><b>Headers and sample types</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixclickhook">mix-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k2cos">r2k2cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#telephone">telephone</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#convolveselectionwith">convolve-selection-with</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hellodentist">hello-dentist</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixclickinfo">mix-click-info</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k2cos?">r2k2cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#tempdir">temp-dir</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolve-with</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helpdialog">help-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixclicksetsamp">mix-click-sets-amp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstodegrees">radians->degrees</a></em></td><td></td><td><em class=tab><a href="extsnd.html#textfocuscolor">text-focus-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#convolve?">convolve?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helphook">help-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixcolor">mix-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstohz">radians->hz</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphstyle">time-graph-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#fvcopy">copy</a></em></td><td></td><td><em class=tab><a href="extsnd.html#hidewidget">hide-widget</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdialogmix">mix-dialog-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rampchannel">ramp-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphtype">time-graph-type</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#s7copy">copy</a></em></td><td></td><td><em class=tab><a href="extsnd.html#highlightcolor">highlight-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdraghook">mix-drag-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand">rand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphp">time-graph?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#genericcopy"><b>copy (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#hilberttransform">hilbert-transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixfiledialog">mix-file-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp">rand-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#timestosamples">times->samples</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#copycontext">copy-context</a></em></td><td></td><td><em class=tab><a href="s7.html#hookfunctions">hook-functions</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixfv">mix-float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp?">rand-interp?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#tinyfont">tiny-font</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#copysampler">copy-sampler</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hookmember">hook-member</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixhome">mix-home</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand?">rand?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#telephone">touch-tone</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#copying"><b>Copying</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhooks"><b>Hooks</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixlength">mix-length</a></em></td><td></td><td><em class=tab><a href="s7.html#random">random</a></em></td><td></td><td><em class=tab><a href="s7.html#trace">trace</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#correlate">correlate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#html">html</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixmaxamp">mix-maxamp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#allrandomnumbers"><b>Random Numbers</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursors"><b>Tracking cursors</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#coverlet">coverlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmldir">html-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixname">mix-name</a></em></td><td></td><td><em class=tab><a href="s7.html#randomstate">random-state</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursorstyle">tracking-cursor-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#mixdoc">cross-fade (amplitude)</a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmlprogram">html-program</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixnametoid">mix-name->id</a></em></td><td></td><td><em class=tab><a href="s7.html#randomstatep">random-state?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtofv">transform->float-vector</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#fadedoc">cross-fade (frequency domain)</a></em></td><td></td><td><em class=tab><a href="sndclm.html#hztoradians">hz->radians</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixposition">mix-position</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rcos">rcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtointeger">transform->integer</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#crosssynthesis">cross-synthesis</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mixproperties">mix-properties</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rcos?">rcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformdialog">transform-dialog</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#curlet">curlet</a></em></td><td></td><td class="green"><div class="centered">I</div></td><td></td><td><em class=tab><a href="extsnd.html#mixproperty">mix-property</a></em></td><td></td><td><em class=tab><a href="s7.html#readerrorhook">*read-error-hook*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformframples">transform-framples</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#currentfont">current-font</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mixregion">mix-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readhook">read-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphstyle">transform-graph-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursor">cursor</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter">iir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixreleasehook">mix-release-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readmixsample">read-mix-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphtype">transform-graph-type</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorcolor">cursor-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter?">iir-filter?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsamplerQ">mix-sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readonly">read-only</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphp">transform-graph?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorcontext">cursor-context</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gin">in</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixselection">mix-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readregionsample">read-region-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizefft">transform-normalization</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorlocationoffset">cursor-location-offset</a></em></td><td></td><td><em class=tab><a href="sndclm.html#in-any">in-any</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixsound">mix-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readsample">read-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsample">transform-sample</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorposition">cursor-position</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ina">ina</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixspeed">mix-speed</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readsamplewithdirection">read-sample-with-direction</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsize">transform-size</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorsize">cursor-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#inb">inb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsync">mix-sync</a></em></td><td></td><td><em class=tab><a href="s7.html#readercond">reader-cond</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtype">transform-type</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorstyle">cursor-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#infodialog">info-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsyncmax">mix-sync-max</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin">readin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformp">transform?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorupdateinterval">cursor-update-interval</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#initladspa">init-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagheight">mix-tag-height</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin?">readin?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#transposemixes">transpose-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorexamples"><b>Cursors</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialbeg">initial-beg</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagwidth">mix-tag-width</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartomagnitudes">rectangular->magnitudes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave">triangle-wave</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#cutlet">cutlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialdur">initial-dur</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagy">mix-tag-y</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartopolar">rectangular->polar</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave?">triangle-wave?</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#cyclicsequences">cyclic-sequences</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialgraphhook">initial-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixwaveformheight">mix-waveform-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#redo">redo</a></em></td><td></td><td><em class=tab><a href="sndscm.html#tubebell">tubebell</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="grfsnd.html#sndinitfile"><b>Initialization file</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixp">mix?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontofv">region->float-vector</a></em></td><td></td><td><em class=tab><a href="sndscm.html#tubebell">tubular bell</a></em></td></tr>
+ <tr><td class="green"><div class="centered">D</div></td><td></td><td><em class=tab><a href="s7.html#inlet">inlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixes">mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontointeger">region->integer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole">two-pole</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#insertchannel">insert-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndmixes"><b>Mixing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionchans">region-chans</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole?">two-pole?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dacfolding">dac-combines-channels</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertfiledialog">insert-file-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#monotostereo">mono->stereo</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionframples">region-framples</a></em></td><td></td><td><em class=tab><a href="sndscm.html#twotab">two-tab</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dacsize">dac-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertregion">insert-region</a></em></td><td></td><td><em class=tab><a href="sndscm.html#moogfilter">moog-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiongraphstyle">region-graph-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero">two-zero</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#datacolor">data-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsample">insert-sample</a></em></td><td></td><td><em class=tab><a href="s7.html#morallyequalp">morally-equal?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionhome">region-home</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero?">two-zero?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#datalocation">data-location</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsamples">insert-samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseclickhook">mouse-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxamp">region-maxamp</a></em></td><td></td><td><em class=tab><a href="s7.html#typeof">type-of</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#datasize">data-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertselection">insert-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousedraghook">mouse-drag-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxampposition">region-maxamp-position</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#dbtolinear">db->linear</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsilence">insert-silence</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentergraphhook">mouse-enter-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionplaylist">region-play-list</a></em></td><td></td><td class="green"><div class="centered">U</div></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cdebugging"><b>Debugging (C)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsound">insert-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlabelhook">mouse-enter-label-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionposition">region-position</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#variabledisplay"><b>Debugging (instruments)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertionexamples"><b>Insertions</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlistenerhook">mouse-enter-listener-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionrms">region-rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#unbindkey">unbind-key</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#snderrors"><b>Debugging (Scheme)</b></a></em></td><td></td><td><em class=tab><a href="s7.html#intvector">int-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentertexthook">mouse-enter-text-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsample">region-sample</a></em></td><td></td><td><em class=tab><a href="s7.html#unboundvariablehook">*unbound-variable-hook*</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defaultoutputchans">default-output-chans</a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorref">int-vector-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavegraphhook">mouse-leave-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsamplerQ">region-sampler?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#unclipchannel">unclip-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defaultoutputheadertype">default-output-header-type</a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorset">int-vector-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavelabelhook">mouse-leave-label-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsrate">region-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undo">undo</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defaultoutputsampletype">default-output-sample-type</a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorp">int-vector?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavelistenerhook">mouse-leave-listener-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionok">region?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undoexamples"><b>Undo and Redo</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defaultoutputsrate">default-output-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertocolormap">integer->colormap</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavetexthook">mouse-leave-text-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#eregions">regions</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undohook">undo-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#defgenerator">defgenerator</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomark">integer->mark</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousepresshook">mouse-press-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionstuff"><b>Regions</b></a></em></td><td></td><td><em class=tab><a href="s7.html#unlet">unlet</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#definestar">define*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomix">integer->mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-locsig">move-locsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#remembersoundstate">remember-sound-state</a></em></td><td></td><td><em class=tab><a href="extsnd.html#unselectall">unselect-all</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#defineconstant">define-constant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertoregion">integer->region</a></em></td><td></td><td><em class=tab><a href="sndscm.html#movemixes">move-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#removeclicks">remove-clicks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#updategraphs">update-graphs</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defineenvelope">define-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertosound">integer->sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound">move-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#removefrommenu">remove-from-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatehook">update-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#expansion">define-expansion</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertotransform">integer->transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound?">move-sound?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#replacewithselection">replace-with-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatelispgraph">update-lisp-graph</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#definemacro">define-macro</a></em></td><td></td><td><em class=tab><a href="sndscm.html#integrateenvelope">integrate-envelope</a></em></td><td></td><td><em class=tab><a href="sndscm.html#movesyncdmarks">move-syncd-marks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reportmarknames">report-mark-names</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatesound">update-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#definemacrostar">define-macro*</a></em></td><td></td><td><em class=tab><a href="sndscm.html#invertfilter">invert-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation">moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="s7.html#requires7">require</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetimegraph">update-time-graph</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#defineselectionviamarks">define-selection-via-marks</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndswitches"><b>Invocation flags</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation?">moving-autocorrelation?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resampleexamples"><b>Resampling</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetransformgraph">update-transform-graph</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#definedp">defined?</a></em></td><td></td><td><em class=tab><a href="s7.html#iterate">iterate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average">moving-average</a></em></td><td></td><td><em class=tab><a href="sndscm.html#resetallhooks">reset-all-hooks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#uponsaveyourself">upon-save-yourself</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#degreestoradians">degrees->radians</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratoratend">iterator-at-end?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average?">moving-average?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetcontrols">reset-controls</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndmotifdoc">user interface extensions</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#delay">delay</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratorsequence">iterator-sequence</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft">moving-fft</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetlistenercursor">reset-listener-cursor</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#delaychannelmixes">delay-channel-mixes</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratorp">iterator?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft?">moving-fft?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reson">reson</a></em></td><td></td><td class="green"><div class="centered">V</div></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#delaytick">delay-tick</a></em></td><td></td><td><em class=tab><a href="sndclm.html#izcos">izcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-length">moving-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#restorecontrols">restore-controls</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#delay?">delay?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#izcos?">izcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-max">moving-max</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reverbexamples"><b>Reverb</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#variabledisplay">variable-display</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletecolormap">delete-colormap</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#moving-max?">moving-max?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*reverb*">*reverb*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#variablegraphp">variable-graph?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletefilefilter">delete-file-filter</a></em></td><td></td><td class="green"><div class="centered">J</div></td><td></td><td><em class=tab><a href="sndclm.html#moving-norm">moving-norm</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbdecay">reverb-control-decay</a></em></td><td></td><td><em class=tab><a href="s7.html#varlet">varlet</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletefilesorter">delete-file-sorter</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#moving-norm?">moving-norm?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolfeedback">reverb-control-feedback</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vibratinguniformcircularstring">vibrating-uniform-circular-string</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletemark">delete-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0evencos">j0evencos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch">moving-pitch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollength">reverb-control-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesamp">view-files-amp</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletemarks">delete-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0evencos?">j0evencos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch?">moving-pitch?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollengthbounds">reverb-control-length-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesampenv">view-files-amp-env</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletesample">delete-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0j1cos">j0j1cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-rms">moving-rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollowpass">reverb-control-lowpass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesdialog">view-files-dialog</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletesamples">delete-samples</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0j1cos?">j0j1cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid">moving-scentroid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscale">reverb-control-scale</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesfiles">view-files-files</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletesamplesandsmooth">delete-samples-and-smooth</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j2cos">j2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid?">moving-scentroid?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscalebounds">reverb-control-scale-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselecthook">view-files-select-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deleteselection">delete-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j2cos?">j2cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum">moving-spectrum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolp">reverb-control?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselectedfiles">view-files-selected-files</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deleteselectionandsmooth">delete-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandjack"><b>Jack</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum?">moving-spectrum?</a></em></td><td></td><td><em class=tab><a href="s7.html#reverseb">reverse!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilessort">view-files-sort</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletetransform">delete-transform</a></em></td><td></td><td><em class=tab><a href="sndscm.html#jcreverb">jc-reverb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-sum">moving-sum</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reversebyblocks">reverse-by-blocks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeed">view-files-speed</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletionexamples"><b>Deletions</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#jjcos">jjcos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mpg">mpg</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reversechannel">reverse-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeedstyle">view-files-speed-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#describehook">describe-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jjcos?">jjcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffersize">mus-alsa-buffer-size</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reverseenvelope">reverse-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewmixesdialog">view-mixes-dialog</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#describemark">describe-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jncos">jncos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffers">mus-alsa-buffers</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseselection">reverse-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewregionsdialog">view-regions-dialog</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#dht">dht</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jncos?">jncos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsacapturedevice">mus-alsa-capture-device</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reversesound">reverse-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewsound">view-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dialogwidgets">dialog-widgets</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jpcos">jpcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsadevice">mus-alsa-device</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseexamples"><b>Reversing</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">voice physical model</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#dilambda">dilambda</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jpcos?">jpcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsaplaybackdevice">mus-alsa-playback-device</a></em></td><td></td><td><em class=tab><a href="extsnd.html#revertsound">revert-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#voicedtounvoiced">voiced->unvoiced</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#disablecontrolpanel">disable-control-panel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#justsounds">just-sounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsasquelchwarning">mus-alsa-squelch-warning</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rightsample">right-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#volterrafilter">volterra-filter</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#displaybarkfft">display-bark-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jycos">jycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musarrayprintlength">mus-array-print-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ring-modulate">ring-modulate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvox">vox</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#displaycorrelation">display-correlation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jycos?">jycos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musbytespersample">mus-bytes-per-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!cos">rk!cos</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#displaydb">display-db</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channel">mus-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!cos?">rk!cos?</a></em></td><td></td><td class="green"><div class="centered">W</div></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#displayedits">display-edits</a></em></td><td></td><td class="green"><div class="centered">K</div></td><td></td><td><em class=tab><a href="sndclm.html#mus-channels">mus-channels</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!ssb">rk!ssb</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#displayenergy">display-energy</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-chebyshev-tu-sum">mus-chebyshev-tu-sum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!ssb?">rk!ssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train">wave-train</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#dissolvefade">dissolve-fade</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2cos">k2cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musclipping">mus-clipping</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkcos">rkcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train?">wave-train?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#ditherchannel">dither-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2cos?">k2cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-close">mus-close</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkcos?">rkcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavelettype">wavelet-type</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#dithersound">dither-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2sin">k2sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-copy">mus-copy</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkoddssb">rkoddssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqwvox">waveshaping voice</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#dolph">dolph</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2sin?">k2sin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-data">mus-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkoddssb?">rkoddssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavohop">wavo-hop</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#dot-product">dot-product</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2ssb">k2ssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-describe">mus-describe</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin">rksin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavotrace">wavo-trace</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dotsize">dot-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2ssb?">k2ssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrorhook">mus-error-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin?">rksin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#weighted-moving-average">weighted-moving-average</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#downoct">down-oct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k3sin">k3sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrortypetostring">mus-error-type->string</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkssb">rkssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetposition">widget-position</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawaxes">draw-axes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k3sin?">k3sin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musexpandfilename">mus-expand-filename</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkssb?">rkssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetsize">widget-size</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawdot">draw-dot</a></em></td><td></td><td><em class=tab><a href="sndscm.html#kalmanfilterchannel">kalman-filter-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedback">mus-feedback</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgettext">widget-text</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawdots">draw-dots</a></em></td><td></td><td><em class=tab><a href="extsnd.html#key">key</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedforward">mus-feedforward</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms, gain, balance gens</a></em></td><td></td><td><em class=tab><a href="extsnd.html#movingwindows"><b>Window size and position</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawline">draw-line</a></em></td><td></td><td><em class=tab><a href="extsnd.html#keybinding">key-binding</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fft">mus-fft</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsenvelope">rms-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowheight">window-height</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawlines">draw-lines</a></em></td><td></td><td><em class=tab><a href="extsnd.html#keypresshook">key-press-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musfilebuffersize">mus-file-buffer-size</a></em></td><td></td><td><em class=tab><a href="s7.html#rootlet">rootlet</a></em></td><td></td><td><em class=tab><a href="sndscm.html#windowsamples">window-samples</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawmarkhook">draw-mark-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#krksin">krksin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musfileclipping">mus-file-clipping</a></em></td><td></td><td><em class=tab><a href="s7.html#rootletredefinitionhook">*rootlet-redefinition-hook*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowwidth">window-width</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawmixhook">draw-mix-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#krksin?">krksin?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#musfilemix">mus-file-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#round-interp">round-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowx">window-x</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawstring">draw-string</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-file-name">mus-file-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#round-interp?">round-interp?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowy">window-y</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#drone">drone</a></em></td><td></td><td class="green"><div class="centered">L</div></td><td></td><td><em class=tab><a href="sndclm.html#musfloatequalfudgefactor">mus-float-equal-fudge-factor</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssb">rssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withbackgroundprocesses">with-background-processes</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#makedropsite">drop sites</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-frequency">mus-frequency</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssbinterp">rssb-interp</a></em></td><td></td><td><em class=tab><a href="s7.html#withbaffle">with-baffle</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drophook">drop-hook</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#ladspadescriptor">ladspa-descriptor</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musgeneratorp">mus-generator?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssb?">rssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withfilemonitor">with-file-monitor</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#duringopenhook">during-open-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ladspadir">ladspa-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musheaderrawdefaults">mus-header-raw-defaults</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rubbersound">rubber-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withgl">with-gl</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="s7.html#lambdastar">lambda*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypetostring">mus-header-type->string</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandruby"><b>Ruby</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#withinsetgraph">with-inset-graph</a></em></td></tr>
+ <tr><td class="green"><div class="centered">E</div></td><td></td><td><em class=tab><a href="sndscm.html#lbjpiano">lbj-piano</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypename">mus-header-type-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxycos">rxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withinterrupts">with-interrupts</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#leftsample">left-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-hop">mus-hop</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxycos?">rxycos?</a></em></td><td></td><td><em class=tab><a href="s7.html#with-let">with-let</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editlists"><b>Edit lists</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericlength"><b>length (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-increment">mus-increment</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!cos">rxyk!cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withlocalhook">with-local-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editfragment">edit-fragment</a></em></td><td></td><td><em class=tab><a href="s7.html#lettolist">let->list</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-input?">mus-input?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!cos?">rxyk!cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withmenuicons">with-menu-icons</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editheaderdialog">edit-header-dialog</a></em></td><td></td><td><em class=tab><a href="s7.html#letref">let-ref</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interp-type">mus-interp-type</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!sin">rxyk!sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withmixtags">with-mix-tags</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#edithook">edit-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#letset">let-set!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interpolate">mus-interpolate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!sin?">rxyk!sin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withpointerfocus">with-pointer-focus</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editlisttofunction">edit-list->function</a></em></td><td></td><td><em class=tab><a href="s7.html#lettemporarily">let-temporarily</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-length">mus-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxysin">rxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withrelativepanes">with-relative-panes</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editposition">edit-position</a></em></td><td></td><td><em class=tab><a href="s7.html#letp">let?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-location">mus-location</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxysin?">rxysin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withsmptelabel">with-smpte-label</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editproperties">edit-properties</a></em></td><td></td><td><em class=tab><a href="sndclm.html#lineartodb">linear->db</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musmaxmalloc">mus-max-malloc</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#withsound">with-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editproperty">edit-property</a></em></td><td></td><td><em class=tab><a href="sndscm.html#linearsrcchannel">linear-src-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musmaxtablesize">mus-max-table-size</a></em></td><td></td><td class="green"><div class="centered">S</div></td><td></td><td><em class=tab><a href="sndscm.html#withtemporaryselection">with-temporary-selection</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#edittree">edit-tree</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lintdoc">lint for scheme</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-name">mus-name</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#withtoolbar">with-toolbar</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#edits">edits</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphhook">lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-offset">mus-offset</a></em></td><td></td><td><em class=tab><a href="s7.html#s7doc"><b>s7 scheme</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtooltips">with-tooltips</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#edot-product">edot-product</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphstyle">lisp-graph-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-order">mus-order</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sample">sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtrackingcursor">with-tracking-cursor</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#effectshook">effects-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphp">lisp-graph?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musosssetbuffers">mus-oss-set-buffers</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile">sample->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withverbosecursor">with-verbose-cursor</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">elliptic filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listtofv">list->float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-output?">mus-output?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile?">sample->file?</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#emacssnd"><b>Emacs and Snd</b></a></em></td><td></td><td><em class=tab><a href="grfsnd.html#listladspa">list-ladspa</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-phase">mus-phase</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sampletype">sample-type</a></em></td><td></td><td class="green"><div class="centered">X</div></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#env">env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerclickhook">listener-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ramp">mus-ramp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sampleratendQ">sampler-at-end?</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#env-any">env-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenercolor">listener-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-rand-seed">mus-rand-seed</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerhome">sampler-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xtoposition">x->position</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envchannel">env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenercolorized">listener-colorized</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-random">mus-random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerposition">sampler-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xaxislabel">x-axis-label</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envchannelwithbase">env-channel-with-base</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerfont">listener-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-reset">mus-reset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerQ">sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xaxisstyle">x-axis-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#envexptchannel">env-expt-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerprompt">listener-prompt</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-run">mus-run</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplers"><b>samplers</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#xbounds">x-bounds</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#env-interp">env-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerselection">listener-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussampletypetostring">mus-sample-type->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samples">samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xpositionslider">x-position-slider</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#envmixes">env-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenertextcolor">listener-text-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussampletypename">mus-sample-type-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#samplestoseconds">samples->seconds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xzoomslider">x-zoom-slider</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envselection">env-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#littleendianp">little-endian?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-scaler">mus-scaler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sashcolor">sash-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#xbopen">xb-open</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envsound">env-sound</a></em></td><td></td><td><em class=tab><a href="s7.html#loadhook">*load-hook*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundchans">mus-sound-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveasdialogautocomment">save-as-dialog-auto-comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xrampchannel">xramp-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#envsoundinterp">env-sound-interp</a></em></td><td></td><td><em class=tab><a href="s7.html#loadpath">*load-path*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcloseinput">mus-sound-close-input</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveasdialogsrc">save-as-dialog-src</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#envsquaredchannel">env-squared-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#locatezero">locate-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcloseoutput">mus-sound-close-output</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savecontrols">save-controls</a></em></td><td></td><td class="green"><div class="centered">Y</div></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#env?">env?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig">locsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcomment">mus-sound-comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savedir">save-dir</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedbase">enved-base</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-ref">locsig-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatalocation">mus-sound-data-location</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveedithistory">save-edit-history</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ytoposition">y->position</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedclipping">enved-clip?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-reverb-ref">locsig-reverb-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatumsize">mus-sound-datum-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveenvelopes">save-envelopes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yaxislabel">y-axis-label</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#enveddialog">enved-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-reverb-set!">locsig-reverb-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundduration">mus-sound-duration</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savehook">save-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ybounds">y-bounds</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedenvelope">enved-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-set!">locsig-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundforget">mus-sound-forget</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savelistener">save-listener</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ypositionslider">y-position-slider</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#filterenv">enved-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-type">locsig-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundframples">mus-sound-framples</a></em></td><td></td><td><em class=tab><a href="sndscm.html#savemarkproperties">save-mark-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yzoomslider">y-zoom-slider</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#filterenvorder">enved-filter-order</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig?">locsig?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundheadertype">mus-sound-header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemarks">save-marks</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedhook">enved-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#logfreqstart">log-freq-start</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundlength">mus-sound-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemix">save-mix</a></em></td><td></td><td class="green"><div class="centered">Z</div></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedin-dB">enved-in-dB</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpccoeffs">lpc-coeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundloopinfo">mus-sound-loop-info</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregion">save-region</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedpower">enved-power</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpcpredict">lpc-predict</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmarkinfo">mus-sound-mark-info</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregiondialog">save-region-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ztransform">z-transform</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedstyle">enved-style</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxamp">mus-sound-maxamp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveselection">save-selection</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zecho">zecho</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedtarget">enved-target</a></em></td><td></td><td class="green"><div class="centered">M</div></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxampexists">mus-sound-maxamp-exists?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveselectiondialog">save-selection-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zeroplus">zero+</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedwaving">enved-wave?</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundopeninput">mus-sound-open-input</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesound">save-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zeropad">zero-pad</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedwaveformcolor">enved-waveform-color</a></em></td><td></td><td><em class=tab><a href="s7.html#macrop">macro?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundopenoutput">mus-sound-open-output</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesoundas">save-sound-as</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zerophase">zero-phase</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#envelopeinterp">envelope-interp</a></em></td><td></td><td><em class=tab><a href="s7.html#macroexpand">macroexpand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundpath">mus-sound-path</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesounddialog">save-sound-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipsound">zip-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#envelopedmix">enveloped-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainmenu">main-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundpreload">mus-sound-preload</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestate">save-state</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipper">zipper</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envexamples"><b>Envelopes</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainwidgets">main-widgets</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundprune">mus-sound-prune</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatefile">save-state-file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomcolor">zoom-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#eoddcos">eoddcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-abcos">make-abcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundread">mus-sound-read</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatehook">save-state-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomfocusstyle">zoom-focus-style</a></em></td></tr>
+
</table>
</body></html>
diff --git a/inf-snd.el b/inf-snd.el
index bccc638..4531878 100644
--- a/inf-snd.el
+++ b/inf-snd.el
@@ -1156,6 +1156,17 @@ Started from `snd-ruby-mode', `snd-forth-mode' or `snd-scheme-mode'."
(comint-send-string (snd-proc) (concat "include " filename "\n"))
(comint-send-string (snd-proc) (concat "(load \"" filename"\"\)\n"))))
+;;; this from Orm Finnendahl 20-Mar-17
+(defun snd-scheme-open-file (filename)
+ "Open file in a running inferior Snd-Scheme process. Start the process if necessary."
+ (interactive "FOpen Soundfile:")
+ (if (comint-check-proc inf-snd-scheme-buffer)
+ (inf-snd-send-string (format "(open-sound \"%s\")" filename))
+ (progn
+ (set-buffer (apply 'make-comint inf-snd-scheme-buffer-name inf-snd-scheme-program-name nil (list filename)))
+ (inf-snd-scheme-mode)
+ (snd-send-invisible "#f"))))
+
(defun snd-save-state ()
"Synchronize the inferior Snd process with the edit buffer."
(and (snd-proc)
diff --git a/io.c b/io.c
index 660e3c3..5bd52e9 100644
--- a/io.c
+++ b/io.c
@@ -1082,8 +1082,6 @@ static mus_long_t mus_read_any_1(int tfd, mus_long_t beg, int chans, mus_long_t
if (fd->saved)
{
- /* fprintf(stderr, "mus_read_any_1 %d use saved data\n", tfd); */
-
lim = nints;
if (lim > fd->framples)
lim = fd->framples;
@@ -1096,9 +1094,9 @@ static mus_long_t mus_read_any_1(int tfd, mus_long_t beg, int chans, mus_long_t
buffer = (mus_float_t *)(bufs[0]);
if (buffer)
{
- memcpy((void *)buffer, (void *)(fd->saved_data[0] + beg), bytes);
+ copy_floats(buffer, fd->saved_data[0] + beg, lim);
if (lim < nints)
- memset((void *)(buffer + lim), 0, (nints - lim) * sizeof(mus_float_t));
+ clear_floats(buffer + lim, nints - lim);
}
}
else
@@ -1109,9 +1107,9 @@ static mus_long_t mus_read_any_1(int tfd, mus_long_t beg, int chans, mus_long_t
buffer = (mus_float_t *)(bufs[k]);
if (buffer)
{
- memcpy((void *)buffer, (void *)(fd->saved_data[k] + beg), bytes);
+ copy_floats(buffer, fd->saved_data[k] + beg, lim);
if (lim < nints)
- memset((void *)(buffer + lim), 0, (nints - lim) * sizeof(mus_float_t));
+ clear_floats(buffer + lim, nints - lim);
}
}
}
@@ -1173,7 +1171,7 @@ static mus_long_t mus_read_any_1(int tfd, mus_long_t beg, int chans, mus_long_t
{
mus_float_t *p;
p = bufs[k];
- memset((void *)(p + loc), 0, (nints - loc) * sizeof(mus_float_t));
+ clear_floats(p + loc, nints - loc);
}
return(total_read);
}
@@ -1728,7 +1726,7 @@ mus_long_t mus_file_read(int tfd, mus_long_t beg, mus_long_t num, int chans, mus
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); */
- memset((void *)(buffer + rtn), 0, (num - rtn) * sizeof(mus_float_t));
+ clear_floats(buffer + rtn, num - rtn);
}
}
return(num);
@@ -1738,19 +1736,22 @@ mus_long_t mus_file_read(int tfd, mus_long_t beg, mus_long_t num, int chans, mus
mus_long_t mus_file_read_chans(int tfd, mus_long_t beg, mus_long_t num, int chans, mus_float_t **bufs, mus_float_t **cm)
{
/* an optimization of mus_file_read -- just reads the desired channels */
- mus_long_t rtn, k;
+ mus_long_t rtn;
rtn = mus_read_any_1(tfd, beg, chans, num, bufs, cm, NULL);
if (rtn == MUS_ERROR) return(MUS_ERROR);
- if (rtn < num)
- for (k = 0; k < chans; k++)
- if ((!cm) || (cm[k]))
- {
- mus_float_t *buffer;
- buffer = bufs[k];
- memset((void *)(buffer + rtn), 0, (num - rtn) * sizeof(mus_float_t));
- }
+ if (rtn < num)
+ {
+ mus_long_t k;
+ for (k = 0; k < chans; k++)
+ if ((!cm) || (cm[k]))
+ {
+ mus_float_t *buffer;
+ buffer = bufs[k];
+ clear_floats(buffer + rtn, num - rtn);
+ }
+ }
return(num);
}
@@ -3335,11 +3336,6 @@ bool mus_strcmp(const char *s1, const char *s2)
if (c1 == '\0') break;
}
return(true);
-#if 0
- return((str1 == str2) ||
- ((str1) && (str2) &&
- (strcmp(str1, str2) == 0)));
-#endif
}
diff --git a/jcrev.scm b/jcrev.scm
index fd406f9..0f4b45c 100644
--- a/jcrev.scm
+++ b/jcrev.scm
@@ -26,7 +26,7 @@
(allpasses (make-all-pass-bank (vector allpass1 allpass2 allpass3))))
(if (or amp-env low-pass)
- (let ((flt (and low-pass (make-fir-filter 3 (float-vector 0.25 0.5 0.25))))
+ (let ((flt (and low-pass (make-fir-filter 3 #r(0.25 0.5 0.25))))
(envA (make-env :envelope (or amp-env '(0 1 1 1)) :scaler volume :duration (/ len *clm-srate*))))
(if low-pass
(do ((i 0 (+ i 1)))
@@ -35,9 +35,18 @@
(do ((i 0 (+ i 1)))
((= i len))
(out-bank filts i (* (env envA) (comb-bank combs (all-pass-bank allpasses (ina i *reverb*))))))))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (out-bank filts i (* volume (comb-bank combs (all-pass-bank allpasses (ina i *reverb*))))))))))
+ (if (= chns 1)
+ (let ((gen (filts 0)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (outa i (delay gen (* volume (comb-bank combs (all-pass-bank allpasses (ina i *reverb*))))))))
+ (let ((gen1 (filts 0))
+ (gen2 (filts 1)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let ((val (* volume (comb-bank combs (all-pass-bank allpasses (ina i *reverb*))))))
+ (outa i (delay gen1 val))
+ (outb i (delay gen2 val))))))))))
;;; (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount .3))
;;; (with-sound (:reverb jc-reverb) (outa 0 .1) (outa 0 .5 *reverb*))
diff --git a/libc.scm b/libc.scm
index 94d460b..89ed0bc 100644
--- a/libc.scm
+++ b/libc.scm
@@ -222,9 +222,7 @@
(int remove (char*))
(int rename (char* char*))
(FILE* tmpfile (void))
- (reader-cond ((not (provided? 'osx))
- (char* tmpnam (char*))
- (char* tempnam (char* char*))))
+; (reader-cond ((not (provided? 'osx)) (char* tmpnam (char*)) (char* tempnam (char* char*))))
(int fclose (FILE*))
(int fflush (FILE*))
;; (reader-cond ((provided? 'linux) (int fcloseall (void))))
@@ -303,7 +301,7 @@
(int putenv (char*))
(int setenv (char* char* int))
(int unsetenv (char*))
- (char* mktemp (char*))
+; (char* mktemp (char*))
(int mkstemp (char*))
(int system (char*))
(char* realpath (char* char*))
diff --git a/libgdbm.scm b/libgdbm.scm
index b4146b3..dbe8449 100644
--- a/libgdbm.scm
+++ b/libgdbm.scm
@@ -31,7 +31,7 @@
(C-macro (int (GDBM_NO_ERROR GDBM_MALLOC_ERROR GDBM_BLOCK_SIZE_ERROR GDBM_FILE_OPEN_ERROR GDBM_FILE_WRITE_ERROR
GDBM_FILE_SEEK_ERROR GDBM_FILE_READ_ERROR GDBM_BAD_MAGIC_NUMBER GDBM_EMPTY_DATABASE GDBM_CANT_BE_READER
GDBM_CANT_BE_WRITER GDBM_READER_CANT_DELETE GDBM_READER_CANT_STORE GDBM_READER_CANT_REORGANIZE
- GDBM_UNKNOWN_UPDATE GDBM_ITEM_NOT_FOUND GDBM_REORGANIZE_FAILED GDBM_CANNOT_REPLACE GDBM_ILLEGAL_DATA
+ GDBM_ITEM_NOT_FOUND GDBM_REORGANIZE_FAILED GDBM_CANNOT_REPLACE GDBM_ILLEGAL_DATA
GDBM_OPT_ALREADY_SET GDBM_OPT_ILLEGAL GDBM_BYTE_SWAPPED GDBM_BAD_FILE_OFFSET GDBM_BAD_OPEN_FLAGS
GDBM_FILE_STAT_ERROR GDBM_FILE_EOF)))
diff --git a/libgsl.scm b/libgsl.scm
index 657e379..a9227d5 100644
--- a/libgsl.scm
+++ b/libgsl.scm
@@ -2,23 +2,6 @@
;;;
;;; tie the gsl library into the *libgsl* environment
-
-#|
-2.1: gsl_multilarge.h
-+ double
-+ gsl_multifit_linear_rcond (const gsl_multifit_linear_workspace * w);
-+
-changes to sigs in multifit.h
-
-2.2:
-gsl_multifit_nlinear.h
-gsl_multilarge_nlinear.h
-gsl_permute_matrix_char.h
-gsl_permute_matrix_complex_double.h and float/long double and all other types
-many other additions/sig changes (triangular matrices primiarily)
-|#
-
-
(require cload.scm)
(provide 'libgsl.scm)
@@ -2570,6 +2553,8 @@ many other additions/sig changes (triangular matrices primiarily)
(int gsl_multifit_linear_est (gsl_vector* gsl_vector* gsl_matrix* double* double*))
(reader-cond ((>= gsl-version 2.1)
(double gsl_multifit_linear_rcond (gsl_multifit_linear_workspace*))))
+ (reader-cond ((>= gsl-version 2.3)
+ (size_t gsl_multifit_linear_rank (double gsl_multifit_linear_workspace*))))
(int gsl_multifit_linear_residuals (gsl_matrix* gsl_vector* gsl_vector* gsl_vector*))
(reader-cond ((>= gsl-version 1.16)
(gsl_multifit_robust_workspace* gsl_multifit_robust_alloc (gsl_multifit_robust_type* size_t size_t))
diff --git a/lint.scm b/lint.scm
index d4ee3bd..26bea2b 100644
--- a/lint.scm
+++ b/lint.scm
@@ -33,9 +33,11 @@
(define *report-bloated-arg* 24) ; min arg expr tree size that can trigger a rewrite-as-let suggestion (32 is too high I think)
(define *report-clobbered-function-return-value* #f) ; function returns constant sequence, which is then stomped on -- very rare!
(define *report-boolean-functions-misbehaving* #t) ; function name ends in #\? but function returns a non-boolean value -- dubious.
-(define *report-repeated-code-fragments* 200) ; #t, #f, or an int = min reported fragment size * uses * uses, #t=130.
(define *report-quasiquote-rewrites* #t) ; simple quasiquote stuff rewritten as a normal list expression
+(define *report-||-rewrites* #t) ; | has no special meaning in s7, |...| does not represent the symbol ...
+;;; these turn out to be less useful than I expected
+(define *report-repeated-code-fragments* 200) ; #t, #f, or an int = min reported fragment size * uses * uses, #t=130.
(define *fragment-max-size* 128) ; biggest seen if 512: 180 -- appears to be in a test suite, if 128 max at 125
(define *fragment-min-size* 5) ; smallest seen - 1 -- maybe 8 would be better
@@ -74,7 +76,7 @@
(define-macro (reader-cond . clauses) `(values)) ; clobber reader-cond to avoid (incorrect) unbound-variable errors
#|
-;; debugging version
+;; debugging version -- does not work in repl's listener
(define-expansion (lint-format str caller . args)
`(begin
(format outport "lint.scm line ~A~%" ,(port-line-number))
@@ -82,6 +84,9 @@
|#
+(define var-name car)
+(define var-member assq)
+
;;; --------------------------------------------------------------------------------
(define lint
@@ -120,17 +125,18 @@
procedure-setter procedure-signature procedure-source procedure? proper-list? provided?
quasiquote quote quotient
random-state random-state->list random-state? rational? rationalize real-part real? remainder reverse rootlet round
- s7-version sequence? sin sinh square sqrt stacktrace string string->list string->number string->symbol string->keyword string-append
+ sequence? sin sinh square sqrt stacktrace string string->list string->number string->symbol string->keyword string-append
string-ci<=? string-ci<? string-ci=? string-ci>=? string-ci>? string-downcase string-length
string-position string-ref string-upcase string<=? string<? string=? string>=? string>? string?
sublet substring symbol symbol->dynamic-value symbol->keyword symbol->string symbol->value symbol?
- tan tanh tree-leaves tree-memq truncate
+ tan tanh tree-leaves tree-memq truncate type-of
unless
values vector vector-append vector->list vector-dimensions vector-length vector-ref vector?
when with-baffle with-let with-input-from-file with-input-from-string with-output-to-string
zero?
- #_list-values #_apply-values #_append unquote))
+ list-values apply-values unquote))
;; do not include file-exists? or directory? (also not peek-char because these are checked via eval)
+ ;; also s7-version since it's used for reporting
ht))
(built-in-functions (let ((ht (make-hash-table)))
@@ -176,8 +182,8 @@
catch throw error procedure-documentation procedure-signature help procedure-source funclet
procedure-setter arity aritable? not eq? eqv? equal? morally-equal? gc s7-version emergency-exit
exit dilambda make-hook hook-functions stacktrace tree-leaves tree-memq object->let
- getenv directory? file-exists?
- #_list-values #_apply-values #_append unquote))
+ getenv directory? file-exists? type-of
+ list-values apply-values unquote))
ht))
(makers (let ((h (make-hash-table)))
@@ -188,7 +194,7 @@
make-string string string-copy copy list->string string->list string-append substring object->string
format cons list make-list reverse append vector-append list->vector vector->list make-vector
make-shared-vector vector make-float-vector float-vector make-int-vector int-vector byte-vector
- hash-table hash-table* make-hash-table make-hook #_list-values #_append gentemp)) ; gentemp for other schemes
+ hash-table hash-table* make-hash-table make-hook list-values append gentemp)) ; gentemp for other schemes
h))
(non-negative-ops (let ((h (make-hash-table)))
@@ -280,25 +286,17 @@
define-constant define-expansion))
h))
- (definers (let ((h (make-hash-table)))
- (for-each (lambda (d)
- (set! (h d) #t))
- '(define define* define-constant lambda lambda* curlet require load eval eval-string
- define-macro define-macro* define-bacro define-bacro* define-expansion
- definstrument define-animal define-envelope
- define-values define-module define-method
- define-syntax define-public define-inlinable define-integrable define^))
- h))
+ (definers '(define define* define-constant lambda lambda* curlet require load eval eval-string
+ define-macro define-macro* define-bacro define-bacro* define-expansion
+ definstrument define-animal define-envelope
+ define-values define-module define-method
+ define-syntax define-public define-inlinable define-integrable define^))
- (open-definers (let ((h (make-hash-table)))
- (for-each (lambda (d)
- (set! (h d) #t))
- '(define define* define-constant require load eval eval-string
- define-macro define-macro* define-bacro define-bacro* define-expansion
- definstrument define-animal define-envelope defgenerator
- define-values define-module define-method
- define-syntax define-public define-inlinable define-integrable define^))
- h))
+ (open-definers '(define define* define-constant require load eval eval-string
+ define-macro define-macro* define-bacro define-bacro* define-expansion
+ definstrument define-animal define-envelope defgenerator
+ define-values define-module define-method
+ define-syntax define-public define-inlinable define-integrable define^))
(cxars (hash-table '(car . ()) '(caar . car) '(cdar . cdr)
'(caaar . caar) '(cdaar . cdar) '(cddar . cddr) '(cadar . cadr)
@@ -336,85 +334,86 @@
(i 0 (+ i 1)))
((= i *fragment-max-size*) v)
(set! (v i) (make-hash-table))))
+ (fragmin *fragment-max-size*)
+ (fragmax 0)
(*max-cdr-len* 16)) ; 40 is too high, 24 questionable, if #f the let+do rewrite is turned off
(set! *e* (curlet))
(set! *lint* (curlet)) ; external access to (for example) the built-in-functions hash-table via (*lint* 'built-in-functions)
+ (define denote define-constant)
+
+ (define definers-table
+ (let ((h (make-hash-table)))
+ (for-each (lambda (d)
+ (set! (h d) #t))
+ definers)
+ h))
+
+ (define open-definers-table
+ (let ((h (make-hash-table)))
+ (for-each (lambda (d)
+ (set! (h d) #t))
+ open-definers)
+ h))
;; -------- lint-format --------
- (define target-line-length 80)
+ (define target-line-length 80) ; also 120 via let-temporarily
- (define (truncated-list->string form)
- ;; return form -> string with limits on its length
- (let* ((str (object->string form))
- (len (length str)))
+ (denote (lint-truncate-string str)
+ (let ((len (length str)))
(if (< len target-line-length)
str
(do ((i (- target-line-length 6) (- i 1)))
((or (= i 40)
- (char-whitespace? (str i)))
+ (char-whitespace? (string-ref str i)))
(string-append (substring str 0 (if (<= i 40)
(- target-line-length 6)
i))
"..."))))))
+
+ (denote (truncated-list->string form)
+ ;; return form -> string with limits on its length
+ (lint-truncate-string (object->string form #t target-line-length)))
(define lint-pp #f) ; avoid crosstalk with other schemes' definitions of pp and pretty-print (make-lint-var also collides)
- (define lint-pretty-print #f)
+ (define lint-pp-funclet #f)
(let ()
(require write.scm)
(set! lint-pp pp);
- (set! lint-pretty-print pretty-print))
-
- (define (lists->string f1 f2)
- ;; same but 2 strings that may need to be lined up vertically
- (let ((str1 (object->string f1))
- (str2 (object->string f2)))
- (let ((len1 (length str1))
- (len2 (length str2)))
- (when (> len1 target-line-length)
- (set! str1 (truncated-list->string f1))
- (set! len1 (length str1)))
- (when (> len2 target-line-length)
- (let ((old-len2 len2))
- (set! ((funclet lint-pretty-print) '*pretty-print-left-margin*) pp-left-margin)
- (set! ((funclet lint-pretty-print) '*pretty-print-length*) (- 114 pp-left-margin))
- (set! str2 (lint-pp f2))
- (set! len2 (length str2))
- (when (> len2 (* 10 old-len2)) ; this is aimed at some pathological s7test cases -- never hit otherwise I think
- (set! str2 (truncated-list->string f2))
- (set! len2 (length str2)))))
- (if (< (+ len1 len2) target-line-length)
- (format #f "~A -> ~A" str1 str2)
- (format #f "~%~NC~A ->~%~NC~A" pp-left-margin #\space str1 pp-left-margin #\space str2)))))
+ (set! lint-pp-funclet (funclet pretty-print)))
+ (denote (lists->string f1 f2)
+ (let ((str1 (lint-truncate-string (object->string f1 #t (+ target-line-length 2)))))
+ (if (> (tree-leaves f2) 10)
+ (begin
+ (set! (lint-pp-funclet '*pretty-print-left-margin*) pp-left-margin)
+ (set! (lint-pp-funclet '*pretty-print-length*) (- 114 pp-left-margin))
+ (format #f "~%~NC~A ->~%~NC~A" pp-left-margin #\space str1 pp-left-margin #\space (lint-pp f2)))
+ (let ((str2 (lint-truncate-string (object->string f2 #t (+ target-line-length 2)))))
+ (if (< (+ (length str1) (length str2)) target-line-length)
+ (format #f "~A -> ~A" str1 str2)
+ (format #f "~%~NC~A ->~%~NC~A" pp-left-margin #\space str1 pp-left-margin #\space str2))))))
+
(define (truncated-lists->string f1 f2)
;; same but 2 strings that may need to be lined up vertically and both are truncated
- (let ((str1 (object->string f1))
- (str2 (object->string f2)))
- (let ((len1 (length str1))
- (len2 (length str2)))
- (when (> len1 target-line-length)
- (set! str1 (truncated-list->string f1))
- (set! len1 (length str1)))
- (when (> len2 target-line-length)
- (set! str2 (truncated-list->string f2))
- (set! len2 (length str2)))
- (if (< (+ len1 len2) target-line-length)
- (format #f "~A -> ~A" str1 str2)
- (format #f "~%~NC~A ->~%~NC~A" pp-left-margin #\space str1 pp-left-margin #\space str2)))))
+ (let ((str1 (lint-truncate-string (object->string f1 #t (+ target-line-length 2))))
+ (str2 (lint-truncate-string (object->string f2 #t (+ target-line-length 2)))))
+ (if (< (+ (length str1) (length str2)) target-line-length)
+ (format #f "~A -> ~A" str1 str2)
+ (format #f "~%~NC~A ->~%~NC~A" pp-left-margin #\space str1 pp-left-margin #\space str2))))
(define made-suggestion 0)
- (define (lint-format str caller . args)
+ (denote (lint-format str caller . args)
(let ((outstr (apply format #f
- (string-append (if (< 0 line-number 100000)
+ (string-append (if line-number
"~NC~A (line ~D): "
"~NC~A: ")
str "~%")
lint-left-margin #\space
(truncated-list->string caller)
- (if (< 0 line-number 100000)
+ (if line-number
(values line-number args)
args))))
(set! made-suggestion (+ made-suggestion 1))
@@ -422,35 +421,35 @@
(if (> (length outstr) (+ target-line-length 40))
(newline outport))))
- (define (local-line-number tree)
- (let ((tree-line (if (pair? tree) (pair-line-number tree) 0)))
- (if (and (< 0 tree-line 100000)
+ (denote (local-line-number tree)
+ (let ((tree-line (and (pair? tree) (pair-line-number tree))))
+ (if (and tree-line
(not (= tree-line line-number)))
(format #f " (line ~D)" tree-line)
"")))
;; -------- vars --------
- (define var-name car)
- (define (var? v) (and (pair? v) (let? (cdr v))))
- (define var-member assq)
-
- (define var-ref (dilambda (lambda (v) (let-ref (cdr v) 'ref)) (lambda (v x) (let-set! (cdr v) 'ref x))))
- (define var-set (dilambda (lambda (v) (let-ref (cdr v) 'set)) (lambda (v x) (let-set! (cdr v) 'set x))))
- (define var-history (dilambda (lambda (v) (let-ref (cdr v) 'history)) (lambda (v x) (let-set! (cdr v) 'history x))))
- (define var-ftype (dilambda (lambda (v) (let-ref (cdr v) 'ftype)) (lambda (v x) (let-set! (cdr v) 'ftype x))))
- (define var-retcons (dilambda (lambda (v) (let-ref (cdr v) 'retcons)) (lambda (v x) (let-set! (cdr v) 'retcons x))))
- (define var-arglist (dilambda (lambda (v) (let-ref (cdr v) 'arglist)) (lambda (v x) (let-set! (cdr v) 'arglist x))))
- (define var-definer (dilambda (lambda (v) (let-ref (cdr v) 'definer)) (lambda (v x) (let-set! (cdr v) 'definer x))))
- (define var-leaves (dilambda (lambda (v) (let-ref (cdr v) 'leaves)) (lambda (v x) (let-set! (cdr v) 'leaves x))))
- (define var-scope (dilambda (lambda (v) (let-ref (cdr v) 'scope)) (lambda (v x) (let-set! (cdr v) 'scope x))))
- (define var-setters (dilambda (lambda (v) (let-ref (cdr v) 'setters)) (lambda (v x) (let-set! (cdr v) 'setters x))))
- (define var-env (dilambda (lambda (v) (let-ref (cdr v) 'env)) (lambda (v x) (let-set! (cdr v) 'env x))))
- (define var-decl (dilambda (lambda (v) (let-ref (cdr v) 'decl)) (lambda (v x) (let-set! (cdr v) 'decl x))))
- (define var-match-list (dilambda (lambda (v) (let-ref (cdr v) 'match-list)) (lambda (v x) (let-set! (cdr v) 'match-list x))))
- (define var-initial-value (lambda (v) (let-ref (cdr v) 'initial-value))) ; not (easily) settable
-
- (define var-refenv
+ (denote (var? v) (and (pair? v) (let? (cdr v))))
+ (denote var-ref (dilambda (lambda (v) (let-ref (cdr v) 'ref)) (lambda (v x) (let-set! (cdr v) 'ref x))))
+ (denote var-set (dilambda (lambda (v) (let-ref (cdr v) 'set)) (lambda (v x) (let-set! (cdr v) 'set x))))
+ (denote var-history (dilambda (lambda (v) (let-ref (cdr v) 'history)) (lambda (v x) (let-set! (cdr v) 'history x))))
+ (denote var-ftype (dilambda (lambda (v) (let-ref (cdr v) 'ftype)) (lambda (v x) (if (defined? 'ftype (cdr v)) (let-set! (cdr v) 'ftype x)))))
+ (denote var-retcons (dilambda (lambda (v) (let-ref (cdr v) 'retcons)) (lambda (v x) (let-set! (cdr v) 'retcons x))))
+ (denote var-arglist (dilambda (lambda (v) (let-ref (cdr v) 'arglist)) (lambda (v x) (let-set! (cdr v) 'arglist x))))
+ (denote var-definer (dilambda (lambda (v) (let-ref (cdr v) 'definer)) (lambda (v x) (let-set! (cdr v) 'definer x))))
+ (denote var-leaves (dilambda (lambda (v) (let-ref (cdr v) 'leaves)) (lambda (v x) (let-set! (cdr v) 'leaves x))))
+ (denote var-scope (dilambda (lambda (v) (let-ref (cdr v) 'scope)) (lambda (v x) (let-set! (cdr v) 'scope x))))
+ (denote var-setters (dilambda (lambda (v) (let-ref (cdr v) 'setters)) (lambda (v x) (let-set! (cdr v) 'setters x))))
+ (denote var-env (dilambda (lambda (v) (let-ref (cdr v) 'env)) (lambda (v x) (let-set! (cdr v) 'env x))))
+ (denote (var-arity v)
+ (let ((val (let-ref (cdr v) 'arit)))
+ (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-refenv
(dilambda (lambda (v)
(let-ref (cdr v) 'refenv))
(lambda (v e)
@@ -461,7 +460,7 @@
(let-set! (cdr v) 'refenv #f))))
e)))
- (define var-side-effect
+ (denote var-side-effect
(dilambda (lambda (v)
(case (let-ref (cdr v) 'side-effect)
((()) (let-set! (cdr v) 'side-effect (get-side-effect v)))
@@ -469,74 +468,82 @@
(lambda (v x)
(let-set! (cdr v) 'side-effect x))))
- (define var-signature
+ (denote var-signature
(dilambda (lambda (v)
(case (let-ref (cdr v) 'signature)
((()) (let-set! (cdr v) 'signature (get-signature v)))
(else)))
- (lambda (v x)
- (let-set! (cdr v) 'signature x))))
+ (lambda (v x)
+ (if (defined? 'signature (cdr v))
+ (let-set! (cdr v) 'signature x))))) ; perhaps fallback on varlet here and in var-ftype above?
- (define (make-lint-var name initial-value definer)
- (let ((old (hash-table-ref other-identifiers name)))
- (cons name (inlet 'initial-value initial-value
- 'definer definer
- '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) ()))
- 'scope ()
+ (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) ()))))
+ (cons name (inlet 'scope ()
'env ()
'refenv ()
'setters ()
+ 'initial-value initial-value
+ 'definer definer
+ 'history history
'set 0
'ref (if old (length old) 0)))))
;; -------- the usual list functions --------
- (define (len=1? x)
+ (denote (len=1? x)
(and (pair? x)
(null? (cdr x))))
- (define (len=2? x)
+ (denote (len=2? x)
(and (pair? x)
(pair? (cdr x))
(null? (cddr x))))
- (define (len=3? x)
+ (denote (len=3? x)
(and (pair? x)
(pair? (cdr x))
(pair? (cddr x))
(null? (cdddr x))))
- (define (len>1? x)
+ (denote (len>1? x)
(and (pair? x)
(pair? (cdr x))))
- (define (len>2? x)
+ (denote (len>2? x)
(and (pair? x)
(pair? (cdr x))
(pair? (cddr x))))
- (define (proper-pair? x)
+ (denote (last-ref x)
+ (let ((len (length x)))
+ (and (integer? len)
+ (positive? len)
+ (list-ref x (- len 1)))))
+
+ (denote (proper-pair? x)
(and (pair? x)
(proper-list? (cdr x))))
- (define (unquoted-pair? x)
+ (denote (unquoted-pair? x)
(and (pair? x)
(not (eq? (car x) 'quote))))
(define (remove item sequence)
- (cond ((null? sequence) ())
+ (cond ((not (pair? sequence)) sequence)
((equal? item (car sequence)) (cdr sequence))
(else (cons (car sequence)
(remove item (cdr sequence))))))
(define (remq-set items sequence)
- (cond ((null? sequence)
- ())
+ (cond ((not (pair? sequence))
+ sequence)
((memq (car sequence) items)
(remq-set items (cdr sequence)))
(else
@@ -551,12 +558,12 @@
sequence))
(define (remove-if p lst)
- (cond ((null? lst) ())
+ (cond ((not (pair? lst)) lst)
((p (car lst)) (remove-if p (cdr lst)))
(else (cons (car lst)
(remove-if p (cdr lst))))))
- (define (lint-remove-duplicates lst env)
+ (denote (lint-remove-duplicates lst env)
(reverse (let rem-dup ((lst lst)
(nlst ()))
(cond ((null? lst) nlst)
@@ -568,43 +575,50 @@
(define applicable? arity)
- (define every?
- (let ((documentation "(every? func sequence) returns #t if func approves of every member of sequence")
- (signature '(boolean? procedure? sequence?)))
+ (denote lint-every?
+ (let ((documentation "(lint-every? func sequence) returns #t if func approves of every member of the list sequence")
+ (signature '(boolean? procedure? list?)))
(lambda (f sequence)
- (and (sequence? sequence)
- (call-with-exit
- (lambda (return)
- (for-each (lambda (arg) (if (not (f arg)) (return #f))) sequence)))))))
-
- (define any?
- (let ((documentation "(any? func sequence) returns #t if func approves of any member of sequence")
- (signature '(boolean? procedure? sequence?)))
+ (do ((arg sequence (cdr arg)))
+ ((not (and (pair? arg)
+ (f (car arg))))
+ (null? arg))))))
+
+ (denote lint-any?
+ (let ((documentation "(lint-any? func sequence) returns #t if func approves of any member of the list sequence")
+ (signature '(boolean? procedure? list?)))
(lambda (f sequence)
- (and (sequence? sequence)
- (call-with-exit
- (lambda (return)
- (for-each (lambda (arg) (if (f arg) (return #t))) sequence)
- #f))))))
+ (do ((arg sequence (cdr arg)))
+ ((or (not (pair? arg))
+ (f (car arg)))
+ (pair? arg))))))
- (define collect-if
- (let ((documentation "(collect-if type func sequence) gathers the elements of sequence that satisfy func, and returns them via type:\n\
- (collect-if list integer? #(1.4 2/3 1 1+i 2)) -> '(1 2)"))
- (lambda (type f sequence)
- (apply type (map (lambda (arg) (if (f arg) arg (values))) sequence)))))
+ (denote lint-find-if
+ (let ((documentation "(lint-find-if func lst) applies func to each member of the list lst.\n\
+ If func approves of one, find-if returns that member of the sequence")
+ (signature '(#t procedure? list?)))
+ (lambda (f lst)
+ (do ((p lst (cdr p)))
+ ((or (not (pair? p))
+ (f (car p)))
+ (and (pair? p)
+ (car p)))))))
+
+ (define (collect-if f lst)
+ (map (lambda (arg) (if (f arg) arg (values))) lst))
+
+ (define (collect-if-rational lst)
+ (map (lambda (x) (if (rational? x) x (values))) lst))
- (define find-if
- (let ((documentation "(find-if func sequence) applies func to each member of sequence.\n\
- If func approves of one, find-if returns that member of the sequence"))
- (lambda (f sequence)
- (call-with-exit
- (lambda (return)
- (for-each (lambda (arg)
- (if (f arg)
- (return arg)))
- sequence)
- #f)))))
+ (define (collect-if-integer lst)
+ (map (lambda (x) (if (integer? x) x (values))) lst))
+ (define (collect-if-real lst)
+ (map (lambda (x) (if (real? x) x (values))) lst))
+
+ (define (collect-if-not-number lst)
+ (map (lambda (x) (if (number? x) (values) x)) lst))
+
;; -------- trees --------
(define copy-tree
@@ -614,42 +628,11 @@
(cons (copy-tree (car lis))
(copy-tree (cdr lis)))
lis))))
-
- (define (tree-nonce x tree)
- (let ((count 0))
- (let nonce ((t tree))
- (cond ((eq? x t)
- (set! count (+ count 1)))
- ((and (pair? t)
- (< count 2)
- (not (eq? (car t) 'quote)))
- (nonce (car t))
- (nonce (cdr t)))))
- (= count 1)))
-
- (define (tree-count x tree1)
- (let counter ((count 0) (tree tree1))
- (if (eq? x tree)
- (+ count 1)
- (if (or (not (pair? tree))
- (eq? (car tree) 'quote))
- count
- (counter (counter count (car tree)) (cdr tree))))))
-
- (define (tree-count2 x tree1)
- (let counter ((count 0) (tree tree1))
- (if (eq? x tree)
- (+ count 1)
- (if (or (>= count 3)
- (not (pair? tree))
- (eq? (car tree) 'quote))
- count
- (counter (counter count (car tree)) (cdr tree))))))
-
+
(define (proper-tree? tree)
(or (not (pair? tree))
(and (proper-list? tree)
- (every? proper-tree? (cdr tree)))))
+ (lint-every? proper-tree? (cdr tree)))))
(define (shadowed? sym tree1)
(let shadow? ((tree tree1))
@@ -732,7 +715,7 @@
(cdr tree))
#f))))))
- (define (tree-member sym tree1)
+ (define (tree-member sym tree1) ; tree-memq ignoring quote and no match if tree1 == bare sym -- nearly all of these "members" should be "memqs"
(let tm ((tree tree1))
(and (pair? tree)
(or (eq? (car tree) sym)
@@ -746,10 +729,8 @@
(tree-equal-member sym (cdr tree)))))
(define (tree-unquoted-member sym tree)
- (and (unquoted-pair? tree)
- (or (eq? (car tree) sym)
- (tree-unquoted-member sym (car tree))
- (tree-unquoted-member sym (cdr tree)))))
+ (and (pair? tree)
+ (tree-memq sym tree)))
(define (tree-car-member sym tree)
(and (pair? tree)
@@ -769,18 +750,19 @@
(member #f (cdr tree) (lambda (a b) (tree-sym-set-member sym set b))))))))
(define (tree-set-member set tree1)
- (let ts ((tree tree1))
- (and (unquoted-pair? tree)
- (or (memq (car tree) set)
- (ts (car tree))
- (ts (cdr tree))))))
-
- (define (tree-table-member table tree)
- (and (pair? tree)
- (or (hash-table-ref table (car tree))
- (tree-table-member table (car tree))
- (tree-table-member table (cdr tree)))))
-
+ (case (length set)
+ ((0) #f)
+ ((1) (tree-memq (car set) tree1))
+ ((2) (or (tree-memq (car set) tree1)
+ (tree-memq (cadr set) tree1)))
+ (else
+ (let ts ((tree tree1))
+ (if (pair? tree)
+ (and (not (eq? (car tree) 'quote))
+ (or (ts (car tree))
+ (ts (cdr tree))))
+ (memq tree set))))))
+
(define (tree-set-car-member set tree) ; set as car
(and (pair? tree)
(or (and (memq (car tree) set)
@@ -788,8 +770,11 @@
(and (pair? (car tree))
(tree-set-car-member set (car tree)))
(and (pair? (cdr tree))
- (member #f (cdr tree) (lambda (a b) (tree-set-car-member set b)))))))
-
+ (do ((p (cdr tree) (cdr p)))
+ ((or (not (pair? p))
+ (tree-set-car-member set (car p)))
+ (pair? p)))))))
+
(define (tree-table-car-member set tree) ; hash-table as car
(and (pair? tree)
(or (and (hash-table-ref set (car tree))
@@ -797,30 +782,34 @@
(and (pair? (car tree))
(tree-table-car-member set (car tree)))
(and (pair? (cdr tree))
- (member #f (cdr tree) (lambda (a b) (tree-table-car-member set b)))))))
+ (do ((p (cdr tree) (cdr p)))
+ ((or (not (pair? p))
+ (tree-table-car-member set (car p)))
+ (pair? p)))))))
(define (maker? tree)
(tree-table-car-member makers tree))
(define (tree-symbol-walk tree syms)
(if (pair? tree)
- (if (eq? (car tree) 'quote)
- (if (and (pair? (cdr tree))
- (symbol? (cadr tree))
- (not (memq (cadr tree) (car syms))))
- (tree-symbol-walk (cddr tree) (begin (set-car! syms (cons (cadr tree) (car syms))) syms)))
- (if (eq? (car tree) list-values)
- (if (and (pair? (cdr tree))
- (pair? (cadr tree))
- (eq? (caadr tree) 'quote)
- (symbol? (cadadr tree))
- (not (memq (cadadr tree) (cadr syms))))
- (tree-symbol-walk (cddr tree) (begin (list-set! syms 1 (cons (cadadr tree) (cadr syms))) syms)))
- (begin
- (tree-symbol-walk (car tree) syms)
- (tree-symbol-walk (cdr tree) syms))))))
+ (case (car tree)
+ ((quote)
+ (if (and (pair? (cdr tree))
+ (symbol? (cadr tree))
+ (not (memq (cadr tree) (car syms))))
+ (tree-symbol-walk (cddr tree) (begin (set-car! syms (cons (cadr tree) (car syms))) syms))))
+ ((list-values)
+ (if (and (pair? (cdr tree))
+ (pair? (cadr tree))
+ (eq? (caadr tree) 'quote)
+ (symbol? (cadadr tree))
+ (not (memq (cadadr tree) (cadr syms))))
+ (tree-symbol-walk (cddr tree) (begin (list-set! syms 1 (cons (cadadr tree) (cadr syms))) syms))))
+ (else
+ (tree-symbol-walk (car tree) syms)
+ (tree-symbol-walk (cdr tree) syms)))))
- (define (unbegin x)
+ (denote (unbegin x)
((if (and (pair? x)
(list? (cdr x))
(eq? (car x) 'begin))
@@ -830,25 +819,25 @@
;; -------- types --------
- (define (unspecified? x)
+ (denote (unspecified? x)
(eq? x #<unspecified>))
- (define (quoted-pair? x)
+ (denote (quoted-pair? x)
(and (pair? x)
(eq? (car x) 'quote)
(pair? (cdr x))
(pair? (cadr x))))
- (define (quoted-undotted-pair? x)
+ (denote (quoted-undotted-pair? x)
(and (quoted-pair? x)
(positive? (length (cadr x)))))
- (define (quoted-null? x)
+ (denote (quoted-null? x)
(and (len=2? x)
(eq? (car x) 'quote)
(null? (cadr x))))
- (define (any-null? x)
+ (denote (any-null? x)
(or (null? x)
(and (pair? x)
(case (car x)
@@ -860,29 +849,29 @@
;; no hits (in this context): (make-list 0 ...) (string->list "") (vector->list #()) (reverse ()) (copy ()) (append ()) (append)
(else #f)))))
- (define (quoted-not? x)
+ (denote (quoted-not? x)
(and (len=2? x)
(eq? (car x) 'quote)
(not (cadr x))))
- (define (quoted-symbol? x)
- (and (len=2? x)
+ (denote (quoted-symbol? x)
+ (and (pair? x)
(eq? (car x) 'quote)
+ (pair? (cdr x))
(symbol? (cadr x))))
- (define (just-symbols? form)
- (or (null? form)
- (symbol? form)
- (and (pair? form)
- (symbol? (car form))
- (just-symbols? (cdr form)))))
+ (denote (just-symbols? form)
+ (or (symbol? form)
+ (do ((p form (cdr p)))
+ ((not (and (pair? p)
+ (symbol? (car p))))
+ (null? p)))))
- (define (code-constant? x)
- (and (or (not (symbol? x))
- (keyword? x))
+ (denote (code-constant? x)
+ (and (constant? x)
(or (not (pair? x))
(eq? (car x) 'quote))))
-
+
(define constant-expression?
(let ((constant-functions (let ((ht (make-hash-table)))
(for-each
@@ -930,48 +919,25 @@
(and (pair? val)
(hash-table-ref constant-functions (car val))
(not (var-member (car val) env))
- (every? code-constant? (cdr val)))))))
-
- (define (list-any? f lst)
- (if (pair? lst)
- (or (f (car lst))
- (list-any? f (cdr lst)))
- (f lst)))
-
- (define syntax?
- (let ((syns (let ((h (make-hash-table)))
- (for-each (lambda (x)
- (hash-table-set! h x #t))
- (list quote if when unless begin set! let let* letrec letrec* cond and or case do
- lambda lambda* define define* define-macro define-macro* define-bacro define-bacro*
- define-constant with-baffle macroexpand with-let))
- h)))
- (lambda (obj) ; a value, not a symbol
- (hash-table-ref syns obj))))
+ (lint-every? code-constant? (cdr val)))))))
;; -------- func info --------
(define (arg-signature fnc env)
(and (symbol? fnc)
(let ((fd (var-member fnc env)))
- (if (var? fd)
+ (if fd
(and (symbol? (var-ftype fd))
(var-signature fd))
- (or (and (eq? *e* *lint*)
- (procedure-signature fnc))
- (let ((f (symbol->value fnc *e*)))
- (and (procedure? f)
- (procedure-signature f))))))))
+ (procedure-signature fnc)))))
(define (arg-arity fnc env)
(and (symbol? fnc)
- (let ((fd (var-member fnc env)))
- (if (var? fd)
- (and (not (eq? (var-decl fd) 'error))
- (arity (var-decl fd)))
- (let ((f (symbol->value fnc *e*)))
- (and (procedure? f)
- (arity f)))))))
+ (cond ((var-member fnc env) => var-arity)
+ (else
+ (let ((f (symbol->value fnc (rootlet))))
+ (and (procedure? f)
+ (arity f)))))))
(define (dummy-func caller form f)
(catch #t
@@ -987,7 +953,7 @@
(mx #f))
(if (pair? body)
(let counter ((ignored #f) ; 'ignored is for member's benefit
- (tree (list-ref body (- (length body) 1))))
+ (tree (last-ref body)))
(if (pair? tree)
(if (eq? (car tree) 'values)
(if (pair? (cdr tree))
@@ -1016,7 +982,7 @@
(let ((body (and (memq ftype '(define define* lambda lambda* let))
(cddr initial-value))))
(and (pair? body)
- (let ((sig (let signer ((endb (list-ref body (- (length body) 1))))
+ (let ((sig (let signer ((endb (last-ref body)))
(and (not (side-effect? endb env))
(cond ((not (pair? endb))
(and (not (symbol? endb))
@@ -1047,20 +1013,20 @@
(and (> len 2)
(pair? (caddr endb))
(pair? (cdaddr endb)) ; if nil -> unspecified?
- (signer (last-par (cdaddr endb)))))
+ (signer (last-ref (cdaddr endb)))))
(else #f)))))))))
(if (not (pair? sig))
(set! sig (list #t)))
(when (and (proper-list? arglist)
- (not (any? keyword? arglist)))
+ (not (lint-any? keyword? arglist)))
(for-each
(lambda (arg) ; new function's parameter
(set! sig (cons #t sig))
;; (if (pair? arg) (set! arg (car arg)))
- ;; causes trouble when tree-nonce sees keyword args in s7test.scm
- (if (tree-nonce arg body)
+ ;; causes trouble when tree-count sees keyword args in s7test.scm
+ (if (= (tree-count arg body 2) 1)
(let ((p (tree-arg-member arg body)))
(when (pair? p)
(let ((f (car p))
@@ -1076,7 +1042,7 @@
(not (memq chk '(integer:any? integer:real?))))
(set-car! sig chk)))))))))))
arglist))
- (and (any? (lambda (a) (not (eq? a #t))) sig)
+ (and (lint-any? (lambda (a) (not (eq? a #t))) sig)
(reverse sig)))))))
(define (args->proper-list args)
@@ -1216,16 +1182,10 @@
(let ((fv (copy v)))
(let-set! (cdr fv) 'side-effect #f)
(set! env (cons fv env))))
- (any? (lambda (f)
- (side-effect-with-vars? f env outvars))
- body))))))
+ (lint-any? (lambda (f)
+ (side-effect-with-vars? f env outvars))
+ body))))))
- (define (last-par x)
- (let ((len (length x)))
- (and (integer? len)
- (positive? len)
- (x (- len 1)))))
-
(define (tree-subst new old tree)
(cond ((equal? old tree)
new)
@@ -1265,7 +1225,7 @@
(if (and (len=1? (cddr new-form))
(len=2? (caddr new-form))
(eq? '_1_ (cadr (caddr new-form))))
- (set! new-form (car (caddr new-form))))
+ (set! new-form (caaddr new-form)))
(lint-format "perhaps ~A" name
(lists->string outer-form
(if (eq? (car outer-form) 'let) ; named-let, not define
@@ -1279,63 +1239,76 @@
(when (and (pair? initial-value)
(proper-pair? arglist)
- (= (tree-count name (cddr initial-value)) 1))
+ (= (tree-count name (cddr initial-value) 2) 1))
(let ((body ((if (memq ftype '(let let*)) cdddr cddr) initial-value))
(for-each-case #f)) ; avoid rewriting twice
(when (and (len=1? body)
(len>1? (car body))
- (case (caar body) ; change body to use if
- ((if)
- #t) ; only 1 hit for 2 reversal branches, say 20 hits for 2 ifs + repeated return vals (collapsible) -- see tmp
- ((when)
- (and (pair? (cddar body))
- (set! body `((if ,(cadar body)
- ,@(if (null? (cdddar body))
- (cddar body)
- (list (cons 'begin (cddar body)))))))))
- ((unless)
- (set! body `((if (not ,(cadar body))
- ,@(if (null? (cdddar body))
- (cddar body)
- (list (cons 'begin (cddar body))))))))
- ((cond)
- (and (<= 2 (length (car body)) 3)
- (not (tree-memq '=> (car body)))
- (or (null? (cddar body))
- (and (pair? (caddar body))
- (memq (car (caddar body)) '(else #t))))
- (let ((arg1 (cadar body)))
- (set! body `((if ,(car arg1)
- ,@(if (null? (cdr arg1)) '(#t)
- (if (null? (cddr arg1)) (cdr arg1)
- (list (cons 'begin (cdr arg1)))))
- ,@(if (not (= (length (car body)) 3))
- ()
- (let ((arg2 (cdr (caddar body))))
- (if (null? (cdr arg2))
- arg2
- `((begin , at arg2)))))))))))
- ((case)
- (and (<= 3 (length (car body)) 4)
- (not (tree-memq '=> (car body)))
- (let ((selector (cadar body))
- (arg1 (caddar body))
- (rest (cdddar body)))
- (and (or (null? rest)
- (and (pair? (car rest))
- (eq? 'else (caar rest))))
- (set! body `((if (memv ,selector ',(car arg1))
- ,@(if (null? (cddr arg1)) (cdr arg1)
- (list (cons 'begin (cdr arg1))))
- ,@(if (not (pair? rest))
- ()
- (let ((arg2 (cdar rest)))
- (if (null? (cdr arg2))
- arg2
- `((begin , at arg2))))))))))))
- (else #f)))
+ (let ((exprs (cdar body)))
+ (case (caar body) ; change body to use if
+ ((if) ; only 1 hit for 2 reversal branches, say 20 hits for 2 ifs + repeated return vals (collapsible) -- see tmp
+ (len>1? exprs))
+ ((when)
+ (and (len>1? exprs)
+ (set! body `((if ,(car exprs)
+ ,@(if (null? (cddr exprs))
+ (cdr exprs)
+ (list (cons 'begin (cdr exprs)))))))))
+ ((unless)
+ (and (len>1? exprs)
+ (set! body `((if (not ,(car exprs))
+ ,@(if (null? (cddr exprs))
+ (cdr exprs)
+ (list (cons 'begin (cdr exprs)))))))))
+ ((cond)
+ (and (<= 1 (length exprs) 2)
+ (not (tree-memq '=> exprs))
+ (or (null? (cdr exprs))
+ (and (pair? (cadr exprs))
+ (memq (caadr exprs) '(else #t))))
+ (let ((arg1 (car exprs)))
+ (and (proper-list? arg1)
+ (set! body `((if ,(car arg1)
+ ,@(if (null? (cdr arg1)) '(#t)
+ (if (null? (cddr arg1)) (cdr arg1)
+ (list (cons 'begin (cdr arg1)))))
+ ,@(if (not (= (length exprs) 2))
+ ()
+ (let ((arg2 (cdadr exprs)))
+ (if (null? (cdr arg2))
+ arg2
+ `((begin , at arg2))))))))))))
+ ((case)
+ (and (<= 2 (length exprs) 3)
+ (not (tree-memq '=> exprs))
+ (let ((selector (car exprs))
+ (arg1 (cadr exprs))
+ (rest (cddr exprs)))
+ (and (or (null? rest)
+ (and (pair? (car rest))
+ (eq? 'else (caar rest))))
+ (set! body `((if (memv ,selector ',(car arg1))
+ ,@(if (null? (cddr arg1)) (cdr arg1)
+ (list (cons 'begin (cdr arg1))))
+ ,@(if (not (pair? rest))
+ ()
+ (let ((arg2 (cdar rest)))
+ (if (null? (cdr arg2))
+ arg2
+ `((begin , at arg2))))))))))))
+ (else
+
+ ;; zillions of or/and (well, 200) -- the problem is the result, and do is not shorter
+ ;; (if (and (memq (caar body) '(or and)) (pair? (cadar body)) (memq (caadar body) '(= < > <= >=)) (format *stderr* "~A~%~%" (lint-pp body)))
+ ;; (or (>= i len) (and (x i) (rec (+ i 1))))
+ ;; (do ((i 0 (+ i 1))) ((or (>= i len) (not (x i))) (>= i len)))
+ ;; (and (< i len) (or (x i) (rec (+ i 1))))
+ ;; (do ((i 0 (+ i 1))) ((or (= i len) (x i)) (< i len)))
+ ;; memx here might be shorter if var is a list
+
+ #f))))
;; (caar body) is 'if
@@ -1354,7 +1327,7 @@
(when (and (len=2? res)
(any-null? (cadr res))
- (<= 2 (tree-count (car res) body) 3))
+ (<= 2 (tree-count (car res) body 4) 3))
(let ((nf (cdar body))) ;((null? lst) (reverse...) (loop ...))
(when (and (len>2? nf)
@@ -1384,7 +1357,7 @@
(or (and (eq? name (car cdrf))
(set! recur cdrf))
(and (memq (car cdrf) '(begin let let*))
- (let ((ret (last-par cdrf)))
+ (let ((ret (last-ref cdrf)))
(and (pair? ret)
(eq? name (car ret))
(set! recur ret))))) ; recur is the looper
@@ -1484,12 +1457,12 @@
(and (len=1? (cadr cdrf))
(len=1? (cddr cdrf))
(len=3? (caddr cdrf))
- (eq? (car (caddr cdrf)) 'cons)
- (len>1? (cdr (caddr cdrf)))
+ (eq? (caaddr cdrf) 'cons)
+ (len>1? (cdaddr cdrf))
(equal? (cadr (caadr cdrf)) (list 'car iter))
(equal? (caddr (caddr cdrf)) (list name (list 'cdr iter)))
(set! cdrf (list 'cons
- (tree-subst (list 'car iter) (car (caadr cdrf)) (cadr (caddr cdrf)))
+ (tree-subst (list 'car iter) (caaadr cdrf) (cadr (caddr cdrf)))
(caddr (caddr cdrf))))))
(else #f)))
@@ -1502,18 +1475,18 @@
(when (and (null? (cddr nf))
(let ((lst (cadr nf))
(find-iter (lambda (args)
- (any? (lambda (p)
- (and (pair? p)
- (eq? (car p) 'cdr)
- (let ((sym (cadr p)))
- (and (symbol? sym)
- (set! iters (cons sym iters))))))
- args))))
+ (lint-any? (lambda (p)
+ (and (pair? p)
+ (eq? (car p) 'cdr)
+ (let ((sym (cadr p)))
+ (and (symbol? sym)
+ (set! iters (cons sym iters))))))
+ args))))
(and (pair? lst)
(or (and (eq? name (car lst))
(find-iter (cdr lst)))
(and (memq (car lst) '(begin when unless let let*))
- (let ((ret (last-par lst)))
+ (let ((ret (last-ref lst)))
(and (pair? ret)
(eq? name (car ret))
(find-iter (cdr ret))))))))
@@ -1554,7 +1527,7 @@
(let ((call (if (eq? (car do-body) name)
do-body
(and (eq? (car do-body) 'begin)
- (let ((lp (last-par do-body)))
+ (let ((lp (last-ref do-body)))
(and (pair? lp)
(eq? (car lp) name)
lp))))))
@@ -1569,7 +1542,7 @@
(and (pair? args)
(let ((par ((if (pair? (car pars)) caar car) pars)))
(and (not (memq (car args) (remove par arglist)))
- (not (tree-set-member (remove par arglist) (car args)))
+ (not (tree-set-memq (remove par arglist) (car args)))
(check-iters (cdr pars) (cdr args)))))))))
(let ((do-loop `(do ,(map (lambda (par init arg)
(let ((var (if (pair? par) (car par) par)))
@@ -1613,7 +1586,7 @@
(let* ((rest-name (if (symbol? arglist)
arglist
(list-tail arglist (abs (length arglist)))))
- (rest-refs (tree-count rest-name body)))
+ (rest-refs (tree-count rest-name body 3)))
(when (= rest-refs 2) ; more refs for added optargs got few hits (and they were riddled with mistakes)
(let ((var1 (caadr body))
@@ -1660,40 +1633,87 @@
(list 'lambda* new-arglist
new-body)))))))))))))))))
-
- (define* (make-fvar name ftype arglist decl initial-value env)
+ (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)
+ (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))))))))
+
+ (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))
(improper-arglist->define* name ftype arglist initial-value)
-
- (let ((new (let ((old (hash-table-ref other-identifiers name)))
- (cons name
- (inlet 'signature ()
- 'side-effect ()
- 'allow-other-keys (and (pair? arglist)
- (memq ftype '(define* define-macro* define-bacro* defmacro*))
- (eq? (last-par arglist) :allow-other-keys))
- 'scope ()
- 'refenv ()
- 'setters ()
- 'env env
- 'initial-value initial-value
- 'values (and (pair? initial-value)
- (tree-memq 'values initial-value)
- (count-values (cddr initial-value)))
- 'leaves #f
- 'match-list #f
- 'decl decl
- 'arglist arglist
- 'ftype ftype
- 'retcons #f
- '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) ()))
- 'set 0
- 'ref (if old (length old) 0))))))
+
+ (when *report-shadowed-variables*
+ (for-each (lambda (v)
+ (report-shadower ftype name 'parameter v arglist env))
+ (args->proper-list arglist)))
+
+ (let ((new (let ((old (hash-table-ref other-identifiers name))
+ (allow-keys (and (pair? arglist)
+ (memq ftype '(define* define-macro* define-bacro* defmacro*))
+ (eq? (last-ref arglist) :allow-other-keys)))
+ (nv (and (pair? initial-value)
+ (tree-memq 'values initial-value)
+ (count-values (cddr initial-value)))))
+ (let ((hist (if old
+ (begin
+ (hash-table-set! other-identifiers name #f)
+ (if initial-value (cons initial-value old) old))
+ (if initial-value (list initial-value) ())))
+ (rf (if old (length old) 0))
+ (ar (form->arity initial-value)))
+ (cons name
+ (inlet 'allow-other-keys allow-keys
+ 'scope ()
+ 'refenv ()
+ 'setters ()
+ 'env env
+ 'nvalues nv
+ 'leaves #f
+ 'match-list #f
+ 'retcons #f
+ 'arit ar
+ 'arglist arglist
+ 'history hist
+ 'signature ()
+ 'side-effect ()
+ 'ftype ftype
+ 'initial-value initial-value
+ 'set 0
+ 'ref rf))))))
(reduce-function-tree new env)
new))
@@ -1714,14 +1734,14 @@
(lambda (f env)
(or (hash-table-ref macros f)
(let ((fd (var-member f env)))
- (and (var? fd)
+ (and fd
(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 (var? v)
+ (and v
(memq (var-ftype v) '(define define* lambda lambda*))))))
(define ->simple-type
@@ -1730,38 +1750,17 @@
(cons :dilambda 'dilambda?)
(cons :lambda 'procedure?))))
(lambda (c)
- (cond ((pair? c) 'pair?)
- ((integer? c) 'integer?)
- ((rational? c) 'rational?)
- ((real? c) 'real?)
- ((number? c) 'number?)
- ((byte-vector? c) 'byte-vector?)
- ((string? c) 'string?)
- ((null? c) 'null?)
- ((char? c) 'char?)
- ((boolean? c) 'boolean?)
- ((keyword? c)
+ (case (type-of c)
+ ((symbol?)
+ (if (keyword? c)
(cond ((assq c markers) => cdr)
- (else 'keyword?)))
- ((float-vector? c) 'float-vector?)
- ((int-vector? c) 'int-vector?)
- ((vector? c) 'vector?)
- ((let? c) 'let?)
- ((hash-table? c) 'hash-table?)
- ((input-port? c) 'input-port?)
- ((output-port? c) 'output-port?)
- ((iterator? c) 'iterator?)
- ((continuation? c) 'continuation?)
- ((dilambda? c) 'dilambda?)
- ((procedure? c) 'procedure?)
- ((macro? c) 'macro?)
- ((random-state? c) 'random-state?)
- ((c-pointer? c) 'c-pointer?)
- ((c-object? c) 'c-object?)
- ((eof-object? c) 'eof-object?)
- ((syntax? c) 'syntax?)
- ((assq c '((#<unspecified> . unspecified?) (#<undefined> . undefined?))) => cdr)
- (#t #t)))))
+ (else 'keyword?))
+ #t))
+ ((string?)
+ (if (byte-vector? c) 'byte-vector? 'string?))
+ ((procedure?)
+ (if (dilambda? c) 'dilambda? 'procedure?))
+ (else)))))
(define (define->type c)
(and (pair? c)
@@ -1880,13 +1879,13 @@
(string-append (prettify-checker-unq (car op)) " or " (prettify-checker-unq (cadr op)))
(case op
((rational?) "rational")
- ((real?) "real")
- ((complex?) "complex")
- ((null?) "null")
- ((length) "a sequence")
+ ((real?) "real")
+ ((complex?) "complex")
+ ((null?) "null")
+ ((length) "a sequence")
((unspecified?) "untyped")
((undefined?) "not defined")
- (else
+ (else
(let ((op-name (symbol->string op)))
(string-append (if (memv (op-name 0) '(#\a #\e #\i #\o #\u)) "an " "a ")
(substring op-name 0 (- (length op-name) 1))))))))
@@ -1894,12 +1893,16 @@
(define (prettify-checker op)
(if (pair? op)
(string-append (prettify-checker-unq (car op)) " or " (prettify-checker (cadr op)))
- (let ((op-name (symbol->string op)))
- (case op
- ((rational? real? complex? null?) op-name)
- ((unspecified?) "untyped")
- ((undefined?) "not defined")
- (else (string-append (if (memv (op-name 0) '(#\a #\e #\i #\o #\u)) "an " "a ") op-name))))))
+ (case op
+ ((rational?) "rational?")
+ ((real?) "real?")
+ ((complex?) "complex?")
+ ((null?) "null?")
+ ((unspecified?) "untyped")
+ ((undefined?) "not defined")
+ (else
+ (let ((op-name (symbol->string op)))
+ (string-append (if (memv (op-name 0) '(#\a #\e #\i #\o #\u)) "an " "a ") op-name))))))
(define (side-effect-with-vars? form env vars)
;; could evaluation of form have any side effects (like IO etc)
@@ -1912,7 +1915,7 @@
(and (symbol? form)
(or (eq? form '=>) ; (cond ((x => y))...) -- someday check y...
(let ((e (var-member form env)))
- (if (var? e)
+ (if e
(and (symbol? (var-ftype e))
(var-side-effect e))
(and (not (hash-table-ref no-side-effect-functions form))
@@ -1923,7 +1926,7 @@
;; if it's not in the no-side-effect table and ...
(let ((e (var-member (car form) env)))
- (or (not (var? e))
+ (or (not e)
(not (symbol? (var-ftype e)))
(var-side-effect e)))
@@ -1955,7 +1958,7 @@
(let case-effect? ((f (cddr form)))
(and (pair? f)
(or (not (pair? (car f)))
- (any? (lambda (ff) (side-effect-with-vars? ff env vars)) (cdar f))
+ (lint-any? (lambda (ff) (side-effect-with-vars? ff env vars)) (cdar f))
(case-effect? (cdr f)))))))
((cond)
@@ -1965,7 +1968,7 @@
(e env))
(and (pair? f)
(or (and (pair? (car f))
- (any? (lambda (ff) (side-effect-with-vars? ff e vars)) (car f)))
+ (lint-any? (lambda (ff) (side-effect-with-vars? ff e vars)) (car f)))
(cond-effect? (cdr f) e))))))
((let let* letrec letrec*)
@@ -1985,7 +1988,7 @@
(pair? syms))
(for-each (lambda (sym)
(when (and (len>1? sym)
- (tree-set-member vars (cdr sym)))
+ (tree-set-memq vars (cdr sym)))
(set! vars (cons (car sym) vars))))
syms))
(or (let let-effect? ((f syms))
@@ -1994,9 +1997,9 @@
(not (pair? (cdar f))) ; an error, reported elsewhere: (let ((x)) x)
(side-effect-with-vars? (cadar f) e vars)
(let-effect? (cdr f)))))
- (any? (lambda (ff)
- (side-effect-with-vars? ff e vars))
- body)))))
+ (lint-any? (lambda (ff)
+ (side-effect-with-vars? ff e vars))
+ body)))))
((do)
(or (< (length form) 3)
@@ -2010,15 +2013,15 @@
(and (pair? (cddar f))
(side-effect-with-vars? (caddar f) e vars))
(do-effect? (cdr f) e))))
- (any? (lambda (ff) (side-effect-with-vars? ff env vars)) (caddr form))
- (any? (lambda (ff) (side-effect-with-vars? ff env vars)) (cdddr form))))
+ (lint-any? (lambda (ff) (side-effect-with-vars? ff env vars)) (caddr form))
+ (lint-any? (lambda (ff) (side-effect-with-vars? ff env vars)) (cdddr form))))
- ;; ((lambda lambda*) (any? (lambda (ff) (side-effect-with-vars? ff env vars)) (cddr form))) ; this is trickier than it looks
+ ;; ((lambda lambda*) (lint-any? (lambda (ff) (side-effect-with-vars? ff env vars)) (cddr form))) ; this is trickier than it looks
(else
- (or (any? (lambda (f) ; any subform has a side-effect
- (and (not (null? f))
- (side-effect-with-vars? f env vars)))
+ (or (lint-any? (lambda (f) ; any subform has a side-effect
+ (and (not (null? f))
+ (side-effect-with-vars? f env vars)))
(cdr form))
(let ((sig (procedure-signature (car form)))) ; sig has func arg and it is not known safe
(and (pair? sig)
@@ -2045,8 +2048,8 @@
(and (symbol? (car form))
(hash-table-ref no-side-effect-functions (car form))
(hash-table-ref built-in-functions (car form)) ; and not hook-functions
- (not (var-member (car form) env)) ; e.g. exp declared locally as a list
- (every? (lambda (p) (just-constants? p env)) (cdr form)))))
+ (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)
@@ -2062,7 +2065,7 @@
(assq caller (var-scope v)))
(let ((cv (var-member caller env)))
(set! (var-scope v)
- (cons (if (and (var? cv)
+ (cons (if (and cv
(memq (var-ftype cv) '(define lambda define* lambda*))) ; named-let does not define ftype
caller
(cons caller env))
@@ -2084,27 +2087,28 @@
(set! (symbol-access '*report-bad-variable-names*) ; update these local variables if the global variable changes
(lambda (sym val)
- (when (every? symbol? val)
+ (when (lint-every? symbol? val)
(initialize-bad-var-names val))
val))
(lambda (caller vname)
(when (symbol? vname)
(let* ((sname (symbol->string (if (keyword? vname) (keyword->symbol vname) vname)))
- (slen (length sname)))
+ (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 (sname 0) bad-var-names) =>
+ (if (or (cond ((assq s0 bad-var-names) =>
(lambda (baddies)
(or (assq vname (cdr baddies))
- (any? (lambda (b)
- (and (eqv? (string-position (cadr b) sname) 0)
- (string->number (substring sname (caddr b)))))
- (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=? (sname 0) #\c)
+ (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*
@@ -2113,14 +2117,34 @@
(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)))))))))
+ (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)))))))))))))
(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 (var? data)
+ (if data
(begin
(set! (var-ref data) (+ (var-ref data) 1))
(update-scope data caller env)
@@ -2137,7 +2161,7 @@
(define (set-set name caller form env)
(let ((data (var-member name env)))
- (when (var? data)
+ (when data
(set! (var-set data) (+ (var-set data) 1))
(update-scope data caller env)
(if (not (memq caller (var-setters data)))
@@ -2187,7 +2211,7 @@
(define (->eqf x)
(case x
((char?) '(eqv? char=?))
- ((integer? rational? real? number? complex?) '(eqv? =))
+ ((integer? rational? real? number? complex? float?) '(eqv? =))
((symbol? keyword? boolean? null? procedure? syntax? macro? undefined? unspecified?) '(eq? eq?))
((string? byte-vector?) '(equal? string=?))
((pair? vector? float-vector? int-vector? hash-table?) '(equal? equal?))
@@ -2235,7 +2259,7 @@
(else '(#t #t))))
(define (unquoted x)
- (if (and (pair? x)
+ (if (and (len=2? x)
(eq? (car x) 'quote))
(cadr x)
x))
@@ -2261,7 +2285,7 @@
(string-append "... " (substring str (- pos 20) (min (- len 1) (+ focus-len pos 20))) " ...")))))))
(define (check-star-parameters f args env)
- (if (list-any? (lambda (k) (memq k '(:key :optional))) args)
+ (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)))))
@@ -2278,9 +2302,12 @@
(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)))
- (if (len>1? 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"))))
+ (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)
@@ -2315,7 +2342,7 @@
(unless (memq (car arg2) '(and or not list cons vector)) ; these don't tell us anything about arg1's type
(let ((v (var-member arg1 env))) ; try to avoid the member->cdr trope
(unless (or (eq? arg2 last-and-incomplete-arg2)
- (and (var? v)
+ (and v
(pair? (var-history v))
(member #f (var-history v)
(lambda (a b)
@@ -2328,13 +2355,14 @@
i)))
(arg-type (let ((sig (and (positive? pos) ; procedure-signature for arg2
(arg-signature (car arg2) env))))
- (if (zero? pos) ; it's type indication for arg1's position
+ (if (zero? pos) ; its type indication for arg1's position
'procedure? ; or sequence? -- how to distinguish? use 'applicable?
(and (pair? sig)
(< pos (length sig))
(list-ref sig pos))))))
(set! last-and-incomplete-arg2 arg2) ; ignore unwanted repetitions due to recursive simplifications
- (if (symbol? arg-type)
+ (if (and (symbol? arg-type)
+ (not (eq? arg-type 'unused-parameter?)))
(let ((ln (and (< 0 line-number 100000) line-number))
(comment (if (and (eq? arg-type 'procedure?)
(= pos 0)
@@ -2657,18 +2685,18 @@
(typer c2))
(cond ((or (eq? op1 op2)
(eq? op2 (cadr (assq op1 relops))))
- (return (if ((symbol->value op1) c1 c2)
+ (return (if ((symbol->value op1 (rootlet)) c1 c2)
(list op1 x c1)
(list op2 x c2))))
((eq? op1 (caddr (assq op2 relops)))
- (if ((symbol->value op1) c2 c1)
+ (if ((symbol->value op1 (rootlet)) c2 c1)
(return (list op1 c2 x c1))
(if (memq op1 gts)
(return #f))))
((and (eq? op2 (hash-table-ref reversibles (cadr (assq op1 relops))))
- ((symbol->value op1) c1 c2))
+ ((symbol->value op1 (rootlet)) c1 c2))
(return #f))))
((eq? op2 (caddr (assq op1 relops)))
@@ -2692,17 +2720,17 @@
(typer c2))
(cond ((or (eq? op1 op2)
(eq? op2 (cadr (assq op1 relops))))
- (return (if ((symbol->value op1) c1 c2)
+ (return (if ((symbol->value op1 (rootlet)) c1 c2)
(list op2 x c2)
(list op1 x c1))))
((eq? op1 (caddr (assq op2 relops)))
- (if ((symbol->value op1) c2 c1)
+ (if ((symbol->value op1 (rootlet)) c2 c1)
(return #t))
(return (list 'not (list (cadr (assq op1 relops)) c1 x c2))))
((and (eq? op2 (hash-table-ref reversibles (cadr (assq op1 relops))))
- ((symbol->value op1) c2 c1))
+ ((symbol->value op1 (rootlet)) c2 c1))
(return #t))))
((eq? op2 (caddr (assq op1 relops)))
@@ -2750,7 +2778,7 @@
(and (null? p)
(pair? locals)
(or diffs
- (any? (lambda (a) (pair? (cddr a))) locals))
+ (lint-any? (lambda (a) (pair? (cddr a))) locals))
(let ((keepers ()))
(for-each (lambda (a)
(let ((next-a (cdr a)))
@@ -3080,164 +3108,158 @@
;; -------- or->memx --------
(define (or->memx return form env)
- (let ((sym #f)
- (eqfnc #f)
- (vals ())
- (start #f))
-
- (define collect-vals
- (let ()
- (define (constant-arg p)
- (if (code-constant? (cadr p))
- (set! vals (cons (cadr p) vals))
- (and (code-constant? (caddr p))
- (set! vals (cons (caddr p) vals)))))
-
- (define (upgrade-eqf)
- (set! eqfnc (case eqfnc
- ((string=? string-ci=? = equal?) 'equal?)
- ((#f eq?) 'eq?)
- (else 'eqv?))))
-
- (lambda (p)
- ;; = can't share: (equal? 1 1.0) -> #f, so (or (not x) (= x 1)) can't be simplified
- ;; except via member+morally-equal? but that brings in float-epsilon and NaN differences.
- ;; We could add both: 1 1.0 as in cond?
- ;;
- ;; another problem: using memx below means the returned value of the expression
- ;; may not match the original (#t -> '(...)), so perhaps we should add a one-time
- ;; warning about this, and wrap it in (pair? (mem...)) as an example.
- ;;
- ;; and another thing... the original might be broken: (eq? x #(1)) where equal?
- ;; is more sensible, but that also changes the behavior of the expression:
- ;; (memq x '(#(1))) may be #f (or #t!) when (member x '(#(1))) is '(#(1)).
- ;;
- ;; I think I'll try to turn out a more-or-less working expression, but warn about it.
+ (do ((sym #f)
+ (eqfnc #f)
+ (vals ())
+ (start #f)
+ (fp (cdr form) (cdr fp)))
+ ((null? fp))
+ (let ((p (car fp)))
+ (if (and (pair? p)
+ (if (not sym)
+ (set! sym (eqv-selector p))
+ (equal? sym (eqv-selector p)))
+ (or (not (memq eqfnc '(char-ci=? string-ci=? =)))
+ (memq (car p) '(char-ci=? string-ci=? =)))
+
+ ;; = can't share: (equal? 1 1.0) -> #f, so (or (not x) (= x 1)) can't be simplified
+ ;; except via member+morally-equal? but that brings in float-epsilon and NaN differences.
+ ;; We could add both: 1 1.0 as in cond?
+ ;;
+ ;; another problem: using memx below means the returned value of the expression
+ ;; may not match the original (#t -> '(...)), so perhaps we should add a one-time
+ ;; warning about this, and wrap it in (pair? (mem...)) as an example.
+ ;;
+ ;; and another thing... the original might be broken: (eq? x #(1)) where equal?
+ ;; is more sensible, but that also changes the behavior of the expression:
+ ;; (memq x '(#(1))) may be #f (or #t!) when (member x '(#(1))) is '(#(1)).
+ ;;
+ ;; I think I'll try to turn out a more-or-less working expression, but warn about it.
+
+ (case (car p)
+ ((string=? equal?)
+ (set! eqfnc (if (or (not eqfnc)
+ (eq? eqfnc (car p)))
+ (car p)
+ 'equal?))
+ (and (= (length p) 3)
+ (if (code-constant? (cadr p))
+ (set! vals (cons (cadr p) vals))
+ (and (code-constant? (caddr p))
+ (set! vals (cons (caddr p) vals))))))
+ ((char=?)
+ (if (memq eqfnc '(#f char=?))
+ (set! eqfnc 'char=?)
+ (if (not (eq? eqfnc 'equal?))
+ (set! eqfnc 'eqv?)))
+ (and (= (length p) 3)
+ (if (code-constant? (cadr p))
+ (set! vals (cons (cadr p) vals))
+ (and (code-constant? (caddr p))
+ (set! vals (cons (caddr p) vals))))))
+
+ ((eq? eqv?)
+ (let ((leqf (car (->eqf (->lint-type ((if (code-constant? (cadr p)) cadr caddr) p))))))
+ (cond ((not eqfnc)
+ (set! eqfnc leqf))
+
+ ((or (memq leqf '(#t equal?))
+ (not (eq? eqfnc leqf)))
+ (set! eqfnc 'equal?))
+
+ ((memq eqfnc '(#f eq?))
+ (set! eqfnc leqf))))
+ (and (= (length p) 3)
+ (if (code-constant? (cadr p))
+ (set! vals (cons (cadr p) vals))
+ (and (code-constant? (caddr p))
+ (set! vals (cons (caddr p) vals))))))
+
+ ((char-ci=? string-ci=? =)
+ (and (or (not eqfnc)
+ (eq? eqfnc (car p)))
+ (set! eqfnc (car p))
+ (= (length p) 3)
+ (if (code-constant? (cadr p))
+ (set! vals (cons (cadr p) vals))
+ (and (code-constant? (caddr p))
+ (set! vals (cons (caddr p) vals))))))
+
+ ((eof-object?)
+ (set! eqfnc (case eqfnc ((string=? string-ci=? = equal?) 'equal?) ((#f eq?) 'eq?) (else 'eqv?)))
+ (set! vals (cons #<eof> vals)))
+
+ ((not)
+ (set! eqfnc (case eqfnc ((string=? string-ci=? = equal?) 'equal?) ((#f eq?) 'eq?) (else 'eqv?)))
+ (set! vals (cons #f vals)))
+
+ ((boolean?)
+ (set! eqfnc (case eqfnc ((string=? string-ci=? = equal?) 'equal?) ((#f eq?) 'eq?) (else 'eqv?)))
+ (set! vals (cons #f (cons #t vals))))
+
+ ((zero?)
+ (if (memq eqfnc '(#f eq?)) (set! eqfnc 'eqv?))
+ (set! vals (cons 0 (cons 0.0 vals))))
+
+ ((null?)
+ (set! eqfnc (case eqfnc ((string=? string-ci=? = equal?) 'equal?) ((#f eq?) 'eq?) (else 'eqv?)))
+ (set! vals (cons () vals)))
+
+ ((memq memv member)
+ (cond ((eq? (car p) 'member)
+ (set! eqfnc 'equal?))
+
+ ((eq? (car p) 'memv)
+ (set! eqfnc (if (eq? eqfnc 'string=?) 'equal? 'eqv?)))
+
+ ((not eqfnc)
+ (set! eqfnc 'eq?)))
+ (and (= (length p) 3)
+ (quoted-pair? (caddr p))
+ (proper-list? (cadr (caddr p)))
+ (set! vals (append (cadr (caddr p)) vals))))
+
+ (else #f)))
- (case (car p)
- ((string=? equal?)
- (set! eqfnc (if (or (not eqfnc)
- (eq? eqfnc (car p)))
- (car p)
- 'equal?))
- (and (= (length p) 3)
- (constant-arg p)))
-
- ((char=?)
- (if (memq eqfnc '(#f char=?))
- (set! eqfnc 'char=?)
- (if (not (eq? eqfnc 'equal?))
- (set! eqfnc 'eqv?)))
- (and (= (length p) 3)
- (constant-arg p)))
-
- ((eq? eqv?)
- (let ((leqf (car (->eqf (->lint-type ((if (code-constant? (cadr p)) cadr caddr) p))))))
- (cond ((not eqfnc)
- (set! eqfnc leqf))
-
- ((or (memq leqf '(#t equal?))
- (not (eq? eqfnc leqf)))
- (set! eqfnc 'equal?))
-
- ((memq eqfnc '(#f eq?))
- (set! eqfnc leqf))))
- (and (= (length p) 3)
- (constant-arg p)))
-
- ((char-ci=? string-ci=? =)
- (and (or (not eqfnc)
- (eq? eqfnc (car p)))
- (set! eqfnc (car p))
- (= (length p) 3)
- (constant-arg p)))
-
- ((eof-object?)
- (upgrade-eqf)
- (set! vals (cons #<eof> vals)))
-
- ((not)
- (upgrade-eqf)
- (set! vals (cons #f vals)))
-
- ((boolean?)
- (upgrade-eqf)
- (set! vals (cons #f (cons #t vals))))
-
- ((zero?)
- (if (memq eqfnc '(#f eq?)) (set! eqfnc 'eqv?))
- (set! vals (cons 0 (cons 0.0 vals))))
-
- ((null?)
- (upgrade-eqf)
- (set! vals (cons () vals)))
-
- ((memq memv member)
- (cond ((eq? (car p) 'member)
- (set! eqfnc 'equal?))
-
- ((eq? (car p) 'memv)
- (set! eqfnc (if (eq? eqfnc 'string=?) 'equal? 'eqv?)))
-
- ((not eqfnc)
- (set! eqfnc 'eq?)))
- (and (= (length p) 3)
- (quoted-pair? (caddr p))
- (proper-list? (cadr (caddr p)))
- (set! vals (append (cadr (caddr p)) vals))))
-
- (else #f)))))
-
- (do ((fp (cdr form) (cdr fp)))
- ((null? fp))
- (let ((p (car fp)))
- (if (and (pair? p)
- (if (not sym)
- (set! sym (eqv-selector p))
- (equal? sym (eqv-selector p)))
- (or (not (memq eqfnc '(char-ci=? string-ci=? =)))
- (memq (car p) '(char-ci=? string-ci=? =)))
- (collect-vals p))
-
- (if (not start)
- (set! start fp) ; we're in a loop above...
- (if (and (proper-list? form)
- (len=1? fp))
- (return (if (eq? start (cdr form))
- (gather-or-eqf-elements eqfnc sym vals env)
- `(or ,@(copy (cdr form) (make-list (do ((g (cdr form) (cdr g))
- (len 0 (+ len 1)))
- ((eq? g start)
- len))))
- ,(gather-or-eqf-elements eqfnc sym vals env))))))
-
- ;; false branch of if above -- not consequent on previous
- (when (pair? start)
- (if (eq? fp (cdr start))
- (begin
- (set! sym #f)
- (set! eqfnc #f)
- (set! vals ())
- (set! start #f))
- ;; here we have possible header stuff + more than one match + trailing stuff
- (let ((trailer (if (not (len>1? fp))
- fp
- (let ((nfp (simplify-boolean (cons 'or fp) () () env)))
- ((if (and (pair? nfp)
- (eq? (car nfp) 'or))
- cdr list)
- nfp)))))
- (return (if (eq? start (cdr form))
- (cons 'or (cons (gather-or-eqf-elements eqfnc sym vals env) trailer))
- `(or ,@(copy (cdr form) (make-list (do ((g (cdr form) (cdr g))
- (len 0 (+ len 1)))
- ((eq? g start)
- len))))
- ,(gather-or-eqf-elements eqfnc sym vals env)
- , at trailer)))))))))))
+ (if (not start)
+ (set! start fp) ; we're in a loop above...
+ (if (and (proper-list? form)
+ (len=1? fp))
+ (return (if (eq? start (cdr form))
+ (gather-or-eqf-elements eqfnc sym vals env)
+ `(or ,@(copy (cdr form) (make-list (do ((g (cdr form) (cdr g))
+ (len 0 (+ len 1)))
+ ((eq? g start)
+ len))))
+ ,(gather-or-eqf-elements eqfnc sym vals env))))))
+
+ ;; false branch of if above -- not consequent on previous
+ (when (pair? start)
+ (if (eq? fp (cdr start))
+ (begin
+ (set! sym #f)
+ (set! eqfnc #f)
+ (set! vals ())
+ (set! start #f))
+ ;; here we have possible header stuff + more than one match + trailing stuff
+ (let ((trailer (if (not (len>1? fp))
+ fp
+ (let ((nfp (simplify-boolean (cons 'or fp) () () env)))
+ ((if (and (pair? nfp)
+ (eq? (car nfp) 'or))
+ cdr list)
+ nfp)))))
+ (return (if (eq? start (cdr form))
+ (cons 'or (cons (gather-or-eqf-elements eqfnc sym vals env) trailer))
+ `(or ,@(copy (cdr form) (make-list (do ((g (cdr form) (cdr g))
+ (len 0 (+ len 1)))
+ ((eq? g start)
+ len))))
+ ,(gather-or-eqf-elements eqfnc sym vals env)
+ , at trailer))))))))))
;; -------- or->case --------
- (define (or->case return form env)
+ (define (or->case return form)
(do ((selector #f) ; (or (and (eq?...)...)....) -> (case ....)
(keys ())
(fp (cdr form) (cdr fp)))
@@ -3281,9 +3303,9 @@
(and (equal? selector arg1)
(pair? (cddr expr))
(quoted-pair? (caddr expr))
- (not (any? (lambda (g)
- (memv g keys))
- (cadr (caddr expr))))
+ (not (lint-any? (lambda (g)
+ (memv g keys))
+ (cadr (caddr expr))))
(set! keys (append (cadr (caddr expr)) keys))))
((eq? eqv? char=?)
@@ -3406,11 +3428,11 @@
((not (or (memq val new-form)
(and (len>1? val) ; and redundant tests
(hash-table-ref booleans (car val))
- (any? (lambda (p)
- (and (len>1? p)
- (subsumes? (car p) (car val))
- (equal? (cadr val) (cadr p))))
- new-form))))
+ (lint-any? (lambda (p)
+ (and (len>1? p)
+ (subsumes? (car p) (car val))
+ (equal? (cadr val) (cadr p))))
+ new-form))))
(set! new-form (cons val new-form))))
(if (and (not (eq? new-form old-form))
@@ -3565,17 +3587,17 @@
((not (and (len>2? e) ; (and ... (or ... 123) ...) -> splice out or
(pair? (cdr exprs))
(eq? (car e) 'or)
- (cond ((list-ref e (- (length e) 1)) => code-constant?) ; (or ... #f)
+ (cond ((last-ref e) => code-constant?) ; (or ... #f)
(else #f))))
(if (not (and (pair? new-form)
(or (eq? val (car new-form)) ; omit repeated tests
(and (len>1? val) ; and redundant tests
(hash-table-ref booleans (car val))
- (any? (lambda (p)
- (and (len>1? p)
- (subsumes? (car val) (car p))
- (equal? (cadr val) (cadr p))))
- new-form)))))
+ (lint-any? (lambda (p)
+ (and (len>1? p)
+ (subsumes? (car val) (car p))
+ (equal? (cadr val) (cadr p))))
+ new-form)))))
(set! new-form (cons val new-form)))))
(if (and (not (eq? new-form old-form))
@@ -3596,14 +3618,14 @@
(else #f))))
(if (and op
(>= len 3)
- (every? (lambda (p)
- (and (len>2? p)
- (eq? (car p) op)))
- (cdr form)))
+ (lint-every? (lambda (p)
+ (and (len>2? p)
+ (eq? (car p) op)))
+ (cdr form)))
(let ((first (cadadr form)))
- (if (every? (lambda (p)
- (equal? (cadr p) first))
- (cddr form))
+ (if (lint-every? (lambda (p)
+ (equal? (cadr p) first))
+ (cddr form))
(set! form `(,op ,first (,(car form) ,@(map (lambda (p)
(if (null? (cdddr p))
(caddr p)
@@ -3611,10 +3633,10 @@
(cdr form)))))
(if (null? (cdddr (cadr form)))
(let ((last (caddr (cadr form))))
- (if (every? (lambda (p)
- (and (null? (cdddr p))
- (equal? (caddr p) last)))
- (cddr form))
+ (if (lint-every? (lambda (p)
+ (and (null? (cdddr p))
+ (equal? (caddr p) last)))
+ (cddr form))
(set! form (list op
(cons (car form)
(map cadr (cdr form)))
@@ -3759,7 +3781,7 @@
(return arg1))
(if (and (pair? arg1) ; (or (and ... A) A) -> A
(eq? (car arg1) 'and)
- (equal? arg2 (list-ref arg1 (- (length arg1) 1)))
+ (equal? arg2 (last-ref arg1))
(not (side-effect? arg1 env)))
(return arg2))
@@ -3867,12 +3889,10 @@
;; perhaps also (or (not (or A B)) (not (or (not A) (not B)))), but it never happens
(let ((a1 (cadr form))
(a2 (caddr form)))
- (when (and (pair? a1)
- (pair? a2)
+ (when (and (len=3? a1)
+ (len=3? a2)
(eq? (car a1) 'and)
- (eq? (car a2) 'and)
- (= (length a1) 3)
- (= (length a2) 3))
+ (eq? (car a2) 'and))
(let ((A ((if (and (pair? (cadr a1)) (eq? (caadr a1) 'not)) cadadr cadr) a1))
(B (if (and (pair? (caddr a1)) (eq? (caaddr a1) 'not)) (cadr (caddr a1)) (caddr a1))))
(if (or (equal? form `(or (and ,A ,B) (and (not ,A) (not ,B))))
@@ -3907,7 +3927,7 @@
;; len > 3 or nothing was caught above
(invert-successive-nots return form len env)
(or->memx return form env)
- (or->case return form env)
+ (or->case return form)
(reduce-or return form len true false env))))))
;; --------------------------------
@@ -4038,7 +4058,7 @@
(cdr arg1))))
(and (or (not (code-constant? arg1-1))
(not (code-constant? arg2-2))
- ((symbol->value op1) arg1-1 arg2-2))
+ ((symbol->value op1 (rootlet)) arg1-1 arg2-2))
(list op1 arg1-1 arg2-1 arg2-2))))
((equal? arg1-1 arg2-2) ; (and (op x y) (op z x)) -> (op z x y)
@@ -4047,21 +4067,21 @@
arg1)
(and (or (not (code-constant? arg2-1))
(not (code-constant? arg1-2))
- ((symbol->value op1) arg2-1 arg1-2))
+ ((symbol->value op1 (rootlet)) arg2-1 arg1-2))
(list op1 arg2-1 arg1-1 arg1-2))))
;; here we're restricted to equalities and we know arg1 != arg2
((equal? arg1-1 arg2-1) ; (and (op x y) (op x z)) -> (op x y z)
(if (and (code-constant? arg1-2)
(code-constant? arg2-2))
- (and ((symbol->value op1) arg1-2 arg2-2)
+ (and ((symbol->value op1 (rootlet)) arg1-2 arg2-2)
arg1)
(list op1 arg1-1 arg1-2 arg2-2)))
;; equalities again
((and (code-constant? arg1-1)
(code-constant? arg2-1))
- (and ((symbol->value op1) arg1-1 arg2-1)
+ (and ((symbol->value op1 (rootlet)) arg1-1 arg2-1)
arg1))
(else (list op1 arg1-1 arg1-2 arg2-1)))))))
@@ -4174,14 +4194,14 @@
;; len > 3 or nothing was caught above
(invert-successive-nots return form len env)
- (if (every? (lambda (a)
- (and (len>1? a)
- (or (eq? (car a) 'zero?)
- (and (eq? (car a) '=)
- (len=2? (cdr a))
- (or (eqv? (cadr a) 0)
- (eqv? (caddr a) 0))))))
- (cdr form))
+ (if (lint-every? (lambda (a)
+ (and (len>1? a)
+ (or (eq? (car a) 'zero?)
+ (and (eq? (car a) '=)
+ (len=2? (cdr a))
+ (or (eqv? (cadr a) 0)
+ (eqv? (caddr a) 0))))))
+ (cdr form))
(return (cons '= (cons 0 (lint-remove-duplicates
(map (lambda (a)
((if (or (eq? (car a) 'zero?)
@@ -4382,27 +4402,27 @@
(memq op '(logior lognot logxor logand numerator denominator floor round truncate ceiling ash)))
(define (just-rationals? form)
- (or (null? form)
- (rational? form)
- (and (pair? form)
- (rational? (car form))
- (just-rationals? (cdr form)))))
+ (or (rational? form)
+ (do ((p form (cdr p)))
+ ((not (and (pair? p)
+ (rational? (car p))))
+ (null? p)))))
(define (remove-inexactions val)
(when (and (or (assq 'exact->inexact val)
(assq 'inexact val))
(not (tree-memq 'random val))
- (any? number? val))
+ (lint-any? number? val))
(set! val (map (lambda (x)
(if (and (len>1? x)
(memq (car x) '(inexact exact->inexact)))
(cadr x)
x))
val))
- (if (not (any? (lambda (x)
- (and (number? x)
- (inexact? x)))
- val))
+ (if (not (lint-any? (lambda (x)
+ (and (number? x)
+ (inexact? x)))
+ val))
(do ((p val (cdr p)))
((or (null? p)
(number? (car p)))
@@ -4410,9 +4430,6 @@
(set-car! p (* 1.0 (car p))))))))
val)
- (define (collect-non-numbers args)
- (collect-if list (lambda (x) (not (number? x))) args))
-
;; polar notation (@) is never used anywhere except test suites
(define numerics-table
@@ -4482,18 +4499,18 @@
((1) (car args))
(else
(let ((val (remove-all 0 (splice-if '+ args))))
- (if (every? (lambda (x) (or (not (number? x)) (rational? x))) val)
- (let ((rats (collect-if list rational? val)))
+ (if (lint-every? (lambda (x) (or (not (number? x)) (rational? x))) val)
+ (let ((rats (collect-if-rational val)))
(if (len>1? rats)
(let ((y (apply + rats)))
(set! val (if (zero? y)
- (collect-non-numbers val)
- (cons y (collect-non-numbers val))))))))
+ (collect-if-not-number val)
+ (cons y (collect-if-not-number val))))))))
(set! val (remove-inexactions val))
- (if (any? (lambda (p) ; collect all + and - vals -> (- (+ ...) ...)
- (and (pair? p)
- (eq? (car p) '-)))
- val)
+ (if (lint-any? (lambda (p) ; collect all + and - vals -> (- (+ ...) ...)
+ (and (pair? p)
+ (eq? (car p) '-)))
+ val)
(let ((plus ())
(minus ())
(c 0))
@@ -4573,9 +4590,9 @@
((and (eq? (car arg1) '*) ; (+ (* a b) (* a c)) -> (* a (+ b c))
(eq? (car arg2) '*)
- (any? (lambda (a)
- (member a (cdr arg2)))
- (cdr arg1)))
+ (lint-any? (lambda (a)
+ (member a (cdr arg2)))
+ (cdr arg1)))
(do ((times ())
(pluses ())
(rset (cdr arg2))
@@ -4620,13 +4637,13 @@
((1) (car args))
(else
(let ((val (remove-all 1 (splice-if '* args))))
- (if (every? (lambda (x) (or (not (number? x)) (rational? x))) val)
- (let ((rats (collect-if list rational? val)))
+ (if (lint-every? (lambda (x) (or (not (number? x)) (rational? x))) val)
+ (let ((rats (collect-if-rational val)))
(if (len>1? rats)
(let ((y (apply * rats)))
(set! val (if (= y 1)
- (collect-non-numbers val)
- (cons y (collect-non-numbers val))))))))
+ (collect-if-not-number val)
+ (cons y (collect-if-not-number val))))))))
(set! val (remove-inexactions val))
(case (length val)
@@ -4761,9 +4778,9 @@
(if (eqv? (caddr gif) 0) 0 (cons '* (cons (caddr gif) other-args)))
(if (eqv? (cadddr gif) 0) 0 (cons '* (cons (cadddr gif) other-args)))))))
- ((any? (lambda (p) ; collect * and / vals -> (/ (* ...) ...)
- (and (pair? p)
- (eq? (car p) '/)))
+ ((lint-any? (lambda (p) ; collect * and / vals -> (/ (* ...) ...)
+ (and (pair? p)
+ (eq? (car p) '/)))
val)
(let ((mul ())
(div ()))
@@ -4870,13 +4887,13 @@
(if (just-rationals? args)
(apply - args)
(let ((val (remove-all 0 (splice-if '+ (cdr args)))))
- (if (every? (lambda (x) (or (not (number? x)) (rational? x))) val)
- (let ((rats (collect-if list rational? val)))
+ (if (lint-every? (lambda (x) (or (not (number? x)) (rational? x))) val)
+ (let ((rats (collect-if-rational val)))
(if (len>1? rats)
(let ((y (apply + rats)))
(set! val (if (zero? y)
- (collect-non-numbers val)
- (cons y (collect-non-numbers val))))))))
+ (collect-if-not-number val)
+ (cons y (collect-if-not-number val))))))))
(let ((first-arg (car args))
(nargs val))
(if (member first-arg nargs)
@@ -4997,9 +5014,8 @@
((-1) (list '- (caddr arg2)))
(else (list '* val (caddr arg2))))))
(else `(/ (* ,arg1 ,@(cddr arg2)) ,op2-arg1))))
- ((and (pair? arg1) ; (/ (log x) (log y)) -> (log x y) -- (log number) for (log y) never happens
- (pair? arg2)
- (= (length arg1) (length arg2) 2)
+ ((and (len=2? arg1) ; (/ (log x) (log y)) -> (log x y) -- (log number) for (log y) never happens
+ (len=2? arg2)
(case op1
((log) (eq? op2 'log))
((sin)
@@ -5010,11 +5026,10 @@
(list 'log op1-arg1 op2-arg1)
(list 'tan op1-arg1)))
- ((and (pair? arg1) ; (/ (- x) (- y)) -> (/ x y)
- (pair? arg2)
+ ((and (len=2? arg1) ; (/ (- x) (- y)) -> (/ x y)
+ (len=2? arg2)
(eq? op1 '-)
- (eq? op2 '-)
- (= (length arg1) (length arg2) 2))
+ (eq? op2 '-))
(list '/ op1-arg1 op2-arg1))
((and (pair? arg1) ; (/ (* x y) (* z y)) -> (/ x z)
@@ -5059,7 +5074,10 @@
(if (and (just-rationals? args)
(not (memv 0 (cdr args)))
(not (memv 0.0 (cdr args))))
- (apply / args)
+ (catch #t
+ (lambda ()
+ (apply / args)) ; if no overflow catch we can hit divide by zero here
+ (lambda a form))
(let ((nargs ; (/ x a (* b 1 c) d) -> (/ x a b c d)
(remove-all 1 (splice-if '* (cdr args)))))
(if (null? nargs) ; (/ x 1 1) -> x
@@ -5126,7 +5144,7 @@
(else (cons head args))))
((eqv? (car args) 0.0) ; (sin 0.0) -> 0.0
- ((symbol->value head) 0.0))
+ ((symbol->value head (rootlet)) 0.0))
((and (eq? head 'acos) ; (acos -1) -> pi
(eqv? (car args) -1))
@@ -5210,7 +5228,7 @@
((number? (car args))
(catch #t
- (lambda () (apply (symbol->value (car form)) args))
+ (lambda () (apply (symbol->value (car form) (rootlet)) args))
(lambda any (cons (car form) args))))
((not (len>1? (car args)))
@@ -5359,34 +5377,33 @@
(let ()
(define (numrat args form env)
- (let ((len (length args))
+ (let ((len2 (= (length args) 2))
(head (car form)))
(cond ((just-rationals? args)
(catch #t ; catch needed here for things like (ash 2 64)
(lambda ()
- (apply (symbol->value head) args))
+ (apply (symbol->value head (rootlet)) args))
(lambda ignore
(cons head args)))) ; use this form to pick up possible arg changes
((and (eq? head 'ash) ; (ash x 0) -> x
- (= len 2)
+ len2
(eqv? (cadr args) 0))
(car args))
((case head
((quotient) ; (quotient (remainder x y) y) -> 0
- (and (= len 2)
- (pair? (car args))
+ (and len2
+ (len=3? (car args))
(eq? (caar args) 'remainder)
- (= (length (car args)) 3)
(eqv? (caddar args) (cadr args))))
((ash modulo) ; (modulo 0 x) -> 0
- (and (= len 2) (eqv? (car args) 0)))
+ (and len2 (eqv? (car args) 0)))
(else #f))
0)
((and (eq? head 'modulo) ; (modulo (abs x) y) -> (modulo x y)
- (= len 2)
+ len2
(pair? (car args))
(eq? (caar args) 'abs))
(list 'modulo (cadar args) (cadr args)))
@@ -5486,13 +5503,13 @@
((not (and (pair? (car args))
(not (eq? (caar args) 'random))
(hash-table-ref numeric-ops (caar args))
- (any? number? (cdar args))))
+ (lint-any? number? (cdar args))))
(cons (car form) args))
- ((any? (lambda (x)
- (and (number? x)
- (inexact? x)))
- (cdar args))
+ ((lint-any? (lambda (x)
+ (and (number? x)
+ (inexact? x)))
+ (cdar args))
(car args))
(else
@@ -5509,21 +5526,21 @@
(let ()
(define (just-integers? form)
- (or (null? form)
- (integer? form)
- (and (pair? form)
- (integer? (car form))
- (just-integers? (cdr form)))))
+ (or (integer? form)
+ (do ((p form (cdr p)))
+ ((not (and (pair? p)
+ (integer? (car p))))
+ (null? p)))))
(define (numior args form env)
(let ((args (lint-remove-duplicates (remove-all 0 (splice-if 'logior args)) env)))
- (if (every? (lambda (x) (or (not (number? x)) (integer? x))) args)
- (let ((rats (collect-if list integer? args)))
+ (if (lint-every? (lambda (x) (or (not (number? x)) (integer? x))) args)
+ (let ((rats (collect-if-integer args)))
(if (len>1? rats)
(let ((y (apply logior rats)))
(set! args (if (zero? y)
- (collect-non-numbers args)
- (cons y (collect-non-numbers args))))))))
+ (collect-if-not-number args)
+ (cons y (collect-if-not-number args))))))))
(cond ((null? args) 0) ; (logior) -> 0
((null? (cdr args)) (car args)) ; (logior x) -> x
((memv -1 args) -1) ; (logior ... -1 ...) -> -1
@@ -5533,13 +5550,13 @@
(define (numand args form env)
(let ((args (lint-remove-duplicates (remove-all -1 (splice-if 'logand args)) env)))
- (if (every? (lambda (x) (or (not (number? x)) (integer? x))) args)
- (let ((rats (collect-if list integer? args)))
+ (if (lint-every? (lambda (x) (or (not (number? x)) (integer? x))) args)
+ (let ((rats (collect-if-integer args)))
(if (len>1? rats)
(let ((y (apply logand rats)))
(set! args (if (= y -1)
- (collect-non-numbers args)
- (cons y (collect-non-numbers args))))))))
+ (collect-if-not-number args)
+ (cons y (collect-if-not-number args))))))))
(cond ((null? args) -1)
((null? (cdr args)) (car args)) ; (logand x) -> x
((memv 0 args) 0)
@@ -5584,7 +5601,7 @@
(let ((args (lint-remove-duplicates (splice-if 'lcm args) env)))
(cond ((null? args) 1) ; (lcm) -> 1
((memv 0 args) 0) ; (lcm ... 0 ...) -> 0
- ((just-rationals? args) ; (lcm 3 4) -> 12
+ ((just-rationals? args) ; (lcm 3 4) -> 12
(catch #t
(lambda ()
(apply lcm args))
@@ -5597,20 +5614,21 @@
(let ()
(define (just-reals? form)
- (or (null? form)
- (and (pair? form)
- (real? (car form))
- (just-reals? (cdr form)))))
+ (or (real? form)
+ (do ((p form (cdr p)))
+ ((not (and (pair? p)
+ (real? (car p))))
+ (null? p)))))
(define (nummax args form env)
(if (not (pair? args))
form
(begin
(set! args (lint-remove-duplicates (splice-if (car form) args) env))
- (if (any? (lambda (p) ; if non-negative-op, remove any non-positive numbers
- (and (pair? p)
- (hash-table-ref non-negative-ops (car p))))
- args)
+ (if (lint-any? (lambda (p) ; if non-negative-op, remove any non-positive numbers
+ (and (pair? p)
+ (hash-table-ref non-negative-ops (car p))))
+ args)
(set! args (remove-if (lambda (x)
(and (real? x)
(not (positive? x))))
@@ -5619,22 +5637,22 @@
(car args)
(if (and (len>1? args)
(just-reals? args))
- (apply (symbol->value (car form)) args)
- (let ((nums (collect-if list real? args))
+ (apply (symbol->value (car form) (rootlet)) args)
+ (let ((nums (collect-if-real args))
(other (if (eq? (car form) 'min) 'max 'min)))
(if (pair? nums)
(let ((relop (if (eq? (car form) 'min) >= <=)))
(if (pair? (cdr nums))
- (set! nums (list (apply (symbol->value (car form)) nums))))
- (let ((new-args (append nums (collect-non-numbers args))))
+ (set! nums (list (apply (symbol->value (car form) (rootlet)) nums))))
+ (let ((new-args (append nums (collect-if-not-number args))))
(let ((c1 (car nums)))
- (set! new-args (collect-if list (lambda (x)
- (or (not (pair? x))
- (<= (length x) 2)
- (not (eq? (car x) other))
- (let ((c2 (find-if real? (cdr x))))
- (or (not c2)
- (relop c1 c2)))))
+ (set! new-args (collect-if (lambda (x)
+ (or (not (pair? x))
+ (<= (length x) 2)
+ (not (eq? (car x) other))
+ (let ((c2 (lint-find-if real? (cdr x))))
+ (or (not c2)
+ (relop c1 c2)))))
new-args)))
(if (< (length new-args) (length args))
(set! args new-args))))) ; might set args to ()?
@@ -5687,7 +5705,6 @@
(f args form env)))
(else (cons (car form) args)))))))
-
(define (binding-ok? caller head binding env second-pass)
;; check let-style variable binding for various syntactic problems
(cond (second-pass
@@ -5715,24 +5732,23 @@
#f)
((and (eq? caller (car binding))
(let ((fv (var-member caller env)))
- (and (var? fv)
+ (and fv
(memq (var-ftype fv) '(define lambda let define* lambda*)))))
(lint-format "~A variable ~A in ~S shadows the current function?" caller head caller binding)
#t)
- ((and *report-shadowed-variables* ; (let ((x 1)) (+ (let ((x 2)) (+ x 1)) x))
- (var-member (car binding) env))
- (lint-format "~A variable ~A in ~S shadows an earlier declaration" caller head (car binding) binding)
+ (*report-shadowed-variables* ; (let ((x 1)) (+ (let ((x 2)) (+ x 1)) x))
+ (report-shadower caller head 'variable (car binding) binding env)
#t)
(else #t)))
(define (check-char-cmp caller op form)
(if (and (tree-memq 'char->integer (cdr form))
- (every? (lambda (x)
- (or (and (integer? x)
- (<= 0 x 255))
- (and (len=2? x)
- (eq? (car x) 'char->integer))))
- (cdr form)))
+ (lint-every? (lambda (x)
+ (or (and (integer? x)
+ (<= 0 x 255))
+ (and (len=2? x)
+ (eq? (car x) 'char->integer))))
+ (cdr form)))
(lint-format "perhaps ~A" caller ; (< (char->integer x) 95) -> (char<? x #\_)
(lists->string form
(cons (case op ((=) 'char=?) ((>) 'char>?) ((<) 'char<?) ((>=) 'char>=?) (else 'char<=?))
@@ -5836,11 +5852,11 @@
(define (simple-lambda? x)
(and (easy-lambda? x)
(null? (cdddr x))
- (tree-nonce (caadr x) (caddr x))))
+ (= (tree-count (caadr x) (caddr x) 2) 1)))
(define (less-simple-lambda? x)
(and (easy-lambda? x)
- (tree-nonce (caadr x) (cddr x))))
+ (= (tree-count (caadr x) (cddr x) 2) 1)))
(define (cdr-count c)
(case c ((cdr) 1) ((cddr) 2) ((cdddr) 3) (else 4)))
@@ -5956,7 +5972,7 @@
(let ((cxr? (lambda (s)
(and (pair? (cdr s))
(len=2? (cadr s))
- (memq (caadr s) '(car cdr cadr cddr cdar cdddr cddddr))))))
+ (hash-table-ref combinable-cxrs (caadr s))))))
(lambda (form)
(and (cxr? form)
(let* ((arg1 (cadr form))
@@ -6004,9 +6020,9 @@
(define (mv-range producer env)
(if (symbol? producer)
(let ((v (var-member producer env)))
- (and (var? v)
- (pair? ((cdr v) 'values))
- ((cdr v) 'values)))
+ (and v
+ (pair? ((cdr v) 'nvalues))
+ ((cdr v) 'nvalues)))
(and (pair? producer)
(case (car producer)
((lambda lambda*)
@@ -6023,7 +6039,7 @@
(else (mv-range (car producer) env))))))
(define (eval-constant-expression caller form)
- (if (every? code-constant? (cdr form))
+ (if (lint-every? code-constant? (cdr form))
(catch #t
(lambda ()
(let ((val (eval (copy form :readable))))
@@ -6032,23 +6048,24 @@
#t))))
(define (unlist-values tree)
- (cond ((not (pair? tree))
- tree)
-
- ((eq? (car tree) #_list-values)
- (if (and (assq #_apply-values (cdr tree))
+ (if (not (and (pair? tree)
+ (list? (cdr tree))))
+ tree
+ (case (car tree)
+ ((list-values)
+ (if (and (assq 'apply-values (cdr tree))
(len=2? (cdr tree))
(pair? (caddr tree)))
(if (and (pair? (cadr tree))
- (eq? (caadr tree) #_apply-values))
+ (eq? (caadr tree) 'apply-values))
(list 'append (cadadr tree) (cadr (caddr tree)))
(list 'cons (cadr tree) (cadr (caddr tree))))
(cons 'list (unlist-values (cdr tree)))))
-
- ((eq? (car tree) #_append)
+
+ ((append)
(if (and (len=2? (cdr tree))
(pair? (cadr tree))
- (eq? (caadr tree) #_list-values))
+ (eq? (caadr tree) 'list-values))
(let ((lst (unlist-values (cadr tree)))
(rest (caddr tree)))
(if (pair? rest) (set! rest (unlist-values rest)))
@@ -6059,19 +6076,19 @@
(else (cons 'append (unlist-values (cdr tree)))))))))
(else (cons (unlist-values (car tree))
- (unlist-values (cdr tree))))))
-
+ (unlist-values (cdr tree)))))))
+
(define (qq-tree? tree)
(and (pair? tree)
- (or (eq? (car tree) #_apply-values)
- (if (and (eq? (car tree) #_list-values)
- (assq #_apply-values (cdr tree)))
+ (or (eq? (car tree) 'apply-values)
+ (if (and (eq? (car tree) 'list-values)
+ (assq 'apply-values (cdr tree)))
(or (not (= (length tree) 3))
(not (and (pair? (caddr tree))
- (eq? (caaddr tree) #_apply-values)))
+ (eq? (caaddr tree) 'apply-values)))
(qq-tree? (cadr (caddr tree)))
(let ((applying (and (pair? (cadr tree))
- (eq? (caadr tree) #_apply-values))))
+ (eq? (caadr tree) 'apply-values))))
(qq-tree? ((if applying cadadr cadr) tree))))
(or (qq-tree? (car tree))
(qq-tree? (cdr tree)))))))
@@ -6138,15 +6155,15 @@
(if (and (memq (car eq) '(eq? eqv? equal?))
(eq? (car args) (cadr eq))
(len>1? (caddr eq))
- (eq? (car (caddr eq)) 'car)
+ (eq? (caaddr eq) 'car)
(pair? (cdr args))
(eq? (cadr args) (cadr (caddr eq))))
(lint-format "member might perhaps be ~A" ; (member 'a x (lambda (a b) (eq? a (car b))))
caller
(if (or (eq? func 'eq?)
- (eq? (car (caddr func)) 'eq?))
+ (eq? (caaddr func) 'eq?))
'assq
- (if (eq? (car (caddr func)) 'eqv?)
+ (if (eq? (caaddr func) 'eqv?)
'assv
'assoc)))))))))))
@@ -6204,16 +6221,16 @@
(keys (if (eq? (car items) 'quote)
(if (memq head '(memq memv member))
elements
- (and (every? pair? elements)
+ (and (lint-every? pair? elements)
(map car elements)))
(if (memq head '(memq memv member))
- (and (every? code-constant? elements)
+ (and (lint-every? code-constant? elements)
elements)
- (and (every? (lambda (e)
- (and (len=2? e)
- (eq? (car e) 'quote)
- (pair? (cadr e))))
- elements)
+ (and (lint-every? (lambda (e)
+ (and (len=2? e)
+ (eq? (car e) 'quote)
+ (pair? (cadr e))))
+ elements)
(map caadr elements))))))
(when (proper-list? keys)
(if (eq? (car items) 'quote)
@@ -6350,13 +6367,13 @@
(if (> nitems 20)
(lint-format "perhaps use a hash-table here, rather than ~A" caller (truncated-list->string form)))
- (let ((bad (find-if (lambda (x)
- (not (or (symbol? x)
- (char? x)
- (number? x)
- (procedure? x) ; (memq abs '(1 #_abs 2)) !
- (memq x '(#f #t () #<unspecified> #<undefined> #<eof>)))))
- (cadr items))))
+ (let ((bad (lint-find-if (lambda (x)
+ (not (or (symbol? x)
+ (char? x)
+ (number? x)
+ (procedure? x) ; (memq abs '(1 #_abs 2)) !
+ (memq x '(#f #t () #<unspecified> #<undefined> #<eof>)))))
+ (cadr items))))
(if bad
(lint-format (if (and (pair? bad)
(eq? (car bad) 'unquote))
@@ -6404,13 +6421,13 @@
(if (pair? (cdr arg)) ; (car (memq x ...)) is either x or (car #f) -> error
(lint-format "~A is ~A, or an error" caller (truncated-list->string form) (cadr arg))))))
- (when (and (eq? (car arg) 'or) ; (cdr (or (assoc x y) (cons 1 2))) -> (cond ((assoc x y) => cdr) (else 2))
+ (when (and (eq? (car arg) 'or) ; (cdr (or (assoc x y) (cons 1 2))) -> (cond ((assoc x y) => cdr) (else 2))
(not (eq? form last-rewritten-internal-define))
(len=3? arg))
(let ((arg1 (cadr arg))
(arg2 (caddr arg)))
(if (and (pair? arg2)
- (or (and (memq (car arg2) '(cons list #_list-values))
+ (or (and (memq (car arg2) '(cons list list-values))
(eq? head 'cdr))
(memq (car arg2) '(error throw))
(quoted-pair? arg2)))
@@ -6441,7 +6458,7 @@
(if (and (memq head '(car cdr))
(eq? (car arg) 'cons)
(len>1? (cdr arg)))
- (lint-format "(~A~A) is the same as ~A" ; (car (cons 1 2)) is the same as 1
+ (lint-format "(~A~A) is the same as ~A" ; (car (cons 1 2)) is the same as 1
caller head
(truncated-list->string arg)
(truncated-list->string ((if (eq? head 'car) cadr caddr) arg))))
@@ -6478,6 +6495,10 @@
(define (sp-set-car! caller head form env)
(when (= (length form) 3)
(let ((target (cadr form)))
+ (if (code-constant? target)
+ (lint-format "~A is a constant, so ~A is problematic" caller
+ target
+ (truncated-list->string form)))
(if (pair? target)
(case (car target)
@@ -6502,6 +6523,16 @@
(caddr form)))))))))))
(hash-special 'set-car! sp-set-car!))
+ (let ()
+ (define (sp-set-cdr! caller head form env)
+ (when (= (length form) 3)
+ (let ((target (cadr form)))
+ (if (code-constant? target)
+ (lint-format "~A is a constant, so ~A is problematic" caller
+ target
+ (truncated-list->string form))))))
+ (hash-special 'set-cdr! sp-set-cdr!))
+
;; ---------------- not ----------------
(let ()
(define (sp-not caller head form env)
@@ -6514,7 +6545,7 @@
(unless (eq? (caadr form) 'for-each)
(let ((sig (arg-signature (caadr form) env)))
(if (and (pair? sig)
- (if (pair? (car sig)) ; (not (+ x y))
+ (if (pair? (car sig)) ; (not (+ x y))
(not (memq 'boolean? (car sig)))
(not (memq (car sig) '(#t values boolean?)))))
(lint-format "~A can't be true (~A never returns #f)" caller (truncated-list->string form) (caadr form)))))))
@@ -6522,7 +6553,7 @@
(if (not (= line-number last-simplify-boolean-line-number))
(let ((val (simplify-boolean form () () env)))
(set! last-simplify-boolean-line-number line-number)
- (if (not (equal? form val)) ; (not (and (> x 2) (not z))) -> (or (<= x 2) z)
+ (if (not (equal? form val)) ; (not (and (> x 2) (not z))) -> (or (<= x 2) z)
(lint-format "perhaps ~A" caller (lists->string form val))))))
(hash-special 'not sp-not))
@@ -6538,9 +6569,8 @@
(if (pair? (cdr form))
(do ((p (cdr form) (cdr p)))
((null? (cdr p)))
- (if (and (pair? (car p))
- (eq? (caar p) 'if)
- (= (length (car p)) 3)) ; (and (member n cvars) (if (pair? open) (not (member n open))) (not (eq? n open)))
+ (if (and (len=3? (car p)) ; (and (member n cvars) (if (pair? open) (not (member n open))) (not (eq? n open)))
+ (eq? (caar p) 'if))
(lint-format "one-armed if might cause confusion here: ~A" caller form)))))
(hash-special 'and sp-and)
(hash-special 'or sp-and))
@@ -6551,7 +6581,7 @@
;; repeated factors (= (+ x y) (+ x z)) never happen
(let ((len (length form)))
(if (and (> len 2)
- (let any-real? ((lst (cdr form))) ; ignore 0.0 and 1.0 in this since they normally work
+ (let any-real? ((lst (cdr form))) ; ignore 0.0 and 1.0 in this since they normally work
(and (pair? lst)
(or (and (number? (car lst))
(not (rational? (car lst)))
@@ -6802,7 +6832,7 @@
(if op
(eq? op (car a))
(set! op (car a)))))))))
- (every? casef (cdr form))))
+ (lint-every? casef (cdr form))))
(lint-format "perhaps ~A" caller
(lists->string form ; (char=? #\a (char-downcase x)) -> (char-ci=? #\a x)
(cons 'char-ci=? (map (lambda (a)
@@ -6835,7 +6865,7 @@
(if op
(eq? op (car a))
(set! op (car a))))))))
- (every? casef (cdr form))))
+ (lint-every? casef (cdr form))))
(lint-format "perhaps ~A" caller ; (string=? (string-downcase x) (string-downcase y)) -> (string-ci=? x y)
(lists->string form
(let ((op (case head
@@ -6852,10 +6882,10 @@
a))
(cdr form)))))))
- (if (any? (lambda (a) ; string-copy is redundant in arg list
- (and (len=2? a)
- (memq (car a) '(copy string-copy))))
- (cdr form))
+ (if (lint-any? (lambda (a) ; string-copy is redundant in arg list
+ (and (len=2? a)
+ (memq (car a) '(copy string-copy))))
+ (cdr form))
(let cleaner ((args (cdr form)) (new-args ())) ; (string=? "" (string-copy "")) -> (string=? "" "")
(if (not (pair? args))
(lint-format "perhaps ~A" caller (lists->string form (cons head (reverse new-args))))
@@ -6895,12 +6925,12 @@
(lint-format "perhaps ~A" caller
(lists->string form (list 'char=? (list 'string-ref (cadr s2) 0) (string-ref s1 0))))))))
- (if (every? (lambda (a) ; (string=? "#" (string (string-ref s 0))) -> (char=? #\# (string-ref s 0))
- (or (and (string? a)
- (= (length a) 1))
- (and (len>1? a)
- (eq? (car a) 'string))))
- (cdr form))
+ (if (lint-every? (lambda (a) ; (string=? "#" (string (string-ref s 0))) -> (char=? #\# (string-ref s 0))
+ (or (and (string? a)
+ (= (length a) 1))
+ (and (len>1? a)
+ (eq? (car a) 'string))))
+ (cdr form))
(lint-format "perhaps ~A" caller
(lists->string form
(cons (symbol "char" (substring (symbol->string head) 6))
@@ -7020,16 +7050,20 @@
((and (null? (cddr form))
(number? (cadr form))
- (zero? (cadr form))) ; (/ 0)
+ (zero? (cadr form))) ; (/ 0)
(lint-format "attempt to invert zero: ~A" caller (truncated-list->string form)))
- ((and (pair? (cddr form)) ; (/ x y 2 0)
+ ((and (pair? (cddr form)) ; (/ x y 2 0)
(memv 0 (cddr form)))
(lint-format "attempt to divide by 0: ~A" caller (truncated-list->string form)))
(else
- (let ((len (assq 'length (cdr form))))
- (if (len>1? len)
+ (let ((len (if (null? (cddr form)) ; (/ (length x))
+ (and (len=2? (cadr form))
+ (eq? (caadr form) 'length)
+ (cadr form))
+ (assq 'length (cddr form))))) ; (/ x y (length z))
+ (if (len=2? len)
(lint-format "~A will cause division by 0 if ~A is empty" caller len (cadr len)))))))
(hash-special '/ sp-/))
@@ -7080,57 +7114,56 @@
;; ---------------- string ----------------
(let ()
- (define (sp-string caller head form env)
- (if (every? (lambda (x)
- (and (char? x)
- (char<=? #\space x #\~))) ; #\0xx chars here look dumb
- (cdr form))
- (lint-format "~A could be ~S" caller (truncated-list->string form) (apply string (cdr form)))
- (if (and (pair? (cdr form)) ; (string (string-ref x 0)) -> (substring x 0 1)
- (pair? (cadr form)))
- (if (and (eq? (caadr form) 'string-ref)
- (null? (cddr form)))
- (let ((arg (cdadr form)))
- (if (and (len>1? arg)
- (integer? (cadr arg))) ; (string (string-ref x 0)) -> (substring x 0 1)
- (lint-format "perhaps ~A" caller
- (lists->string form
- (list 'substring (car arg) (cadr arg) (+ 1 (cadr arg)))))))
- (if (and (not (null? (cddr form)))
- (memq (caadr form) '(char-upcase char-downcase))
- (every? (lambda (p)
- (eq? (caadr form) (car p)))
- (cddr form)))
- ;; (string (char-downcase (string-ref x 1)) (char-downcase (string-ref x 2))) ->
- ;; (string-downcase (string (string-ref x 1) (string-ref x 2)))
- (lint-format "perhaps ~A" caller
- (lists->string form `(,(if (eq? (caadr form) 'char-upcase) 'string-upcase 'string-downcase)
- (string ,@(map cadr (cdr form)))))))))))
- ;; repeated args as in vector/list (sp-list below) got no hits
- (hash-special 'string sp-string))
+ (define (sp-string caller head form env)
+ (if (lint-every? (lambda (x)
+ (and (char? x)
+ (char<=? #\space x #\~))) ; #\0xx chars here look dumb
+ (cdr form))
+ (lint-format "~A could be ~S" caller (truncated-list->string form) (apply string (cdr form)))
+ (if (and (pair? (cdr form)) ; (string (string-ref x 0)) -> (substring x 0 1)
+ (pair? (cadr form)))
+ (if (null? (cddr form))
+ (if (eq? (caadr form) 'string-ref)
+ (let ((arg (cdadr form)))
+ (if (and (len>1? arg)
+ (integer? (cadr arg))) ; (string (string-ref x 0)) -> (substring x 0 1)
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (list 'substring (car arg) (cadr arg) (+ 1 (cadr arg))))))))
+ (if (and (memq (caadr form) '(char-upcase char-downcase))
+ (lint-every? (lambda (p)
+ (eq? (caadr form) (car p)))
+ (cddr form)))
+ ;; (string (char-downcase (string-ref x 1)) (char-downcase (string-ref x 2))) ->
+ ;; (string-downcase (string (string-ref x 1) (string-ref x 2)))
+ (lint-format "perhaps ~A" caller
+ (lists->string form `(,(if (eq? (caadr form) 'char-upcase) 'string-upcase 'string-downcase)
+ (string ,@(map cadr (cdr form)))))))))))
+ ;; repeated args as in vector/list (sp-list below) got no hits
+ (hash-special 'string sp-string))
;; ---------------- string? ----------------
(let ()
- (define (sp-string? caller head form env)
- (if (and (pair? (cdr form))
- (pair? (cadr form))
- (memq (caadr form) '(format number->string)))
- (if (eq? (caadr form) 'format) ; (string? (number->string x)) -> #t
- (lint-format "format returns either #f or a string, so ~A" caller (lists->string form (cadr form)))
- (lint-format "number->string always returns a string, so ~A" caller (lists->string form #t)))
- (check-boolean-affinity caller form env)))
- (hash-special 'string? sp-string?))
+ (define (sp-string? caller head form env)
+ (if (and (pair? (cdr form))
+ (pair? (cadr form))
+ (memq (caadr form) '(format number->string)))
+ (if (eq? (caadr form) 'format) ; (string? (number->string x)) -> #t
+ (lint-format "format returns either #f or a string, so ~A" caller (lists->string form (cadr form)))
+ (lint-format "number->string always returns a string, so ~A" caller (lists->string form #t)))
+ (check-boolean-affinity caller form env)))
+ (hash-special 'string? sp-string?))
;; ---------------- number? ----------------
(let ()
- (define (sp-number? caller head form env)
- (if (and (pair? (cdr form))
- (pair? (cadr form))
- (eq? (caadr form) 'string->number)) ; (number? (string->number x)) -> (string->number x)
- (lint-format "string->number returns either #f or a number, so ~A" caller (lists->string form (cadr form)))
- (check-boolean-affinity caller form env)))
- (hash-special 'number? sp-number?))
-
+ (define (sp-number? caller head form env)
+ (if (and (pair? (cdr form))
+ (pair? (cadr form))
+ (eq? (caadr form) 'string->number)) ; (number? (string->number x)) -> (string->number x)
+ (lint-format "string->number returns either #f or a number, so ~A" caller (lists->string form (cadr form)))
+ (check-boolean-affinity caller form env)))
+ (hash-special 'number? sp-number?))
+
;; ---------------- exact? inexact? infinite? nan? ----------------
(let ()
(define (sp-exact? caller head form env)
@@ -7148,9 +7181,9 @@
(for-each (lambda (f)
(hash-special f sp-symbol?))
'(symbol? rational? real? complex? float? keyword? gensym? byte-vector? proper-list? sequence? constant?
- char? boolean? float-vector? int-vector? vector? let? hash-table? input-port? c-object?
- output-port? iterator? continuation? dilambda? procedure? macro? random-state? eof-object? c-pointer?)))
-
+ char? boolean? float-vector? int-vector? vector? let? hash-table? input-port? c-object?
+ output-port? iterator? continuation? dilambda? procedure? macro? random-state? eof-object? c-pointer?)))
+
;; ---------------- pair? list? ----------------
(let ()
(define (sp-pair? caller head form env)
@@ -7163,49 +7196,49 @@
(for-each (lambda (f)
(hash-special f sp-pair?))
'(pair? list?)))
-
+
;; ---------------- integer? ----------------
(let ()
- (define (sp-integer? caller head form env)
- (check-boolean-affinity caller form env)
- (if (and (pair? (cdr form)) ; (integer? (char-position x y)) -> (char-position x y)
- (pair? (cadr form))
- (memq (caadr form) '(char-position string-position)))
- (lint-format "~A returns either #f or an integer, so ~A" caller (caadr form)
- (lists->string form (cadr form)))))
- (hash-special 'integer? sp-integer?))
+ (define (sp-integer? caller head form env)
+ (check-boolean-affinity caller form env)
+ (if (and (pair? (cdr form)) ; (integer? (char-position x y)) -> (char-position x y)
+ (pair? (cadr form))
+ (memq (caadr form) '(char-position string-position)))
+ (lint-format "~A returns either #f or an integer, so ~A" caller (caadr form)
+ (lists->string form (cadr form)))))
+ (hash-special 'integer? sp-integer?))
;; ---------------- null? ----------------
(let ()
- (define (sp-null? caller head form env)
- (check-boolean-affinity caller form env)
- (if (and (pair? (cdr form)) ; (null? (string->list x)) -> (zero? (length x))
- (len>1? (cadr form))
- (memq (caadr form) '(vector->list string->list let->list)))
- (lint-format "perhaps ~A" caller
- (lists->string form (list 'zero? (list 'length (cadadr form)))))))
- (hash-special 'null? sp-null?))
+ (define (sp-null? caller head form env)
+ (check-boolean-affinity caller form env)
+ (if (and (pair? (cdr form)) ; (null? (string->list x)) -> (zero? (length x))
+ (len>1? (cadr form))
+ (memq (caadr form) '(vector->list string->list let->list)))
+ (lint-format "perhaps ~A" caller
+ (lists->string form (list 'zero? (list 'length (cadadr form)))))))
+ (hash-special 'null? sp-null?))
;; ---------------- odd? even? ----------------
(let ()
- (define (sp-odd? caller head form env)
- (if (and (pair? (cdr form)) ; (odd? (- x 1)) -> (even? x)
- (len=3? (cadr form))
- (memq (caadr form) '(+ -)))
- (let* ((arg1 (cadadr form))
- (arg2 (caddr (cadr form)))
- (int-arg (or (and (integer? arg1) arg1)
- (and (integer? arg2) arg2))))
- (if int-arg
- (lint-format "perhaps ~A" caller
- (lists->string form
- (if (and (integer? arg1)
- (integer? arg2))
- (eval/error caller form)
- (list (if (eq? (eq? head 'even?) (even? int-arg)) 'even? 'odd?)
- (if (integer? arg1) arg2 arg1)))))))))
- (hash-special 'odd? sp-odd?)
- (hash-special 'even? sp-odd?))
+ (define (sp-odd? caller head form env)
+ (if (and (pair? (cdr form)) ; (odd? (- x 1)) -> (even? x)
+ (len=3? (cadr form))
+ (memq (caadr form) '(+ -)))
+ (let* ((arg1 (cadadr form))
+ (arg2 (caddr (cadr form)))
+ (int-arg (or (and (integer? arg1) arg1)
+ (and (integer? arg2) arg2))))
+ (if int-arg
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (if (and (integer? arg1)
+ (integer? arg2))
+ (eval/error caller form)
+ (list (if (eq? (eq? head 'even?) (even? int-arg)) 'even? 'odd?)
+ (if (integer? arg1) arg2 arg1)))))))))
+ (hash-special 'odd? sp-odd?)
+ (hash-special 'even? sp-odd?))
;; ---------------- string-ref ----------------
(let ()
@@ -7214,7 +7247,7 @@
(if (equal? (cadr form) "")
(lint-format "~A is an error" caller form)
- (when (every? code-constant? (cdr form)) ; (string-ref "abc" 0) -> #\a
+ (when (lint-every? code-constant? (cdr form)) ; (string-ref "abc" 0) -> #\a
(catch #t
(lambda ()
(let ((val (eval form)))
@@ -7252,11 +7285,11 @@
(unless (= line-number last-checker-line-number)
(when (= (length form) 3)
(let ((seq (cadr form)))
-
+
(when (code-constant? (cadr form))
(if (eqv? (length (cadr form)) 0)
(lint-format "~A is an error" caller form)
- (when (every? code-constant? (cddr form)) ; (vector-ref #(1 2) 0) -> 1
+ (when (lint-every? code-constant? (cddr form)) ; (vector-ref #(1 2) 0) -> 1
(catch #t
(lambda ()
(let ((val (eval form)))
@@ -7320,15 +7353,23 @@
(index (caddr form))
(val (cadddr form)))
- (cond ((and (pair? val) ; (vector-set! x 0 (vector-ref x 0))
- (= (length val) 3)
+ (cond ((and (len=3? val) ; (vector-set! x 0 (vector-ref x 0))
(eq? target (cadr val))
(equal? index (caddr val))
(memq (car val) '(vector-ref list-ref hash-table-ref string-ref let-ref float-vector-ref int-vector-ref)))
(lint-format "redundant ~A: ~A" caller head (truncated-list->string form)))
- ((code-constant? target) ; (vector-set! #(0 1 2) 1 3)??
- (lint-format "~A is a constant that is discarded; perhaps ~A" caller target (lists->string form val)))
+ ((code-constant? target) ; (vector-set! #(0 1 2) 1 3)??
+ (let ((len (length target)))
+ (cond ((eqv? len 0)
+ (lint-format "~A has no elements, so ~A makes no sense" caller target (truncated-list->string form)))
+ ((and (integer? index)
+ (integer? len)
+ (>= index len))
+ (lint-format "index ~A is too large in ~A" caller index (truncated-list->string form)))
+ (else
+ (lint-format "~S is a constant, so ~A is problematic, and ~S is discarded; perhaps ~A" caller
+ target head target (lists->string form val))))))
((not (pair? target)))
@@ -7337,7 +7378,10 @@
(lint-format "perhaps ~A" caller (lists->string form `(set! (,@(cdr target) ,index) ,val))))
((memq (car target) '(make-vector vector make-string string make-list list append cons
- vector-append inlet sublet copy vector-copy string-copy list-copy)) ;list-copy is from r7rs
+ vector-append inlet sublet copy vector-copy string-copy list-copy
+ int-vector float-vector byte-vector string-append make-byte-vector
+ make-int-vector make-float-vector make-hash-table hash-table hash-table*
+ )) ;list-copy is from r7rs
(lint-format "~A is simply discarded; perhaps ~A" caller
(truncated-list->string target) ; (vector-set! (make-vector 3) 1 1) -- does this ever happen?
(lists->string form val)))
@@ -7350,21 +7394,21 @@
`(list-set! ,(cadr target) ,(+ (caddr form) (cdr-count (car target))) ,(cadddr form)))))))))
(for-each (lambda (f)
(hash-special f sp-vector-set!))
- '(vector-set! list-set! hash-table-set! float-vector-set! int-vector-set! string-set! let-set!)))
+ '(vector-set! list-set! hash-table-set! float-vector-set! int-vector-set! string-set! byte-vector-set! let-set!)))
;; ---------------- object->string ----------------
(let ()
- (define (sp-object->string caller head form env)
- (when (pair? (cdr form))
- (if (and (pair? (cadr form)) ; (object->string (object->string x)) could be (object->string x)
- (eq? (caadr form) 'object->string))
- (lint-format "~A could be ~A" caller (truncated-list->string form) (cadr form))
- (if (pair? (cddr form))
- (let ((arg2 (caddr form)))
- (if (and (code-constant? arg2) ; (object->string x :else)
- (not (memq arg2 '(#f #t :readable)))) ; #f and #t are display|write choice, :readable = ~W
- (lint-format "bad second argument: ~A" caller arg2)))))))
-
+ (define (sp-object->string caller head form env)
+ (when (pair? (cdr form))
+ (if (and (pair? (cadr form)) ; (object->string (object->string x)) could be (object->string x)
+ (eq? (caadr form) 'object->string))
+ (lint-format "~A could be ~A" caller (truncated-list->string form) (cadr form))
+ (if (pair? (cddr form))
+ (let ((arg2 (caddr form)))
+ (if (and (code-constant? arg2) ; (object->string x :else)
+ (not (memq arg2 '(#f #t :readable)))) ; #f and #t are display|write choice, :readable = ~W
+ (lint-format "bad second argument: ~A" caller arg2)))))))
+
(hash-special 'object->string sp-object->string))
(define (all-caps-warning arg)
@@ -7374,94 +7418,94 @@
;; ---------------- display ----------------
(let ()
- (define (sp-display caller head form env)
- (when (pair? (cdr form))
- (let ((arg (cadr form))
- (port (if (pair? (cddr form))
- (caddr form)
- ())))
- (cond ((all-caps-warning arg)
- (lint-format "There's no need to shout: ~A" caller (truncated-list->string form)))
-
- ((not (len>1? arg)))
-
- ((and (eq? (car arg) 'format) ; (display (format #f str x)) -> (format () str x)
- (not (cadr arg)))
- (lint-format "perhaps ~A" caller (lists->string form (cons 'format (cons port (cddr arg))))))
-
- ((and (eq? (car arg) 'apply) ; (display (apply format #f str x) p) -> (apply format p str x)
- (eq? (cadr arg) 'format)
- (pair? (cddr arg))
- (not (caddr arg)))
- (lint-format "perhaps ~A" caller (lists->string form `(apply format ,port ,@(cdddr arg)))))
-
- ((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))
-
+ (define (sp-display caller head form env)
+ (when (pair? (cdr form))
+ (let ((arg (cadr form))
+ (port (if (pair? (cddr form))
+ (caddr form)
+ ())))
+ (cond ((all-caps-warning arg)
+ (lint-format "There's no need to shout: ~A" caller (truncated-list->string form)))
+
+ ((not (len>1? arg)))
+
+ ((and (eq? (car arg) 'format) ; (display (format #f str x)) -> (format () str x)
+ (not (cadr arg)))
+ (lint-format "perhaps ~A" caller (lists->string form (cons 'format (cons port (cddr arg))))))
+
+ ((and (eq? (car arg) 'apply) ; (display (apply format #f str x) p) -> (apply format p str x)
+ (eq? (cadr arg) 'format)
+ (pair? (cddr arg))
+ (not (caddr arg)))
+ (lint-format "perhaps ~A" caller (lists->string form `(apply format ,port ,@(cdddr arg)))))
+
+ ((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)))
- (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))
-
+ (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)))
+ (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))
+
;; ---------------- write-char, write-byte, write ----------------
(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))
- (case head
- ((write-byte)
- (if (and (integer? (cadr form))
- (not (<= 0 (cadr form) 255)))
- (lint-format "write-byte argument must be (<= 0 byte 255): ~A" caller form)))
- ((write-char)
- (if (eqv? (cadr form) #\newline)
- (lint-format "perhaps ~A" caller (lists->string form (cons 'newline (cddr form))))
- (if (and (len>1? (cadr form))
- (eq? (caadr form) 'integer->char))
- (lint-format "perhaps ~A" caller (lists->string form (cons 'write-byte (cons (cadadr form) (cddr form)))))))))))
-
- (hash-special 'write-char sp-write-char)
- (hash-special 'write-byte sp-write-char)
- (hash-special 'write sp-write-char))
-
+ (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))
+ (case head
+ ((write-byte)
+ (if (and (integer? (cadr form))
+ (not (<= 0 (cadr form) 255)))
+ (lint-format "write-byte argument must be (<= 0 byte 255): ~A" caller form)))
+ ((write-char)
+ (if (eqv? (cadr form) #\newline)
+ (lint-format "perhaps ~A" caller (lists->string form (cons 'newline (cddr form))))
+ (if (and (len>1? (cadr form))
+ (eq? (caadr form) 'integer->char))
+ (lint-format "perhaps ~A" caller (lists->string form (cons 'write-byte (cons (cadadr form) (cddr form)))))))))))
+
+ (hash-special 'write-char sp-write-char)
+ (hash-special 'write-byte sp-write-char)
+ (hash-special 'write sp-write-char))
+
;; ---------------- read, port-filename, port-line-number, read-char, read-byte ----------------
(let ()
- (define (sp-read caller head form env)
- (when (len=2? form)
- (if (and (pair? (cadr form))
- (eq? (caadr form) 'current-input-port))
- (lint-format "(current-input-port) is the default port for ~A: ~A" caller head form)
- (if (and (eq? head 'port-filename)
- (memq (cadr form) '(*stdin* *stdout* *stderr*)))
- (lint-format "~A: ~S" caller form
- (case (cadr form) ((*stdin*) "*stdin*") ((*stdout*) "*stdout*") ((*stderr*) "*stderr*")))))))
- (for-each (lambda (c)
- (hash-special c sp-read))
- '(read port-filename port-line-number read-char read-byte peek-char close-input-port)))
-
+ (define (sp-read caller head form env)
+ (when (len=2? form)
+ (if (and (pair? (cadr form))
+ (eq? (caadr form) 'current-input-port))
+ (lint-format "(current-input-port) is the default port for ~A: ~A" caller head form)
+ (if (and (eq? head 'port-filename)
+ (memq (cadr form) '(*stdin* *stdout* *stderr*)))
+ (lint-format "~A: ~S" caller form
+ (case (cadr form) ((*stdin*) "*stdin*") ((*stdout*) "*stdout*") ((*stderr*) "*stderr*")))))))
+ (for-each (lambda (c)
+ (hash-special c sp-read))
+ '(read port-filename port-line-number read-char read-byte peek-char close-input-port)))
+
;; ---------------- 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)))
- (lint-format "perhaps ~A" caller (lists->string form (eval/error caller form)))))
- (for-each (lambda (c)
- (hash-special c sp-char-numeric))
- '(char-alphabetic? char-lower-case? char-numeric? char-upper-case? char-whitespace? char-upcase char-downcase)))
-
+ (define (sp-char-numeric caller head form env)
+ (if (and (not (var-member (car form) env))
+ (len=1? (cdr form))
+ (char? (cadr form)))
+ (lint-format "perhaps ~A" caller (lists->string form (eval/error caller form)))))
+ (for-each (lambda (c)
+ (hash-special c sp-char-numeric))
+ '(char-alphabetic? char-lower-case? char-numeric? char-upper-case? char-whitespace? char-upcase char-downcase)))
+
;; ---------------- make-vector etc ----------------
(let ()
(define (sp-make-vector caller head form env)
@@ -7469,7 +7513,7 @@
(if (and (= (length form) 4)
(eq? head 'make-vector)) ; (make-vector 3 0 #t)
(lint-format "make-vector no longer has a fourth argument: ~A" caller form))
-
+
(if (>= (length form) 3)
(case (caddr form)
((#<unspecified>)
@@ -7481,7 +7525,7 @@
((0.0)
(if (eq? head 'make-float-vector)
(lint-format "0.0 is the default initial value in ~A" caller form)))))
-
+
(when (and (pair? (cdr form))
(integer? (cadr form))
(zero? (cadr form)))
@@ -7508,14 +7552,14 @@
;; ---------------- make-list ----------------
(let ()
- (define (sp-make-list caller head form env)
- (when (and (pair? (cdr form))
- (integer? (cadr form))
- (zero? (cadr form)))
- (if (pair? (cddr form)) ; (make-list 0 #f)
- (lint-format "initial value is pointless here: ~A" caller form))
- (lint-format "perhaps ~A" caller (lists->string form ()))))
- (hash-special 'make-list sp-make-list))
+ (define (sp-make-list caller head form env)
+ (when (and (pair? (cdr form))
+ (integer? (cadr form))
+ (zero? (cadr form)))
+ (if (pair? (cddr form)) ; (make-list 0 #f)
+ (lint-format "initial value is pointless here: ~A" caller form))
+ (lint-format "perhaps ~A" caller (lists->string form ()))))
+ (hash-special 'make-list sp-make-list))
;; ---------------- reverse string->list etc ----------------
(let ()
@@ -7523,7 +7567,7 @@
;; not string->number -- no point in copying a number and it's caught below
(when (pair? (cdr form))
- (if (every? code-constant? (cdr form))
+ (if (lint-every? code-constant? (cdr form))
(let ((seq (checked-eval form)))
(if (not (eq? seq :checked-eval-error)) ; (symbol->string 'abs) -> "abs"
(lint-format "perhaps ~A -> ~A~A" caller
@@ -7580,10 +7624,10 @@
((and (eq? head 'list->vector) ; (list->vector (append (vector->list v1) ...)) -> (append v1 ...)
(eq? func-of-arg 'append)
- (every? (lambda (a)
- (and (pair? a)
- (eq? (car a) 'vector->list)))
- (cdadr form)))
+ (lint-every? (lambda (a)
+ (and (pair? a)
+ (eq? (car a) 'vector->list)))
+ (cdadr form)))
(lint-format "perhaps ~A" caller
(lists->string form (cons 'append (map cadr (cdadr form))))))
@@ -7705,51 +7749,56 @@
(lint-format "10 is the default radix for number->string: ~A" caller (truncated-list->string form))))
(when (memq head '(reverse reverse!))
- (if (and (eq? head 'reverse!)
- (symbol? (cadr form)))
- (let ((v (var-member (cadr form) env)))
- (if (and (var? v)
- (eq? (var-definer v) 'parameter))
- (lint-format "if ~A (a function argument) is a pair, ~A is ill-advised" caller
- (cadr form)
- (truncated-list->string form))))
- (when (pair? (cadr form))
- (let ((arg (cadr form))
- (arg-op (caadr form))
- (arg-args (cdadr form))
- (arg-arg (and (pair? (cdadr form)) (cadadr form))))
- (when (and (pair? arg-args)
- (pair? arg-arg))
- (if (and (case arg-op
- ((cdr) (len=1? arg-args)) ; (reverse (cdr (reverse lst))) = all but last of lst -> copy to len-1
- ((list-tail) (len=2? arg-args))
- (else #f))
- (memq (car arg-arg) '(reverse reverse!))
- (pair? (cdr arg-arg))
- (symbol? (cadr arg-arg)))
- (lint-format "perhaps ~A" caller
- (lists->string form `(copy ,(cadr arg-arg)
- (make-list (- (length ,(cadr arg-arg)) ,(if (eq? arg-op 'cdr) 1 (cadr arg-args))))))))
-
- (if (and (eq? arg-op 'append) ; (reverse (append (reverse b) res)) = (append (reverse res) b)
- (eq? (car arg-arg) 'reverse)
- (len=1? (cdr arg-args)))
- (lint-format "perhaps ~A" caller (lists->string form `(append (reverse ,(cadr arg-args)) ,(cadr arg-arg))))))
-
- (when (and (= (length arg) 3)
- (pair? (cadr arg-args)))
- (cond ((and (eq? arg-op 'map) ; (reverse (map abs (sort! x <))) -> (map abs (sort! x >))
- (eq? (caadr arg-args) 'sort!)
- (len=2? (cdadr arg-args))
- (hash-table-ref reversibles (caddr (cadr arg-args))))
- => (lambda (op)
- (lint-format "possibly ~A" caller (lists->string form `(,arg-op ,arg-arg (sort! ,(cadadr arg-args) ,op)))))))
- ;; (reverse (apply vector (sort! x <))) doesn't happen (nor does this map case, but it's too pretty to leave out)
-
- (if (and (eq? arg-op 'cons) ; (reverse (cons x (reverse lst))) -- adds x to end -- (append lst (list x))
- (memq (caadr arg-args) '(reverse reverse!))
- (len=1? (cdadr arg-args)))
- (lint-format "perhaps ~A" caller (lists->string form `(append ,(cadadr arg-args) (list ,arg-arg))))))))))))
+ (if (eq? head 'reverse!)
+ (if (symbol? (cadr form))
+ (let ((v (var-member (cadr form) env)))
+ (if (and v
+ (eq? (var-definer v) 'parameter))
+ (lint-format "if ~A (a function argument) is a pair, ~A is ill-advised" caller
+ (cadr form)
+ (truncated-list->string form))))
+ (if (code-constant? (cadr form))
+ (lint-format "~A is a constant, so ~A is problematic" caller
+ (cadr form)
+ (truncated-list->string form)))))
+
+ (when (pair? (cadr form))
+ (let ((arg (cadr form))
+ (arg-op (caadr form))
+ (arg-args (cdadr form))
+ (arg-arg (and (pair? (cdadr form)) (cadadr form))))
+ (when (and (pair? arg-args)
+ (pair? arg-arg))
+ (if (and (case arg-op
+ ((cdr) (len=1? arg-args)) ; (reverse (cdr (reverse lst))) = all but last of lst -> copy to len-1
+ ((list-tail) (len=2? arg-args))
+ (else #f))
+ (memq (car arg-arg) '(reverse reverse!))
+ (pair? (cdr arg-arg))
+ (symbol? (cadr arg-arg)))
+ (lint-format "perhaps ~A" caller
+ (lists->string form `(copy ,(cadr arg-arg)
+ (make-list (- (length ,(cadr arg-arg)) ,(if (eq? arg-op 'cdr) 1 (cadr arg-args))))))))
+
+ (if (and (eq? arg-op 'append) ; (reverse (append (reverse b) res)) = (append (reverse res) b)
+ (eq? (car arg-arg) 'reverse)
+ (len=1? (cdr arg-args)))
+ (lint-format "perhaps ~A" caller (lists->string form `(append (reverse ,(cadr arg-args)) ,(cadr arg-arg))))))
+
+ (when (and (= (length arg) 3)
+ (pair? (cadr arg-args)))
+ (cond ((and (eq? arg-op 'map) ; (reverse (map abs (sort! x <))) -> (map abs (sort! x >))
+ (eq? (caadr arg-args) 'sort!)
+ (len=2? (cdadr arg-args))
+ (hash-table-ref reversibles (caddr (cadr arg-args))))
+ => (lambda (op)
+ (lint-format "possibly ~A" caller (lists->string form `(,arg-op ,arg-arg (sort! ,(cadadr arg-args) ,op)))))))
+ ;; (reverse (apply vector (sort! x <))) doesn't happen (nor does this map case, but it's too pretty to leave out)
+
+ (if (and (eq? arg-op 'cons) ; (reverse (cons x (reverse lst))) -- adds x to end -- (append lst (list x))
+ (memq (caadr arg-args) '(reverse reverse!))
+ (len=1? (cdadr arg-args)))
+ (lint-format "perhaps ~A" caller (lists->string form `(append ,(cadadr arg-args) (list ,arg-arg)))))))))))
(for-each (lambda (f)
(hash-special f sp-reverse))
@@ -7830,538 +7879,629 @@
;; ---------------- string-append ----------------
(let ()
- (define (sp-string-append caller head form env)
- (unless (= line-number last-checker-line-number)
- (let ((args (remove-all "" (splice-if 'string-append (cdr form))))
- (combined #f))
- (when (any? (lambda (s)
- (or (string? s)
- (and (pair? s)
- (memq (car s) '(string apply)))))
- args)
- (do ((nargs ()) ; look for (string...) (string...) in the arg list and combine
- (p args (cdr p)))
- ((null? p)
- (set! args (reverse nargs)))
- (let ((arg (car p)))
- (cond ((and (len=3? arg) ; (string-append (apply string-append strs) str) -> (string-append (apply values strs) str)
- (eq? (car arg) 'apply) ; unfortunately the values version is only slightly faster
- (eq? (cadr arg) 'string-append))
- (set! nargs (cons (list 'apply 'values (caddr arg)) nargs)))
-
- ((not (pair? (cdr p)))
- (set! nargs (cons arg nargs)))
-
- ((and (pair? arg)
- (eq? (car arg) 'string)
- (pair? (cadr p))
- (eq? (caadr p) 'string))
- (set! nargs (cons (cons 'string (append (cdr arg) (cdadr p))) nargs))
- (set! combined #t)
- (set! p (cdr p)))
-
- ((and (string? arg)
- (string? (cadr p)))
- (set! nargs (cons (string-append arg (cadr p)) nargs))
- (set! combined #t)
- (set! p (cdr p)))
-
- (else (set! nargs (cons (car p) nargs)))))))
-
- ;; (if ... "" ...) as arg split out got a couple dozen hits but we still need copy for the "" branch, so it's not much better
-
- (cond ((null? args) ; (string-append) -> ""
- (lint-format "perhaps ~A" caller (lists->string form "")))
-
- ((null? (cdr args)) ; (string-append a) -> a
- (if (not (tree-memq 'values (cdr form)))
- (lint-format "perhaps ~A~A" caller (lists->string form (car args))
- (if combined "" ", or use copy")))) ; (string-append x "") appears to be a common substitute for string-copy
-
- ((every? string? args) ; (string-append "a" "b") -> "ab"
- (lint-format "perhaps ~A" caller (lists->string form (apply string-append args))))
-
- ((every? (lambda (a) ; (string-append "a" (string #\b)) -> "ab"
- (or (string? a)
- (and (pair? a)
- (eq? (car a) 'string)
- (or (null? (cdr a))
- (char? (cadr a))))))
- args)
- (catch #t
- (lambda () ; (string-append (string #\C) "ZLl*()def") -> "CZLl*()def"
- (let ((val (if (not (any? pair? args))
- (apply string-append args)
- (eval (cons 'string-append args)))))
- (lint-format "perhaps ~A -> ~S" caller (truncated-list->string form) val)))
- (lambda args #f)))
-
- ((every? (lambda (c) ; (string-append (make-string 3 #\a) (make-string 2 #\b)) -> (format #f "~NC~NC" 3 #\a 2 #\b)
- (and (len>2? c)
- (eq? (car c) 'make-string)))
- (cdr form))
- (lint-format "perhaps ~A" caller
- (lists->string form
- `(format #f ,(apply string-append (make-list (abs (length (cdr form))) "~NC"))
- ,@(map (lambda (c) (values (cadr c) (caddr c))) (cdr form))))))
-
- ((not (equal? args (cdr form))) ; (string-append x (string-append y z)) -> (string-append x y z)
- (lint-format "perhaps ~A" caller (lists->string form (cons 'string-append args)))))
- (set! last-checker-line-number line-number))))
- (hash-special 'string-append sp-string-append))
+ (define (sp-string-append caller head form env)
+ (unless (= line-number last-checker-line-number)
+ (let ((args (remove-all "" (splice-if 'string-append (cdr form))))
+ (combined #f))
+ (when (lint-any? (lambda (s)
+ (or (string? s)
+ (and (pair? s)
+ (memq (car s) '(string apply)))))
+ args)
+ (do ((nargs ()) ; look for (string...) (string...) in the arg list and combine
+ (p args (cdr p)))
+ ((null? p)
+ (set! args (reverse nargs)))
+ (let ((arg (car p)))
+ (cond ((and (len=3? arg) ; (string-append (apply string-append strs) str) -> (string-append (apply values strs) str)
+ (eq? (car arg) 'apply) ; unfortunately the values version is only slightly faster
+ (eq? (cadr arg) 'string-append))
+ (set! nargs (cons (list 'apply 'values (caddr arg)) nargs)))
+
+ ((not (pair? (cdr p)))
+ (set! nargs (cons arg nargs)))
+
+ ((and (pair? arg)
+ (eq? (car arg) 'string)
+ (pair? (cadr p))
+ (eq? (caadr p) 'string))
+ (set! nargs (cons (cons 'string (append (cdr arg) (cdadr p))) nargs))
+ (set! combined #t)
+ (set! p (cdr p)))
+
+ ((and (string? arg)
+ (string? (cadr p)))
+ (set! nargs (cons (string-append arg (cadr p)) nargs))
+ (set! combined #t)
+ (set! p (cdr p)))
+
+ (else (set! nargs (cons (car p) nargs)))))))
+
+ ;; (if ... "" ...) as arg split out got a couple dozen hits but we still need copy for the "" branch, so it's not much better
+
+ (cond ((null? args) ; (string-append) -> ""
+ (lint-format "perhaps ~A" caller (lists->string form "")))
+
+ ((null? (cdr args)) ; (string-append a) -> a
+ (if (not (tree-memq 'values (cdr form)))
+ (lint-format "perhaps ~A~A" caller (lists->string form (car args))
+ (if combined "" ", or use copy")))) ; (string-append x "") appears to be a common substitute for string-copy
+
+ ((lint-every? string? args) ; (string-append "a" "b") -> "ab"
+ (lint-format "perhaps ~A" caller (lists->string form (apply string-append args))))
+
+ ((lint-every? (lambda (a) ; (string-append "a" (string #\b)) -> "ab"
+ (or (string? a)
+ (and (pair? a)
+ (eq? (car a) 'string)
+ (or (null? (cdr a))
+ (char? (cadr a))))))
+ args)
+ (catch #t
+ (lambda () ; (string-append (string #\C) "ZLl*()def") -> "CZLl*()def"
+ (let ((val (if (not (lint-any? pair? args))
+ (apply string-append args)
+ (eval (cons 'string-append args)))))
+ (lint-format "perhaps ~A -> ~S" caller (truncated-list->string form) val)))
+ (lambda args #f)))
+
+ ((lint-every? (lambda (c) ; (string-append (make-string 3 #\a) (make-string 2 #\b)) -> (format #f "~NC~NC" 3 #\a 2 #\b)
+ (and (len>2? c)
+ (eq? (car c) 'make-string)))
+ (cdr form))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ `(format #f ,(apply string-append (make-list (abs (length (cdr form))) "~NC"))
+ ,@(map (lambda (c) (values (cadr c) (caddr c))) (cdr form))))))
+
+ ((not (equal? args (cdr form))) ; (string-append x (string-append y z)) -> (string-append x y z)
+ (lint-format "perhaps ~A" caller (lists->string form (cons 'string-append args)))))
+ (set! last-checker-line-number line-number))))
+ (hash-special 'string-append sp-string-append))
;; ---------------- vector-append ----------------
(let ()
- (define (sp-vector-append caller head form env)
- (unless (= line-number last-checker-line-number)
- (let ((args (map (lambda (v)
- (if (and (len=3? v)
- (eq? (car v) 'apply)
- (eq? (cadr v) 'vector-append))
- (list 'apply 'values (caddr v))
- v))
- (remove-all #() (splice-if 'vector-append (cdr form))))))
- (cond ((null? args) ; (vector-append) -> #()
- (lint-format "perhaps ~A" caller (lists->string form #())))
-
- ((null? (cdr args)) ; (vector-append x) -> (copy x)
- (lint-format "perhaps ~A" caller (lists->string form (list 'copy (car args)))))
-
- ((every? vector? args) ; (vector-append #(1 2) (vector-append #(3))) -> #(1 2 3)
- (lint-format "perhaps ~A" caller (lists->string form (apply vector-append args))))
-
- ((not (equal? args (cdr form))) ; (vector-append x (vector-append y z)) -> (vector-append x y z)
- (lint-format "perhaps ~A" caller (lists->string form (cons 'vector-append args)))))
- (set! last-checker-line-number line-number))))
- (hash-special 'vector-append sp-vector-append))
+ (define (sp-vector-append caller head form env)
+ (unless (= line-number last-checker-line-number)
+ (let ((args (map (lambda (v)
+ (if (and (len=3? v)
+ (eq? (car v) 'apply)
+ (eq? (cadr v) 'vector-append))
+ (list 'apply 'values (caddr v))
+ v))
+ (remove-all #() (splice-if 'vector-append (cdr form))))))
+ (cond ((null? args) ; (vector-append) -> #()
+ (lint-format "perhaps ~A" caller (lists->string form #())))
+
+ ((null? (cdr args)) ; (vector-append x) -> (copy x)
+ (lint-format "perhaps ~A" caller (lists->string form (list 'copy (car args)))))
+
+ ((lint-every? vector? args) ; (vector-append #(1 2) (vector-append #(3))) -> #(1 2 3)
+ (lint-format "perhaps ~A" caller (lists->string form (apply vector-append args))))
+
+ ((not (equal? args (cdr form))) ; (vector-append x (vector-append y z)) -> (vector-append x y z)
+ (lint-format "perhaps ~A" caller (lists->string form (cons 'vector-append args)))))
+ (set! last-checker-line-number line-number))))
+ (hash-special 'vector-append sp-vector-append))
;; ---------------- cons ----------------
(let ()
- (define (sp-cons caller head form env)
- (when (and (= (length form) 3)
- (not (= last-cons-line-number line-number)))
- (if (any-null? (caddr form)) ; (cons x '()) -> (list x)
- (lint-format "perhaps ~A" caller (lists->string form (list 'list (cadr form))))
-
- (when (pair? (caddr form))
- (let ((op (caaddr form)))
-
- (cond ((or (eq? op 'list) ; (cons x (list ...)) -> (list x ...)
- (and (eq? op #_list-values)
- (not (tree-member #_apply-values (cdaddr form)))))
- (lint-format "perhaps ~A" caller (lists->string form (cons 'list (cons (cadr form) (unlist-values (cdaddr form)))))))
-
- ((and (pair? (cadr form)) ; (cons (car x) (cdr x)) -> (copy x)
- (let ((x (assq (caadr form) ; but if cdr is a pair, copy is more expensive and slightly different
- '((car cdr #t)
- (caar cdar car) (cadr cddr cdr)
- (caaar cdaar caar) (caadr cdadr cadr) (caddr cdddr cddr) (cadar cddar cdar)
- (cadddr cddddr cdddr) (caaaar cdaaar caaar) (caaadr cdaadr caadr) (caadar cdadar cadar)
- (caaddr cdaddr caddr) (cadaar cddaar cdaar) (cadadr cddadr cdadr) (caddar cdddar cddar)))))
- (and x
- (eq? (cadr x) op)
- (caddr x))))
- => (lambda (cfunc)
- (if (and cfunc
- (equal? (cadadr form) (cadr (caddr form)))
- (not (side-effect? (cadadr form) env)))
- (lint-format "possibly ~A" caller
- (lists->string form
- (list 'copy
- (if (symbol? cfunc)
- (list cfunc (cadadr form))
- (cadadr form))))))))
- (else
- (case op
- ((cons) ; list handled above
+ (define (sp-cons caller head form env)
+ (when (and (= (length form) 3)
+ (not (= last-cons-line-number line-number)))
+ (if (any-null? (caddr form)) ; (cons x '()) -> (list x)
+ (lint-format "perhaps ~A" caller (lists->string form (list 'list (cadr form))))
+
+ (when (pair? (caddr form))
+ (let ((op (caaddr form)))
+
+ (cond ((or (eq? op 'list) ; (cons x (list ...)) -> (list x ...)
+ (and (eq? op 'list-values)
+ (not (tree-memq 'apply-values (cdaddr form)))))
+ (lint-format "perhaps ~A" caller (lists->string form (cons 'list (cons (cadr form) (unlist-values (cdaddr form)))))))
+
+ ((and (pair? (cadr form)) ; (cons (car x) (cdr x)) -> (copy x)
+ (let ((x (assq (caadr form) ; but if cdr is a pair, copy is more expensive and slightly different
+ '((car cdr #t)
+ (caar cdar car) (cadr cddr cdr)
+ (caaar cdaar caar) (caadr cdadr cadr) (caddr cdddr cddr) (cadar cddar cdar)
+ (cadddr cddddr cdddr) (caaaar cdaaar caaar) (caaadr cdaadr caadr) (caadar cdadar cadar)
+ (caaddr cdaddr caddr) (cadaar cddaar cdaar) (cadadr cddadr cdadr) (caddar cdddar cddar)))))
+ (and x
+ (eq? (cadr x) op)
+ (caddr x))))
+ => (lambda (cfunc)
+ (if (and cfunc
+ (equal? (cadadr form) (cadr (caddr form)))
+ (not (side-effect? (cadadr form) env)))
+ (lint-format "possibly ~A" caller
+ (lists->string form
+ (list 'copy
+ (if (symbol? cfunc)
+ (list cfunc (cadadr form))
+ (cadadr form))))))))
+ (else
+ (case op
+ ((cons) ; list handled above
; (cons a (cons b (cons ...))) -> (list a b ...), input ending in nil of course
- (let loop ((args (list (cadr form))) (chain (caddr form)))
- (if (pair? chain)
- (if (eq? (car chain) 'list)
- (begin
- (lint-format "perhaps ~A" caller
- (lists->string form
- (cons 'list (append (reverse args) (cdr chain)))))
- (set! last-cons-line-number line-number))
- (if (and (eq? (car chain) 'cons)
- (len>1? (cdr chain)))
- (if (any-null? (caddr chain))
- (begin
- (lint-format "perhaps ~A" caller (lists->string form `(list ,@(reverse args) ,(cadr chain))))
- (set! last-cons-line-number line-number))
- (if (and (pair? (caddr chain))
- (memq (caaddr chain) '(cons list)))
- (loop (cons (cadr chain) args) (caddr chain)))))))))
-
- ((else)
- (lint-format "else (as car of second argument to cons) makes no sense: ~A" caller form))))))))))
-
- (hash-special 'cons sp-cons))
+ (let loop ((args (list (cadr form))) (chain (caddr form)))
+ (if (pair? chain)
+ (if (eq? (car chain) 'list)
+ (begin
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (cons 'list (append (reverse args) (cdr chain)))))
+ (set! last-cons-line-number line-number))
+ (if (and (eq? (car chain) 'cons)
+ (len>1? (cdr chain)))
+ (if (any-null? (caddr chain))
+ (begin
+ (lint-format "perhaps ~A" caller (lists->string form `(list ,@(reverse args) ,(cadr chain))))
+ (set! last-cons-line-number line-number))
+ (if (and (pair? (caddr chain))
+ (memq (caaddr chain) '(cons list)))
+ (loop (cons (cadr chain) args) (caddr chain)))))))))
+
+ ((else)
+ (lint-format "else (as car of second argument to cons) makes no sense: ~A" caller form))))))))))
+
+ (hash-special 'cons sp-cons))
;; ---------------- append ----------------
(let ()
- (define (sp-append caller head form env)
- (unless (= line-number last-checker-line-number)
- (set! last-checker-line-number line-number)
- (letrec ((splice-append (lambda (lst)
- (cond ((null? lst)
- ())
-
- ((not (pair? lst))
- lst)
-
- ((and (pair? (car lst))
- (eq? (caar lst) 'append)
- (proper-list? (cdar lst))) ; for append below
- (if (null? (cdar lst)) ; (append) at end -> () to keep copy intact?
- (case (cdr lst) ((()) (list ())) (else => splice-append))
- (append (splice-append (cdar lst))
- (splice-append (cdr lst)))))
-
- ((and (len=2? (car lst))
- (eq? (caar lst) 'copy)
- (pair? (cdr lst)))
- (cons (cadar lst) (splice-append (cdr lst))))
-
- ((and (len=3? (car lst)) ; (append (apply append x)...) -> (append (apply values x)...)
- (eq? (caar lst) 'apply)
- (memq (cadar lst) '(append string-append vector-append)))
- (cons (list 'apply 'values (caddar lst))
- (splice-append (cdr lst))))
-
- ((or (null? (cdr lst))
- (not (or (any-null? (car lst))
- (and (len=1? (car lst))
- (eq? (caar lst) 'list)))))
- (cons (car lst)
- (splice-append (cdr lst))))
-
- (else (splice-append (cdr lst)))))))
-
- (let ((new-args (splice-append (cdr form)))) ; (append '(1) (append '(2) '(3))) -> (append '(1) '(2) '(3))
- (let ((len1 (length new-args))
- (suggestion made-suggestion)
- (append->list (lambda items
- (let ((lst (list 'list)))
- (for-each
- (lambda (item)
- (set! lst (append lst (if (eq? (car item) 'list)
- (cdr item)
- ((if (eq? (car item) 'cons) list distribute-quote)
- (cadr item))))))
- 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))))
-
- (if (positive? len1)
- (let ((last (list-ref new-args (- len1 1))))
- ;; (define (f) (append '(1) '(2))) (define a (f)) (set! (a 1) 32) (f) -> '(1 32)
- (if (quoted-pair? last)
- (lint-format "append does not copy its last argument, so ~A is dangerous" caller
- (truncated-list->string form)))))
-
- (case len1
- ((0) ; (append) -> ()
- (lint-format "perhaps ~A" caller (lists->string form ())))
- ((1) ; (append x) -> x
- (lint-format "perhaps ~A" caller (lists->string form (car new-args))))
- ((2) ; (append (list x) ()) -> (list x)
- (let ((arg2 (cadr new-args))
- (arg1 (car new-args)))
- (cond ((or (any-null? arg2)
- (equal? arg2 '(list))) ; (append x ()) -> (copy x)
- (lint-format "perhaps clearer: ~A" caller (lists->string form (list 'copy arg1))))
-
- ((null? arg1) ; (append () x) -> x
- (lint-format "perhaps ~A" caller (lists->string form arg2)))
-
- ((not (pair? arg1)))
-
- ((and (pair? arg2) ; (append (list x y) '(z)) -> (list x y z) or extensions thereof
- (or (eq? (car arg1) 'list)
- (and (eq? (car arg1) 'cons)
- (any-null? (caddr arg1)))
- (quoted-undotted-pair? arg1))
- (or (eq? (car arg2) 'list)
- (and (eq? (car arg2) 'cons)
- (len>1? (cdr arg2))
- (any-null? (caddr arg2)))
- (quoted-undotted-pair? arg2)))
- (lint-format "perhaps ~A" caller (lists->string form (apply append->list new-args))))
-
- ((and (eq? (car arg1) 'list) ; (append (list x) y) -> (cons x y)
- (len=1? (cdr arg1)))
- (lint-format "perhaps ~A" caller (lists->string form (list 'cons (cadr arg1) arg2))))
-
- ((eq? (car arg1) 'cons) ; (append (cons x y) z) -> (cons x z) or (cons z (append y z))
- (lint-format "perhaps ~A" caller ; append insists on proper lists, so this should be equivalent
- (lists->string form
- (if (any-null? (caddr arg1))
- (list 'cons (cadr arg1) arg2)
- `(cons ,(cadr arg1) (append ,(caddr arg1) ,arg2))))))
-
- ((and (eq? (car arg1) 'list) ; (append (list x y) z) -> (cons x (cons y z))
- (len=2? (cdr arg1)))
- (lint-format "perhaps ~A" caller (lists->string form `(cons ,(cadr arg1) (cons ,(caddr arg1) ,arg2)))))
-
- ;; not sure about this: reports the un-qq'd form
- ((and (eq? (car arg1) #_list-values)
- (not (qq-tree? arg1)))
- (set! last-checker-line-number -1)
- (sp-append caller 'append (list 'append (unlist-values arg1) arg2) env))
-
- ((and (eq? (car arg1) 'vector->list)
- (pair? arg2)
- (eq? (car arg2) 'vector->list))
- (lint-format "perhaps ~A" caller (lists->string form (list 'vector->list (list 'append (cadr arg1) (cadr arg2))))))
-
- ((and (quoted-pair? arg1) ; (append '(x) y) -> (cons 'x y)
- (null? (cdadr arg1)))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (if (or (symbol? (caadr arg1))
- (pair? (caadr arg1)))
- `(cons ',(caadr arg1) ,arg2)
- (list 'cons (caadr arg1) arg2)))))
-
- ((not (equal? (cdr form) new-args)) ; (append () '(1 2) 1) -> (append '(1 2) 1)
- (lint-format "perhaps ~A" caller (lists->string form (cons 'append new-args)))))))
- (else
- (cond ((every? (lambda (item)
- (and (pair? item)
- (or (eq? (car item) 'list)
- (and (eq? (car item) 'cons)
- (len>1? (cdr item))
- (any-null? (caddr item)))
- (quoted-undotted-pair? item))))
- new-args) ; (append '(1) (append '(2) '(3)) '(4)) -> (list 1 2 3 4)
- (lint-format "perhaps ~A" caller (lists->string form (apply append->list new-args))))
-
- ((and (len=2? (car new-args)) ; (append (list x) y (list z)) -> (cons x (append y (list z)))?
- (eq? (caar new-args) 'list))
- (lint-format "perhaps ~A" caller (lists->string form `(cons ,(cadar new-args) (append ,@(cdr new-args))))))
-
- ((and (pair? (car new-args))
- (eq? (caar new-args) 'cons))
- (lint-format "perhaps ~A" caller
- (lists->string form
- `(cons ,(cadar new-args) (append ,(caddar new-args) ,@(cdr new-args))))))
-
- ((let ((n-1 (list-ref new-args (- len1 2))))
- (and (len=2? n-1)
- (eq? (car n-1) 'list))) ; (append x (list y) z) -> (append x (cons y z))
- (lint-format "perhaps ~A" caller
- (lists->string form
- `(append ,@(copy new-args (make-list (- len1 2)))
- (cons ,(cadr (list-ref new-args (- len1 2)))
- ,(list-ref new-args (- len1 1)))))))
-
- ((not (equal? (cdr form) new-args)) ; (append x y (append)) -> (append x y ())
- (lint-format "perhaps ~A" caller (lists->string form (cons 'append new-args)))))))
-
- (if (and (= made-suggestion suggestion)
- (not (equal? (cdr form) new-args)))
- (lint-format "perhaps ~A" caller (lists->string form (cons 'append new-args)))))))))
- (hash-special 'append sp-append))
-
+ (define (sp-append caller head form env)
+ (unless (= line-number last-checker-line-number)
+ (set! last-checker-line-number line-number)
+ (letrec ((splice-append (lambda (lst)
+ (cond ((null? lst)
+ ())
+
+ ((not (pair? lst))
+ lst)
+
+ ((and (pair? (car lst))
+ (eq? (caar lst) 'append)
+ (proper-list? (cdar lst))) ; for append below
+ (if (null? (cdar lst)) ; (append) at end -> () to keep copy intact?
+ (case (cdr lst) ((()) => list) (else => splice-append))
+ (append (splice-append (cdar lst))
+ (splice-append (cdr lst)))))
+
+ ((and (len=2? (car lst))
+ (eq? (caar lst) 'copy)
+ (pair? (cdr lst)))
+ (cons (cadar lst) (splice-append (cdr lst))))
+
+ ((and (len=3? (car lst)) ; (append (apply append x)...) -> (append (apply values x)...)
+ (eq? (caar lst) 'apply)
+ (memq (cadar lst) '(append string-append vector-append)))
+ (cons (list 'apply 'values (caddar lst))
+ (splice-append (cdr lst))))
+
+ ((or (null? (cdr lst))
+ (not (or (any-null? (car lst))
+ (and (len=1? (car lst))
+ (eq? (caar lst) 'list)))))
+ (cons (car lst)
+ (splice-append (cdr lst))))
+
+ (else (splice-append (cdr lst)))))))
+
+ (let ((new-args (splice-append (cdr form)))) ; (append '(1) (append '(2) '(3))) -> (append '(1) '(2) '(3))
+ (let ((len1 (length new-args))
+ (suggestion made-suggestion)
+ (append->list (lambda items
+ (let ((lst (list 'list)))
+ (for-each
+ (lambda (item)
+ (set! lst (append lst (if (eq? (car item) 'list)
+ (cdr item)
+ ((if (eq? (car item) 'cons) list distribute-quote)
+ (cadr item))))))
+ 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))))
+
+ (if (positive? len1)
+ (let ((last (list-ref new-args (- len1 1))))
+ ;; (define (f) (append '(1) '(2))) (define a (f)) (set! (a 1) 32) (f) -> '(1 32)
+ (if (quoted-pair? last)
+ (lint-format "append does not copy its last argument, so ~A is dangerous" caller
+ (truncated-list->string form)))))
+
+ (case len1
+ ((0) ; (append) -> ()
+ (lint-format "perhaps ~A" caller (lists->string form ())))
+ ((1) ; (append x) -> x
+ (lint-format "perhaps ~A" caller (lists->string form (car new-args))))
+ ((2) ; (append (list x) ()) -> (list x)
+ (let ((arg2 (cadr new-args))
+ (arg1 (car new-args)))
+ (cond ((or (any-null? arg2)
+ (equal? arg2 '(list))) ; (append x ()) -> (copy x)
+ (lint-format "perhaps clearer: ~A" caller (lists->string form (list 'copy arg1))))
+
+ ((null? arg1) ; (append () x) -> x
+ (lint-format "perhaps ~A" caller (lists->string form arg2)))
+
+ ((not (pair? arg1)))
+
+ ((and (pair? arg2) ; (append (list x y) '(z)) -> (list x y z) or extensions thereof
+ (or (eq? (car arg1) 'list)
+ (and (eq? (car arg1) 'cons)
+ (any-null? (caddr arg1)))
+ (quoted-undotted-pair? arg1))
+ (or (eq? (car arg2) 'list)
+ (and (eq? (car arg2) 'cons)
+ (len>1? (cdr arg2))
+ (any-null? (caddr arg2)))
+ (quoted-undotted-pair? arg2)))
+ (lint-format "perhaps ~A" caller (lists->string form (apply append->list new-args))))
+
+ ((and (eq? (car arg1) 'list) ; (append (list x) y) -> (cons x y)
+ (len=1? (cdr arg1)))
+ (lint-format "perhaps ~A" caller (lists->string form (list 'cons (cadr arg1) arg2))))
+
+ ((eq? (car arg1) 'cons) ; (append (cons x y) z) -> (cons x z) or (cons z (append y z))
+ (lint-format "perhaps ~A" caller ; append insists on proper lists, so this should be equivalent
+ (lists->string form
+ (if (any-null? (caddr arg1))
+ (list 'cons (cadr arg1) arg2)
+ `(cons ,(cadr arg1) (append ,(caddr arg1) ,arg2))))))
+
+ ((and (eq? (car arg1) 'list) ; (append (list x y) z) -> (cons x (cons y z))
+ (len=2? (cdr arg1)))
+ (lint-format "perhaps ~A" caller (lists->string form `(cons ,(cadr arg1) (cons ,(caddr arg1) ,arg2)))))
+
+ ;; not sure about this: reports the un-qq'd form
+ ((and (eq? (car arg1) 'list-values)
+ (not (qq-tree? arg1)))
+ (set! last-checker-line-number -1)
+ (sp-append caller 'append (list 'append (unlist-values arg1) arg2) env))
+
+ ((and (eq? (car arg1) 'vector->list)
+ (pair? arg2)
+ (eq? (car arg2) 'vector->list))
+ (lint-format "perhaps ~A" caller (lists->string form (list 'vector->list (list 'append (cadr arg1) (cadr arg2))))))
+
+ ((and (quoted-pair? arg1) ; (append '(x) y) -> (cons 'x y)
+ (null? (cdadr arg1)))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (if (or (symbol? (caadr arg1))
+ (pair? (caadr arg1)))
+ `(cons ',(caadr arg1) ,arg2)
+ (list 'cons (caadr arg1) arg2)))))
+
+ ((not (equal? (cdr form) new-args)) ; (append () '(1 2) 1) -> (append '(1 2) 1)
+ (lint-format "perhaps ~A" caller (lists->string form (cons 'append new-args)))))))
+ (else
+ (cond ((lint-every? (lambda (item)
+ (and (pair? item)
+ (or (eq? (car item) 'list)
+ (and (eq? (car item) 'cons)
+ (len>1? (cdr item))
+ (any-null? (caddr item)))
+ (quoted-undotted-pair? item))))
+ new-args) ; (append '(1) (append '(2) '(3)) '(4)) -> (list 1 2 3 4)
+ (lint-format "perhaps ~A" caller (lists->string form (apply append->list new-args))))
+
+ ((and (len=2? (car new-args)) ; (append (list x) y (list z)) -> (cons x (append y (list z)))?
+ (eq? (caar new-args) 'list))
+ (lint-format "perhaps ~A" caller (lists->string form `(cons ,(cadar new-args) (append ,@(cdr new-args))))))
+
+ ((and (pair? (car new-args))
+ (eq? (caar new-args) 'cons))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ `(cons ,(cadar new-args) (append ,(caddar new-args) ,@(cdr new-args))))))
+
+ ((let ((n-1 (list-ref new-args (- len1 2))))
+ (and (len=2? n-1)
+ (eq? (car n-1) 'list))) ; (append x (list y) z) -> (append x (cons y z))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ `(append ,@(copy new-args (make-list (- len1 2)))
+ (cons ,(cadr (list-ref new-args (- len1 2)))
+ ,(list-ref new-args (- len1 1)))))))
+
+ ((not (equal? (cdr form) new-args)) ; (append x y (append)) -> (append x y ())
+ (lint-format "perhaps ~A" caller (lists->string form (cons 'append new-args)))))))
+
+ (if (and (= made-suggestion suggestion)
+ (not (equal? (cdr form) new-args)))
+ (lint-format "perhaps ~A" caller (lists->string form (cons 'append new-args)))))))))
+ (hash-special 'append sp-append))
+
;; ---------------- apply ----------------
(let ()
- (define (sp-apply caller head form env)
- (when (pair? (cdr form))
- (let ((len (length form))
- (suggestion made-suggestion))
- (if (= len 2) ; (apply f) -> (f)
- (lint-format "perhaps ~A" caller (lists->string form (list (cadr form))))
- (if (not (or (<= len 2) ; it might be (apply)...
- (symbol? (cadr form))
- (applicable? (cadr form))))
- (lint-format "~S is not applicable: ~A" caller (cadr form) (truncated-list->string form))
- (let ((happy #f)
- (f (cadr form)))
- (unless (or (<= len 2)
- (any-macro? f env)
- (eq? f 'macroexpand)) ; handled specially (syntactic, not a macro)
-
- (when (and (symbol? f)
- (not (var-member f env)))
- (let ((func (symbol->value f *e*)))
- (if (procedure? func)
- (let ((ary (arity func)))
- (when (pair? ary) ; (apply real? 1 3 rest)
- (if (> (- len 3) (cdr ary)) ; last apply arg might be var=()
- (lint-format "too many arguments for ~A: ~A" caller f form))
- (if (and (= len 3)
- (= (car ary) 1)
- (= (cdr ary) 1)) ; (apply car x) -> (car (car x))
- (lint-format "perhaps ~A" caller (lists->string form (list f (list 'car (caddr form)))))))))))
-
- (let ((last-arg (form (- len 1))))
- (if (and (not (list? last-arg))
- (code-constant? last-arg)) ; (apply + 1)
- (lint-format "last argument should be a list: ~A" caller (truncated-list->string form))
- (if (= len 3)
- (let ((args (caddr form))
- (cdr-args (and (pair? (caddr form)) (cdaddr form))))
- (if (identity? f) ; (apply (lambda (x) x) y) -> (car y)
- (lint-format "perhaps (assuming ~A is a list of one element) ~A" caller args
- (lists->string form (list 'car args)))
- (if (simple-lambda? f) ; (apply (lambda (x) (f x)) y) -> (f (car y))
- (lint-format "perhaps (assuming ~A is a list of one element) ~A" caller args
- (lists->string form (tree-subst (list 'car args) (caadr f) (caddr f))))))
-
- (cond ((eq? f 'list) ; (apply list x) -> x?
- (lint-format "perhaps ~A" caller (lists->string form args)))
-
- ((any-null? args) ; (apply f ()) -> (f)
- (lint-format "perhaps ~A" caller (lists->string form (list f))))
-
- ((or (not (pair? args))
- (case (car args)
- ((list) ; (apply f (list a b)) -> (f a b)
- (lint-format "perhaps ~A" caller (lists->string form (cons f cdr-args))))
-
- ((quote) ; (apply eq? '(a b)) -> (eq? 'a 'b)
- (and (pair? cdr-args)
- (pair? (car cdr-args))
- (lint-format "perhaps ~A" caller
- (lists->string form (cons f (distribute-quote (car cdr-args)))))))
-
- ((cons cons*) ; (apply f (cons a b)) -> (apply f a b)
- (lint-format "perhaps ~A" caller
- (lists->string form
- (if (and (len>1? cdr-args)
- (len>1? (cadr cdr-args))
- (eq? (caadr cdr-args) 'cons))
- `(apply ,f ,(car cdr-args) ,@(cdadr cdr-args))
- (cons 'apply (cons f cdr-args))))))
-
- ((append) ; (apply f (append (list ...)...)) -> (apply f ... ...)
- (and (pair? cdr-args)
- (pair? (car cdr-args))
- (eq? (caar cdr-args) 'list)
- (lint-format "perhaps ~A" caller
- (lists->string form `(apply ,f ,@(cdar cdr-args)
- ,(if (not (pair? (cdr cdr-args)))
- (cdr cdr-args)
- (if (null? (cddr cdr-args))
- (cadr cdr-args)
- (cons 'append (cdr cdr-args)))))))))
-
- ((reverse reverse!) ; (apply vector (reverse x)) -> (reverse (apply vector x))
- (and (memq f '(string vector int-vector float-vector))
- (pair? cdr-args)
+ (define (sp-apply caller head form env)
+ (when (pair? (cdr form))
+ (let ((len (length form))
+ (suggestion made-suggestion))
+ (if (= len 2) ; (apply f) -> (f)
+ (lint-format "perhaps ~A" caller (lists->string form (list (cadr form))))
+ (if (not (or (<= len 2) ; it might be (apply)...
+ (symbol? (cadr form))
+ (applicable? (cadr form))))
+ (lint-format "~S is not applicable: ~A" caller (cadr form) (truncated-list->string form))
+ (let ((f (cadr form)))
+ (unless (or (<= len 2)
+ (any-macro? f env)
+ (eq? f 'macroexpand)) ; handled specially (syntactic, not a macro)
+
+ (when (and (symbol? f)
+ (not (var-member f env)))
+ (let ((func (symbol->value f *e*)))
+ (if (procedure? func)
+ (let ((ary (arity func)))
+ (when (pair? ary) ; (apply real? 1 3 rest)
+ (if (> (- len 3) (cdr ary)) ; last apply arg might be var=()
+ (lint-format "too many arguments for ~A: ~A" caller f form))
+ (if (and (= len 3)
+ (= (car ary) 1)
+ (= (cdr ary) 1)) ; (apply car x) -> (car (car x))
+ (lint-format "perhaps ~A" caller (lists->string form (list f (list 'car (caddr form)))))))))))
+
+ (let ((happy #f)
+ (last-arg (form (- len 1))))
+ (if (and (not (list? last-arg))
+ (code-constant? last-arg)) ; (apply + 1)
+ (lint-format "last argument should be a list: ~A" caller (truncated-list->string form))
+ (if (= len 3)
+ (let ((args (caddr form))
+ (cdr-args (and (pair? (caddr form)) (cdaddr form))))
+ (if (identity? f) ; (apply (lambda (x) x) y) -> (car y)
+ (lint-format "perhaps (assuming ~A is a list of one element) ~A" caller args
+ (lists->string form (list 'car args)))
+ (if (simple-lambda? f) ; (apply (lambda (x) (f x)) y) -> (f (car y))
+ (lint-format "perhaps (assuming ~A is a list of one element) ~A" caller args
+ (lists->string form (tree-subst (list 'car args) (caadr f) (caddr f))))))
+
+ (cond ((eq? f 'list) ; (apply list x) -> x?
+ (lint-format "perhaps ~A" caller (lists->string form args)))
+
+ ((any-null? args) ; (apply f ()) -> (f)
+ (lint-format "perhaps ~A" caller (lists->string form (list f))))
+
+ ((or (not (pair? args))
+ (case (car args)
+ ((list) ; (apply f (list a b)) -> (f a b)
+ (lint-format "perhaps ~A" caller (lists->string form (cons f cdr-args))))
+
+ ((quote) ; (apply eq? '(a b)) -> (eq? 'a 'b)
+ (and (pair? cdr-args)
+ (pair? (car cdr-args))
+ (lint-format "perhaps ~A" caller
+ (lists->string form (cons f (distribute-quote (car cdr-args)))))))
+
+ ((cons cons*) ; (apply f (cons a b)) -> (apply f a b)
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (if (and (len>1? cdr-args)
+ (len>1? (cadr cdr-args))
+ (eq? (caadr cdr-args) 'cons))
+ `(apply ,f ,(car cdr-args) ,@(cdadr cdr-args))
+ (cons 'apply (cons f cdr-args))))))
+
+ ((append) ; (apply f (append (list ...)...)) -> (apply f ... ...)
+ (and (pair? cdr-args)
+ (pair? (car cdr-args))
+ (eq? (caar cdr-args) 'list)
+ (lint-format "perhaps ~A" caller
+ (lists->string form `(apply ,f ,@(cdar cdr-args)
+ ,(if (not (pair? (cdr cdr-args)))
+ (cdr cdr-args)
+ (if (null? (cddr cdr-args))
+ (cadr cdr-args)
+ (cons 'append (cdr cdr-args)))))))))
+
+ ((reverse reverse!) ; (apply vector (reverse x)) -> (reverse (apply vector x))
+ (and (memq f '(string vector int-vector float-vector))
+ (pair? cdr-args)
+ (lint-format "perhaps ~A" caller
+ (lists->string form (list 'reverse (list 'apply f (car cdr-args)))))))
+
+ ((make-list) ; (apply string (make-list x y)) -> (make-string x y)
+ (if (memq f '(string vector))
(lint-format "perhaps ~A" caller
- (lists->string form (list 'reverse (list 'apply f (car cdr-args)))))))
-
- ((make-list) ; (apply string (make-list x y)) -> (make-string x y)
- (if (memq f '(string vector))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (cons (if (eq? f 'string) 'make-string 'make-vector)
- cdr-args)))))
-
- ((map)
- (case f
- ((string-append) ; (apply string-append (map ...))
- (if (eq? (car cdr-args) 'symbol->string)
- (lint-format "perhaps ~A" caller ; (apply string-append (map symbol->string ...))
- (lists->string form (list 'format #f "~{~A~}" (cadr cdr-args))))
- (if (simple-lambda? (car cdr-args))
- (let ((body (caddar cdr-args)))
- (if (and (len=3? body)
- (eq? (car body) 'string-append)
- (or (and (string? (cadr body))
- (eq? (caddr body) (caadar cdr-args)))
- (and (string? (caddr body))
- (eq? (cadr body) (caadar cdr-args)))))
- (let ((str (string-append "~{"
- (if (string? (cadr body)) (cadr body) "~A")
- (if (string? (caddr body)) (caddr body) "~A")
- "~}")))
- (lint-format "perhaps ~A" caller
- (lists->string form (list 'format #f str (cadr cdr-args))))))))))
-
- ((string) ; (apply string (map char-downcase x)) -> (string-downcase (apply string x))
- (if (memq (car cdr-args) '(char-upcase char-downcase))
- (lint-format "perhaps, assuming ~A is a list, ~A" caller (cadr cdr-args)
- (lists->string form (list (if (eq? (car cdr-args) 'char-upcase)
- 'string-upcase 'string-downcase)
- (list 'apply string (cadr cdr-args)))))))
-
- ((append) ; (apply append (map vector->list args)) -> (vector->list (apply append args))
- (and (eq? (car cdr-args) 'vector->list)
- (lint-format "perhaps ~A" caller (lists->string form `(vector->list (apply append ,@(cdr cdr-args)))))))
-
- (else #f)))
- ;; (apply append (map...)) is very common but changing it to
- ;; (map (lambda (x) (apply values (f x))) ...) from (apply append (map f ...))
- ;; is not an obvious win. The code is more complicated, and currently apply values
- ;; copies its args as do apply and append -- how many copies are there here?!
- ;; cursory timing tests indicate that (apply append ...) is faster
-
- ;; need to check for only one apply values
- ((#_list-values) ; (apply f `(,x , at z)) -> (apply f x z)
- (let ((last-arg (list-ref args (- (length args) 1))))
- (if (and (pair? last-arg)
- (eq? (car last-arg) #_apply-values)
- (tree-nonce #_apply-values args))
- (lint-format "perhaps ~A" caller
- (lists->string form
- `(apply ,f
- ,@(copy args (make-list (- (length args) 2)) 1)
- ,(cadr last-arg))))
- (if (not (tree-member #_apply-values cdr-args))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (cons f (unlist-values cdr-args)))))))))))))
- ;; len > 3
- (unless (hash-table-ref syntaces f) ; also not any-macro I presume
- (when (and (pair? last-arg)
- (eq? (car last-arg) 'list)) ; (apply f y z (list a b)) -> (f y z a b)
- (lint-format "perhaps ~A" caller
- (lists->string form
- (append (copy (cdr form) (make-list (- len 2)))
- (cdr last-arg)))))
- ;; can't cleanly go from (apply write o p) to (write o (car p)) since p can be ()
-
- (when (and (not happy)
- (any-null? last-arg)) ; (apply f ... ()) -> (f ...)
- (lint-format "perhaps ~A" caller (lists->string form (cons f (copy (cddr form) (make-list (- len 3)))))))))))))))
- (if (and (= suggestion made-suggestion)
- (symbol? (cadr form)))
- (let ((ary (arg-arity (cadr form) env)))
- (if (and (pair? ary) ; (apply make-string tcnt initializer) -> (make-string tcnt (car initializer))
- (= (car ary) (cdr ary)) ; else () as last, so can't suggest (car last)
- (= (cdr ary) (- len 2)))
- (lint-format "perhaps ~A" caller
- (lists->string form (append (copy (cdr form) (make-list (- len 2)))
- (list (list 'car (list-ref form (- len 1)))))))))))))
-
- (hash-special 'apply sp-apply))
-
+ (lists->string form
+ (cons (if (eq? f 'string) 'make-string 'make-vector)
+ cdr-args)))))
+
+ ((map)
+ (case f
+ ((string-append) ; (apply string-append (map ...))
+ (if (eq? (car cdr-args) 'symbol->string)
+ (lint-format "perhaps ~A" caller ; (apply string-append (map symbol->string ...))
+ (lists->string form (list 'format #f "~{~A~}" (cadr cdr-args))))
+ (if (simple-lambda? (car cdr-args))
+ (let ((body (caddar cdr-args)))
+ (if (and (len=3? body)
+ (eq? (car body) 'string-append)
+ (or (and (string? (cadr body))
+ (eq? (caddr body) (caadar cdr-args)))
+ (and (string? (caddr body))
+ (eq? (cadr body) (caadar cdr-args)))))
+ (let ((str (string-append "~{"
+ (if (string? (cadr body)) (cadr body) "~A")
+ (if (string? (caddr body)) (caddr body) "~A")
+ "~}")))
+ (lint-format "perhaps ~A" caller
+ (lists->string form (list 'format #f str (cadr cdr-args))))))))))
+
+ ((string) ; (apply string (map char-downcase x)) -> (string-downcase (apply string x))
+ (if (memq (car cdr-args) '(char-upcase char-downcase))
+ (lint-format "perhaps, assuming ~A is a list, ~A" caller (cadr cdr-args)
+ (lists->string form (list (if (eq? (car cdr-args) 'char-upcase)
+ 'string-upcase 'string-downcase)
+ (list 'apply string (cadr cdr-args)))))))
+
+ ((append) ; (apply append (map vector->list args)) -> (vector->list (apply append args))
+ (case (car cdr-args)
+ ((vector->list)
+ (lint-format "perhaps ~A" caller (lists->string form `(vector->list (apply append ,@(cdr cdr-args))))))
+ ((list) ; (apply append (map list args)) -> args
+ (lint-format "perhaps ~A" caller (lists->string form (cadr cdr-args))))))
+
+ (else #f)))
+ ;; (apply append (map f ...)) is very common but changing it to
+ ;; (map (lambda (x) (apply values (f x))) ...)
+ ;; is not an obvious win. The code is more complicated, and currently apply values
+ ;; copies its args as do apply and append -- how many copies are there here?!
+ ;; cursory timing tests indicate that (apply append ...) is faster
+
+ ;; need to check for only one apply values
+ ((list-values) ; (apply f `(,x , at z)) -> (apply f x z)
+ (let ((last-arg (last-ref args)))
+ (if (and (pair? last-arg)
+ (eq? (car last-arg) 'apply-values)
+ (= (tree-count 'apply-values args 2) 1))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ `(apply ,f
+ ,@(copy args (make-list (- (length args) 2)) 1)
+ ,(cadr last-arg))))
+ (if (not (tree-set-memq '(append apply-values) cdr-args))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (cons f (unlist-values cdr-args)))))))))))))
+ ;; len > 3
+ (unless (hash-table-ref syntaces f) ; also not any-macro I presume
+ (when (and (pair? last-arg)
+ (eq? (car last-arg) 'list)) ; (apply f y z (list a b)) -> (f y z a b)
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (append (copy (cdr form) (make-list (- len 2)))
+ (cdr last-arg)))))
+ ;; can't cleanly go from (apply write o p) to (write o (car p)) since p can be ()
+
+ (when (and (not happy)
+ (any-null? last-arg)) ; (apply f ... ()) -> (f ...)
+ (lint-format "perhaps ~A" caller (lists->string form (cons f (copy (cddr form) (make-list (- len 3)))))))))))))))
+ (if (and (= suggestion made-suggestion)
+ (symbol? (cadr form)))
+ (let ((ary (arg-arity (cadr form) env)))
+ (if (and (pair? ary) ; (apply make-string tcnt initializer) -> (make-string tcnt (car initializer))
+ (= (car ary) (cdr ary)) ; else () as last, so can't suggest (car last)
+ (= (cdr ary) (- len 2)))
+ (lint-format "perhaps ~A" caller
+ (lists->string form (append (copy (cdr form) (make-list (- len 2)))
+ (list (list 'car (list-ref form (- len 1)))))))))))))
+
+ (hash-special 'apply sp-apply))
+
;; ---------------- format ----------------
(let ()
+ (define count-directives
+ (let ((format-control-char (let ((chars (make-vector 256 #f)))
+ (for-each
+ (lambda (c)
+ (vector-set! chars (char->integer c) #t))
+ '(#\A #\S #\C #\F #\E #\G #\O #\D #\B #\X #\P #\N #\W #\, #\{ #\} #\* #\@
+ #\a #\s #\c #\f #\e #\g #\o #\d #\b #\x #\p #\n #\w
+ #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+ chars)))
+ (lambda (head str caller form)
+ (let ((curlys 0)
+ (dirs 0)
+ (pos (char-position #\~ str)))
+ (when pos
+ (do ((len (length str))
+ (tilde-time #t)
+ (i (+ pos 1) (+ i 1)))
+ ((>= i len)
+ (if tilde-time ; (format #f "asdf~")
+ (lint-format "~A control string ends in tilde: ~A" caller head (truncated-list->string form))))
+ (if tilde-time
+ (let ((c (string-ref str i)))
+ (when (and (= curlys 0)
+ (not (memv c '(#\~ #\T #\t #\& #\% #\^ #\| #\newline #\}))) ; ~* consumes an arg
+ (not (call-with-exit
+ (lambda (return)
+ (do ((k i (+ k 1)))
+ ((= k len) #f)
+ ;; this can be confused by pad chars in ~T
+ (if (not (or (char-numeric? (string-ref str k))
+ (char=? (string-ref str k) #\,)))
+ (return (char-ci=? (string-ref str k) #\t))))))))
+ ;; the possibilities are endless, so I'll stick to the simplest
+ (if (not (vector-ref format-control-char (char->integer c))) ; (format #f "~H" 1)
+ (lint-format "unrecognized format directive: ~C in ~S, ~S" caller c str form))
+ (set! dirs (+ dirs 1))
+
+ ;; ~n so try to figure out how many args are needed (this is not complete)
+ (when (char-ci=? c #\n)
+ (let ((j (+ i 1)))
+ (if (>= j len) ; (format p "~A~A" x)
+ (lint-format "missing format directive: ~S" caller str)
+ (begin
+ ;; if ,n -- add another, if then not T, add another
+ (cond ((not (char=? (string-ref str j) #\,)))
+ ((>= (+ j 1) len)
+ (lint-format "missing format directive: ~S" caller str))
+ ((char-ci=? (string-ref str (+ j 1)) #\n)
+ (set! dirs (+ dirs 1))
+ (set! j (+ j 2)))
+ ((char-numeric? (string-ref str (+ j 1)))
+ (set! j (+ j 2)))
+ (else (set! j (+ j 1))))
+ (if (>= j len)
+ (lint-format "missing format directive: ~S" caller str)
+ (if (not (char-ci=? (string-ref str j) #\t))
+ (set! dirs (+ dirs 1)))))))))
+
+ (set! tilde-time #f)
+ (case c
+ ((#\{) (set! curlys (+ curlys 1)))
+ ((#\}) (set! curlys (- curlys 1)))
+ ((#\^ #\|)
+ (if (zero? curlys) ; (format #f "~^")
+ (lint-format "~A has ~~~C outside ~~{~~}?" caller str c))))
+ (if (and (< (+ i 2) len)
+ (member (substring str i (+ i 3)) '("%~&" "^~^" "|~|" "&~&" "\n~\n") string=?))
+ (lint-format "~A in ~A could be ~A" caller ; (format #f "~%~&")
+ (substring str (- i 1) (+ i 3))
+ str
+ (substring str (- i 1) (+ i 1)))))
+ (begin
+ (set! pos (char-position #\~ str i))
+ (if pos
+ (begin
+ (set! tilde-time #t)
+ (set! i pos))
+ (set! i len))))))
+
+ (if (not (= curlys 0)) ; (format #f "~{~A" 1)
+ (lint-format "~A has ~D unmatched ~A~A: ~A"
+ caller head
+ (abs curlys)
+ (if (positive? curlys) "{" "}")
+ (if (> curlys 1) "s" "")
+ (truncated-list->string form)))
+ dirs))))
+
(define (sp-format caller head form env)
(if (< (length form) 3)
(begin
(cond ((< (length form) 2) ; (format)
(lint-format "~A has too few arguments: ~A" caller head (truncated-list->string form)))
-
+
((and (pair? (cadr form)) ; (format (format #f str))
(eq? (caadr form) 'format))
(lint-format "redundant format: ~A" caller (truncated-list->string form)))
-
+
((and (code-constant? (cadr form)) ; (format 1)
(not (string? (cadr form))))
(lint-format "format with one argument takes a string: ~A" caller (truncated-list->string form)))
-
+
((and (string? (cadr form)) ; (format "str") -> str
(eq? head 'format) ; not snd-display, error, etc
(not (char-position #\~ (cadr form))))
@@ -8371,94 +8511,6 @@
(let ((control-string ((if (string? (cadr form)) cadr caddr) form))
(args ((if (string? (cadr form)) cddr cdddr) form)))
- (define count-directives
- (let ((format-control-char (let ((chars (make-vector 256 #f)))
- (for-each
- (lambda (c)
- (vector-set! chars (char->integer c) #t))
- '(#\A #\S #\C #\F #\E #\G #\O #\D #\B #\X #\P #\N #\W #\, #\{ #\} #\* #\@
- #\a #\s #\c #\f #\e #\g #\o #\d #\b #\x #\p #\n #\w
- #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
- chars)))
- (lambda (str caller form)
- (let ((curlys 0)
- (dirs 0)
- (pos (char-position #\~ str)))
- (when pos
- (do ((len (length str))
- (tilde-time #t)
- (i (+ pos 1) (+ i 1)))
- ((>= i len)
- (if tilde-time ; (format #f "asdf~")
- (lint-format "~A control string ends in tilde: ~A" caller head (truncated-list->string form))))
- (if tilde-time
- (let ((c (string-ref str i)))
- (when (and (= curlys 0)
- (not (memv c '(#\~ #\T #\t #\& #\% #\^ #\| #\newline #\}))) ; ~* consumes an arg
- (not (call-with-exit
- (lambda (return)
- (do ((k i (+ k 1)))
- ((= k len) #f)
- ;; this can be confused by pad chars in ~T
- (if (not (or (char-numeric? (string-ref str k))
- (char=? (string-ref str k) #\,)))
- (return (char-ci=? (string-ref str k) #\t))))))))
- ;; the possibilities are endless, so I'll stick to the simplest
- (if (not (vector-ref format-control-char (char->integer c))) ; (format #f "~H" 1)
- (lint-format "unrecognized format directive: ~C in ~S, ~S" caller c str form))
- (set! dirs (+ dirs 1))
-
- ;; ~n so try to figure out how many args are needed (this is not complete)
- (when (char-ci=? c #\n)
- (let ((j (+ i 1)))
- (if (>= j len) ; (format p "~A~A" x)
- (lint-format "missing format directive: ~S" caller str)
- (begin
- ;; if ,n -- add another, if then not T, add another
- (cond ((not (char=? (string-ref str j) #\,)))
- ((>= (+ j 1) len)
- (lint-format "missing format directive: ~S" caller str))
- ((char-ci=? (string-ref str (+ j 1)) #\n)
- (set! dirs (+ dirs 1))
- (set! j (+ j 2)))
- ((char-numeric? (string-ref str (+ j 1)))
- (set! j (+ j 2)))
- (else (set! j (+ j 1))))
- (if (>= j len)
- (lint-format "missing format directive: ~S" caller str)
- (if (not (char-ci=? (string-ref str j) #\t))
- (set! dirs (+ dirs 1)))))))))
-
- (set! tilde-time #f)
- (case c
- ((#\{) (set! curlys (+ curlys 1)))
- ((#\}) (set! curlys (- curlys 1)))
- ((#\^ #\|)
- (if (zero? curlys) ; (format #f "~^")
- (lint-format "~A has ~~~C outside ~~{~~}?" caller str c))))
- (if (and (< (+ i 2) len)
- (member (substring str i (+ i 3)) '("%~&" "^~^" "|~|" "&~&" "\n~\n") string=?))
- (lint-format "~A in ~A could be ~A" caller ; (format #f "~%~&")
- (substring str (- i 1) (+ i 3))
- str
- (substring str (- i 1) (+ i 1)))))
- (begin
- (set! pos (char-position #\~ str i))
- (if pos
- (begin
- (set! tilde-time #t)
- (set! i pos))
- (set! i len))))))
-
- (if (not (= curlys 0)) ; (format #f "~{~A" 1)
- (lint-format "~A has ~D unmatched ~A~A: ~A"
- caller head
- (abs curlys)
- (if (positive? curlys) "{" "}")
- (if (> curlys 1) "s" "")
- (truncated-list->string form)))
- dirs))))
-
(when (eq? head 'format)
(if (string? (cadr form)) ; (format "s")
(lint-format "please include the port argument to format, perhaps ~A" caller (cons 'format (cons () (cdr form))))
@@ -8480,13 +8532,13 @@
(not (var-member 't env)))
(lint-format "'t in ~A should probably be #t" caller (truncated-list->string form))))
- (if (any? all-caps-warning (cdr form))
+ (if (lint-any? all-caps-warning (cdr form))
(lint-format "There's no need to shout: ~A" caller (truncated-list->string form)))
(if (not (string? control-string))
(if (not (proper-list? args))
(lint-format "~S looks suspicious" caller form))
- (let ((ndirs (count-directives control-string caller form))
+ (let ((ndirs (count-directives head control-string caller form))
(nargs (if (list? args) (length args) 0)))
(let ((pos (char-position #\null control-string)))
(if (and pos (< pos (length control-string))) ; (format #f "~a\x00b" x)
@@ -8574,96 +8626,103 @@
;; ---------------- sort! ----------------
(let ()
- (define (sp-sort caller head form env)
- (if (= (length form) 3)
- (let ((func (caddr form)))
- (if (memq func '(= eq? eqv? equal? string=? char=? string-ci=? char-ci=?))
- (lint-format "sort! with ~A may hang: ~A" caller func (truncated-list->string form))
- (if (symbol? func)
- (let ((sig (procedure-signature (symbol->value func))))
- (if (and (pair? sig)
- (not (eq? 'boolean? (car sig)))
- (not (and (pair? (car sig))
- (memq 'boolean? (car sig))))) ; (sort! x abs)
- (lint-format "~A is a questionable sort! function" caller func))))))))
- (hash-special 'sort! sp-sort))
+ (define (sp-sort caller head form env)
+ (when (= (length form) 3)
+ (let ((func (caddr form)))
+ (if (memq func '(= eq? eqv? equal? string=? char=? string-ci=? char-ci=?))
+ (lint-format "sort! with ~A may hang: ~A" caller func (truncated-list->string form))
+ (if (symbol? func)
+ (let ((sig (procedure-signature (symbol->value func (rootlet)))))
+ (if (and (pair? sig)
+ (not (eq? 'boolean? (car sig)))
+ (not (and (pair? (car sig))
+ (memq 'boolean? (car sig))))) ; (sort! x abs)
+ (lint-format "~A is a questionable sort! function" caller func))))))
+ (let ((target (cadr form)))
+ (if (code-constant? target) ; (sort #(1 2) <)
+ (if (eqv? (length target) 0)
+ (lint-format "~A is pointless" caller (truncated-list->string form))
+ (lint-format "~S is a constant, so ~A is problematic" caller
+ target (truncated-list->string form)))))))
+
+ (hash-special 'sort! sp-sort))
;; ---------------- substring ----------------
(let ()
- (define (sp-substring caller head form env)
- (if (every? code-constant? (cdr form))
- (catch #t
- (lambda ()
- (let ((val (eval form))) ; (substring "abracadabra" 2 7) -> "racad"
- (lint-format "perhaps ~A -> ~S" caller (truncated-list->string form) val)))
- (lambda (type info)
- (lint-format "~A -> ~A" caller (truncated-list->string form) (apply format #f info))))
-
- (let ((str (cadr form)))
-
- (when (and (string? str) ; (substring "++++++" 0 2) -> (make-string 2 #\+)
- (not (byte-vector? str)))
- (let ((len (length str)))
- (when (and (> len 0)
- (string=? str (make-string len (string-ref str 0))))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (let ((chars (if (null? (cddr form))
- len
- (if (pair? (cdddr form))
- (if (eqv? (caddr form) 0)
- (cadddr form)
- (list '- (cadddr form) (caddr form)))
- (list '- len (caddr form))))))
- (list 'make-string chars (string-ref str 0))))))))
- (when (pair? (cddr form))
- (when (null? (cdddr form))
- (when (and (pair? str) ; (substring (substring x 1) 2) -> (substring x 3)
- (eq? (car str) 'substring)
- (null? (cdddr str)))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (list 'substring (cadr str)
- (if (and (integer? (caddr form))
- (integer? (caddr str)))
- (+ (caddr str) (caddr form))
- (list '+ (caddr str) (caddr form)))))))
-
- ;; end indices are complicated -- since this rarely happens, not worth the trouble
- (if (eqv? (caddr form) 0) ; (substring x 0) -> (copy x)
- (lint-format "perhaps clearer: ~A" caller (lists->string form (list 'copy str)))))
-
- (when (pair? (cdddr form))
- (let ((end (cadddr form)))
- (if (equal? (caddr form) end) ; (substring x (+ y 1) (+ y 1)) is ""
- (lint-format "leaving aside errors, ~A is \"\"" caller form))
-
- (when (and (len=3? str)
- (eqv? (caddr form) 0)
- (eq? (car str) 'string-append))
- (let ((in-arg2 (caddr str)))
- (if (and (pair? in-arg2) ; (substring (string-append str (make-string len #\space)) 0 len) -> (copy str (make-string len #\space))
- (eq? (car in-arg2) 'make-string)
- (equal? (cadddr form) (cadr in-arg2)))
- (lint-format "perhaps ~A" caller
- (lists->string form `(copy ,(cadr str) (make-string ,(cadddr form) ,(caddr in-arg2))))))))
-
- (if (and (len>1? end) ; (substring x start (length|string-length x)) -> (substring s start)
- (memq (car end) '(string-length length))
- (equal? (cadr end) str))
- (lint-format "perhaps ~A" caller (lists->string form (copy form (make-list 3))))
-
- (when (symbol? end)
- (let ((v (var-member end env)))
- (if (and (var? v)
- (equal? (list 'string-length str) (var-initial-value v))
- (not (any? (lambda (p)
- (set!? p env))
- (var-history v)))) ; if len is still (string-length x), (substring x 1 len) -> (substring x 1)
- (lint-format "perhaps, if ~A is still ~A, ~A" caller end (var-initial-value v)
- (lists->string form (copy form (make-list 3))))))))))))))
-
- (hash-special 'substring sp-substring))
+ (define (sp-substring caller head form env)
+ (if (lint-every? code-constant? (cdr form))
+ (catch #t
+ (lambda ()
+ (let ((val (eval form))) ; (substring "abracadabra" 2 7) -> "racad"
+ (lint-format "perhaps ~A -> ~S" caller (truncated-list->string form) val)))
+ (lambda (type info)
+ (lint-format "~A -> ~A" caller (truncated-list->string form) (apply format #f info))))
+
+ (let ((str (cadr form)))
+
+ (when (and (string? str) ; (substring "++++++" 0 2) -> (make-string 2 #\+)
+ (not (byte-vector? str)))
+ (let ((len (length str)))
+ (when (and (> len 0)
+ (string=? str (make-string len (string-ref str 0))))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (let ((chars (if (null? (cddr form))
+ len
+ (if (pair? (cdddr form))
+ (if (eqv? (caddr form) 0)
+ (cadddr form)
+ (list '- (cadddr form) (caddr form)))
+ (list '- len (caddr form))))))
+ (list 'make-string chars (string-ref str 0))))))))
+ (when (pair? (cddr form))
+ (when (null? (cdddr form))
+ (when (and (pair? str) ; (substring (substring x 1) 2) -> (substring x 3)
+ (eq? (car str) 'substring)
+ (null? (cdddr str)))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (list 'substring (cadr str)
+ (if (and (integer? (caddr form))
+ (integer? (caddr str)))
+ (+ (caddr str) (caddr form))
+ (list '+ (caddr str) (caddr form)))))))
+
+ ;; end indices are complicated -- since this rarely happens, not worth the trouble
+ (if (eqv? (caddr form) 0) ; (substring x 0) -> (copy x)
+ (lint-format "perhaps clearer: ~A" caller (lists->string form (list 'copy str)))))
+
+ (when (pair? (cdddr form))
+ (let ((end (cadddr form)))
+ (if (equal? (caddr form) end) ; (substring x (+ y 1) (+ y 1)) is ""
+ (lint-format "leaving aside errors, ~A is \"\"" caller form))
+
+ (when (and (len=3? str)
+ (eqv? (caddr form) 0)
+ (eq? (car str) 'string-append))
+ (let ((in-arg2 (caddr str)))
+ (if (and (pair? in-arg2) ; (substring (string-append str (make-string len #\space)) 0 len) -> (copy str (make-string len #\space))
+ (eq? (car in-arg2) 'make-string)
+ (equal? (cadddr form) (cadr in-arg2)))
+ (lint-format "perhaps ~A" caller
+ (lists->string form `(copy ,(cadr str) (make-string ,(cadddr form) ,(caddr in-arg2))))))))
+
+ (if (and (len>1? end) ; (substring x start (length|string-length x)) -> (substring s start)
+ (memq (car end) '(string-length length))
+ (equal? (cadr end) str))
+ (lint-format "perhaps ~A" caller (lists->string form (copy form (make-list 3))))
+
+ (when (symbol? end)
+ (let ((v (var-member end env)))
+ (if (and v
+ (equal? (list 'string-length str) (var-initial-value v))
+ (not (lint-any? (lambda (p)
+ (set!? p env))
+ (var-history v)))) ; if len is still (string-length x), (substring x 1 len) -> (substring x 1)
+ (lint-format "perhaps, if ~A is still ~A, ~A" caller end (var-initial-value v)
+ (lists->string form (copy form (make-list 3))))))))))))))
+
+ (hash-special 'substring sp-substring))
;; ---------------- list, *vector ----------------
(let ((seq-maker (lambda (seq)
@@ -8691,15 +8750,15 @@
(let ((f (caadr form))) ; map orders this process whereas list is unordered?
;; not any-macro? f?? or no side-effect? in the args?
(if (and (not (memq f '(quote values)))
- (every? (lambda (p)
- (and (len=2? p)
- (eq? f (car p))))
- (cddr form)))
+ (lint-every? (lambda (p)
+ (and (len=2? p)
+ (eq? f (car p))))
+ (cddr form)))
(lint-format "perhaps ~A" caller
(truncated-lists->string form
- (if (every? (lambda (p)
- (code-constant? (cadr p)))
- (cdr form))
+ (if (lint-every? (lambda (p)
+ (code-constant? (cadr p)))
+ (cdr form))
`(map ,f ',(map (lambda (p) ; p = arg which might be quoted (not = f)
((if (and (pair? (cadr p))
(eq? (caadr p) 'quote))
@@ -8712,7 +8771,7 @@
;; the only other hits in this area are and/or and test macros
(when (and (> len 4)
- (every? (lambda (a) (equal? a val)) (cddr form)))
+ (lint-every? (lambda (a) (equal? a val)) (cddr form)))
(if (code-constant? val) ; (vector 12 12 12 12 12 12) -> (make-vector 6 12)
(lint-format "perhaps ~A~A" caller
(lists->string form
@@ -8938,37 +8997,37 @@
(ary #f))
;; if zero or one args, the map/for-each is either a no-op or a function call
- (if (or (any? any-null? (cddr form)) ; (map abs ())
- (any? (lambda (p)
- (or (and (code-constant? p)
- (eqv? (length p) 0))
- (and (pair? p)
- (case (car p)
- ((vector string)
- (null? (cdr p)))
- ((quote)
- (and (pair? (cdr p))
- (eqv? (length (cadr p)) 0)))
- (else #f)))))
- (cddr form)))
- (lint-format "this ~A has no effect (~A arg)" caller
- (truncated-list->string form)
- (if (any? any-null? (cddr form)) "null" "zero length"))
- (if (and (not (tree-memq 'values form)) ; e.g. flatten in s7.html
- (any? (lambda (p)
+ (if (or (lint-any? any-null? (cddr form)) ; (map abs ())
+ (lint-any? (lambda (p)
(or (and (code-constant? p)
- (eqv? (length p) 1))
- (and (len>1? p)
+ (eqv? (length p) 0))
+ (and (pair? p)
(case (car p)
- ((quote)
- (len=1? (cadr p)))
- ((list vector string)
- (null? (cddr p)))
- ((cons)
- (and (pair? (cddr p))
- (any-null? (caddr p))))
+ ((vector string)
+ (null? (cdr p)))
+ ((quote)
+ (and (pair? (cdr p))
+ (eqv? (length (cadr p)) 0)))
(else #f)))))
- (cddr form))) ; (for-each display (list a)) -> (display a)
+ (cddr form)))
+ (lint-format "this ~A has no effect (~A arg)" caller
+ (truncated-list->string form)
+ (if (lint-any? any-null? (cddr form)) "null" "zero length"))
+ (if (and (not (tree-memq 'values form)) ; e.g. flatten in s7.html
+ (lint-any? (lambda (p)
+ (or (and (code-constant? p)
+ (eqv? (length p) 1))
+ (and (len>1? p)
+ (case (car p)
+ ((quote)
+ (len=1? (cadr p)))
+ ((list vector string)
+ (null? (cddr p)))
+ ((cons)
+ (and (pair? (cddr p))
+ (any-null? (caddr p))))
+ (else #f)))))
+ (cddr form))) ; (for-each display (list a)) -> (display a)
(lint-format "perhaps ~A" caller
(lists->string form
(let ((args (map (lambda (a)
@@ -9002,7 +9061,7 @@
(pair? (caddr form))
(or (eq? (caaddr form) 'quote)
(and (eq? (caaddr form) 'list)
- (every? code-constant? (cdaddr form)))))
+ (lint-every? code-constant? (cdaddr form)))))
(catch #t
(lambda () ; (map symbol->string '(a b c d)) -> '("a" "b" "c" "d")
(let ((val (eval form)))
@@ -9074,7 +9133,7 @@
(when (and (eq? head 'for-each)
(len>1? (cadr form)) ; (for-each (lambda (x) (+ (abs x) 1)) lst)
(eq? (caadr form) 'lambda)
- (not (any? (lambda (x) (side-effect? x env)) (cddadr form))))
+ (not (lint-any? (lambda (x) (side-effect? x env)) (cddadr form))))
(lint-format "pointless for-each: ~A" caller (truncated-list->string form)))
(when (= args 1)
@@ -9130,9 +9189,8 @@
(let ((op (if (eq? func 'write) "~S" "~A"))
(len (- (length seq) 1)))
(lists->string form `(format () ,(do ((i 0 (+ i 1))
- (str ""))
- ((= i len) str)
- (set! str (string-append str op)))
+ (str "" (string-append str op)))
+ ((= i len) str))
,@(cdr seq))))
(let ((op (if (eq? func 'write) "~{~S~}" "~{~A~}")))
(lists->string form (list 'format () op seq)))))
@@ -9144,18 +9202,18 @@
(caadr func))))
(when (and (symbol? larg)
(null? (cdadr func)) ; just one arg (one sequence to for-each) for now
- (every? (lambda (x)
- (and (pair? x)
- (memq (car x) '(display write newline write-char write-string))
- (or (eq? (car x) 'newline)
- (eq? (cadr x) larg)
- (string? (cadr x))
- (eqv? (cadr x) #\space)
- (and (len>1? (cadr x))
- (eq? (caadr x) 'number->string)
- (eq? (cadadr x) larg)))
- (eq? (write-port x) op)))
- body))
+ (lint-every? (lambda (x)
+ (and (pair? x)
+ (memq (car x) '(display write newline write-char write-string))
+ (or (eq? (car x) 'newline)
+ (eq? (cadr x) larg)
+ (string? (cadr x))
+ (eqv? (cadr x) #\space)
+ (and (len>1? (cadr x))
+ (eq? (caadr x) 'number->string)
+ (eq? (cadadr x) larg)))
+ (eq? (write-port x) op)))
+ body))
;; (for-each (lambda (x) (display x) (write-char #\space)) msg)
;; (for-each (lambda (elt) (display elt)) lst)
(let ((ctrl-string "")
@@ -9221,263 +9279,268 @@
(lint-format "perhaps ~A" caller
(lists->string form ; (values (list-values 'x (apply-values y))) -> (cons 'x y)
(if (and (pair? (cadr form))
- (eq? (caadr form) #_list-values)
+ (eq? (caadr form) 'list-values)
(not (qq-tree? (cadr form))))
(unlist-values (cadr form))
(cadr form)))))
- ((and (assq #_list-values (cdr form))
- (not (any? (lambda (a)
- (and (pair? a)
- (memq (car a) '(#_list-values #_apply-values))
- (qq-tree? a)))
- (cdr form))))
+ ((and (assq 'list-values (cdr form))
+ (not (lint-any? (lambda (a)
+ (and (pair? a)
+ (memq (car a) '(list-values apply-values))
+ (qq-tree? a)))
+ (cdr form))))
(lint-format "perhaps ~A" caller
(lists->string form ; (values (list-values 'x y) a) -> (values (list 'x y) a)
(cons 'values (map (lambda (a)
(if (and (pair? a)
- (eq? (car a) #_list-values))
+ (eq? (car a) 'list-values))
(unlist-values a)
a))
(cdr form))))))))
(hash-special 'values sp-values))
- ;; ---------------- call-with-values ----------------
+ ;; ---------------- call-with-values ----------------
+ (let ()
+ (define (sp-call/values caller head form env) ; (call/values p c) -> (c (p))
+ (when (= (length form) 3)
+ (let ((producer (cadr form))
+ (consumer (caddr form)))
+ (let* ((produced-values (mv-range producer env))
+ (consumed-values (and produced-values
+ (or (and (symbol? consumer)
+ (arg-arity consumer env))
+ (and (len>2? consumer)
+ (eq? (car consumer) 'lambda)
+ (pair? (cadr consumer))
+ (let ((len (length (cadr consumer))))
+ (if (negative? len)
+ (cons (abs len) (cdr (arity +))) ; 536870912 = MAX_ARITY in s7.c
+ (cons len len))))))))
+ (if (and consumed-values
+ (or (> (car consumed-values) (car produced-values))
+ (< (cdr consumed-values) (cadr produced-values))))
+ (let ((clen ((if (> (car consumed-values) (car produced-values)) car cdr) consumed-values)))
+ (lint-format "call-with-values consumer ~A wants ~D value~P, but producer ~A returns ~A"
+ caller
+ (truncated-list->string consumer)
+ clen clen
+ (truncated-list->string producer)
+ ((if (> (car consumed-values) (car produced-values)) car cadr) produced-values)))))
+
+ (cond ((not (pair? producer)) ; (call-with-values log c)
+ (if (and (symbol? producer)
+ (not (memq (return-type producer ()) '(#t #f values))))
+ (lint-format "~A does not return multiple values" caller producer)
+ (lint-format "perhaps ~A" caller (lists->string form (list consumer (list producer))))))
+
+ ((not (eq? (car producer) 'lambda)) ; (call-with-values (eval p env) (eval c env)) -> ((eval c env) ((eval p env)))
+ (lint-format "perhaps ~A" caller (lists->string form (list consumer (list producer)))))
+
+ ((pair? (cadr producer)) ; (call-with-values (lambda (x) 0) list)
+ (lint-format "~A requires too many arguments" caller (truncated-list->string producer)))
+
+ ((symbol? (cadr producer)) ; (call-with-values (lambda x 0) list)
+ (lint-format "~A's parameter ~A will always be ()" caller (truncated-list->string producer) (cadr producer)))
+
+ ((len=1? (cddr producer)) ; (call-with-values (lambda () (read-char p)) cons)
+ (let ((body (caddr producer)))
+ (if (or (code-constant? body)
+ (and (pair? body)
+ (symbol? (car body))
+ (not (memq (return-type (car body) ()) '(#t #f values)))))
+ (lint-format "~A does not return multiple values" caller body)
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (if (and (pair? body)
+ (eq? (car body) 'values))
+ (cons consumer (cdr body))
+ (list consumer body)))))))
+
+ (else (lint-format "perhaps ~A" caller (lists->string form (list consumer (list producer)))))))))
+ (hash-special 'call-with-values sp-call/values))
+
+ ;; ---------------- multiple-value-bind ----------------
(let ()
- (define (sp-call/values caller head form env) ; (call/values p c) -> (c (p))
- (when (= (length form) 3)
- (let ((producer (cadr form))
- (consumer (caddr form)))
- (let* ((produced-values (mv-range producer env))
- (consumed-values (and produced-values
- (or (and (symbol? consumer)
- (arg-arity consumer env))
- (and (len>2? consumer)
- (eq? (car consumer) 'lambda)
- (pair? (cadr consumer))
- (let ((len (length (cadr consumer))))
- (if (negative? len)
- (cons (abs len) (cdr (arity +))) ; 536870912 = MAX_ARITY in s7.c
- (cons len len))))))))
- (if (and consumed-values
- (or (> (car consumed-values) (car produced-values))
- (< (cdr consumed-values) (cadr produced-values))))
- (let ((clen ((if (> (car consumed-values) (car produced-values)) car cdr) consumed-values)))
- (lint-format "call-with-values consumer ~A wants ~D value~P, but producer ~A returns ~A"
- caller
- (truncated-list->string consumer)
- clen clen
- (truncated-list->string producer)
- ((if (> (car consumed-values) (car produced-values)) car cadr) produced-values)))))
-
- (cond ((not (pair? producer)) ; (call-with-values log c)
- (if (and (symbol? producer)
- (not (memq (return-type producer ()) '(#t #f values))))
- (lint-format "~A does not return multiple values" caller producer)
- (lint-format "perhaps ~A" caller (lists->string form (list consumer (list producer))))))
-
- ((not (eq? (car producer) 'lambda)) ; (call-with-values (eval p env) (eval c env)) -> ((eval c env) ((eval p env)))
- (lint-format "perhaps ~A" caller (lists->string form (list consumer (list producer)))))
-
- ((pair? (cadr producer)) ; (call-with-values (lambda (x) 0) list)
- (lint-format "~A requires too many arguments" caller (truncated-list->string producer)))
-
- ((symbol? (cadr producer)) ; (call-with-values (lambda x 0) list)
- (lint-format "~A's parameter ~A will always be ()" caller (truncated-list->string producer) (cadr producer)))
-
- ((len=1? (cddr producer)) ; (call-with-values (lambda () (read-char p)) cons)
- (let ((body (caddr producer)))
- (if (or (code-constant? body)
- (and (pair? body)
- (symbol? (car body))
- (not (memq (return-type (car body) ()) '(#t #f values)))))
- (lint-format "~A does not return multiple values" caller body)
+ (define (sp-mvb caller head form env)
+ (when (>= (length form) 4)
+ (let ((vars (cadr form))
+ (producer (caddr form))
+ (body (cdddr form)))
+
+ (if (null? vars)
+ (lint-format "this multiple-value-bind is pointless; perhaps ~A" caller
+ (lists->string form
+ (if (side-effect? producer env)
+ (cons 'begin (cons producer body))
+ (if (null? (cdr body))
+ (car body)
+ (cons 'begin body)))))
+
+ (unless (symbol? vars) ; else any number of values is ok
+ (let ((vals (mv-range producer env)) ; (multiple-value-bind (a b) (values 1 2 3) b)
+ (args (length vars)))
+ (if (and (integer? args)
+ (pair? vals)
+ (not (<= (car vals) args (cadr vals))))
+ (lint-format "multiple-value-bind wants ~D values, but ~A returns ~A"
+ caller args
+ (truncated-list->string producer)
+ ((if (< args (car vals)) car cadr) vals)))
+
+ (if (and (pair? producer) ; (multiple-value-bind (a b) (f) b) -> ((lambda (a b) b) (f))
+ (symbol? (car producer))
+ (not (memq (return-type (car producer) ()) '(#t #f values))))
+ (lint-format "~A does not return multiple values" caller (car producer))
(lint-format "perhaps ~A" caller
(lists->string form
- (if (and (pair? body)
- (eq? (car body) 'values))
- (cons consumer (cdr body))
- (list consumer body)))))))
-
- (else (lint-format "perhaps ~A" caller (lists->string form (list consumer (list producer)))))))))
- (hash-special 'call-with-values sp-call/values))
-
- ;; ---------------- multiple-value-bind ----------------
- (let ()
- (define (sp-mvb caller head form env)
- (when (>= (length form) 4)
- (let ((vars (cadr form))
- (producer (caddr form))
- (body (cdddr form)))
-
- (if (null? vars)
- (lint-format "this multiple-value-bind is pointless; perhaps ~A" caller
- (lists->string form
- (if (side-effect? producer env)
- (cons 'begin (cons producer body))
- (if (null? (cdr body))
- (car body)
- (cons 'begin body)))))
-
- (unless (symbol? vars) ; else any number of values is ok
- (let ((vals (mv-range producer env)) ; (multiple-value-bind (a b) (values 1 2 3) b)
- (args (length vars)))
- (if (and (integer? args)
- (pair? vals)
- (not (<= (car vals) args (cadr vals))))
- (lint-format "multiple-value-bind wants ~D values, but ~A returns ~A"
- caller args
- (truncated-list->string producer)
- ((if (< args (car vals)) car cadr) vals)))
-
- (if (and (pair? producer) ; (multiple-value-bind (a b) (f) b) -> ((lambda (a b) b) (f))
- (symbol? (car producer))
- (not (memq (return-type (car producer) ()) '(#t #f values))))
- (lint-format "~A does not return multiple values" caller (car producer))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (if (and (null? (cdr body))
- (pair? (car body))
- (symbol? (caar body))
- (equal? vars (cdar body))
- (defined? (caar body))
- (equal? (arity (symbol->value (caar body))) (cons args args)))
- (list (caar body) producer)
- `((lambda ,vars , at body) ,producer)))))))))))
- (hash-special 'multiple-value-bind sp-mvb))
+ (if (and (null? (cdr body))
+ (pair? (car body))
+ (symbol? (caar body))
+ (equal? vars (cdar body))
+ (defined? (caar body))
+ (equal? (arity (symbol->value (caar body))) (cons args args)))
+ (list (caar body) producer)
+ `((lambda ,vars , at body) ,producer)))))))))))
+ (hash-special 'multiple-value-bind sp-mvb))
;; ---------------- let-values ----------------
(let ()
- (define (sp-let-values caller head form env)
- (if (and (pair? (cdr form))
- (proper-pair? (cadr form)))
- (if (null? (cdadr form)) ; just one set of vars
- (let ((call (caadr form)))
- (if (len>1? call)
- (lint-format "perhaps ~A" caller ; (let-values (((x) (values 1))) x) -> ((lambda (x) x) (values 1))
- (lists->string form
- `((lambda ,(car call)
- ,@(cddr form))
- ,(cadr call))))))
- (if (every? len>1? (cadr form))
- (lint-format "perhaps ~A" caller ; (let-values (((x) (values 1)) ((y) (values 2))) (list x y)) ...
- (lists->string
- form
- `(with-let
- (apply sublet (curlet)
- (list ,@(map (lambda (v)
- `((lambda ,(car v)
- (values ,@(map (lambda (name)
- (values (symbol->keyword name) name))
- (args->proper-list (car v)))))
- ,(cadr v)))
- (cadr form))))
- ,@(cddr form))))))))
- (hash-special 'let-values sp-let-values))
+ (define (sp-let-values caller head form env)
+ (if (and (pair? (cdr form))
+ (proper-pair? (cadr form)))
+ (if (null? (cdadr form)) ; just one set of vars
+ (let ((call (caadr form)))
+ (if (len>1? call)
+ (lint-format "perhaps ~A" caller ; (let-values (((x) (values 1))) x) -> ((lambda (x) x) (values 1))
+ (lists->string form
+ `((lambda ,(car call)
+ ,@(cddr form))
+ ,(cadr call))))))
+ (if (lint-every? len>1? (cadr form))
+ (lint-format "perhaps ~A" caller ; (let-values (((x) (values 1)) ((y) (values 2))) (list x y)) ...
+ (lists->string
+ form
+ `(with-let
+ (apply sublet (curlet)
+ (list ,@(map (lambda (v)
+ `((lambda ,(car v)
+ (values ,@(map (lambda (name)
+ (values (symbol->keyword name) name))
+ (args->proper-list (car v)))))
+ ,(cadr v)))
+ (cadr form))))
+ ,@(cddr form))))))))
+ (hash-special 'let-values sp-let-values))
;; ---------------- let*-values ----------------
(hash-special 'let*-values
- (lambda (caller head form env)
- (if (and (pair? (cdr form))
- (proper-pair? (cadr form)) ; every? uses for-each which ignores dotted-list cdr?
- (every? len>1? (cadr form)))
- (lint-format "perhaps ~A" caller
- (lists->string form ; (let*-values (((a) (f x))) (+ a b)) -> (let ((a (f x))) (+ a b))
- (let loop ((var-data (cadr form)))
- (let ((v (car var-data)))
- (if (and (pair? (car v)) ; just one var
- (null? (cdar v)))
- (if (null? (cdr var-data))
- (cons 'let (cons (list (list (caar v) (cadr v))) (cddr form)))
- `(let ((,(caar v) ,(cadr v))) ,(loop (cdr var-data))))
- (if (null? (cdr var-data))
- `((lambda ,(car v) ,@(cddr form)) ,(cadr v))
- `((lambda ,(car v) ,(loop (cdr var-data))) ,(cadr v)))))))))))
-
+ (lambda (caller head form env)
+ (if (and (pair? (cdr form))
+ (proper-pair? (cadr form)) ; every? uses for-each which ignores dotted-list cdr?
+ (lint-every? len>1? (cadr form)))
+ (lint-format "perhaps ~A" caller
+ (lists->string form ; (let*-values (((a) (f x))) (+ a b)) -> (let ((a (f x))) (+ a b))
+ (let loop ((var-data (cadr form)))
+ (let ((v (car var-data)))
+ (if (and (pair? (car v)) ; just one var
+ (null? (cdar v)))
+ (if (null? (cdr var-data))
+ (cons 'let (cons (list (list (caar v) (cadr v))) (cddr form)))
+ `(let ((,(caar v) ,(cadr v))) ,(loop (cdr var-data))))
+ (if (null? (cdr var-data))
+ `((lambda ,(car v) ,@(cddr form)) ,(cadr v))
+ `((lambda ,(car v) ,(loop (cdr var-data))) ,(cadr v)))))))))))
+
;; ---------------- define-values ----------------
(hash-special 'define-values
- (lambda (caller head form env)
- (when (pair? (cdr form))
- (if (null? (cadr form))
- (lint-format "~A is pointless" caller (truncated-list->string form))
- (when (pair? (cddr form))
- (lint-format "perhaps ~A" caller
- (cond ((symbol? (cadr form))
- (lists->string form (list 'define (cadr form) (list 'list (caddr form)))))
-
- ((len=1? (cadr form))
- (lists->string form (list 'define (caadr form) (caddr form))))
-
- (else ; (define-values (x y) (values 3 2)) -> (varlet (curlet) ((lambda (x y) (curlet)) (values 3 2)))
- (let-temporarily ((target-line-length 120))
- (truncated-lists->string form
- `(varlet (curlet)
- ((lambda ,(cadr form)
- (curlet))
- ,(caddr form)))))))))))))
+ (lambda (caller head form env)
+ (when (pair? (cdr form))
+ (if (null? (cadr form))
+ (lint-format "~A is pointless" caller (truncated-list->string form))
+ (when (pair? (cddr form))
+ (lint-format "perhaps ~A" caller
+ (cond ((symbol? (cadr form))
+ (lists->string form (list 'define (cadr form) (list 'list (caddr form)))))
+
+ ((len=1? (cadr form))
+ (lists->string form (list 'define (caadr form) (caddr form))))
+
+ (else ; (define-values (x y) (values 3 2)) -> (varlet (curlet) ((lambda (x y) (curlet)) (values 3 2)))
+ (let-temporarily ((target-line-length 120))
+ (truncated-lists->string form
+ `(varlet (curlet)
+ ((lambda ,(cadr form)
+ (curlet))
+ ,(caddr form)))))))))))))
;; ---------------- eval ----------------
(let ()
- (define (sp-eval caller head form env)
- (case (length form)
- ((2)
- (let ((arg (cadr form)))
- (if (not (pair? arg))
- (if (not (symbol? arg)) ; (eval 32)
- (lint-format "this eval is pointless; perhaps ~A" caller (lists->string form arg)))
- (case (car arg)
- ((quote) ; (eval 'x)
- (if (pair? (cdr arg))
- (lint-format "perhaps ~A" caller (lists->string form (cadr arg)))))
-
- ((string->symbol) ; (eval (string->symbol "x")) -> x
- (if (pair? (cdr arg)) ; (eval (string->symbol x)) -> (eval-string x)
- (if (string? (cadr arg))
- (if (equal? (cadr arg) "")
- (lint-format "string->symbol argument can't be a null string:~A" caller (truncated-list->string form))
- (lint-format "perhaps ~A" caller (lists->string form (string->symbol (cadr arg)))))
- (lint-format "perhaps ~A" caller (lists->string form (list 'eval-string (cadr arg)))))))
-
- ((with-input-from-string call-with-input-string)
- (if (and (len>1? (cdr arg)) ; (eval (call-with-input-string port read)) -> (eval-string port)
- (eq? (caddr arg) 'read))
- (lint-format "perhaps ~A" caller (lists->string form (list 'eval-string (cadr arg))))))
-
- ((read)
- (if (and (= (length arg) 2) ; (eval (read (open-input-string expr))) -> (eval-string expr)
- (len>1? (cadr arg))
- (eq? (caadr arg) 'open-input-string))
- (lint-format "perhaps ~A" caller (lists->string form (list 'eval-string (cadadr arg))))))
-
- ((list)
- (if (every? (lambda (p) ; (eval (list '* 2 x)) -> (* 2 (eval x))
- (or (symbol? p)
- (code-constant? p)))
- (cdr arg))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (map (lambda (p)
- (if (and (len>1? p)
- (eq? (car p) 'quote))
- (cadr p)
- (if (code-constant? p)
- p
- (list 'eval p))))
- (cdr arg))))))))))
- ((3)
- (let ((arg (cadr form))
- (e (caddr form)))
- (if (and (not (code-constant? e)) ; error reported elsewhere
- (pair? arg)
- (eq? (car arg) 'quote))
- (lint-format "perhaps ~A" caller ; (eval 'x env) -> (env 'x)
- (lists->string form
- (if (symbol? (cadr arg))
- (list e arg)
- (cons 'with-let (cons e (unbegin (cadr arg))))))))))))
- (hash-special 'eval sp-eval))
-
+ (define (sp-eval caller head form env)
+ (case (length form)
+ ((2)
+ (let ((arg (cadr form)))
+ (if (not (pair? arg))
+ (if (not (symbol? arg)) ; (eval 32)
+ (lint-format "this eval is pointless; perhaps ~A" caller (lists->string form arg)))
+ (case (car arg)
+ ((quote) ; (eval 'x)
+ (if (pair? (cdr arg))
+ (lint-format "perhaps ~A" caller (lists->string form (cadr arg)))))
+
+ ((string->symbol) ; (eval (string->symbol "x")) -> x
+ (if (pair? (cdr arg)) ; (eval (string->symbol x)) -> (eval-string x)
+ (if (string? (cadr arg))
+ (if (equal? (cadr arg) "")
+ (lint-format "string->symbol argument can't be a null string:~A" caller (truncated-list->string form))
+ (lint-format "perhaps ~A" caller (lists->string form (string->symbol (cadr arg)))))
+ (lint-format "perhaps ~A" caller (lists->string form (list 'eval-string (cadr arg)))))))
+
+ ((with-input-from-string call-with-input-string)
+ (if (and (len>1? (cdr arg)) ; (eval (call-with-input-string port read)) -> (eval-string port)
+ (eq? (caddr arg) 'read))
+ (lint-format "perhaps ~A" caller (lists->string form (list 'eval-string (cadr arg))))))
+
+ ((read)
+ (if (and (= (length arg) 2) ; (eval (read (open-input-string expr))) -> (eval-string expr)
+ (len>1? (cadr arg))
+ (eq? (caadr arg) 'open-input-string))
+ (lint-format "perhaps ~A" caller (lists->string form (list 'eval-string (cadadr arg))))))
+
+ ((list)
+ (if (lint-every? (lambda (p) ; (eval (list '* 2 x)) -> (* 2 (eval x))
+ (or (symbol? p)
+ (code-constant? p)))
+ (cdr arg))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (map (lambda (p)
+ (if (and (len>1? p)
+ (eq? (car p) 'quote))
+ (cadr p)
+ (if (code-constant? p)
+ p
+ (list 'eval p))))
+ (cdr arg))))))))))
+ ((3)
+ (let ((arg (cadr form))
+ (e (caddr form)))
+ (if (and (not (code-constant? e)) ; error reported elsewhere
+ (pair? arg)
+ (eq? (car arg) 'quote))
+ (lint-format "perhaps ~A" caller ; (eval 'x env) -> (env 'x)
+ (lists->string form
+ (if (symbol? (cadr arg))
+ (list e arg)
+ (cons 'with-let (cons e (unbegin (cadr arg))))))))))))
+ (hash-special 'eval sp-eval))
+
;; ---------------- fill! etc ----------------
(let ()
(define (sp-fill! caller head form env)
+ (if (and (pair? (cdr form))
+ (code-constant? (cadr form)))
+ (lint-format "~A is a constant, so ~A is problematic" caller
+ (cadr form)
+ (truncated-list->string form)))
(if (= (length form) 5)
(check-start-and-end caller head (cdddr form) form env)))
(for-each (lambda (f)
@@ -9507,17 +9570,17 @@
;; ---------------- read-line ----------------
(let ()
- (define (sp-read-line caller head form env)
- (if (and (= (length form) 3)
- (code-constant? (caddr form))
- (not (boolean? (caddr form)))) ; (read-line in-port 'concat)
- (lint-format "the third argument should be boolean (#f=default, #t=include trailing newline): ~A" caller form)
- (if (and (pair? (cdr form))
- (pair? (cadr form))
- (eq? (caadr form) 'current-input-port))
- (lint-format "(current-input-port) is the default port for ~A: ~A" caller head form))))
- (hash-special 'read-line sp-read-line))
-
+ (define (sp-read-line caller head form env)
+ (if (and (= (length form) 3)
+ (code-constant? (caddr form))
+ (not (boolean? (caddr form)))) ; (read-line in-port 'concat)
+ (lint-format "the third argument should be boolean (#f=default, #t=include trailing newline): ~A" caller form)
+ (if (and (pair? (cdr form))
+ (pair? (cadr form))
+ (eq? (caadr form) 'current-input-port))
+ (lint-format "(current-input-port) is the default port for ~A: ~A" caller head form))))
+ (hash-special 'read-line sp-read-line))
+
;; ---------------- string-length ----------------
(let ()
(define (sp-string-length caller head form env)
@@ -9527,7 +9590,7 @@
(if (and (len>1? (cadr form)) ; (string-length (make-string 3)) -> 3
(eq? (caadr form) 'make-string))
(lint-format "perhaps ~A" caller (lists->string form (cadadr form)))))))
-
+
(hash-special 'string-length sp-string-length))
;; ---------------- vector-length ----------------
@@ -9558,51 +9621,51 @@
;; ---------------- dynamic-wind ----------------
(let ()
- (define (sp-dw caller head form env)
- (when (= (length form) 4)
- (let ((init (cadr form))
- (body (caddr form))
- (end (cadddr form))
- (empty 0))
- ;; (equal? init end) as a mistake doesn't seem to happen
-
- (when (and (len>1? init)
- (eq? (car init) 'lambda))
- (if (not (null? (cadr init)))
- (lint-format "dynamic-wind init function should be a thunk: ~A" caller init))
- (if (pair? (cddr init))
- (let ((last-expr (list-ref init (- (length init) 1))))
- (if (not (pair? last-expr))
- (if (null? (cdddr init))
- (set! empty 1))
- (unless (side-effect? last-expr env)
- (if (null? (cdddr init))
- (set! empty 1)) ; (dynamic-wind (lambda () (s7-version)) (lambda () (list)) (lambda () #f))
- (lint-format "this could be omitted: ~A in ~A" caller last-expr init))))))
-
- (if (and (pair? body)
- (eq? (car body) 'lambda))
- (if (not (null? (cadr body)))
- (lint-format "dynamic-wind body function should be a thunk: ~A" caller body))
- (set! empty 3)) ; don't try to access body below
-
- (when (and (len>1? end)
- (eq? (car end) 'lambda))
- (if (not (null? (cadr end)))
- (lint-format "dynamic-wind end function should be a thunk: ~A" caller end))
- (if (pair? (cddr end))
- (let ((last-expr (list-ref end (- (length end) 1))))
- (if (not (pair? last-expr))
- (if (null? (cdddr end))
- (set! empty (+ empty 1)))
- (unless (side-effect? last-expr env) ; or if no side-effects in any (also in init)
- (if (null? (cdddr end))
- (set! empty (+ empty 1)))
- (lint-format "this could be omitted: ~A in ~A" caller last-expr end)))
- (if (= empty 2) ; (dynamic-wind (lambda () #f) (lambda () #()) (lambda () #f)) -> #()
- (lint-format "this dynamic-wind is pointless, ~A" caller
- (lists->string form (if (null? (cdddr body)) (caddr body) (cons 'begin (cddr body))))))))))))
- (hash-special 'dynamic-wind sp-dw))
+ (define (sp-dw caller head form env)
+ (when (= (length form) 4)
+ (let ((init (cadr form))
+ (body (caddr form))
+ (end (cadddr form))
+ (empty 0))
+ ;; (equal? init end) as a mistake doesn't seem to happen
+
+ (when (and (len>1? init)
+ (eq? (car init) 'lambda))
+ (if (not (null? (cadr init)))
+ (lint-format "dynamic-wind init function should be a thunk: ~A" caller init))
+ (if (pair? (cddr init))
+ (let ((last-expr (last-ref init)))
+ (if (not (pair? last-expr))
+ (if (null? (cdddr init))
+ (set! empty 1))
+ (unless (side-effect? last-expr env)
+ (if (null? (cdddr init))
+ (set! empty 1)) ; (dynamic-wind (lambda () (s7-version)) (lambda () (list)) (lambda () #f))
+ (lint-format "this could be omitted: ~A in ~A" caller last-expr init))))))
+
+ (if (and (pair? body)
+ (eq? (car body) 'lambda))
+ (if (not (null? (cadr body)))
+ (lint-format "dynamic-wind body function should be a thunk: ~A" caller body))
+ (set! empty 3)) ; don't try to access body below
+
+ (when (and (len>1? end)
+ (eq? (car end) 'lambda))
+ (if (not (null? (cadr end)))
+ (lint-format "dynamic-wind end function should be a thunk: ~A" caller end))
+ (if (pair? (cddr end))
+ (let ((last-expr (last-ref end)))
+ (if (not (pair? last-expr))
+ (if (null? (cdddr end))
+ (set! empty (+ empty 1)))
+ (unless (side-effect? last-expr env) ; or if no side-effects in any (also in init)
+ (if (null? (cdddr end))
+ (set! empty (+ empty 1)))
+ (lint-format "this could be omitted: ~A in ~A" caller last-expr end)))
+ (if (= empty 2) ; (dynamic-wind (lambda () #f) (lambda () #()) (lambda () #f)) -> #()
+ (lint-format "this dynamic-wind is pointless, ~A" caller
+ (lists->string form (if (null? (cdddr body)) (caddr body) (cons 'begin (cddr body))))))))))))
+ (hash-special 'dynamic-wind sp-dw))
;; ---------------- with-output-to-string ----------------
(let ()
@@ -9683,9 +9746,9 @@
;; ---------------- cond-expand ----------------
(let ()
(define (sp-cond-expand caller head form env)
- (if (every? (lambda (c)
- (not (len>1? c)))
- (cdr form))
+ (if (lint-every? (lambda (c)
+ (not (len>1? c)))
+ (cdr form))
(lint-format "pointless cond-expand: ~A" caller (truncated-list->string form))
(for-each (lambda (c)
(if (not (or (symbol? (car c))
@@ -9811,9 +9874,11 @@
(bytevector-set! . byte-vector-set!)
(bytevector-u8-ref . byte-vector-ref)
(bytevector-u8-set! . byte-vector-set!)
+ (byte-vector-length . length)
(copy-list . copy)
(copy-string . copy)
(copy-vector . copy)
+ (environment-copy . copy)
(environment-ref . let-ref)
(environment-set! . let-set!)
(environment? . let?)
@@ -9826,6 +9891,7 @@
(f64vector? . float-vector?)
(fixnum? . integer?)
(floor-remainder . modulo)
+ (flo:vector-length . length)
(fluid-let . let-temporarily)
(hash-for-each . for-each)
(hash-ref . hash-table-ref)
@@ -9847,7 +9913,9 @@
(hashv-set! . hash-table-set!)
(interaction-environment . curlet)
(intern . string->symbol)
- (list-copy . copy)
+ ;(list-copy . copy)
+ ;(list-fill! . fill!)
+ (list-length . length)
(list-reverse . reverse)
(make-bytevector . make-byte-vector)
(make-f64vector . make-float-vector)
@@ -9871,8 +9939,11 @@
(s64vector? . int-vector?)
(some . any?)
(some? . any?)
+ ;(string-copy . copy)
+ ;(string-fill! . fill!)
(string-for-each . for-each)
(string-reverse! . reverse!)
+ (string-reverse . reverse)
(symbol-name . symbol->string)
(system-global-environment . rootlet)
(the-environment . curlet)
@@ -9891,6 +9962,8 @@
(unspecific . #<unspecified>)
(user-global-environment . rootlet)
(user-initial-environment . rootlet)
+ ;(vector-copy . copy)
+ ;(vector-fill! . fill!)
(vector-for-each . for-each)
(vector-reverse! . reverse!)
(write-bytevector . write-string)
@@ -10042,11 +10115,6 @@
(report-arg-trouble
(lambda (caller form head arg-number checker arg uop env)
- (define (prettify-arg-number argn)
- (if (or (not (= argn 1))
- (pair? (cddr form)))
- (format #f "~D " argn)
- ""))
(when (and (or arg (not (eq? checker 'output-port?)))
(not (and (eq? checker 'string?)
(len>1? arg)
@@ -10057,11 +10125,18 @@
(let ((op (if (and (eq? checker 'real?)
(eq? uop 'number?))
'complex?
- uop)))
+ uop))
+ (prettify-arg-number (lambda (argn)
+ (if (or (not (= argn 1))
+ (pair? (cddr form)))
+ (format #f "~D " argn)
+ ""))))
(if (and (pair? op)
(member checker op any-compatible?))
(if (and *report-sloppy-assoc*
- (not (var-member :catch env))) ; (round (char-position #\a "asb"))
+ (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
@@ -10082,7 +10157,7 @@
(lambda (caller head form checkers env max-arity)
(when *report-func-as-arg-arity-mismatch*
(let ((v (var-member head env)))
- (when (and (var? v)
+ (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)))
@@ -10100,7 +10175,7 @@
(let ((ari (if (symbol? arg)
(arg-arity arg env)
- (and (pair? arg)
+ (and (len>1? arg)
(eq? (car arg) 'lambda)
(let ((len (length (cadr arg))))
(and (integer? len)
@@ -10139,28 +10214,29 @@
((let let*)
(if (len>1? (cdr tree))
(let ((vs ((if (symbol? (cadr tree)) caddr cadr) tree)))
- (if (not (any? (lambda (a) (or (not (pair? a)) (eq? sym (car a)))) vs))
+ (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 (any? (lambda (a) (or (not (pair? a)) (eq? sym (car a)))) (cadr 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 (any? (lambda (a) (eq? sym a)) (args->proper-list (cadr 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 (any? (lambda (a) (eq? sym a)) (args->proper-list (cdadr 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))
- (not (any? (lambda (a) (eq? sym a)) (args->proper-list (cdadr tree)))))
+ (pair? (cadr tree))
+ (not (lint-any? (lambda (a) (eq? sym a)) (args->proper-list (cdadr tree)))))
(fwalk sym (cddr tree))))
((quote) #f)
@@ -10301,11 +10377,9 @@
((do)
(if (len>1? (cdr arg))
(let ((end+res (caddr arg)))
- (check-arg (if (and (pair? end+res)
- (> (length end+res) 1))
- (list-ref end+res (- (length end+res) 1))
- ())))))
-
+ (if (pair? end+res)
+ (check-arg ((if (> (length end+res) 1) last-ref car) end+res)))))) ; car=test which is returned if no result
+
((case)
(if (len>1? (cdr arg))
(for-each
@@ -10313,7 +10387,7 @@
(if (and (pair? clause)
(> (length clause) 1)
(not (eq? (cadr clause) '=>)))
- (check-arg (list-ref clause (- (length clause) 1)))))
+ (check-arg (last-ref clause))))
(cddr arg))))
((cond)
@@ -10324,7 +10398,7 @@
(if (pair? (cdr clause))
(if (and (not (eq? (cadr clause) '=>))
(proper-list? (cdr clause)))
- (check-arg (list-ref clause (- (length clause) 1))))
+ (check-arg (last-ref clause)))
(check-cond-arg (car clause)))))
(cdr arg))))
@@ -10369,12 +10443,12 @@
(done)
(set! checkers (cdr checkers)))))
(cdr arg) (cddr arg))
- (check-arg (list-ref arg (- (length arg) 1))))))
+ (check-arg (last-ref arg)))))
(else
(let ((op (return-type (car arg) env)))
(let ((v (var-member (car arg) env)))
- (if (and (var? v)
+ (if (and v
(not (memq form (var-history v))))
(begin
(set! (var-history v) (cons form (var-history v)))
@@ -10485,11 +10559,11 @@
((fill! string-fill! vector-fill! reverse! sort! set! set-cdr!)
;; here there's trouble if cadr used anywhere -- but we need to check for shadowing which is tedious:
(if (and (len>1? p)
- (any? (lambda (np)
- (and (not (eq? np p))
- (tree-memq (cadr p) np)
- (not (shadowed? (cadr p) np))))
- vals))
+ (lint-any? (lambda (np)
+ (and (not (eq? np p))
+ (tree-memq (cadr p) np)
+ (not (shadowed? (cadr p) np))))
+ vals))
(return (report-trouble))))
((throw error exit emergency-exit)
@@ -10520,41 +10594,39 @@
h)))
(lambda (caller head form env)
(let ((data (var-member head env)))
-
(if (and (len>1? (cdr form))
(any-procedure? head env))
(check-unordered-exprs caller form (cdr form) env))
- (if (var? data)
+ (if data
(let ((fdata (cdr data)))
;; a local var
- (when (symbol? (fdata 'ftype))
- (let ((args (fdata 'arglist))
- (ary (and (not (eq? (fdata 'decl) 'error))
- (arity (fdata 'decl))))
+ (when (symbol? (let-ref fdata 'ftype))
+ (let ((args (let-ref fdata 'arglist))
+ (ary (let-ref fdata 'arit))
(sig (var-signature data)))
(when (pair? ary)
- (let ((req (car ary))
- (opt (cdr ary))
+ (let ((opt (cdr ary))
(pargs (if (pair? args)
(proper-list args)
(if (symbol? args)
(list args)
()))))
- (let ((call-args (- (length form) 1)))
+ (let ((call-args (- (length form) 1))
+ (req (car ary)))
(if (< call-args req)
(begin
(for-each (lambda (p)
(if (pair? p)
(let ((v (var-member (car p) env)))
- (if (var? v)
- (let ((vals (let-ref (cdr v) 'values)))
+ (if v
+ (let ((vals (let-ref (cdr v) 'nvalues)))
(if (pair? vals)
(set! call-args (+ call-args -1 (cadr vals)))))))))
(cdr form))
(if (not (or (>= call-args req)
(tree-memq 'values (cdr form))
- (tree-memq 'dilambda (fdata 'initial-value))))
+ (tree-memq 'dilambda (let-ref fdata 'initial-value))))
(lint-format "~A needs ~D argument~A: ~A"
caller head
req (if (> req 1) "s" "")
@@ -10562,7 +10634,7 @@
(if (> (- call-args (keywords (cdr form))) 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 (fdata 'allow-other-keys)
+ (unless (let-ref fdata 'allow-other-keys)
(let ((last-was-key #f)
(have-keys 0)
(warned #f)
@@ -10598,41 +10670,41 @@
;; also if var passed to macro -- what to do?
;; look for problematic macro expansion
- (when (memq (fdata 'ftype) '(define-macro define-macro* defmacro defmacro*))
+ (when (memq (let-ref fdata 'ftype) '(define-macro define-macro* defmacro defmacro*))
- (unless (list? (fdata 'macro-ops))
+ (unless (list? (let-ref fdata 'macro-ops))
(let ((syms (list () ())))
- (tree-symbol-walk ((if (memq (fdata 'ftype) '(define-macro define-macro*))
+ (tree-symbol-walk ((if (memq (let-ref fdata 'ftype) '(define-macro define-macro*))
cddr cdddr)
- (fdata 'initial-value))
+ (let-ref fdata 'initial-value))
syms)
(varlet fdata 'macro-locals (car syms) 'macro-ops (cadr syms))))
- (when (or (pair? (fdata 'macro-locals))
- (pair? (fdata 'macro-ops)))
+ (when (or (pair? (let-ref fdata 'macro-locals))
+ (pair? (let-ref fdata 'macro-ops)))
(let ((bad-locals ())
(bad-quoted-locals ()))
(for-each
(lambda (local)
(if (tree-unquoted-member local (cdr form))
(set! bad-locals (cons local bad-locals))))
- (fdata 'macro-locals))
+ (let-ref fdata 'macro-locals))
(when (null? bad-locals)
(for-each
(lambda (local)
(if (tree-member local (cdr form)) ; not tree-memq!
(set! bad-quoted-locals (cons local bad-quoted-locals))))
- (fdata 'macro-locals)))
+ (let-ref fdata 'macro-locals)))
(let ((bad-ops ()))
(for-each
(lambda (op)
(let ((curf (var-member op env))
- (oldf (var-member op (fdata 'env))))
+ (oldf (var-member op (let-ref fdata 'env))))
(if (and (not (eq? curf oldf))
- (or (pair? (fdata 'env))
+ (or (pair? (let-ref fdata 'env))
(defined? op (rootlet))))
(set! bad-ops (cons op bad-ops)))))
- (fdata 'macro-ops))
+ (let-ref fdata 'macro-ops))
(when (or (pair? bad-locals)
(pair? bad-quoted-locals)
@@ -10744,7 +10816,7 @@
(lint-format "this looks odd: ~A" caller (truncated-list->string form))))
;; now try to check arg types
- (let ((arg-data (cond ((procedure-signature (symbol->value head *e*)) => cdr) (else #f))))
+ (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))
))))))))))))))
@@ -10790,7 +10862,7 @@
(and (memq nt '(pair? null? proper-list?))
(memq base-type '(pair? null? proper-list?))
(set! base-type 'list?))))))))
- (and (every? typef (var-history v))
+ (and (lint-every? typef (var-history v))
base-type))))))
;; -------- defined-twice
@@ -10900,7 +10972,7 @@
(let ((getdots (if (null? getargs) "" " ..."))
(setdots (if (or (not (pair? setargs)) (null? (cdr setargs))) "" " ..."))
(setvalue (and (proper-list? setargs)
- (list-ref setargs (- (length setargs) 1)))))
+ (last-ref setargs))))
(if setvalue
(format outport "~NC~A: perhaps use dilambda and generalized set! for ~A and ~A:~%~
~NCreplace (~A~A) with (~A~A) and (~A~A ~A) with (set! (~A~A) ~A)~%~
@@ -10945,27 +11017,27 @@
(when (pair? first)
(let ((op (car first)))
(when (and (symbol? op)
- (not (or (eq? op 'unquote)
+ (not (or (memq op '(unquote apply-values list-values))
(hash-table-ref makers op)
(eq? vname op))) ; not a function (this kind if repetition is handled elsewhere)
(len>1? (cdr hist))
(pair? (cdr first))
(not (side-effect? first env))
- (every? (lambda (a)
- (or (eq? a vname)
- (code-constant? a)))
- (cdr first))
+ (lint-every? (lambda (a)
+ (or (eq? a vname)
+ (code-constant? a)))
+ (cdr first))
(or (code-constant? (var-initial-value local-var))
- (tree-nonce vname first))
- (every? (lambda (a)
- (and (pair? a)
- (or (equal? first a)
- (and (eq? (hash-table-ref reversibles (car first)) (car a))
- (equal? (cdr first) (reverse (cdr a))))
- (set! op (match-cxr op (car a))))))
- (if (eq? otype 'parameter)
- (cdr hist)
- (copy (cdr hist) (make-list (- (length hist) 2))))))
+ (= (tree-count vname first 2) 1))
+ (lint-every? (lambda (a)
+ (and (pair? a)
+ (or (equal? first a)
+ (and (eq? (hash-table-ref reversibles (car first)) (car a))
+ (equal? (cdr first) (reverse (cdr a))))
+ (set! op (match-cxr op (car a))))))
+ (if (eq? otype 'parameter)
+ (cdr hist)
+ (copy (cdr hist) (make-list (- (length hist) 2))))))
(let* ((new-op (or op (car first)))
(set-target (let walker ((tree outer-form)) ; check for new-op dilambda as target of set!
(and (pair? tree)
@@ -11001,16 +11073,16 @@
(and (eq? (car init) 'quote)
(pair? (cdr init))
(pair? (cadr init))))
- (every? (lambda (p)
- (and (pair? p)
- (or (eq? p init)
- (eq? (car p) vname)
- (hash-table-ref cxars (car p))
- (memq (car p) '(list-ref list-set! length reverse map for-each
- list->vector list->string list? pair? null? quote)))))
- hist))
+ (lint-every? (lambda (p)
+ (and (pair? p)
+ (or (eq? p init)
+ (eq? (car p) vname)
+ (hash-table-ref cxars (car p))
+ (memq (car p) '(list-ref list-set! length reverse map for-each
+ list->vector list->string list? pair? null? quote)))))
+ hist))
(lint-format "~A could be a vector, rather than a list" caller vname))))))
-
+
;; -------- parlous-port
(define (parlous-port caller local-var outer-form)
;; look for port opened but not closed, or not used
@@ -11018,7 +11090,7 @@
(when (and (pair? outer-form)
(not (memq (var-definer local-var) '(call-with-input-string call-with-input-file call-with-output-string call-with-output-file)))
;; call-with-io-walker below uses open-input-string et al for the initial value to get type checks
- (let ((last (list-ref outer-form (- (length outer-form) 1))))
+ (let ((last (last-ref outer-form)))
(or (not (tree-memq (var-name local-var) last))
(and (pair? last)
(memq (car last) '(close-input-port close-output-port close-port close))))))
@@ -11026,19 +11098,19 @@
(open-set '(open-input-string open-input-file open-output-string open-output-file))
(open-form #f)
(vname (var-name local-var)))
- (when (any? (lambda (tree)
- (and (pair? tree)
- (or (and (memq (car tree) open-set)
- (not (and (pair? (cdr tree))
- (memq vname (cdr tree)))))
- (and (eq? (car tree) 'set!)
- (len>1? (cdr tree))
- (eq? (cadr tree) vname)
- (pair? (caddr tree))
- (memq (caaddr tree) open-set)))
- (set! open-form tree)))
- hist)
- (if (not (tree-set-member '(close-input-port close-output-port close-port close current-output-port current-input-port) hist))
+ (when (lint-any? (lambda (tree)
+ (and (pair? tree)
+ (or (and (memq (car tree) open-set)
+ (not (and (pair? (cdr tree))
+ (memq vname (cdr tree)))))
+ (and (eq? (car tree) 'set!)
+ (len>1? (cdr tree))
+ (eq? (cadr tree) vname)
+ (pair? (caddr tree))
+ (memq (caaddr tree) open-set)))
+ (set! open-form tree)))
+ hist)
+ (if (not (tree-set-memq '(close-input-port close-output-port close-port close current-output-port current-input-port) hist))
(lint-format "in ~A~% perhaps ~A is opened via ~A, but never closed" caller
(truncated-list->string outer-form)
vname open-form)
@@ -11140,7 +11212,10 @@
;; not ref'd or set
(if (not (memq vname '(documentation signature iterator? define-animal)))
- (let ((val (if (pair? (var-history local-var)) (car (var-history local-var)) (var-initial-value local-var)))
+ (let ((val (truncated-list->string
+ (if (pair? (var-history local-var))
+ (car (var-history local-var))
+ (var-initial-value local-var))))
(def (var-definer local-var)))
(let-temporarily ((line-number (if (eq? caller top-level:) -1 line-number)))
;; eval confuses this message (eval '(+ x 1)), no other use of x [perhaps check :let initial-value = outer-form]
@@ -11148,8 +11223,8 @@
(if (symbol? def)
(if (eq? otype 'parameter)
(lint-format "~A not used" caller vname)
- (lint-format "~A not used, initially: ~A from ~A" caller vname (truncated-list->string val) def))
- (lint-format "~A not used, value: ~A" caller vname (truncated-list->string val))))))))))
+ (lint-format "~A not used, initially: ~A from ~A" caller vname val def))
+ (lint-format "~A not used, value: ~A" caller vname val)))))))))
;; -------- move local var inward
(define (move-var-inward caller local-var)
@@ -11162,7 +11237,9 @@
(deflet (var-env local-var))
(source (var-initial-value local-var))
(vname (var-name local-var)))
- (if (and func
+ ;; if (define f (let ... (lambda ...))) the f is not in the deflet yet
+
+ (if (and deffunc
(pair? local-env))
(let crawler ((ref (cdr local-env)))
(if (pair? ref)
@@ -11173,7 +11250,7 @@
(when (and (pair? reflet)
(pair? deflet)
(not (eq? local-env reflet))
- (or func
+ (or deffunc
(code-constant? source))
;; code-constant? is very restrictive, but side-effect? leaves too many complications:
;; (let ((a (car b))) (set! b c) (let ...))
@@ -11202,7 +11279,7 @@
(cons (caar ref) largs)
largs)))))))
(and (> lets 2)
- (not (tree-set-member (let remove-args ((args let-args) (nargs ()))
+ (not (tree-set-memq (let remove-args ((args let-args) (nargs ()))
(if (null? args)
nargs
(remove-args (cdr args)
@@ -11224,11 +11301,6 @@
(not (and (pair? (caddr makval)) ; not lambda's closure
(null? (cdddr makval))
(memq (caaddr makval) '(lambda lambda*)))))))
-
- (if (and (not deffunc)
- (memq (car makval) '(define define*)))
- (set! makval `(define ,caller ...)))
-
(lint-format "perhaps move '~A~A into the inner let~A: ~A" caller
vname
(if (or deffunc
@@ -11259,7 +11331,7 @@
(let ((func #f)
(retcons? (and (pair? start) ; is this var's initial value from a function that returns a constant sequence?
(let ((v (var-member (car start) env)))
- (and (var? v)
+ (and v
(eq? (var-retcons v) #t))))))
(for-each (lambda (f)
(when (pair? f)
@@ -11269,7 +11341,7 @@
(eq? (cadr f) vname)
(pair? (caddr f))
(let ((v (var-member (caaddr f) env)))
- (and (var? v)
+ (and v
(eq? #t (var-retcons v))
(set! func f))))))
((string-set! list-set! vector-set! set-car! set-cdr!)
@@ -11487,10 +11559,10 @@
(and (not (memq (caar call) '(make-vector make-float-vector)))
(> (cdr call) (max 3 (/ 20 (tree-leaves (car call))))))) ; was 5
(or (null? (cddar call))
- (every? (lambda (p) ; make sure only current var is involved
- (or (not (symbol? p))
- (eq? p vname)))
- (cdar call))))
+ (lint-every? (lambda (p) ; make sure only current var is involved
+ (or (not (symbol? p))
+ (eq? p vname)))
+ (cdar call))))
(unless intro
(let ((str (format #f "~NC~A: ~A is not set, but "
lint-left-margin #\space
@@ -11559,19 +11631,19 @@
(set! res (cons i res))))))
(if (and (pair? unused)
(or (null? (cddr p))
- (every? (lambda (arg)
- (and (pair? arg)
- (eq? (car arg) 'lambda)
- (proper-list? (cadr arg))
- (let ((new-unused (copy unused)))
- (for-each (lambda (parnum)
- (let ((par-name (list-ref (cadr arg) parnum)))
- (if (tree-memq par-name (cddr arg))
- (set! new-unused (remove parnum new-unused)))))
- unused)
- (and (pair? new-unused)
- (set! unused new-unused)))))
- (cddr p))))
+ (lint-every? (lambda (arg)
+ (and (pair? arg)
+ (eq? (car arg) 'lambda)
+ (proper-list? (cadr arg))
+ (let ((new-unused (copy unused)))
+ (for-each (lambda (parnum)
+ (let ((par-name (list-ref (cadr arg) parnum)))
+ (if (tree-memq par-name (cddr arg))
+ (set! new-unused (remove parnum new-unused)))))
+ unused)
+ (and (pair? new-unused)
+ (set! unused new-unused)))))
+ (cddr p))))
(lint-format "~A parameter ~A is a function whose parameter~P ~{~A~^, ~} ~A never used" caller
vname (car p)
(length unused)
@@ -11656,10 +11728,8 @@
(do ((clause (var-history local-var) (cdr clause)))
((null? (cdr clause))) ; ignore the initial value which depends on a different env
(let ((call (car clause)))
- (if (or (= line-number -1)
- (and (pair? call)
- (positive? (pair-line-number call))))
- (set! line-number (pair-line-number call)))
+ (if (pair? call)
+ (set! line-number (or (pair-line-number call) line-number)))
(when (pair? call)
(let ((func (car call))
@@ -11751,17 +11821,17 @@
;; here all but last result exprs are already checked
;; redundant begin can confuse this, but presumably we'll complain about that elsewhere
;; also even in mid-body, if else clause has a side-effect, an earlier otherwise pointless clause might be avoiding that
- (let ((has-else (let ((last-clause (list-ref f (- (length f) 1))))
+ (let ((has-else (let ((last-clause (last-ref f)))
(and (pair? last-clause)
(memq (car last-clause) '(else #t))
- (any? (lambda (c)
- (side-effect? c env))
- (cdr last-clause))))))
+ (lint-any? (lambda (c)
+ (side-effect? c env))
+ (cdr last-clause))))))
(for-each (lambda (c)
(if (and (len>1? c)
(proper-list? c)
(not (memq '=> (cdr c))))
- (let ((last-expr (list-ref c (- (length c) 1))))
+ (let ((last-expr (last-ref c)))
(cond ((side-effect? last-expr env)
(if (pair? last-expr)
(check-returns caller last-expr env)))
@@ -11776,7 +11846,7 @@
(truncated-list->string c)))))
((and (eq? (car f) 'case)
(or (eq? last-expr (cadr c))
- (not (any? (lambda (p) (side-effect? p env)) (cdr c)))))
+ (not (lint-any? (lambda (p) (side-effect? p env)) (cdr c)))))
(lint-format "this case clause can be omitted: ~A" caller
(truncated-list->string c)))
@@ -11788,7 +11858,7 @@
((let let*)
(if (and (len>1? (cdr f))
(not (symbol? (cadr f))))
- (let ((last-expr (list-ref f (- (length f) 1))))
+ (let ((last-expr (last-ref f)))
(if (side-effect? last-expr env)
(if (pair? last-expr)
(check-returns caller last-expr env))
@@ -11819,7 +11889,7 @@
((letrec letrec* with-let unless when begin with-baffle)
(if (len>1? (cdr f))
- (let ((last-expr (list-ref f (- (length f) 1))))
+ (let ((last-expr (last-ref f)))
(if (side-effect? last-expr env)
(if (pair? last-expr)
(check-returns caller last-expr env))
@@ -11834,7 +11904,7 @@
(let* ((end+res (caddr f))
(len (or (length end+res) -1)))
(if (> len 1)
- (list-ref end+res (- (length end+res) 1)))))))
+ (last-ref end+res))))))
(unless (eq? returned #<unspecified>)
(if (and (pair? returned)
(side-effect? returned env))
@@ -11888,7 +11958,7 @@
(define (escape? form env)
(and (pair? form)
(let ((v (var-member (car form) env)))
- (if (var? v)
+ (if v
(memq (var-definer v) '(call/cc call-with-current-continuation call-with-exit))
(memq (car form) '(error throw))))))
@@ -11907,8 +11977,9 @@
(fbody (cddar body)))
(when (and (symbol? fname)
(proper-list? fargs)
- (tree-nonce fname (cdr body))
- (not (any? keyword? fargs)))
+ (proper-list? body)
+ (= (tree-count fname (cdr body) 2) 1)
+ (not (lint-any? keyword? fargs)))
(let ((call (find-call fname (cdr body))))
(when (pair? call)
(let ((new-args (if (eq? (caar body) 'define)
@@ -11931,7 +12002,7 @@
;; (... (define* (f1 a b) (+ a b)) (f1 :c 1)) -> (... (let ((a :c) (b 1)) (+ a b)))
(lint-format "perhaps ~A" caller
(lists->string (cons '... body)
- (if (= (tree-count2 fname body) 2)
+ (if (= (tree-count fname body 3) 2)
(if (null? fargs)
(if (null? (cdr fbody))
(cons '... (tree-subst (car fbody) call (cdr body)))
@@ -11974,10 +12045,10 @@
expr
(list (car expr) '...))
vars&vals))
- (if (tree-set-member names (cdr expr))
+ (if (tree-set-memq names (cdr expr))
(set! letx 'let*))
(set! names (cons (car expr) names)))))))
-
+
(let ((len (length body)))
(when (> len 2) ; ... (define (x...)...) (x ...) -> (let (...) ...) or named let -- this happens a lot!
(let ((n-1 (list-ref body (- len 2))) ; or (define (x ...)...) (some expr calling x once) -> named let etc
@@ -11991,7 +12062,7 @@
(eqv? (length (cdadr n-1)) (length (cdr n)))) ; not values -> let!
(and (< (tree-leaves n-1) 12)
(tree-car-member (caadr n-1) (cdr n)) ; skip car -- see preceding
- (tree-nonce (caadr n-1) n))))
+ (= (tree-count (caadr n-1) n 2) 1))))
(let ((outer-form (cond ((var-member :let env) => var-initial-value) (else #f)))
(new-var (caadr n-1)))
(when (and (pair? outer-form)
@@ -12023,14 +12094,14 @@
(eq? (car expr) 'define))
(let ((name (and (symbol? (cadr expr)) (cadr expr))))
(when name
- (do ((last-ref k)
+ (do ((lastref k)
(p (cdr q) (cdr p))
(i (+ k 1) (+ i 1)))
((null? p)
- (if (and (< k last-ref (+ k 2))
+ (if (and (< k lastref (+ k 2))
(pair? (list-ref body (+ k 1))))
- (let ((end-dots (if (< last-ref (- len 1)) '(...) ()))
- (letx (if (tree-member name (cddr expr)) 'letrec 'let))
+ (let ((end-dots (if (< lastref (- len 1)) '(...) ()))
+ (letx (if (tree-memq name (cddr expr)) 'letrec 'let))
(use-expr (list-ref body (+ k 1)))
(seen-earlier (or (var-member name env)
(do ((s body (cdr s)))
@@ -12090,11 +12161,11 @@
,(caddr use-expr)))
, at end-dots))))))))
(when (and (> len 3)
- (< k last-ref (+ k 3)) ; larger cases happen very rarely -- 3 or 4 altogether
+ (< k lastref (+ k 3)) ; larger cases happen very rarely -- 3 or 4 altogether
(pair? (list-ref body (+ k 1)))
(pair? (list-ref body (+ k 2))))
- (let ((end-dots (if (< last-ref (- len 1)) '(...) ()))
- (letx (if (tree-member name (cddr expr)) 'letrec 'let))
+ (let ((end-dots (if (< lastref (- len 1)) '(...) ()))
+ (letx (if (tree-memq name (cddr expr)) 'letrec 'let))
(seen-earlier (or (var-member name env)
(do ((s body (cdr s)))
((or (eq? s q)
@@ -12104,8 +12175,8 @@
(unless seen-earlier
(let ((use-expr1 (list-ref body (+ k 1)))
(use-expr2 (list-ref body (+ k 2))))
- (if (not (or (tree-set-member '(define lambda) use-expr1)
- (tree-set-member '(define lambda) use-expr2)))
+ (if (not (or (tree-set-memq '(define lambda) use-expr1)
+ (tree-set-memq '(define lambda) use-expr2)))
;; (... (define f101 (lambda (y) (+ x y))) (display 41) (f101 2)) ->
;; (... (let ((f101 (lambda (y) (+ x y)))) (display 41) (f101 2)))
(lint-format "the scope of ~A could be reduced: ~A" caller name
@@ -12116,7 +12187,7 @@
,use-expr2)
, at end-dots)))))))))))
(when (tree-memq name (car p))
- (set! last-ref i)))))))))
+ (set! lastref i)))))))))
(when (= suggest made-suggestion)
;; look for define+binding-expr at end and combine
@@ -12145,10 +12216,10 @@
;; (... (define z (f x)) (do ((i z (+ i 1))) ((= i 3)) (display (+ z i))) ...) -> (do ((i (f x) (+ i 1))) ((= i 3)) (display (+ z i)))
(lint-format "perhaps ~A" caller
(lists->string (list '... prev-f f '...)
- (if (any? (lambda (p)
- (and (len>1? p)
- (tree-memq (cadr prev-f) (cadr p))))
- (cadr f))
+ (if (lint-any? (lambda (p)
+ (and (len>1? p)
+ (tree-memq (cadr prev-f) (cadr p))))
+ (cadr f))
(if (and (eq? (cadr prev-f) (cadr (caadr f)))
(null? (cdadr f)))
`(do ((,(caaadr f) ,(caddr prev-f) ,(caddr (caadr f)))) ,@(cddr f))
@@ -12157,9 +12228,10 @@
,@(cadr f))
,@(cddr f)))))
;; just changing define -> let seems officious, though it does reduce (cadr prev-f)'s scope
- (if (or (and (eq? (car f) 'let)
- (not (tree-memq (cadr prev-f) (cadr f))))
- (eq? (car f) 'let*))
+ (if (and (proper-list? (cadr f))
+ (or (and (eq? (car f) 'let)
+ (not (tree-memq (cadr prev-f) (cadr f))))
+ (eq? (car f) 'let*)))
(lint-format "perhaps ~A" caller
(lists->string
`(... ,prev-f ,f ,@(if (null? (cdr fs)) () '(...)))
@@ -12412,9 +12484,8 @@
,@(do ((more ())
(nfs (cdr fs) (cdr nfs)))
((let ((nf (if (pair? nfs) (car nfs) ())))
- (not (and (pair? nf)
+ (not (and (len=3? nf)
(eq? (car nf) 'if)
- (= (length nf) 3)
(pair? (cadr nf))
(memq (caadr nf) '(eq? eqv? = char=?))
(equal? a1 (cadadr nf))
@@ -12466,8 +12537,9 @@
func
(map unquoted (reverse args)))
(let ((v (var-member func-name env))) ; only use of env
- (if (or (and (var? v)
+ (if (or (and v
(memq (var-ftype v) '(define define* lambda lambda*)))
+ (procedure? func-name) ; e.g. list-values??
(procedure? (symbol->value func-name *e*)))
;; (let () (write-byte 0) (write-byte 1) (write-byte 2) (write-byte 3) (write-byte 4)) ->
;; (for-each write-byte '(0 1 2 3 4))
@@ -12477,7 +12549,7 @@
pp-left-margin #\space
func
(reverse args))
- (if (not (or (var? v)
+ (if (not (or v
(macro? (symbol->value func-name *e*))))
;; (let () (writ 0) (writ 1) (writ 2) (writ 3) (writ (* x 2))) -> (for-each writ (vector 0 1 2 3 (* x 2)))
(lint-format "assuming ~A is not a macro, perhaps ~A" caller
@@ -12533,7 +12605,7 @@
(lint-format "perhaps ~A" caller (lists->string f (list 'set! settee (cadr prev-f))))))
((not (and (pair? arg2) ; (set! x 0) (set! x 1) -> "this could be omitted: (set! x 0)"
- (tree-unquoted-member settee arg2)))
+ (tree-memq settee arg2)))
(if (not (or (side-effect? arg1 env)
(side-effect? arg2 env)))
(lint-format "this could be omitted: ~A" caller prev-f)))
@@ -12560,7 +12632,7 @@
prev-f f
`(set! ,settee (append ,settee ,@(cddr arg1) ,@(cddr arg2)))))
- ((and (tree-nonce settee arg2) ; (set! x y) (set! x (+ x 1)) -> (set! x (+ y 1))
+ ((and (= (tree-count settee arg2 2) 1) ; (set! x y) (set! x (+ x 1)) -> (set! x (+ y 1))
(or (not (pair? arg1))
(< (tree-leaves arg1) 5)))
(lint-format "perhaps ~A ~A ->~%~NC~A" caller
@@ -12570,8 +12642,8 @@
;; -------- redundant-set --------
(define (redundant-set caller prev-f f env)
(cond ((and (eq? f #t)
- (or (and (eq? (car prev-f) 'set!)
- (len=2? (cdr prev-f))
+ (if (eq? (car prev-f) 'set!)
+ (and (len=2? (cdr prev-f))
(pair? (caddr prev-f))
(arg-signature (caaddr prev-f) env))
(arg-signature (car prev-f) env)))
@@ -12596,7 +12668,7 @@
(car prev-f) (truncated-list->string f))))
((vector-set! float-vector-set! int-vector-set! string-set! list-set! hash-table-set! let-set! set-car! set-cdr!)
- (if (equal? f (list-ref prev-f (- (length prev-f) 1)))
+ (if (equal? f (last-ref prev-f))
;; (begin (vector-set! x 0 (* y 2)) (* y 2))
(lint-format "~A returns the new value, so this could be omitted: ~A" caller
(car prev-f) (truncated-list->string f)))
@@ -12656,7 +12728,7 @@
(cadr prev-f)
(caddr prev-f)))
- ((= (tree-count2 f body) 2)
+ ((= (tree-count f body 3) 2)
;; (let () (define (f1 x) (+ x 1)) f1) -> (lambda (x) ...)
(lint-format "perhaps omit ~A, and change ~A" caller
f
@@ -12684,12 +12756,12 @@
(define (check-escape caller fs f next-to-last? env)
(if (and (escape? f env)
(pair? (cdr fs)) ; do special case
- (every? (lambda (arg)
- (not (and (symbol? arg)
- (let ((v (var-member arg env)))
- (and (var? v)
- (eq? (var-initial-value v) :call/cc))))))
- (cdr f)))
+ (lint-every? (lambda (arg)
+ (not (and (symbol? arg)
+ (let ((v (var-member arg env)))
+ (and v
+ (eq? (var-initial-value v) :call/cc))))))
+ (cdr f)))
(if next-to-last?
;; (let () (error 'oops "an error") #t)
(lint-format "~A makes this pointless: ~A" caller
@@ -12741,13 +12813,13 @@
(eq? (cadr f) (cadr fs)))
(and (symbol? (car prev-f))
(or (and (eq? (car prev-f) 'begin)
- (every? (lambda (p)
- (and (pair? p)
- (symbol? (car p))
- (let ((fstr (symbol->string (car p))))
- (and (>= (length fstr) 6)
- (string=? (substring fstr 0 6) "define")))))
- (cdr prev-f)))
+ (lint-every? (lambda (p)
+ (and (pair? p)
+ (symbol? (car p))
+ (let ((fstr (symbol->string (car p))))
+ (and (>= (length fstr) 6)
+ (string=? (substring fstr 0 6) "define")))))
+ (cdr prev-f)))
(memq (car prev-f) '(use declare require hash-table-set! test assert))
;; check for (if ... (define...)) as prev-f got only 1 hit
(let ((fstr (symbol->string (car prev-f))))
@@ -12769,7 +12841,6 @@
;; -------- walk-open-body --------
(lambda (caller head body env)
;; walk a body (a list of forms, the value of the last of which might be returned)
-
(if (not (proper-list? body))
(lint-format "stray dot? ~A" caller (truncated-list->string body))
@@ -12830,7 +12901,8 @@
(when (or (not feq)
(= ctr (- len 1))) ; this assumes we're not returning the last value?
(when (and (> repeats 2)
- (not (hash-table-ref syntaces (car prev-f)))) ; macros should be ok here if args are constants
+ (or (zero? repeat-arg) ; all forms are the identical
+ (not (hash-table-ref syntaces (car prev-f))))) ; macros should be ok here if args are constants
(repeats->for-each caller prev-f (if (not feq) fs (cdr fs)) repeats start-repeats repeat-arg env))
(set! repeats 0)
(set! repeat-arg 0)
@@ -12884,7 +12956,7 @@
(if (and macdef
(pair? f)
- (tree-member 'unquote f))
+ (tree-memq 'unquote f))
(lint-format "~A probably has too many unquotes: ~A" caller head (truncated-list->string f)))
(set! prev-f f)
@@ -12917,15 +12989,14 @@
(define (return-walker last func)
- (if (not (pair? last))
+ (if (not (and (pair? last)
+ (proper-list? last)))
(func last)
(case (car last)
((begin let let* letrec letrec* when unless with-baffle with-let)
(when (pair? (cdr last))
- (let ((len (length last)))
- (when (positive? len)
- (return-walker (list-ref last (- len 1)) func)))))
+ (return-walker (last-ref last) func)))
((if)
(when (len>1? (cdr last))
@@ -12937,36 +13008,48 @@
(when (pair? (cdr last))
(for-each (lambda (c)
(when (pair? c)
- (let ((len (length c)))
- (if (and (integer? len)
- (> len 1))
- (return-walker (list-ref c (- len 1)) func)))))
+ (return-walker (last-ref c) func)))
(cdr last))))
((case)
(when (len>1? (cdr last))
(for-each (lambda (c)
(when (pair? c)
- (let ((len (length c)))
- (if (and (integer? len)
- (> len 1))
- (return-walker (list-ref c (- len 1)) func)))))
+ (return-walker (last-ref c) func)))
(cddr last))))
((do)
(if (and (len>1? (cdr last))
(proper-list? (caddr last))
(len>1? (caddr last)))
- (return-walker (list-ref (caddr last) (- (length (caddr last)) 1)) func)))
+ (return-walker (last-ref (caddr last)) func)))
((set!)
(if (len>1? (cdr last))
(func (caddr last))))
+ ((not)
+ (func #f))
+
+ ((or)
+ (func #f)
+ (for-each (lambda (c)
+ (return-walker c func))
+ (cdr last)))
+
+ ((and)
+ (func #f)
+ (return-walker (last-ref last) func))
+
+ ((dynamic-wind catch)
+ (let ((body (and (= (length last) 4)
+ (caddr last))))
+ (if (and (pair? body)
+ (eq? (car body) 'lambda))
+ (return-walker (last-ref (cddr body)) func))))
+
(else (func last)) ; includes quote
- ;; call-with-exit et al also or|and
- ;; or|and -- call return-walker on each entry?
;; call-with-exit: walker on last on body, and scan for return func, walker on arg(s...)->values?
)))
@@ -13023,7 +13106,7 @@
(symbol? lint-function-name)
(pair? form) ; this is (car lint-function-body)
(null? (cdr lint-function-body))
- (not (tree-table-member definers (cdr form))))
+ (not (tree-set-memq definers (cdr form))))
(for-each
(lambda (local-var)
(let ((vname (var-name local-var))
@@ -13031,26 +13114,26 @@
(when (and (zero? (var-set local-var))
(not (eq? (var-definer local-var) 'parameter))
(constant-expression? vvalue env)
- (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)))
+ (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)))
(lint-format "~A can ~Abe moved to ~A's closure" lint-function-name
- vname
- (if (any? (lambda (p)
- (and (pair? p)
- (side-effect? p env)))
- (var-history local-var))
- "probably "
- "")
- (if (not (or (keyword? lint-function-name)
- (memq lint-function-name '(let let* letrec))))
- lint-function-name
- "the enclosing function")))))
+ vname
+ (if (lint-any? (lambda (p)
+ (and (pair? p)
+ (side-effect? p env)))
+ (var-history local-var))
+ "probably "
+ "")
+ (if (not (or (keyword? lint-function-name)
+ (memq lint-function-name '(let let* letrec))))
+ lint-function-name
+ "the enclosing function")))))
vars)
(set! lint-function-name #f)))
@@ -13087,15 +13170,16 @@
(let ((tag 'yup))
(catch 'sequence-constant-done
(lambda ()
- (check-sequence-constant function-name (list-ref body (- (length body) 1))) ; some of these are innocuous -- lambda forms in midst of outer body etc
+ (check-sequence-constant function-name (last-ref body)) ; some of these are innocuous -- lambda forms in midst of outer body etc
(set! tag 'nope))
(lambda args #f))
(if (eq? tag 'yup)
(let ((v (var-member function-name env)))
- (if (var? v)
+ (if (and v
+ (symbol? (var-ftype v)))
(set! (var-retcons v) #t)))))
- (set! lint-function-body body)
+ (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))
@@ -13126,7 +13210,6 @@
(if (or (procedure? p)
(let ((e (var-member cval env) ))
(and e
- (var? e)
(symbol? (var-ftype e))
(let ((def (var-initial-value e))
(e-args (var-arglist e)))
@@ -13208,52 +13291,30 @@
((4) (lint-format "~A could be (define ~A cddddr)" function-name function-name function-name)))))))
(let ((fvar (and (symbol? function-name)
- (make-fvar :name (case definer
- ((lambda lambda*) :lambda)
- ((dilambda) :dilambda)
- (else function-name))
- :ftype definer
- :initial-value form
- :env env
- :arglist ((case definer
- ((lambda lambda*) cadr)
- ((defmacro defmacro*) caddr)
- (else cdadr))
- form)))))
+ (let ((fname (case definer
+ ((lambda lambda*) :lambda)
+ ((dilambda) :dilambda)
+ (else function-name)))
+ (fargs ((case definer
+ ((lambda lambda*) cadr)
+ ((defmacro defmacro*) caddr)
+ (else cdadr))
+ form)))
+ (make-fvar fname definer fargs form env)))))
(when fvar
- (let ((fvar-let (cdr fvar)))
- (set! (fvar-let 'decl)
- (catch #t
- (lambda ()
- (case definer
- ((lambda)
- (set! (fvar-let 'allow-other-keys) #t)
- (eval (list definer (cadr form) #f)))
-
- ((lambda*)
- (set! (fvar-let 'allow-other-keys) (eq? (last-par (cadr form)) :allow-other-keys))
- (eval (list definer (copy (cadr form)) #f))) ; eval can remove :allow-other-keys!
-
- ((define*)
- (set! (fvar-let 'allow-other-keys) (eq? (last-par (cdadr form)) :allow-other-keys))
- (eval (list definer (cons '_ (copy (cdadr form))) #f)))
-
- ((defmacro defmacro*)
- (set! (fvar-let 'allow-other-keys) (or (not (eq? definer 'defmacro*))
- (eq? (last-par (caddr form)) :allow-other-keys)))
- (eval (list definer '_ (caddr form) #f)))
-
- ((define-constant)
- (set! (fvar-let 'allow-other-keys) #t)
- (eval (list 'define (cons '_ (cdadr form)) #f)))
-
- (else
- (set! (fvar-let 'allow-other-keys) (or (not (memq definer '(define-macro* define-bacro*)))
- (eq? (last-par (cdadr form)) :allow-other-keys)))
- (eval (list definer (cons '_ (cdadr form)) #f)))))
- (lambda args
- 'error)))))
-
+ (let-set! (cdr fvar) 'allow-other-keys
+ (case definer
+ ((lambda define-constant) #t)
+ ((lambda*) (eq? (last-ref (cadr form)) :allow-other-keys))
+ ((define*) (eq? (last-ref (cdadr form)) :allow-other-keys))
+ ((defmacro defmacro*)
+ (or (not (eq? definer 'defmacro*))
+ (and (pair? (caddr form))
+ (eq? (last-ref (caddr form)) :allow-other-keys))))
+ (else
+ (or (not (memq definer '(define-macro* define-bacro*)))
+ (eq? (last-ref (cdadr form)) :allow-other-keys))))))
+
(if (null? args)
(begin
(if (memq definer '(define* lambda* defmacro* define-macro* define-bacro*))
@@ -13301,42 +13362,41 @@
(env-difference function-name e cur-env ())))))
(report-usage function-name definer (append (or nvars ()) args-as-vars) cur-env))
- (when (and (var? fvar)
- (memq definer '(define lambda define-macro)))
- ;; look for unused parameters that are passed a value other than #f
- (let ((set ())
- (unused ()))
- (for-each
- (lambda (arg-var)
- (if (zero? (var-ref arg-var))
- (if (positive? (var-set arg-var))
- (set! set (cons (var-name arg-var) set))
- (if (not (memq (var-name arg-var) '(documentation signature iterator?)))
- (set! unused (cons (var-name arg-var) unused))))))
- args-as-vars)
- (when (or (pair? set)
- (pair? unused))
- (let ((proper-args (args->proper-list args)))
- (let ((sig (var-signature fvar))
- (len (+ (length proper-args) 1)))
- (if (not sig)
- (set! sig (make-list len #t))
- (if (< (length sig) len)
- (set! sig (copy sig (make-list len #t)))))
- (let ((siglist (cdr sig)))
- (for-each
- (lambda (arg)
- (if (memq arg unused)
- (set-car! siglist 'unused-parameter?)
- (if (memq arg set)
- (set-car! siglist 'unused-set-parameter?)))
- (set! siglist (cdr siglist)))
- proper-args))
- (set! (var-signature fvar) sig))))))
- (if fvar
- (cons fvar env)
- env))))))
-
+ (if (not fvar)
+ env
+ (begin
+ (when (memq definer '(define lambda define-macro))
+ ;; look for unused parameters that are passed a value other than #f
+ (let ((set ())
+ (unused ()))
+ (for-each
+ (lambda (arg-var)
+ (if (zero? (var-ref arg-var))
+ (if (positive? (var-set arg-var))
+ (set! set (cons (var-name arg-var) set))
+ (if (not (memq (var-name arg-var) '(documentation signature iterator?)))
+ (set! unused (cons (var-name arg-var) unused))))))
+ args-as-vars)
+ (when (or (pair? set)
+ (pair? unused))
+ (let ((proper-args (args->proper-list args)))
+ (let ((sig (var-signature fvar))
+ (len (+ (length proper-args) 1)))
+ (if (not sig)
+ (set! sig (make-list len #t))
+ (if (< (length sig) len)
+ (set! sig (copy sig (make-list len #t)))))
+ (let ((siglist (cdr sig)))
+ (for-each
+ (lambda (arg)
+ (if (memq arg unused)
+ (set-car! siglist 'unused-parameter?)
+ (if (memq arg set)
+ (set-car! siglist 'unused-set-parameter?)))
+ (set! siglist (cdr siglist)))
+ proper-args))
+ (set! (var-signature fvar) sig))))))
+ (cons fvar env))))))))
(define (check-bool-cond caller form c1 c2 env)
;; (cond (x #f) (#t #t)) -> (not x)
@@ -13478,17 +13538,17 @@
(pair? (caddr clause))
(eq? (caaddr clause) 'quote)
(or (not (eq? (car clause) 'member))
- (every? (lambda (x)
- (or (number? x)
- (char? x)
- (symbol? x)
- (memq x '(#t #f () #<unspecified> #<undefined> #<eof>))))
- (cdr (caddr clause))))))
+ (lint-every? (lambda (x)
+ (or (number? x)
+ (char? x)
+ (symbol? x)
+ (memq x '(#t #f () #<unspecified> #<undefined> #<eof>))))
+ (cdaddr clause)))))
((or)
(and or-ok
- (every? (lambda (p)
- (cond-eqv? p eqv-select #f))
- (cdr clause))))
+ (lint-every? (lambda (p)
+ (cond-eqv? p eqv-select #f))
+ (cdr clause))))
((not null? eof-object? zero? boolean?)
(equal? eqv-select (cadr clause)))
@@ -13555,15 +13615,15 @@
(a inner-args (cdr a)))
((or (null? p)
(not (pair? a))
- (not (pair? (car a)))
+ (not (len=2? (car a)))
(pair? (caar a))
(and (not (eq? (car p) (caar a)))
(tree-memq (car p) inner-body)))
;; args can be reversed, but rarely match as symbols
(when (and (null? p)
(or (null? a)
- (and (null? (cdr a))
- (pair? (cdar a))
+ (and (len=1? a)
+ (len>1? (car a))
(code-constant? (cadar a)))))
(let* ((args-match (do ((p1 outer-args (cdr p1))
(a1 inner-args (cdr a1)))
@@ -13651,31 +13711,23 @@
(if (and (eq? (var-definer v) 'define-constant)
(len>2? form)
(not (equal? (caddr form) (var-initial-value v))))
- (let ((line (if (and (pair? (var-initial-value v))
- (positive? (pair-line-number (var-initial-value v))))
- (format #f "(line ~D): " (pair-line-number (var-initial-value v)))
- "")))
+ (let ((line (and (pair? (var-initial-value v))
+ (pair-line-number (var-initial-value v)))))
(lint-format "~A in ~A is already a constant, defined ~A~A" caller sym
(truncated-list->string form)
- line
+ (if line (format #f "(line ~D): " line) "")
(truncated-list->string (var-initial-value v)))))))
((memq sym '(else =>)) ; also in r7rs ... and _, but that is for syntax-rules
(lint-format "redefinition of ~A is a bad idea: ~A" caller sym (truncated-list->string form)))))
- (define binders (let ((h (make-hash-table)))
- (for-each
- (lambda (op)
- (set! (h op) #t))
- '(let let* letrec letrec* do
- lambda lambda* define define*
- call/cc call-with-current-continuation
- define-macro define-macro* define-bacro define-bacro* define-constant define-expansion
- load eval eval-string require))
- h))
-
(define walker-functions
- (let ((walker-table (make-hash-table))
+ (let ((binders '(let let* letrec letrec* do
+ lambda lambda* define define*
+ call/cc call-with-current-continuation
+ define-macro define-macro* define-bacro define-bacro* define-constant define-expansion
+ load eval eval-string require))
+ (walker-table (make-hash-table))
(lint-let-reduction-factor 3)) ; maybe make this a global switch -- the higher this number, the fewer let-reduction suggestions
(define (hash-walker key value)
@@ -13704,16 +13756,18 @@
(for-each (lambda (f)
(if (not (func-definer? f))
(set! all-bad #t)
- (let ((fname ((if (symbol? (cadr f)) cadr caadr) f)))
+ (let ((fname ((if (symbol? (cadr f)) cadr (if (pair? (cadr f)) caadr not)) f)))
(if (or all-bad
+ (not (symbol? fname))
(memq fname largs)
+ (not (pair? ((if (symbol? (cadr f)) (if (len>1? (caddr f)) caddr not) cadr) f)))
(let ((fargs (args->proper-list (if (symbol? (cadr f)) (cadr (caddr f)) (cdadr f)))))
- (tree-set-member (remq-set fargs largs) (cddr f))))
+ (tree-set-memq (remq-set fargs largs) (cddr f))))
(set! bad-funcs (cons fname bad-funcs))
(set! ok-funcs (cons (cons fname f) ok-funcs))))))
body)
(map (lambda (f)
- (if (tree-set-member bad-funcs (cdddr f))
+ (if (tree-set-memq bad-funcs (cdddr f))
(values)
f))
(reverse ok-funcs))))
@@ -13773,18 +13827,18 @@
(and (len=1? (cdr var&val))
(len>2? (cadr var&val))
(memq (caadr var&val) '(lambda lambda*))
- (let* ((val (cadr var&val))
- (fargs (args->proper-list (cadr val))))
+ (let* ((val (cdadr var&val))
+ (fargs (args->proper-list (car val))))
(if (memq let-case '(letrec letrec*))
(set! fargs (cons (car var&val) fargs)))
- (not (tree-set-member (let remove-shadows ((args largs) (nargs ()))
+ (not (tree-set-memq (let remove-shadows ((args largs) (nargs ()))
(if (null? args)
nargs
(remove-shadows (cdr args)
(if (memq (car args) fargs)
nargs
(cons (car args) nargs)))))
- (cddr val))))))))
+ (cdr val))))))))
(lambda (caller form outer-args define-case)
(let ((largs (args->proper-list outer-args))
@@ -13796,7 +13850,7 @@
(len>2? (car body))
(memq (caar body) '(let let* letrec letrec*))
(proper-list? (cadar body))
- (every? pair? (cadar body))
+ (lint-every? pair? (cadar body))
(pair? (cddar body)))
(if (func-definer? (caddar body))
(largs->let caller form
@@ -13808,9 +13862,9 @@
(let ((let-case (caar body))) ; if not 'let, add locals to outer-args
(unless (or (eq? let-case 'let)
(and (eq? let-case 'letrec)
- (every? (lambda (p)
- (ok-func? p let-case largs))
- (cadar body))))
+ (lint-every? (lambda (p)
+ (ok-func? p let-case largs))
+ (cadar body))))
(set! largs (append largs (map car (cadar body)))))
(do ((ok-funcs ())
(p (cadar body) (cdr p)))
@@ -13839,64 +13893,67 @@
(keyword? body))
(or (not (pair? body))
(and (eq? (car body) 'quote)
+ (pair? (cdr body))
(not (symbol? (cadr body)))
(not (unquoted-pair? (cadr body))))
(not (or (memq (car body) '(quote quasiquote list cons append))
- (tree-set-member '(#_list-values #_apply-values #_append) body)))))
+ (tree-set-memq '(list-values apply-values append) body)))))
(lint-format "perhaps ~A or ~A" caller
- (lists->string form (list 'define outer-name (unquoted (car val))))
- (truncated-list->string (list 'define (list outer-name) (unquoted (car val))))))
+ (lists->string form (list 'define outer-name (unquoted body)))
+ (truncated-list->string (list 'define (list outer-name) (unquoted body)))))
(when (pair? body)
- (case (car body)
- ((#_list-values)
- (when (quoted-symbol? (cadr body))
- (if (proper-list? outer-args)
- (if (and (equal? (cddr body) outer-args)
- (or (not (hash-table-ref syntaces (cadadr body))) ; (define-macro (x y) `(lambda () ,y))
- (memq (cadadr body) '(set! define))))
- (lint-format "perhaps ~A" caller ; (define-macro (fx x) `(abs ,x)) -> (define fx abs)
- (lists->string form (list 'define outer-name (cadadr body))))
-
- (if (and (not (hash-table-ref syntaces (cadadr body)))
- (not (any-macro? (cadadr body) env))
- (every? (lambda (a)
- (or (code-constant? a)
- (and (memq a outer-args)
- (tree-nonce a (cddr body)))))
- (cddr body)))
- ;; marginal -- there are many debatable cases here
- (lint-format "perhaps ~A" caller
- (lists->string form `(define (,outer-name , at outer-args)
- (,(cadadr body) ,@(map unquoted (cddr body))))))))
-
- (if (or (and (symbol? outer-args) ; (define-macro (f . x) `(+ , at x)) -> (define f +)
- (len=2? (cdr body))
- (len=2? (caddr body))
- (memq (caaddr body) '(#_apply-values apply-values))
- (eq? (cadr (caddr body)) outer-args))
- (and (eqv? (length outer-args) -1) ; (define-macro (f a . x) `(+ a , at x)) -> (define f +)
- (len=3? (cdr body))
- (eq? (caddr body) (car outer-args))
- (len=2? (cadddr body))
- (memq (car (cadddr body)) '(#_apply-values apply-values))
- (eq? (cadr (cadddr body)) (cdr outer-args))))
- (lint-format "perhaps ~A" caller
- (lists->string form (list 'define outer-name (cadadr body)))))))
-
- (let ((pargs (args->proper-list outer-args)))
- (for-each (lambda (p)
- (if (and (quoted-pair? p)
- (tree-set-member pargs (cadr p)))
- (lint-format "missing comma? ~A" caller form)))
- (cdr body))))
-
- ((quote)
- ;; extra comma (unquote) is already caught elsewhere
- (if (and (pair? (cdr body))
- (pair? (cadr body))
- (tree-set-member (args->proper-list outer-args) (cadr body)))
- (lint-format "missing comma? ~A" caller form)))))))))
+ (let ((args (cdr body)))
+ (case (car body)
+ ((list-values)
+ (when (and (pair? args)
+ (quoted-symbol? (car args)))
+ (if (proper-list? outer-args)
+ (if (and (equal? (cdr args) outer-args)
+ (or (not (hash-table-ref syntaces (cadar args))) ; (define-macro (x y) `(lambda () ,y))
+ (memq (cadar args) '(set! define))))
+ (lint-format "perhaps ~A" caller ; (define-macro (fx x) `(abs ,x)) -> (define fx abs)
+ (lists->string form (list 'define outer-name (cadar args))))
+
+ (if (and (not (hash-table-ref syntaces (cadar args)))
+ (not (any-macro? (cadar args) env))
+ (lint-every? (lambda (a)
+ (or (code-constant? a)
+ (and (memq a outer-args)
+ (= (tree-count a (cdr args) 2) 1))))
+ (cdr args)))
+ ;; marginal -- there are many debatable cases here
+ (lint-format "perhaps ~A" caller
+ (lists->string form `(define (,outer-name , at outer-args)
+ (,(cadar args) ,@(map unquoted (cdr args))))))))
+
+ (if (or (and (symbol? outer-args) ; (define-macro (f . x) `(+ , at x)) -> (define f +)
+ (len=2? args)
+ (len=2? (cadr args))
+ (eq? (caadr args) 'apply-values)
+ (eq? (cadadr args) outer-args))
+ (and (eqv? (length outer-args) -1) ; (define-macro (f a . x) `(+ a , at x)) -> (define f +)
+ (len=3? args)
+ (eq? (cadr args) (car outer-args))
+ (len=2? (caddr args))
+ (eq? (caaddr args) 'apply-values)
+ (eq? (cadr (caddr args)) (cdr outer-args))))
+ (lint-format "perhaps ~A" caller
+ (lists->string form (list 'define outer-name (cadar args)))))))
+
+ (let ((pargs (args->proper-list outer-args)))
+ (for-each (lambda (p)
+ (if (and (quoted-pair? p)
+ (tree-set-memq pargs (cadr p)))
+ (lint-format "missing comma? ~A" caller form)))
+ args)))
+
+ ((quote)
+ ;; extra comma (unquote) is already caught elsewhere
+ (if (and (pair? args)
+ (pair? (car args))
+ (tree-set-memq (args->proper-list outer-args) (car args)))
+ (lint-format "missing comma? ~A" caller form))))))))))
;; -------- uncurry --------
@@ -14001,7 +14058,7 @@
(when (and (symbol? inner-name)
(proper-list? inner-args)
(pair? (car outer-body))
- (tree-nonce inner-name outer-body))
+ (= (tree-count inner-name outer-body 2) 1))
(let ((call (find-call inner-name outer-body)))
(when (pair? call)
(set! last-rewritten-internal-define (car val))
@@ -14057,7 +14114,7 @@
(when (and (eq? (car body) 'lambda) ; let/rec body is lambda calling var
(proper-list? (cadr body)) ; rest args are a headache
(pair? (caddr body)) ; (lambda (...) (...) where car is letrec func name
- (= (tree-count (car var) body) 1)) ; if more than 1 call, a named-let won't suffice
+ (= (tree-count (car var) body 2) 1)) ; if more than 1 call, a named-let won't suffice
(if (eq? (caaddr body) (car var))
(lint-format "perhaps ~A" caller
(lists->string form
@@ -14067,7 +14124,7 @@
,@(cddadr var)))))
(let ((call (find-call (car var) (caddr body))))
(when (and (pair? call) ; inner lambda body is (...some-expr...(sym...) ...)
- (tree-nonce (car var) (caddr body)))
+ (= (tree-count (car var) (caddr body) 2) 1))
(let ((new-call `(let ,(car var)
,(map list (cadadr var) (cdr call))
,@(cddadr var))))
@@ -14079,18 +14136,18 @@
;; -------- check-boolean-function --------
(define (check-boolean-function caller form env)
- (let ((sym (cadr form))
+ (let ((sym (caadr form))
(val (cddr form)))
- (when (and (symbol? (car sym))
- (let ((sym-name (symbol->string (car sym))))
+ (when (and (symbol? sym)
+ (let ((sym-name (symbol->string sym)))
(char=? #\? (sym-name (- (length sym-name) 1)))))
(catch 'one-is-enough
(lambda ()
- (return-walker (list-ref val (- (length val) 1))
+ (return-walker (last-ref val)
(lambda (last)
(when (or (and (code-constant? last)
(not (boolean? last))
- (not (and (pair? last)
+ (not (and (len=2? last)
(eq? (car last) 'quote)
(boolean? (cadr last)))))
(and (pair? last)
@@ -14100,7 +14157,7 @@
(tree-set-member '(boolean? #t values) (car sig))
(memq (car sig) '(boolean? #t values))))))))
(lint-format "~A looks boolean, but it can return ~A" caller
- (car sym)
+ sym
(truncated-list->string last))
(throw 'one-is-enough)))))
(lambda args #f)))))
@@ -14108,8 +14165,8 @@
;; -------- rewrite-let-optionals --------
(define (rewrite-let-optionals caller form outer-name outer-args val)
(let ((args (args->proper-list outer-args)))
- (if (and (eq? (cadar val) (last-par args))
- (every? len=2? (caddar val))) ; some seem to include a type check?
+ (if (and (eq? (cadar val) (last-ref args))
+ (lint-every? len=2? (caddar val))) ; some seem to include a type check?
(lint-format "perhaps ~A" caller
(lists->string form
`(define* (,outer-name
@@ -14235,7 +14292,7 @@
(cond ((memq head '(define* define-macro* define-bacro* define*-public))
(check-star-parameters outer-name outer-args env))
- ((list-any? keyword? outer-args)
+ ((lint-any? keyword? outer-args)
(lint-format "~A parameter can't be a keyword: ~A" caller outer-name sym))
((memq 'pi outer-args)
(lint-format "~A parameter can't be a constant: ~A" caller outer-name sym)))
@@ -14345,7 +14402,7 @@
(lint-format "~A parameter is repeated: ~A" caller head (truncated-list->string args)))
(if (eq? head 'lambda*) ; (lambda* (a :b) ...)
(check-star-parameters head args env)
- (if (list-any? keyword? args) ; (lambda (:key) ...)
+ (if (lint-any? keyword? args) ; (lambda (:key) ...)
(lint-format "lambda arglist can't handle keywords (use lambda*)" caller))))
(if (and (eq? head 'lambda*) ; (lambda* ()...) -> (lambda () ...)
@@ -14436,15 +14493,13 @@
(if (constant? settee) ; (set! pi 3)
(lint-format "can't set! ~A (it is a constant)" caller (truncated-list->string form))
(let ((v (var-member settee env)))
- (cond ((var? v)
+ (cond (v
(if (eq? (var-definer v) 'define-constant)
- (let ((line (if (and (pair? (var-initial-value v))
- (positive? (pair-line-number (var-initial-value v))))
- (format #f "(line ~D): " (pair-line-number (var-initial-value v)))
- "")))
+ (let ((line (and (pair? (var-initial-value v))
+ (pair-line-number (var-initial-value v)))))
(lint-format "can't set! ~A in ~A (it is a constant: ~A~A)" caller settee
(truncated-list->string form)
- line
+ (if line (format #f "(line ~D): " line) "")
(truncated-list->string (var-initial-value v))))))
((and (not lint-in-with-let)
@@ -14459,15 +14514,35 @@
(lint-format "can't set! ~A" caller (truncated-list->string form)))
(else
- (if (memq (car settee) '(vector-ref list-ref string-ref hash-table-ref))
- ;; (set! (vector-ref v 0) 3)
- (lint-format "~A as target of set!~A" caller (car settee) (truncated-list->string form))
- (if (and (eq? (car settee) 'symbol-access)
- (len>1? setval)
- (eq? (car setval) 'lambda)
- (list? (cadr setval))
- (not (= (length (cadr setval)) 2)))
- (lint-format "symbol-access function should take 2 arguments: ~A" caller (truncated-list->string form))))
+ (when (proper-list? settee)
+ (let ((target (car settee)))
+ (cond ((memq target '(vector-ref list-ref string-ref hash-table-ref int-vector-ref float-vector-ref byte-vector-ref let-ref))
+ ;; (set! (vector-ref v 0) 3)
+ (lint-format "perhaps ~A" caller
+ (truncated-lists->string
+ form
+ (cons (case target
+ ((vector-ref) 'vector-set!)
+ ((int-vector-ref) 'int-vector-set!)
+ ((float-vector-ref) 'float-vector-set!)
+ ((byte-vector-ref) 'byte-vector-set!)
+ ((list-ref) 'list-set!)
+ ((string-ref) 'string-set!)
+ ((hash-table-ref) 'hash-table-set!)
+ ((let-ref) 'let-set!))
+ (append (cdadr form) (cddr form))))))
+
+ ((and (eq? target 'symbol-access)
+ (len>1? setval)
+ (eq? (car setval) 'lambda)
+ (list? (cadr setval))
+ (not (= (length (cadr setval)) 2)))
+ (lint-format "symbol-access function should take 2 arguments: ~A" caller (truncated-list->string form)))
+
+ ((or (string? target)
+ (vector? target))
+ (lint-format "~S is a constant so ~A is problematic" caller target (truncated-list->string form))))))
+
(lint-walk caller settee env) ; this counts as a reference since it's by reference so to speak
;; try type check (dilambda signatures)
@@ -14626,7 +14701,7 @@
;; move-if-inward
(when (and (pair? true)
(pair? false)
- (not (memq true-op (list 'quote list-values 'not)))
+ (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)))
@@ -14634,7 +14709,7 @@
(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-nonce). Here
+ ;; in advance that 'old only occurs once in the tree (via tree-count). Here
;; 'old may occur any number of times, but we want to change it only once,
;; so we keep the actual pointer to it and use eq?. (This assumes no shared code?)
(cond ((eq? old tree)
@@ -14663,7 +14738,7 @@
(unless (or (and (equal? true-op (caadr diff)) ; (if x (+ y 1) (- y 1)) -- are we trying to keep really simple stuff out?
(or (hash-table-ref syntaces true-op)
(hash-table-ref syntaces false-op))
- (any? pair? true-rest)) ; (if x (set! y (+ x 1)) (set! y 1))
+ (lint-any? pair? true-rest)) ; (if x (set! y (+ x 1)) (set! y 1))
(and (eq? true-op 'set!) ; (if x (set! y w) (set! z w))
(equal? (caar diff) (car true-rest))))
(let ((subst-loc (car diff)))
@@ -14712,6 +14787,13 @@
(tree-subst-eq (simplify-boolean (cons 'or (cadr diff)) () () env)
subst-loc true))
+ ((and (len=2? test)
+ (eq? (car test) 'not)
+ (equal? (cadadr diff) (cadr test)))
+ ;; (if (not x) (set! y z) (set! y x)) -> (set! y (or x z))
+ (tree-subst-eq (simplify-boolean (cons 'or (reverse (cadr diff))) () () env)
+ subst-loc true))
+
((or (memq true-op '(set! begin and or))
(let list-memq ((a subst-loc) (lst true))
(and (pair? lst)
@@ -14725,7 +14807,7 @@
(not (and (pair? test)
(or (side-effect? test env)
- (memq (car test) '(#_list-values #_apply-values #_append unquote))))))
+ (memq (car test) '(list-values apply-values append unquote))))))
(tree-subst-eq (cons 'if (cons test (cadr diff))) subst-loc true))
(else #f))))
@@ -14805,8 +14887,7 @@
(eq? (car iff) 'if)))
(when (or (> iffs 2)
(and (= iffs 2)
- (pair? iff)
- (= (length iff) 3)
+ (len=3? iff)
(eq? (car iff) 'if)))
(set! last-if-line-number line-number)
;; (if a b (if c d (if e f g))) -> (cond (a b) (c d) (e f) (else g)) -- what about *report-nested-if*?
@@ -14818,8 +14899,7 @@
(= (length iff) 4)
(eq? (car iff) 'if)))
(append (reverse clauses)
- (if (and (pair? iff)
- (= (length iff) 3)
+ (if (and (len=3? iff)
(eq? (car iff) 'if))
`((,(cadr iff) ,@(unbegin (caddr iff))))
`((else ,@(unbegin iff))))))
@@ -15045,9 +15125,9 @@
(let ((true-rest (cdr true))
(false-rest (cdr false)))
(when (and (pair? (car true-rest))
- (every? pair? (car true-rest))
+ (lint-every? pair? (car true-rest))
(pair? (car false-rest))
- (every? pair? (car false-rest)))
+ (lint-every? pair? (car false-rest)))
(let ((true-vars (map car (car true-rest)))
(false-vars (map car (car false-rest)))
(shared-vars ()))
@@ -15084,7 +15164,7 @@
(lint-format "perhaps ~A" caller
(lists->string form
(if (not (or (side-effect? expr env)
- (tree-set-member (map car sv) expr)))
+ (tree-set-memq (map car sv) expr)))
(list 'let (reverse sv) (list 'if expr ntv nfv))
(let ((uniq (find-unique-name form)))
`(let ((,uniq ,expr))
@@ -15159,9 +15239,8 @@
() () env))))))))
;; (if (and x y) ... (if (and x z) ...)) gets 3 hits (one tricky)
- (when (and (pair? true)
+ (when (and (len=3? true)
(eq? (car true) 'if)
- (= (length true) 3)
(= (length false) 3)
(equal? (cdr true-rest) (cdr false-rest)))
;; (if a (if b d) (if c d)) -> (if (if a b c) d)
@@ -15448,12 +15527,12 @@
(let ((ntrue (and (len>1? true) ; (if A B (let () (display x))) -> (if A B (begin (display x)))
(eq? (car true) 'let)
(null? (cadr true))
- (not (tree-table-member definers (cddr true)))
+ (not (tree-set-memq definers (cddr true)))
(cddr true)))
(nfalse (and (len>1? false)
(eq? (car false) 'let)
(null? (cadr false))
- (not (tree-table-member definers (cddr false)))
+ (not (tree-set-memq definers (cddr false)))
(cddr false))))
(if (or ntrue nfalse)
(lint-format "perhaps ~A" caller
@@ -15518,9 +15597,9 @@
(= (length true) (length false) 4)
(equal? (cadr true) (cadr false)))
(let ((true-rest (and (pair? true) (cdr true)))
- (false-rest (and (pair? false) (cdr false))))
- (if (and (equal? (cadr true-rest) (caddr false-rest)) ; (if A (if B a b) (if B b a)) -> (if (eq? (not A) (not B)) a b)
- (equal? (caddr true-rest) (cadr false-rest)))
+ (false-rest (and (pair? false) (cddr false))))
+ (if (and (equal? (cadr true-rest) (cadr false-rest)) ; (if A (if B a b) (if B b a)) -> (if (eq? (not A) (not B)) a b)
+ (equal? (caddr true-rest) (car false-rest)))
(let* ((switch #f)
(a (if (and (pair? expr)
(eq? (car expr) 'not))
@@ -15533,20 +15612,20 @@
(lint-format "perhaps ~A" caller
(lists->string form
(if switch
- `(if (eq? ,a ,b) ,(cadr false-rest) ,(cadr true-rest))
- `(if (eq? ,a ,b) ,(cadr true-rest) ,(cadr false-rest))))))
+ `(if (eq? ,a ,b) ,(car false-rest) ,(cadr true-rest))
+ `(if (eq? ,a ,b) ,(cadr true-rest) ,(car false-rest))))))
(unless (or (side-effect? expr env)
- (equal? (cdr true-rest) (cdr false-rest))) ; handled elsewhere
- (if (equal? (cadr true-rest) (cadr false-rest)) ; (if A (if B a b) (if B a c)) -> (if B a (if A b c))
+ (equal? (cdr true-rest) false-rest)) ; handled elsewhere
+ (if (equal? (cadr true-rest) (car false-rest)) ; (if A (if B a b) (if B a c)) -> (if B a (if A b c))
(lint-format "perhaps ~A" caller
(lists->string form
`(if ,(car true-rest) ,(cadr true-rest)
- (if ,expr ,(caddr true-rest) ,(caddr false-rest)))))
- (if (equal? (caddr true-rest) (caddr false-rest)) ; (if A (if B a b) (if B c b)) -> (if B (if A a c) b)
+ (if ,expr ,(caddr true-rest) ,(cadr false-rest)))))
+ (if (equal? (caddr true-rest) (cadr false-rest)) ; (if A (if B a b) (if B c b)) -> (if B (if A a c) b)
(lint-format "perhaps ~A" caller
(lists->string form
`(if ,(car true-rest)
- (if ,expr ,(cadr true-rest) ,(cadr false-rest))
+ (if ,expr ,(cadr true-rest) ,(car false-rest))
,(caddr true-rest)))))))))))
;; -------- if->case-else --------
@@ -15556,7 +15635,7 @@
(memq (car test) '(null? not eof-object?))) ; memx/charx got no hits
(and (len=3? test)
(memq (car test) '(eq? eqv? =))
- (any? code-constant? test)))
+ (lint-any? code-constant? test)))
(or (and (unquoted-pair? false)
(or (member false test)
(and (len=2? false)
@@ -15570,9 +15649,7 @@
(lint-format "perhaps use case: ~A" caller
(lists->string form
(let ((key #f)
- (selector #f)
- (result #f))
-
+ (selector #f))
(if (memq (car test) '(null? not eof-object?))
(begin
(set! key (case (car test) ((not) #f) ((eof-object?) #<eof>) (else ())))
@@ -15642,6 +15719,7 @@
;; (if ([=] x y) (f x) (f y)) gets only 2 hits, (if ([=] x y) x y) gets 1 hit -- are these so dumb we can't ignore them?
;; (if (not (null? o)) o '()) gets 2 hits
+ ;; (if (and x...) ... (if (and (not x)...)...)) gets 6 hits and 1 is caught (and mangled)
(let ((suggestion made-suggestion))
(sensible-if? caller form test true false env)
@@ -15767,11 +15845,12 @@
(proper-list? body))
(lint-format "perhaps ~A" caller
(truncated-lists->string form
- `(cond (,(if (eq? (car form) 'when)
- (simplify-boolean `(not ,(cadr form)) () () env)
- (cadr form))
- #f)
- ,@(cdr body))))
+ (cons 'cond
+ (cons (list (if (eq? (car form) 'when)
+ (simplify-boolean (list 'not (cadr form)) () () env)
+ (cadr form))
+ #f)
+ (cdr body)))))
(when (or (memq (car body) '(when unless))
(and (eq? (car body) 'if)
(len=3? body)))
@@ -15794,6 +15873,49 @@
(hash-walker 'unless when-walker))
+ ;; -------- check-results --------
+ ;; called in cond, case, and do for => primarily
+ (define (check-results caller syn clause sequel env)
+ (cond ((not (pair? sequel))
+ (if (not (null? sequel)) ; (not (null?...)) here is correct -- we're looking for stray dots
+ (lint-format "~A clause is messed up: ~A" caller syn (truncated-list->string clause))))
+
+ ((not (eq? (car sequel) '=>))
+ (lint-walk-open-body caller syn sequel env))
+
+ ((or (not (pair? (cdr sequel)))
+ (pair? (cddr sequel)))
+ ;; (cond (x =>))
+ (lint-format "~A => target is messed up: ~A" caller syn (truncated-list->string clause)))
+
+ (else (let ((f (cadr sequel)))
+ (if (symbol? f)
+ (let ((val (symbol->value f *e*)))
+ (when (procedure? val)
+ (if (not (aritable? val 1)) ; here values might be in test expr
+ ;; (cond (x => expt))
+ (lint-format "=> target (~A) may be unhappy: ~A" caller f clause))
+ (let ((sig (procedure-signature val)))
+ (if (len>1? sig)
+ (let ((from-type (->lint-type ((if (or (memq syn '(cond do-result))
+ (not (pair? (car clause))))
+ car caar) clause)))
+ (to-type (cadr sig)))
+ (if (not (or (memq from-type '(#f #t values))
+ (memq to-type '(#f #t values))
+ (any-compatible? to-type from-type)))
+ ;; (cond ((> x 0) => abs) (else y))
+ (lint-format "in ~A, ~A returns a ~A, but ~A expects ~A" caller
+ (truncated-list->string clause)
+ (car clause) (prettify-checker-unq from-type)
+ f to-type)))))))
+ (if (and (len>1? f)
+ (eq? (car f) 'lambda)
+ (pair? (cadr f))
+ (not (= (length (cadr f)) 1)))
+ (lint-format "=> target (~A) may be unhappy: ~A" caller f clause)))
+ (lint-walk caller f env)))))
+
;; ---------------- cond ----------------
(let ()
@@ -15810,7 +15932,7 @@
;; at least (car result) has to match across all
(when (and (> len 1) ; (cond (else ...)) is handled elsewhere
(pair? (cdr form))
- (not (tree-set-member '(unquote #_list-values) form)))
+ (not (tree-set-memq '(unquote list-values) form)))
(let ((first-clause (cadr form))
(else-clause (list-ref form len)))
(when (and (len=1? (cdr first-clause))
@@ -15827,13 +15949,13 @@
(not (eq? first-func 'values))
(or (not (hash-table-ref syntaces first-func))
(eq? first-func 'set!))
- (every? (lambda (c)
- (and (len=2? c)
- (len>1? (cadr c))
- (or (equal? first-func (caadr c))
- (and (eq? c else-clause)
- else-error))))
- (cddr form)))
+ (lint-every? (lambda (c)
+ (and (len=2? c)
+ (len>1? (cadr c))
+ (or (equal? first-func (caadr c))
+ (and (eq? c else-clause)
+ else-error))))
+ (cddr form)))
((lambda (header-len trailer-len result-min-len)
(when (and (>= header-len 0)
(>= trailer-len 0)
@@ -15880,13 +16002,13 @@
;; not escaping else here because the trailing args might be evaluated first
(when (and (not (hash-table-ref syntaces (car first-result)))
- (every? (lambda (c)
- (and (len=2? c)
- (pair? (cadr c))
- (not (hash-table-ref syntaces (caadr c)))
- (equal? (cdadr c) (cdr first-result))))
- (cddr form)))
- (if (every? (lambda (c)
+ (lint-every? (lambda (c)
+ (and (len=2? c)
+ (pair? (cadr c))
+ (not (hash-table-ref syntaces (caadr c)))
+ (equal? (cdadr c) (cdr first-result))))
+ (cddr form)))
+ (if (lint-every? (lambda (c)
(eq? first-func (caadr c))) ; all result clauses are the same!?
(cddr form)) ; possibly no else, so not always a duplicate message
;; (cond (X (f y z)) (Y (f y z)) (Z (f y z))) -> (if (or X Y Z) (f y z))
@@ -16181,8 +16303,10 @@
(b (list-ref form (- len 1)))
(a (list-ref form (- len 2))))
(if (and (len>1? a) ; is (else) a legal cond clause? -- yes, it returns else...
+ (proper-list? a)
(equal? (cdr a) (cdr e))
(len>1? b)
+ (proper-list? b)
(not (eq? (cadr b) '=>)))
(let ((expr (simplify-boolean `(or ,(car a) (not ,(car b))) () () env)))
(lint-format "perhaps ~A" caller
@@ -16355,12 +16479,12 @@
;; -------- cond-one-result --------
(define (cond-one-result caller form last-clause len env)
- (let ((result (list-ref (cadr form) (- (length (cadr form)) 1)))
+ (let ((result (last-ref (cadr form)))
(else-clause (cdr (list-ref form len))))
- (when (every? (lambda (c)
- (and (len>1? c)
- (equal? result (list-ref c (- (length c) 1)))))
- (cddr form))
+ (when (lint-every? (lambda (c)
+ (and (len>1? c)
+ (equal? result (last-ref c))))
+ (cddr form))
;; (cond ((and (display x) x) 32) (#t 32)) -> (begin (and (display x) x) 32)
(lint-format "perhaps ~A" caller
(lists->string form
@@ -16407,7 +16531,7 @@
(len=2? arg2)
(eq? (caar arg1) 'and)
(member (car arg2) (cdar arg1))
- (= (length (cdar arg1)) 2))
+ (len=2? (cdar arg1)))
;; (cond ((and A B) c) (B d) (else e)) -> (cond (B (if A c d)) (else e))
(lint-format "perhaps ~A" caller
(lists->string form
@@ -16455,7 +16579,7 @@
(list (list 'else (if (car else-clause)
(list 'not (car last-clause))
(car last-clause)))))))))))
-
+
;; -------- cond-scan-clauses --------
(define (cond-scan-clauses caller form len env)
(let ((ctr 0)
@@ -16606,7 +16730,7 @@
(map (lambda (c)
(append c (list result)))
(cdr first-sequel))
- (if (memq (car (last-par first-sequel)) '(else #t))
+ (if (memq (car (last-ref first-sequel)) '(else #t))
()
(list (list 'else result)))))))
((if)
@@ -16710,43 +16834,7 @@
(if (not (equal? result sequel))
(set! result :unequal)))
- (cond ((not (pair? sequel))
- (if (not (null? sequel)) ; (not (null?...)) here is correct -- we're looking for stray dots
- (lint-format "cond clause is messed up: ~A" caller (truncated-list->string clause))))
-
- ((not (eq? first-sequel '=>))
- (lint-walk-open-body caller 'cond sequel env))
-
- ((or (not (pair? (cdr sequel)))
- (pair? (cddr sequel)))
- ;; (cond (x =>))
- (lint-format "cond => target is messed up: ~A" caller (truncated-list->string clause)))
-
- (else (let ((f (cadr sequel)))
- (if (symbol? f)
- (let ((val (symbol->value f *e*)))
- (when (procedure? val)
- (if (not (aritable? val 1)) ; here values might be in test expr
- ;; (cond (x => expt))
- (lint-format "=> target (~A) may be unhappy: ~A" caller f clause))
- (let ((sig (procedure-signature val)))
- (if (len>1? sig)
- (let ((from-type (->lint-type expr))
- (to-type (cadr sig)))
- (if (not (or (memq from-type '(#f #t values))
- (memq to-type '(#f #t values))
- (any-compatible? to-type from-type)))
- ;; (cond ((> x 0) => abs) (else y))
- (lint-format "in ~A, ~A returns a ~A, but ~A expects ~A" caller
- (truncated-list->string clause)
- expr (prettify-checker-unq from-type)
- f to-type)))))))
- (if (and (len>1? f)
- (eq? (car f) 'lambda)
- (pair? (cadr f))
- (not (= (length (cadr f)) 1)))
- (lint-format "=> target (~A) may be unhappy: ~A" caller f clause)))
- (lint-walk caller f env))))
+ (check-results caller 'cond clause sequel env)
(if (side-effect? expr env)
(begin
@@ -16811,10 +16899,13 @@
(if (and (= len 2)
has-else
(null? (cdadr form)))
- (let ((else-clause (if (null? (cddr (caddr form)))
- (cadr (caddr form))
- (cons 'begin (cdr (caddr form))))))
+ (let ((else-clause (if (null? (cdaddr form))
+ 'else
+ (if (null? (cddr (caddr form)))
+ (cadr (caddr form))
+ (cons 'begin (cdaddr form))))))
;; (cond ((a)) (else A)) -> (or (a) A)
+ ;; but these two are not currently rewritten using if: (cond (A B) (else)) (cond (A B) (else C))
(lint-format "perhaps ~A" caller (lists->string form `(or ,(caadr form) ,else-clause)))))
(unless (or has-combinations all-eqv)
@@ -16849,7 +16940,7 @@
(let ((len (- (length form) 1))
(suggest made-suggestion))
(if (or (< len 1)
- (not (every? pair? (cdr form))))
+ (not (lint-every? pair? (cdr form))))
(lint-format "cond is messed up: ~A" caller (truncated-list->string form))
(begin
(cond->header+cond+trailer caller form len env) ; obviously out-of-place...
@@ -16862,37 +16953,6 @@
;; ---------------- case ----------------
(let ()
- ;; -------- case->case+args --------
- (define (case->case+args caller form len)
- ;; if all args match, move outside case (case sets func)
- (let ((first-clause (caddr form))
- (else-clause (list-ref form (+ len 1))))
- (when (and (eq? (car else-clause) 'else)
- (len=1? (cdr first-clause))
- (len>1? (cadr first-clause))
- (not (hash-table-ref syntaces (caadr first-clause)))
- (every? (lambda (c)
- (and (len=2? c)
- (pair? (cadr c))
- (not (hash-table-ref syntaces (caadr c)))
- (equal? (cdadr first-clause) (cdadr c))))
- (cdddr form)))
- ;; (case x ((a) (f y z)) (else (g y z))) -> ((if (eq? x 'a) f g) y z)
- (lint-format "perhaps ~A" caller ; all results share trailing args
- (lists->string form
- (if (and (= len 2)
- (symbol? (caar first-clause))
- (null? (cdar first-clause)))
- `((if (eq? ,(cadr form) ',(caar first-clause))
- ,(caadr first-clause)
- ,(caadr else-clause))
- ,@(cdadr first-clause))
- `((case ,(cadr form)
- ,@(map (lambda (c)
- (list (car c) (caadr c)))
- (cddr form)))
- ,@(cdadr first-clause))))))))
-
;; -------- case->header+case+trailer --------
(define (case->header+case+trailer caller form len env)
;; if start/end args match (including func), move outside case (case sets whatever differs, using values if necessary)
@@ -16912,13 +16972,13 @@
(not (eq? first-func 'values))
(or (not (hash-table-ref syntaces first-func))
(eq? first-func 'set!))
- (every? (lambda (c)
- (and (len=2? c)
- (len>1? (cadr c))
- (or (equal? first-func (caadr c))
- (and (eq? c else-clause)
- else-error))))
- (cdddr form)))
+ (lint-every? (lambda (c)
+ (and (len=2? c)
+ (len>1? (cadr c))
+ (or (equal? first-func (caadr c))
+ (and (eq? c else-clause)
+ else-error))))
+ (cdddr form)))
((lambda (header-len trailer-len result-mid-len)
(when (and (>= header-len 0)
@@ -17017,7 +17077,7 @@
(let* ((akey (null? (cdaar clauses)))
(keylist ((if akey caaar caar) clauses))
(quoted (or (not akey) (symbol? keylist)))
- (op (if (every? symbol? (caar clauses))
+ (op (if (lint-every? symbol? (caar clauses))
(if akey 'eq? 'memq)
(if akey 'eqv? 'memv))))
;; can't use '= or 'char=? here because the selector may return anything
@@ -17028,13 +17088,9 @@
(cond ((and (boolean? (cadar clauses))
(boolean? (cadadr clauses)))
(if (cadadr clauses)
- (if quoted
- (list 'not (list op selector (list 'quote keylist)))
- (list 'not (list op selector keylist)))
- (if quoted
- (list op selector (list 'quote keylist))
- (list op selector keylist))))
-
+ (list 'not (list op selector (if quoted (list 'quote keylist) keylist)))
+ (list op selector (if quoted (list 'quote keylist) keylist))))
+
((not (cadadr clauses)) ; (else #f) happens a few times
(simplify-boolean
(if quoted
@@ -17171,21 +17227,16 @@
(list (case-branch (cadr expr) selector (list (caddr expr)))
(list 'else (cadddr expr)))
(list (case-branch (cadr expr) selector (cddr expr))))))))))))))
-
- (lint-walk-open-body caller (car form)
- (if (and (pair? exprs)
- (eq? (car exprs) '=>))
- (cdr exprs)
- exprs)
- env))) ; walk the result exprs
+
+ (check-results caller (car form) clause exprs env))) ; walk the result exprs
(cddr form)))
(let ((key-phrase
(let ((keylen (length all-keys)))
(cond ((< keylen 20))
- ((every? char? all-keys)
+ ((lint-every? char? all-keys)
"vector (indexed by char->integer)")
- ((every? (lambda (k) (and (integer? k) (<= 0 k 1000))) all-keys)
+ ((lint-every? (lambda (k) (and (integer? k) (<= 0 k 1000))) all-keys)
"vector")
((> keylen 40)
"hash-table")))))
@@ -17263,9 +17314,9 @@
(for-each
(lambda (clause)
(if (len>1? (car clause))
- (if (every? integer? (car clause))
+ (if (lint-every? integer? (car clause))
(set-car! clause (sort! (car clause) <))
- (if (every? char? (car clause))
+ (if (lint-every? char? (car clause))
(set-car! clause (sort! (car clause) char<?))))))
new-keys-and-exprs)
(let ((new-form (if (pair? else-clause)
@@ -17295,7 +17346,7 @@
,@(if (memv (car (caaddr form)) (cdar svs)) () '(...))
,@(map (lambda (sv)
(list (reverse (cdr sv)) '=> (case (car sv)
- ((#_list-values) 'list)
+ ((list-values) 'list)
(else))))
svs)
,@(if others '(...) ())))))))
@@ -17312,7 +17363,7 @@
(set-cdr! sv-data (cons (caar c) (cdr sv-data)))))
(else (set! svs (cons (list 'symbol->value (caar c)) svs)))))
- ((and (every? symbol? (car c)) ; ((a b c) (eval selector))
+ ((and (lint-every? symbol? (car c)) ; ((a b c) (eval selector))
(len=2? (cadr c))
(memq (caadr c) '(eval symbol->value))
(equal? (cadadr c) selector))
@@ -17345,21 +17396,52 @@
;; -------- case-walker --------
(define case-walker
(let ((selector-types '(#t symbol? char? boolean? integer? rational? real? complex? number? null? eof-object?)))
+
+ (define (case->case+args caller form len)
+ ;; if all args match, move outside case (case sets func)
+ (let ((first-clause (caddr form))
+ (else-clause (list-ref form (+ len 1))))
+ (when (and (eq? (car else-clause) 'else)
+ (len=1? (cdr first-clause))
+ (len>1? (cadr first-clause))
+ (not (hash-table-ref syntaces (caadr first-clause)))
+ (lint-every? (lambda (c)
+ (and (len=2? c)
+ (pair? (cadr c))
+ (not (hash-table-ref syntaces (caadr c)))
+ (equal? (cdadr first-clause) (cdadr c))))
+ (cdddr form)))
+ ;; (case x ((a) (f y z)) (else (g y z))) -> ((if (eq? x 'a) f g) y z)
+ (lint-format "perhaps ~A" caller ; all results share trailing args
+ (lists->string form
+ (if (and (= len 2)
+ (symbol? (caar first-clause))
+ (null? (cdar first-clause)))
+ `((if (eq? ,(cadr form) ',(caar first-clause))
+ ,(caadr first-clause)
+ ,(caadr else-clause))
+ ,@(cdadr first-clause))
+ `((case ,(cadr form)
+ ,@(map (lambda (c)
+ (list (car c) (caadr c)))
+ (cddr form)))
+ ,@(cdadr first-clause))))))))
+
(lambda (caller form env)
;; here the keys are not evaluated, so we might have a list like (letrec define ...)
;; also unlike cond, only 'else marks a default branch (not #t)
(if (or (< (length form) 3)
- (not (every? pair? (cddr form)))) ; (case 3)
+ (not (lint-every? pair? (cddr form)))) ; (case 3)
(lint-format "case is messed up: ~A" caller (truncated-list->string form))
- ;; perhaps also (every? (lambda (c) (or (pair? c) (eq? c 'else))) (car clause)) above
+ ;; perhaps also (lint-every? (lambda (c) (or (pair? c) (eq? c 'else))) (car clause)) above
(let ((suggest made-suggestion))
;; if regular case + else, focus case on diff
(let ((len (- (length form) 2))) ; number of clauses
(when (and (> len 1) ; (case x (else ...)) is handled elsewhere
(len>1? (cdr form))
- (not (tree-set-member '(unquote #_list-values) form)))
+ (not (tree-set-memq '(unquote list-values) form)))
(case->case+args caller form len)
(case->header+case+trailer caller form len env)))
(case->symbol->value caller form)
@@ -17415,14 +17497,15 @@
;; -------- pointless-do --------
(define (pointless-do caller form)
+ ;; called only if no side-effects in form
;; a much more permissive check here (allowing sets of locals etc) got only a half-dozen hits
(let ((end+result (caddr form)))
- (if (or (not (pair? end+result))
- (null? (cdr end+result))) ; (do ((i 0 (+ i 1))) ((= i 1)))
- (lint-format "this do-loop could be replaced by (): ~A" caller (truncated-list->string form))
- (if (and (null? (cddr end+result))
- (code-constant? (cadr end+result))) ; (begin (z 1) (do ((i 0 (+ i 1))) ((= i n) 32))): 32
- (lint-format "this do-loop could be replaced by ~A: ~A" caller (cadr end+result) (truncated-list->string form))))))
+ (if (pair? end+result)
+ (if (null? (cdr end+result)) ; (do ((i 0 (+ i 1))) ((= i 1)))
+ (lint-format "this do-loop could probably be replaced by the end test in a let: ~A" caller (truncated-list->string form))
+ (if (and (null? (cddr end+result))
+ (code-constant? (cadr end+result))) ; (begin (z 1) (do ((i 0 (+ i 1))) ((= i n) 32))): 32
+ (lint-format "this do-loop could be replaced by ~A: ~A" caller (cadr end+result) (truncated-list->string form)))))))
;; -------- walk-do-inits --------
(define (walk-do-inits caller form env)
@@ -17438,7 +17521,7 @@
(if (not (or (eq? (var-initial-value v) (var-name v))
(not (tree-memq (var-name v) (cadar bindings)))
(hash-table-ref built-in-functions (var-name v))
- (tree-table-member binders (cadar bindings))))
+ (tree-set-memq binders (cadar bindings))))
(if (not (var-member (var-name v) env))
;; (let ((xx 0)) (do ((x 1 (+ x 1)) (y x (- y 1))) ((= x 3) xx) (display y)): x
(lint-format "~A in ~A does not appear to be defined in the calling environment" caller
@@ -17447,7 +17530,6 @@
(lint-format "~A in ~A refers to the caller's ~A, not the do-loop variable" caller
(var-name v) (car bindings) (var-name v)))))
vars)
-
(lint-walk caller (cadar bindings) env)
(let ((new-var (let ((v (make-lint-var (caar bindings) (cadar bindings) 'do)))
(let ((stepper (and (pair? (cddar bindings)) (caddar bindings))))
@@ -17476,17 +17558,17 @@
(set! (var-set data) (+ (var-set data) 1)))
(when (and (pair? (caddr stepper))
(not (eq? (car stepper) (cadr stepper)))
- (eq? (car (caddr stepper)) 'cdr)
+ (eq? (caaddr stepper) 'cdr)
(eq? (cadr stepper) (cadr (caddr stepper))))
(lint-format "this looks suspicious: ~A" caller stepper))
(let ((step-name (car stepper))
(step-step (caddr stepper)))
(for-each (lambda (v)
- (if (and (var-step v)
+ (if (and ;(var-step v) ; a toss-up
(not (eq? (var-name v) step-name))
(or (eq? (var-name v) step-step)
(and (pair? step-step)
- (tree-unquoted-member (var-name v) step-step))))
+ (tree-memq (var-name v) step-step))))
(set! baddies (cons step-name baddies))))
vars))))
step-vars)
@@ -17511,11 +17593,11 @@
step-vars)))
(if (or (null? (cdr baddies))
(let ((trails new-sets))
- (not (any? (lambda (v) ; for each baddy, is it used in any following set!?
- (and (pair? (cdr trails))
- (set! trails (cdr trails))
- (tree-unquoted-member v trails)))
- (reverse baddies)))))
+ (not (lint-any? (lambda (v) ; for each baddy, is it used in any following set!?
+ (and (pair? (cdr trails))
+ (set! trails (cdr trails))
+ (tree-memq v trails)))
+ (reverse baddies)))))
(lint-format "perhaps ~A" caller
(lists->string form
`(do ,new-steppers
@@ -17556,13 +17638,25 @@
(let ((end (car end+result)))
(lint-walk caller end inner-env) ; this will call simplify-boolean
(if (pair? (cdr end+result))
- (if (null? (cddr end+result))
- (begin
- (if (any-null? (cadr end+result))
- ;; (do ((i 0 (+ i 1))) ((= i 3) ()) (display i))
- (lint-format "nil return value is redundant: ~A" caller end+result))
- (lint-walk caller (cadr end+result) inner-env))
- (lint-walk-open-body caller 'do-result (cdr end+result) inner-env)))
+ (begin
+ (check-results caller 'do-result end+result (cdr end+result) inner-env)
+ (if (null? (cddr end+result))
+ (let ((end (car end+result))
+ (result (cadr end+result)))
+ (if (or (equal? end result)
+ (and (eq? result #t)
+ (pair? end)
+ (let ((sig (arg-signature (car end) env)))
+ (and (pair? sig)
+ (eq? (car sig) 'boolean?)))))
+ ;; (do ((i 0 (+ i 1))) ((= i 3) ()) (display i))
+ (lint-format "return value is redundant: ~A" caller end+result)
+ (if (and (len=2? result)
+ (equal? end (cadr result)))
+ (lint-format "perhaps use => here: ~A" caller
+ (lists->string end+result
+ (list end '=> (car result))))))))))
+
(if (and (symbol? end) (memq end '(= > < >= <= null? not)))
;; (do ((i 0 (+ i 1))) (= i 10) (display i))
(lint-format "perhaps missing parens: ~A" caller end+result))
@@ -17626,24 +17720,80 @@
(lambda (nv)
(if (or (eq? (var-name var) (var-step nv))
(and (pair? (var-step nv))
- (tree-unquoted-member (var-name var) (var-step nv))))
+ (tree-memq (var-name var) (var-step nv))))
(set! (var-ref var) (+ (var-ref var) 1))))
(cdr v))))))
+
+ ;; try to catch step-var sets at the body end and move to the step expr
+ ;; (do ((i 0 (+ i 1)) (j 1)) ((= i 3)) (display (+ i j)) (set! j (+ j 1))), move (+ j 1)
+ (let ((last-expr (last-ref (cdddr form))))
+ (when (and (len=3? last-expr)
+ (eq? (car last-expr) 'set!))
+ (let ((var (cadr last-expr))
+ (val (caddr last-expr)))
+ (cond ((var-member var vars)
+ => (lambda (v)
+ (if (and (var-step v)
+ (not (tree-memq (var-name v) (var-step v))))
+ (if (side-effect? val env)
+ (lint-format "this set! is pointless: ~A; perhaps replace it with ~A" caller
+ (truncated-list->string last-expr)
+ (truncated-list->string val))
+ (lint-format "this set! is pointless: ~A" caller
+ (truncated-list->string last-expr)))
+ (if (and (or (not (var-step v))
+ (= (tree-count (var-name v) (var-step v) 2) 1))
+ ;; don't move if val contains ref to other step vars
+ (not (tree-set-memq (remove (var-name v) (map var-name vars)) val))
+ ;; don't move if var is referred to in any other step expr
+ (not (lint-any? (lambda (binding)
+ (and (not (eq? (car binding) var))
+ (pair? (cddr binding))
+ (tree-memq var (caddr binding))))
+ (cadr form))))
+ (lint-format "perhaps move ~A to ~A's step expression: ~A" caller
+ (truncated-list->string last-expr)
+ (var-name v)
+ (list (var-name v)
+ (var-initial-value v)
+ (if (not (var-step v))
+ val
+ (let ((expr (tree-subst val (var-name v) (var-step v))))
+ (cond ((not (pair? expr))
+ expr)
+
+ ((hash-table-ref numeric-ops (car expr))
+ (simplify-numerics expr env))
+
+ ((memq (car expr) '(and or not))
+ (simplify-boolean expr () () env))
+
+ (else expr))))))))))))))
(report-usage caller 'do vars inner-env))
;; -------- simplify-do --------
- (define (simplify-do caller form env)
+ (define (simplify-do caller form vars env)
(let ((body (cdddr form)))
(when (and (len=1? body)
(pair? (car body)))
- ;; do+let: tons of hits but how to distinguish the rewritable ones?
- ;; very tricky if val is not a constant
+ ;; do+let
+ ;; no hits for define here
(if (and (eq? (caar body) 'let)
- (len>1? (cdar body)) ; body not ((let))!
- (not (symbol? (cadar body)))
- (every? (lambda (c) (and (len>1? c) (code-constant? (cadr c)))) (cadar body)))
+ (len>1? (cdar body)) ; body not ((let))!
+ (not (symbol? (cadar body))) ; not named let
+ (or (null? (cadar body))
+ (not (tree-set-memq definers (cddar body)))) ; no let capture
+ (let ((varset (map car vars)))
+ (lint-every? (lambda (c)
+ (and (len>1? c)
+ (not (memq (car c) varset)) ; no shadowing
+ (or (code-constant? (cadr c))
+ (not (or (side-effect? (cadr c) env) ; might change end-test calc?
+ (tree-set-memq varset (cadr c)))))))
+ (cadar body))))
;; (do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12)) (set! a (+ a i)) (display a))) ->
;; (do ((i 0 (+ i 1)) (a 12 12)) ((= i 3)) (set! a (+ a i)) ...)
+ ;; maybe a better suggestion: declare in do vars, then use set! in the body
(lint-format "perhaps ~A" caller
(lists->string form
`(do (,@(cadr form)
@@ -17654,7 +17804,7 @@
,@(one-call-and-dots (cddar body))))))
;; do+lambda in body with stepper as free var never happens
(let ((v (var-member (caar body) env)))
- (when (and (var? v)
+ (when (and v
(memq (var-ftype v) '(define lambda)))
(let* ((vfunc (var-initial-value v))
(vbody (cddr vfunc)))
@@ -17664,7 +17814,7 @@
(< (tree-leaves vbody) 16))
(do ((pp (var-arglist v) (cdr pp)))
((or (null? pp)
- (> (tree-count2 (car pp) vbody) 1))
+ (> (tree-count (car pp) vbody 3) 1))
(when (null? pp)
(let ((new-body (copy vbody)))
(for-each (lambda (par arg)
@@ -17728,7 +17878,7 @@
(memq (car end-var) '(length string-length vector-length)))
(set! end-var (cadr end-var))
(let ((v (var-member end-var env)))
- (if (and (var? v)
+ (if (and v
(pair? (var-initial-value v))
(memq (car (var-initial-value v)) '(length string-length vector-length)))
(set! end-var (cadr (var-initial-value v))))))
@@ -17819,7 +17969,7 @@
(walk-do-steps caller form vars inner-env env)
(walk-do-end+result caller form vars inner-env env)
(walk-do-body caller form vars inner-env env)
- (simplify-do caller form env)
+ (simplify-do caller form vars env)
(do->for-each caller form env)
(do->copy caller form vars))))
env)
@@ -17914,32 +18064,26 @@
(keyword? named-let)
(not (or (null? (caddr form))
(and (proper-list? (caddr form))
- (every? pair? (caddr form))))))
+ (lint-every? pair? (caddr form))))))
()
(let ((vars (map car (caddr form))))
- (list (make-fvar :name named-let
- :ftype (car form)
- :decl (dummy-func caller form (list (if (eq? (car form) 'let) 'define 'define*)
- (cons '_ (map car (caddr form)))
- #f))
- :arglist vars
- :initial-value form
- :env env))))))
+ (list (make-fvar named-let (car form) vars form env))))))
+
;; -------- remove-null-let --------
(define (remove-null-let caller form env)
(if (and (null? (cadr form)) ; this can be fooled by macros that define things
- (not (tree-table-member open-definers (cddr form)))) ; somewhat too restrictive but hard to improve
+ (not (tree-set-memq open-definers (cddr form)))) ; somewhat too restrictive but hard to improve
;; (begin (let () (display x)) y)
(if (or (eq? form lint-current-form) ; i.e. we're in a body?
(null? (cdddr form)))
(lint-format "pointless let: ~A" caller (truncated-list->string form))
- (if (every? (lambda (p)
- (or (not (pair? p))
- (hash-table-ref built-in-functions (car p))
- (hash-table-ref syntaces (car p))
- (not (side-effect? p env))))
- (cddr form))
+ (if (lint-every? (lambda (p)
+ (or (not (pair? p))
+ (hash-table-ref built-in-functions (car p))
+ (hash-table-ref syntaces (car p))
+ (not (side-effect? p env))))
+ (cddr form))
(lint-format "let could be begin: ~A" caller
(truncated-lists->string form (cons 'begin (cddr form))))))
(let ((body (cddr form)))
@@ -17975,7 +18119,7 @@
(for-each (lambda (v)
(if (and (tree-memq (var-name v) (cadar bindings))
(not (hash-table-ref built-in-functions (var-name v)))
- (not (tree-table-member binders (cadar bindings))))
+ (not (tree-set-memq binders (cadar bindings))))
(if (not (var-member (var-name v) env))
;; (let ((x 1) (y x)) (+ x y)): x in (y x)
(lint-format "~A in ~A does not appear to be defined in the calling environment" caller
@@ -17993,7 +18137,7 @@
(memq (var-name (car e)) '(:lambda :dilambda)))
(let ((ldata (cdar e)))
(set! (var-name (car e)) (caar bindings))
- (set! (ldata 'initial-value) val)
+ (let-set! ldata 'initial-value val)
(set! vars (cons (car e) vars)))
(set! vars (cons (make-lint-var (caar bindings) val (if named-let 'named-let 'let))
vars)))))))
@@ -18014,29 +18158,29 @@
;; move let in:
;; (let ((a (car x))) (if b (+ a (f a)) (display c))) -> (if b (let ((a (car x))) (+ a (f a))) (display c))
;; let* version gets only 3 hits
- (unless (any? (lambda (c)
- (not (and (len>1? c)
- (symbol? (car c))
- (not (side-effect? (cadr c) env)))))
- (cadr form))
- (let ((body (cddr form)))
- (case (caar body)
+ (unless (lint-any? (lambda (c)
+ (not (and (len>1? c)
+ (symbol? (car c))
+ (not (side-effect? (cadr c) env)))))
+ (cadr form))
+ (let ((first-expr (caddr form)))
+ (case (car first-expr)
((if)
- (when (pair? (cddar body))
- (let ((test (cadar body))
- (true (caddar body))
- (false (and (pair? (cdddar body)) (car (cdddar body))))
+ (when (pair? (cddr first-expr))
+ (let ((test (cadr first-expr))
+ (true (caddr first-expr))
+ (false (and (pair? (cdddr first-expr)) (cadddr first-expr)))
(vars (map car (cadr form)))
(false-let #f))
(when (and (not (memq test vars))
- (not (tree-set-member vars test))
+ (not (tree-set-memq vars test))
(or (and (not (memq true vars))
- (not (tree-set-member vars true))
+ (not (tree-set-memq vars true))
(set! false-let #t))
(not false)
(not (or (memq false vars)
- (tree-set-member vars false))))
- (tree-set-member vars body)) ; otherwise we'll complain elsewhere about unused variables
+ (tree-set-memq vars false))))
+ (tree-set-memq vars (cddr form))) ; otherwise we'll complain elsewhere about unused variables
(lint-format "perhaps move the let to the ~A branch: ~A" caller
(if false-let "false" "true")
(lists->string form
@@ -18050,7 +18194,7 @@
((cond)
;; happens about a dozen times
(let ((vars (map car (cadr form))))
- (when (tree-set-member vars (cdar body))
+ (when (tree-set-memq vars (cdr first-expr))
(call-with-exit
(lambda (quit)
(let ((branch-let #f))
@@ -18060,59 +18204,59 @@
(side-effect? (car c) env))
(quit))
(when (and (pair? c)
- (tree-set-member vars c))
+ (tree-set-memq vars c))
(if branch-let (quit))
(set! branch-let c)))
- (cdar body))
+ (cdr first-expr))
(when (and branch-let
(not (memq (car branch-let) vars))
- (not (tree-set-member vars (car branch-let))))
+ (not (tree-set-memq vars (car branch-let))))
(lint-format "perhaps move the let into the '~A branch: ~A" caller
(truncated-list->string branch-let)
(lists->string form
(if (eq? '=> (cadr branch-let))
- (if (eq? branch-let (cadar body))
+ (if (eq? branch-let (cadr first-expr))
`(cond (,(car branch-let) => (let ,(cadr form) ,@(cddr branch-let))) ...)
`(cond ... (,(car branch-let) => (let ,(cadr form) ,@(cddr branch-let))) ...))
- (if (eq? branch-let (cadar body))
+ (if (eq? branch-let (cadr first-expr))
`(cond (,(car branch-let) (let ,(cadr form) ,@(cdr branch-let))) ...)
`(cond ... (,(car branch-let) (let ,(cadr form) ,@(cdr branch-let))) ...))))))))))))
((case)
(let ((vars (map car (cadr form)))
- (test (cadar body)))
+ (test (cadr first-expr)))
(when (and (not (memq test vars))
- (not (tree-set-member vars test))
- (tree-set-member vars (cddar body)))
+ (not (tree-set-memq vars test))
+ (tree-set-memq vars (cddr first-expr)))
(call-with-exit
(lambda (quit)
(let ((branch-let #f))
(for-each (lambda (c)
(when (and (pair? c)
- (tree-set-member vars (cdr c)))
+ (tree-set-memq vars (cdr c)))
(if branch-let (quit))
(set! branch-let c)))
- (cddar body))
+ (cddr first-expr))
(when (proper-list? branch-let)
(lint-format "perhaps move the let into the '~A branch: ~A" caller
(truncated-list->string branch-let)
(lists->string form
(if (eq? '=> (cadr branch-let))
- (if (eq? branch-let (caddar body))
+ (if (eq? branch-let (caddr first-expr))
`(case ,test (,(car branch-let) => (let ,(cadr form) ,@(cddr branch-let))) ...)
`(case ,test ... (,(car branch-let) => (let ,(cadr form) ,@(cddr branch-let))) ...))
- (if (eq? branch-let (caddar body))
+ (if (eq? branch-let (caddr first-expr))
`(case ,test (,(car branch-let) (let ,(cadr form) ,@(cdr branch-let))) ...)
`(case ,test ... (,(car branch-let) (let ,(cadr form) ,@(cdr branch-let))) ...))))))))))))
((when unless) ; no hits -- maybe someday?
- (let ((test (cadar body))
+ (let ((test (cadr first-expr))
(vars (map car (cadr form))))
(unless (or (memq test vars)
- (tree-set-member vars test)
+ (tree-set-memq vars test)
(side-effect? test env)
- (not (proper-list? (cddar body))))
+ (not (proper-list? (cddr first-expr))))
(lint-format "perhaps move the let inside the ~A: ~A" caller
- (caar body)
- (truncated-lists->string form `(,(caar body) ,test (let ,(cadr form) ,@(cddar body))))))))))))
+ (car first-expr)
+ (truncated-lists->string form `(,(car first-expr) ,test (let ,(cadr form) ,@(cddr first-expr))))))))))))
;; -------- let-body->value --------
(define (let-body->value caller form vars env)
@@ -18130,13 +18274,13 @@
=> (lambda (v)
(or (set! vals-ok (and (code-constant? (var-initial-value v))
(code-constant? setval)))
- (and (<= (tree-count2 settee setval) 1)
- (not (any? (lambda (v1)
- (or (tree-memq settee (cadr v1))
- (and (not (eq? (car v1) settee))
- (or (tree-memq (car v1) setval)
- (side-effect? (cadr v1) env)))))
- varlist))))))
+ (and (<= (tree-count settee setval 3) 1)
+ (not (lint-any? (lambda (v1)
+ (or (tree-memq settee (cadr v1))
+ (and (not (eq? (car v1) settee))
+ (or (tree-memq (car v1) setval)
+ (side-effect? (cadr v1) env)))))
+ varlist))))))
(else #f)))
(begin
(if (not vals-ok)
@@ -18184,19 +18328,19 @@
((define)
(unless named-let
- (let ((f (car body)))
- (when (and (len=2? (cdr f))
- (symbol? (cadr f))
- (not (assq (cadr f) varlist)) ; this (let ((x ...)) (set! x ...)) is handled elsewhere
- (or (code-constant? (caddr f))
- (not (or (tree-memq 'lambda (caddr f)) ; else we have to scan forward for pending refs
+ (let ((f (cdar body)))
+ (when (and (len=2? f)
+ (symbol? (car f))
+ (not (assq (car f) varlist)) ; this (let ((x ...)) (set! x ...)) is handled elsewhere
+ (or (code-constant? (cadr f))
+ (not (or (tree-memq 'lambda (cadr f)) ; else we have to scan forward for pending refs
(and (pair? varlist)
- (or (side-effect? (caddr f) env) ; might be depending on the let var calcs
- (tree-set-member (map car varlist) (caddr f))))))))
+ (or (side-effect? (cadr f) env) ; might be depending on the let var calcs
+ (tree-set-memq (map car varlist) (cadr f))))))))
(lint-format "perhaps ~A" caller
(lists->string form
`(let (, at varlist
- ,(cdr f))
+ ,f)
...)))))))
;; display et al here happen a lot, but only a few are rewritable or collapsible
@@ -18221,7 +18365,7 @@
(let ((ninit (caddar body))
(local-vars (map car vars)))
;; watch out for (let ((g (make-oscil)) (v (make-vector 3))) (fill! v g) ...)
- (not (or (tree-set-member local-vars ninit)
+ (not (or (tree-set-memq local-vars ninit)
(memq ninit local-vars)))))
(list (car init) (cadr init) (caddar body))
:none)))))
@@ -18249,16 +18393,16 @@
(define (normal-let->do caller form env)
(let ((varlist (cadr form))
(body (cddr form)))
- (when (every? len=2? varlist)
+ (when (lint-every? len=2? varlist)
(when (and (null? (cdr body)) ; removing this restriction gets only 3 hits
(pair? (cdar body))
(pair? (cadar body))
- (every? len>1? (cadar body)))
+ (lint-every? len>1? (cadar body)))
(let ((inits (map cadr (cadar body))))
- (when (every? (lambda (v)
- (and (tree-nonce (car v) (car body))
- (tree-memq (car v) inits)))
- varlist)
+ (when (lint-every? (lambda (v)
+ (and (= (tree-count (car v) (car body) 2) 1)
+ (tree-memq (car v) inits)))
+ varlist)
(let ((new-cadr (copy (cadar body))))
(for-each (lambda (v)
(set! new-cadr (tree-subst (cadr v) (car v) new-cadr)))
@@ -18279,20 +18423,20 @@
(<= (tree-leaves (cdr body)) *max-cdr-len*))
(let ((inits (if (and (pair? (cdar body))
(pair? (cadar body))
- (every? len>1? (cadar body)))
+ (lint-every? len>1? (cadar body)))
(map cadr (cadar body))
()))
(locals (if (and (pair? (cdar body))
(pair? (cadar body))
- (every? pair? (cadar body)))
+ (lint-every? pair? (cadar body)))
(map car (cadar body))
())))
(unless (and (pair? inits)
- (any? (lambda (v)
- (or (memq (car v) locals) ; shadowing
- (tree-memq (car v) inits)
- (side-effect? (cadr v) env))) ; let var opens *stdin*, do stepper reads it at init
- varlist))
+ (lint-any? (lambda (v)
+ (or (memq (car v) locals) ; shadowing
+ (tree-memq (car v) inits)
+ (side-effect? (cadr v) env))) ; let var opens *stdin*, do stepper reads it at init
+ varlist))
;; (let ((xx 0)) (do ((x 1 (+ x 1)) (y x (- y 1))) ((= x 3) xx) (display y))) ->
;; (do ((xx 0) (x 1 (+ x 1)) (y x (- y 1))) ...)
(let ((do-form (cdar body)))
@@ -18439,7 +18583,7 @@
(cons 'let
(cons (map list (cadr lform) (cdr body))
(cddr lform))))))
- (if (tree-nonce sym body)
+ (if (= (tree-count sym body 2) 1)
(let ((call (find-call sym body)))
(when (pair? call)
(let ((new-call (cons 'let
@@ -18463,10 +18607,10 @@
(symbol? inner-vars))
(let ((named-body (cdddr inner))
(named-args (caddr inner)))
- (unless (any? (lambda (v)
- (or (not (tree-nonce (car v) named-args))
- (tree-memq (car v) named-body)))
- varlist)
+ (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)))
@@ -18486,12 +18630,12 @@
(let loop ((vars (list 'curlet)) (forms lets))
(and (pair? forms)
(or (and (pair? (car forms))
- (or (tree-set-member vars (car forms))
- (any? (lambda (a)
- (or (not (pair? a))
- (not (pair? (cdr a)))
- (side-effect? (cadr a) env)))
- (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))))))
@@ -18559,7 +18703,7 @@
(let ((body (cddr form))
(varlist (cadr form)))
(when (and (> (length body) 3) ; setting this to 1 did not catch anything new
- (not (tree-table-member open-definers body)))
+ (not (tree-set-memq open-definers body)))
;; define et al are like a continuation of the let bindings, so we can't restrict them by accident
;; (let ((x 1)) (define y x) ...)
(let ((last-refs (map (lambda (v)
@@ -18577,12 +18721,12 @@
(if (and (< end (/ i lint-let-reduction-factor))
(eq? form lint-current-form)
(< (tree-leaves (car body)) 100))
- (let ((old-start (let ((old-pp ((funclet lint-pretty-print) '*pretty-print-left-margin*)))
- (set! ((funclet lint-pretty-print) '*pretty-print-left-margin*) (+ lint-left-margin 4))
+ (let ((old-start (let ((old-pp (lint-pp-funclet '*pretty-print-left-margin*)))
+ (set! (lint-pp-funclet '*pretty-print-left-margin*) (+ lint-left-margin 4))
(let ((res (lint-pp (cons 'let
(cons (cadr form)
(copy body (make-list (+ end 1))))))))
- (set! ((funclet lint-pretty-print) '*pretty-print-left-margin*) old-pp)
+ (set! (lint-pp-funclet '*pretty-print-left-margin*) old-pp)
res))))
(lint-format "this let could be tightened:~%~NC~A ->~%~NC~A~%~NC~A ..." caller
(+ lint-left-margin 4) #\space
@@ -18642,9 +18786,9 @@
(<= (v 2) cur-end))
(positive? (var-ref (v 3)))
(let ((expr (var-initial-value (v 3))))
- (not (any? (lambda (ov) ; watch out for shadowed vars
- (tree-memq (car ov) expr))
- varlist))))
+ (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)))
@@ -18694,13 +18838,13 @@
(let ((body (cddr form))
(varlist (cadr form)))
;; if last is (set! local-var...) and no complications, complain
- (let ((last (list-ref body (- (length body) 1))))
+ (let ((last (last-ref body)))
(when (and (len>2? last)
(eq? (car last) 'set!)
(symbol? (cadr last))
(assq (cadr last) varlist) ; (let ((a 1) (b (display 2))) (set! a 2))
;; this is overly restrictive:
- (not (tree-set-member '(call/cc call-with-current-continuation curlet lambda lambda*) form)))
+ (not (tree-set-memq '(call/cc call-with-current-continuation curlet lambda lambda*) form)))
(lint-format "set! is pointless in ~A: use ~A" caller
last (caddr last))))))
@@ -18731,7 +18875,7 @@
(if (and (null? (cadr new-form))
(null? (cdddr new-form))
(not (and (pair? (caddr new-form))
- (hash-table-ref open-definers (caaddr new-form)))))
+ (hash-table-ref open-definers-table (caaddr new-form)))))
(caddr new-form)
new-form)
(cons 'let
@@ -18743,10 +18887,10 @@
(not (set-target (cadr v) body env))
(not (set-target (car v) body env))
(let ((data (var-member (cadr v) env)))
- (or (not (var? data))
+ (or (not data)
(and (not (eq? (var-definer data) 'parameter))
(or (null? (var-setters data))
- (not (tree-set-member (var-setters data) body)))))))
+ (not (tree-set-memq (var-setters data) body)))))))
(set! changes (cons v changes))))))))
;; -------- embed-let --------
@@ -18758,18 +18902,18 @@
(when (and (< (length varlist) 8)
(not (or (memq (caar body) '(lambda lambda* define define* define-macro))
(and (eq? (caar body) 'set!)
- (any? (lambda (v) (and (eq? (car v) (cadar body)))) varlist))
+ (lint-any? (lambda (v) (and (eq? (car v) (cadar body)))) varlist))
(any-macro? (caar body) env)
- (any? (lambda (p)
- (and (unquoted-pair? p)
- (or (not (hash-table-ref no-side-effect-functions (car p)))
- (any? pair? (cdr p)))))
- (cdar body))))
- (every? (lambda (v)
- (and (len>1? v)
- (< (tree-leaves (cadr v)) 8)
- (tree-nonce (car v) body)))
- varlist))
+ (lint-any? (lambda (p)
+ (and (unquoted-pair? p)
+ (or (not (hash-table-ref no-side-effect-functions (car p)))
+ (lint-any? pair? (cdr p)))))
+ (cdar body))))
+ (lint-every? (lambda (v)
+ (and (len>1? v)
+ (< (tree-leaves (cadr v)) 8)
+ (= (tree-count (car v) body 2) 1)))
+ varlist))
(let ((new-body (copy (car body)))
(bool-arg? #f))
@@ -18793,17 +18937,17 @@
;; -------- useless-let --------
(define (useless-let caller form env)
(when (and (pair? (cadr form)) ; (let ((x x)) (+ x 1)) -> (+ x 1), (let ((x x))...) does not copy x if x is a sequence
- (every? (lambda (c)
- (and (len>1? c) ; the usual... (let binding might be messed up)
- (eq? (car c) (cadr c))))
- (cadr form)))
+ (lint-every? (lambda (c)
+ (and (len>1? c) ; the usual... (let binding might be messed up)
+ (eq? (car c) (cadr c))))
+ (cadr form)))
(let ((vs (map car (cadr form))))
- (unless (any? (lambda (p)
- (and (pair? p)
- (memq (cadr p) vs)
- (or (eq? (car p) 'set!)
- (set!? p env))))
- (cddr form))
+ (unless (lint-any? (lambda (p)
+ (and (pair? p)
+ (memq (cadr p) vs)
+ (or (eq? (car p) 'set!)
+ (set!? p env))))
+ (cddr form))
(lint-format "perhaps omit this useless let: ~A" caller
(truncated-lists->string form
(if (null? (cdddr form))
@@ -18821,38 +18965,41 @@
`(let ,header ,new-form)
new-form)))))
(lambda (caller form env)
- (let ((varlist (cadr form))
- (body (cddr form)))
+ (let ((body (cddr form)))
(let ((p (car body))
(trailer (cdr body))
(vname #f)
(vvalue #f)
(header ()))
- (when (any? (lambda (v)
- (and (len=2? v)
- (< 0 (tree-count (car v) p) 4)
- (not (tree-memq (car v) trailer))
- (begin
- (set! vname (car v))
- (set! vvalue (cadr v))
- (set! header (map (lambda (p)
- (if (eq? v p)
- (values)
- p))
- varlist)))))
- varlist)
-
- (let ((suggest made-suggestion))
+ (when (let ((varlist (cadr form)))
+ (lint-any? (lambda (v)
+ (and (len=2? v)
+ (< 0 (tree-count (car v) p 5) 4)
+ (not (tree-memq (car v) trailer))
+ (begin
+ (set! vname (car v))
+ (set! vvalue (cadr v))
+ (set! header (map (lambda (p)
+ (if (eq? v p)
+ (values)
+ p))
+ varlist)))))
+ varlist))
+ (let ((suggest made-suggestion)
+ (pargs (cdr p))
+ (first-arg (cadr p))
+ (next-args (cddr p)))
+
;; (let ((x (assq a y))) (set! z (if x (cadr x) 0))) -> (set! z (cond ((assq a y) => cadr) (else 0)))
(when (and (not (memq (car p) '(if cond))) ; handled separately below
- (= (tree-count2 vname p) 2))
+ (= (tree-count vname p 3) 2))
(do ((i 0 (+ i 1))
- (bp (cdr p) (cdr bp)))
+ (bp pargs (cdr bp)))
((or (not (pair? bp))
(let ((b (car bp)))
(and (len>2? b)
(eq? (car b) 'if)
- (= (tree-count2 vname b) 2)
+ (= (tree-count vname b 3) 2)
(eq? vname (cadr b))
(len=2? (caddr b))
(eq? vname (cadr (caddr b))))))
@@ -18868,35 +19015,35 @@
trailer))))))))
(when (and (eq? (car p) 'cond) ; (let ((x (f y))) (cond (x (g x)) ...)) -> (cond ((f y) => g) ...)
- (len=2? (cadr p))
- (eq? (caadr p) vname)
- (or (and (len=2? (cadadr p)) ; one arg to func
- (eq? vname (cadr (cadadr p))))
- (eq? vname (cadadr p)))
- (or (null? (cddr p))
- (not (tree-unquoted-member vname (cddr p)))))
+ (len=2? first-arg)
+ (eq? (car first-arg) vname)
+ (or (and (len=2? (cadr first-arg)) ; one arg to func
+ (eq? vname (cadadr first-arg)))
+ (eq? vname (cadr first-arg)))
+ (or (null? next-args)
+ (not (tree-memq vname next-args))))
(lint-format "perhaps ~A" caller
(lists->string form
(wrap-new-form
header
- (if (eq? vname (cadadr p))
+ (if (eq? vname (cadr first-arg))
(list 'or vvalue
- (if (and (pair? (cddr p))
- (len>1? (caddr p))
- (memq (caaddr p) '(else #t t)))
- (if (null? (cddr (caddr p)))
- (cadr (caddr p))
- (cons 'begin (cdaddr p)))
- (cons 'cond (cddr p))))
+ (if (and (pair? next-args)
+ (len>1? (car next-args))
+ (memq (caar next-args) '(else #t t)))
+ (if (null? (cddar next-args))
+ (cadar next-args)
+ (cons 'begin (cdar next-args)))
+ (cons 'cond next-args)))
(cons 'cond
- (cons (list vvalue '=> (caadr (cadr p)))
- (cddr p))))
+ (cons (list vvalue '=> (caadr first-arg))
+ next-args)))
trailer))))
- (when (and (null? (cddr p)) ; (let ((x (+ y 1))) (abs x)) -> (abs (+ y 1))
- (eq? vname (cadr p))) ; not tree-subst or trailing (pair) args: the let might be forcing evaluation order
+ (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 (var? v)
+ (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
@@ -18906,13 +19053,13 @@
(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? (cddr p))
+ (when (pair? next-args)
(when (and (eq? (car p) 'if)
- (pair? (cdddr p)))
- (let ((if-true (caddr p))
- (if-false (cadddr p)))
+ (pair? (cdr next-args)))
+ (let ((if-true (car next-args))
+ (if-false (cadr next-args)))
- (when (and (eq? (cadr p) vname) ; (let ((x (g y))) (if x #t #f)) -> (g y)
+ (when (and (eq? first-arg vname) ; (let ((x (g y))) (if x #t #f)) -> (g y)
(boolean? if-true)
(boolean? if-false)
(not (eq? if-true if-false)))
@@ -18920,15 +19067,15 @@
(lists->string form
(wrap-new-form header (if if-true vvalue (list 'not vvalue)) trailer))))
- (when (and (len>1? (cadr p)) ; (let ((x (f y))) (if (not x) B (g x))) -> (cond ((f y) => g) (else B))
- (eq? (caadr p) 'not)
- (eq? (cadadr p) vname)
+ (when (and (len>1? first-arg) ; (let ((x (f y))) (if (not x) B (g x))) -> (cond ((f y) => g) (else B))
+ (eq? (car first-arg) 'not)
+ (eq? (cadr first-arg) vname)
(len=2? if-false)
(eq? vname (cadr if-false)))
(let ((else-clause (if (eq? if-true vname)
(list (list 'else #f))
(if (and (pair? if-true)
- (tree-unquoted-member vname if-true))
+ (tree-memq vname if-true))
:oops! ; if the let var appears in the else portion, we can't do anything with =>
(list (list 'else if-true))))))
(unless (eq? else-clause :oops!)
@@ -18941,61 +19088,61 @@
(let ((crf #f))
;; all this stuff still misses (cond ((not x)...)) and (set! y (if x (cdr x)...)) i.e. need embedding in this case
(when (and (or (and (memq (car p) '(if and)) ; (let ((x (f y))) (and x (g x))) -> (cond ((f y) => g) (else #f))
- (eq? (cadr p) vname))
+ (eq? first-arg vname))
(and (eq? (car p) 'or)
- (equal? (cadr p) (list 'not vname)))
+ (equal? first-arg (list 'not vname)))
(and (pair? vvalue)
(memq (car vvalue) '(assoc assv assq member memv memq))
- (len>1? (cadr p)) ; (let ((x (memq z y))) (if (pair? x) (g x))) -> (cond ((memq z y) => g))
- (or (eq? (caadr p) 'pair?)
- (and (eq? (caadr p) 'list?)
+ (len>1? first-arg) ; (let ((x (memq z y))) (if (pair? x) (g x))) -> (cond ((memq z y) => g))
+ (or (eq? (car first-arg) 'pair?)
+ (and (eq? (car first-arg) 'list?)
(lint-format "in ~A, ~A can't be null so pair? might be better" caller p vname)
#t)
- (and (eq? (caadr p) 'null?) ; (let ((x (assoc y z))) (if (null? x) (g x)))
+ (and (eq? (car first-arg) 'null?) ; (let ((x (assoc y z))) (if (null? x) (g x)))
(lint-format "in ~A, ~A can't be null because ~A in ~A only returns #f or a pair"
caller p vname (car vvalue) (truncated-list->string (list vname vvalue)))
#f))
- (eq? (cadadr p) vname))
+ (eq? (cadr first-arg) vname))
(and (pair? vvalue)
(memq (car vvalue) '(char-position string-position string->number length arity)) ; length|arity only in s7
- (or (eq? (cadr p) vname)
- (and (len>1? (cadr p))
- (or (memq (caadr p) '(number? complex?))
+ (or (eq? first-arg vname)
+ (and (len>1? first-arg)
+ (or (memq (car first-arg) '(number? complex?))
(and (not (eq? (car vvalue) 'string->number))
- (eq? (caadr p) 'integer?)))
- (eq? (cadadr p) vname)))))
+ (eq? (car first-arg) 'integer?)))
+ (eq? (cadr first-arg) vname)))))
- (or (and (len=2? (caddr p)) ; one func arg
- (or (eq? vname (cadr (caddr p)))
- (and (hash-table-ref combinable-cxrs (caaddr p))
+ (or (and (len=2? (car next-args)) ; one func arg
+ (or (eq? vname (cadar next-args))
+ (and (hash-table-ref combinable-cxrs (caar next-args))
((lambda* (cr arg) ; lambda* not lambda because combine-cxrs might return just #f
(and cr
(< (length cr) 5)
(eq? vname arg)
(set! crf (symbol "c" cr "r"))))
- (combine-cxrs (caddr p))))))
+ (combine-cxrs (car next-args))))))
(and (eq? (car p) 'if)
- (eq? (caddr p) vname)
- (not (tree-unquoted-member vname (cdddr p))) ; (let ((x (g y))) (if x x (g z))) -> (or (g y) (g z))
+ (eq? (car next-args) vname)
+ (not (tree-unquoted-member vname (cdr next-args))) ; (let ((x (g y))) (if x x (g z))) -> (or (g y) (g z))
(lint-format "perhaps ~A" caller
(lists->string form
(wrap-new-form
header
- (if (null? (cdddr p))
+ (if (null? (cdr next-args))
vvalue
- (list 'or vvalue (cadddr p)))
+ (list 'or vvalue (cadr next-args)))
trailer)))
#f))
- (pair? (caddr p))
+ (pair? (car next-args))
(or (eq? (car p) 'if)
- (null? (cdddr p))))
- (let ((else-clause (if (pair? (cdddr p))
- (if (eq? (cadddr p) vname)
+ (null? (cdr next-args))))
+ (let ((else-clause (if (pair? (cdr next-args))
+ (if (eq? (cadr next-args) vname)
(list (list 'else #f)) ; this stands in for the local var
- (if (and (pair? (cadddr p))
- (tree-unquoted-member vname (cadddr p)))
+ (if (and (pair? (cadr next-args))
+ (tree-memq vname (cadr next-args)))
:oops! ; if the let var appears in the else portion, we can't do anything with =>
- (list (list 'else (cadddr p)))))
+ (list (list 'else (cadr next-args)))))
(case (car p)
((and) '((else #f)))
((or) '((else #t)))
@@ -19006,7 +19153,7 @@
(wrap-new-form
header
(cons 'cond
- (cons (list vvalue '=> (or crf (caaddr p)))
+ (cons (list vvalue '=> (or crf (caar next-args)))
else-clause))
trailer))))))))
(when (and (= suggest made-suggestion)
@@ -19014,44 +19161,42 @@
;; also need to be sure let is not blocking defines or keep (let ()...)? -- never happens I think
(case (car p)
((cond)
- (when (and (pair? (cdr p))
- (pair? (cadr p))
- (eq? vname (caadr p))
- (= (tree-count vname body) 1))
+ (when (and (pair? pargs)
+ (pair? first-arg)
+ (eq? vname (car first-arg))
+ (= (tree-count vname body 2) 1))
(lint-format "perhaps ~A" caller
(lists->string form
- (wrap-new-form header `(cond (,vvalue ,@(cdadr p)) ,@(cddr p)) trailer)))))
+ (wrap-new-form header `(cond (,vvalue ,@(cdr first-arg)) , at next-args) trailer)))))
((when unless)
- (let ((test (cadr p)))
- (if (and (eq? test vname)
- (= (tree-count vname body) 1)) ; 2 if we can use cond => (remember cdr)
- (lint-format "perhaps ~A" caller
- (lists->string form
- (wrap-new-form header (tree-subst vvalue vname p) trailer))))))
+ (if (and (eq? first-arg vname)
+ (= (tree-count vname body 2) 1)) ; 2 if we can use cond => (remember cdr)
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (wrap-new-form header (tree-subst vvalue vname p) trailer)))))
((if)
(when (len=3? p)
- (let ((test (cadr p))
- (true (and (pair? (cddr p)) (caddr p))))
- (if (eq? test vname)
- (let ((calls (tree-count vname body)))
- (if (= calls 1)
- (lint-format "perhaps ~A" caller
- (lists->string form
- (wrap-new-form header (tree-subst vvalue vname p) trailer)))
+ (if (eq? first-arg vname)
+ (let ((calls (tree-count vname body 3)))
+ (if (= calls 1)
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (wrap-new-form header (tree-subst vvalue vname p) trailer)))
+ (let ((true (and (pair? next-args) (car next-args))))
(if (and (= calls 2)
(len=2? true)
- (eq? test (cadr true)))
+ (eq? first-arg (cadr true)))
(lint-format "perhaps ~A" caller
(lists->string form
- (wrap-new-form header (list 'cond (list vvalue '=> (car true))) trailer))))))
- (if (and (len=2? test)
- (eq? (car test) 'not)
- (eq? (cadr test) vname)
- (= (tree-count vname body) 1))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (wrap-new-form header (tree-subst vvalue vname p) trailer)))))))))))))))))
-
+ (wrap-new-form header (list 'cond (list vvalue '=> (car true))) trailer)))))))
+ (if (and (len=2? first-arg)
+ (eq? (car first-arg) 'not)
+ (eq? (cadr first-arg) vname)
+ (= (tree-count vname body 2) 1))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (wrap-new-form header (tree-subst vvalue vname p) trailer))))))))))))))))
+
;; -------- let->for-each --------
(define (let->for-each caller form varlist body)
(when (and (len>2? body)
@@ -19075,12 +19220,12 @@
(not (tree-memq name p))) ; we could split the body into for-each sections, but that would repeat the lambda
(lint-format "perhaps ~A" caller
(lists->string form
- (let ((fe (let ((a1 (if (every? code-constant? arg1)
+ (let ((fe (let ((a1 (if (lint-every? code-constant? arg1)
(list 'quote (map unquoted (reverse arg1)))
(cons 'list (reverse arg1))))
(a2 (if (not (pair? arg2))
()
- (if (every? code-constant? arg2)
+ (if (lint-every? code-constant? arg2)
(list 'quote (map unquoted (reverse arg2)))
(cons 'list (reverse arg2))))))
(if (pair? arg2)
@@ -19114,12 +19259,12 @@
(set! prev call)
(begin
(if (and (pair? prev)
- (= (tree-count (cadr prev) call) 1)
+ (= (tree-count (cadr prev) call 2) 1)
(not (or (tree-memq (cadr prev) (cdr p))
- (hash-table-ref definers (car call))
+ (hash-table-ref definers-table (car call))
(side-effect? (caddr prev) env) ; this is needed -- let* in effect
(any-macro? (car call) env)
- (memq (car call) '(map for-each list-values #_list-values))
+ (memq (car call) '(map for-each list-values))
(and (eq? (car call) 'let)
(symbol? (cadr call))))) ; i.e. not named-let
(or (not (eq? (car call) 'do))
@@ -19157,9 +19302,9 @@
ok-funcs)))
(when (pair? ok-funcs)
(let* ((func-names (map car ok-funcs))
- (letrec? (any? (lambda (f)
- (tree-set-member func-names (cdddr f)))
- ok-funcs))
+ (letrec? (lint-any? (lambda (f)
+ (tree-set-memq func-names (cdddr f)))
+ ok-funcs))
(old-vars (if (< (tree-leaves (cadr form)) local-function-context)
(cadr form)
(list (if (< (tree-leaves (caadr form)) local-function-context)
@@ -19167,7 +19312,7 @@
(list (caaadr form) '...))
'...))))
- ;; the letrec has to be a added (we can't combine let+letrec) because
+ ;; the letrec has to be added (we can't combine let+letrec) because
;; (let ((x 1)) (letrec ((x (+ x 1))) x)) is an error ("+ argument 1, #<undefined>...")
;; so the original (let ((x (+ x 1))) (define ...)...) has to be
;; (let ((x (+ x 1))) (letrec ...) ...) or the reverse: (let ((x 1)) (letrec (...) (let ((x (+ x 1))) x)))
@@ -19226,7 +19371,7 @@
(memq (car test) '(null? not eof-object?))) ; memx/charx got no hits
(and (len=2? (cdr test))
(memq (car test) '(eq? eqv? =))
- (any? code-constant? test)))
+ (lint-any? code-constant? test)))
(or (and (or (eq? false var)
(and (len=2? false)
(eq? var (cadr false))))
@@ -19237,8 +19382,7 @@
(not (tree-memq var false)))))
(set! last-let->case-line-number line-number)
(lint-format "perhaps use case: ~A" caller
- (let ((new-form (let ((key #f)
- (result #f))
+ (let ((new-form (let ((key #f))
(if (memq (car test) '(null? not eof-object?))
(set! key (case (car test) ((not) #f) ((eof-object?) #<eof>) (else ())))
(begin
@@ -19274,15 +19418,17 @@
(if (keyword? named-let) ; (let :x ((i y)) (x i))
(lint-format "bad let name: ~A" caller named-let))
- (unless named-let
- (remove-null-let caller form env))
+ (if named-let
+ (if *report-shadowed-variables*
+ (report-shadower caller 'let 'named-let-function-name named-let named-let env))
+ (remove-null-let caller form env))
(let ((vars (declare-named-let caller form env))
(varlist ((if named-let caddr cadr) form))
(body ((if named-let cdddr cddr) form)))
(if (not (and (proper-list? varlist)
- (every? pair? varlist)))
+ (lint-every? pair? varlist)))
(lint-format "let is messed up: ~A" caller (truncated-list->string form))
(begin
(if (and (null? varlist)
@@ -19357,7 +19503,7 @@
(pair? (car body))
(eq? (caar body) 'do)
(len>2? (car body))
- (every? len>1? (cadar body))
+ (lint-every? len>1? (cadar body))
(< (tree-leaves (cdr body)) *max-cdr-len*))
(let ((inits (if (pair? (cadar body))
(map cadr (cadar body))
@@ -19399,7 +19545,7 @@
(if (or (null? varlist)
(len=1? varlist) ; (let* ((x (log y))) x)
(not (or side-effects ; (let* ((x (log y)) (z 32))...)
- (any? (lambda (v) (positive? (var-ref v))) vars))))
+ (lint-any? (lambda (v) (positive? (var-ref v))) vars))))
(lint-format "let* could be let: ~A" caller (truncated-list->string form))))
;; in s7, let evaluates var values top down, so this message is correct
;; even in cases like (let ((ind (open-sound...)) (mx (maxamp))) ...)
@@ -19424,7 +19570,7 @@
(memq (var-name (car e)) '(:lambda :dilambda)))
(let ((ldata (cdar e)))
(set! (var-name (car e)) (caar bindings))
- (set! (ldata 'initial-value) expr)
+ (let-set! ldata 'initial-value expr)
(set! vars (cons (car e) vars)))
(set! vars (cons (make-lint-var (caar bindings) expr (if named-let 'named-let* 'let*))
vars))))
@@ -19460,10 +19606,10 @@
(let ((body (cddr form))
(new-vars ())
(vs-pos vars)
- (repeats (do ((p vars (cdr p)))
- ((or (null? p)
- (var-member (var-name (car p)) (cdr p)))
- (pair? p)))))
+ (no-repeats (do ((p vars (cdr p)))
+ ((or (null? p)
+ (var-member (var-name (car p)) (cdr p)))
+ (null? p)))))
(for-each (lambda (v)
(let ((vname (var-name v))
(vvalue #f))
@@ -19490,7 +19636,7 @@
(let ((deps ()))
(for-each (lambda (nv)
(if (and (eq? (car nv) var)
- (or (not repeats)
+ (or no-repeats
(tree-memq (cadr nv) val)))
(set! deps (cons (list (cadr nv)
(gather-dependencies (cadr nv) (caddr nv) env))
@@ -19517,7 +19663,7 @@
new-let-binds
'...)))))
- (when (and (not repeats)
+ (when (and no-repeats
(len>2? vars))
(let ((outer-vars ())
(inner-vars ())
@@ -19532,11 +19678,11 @@
(value (var-initial-value v)))
(if (or (side-effect? value env)
- (any? (lambda (trailing-var)
- ;; vname is possible inner let var if it is not mentioned in any trailing initial value
- ;; (repeated name can't happen here)
- (tree-memq vname (var-initial-value trailing-var)))
- (cdr vs)))
+ (lint-any? (lambda (trailing-var)
+ ;; vname is possible inner let var if it is not mentioned in any trailing initial value
+ ;; (repeated name can't happen here)
+ (tree-memq vname (var-initial-value trailing-var)))
+ (cdr vs)))
(set! outer-vars (cons vname outer-vars))
(set! inner-vars (cons vname inner-vars)))
@@ -19647,18 +19793,18 @@
(not (set-target (car v) body env))
(not (set-target (cadr v) body env)))
(let ((data (var-member (cadr v) env)))
- (if (and (or (not (var? data))
+ (if (and (or (not data)
(and (not (eq? (var-definer data) 'parameter))
(or (null? (var-setters data))
- (not (tree-set-member (var-setters data) body)))))
- (not (any? (lambda (p)
- (and (len>1? p)
- (or (set-target (cadr v) (cdr p) env)
- (set-target (car v) (cdr p) env)
- (and (var? data)
- (pair? (var-setters data))
- (tree-set-member (var-setters data) body)))))
- (cdr vs))))
+ (not (tree-set-memq (var-setters data) body)))))
+ (not (lint-any? (lambda (p)
+ (and (len>1? p)
+ (or (set-target (cadr v) (cdr p) env)
+ (set-target (car v) (cdr p) env)
+ (and data
+ (pair? (var-setters data))
+ (tree-set-memq (var-setters data) body)))))
+ (cdr vs))))
(set! changes (cons v changes))))))))
;; -------- combine-let*-vars --------
@@ -19701,7 +19847,7 @@
(nxt-var (cadr v)))
(when (and (len>1? cur-var)
(let ((v (var-member (car cur-var) vars)))
- (and (var? v)
+ (and v
(zero? (var-set v))))
(len>1? nxt-var)
(< (tree-leaves (cadr cur-var)) 8)
@@ -19710,11 +19856,11 @@
(symbol? (cadadr nxt-var))))
(or (not (pair? (cadr nxt-var)))
(not (side-effect? (cadr cur-var) env))
- (every? (lambda (a)
- (or (code-constant? a)
- (assq a varlist)))
- (cdadr nxt-var)))
- (tree-nonce (car cur-var) (cadr nxt-var))
+ (lint-every? (lambda (a)
+ (or (code-constant? a)
+ (assq a varlist)))
+ (cdadr nxt-var)))
+ (= (tree-count (car cur-var) (cadr nxt-var) 2) 1)
(not (tree-memq (car cur-var) (cddr v)))
(not (tree-memq (car cur-var) body)))
(set! gone-vars (cons cur-var gone-vars))
@@ -19732,18 +19878,18 @@
(let ((varlist-len (length varlist)))
(when (and (pair? (cdr last-var)) ; varlist-len can be 1 here
(< (tree-leaves (cadr last-var)) 12)
- (tree-nonce (car last-var) body)
+ (= (tree-count (car last-var) body 2) 1)
(pair? (car body))
(null? (cdr body))
(not (memq (caar body) '(lambda lambda* define define* define-macro)))
(not (and (eq? (caar body) 'set!)
(eq? (car last-var) (cadar body))))
(not (any-macro? (caar body) env))
- (not (any? (lambda (p)
- (and (unquoted-pair? p)
- (or (not (hash-table-ref no-side-effect-functions (car p)))
- (any? pair? (cdr p)))))
- (cdar body))))
+ (not (lint-any? (lambda (p)
+ (and (unquoted-pair? p)
+ (or (not (hash-table-ref no-side-effect-functions (car p)))
+ (lint-any? pair? (cdr p)))))
+ (cdar body))))
;; (let* ((a 1) (b 2) (c (+ a 1))) (* c 2)) -> (let* ((a 1) (b 2)) (* (+ a 1) 2))
(lint-format "perhaps ~A" caller
(lists->string form (cons (if (<= varlist-len 2) 'let 'let*)
@@ -19768,7 +19914,7 @@
(if (eq? (cadddr p) (car last-var))
`((else #f)) ; this stands in for the local var
(if (and (pair? (cadddr p))
- (tree-unquoted-member (car last-var) (cadddr p)))
+ (tree-memq (car last-var) (cadddr p)))
:oops! ; if the let var appears in the else portion, we can't do anything with =>
(list (list 'else (cadddr p)))))
(case (car p)
@@ -19807,15 +19953,15 @@
;; -------- reduce-let*-scope
(define (reduce-let*-scope caller form vars)
- (let ((last-ref (vector (var-name (car vars)) #f 0 (car vars)))
+ (let ((lastref (vector (var-name (car vars)) #f 0 (car vars)))
(body (cddr form))
(varlist (cadr form)))
(do ((p body (cdr p))
(i 0 (+ i 1)))
((null? p)
- (let ((cur-line (last-ref 1))
- (max-line (last-ref 2))
- (vname (last-ref 0)))
+ (let ((cur-line (lastref 1))
+ (max-line (lastref 2))
+ (vname (lastref 0)))
(if (and (< max-line (/ i lint-let-reduction-factor))
(> (- i max-line) 3))
(lint-format "the scope of ~A could be reduced: ~A" caller
@@ -19823,13 +19969,13 @@
(lists->string form
`(,(if (> (length vars) 2) 'let* 'let)
,(copy varlist (make-list (- (length vars) 1)))
- (let (,(list vname (var-initial-value (last-ref 3))))
+ (let (,(list vname (var-initial-value (lastref 3))))
,@(copy body (make-list (+ max-line 1))))
,(list-ref body (+ max-line 1))
...)))
(when (and (integer? cur-line)
(< (- max-line cur-line) 2)
- (code-constant? (var-initial-value (last-ref 3))))
+ (code-constant? (var-initial-value (lastref 3))))
(lint-format "~A is only used in expression~A (of ~A),~%~NC~A~A of~%~NC~A" caller
vname
(format #f (if (= cur-line max-line)
@@ -19845,18 +19991,18 @@
(truncated-list->string (list-ref body max-line))))
(+ lint-left-margin 4) #\space
(truncated-list->string form))))))
- (when (tree-memq (last-ref 0) (car p))
- (set! (last-ref 2) i)
- (if (not (last-ref 1)) (set! (last-ref 1) i))))))
+ (when (tree-memq (lastref 0) (car p))
+ (set! (lastref 2) i)
+ (if (not (lastref 1)) (set! (lastref 1) i))))))
;; -------- let*-local-funcs->closure --------
(define (let*-local-funcs->closure caller form body largs)
(let ((ok-funcs (local-movable-funcs body largs)))
(when (pair? ok-funcs)
(let* ((func-names (map car ok-funcs))
- (letrec? (any? (lambda (f)
- (tree-set-member func-names (cdddr f)))
- ok-funcs)))
+ (letrec? (lint-any? (lambda (f)
+ (tree-set-memq func-names (cdddr f)))
+ ok-funcs)))
(lint-format "the inner function~A ~{~A~^, ~} could be moved out of the let*: ~A" caller
(if (null? (cdr ok-funcs)) "" "s")
func-names
@@ -19875,9 +20021,13 @@
(let ((vars (declare-named-let caller form env))
(varlist ((if named-let caddr cadr) form))
(body ((if named-let cdddr cddr) form)))
-
+
+ (if (and named-let
+ *report-shadowed-variables*)
+ (report-shadower caller 'let* 'named-let*-function-name named-let named-let env))
+
(if (not (and (proper-list? varlist)
- (every? pair? varlist)))
+ (lint-every? pair? varlist)))
(lint-format "let* is messed up: ~A" caller (truncated-list->string form))
(begin
(when (and (pair? body)
@@ -19907,7 +20057,7 @@
(remove-unneeded-let*-vars caller form env))
(combine-let*-vars caller form vars env)
- (let ((last-var (last-par varlist)))
+ (let ((last-var (last-ref varlist)))
(combine-let*-last-var caller form last-var env)
(if (and (null? (cdr body))
(len>1? (car body))
@@ -19935,7 +20085,7 @@
(pair? (car bindings))
(pair? (cdar bindings))))
(memq (cadar bindings) vs)
- (tree-set-member vs (cadar bindings)))
+ (tree-set-memq vs (cadar bindings)))
(when (null? bindings)
(let ((letx (if (or (eq? head 'letrec)
(do ((p (map cadr (cadr form)) (cdr p))
@@ -19952,11 +20102,11 @@
(when (and (eq? (car form) 'letrec*)
(len>1? (cadr form)) ; len=1 case handle elsewhere
- (every? (lambda (p)
- (and (len=2? p)
- (pair? (cadr p))
- (eq? (caadr p) 'lambda)))
- (cadr form)))
+ (lint-every? (lambda (p)
+ (and (len=2? p)
+ (pair? (cadr p))
+ (eq? (caadr p) 'lambda)))
+ (cadr form)))
;; this happens only in psyntax-pp.scm (Guile)
(lint-format "letrec* could be letrec: ~A" caller (truncated-list->string form)))
@@ -19982,7 +20132,7 @@
,(map list (cadr lform) (cdr body))
,@(cddr lform)))))
(if (and (not (eq? caller 'define))
- (tree-nonce sym body))
+ (= (tree-count sym body 2) 1))
(let ((call (find-call sym body)))
(when (pair? call)
(let ((new-call `(let ,sym
@@ -20013,14 +20163,14 @@
(len>1? (car bindings))
;; type of current var is not important -- if used in non-function elsewhere,
;; it has to be letrec*
- (any? (lambda (b)
- (and (len>1? b)
- (or (and (not (pair? (cadr b)))
- (eq? (caar bindings) (cadr b)))
- (tree-memq (caar bindings) (cadr b)))
- (not (tree-set-member '(lambda lambda* define define* case-lambda) (cadr b)))
- (set! baddy b)))
- (cdr bindings)))
+ (lint-any? (lambda (b)
+ (and (len>1? b)
+ (or (and (not (pair? (cadr b)))
+ (eq? (caar bindings) (cadr b)))
+ (tree-memq (caar bindings) (cadr b)))
+ (not (tree-set-memq '(lambda lambda* define define* case-lambda) (cadr b)))
+ (set! baddy b)))
+ (cdr bindings)))
(set! warned #t)
;; (letrec ((x 32) (f1 (let ((y 1)) (lambda (z) (+ x y z)))) (f2 (f1 x))) (+ x f2))
(lint-format "in ~A,~%~NCletrec should be letrec* because ~A is used in ~A's value (not a function): ~A" caller
@@ -20052,7 +20202,7 @@
(eq? (caaddr form) 'lambda)
(pair? (caadr form))
(tree-car-member (caaadr form) (cddr form))
- (tree-nonce (caaadr form) (cddr form))) ; this alone can give (caaadr form) passed as a function arg
+ (= (tree-count (caaadr form) (cddr form) 2) 1)) ; this alone can give (caaadr form) passed as a function arg
(let ((lr-lambda (cadr (caadr form))))
(when (and (pair? lr-lambda)
(eq? 'lambda (car lr-lambda)))
@@ -20068,12 +20218,12 @@
(call-with-exit
(lambda (quit)
- (let ((vs (out-vars lr-name pars (cddr lr-lambda))))
- (when (pair? (car vs))
+ (let ((vs (car (out-vars lr-name pars (cddr lr-lambda)))))
+ (when (pair? vs)
(for-each (lambda (v)
(if (shadowed? v (caddr form)) ; this never happens
(quit)))
- (car vs)))) ; set (cadr) appears to include args which leads to false positives here
+ vs))) ; set (cadr) appears to include args which leads to false positives here
(lint-format "perhaps ~A" caller
(lists->string form
(tree-subst `(let ,lr-name ,(map list pars lr-args)
@@ -20085,7 +20235,7 @@
(define (letrec-walker caller form env)
(if (not (and (>= (length form) 3) ; (letrec () . 1)
(proper-list? (cadr form))
- (every? pair? (cadr form))))
+ (lint-every? pair? (cadr form))))
(begin
(lint-format "~A is messed up: ~A" caller (car form) (truncated-list->string form))
env)
@@ -20143,7 +20293,7 @@
;; begin+do+return -> do+return
(if (and (eq? (caadr form) 'do)
(< (tree-leaves (caddr form)) 24) ; or maybe (< ... (min 24 (tree-leaves do-form)))?
- (not (tree-set-member (map car (cadadr form)) (caddr form))))
+ (not (tree-set-memq (map car (cadadr form)) (caddr form))))
;; (begin (do ((i 0 (+ i 1))) ((= i 3)) (display i)) 32) -> (do ((i 0 (+ i 1))) ((= i 3) 32) (display i))
;; the do loop has to end normally to go on? That is, moving the following expr into the do end section is safe?
(lint-format "perhaps ~A" caller
@@ -20162,7 +20312,7 @@
(if (and (memq (caadr form) '(let let* letrec letrec*)) ; same for begin + let + expr -- not sure about this...
(not (symbol? (cadadr form)))
(< (tree-leaves (caddr form)) 24)
- (not (tree-set-member (map car (cadadr form)) (caddr form))))
+ (not (tree-set-memq (map car (cadadr form)) (caddr form))))
(lint-format "perhaps ~A" caller
(lists->string form
(let ((let-form (cadr form)))
@@ -20190,14 +20340,17 @@
(let ()
(define (let-temporarily-walker caller form env)
(if (< (length form) 2) ; empty body is ok here
- (lint-format "let-temporarily is messed up: ~A" 'caller (truncated-list->string form))
- (let* ((new-env (cons (make-lint-var :let form 'let-temporarily) env))
- (e (lint-walk-body caller 'let-temporarily (cddr form) new-env)))
- (report-usage caller 'let-temporarily
- (if (eq? e new-env)
- ()
- (env-difference caller e new-env ()))
- new-env)))
+ (lint-format "let-temporarily is messed up: ~A" caller (truncated-list->string form))
+ (let ((new-env (cons (make-lint-var :let form 'let-temporarily) env)))
+ (if (null? (cadr form))
+ (lint-format "let-temporarily with no vars? ~A" caller (truncated-list->string form))
+ (lint-walk caller (cadr form) new-env))
+ (let ((e (lint-walk-body caller 'let-temporarily (cddr form) new-env)))
+ (report-usage caller 'let-temporarily
+ (if (eq? e new-env)
+ ()
+ (env-difference caller e new-env ()))
+ new-env))))
env)
(hash-walker 'let-temporarily let-temporarily-walker))
@@ -20276,7 +20429,7 @@
(define (require-walker caller form env)
(if (not (pair? (cdr form))) ; (require)
(lint-format "~A is pointless" caller form)
- (if (any? string? (cdr form)) ; (require "repl.scm")
+ (if (lint-any? string? (cdr form)) ; (require "repl.scm")
(lint-format "in s7, require's arguments should be symbols: ~A" caller (truncated-list->string form))))
(if (not *report-loaded-files*)
env
@@ -20340,30 +20493,35 @@
(let ((body (cddr func))
(port (and (pair? args) (car args)))
(head (car form)))
+
+ (when *report-shadowed-variables*
+ (report-shadower caller head 'port port func env))
+
(if (or (not port)
(pair? (cdr args)))
;; (lambda () (write args) (newline))
(lint-format "~A argument should be a function of one argument: ~A" caller head func)
- (if (and (len=1? body)
- (len=2? (car body))
- (eq? (cadar body) port))
- ;; (call-with-input-file "file" (lambda (p) (read-char p))) -> (call-with-input-file "file" read-char)
- (lint-format "perhaps ~A" caller
- (lists->string form
- (list head (if (= len 2)
- (caar body)
- (values (cadr form) (caar body))))))
- (let ((cc (make-lint-var port
- (list (case head
- ((call-with-input-string) 'open-input-string)
- ((call-with-output-string) 'open-output-string)
- ((call-with-input-file) 'open-input-file)
- ((call-with-output-file) 'open-output-file)))
- head)))
- (lint-walk-body caller head body (cons cc
- (cons (make-lint-var :let form head)
- env)))
- (report-usage caller head (list cc) env))))))))))
+ (begin
+ (if (and (len=1? body)
+ (len=2? (car body))
+ (eq? (cadar body) port))
+ ;; (call-with-input-file "file" (lambda (p) (read-char p))) -> (call-with-input-file "file" read-char)
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (list head (if (= len 2)
+ (caar body)
+ (values (cadr form) (caar body)))))))
+ (let ((cc (make-lint-var port
+ (list (case head
+ ((call-with-input-string) 'open-input-string)
+ ((call-with-output-string) 'open-output-string)
+ ((call-with-input-file) 'open-input-file)
+ ((call-with-output-file) 'open-output-file)))
+ head)))
+ (lint-walk-body caller head body (cons cc
+ (cons (make-lint-var :let form head)
+ env)))
+ (report-usage caller head (list cc) env))))))))))
env)
(for-each (lambda (op)
(hash-walker op call-with-io-walker))
@@ -20413,6 +20571,11 @@
(lint-walk caller (cdr form) env)
(let ((body (cddadr form))
(head (car form)))
+
+ (when *report-shadowed-variables*
+ (report-shadower caller head
+ (if (eq? head 'call-with-exit) 'exit-function 'continuation)
+ continuation form env))
(if (not (or (eq? head 'call-with-exit) ; (call/cc (lambda (p) (+ x (p 1))))
(eq? continuation (car body)) ; and (null? (cdr) I think (call/cc (lambda (k) k)) is intended
@@ -20430,7 +20593,7 @@
continuation
(truncated-list->string form))
(let ((last (and (proper-list? body)
- (list-ref body (- (length body) 1)))))
+ (last-ref body))))
(if (and (pair? last)
(eq? (car last) continuation))
;; (call-with-exit (lambda (return) (display x) (return (+ x y))))
@@ -20459,7 +20622,7 @@
(define (walk-import caller form env) ; report repeated entries in import and export lists -- this does not apply to s7
(if (and (> (length form) 12)
- (every? symbol? (cdr form)))
+ (lint-every? symbol? (cdr form)))
(get-repeats caller (cdr form)))
env)
@@ -20495,7 +20658,7 @@
(if (and (pair? (cdr form))
(symbol? (cadr form))
(not (keyword? (cadr form)))) ; !! this thing is a disaster from the very start
- (cons (make-fvar (cadr form) :ftype 'define-syntax) env)
+ (cons (make-fvar (cadr form) 'define-syntax #f #f #f) env)
env)))
(hash-walker 'define-method ; guile and mit-scheme have different syntaxes here
@@ -20508,11 +20671,11 @@
(lint-walk-body caller 'define-method (cddr cdr-form) env)
(let ((new-env (if (var-member (car cdr-form) env)
env
- (cons (make-fvar (car cdr-form) :ftype 'define-method) env))))
+ (cons (make-fvar (car cdr-form) 'define-method #f #f #f) env))))
(lint-walk-body caller (car cdr-form) (cddr cdr-form) new-env)))
(let ((new-env (if (var-member (caar cdr-form) env)
env
- (cons (make-fvar (caar cdr-form) :ftype 'define-method) env))))
+ (cons (make-fvar (caar cdr-form) 'define-method #f #f #f) env))))
(lint-walk-body caller (caar cdr-form) (cdr cdr-form) new-env)))))))
(hash-walker 'let-syntax (lambda (caller form env)
@@ -20570,7 +20733,7 @@
(arglist (let ((arg1 (car clause1))
(arg2 (car clause2)))
(if (> (car lens) (cadr lens)) arg2 arg1))) ; lens is reversed
- (arg-name (list-ref arglist (- (length arglist) 1)))
+ (arg-name (last-ref arglist))
(diffs (let arg->defaults ((arg arg-name)
(b1 body1)
(b2 body2)
@@ -20609,9 +20772,11 @@
(define (hash-fragment reduced-form leaves env func orig-form line outer-vars)
;; func here is either #f or an env-style entry (cons name let) as produced by make-fvar,
;; the let entries accessed are initial-value, history, arglist
- (let ((old (hash-table-ref (fragments leaves) reduced-form)))
+ (let ((old (hash-table-ref (vector-ref fragments leaves) reduced-form)))
+ (set! fragmin (min leaves fragmin))
+ (set! fragmax (min *fragment-max-size* (max leaves fragmax)))
(if (not (vector? old))
- (hash-table-set! (fragments leaves) reduced-form (vector 1 (list line) (and func (list func)) orig-form #f outer-vars))
+ (hash-table-set! (vector-ref fragments leaves) reduced-form (vector 1 (list line) (and func (list func)) orig-form #f outer-vars))
;; key = reduced-form
;; value = #(list uses line-numbers fvar original-form)
(begin
@@ -20620,35 +20785,37 @@
(when func
(if (not (vector-ref old 2))
(vector-set! old 2 (list func))
- (let ((caller (if (keyword? (var-name func)) 'define (var-name func))))
+ (let ((caller (if (keyword? (var-name func)) 'define (var-name func)))
+ (func-name (var-name func)))
(let search ((vs (vector-ref old 2)))
(when (pair? vs)
- (let ((v (car vs)))
+ (let* ((v (car vs))
+ (vname (var-name v)))
(cond ((not (eqv? (length (var-arglist v)) (length (var-arglist func))))
(search (cdr vs)))
((eq? (var-history v) :built-in)
(lint-format "~A is the same as the built-in ~A ~A" caller
- (var-name func)
+ func-name
(if (eq? (car (var-initial-value v)) 'define-macro) 'macro 'function)
- (var-name v)))
+ vname))
- ((not (var-member (var-name v) env))
+ ((not (var-member vname env))
(lint-format "~A is the same as ~A" caller
- (var-name func)
- (if (< 0 (pair-line-number (var-initial-value v)) 100000)
- (format #f "~A (line ~D)" (var-name v) (pair-line-number (var-initial-value v)))
- (if (eq? (var-name func) (var-name v))
- (format #f "previous ~A" (var-name v))
- (var-name v)))))
-
- ((eq? (var-name v) (var-name func))
+ func-name
+ (if (pair-line-number (var-initial-value v))
+ (format #f "~A (line ~D)" vname (pair-line-number (var-initial-value v)))
+ (if (eq? func-name vname)
+ (format #f "previous ~A" vname)
+ vname))))
+
+ ((eq? vname func-name)
(lint-format "~A definition repeated: ~A" caller
- (var-name func) (truncated-list->string (var-initial-value func))))
+ func-name (truncated-list->string (var-initial-value func))))
(else
(lint-format "~A could be (define ~A ~A)" caller
- (var-name func) (var-name func) (var-name v)))))))
+ func-name func-name vname))))))
(vector-set! old 2 (cons func (vector-ref old 2))))))))))
(define (reduce-tree new-form env fvar orig-form)
@@ -20691,19 +20858,19 @@
(set! body (cddr tree))))
(if (not (list? locals)) (quit))
- (for-each (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))))
- locals)
+ (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))))
@@ -20813,7 +20980,7 @@
(map cadr lvars)
(let ((lst (map cadr lvars)))
(append (copy lst (make-list (- (length lst) 1)))
- (list-ref lst (- (length lst) 1))))))))
+ (last-ref lst)))))))
(cons 'lambda (cons new-args new-body))))
((lambda*)
@@ -20822,7 +20989,8 @@
(proper-list? (cadr tree)))))
(quit))
(let ((old-args (args->proper-list (cadr tree))))
- (if (not (pair? old-args))
+ (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))
@@ -20901,7 +21069,7 @@
;; functions within a function (fvar not #f).
;; but adding that possibility got no hits
- #_list-values #_apply-values #_append quasiquote unquote
+ list-values apply-values append quasiquote unquote
define-constant define-macro define-macro* define-expansion
define-syntax let-syntax letrec-syntax match syntax-rules
@@ -20953,35 +21121,24 @@
(cadar ovars))
(set-outer (cdr ovars))))))))))
- (unless (< 0 line 100000)
+ (unless line
(set! line (let search ((tree orig-form))
(and (pair? tree)
- (let ((nl (pair-line-number tree)))
- (if (< 0 nl 100000)
- nl
- (or (search (car tree))
- (search (cdr 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
- (hash-fragment reduced-form leaves env fvar orig-form line outer-vars)
-
- (if (and (memq (car reduced-form) '(or and))
- (> (length reduced-form) 3))
- (do ((i (- (length reduced-form) 1) (- i 1))
- (rfsize leaves))
- ((or (= i 2)
- (<= rfsize *fragment-min-size*)))
- (let ((rf (copy reduced-form (make-list i))))
- (set! rfsize (tree-leaves rf))
- (when (> rfsize *fragment-min-size*)
- (hash-fragment rf rfsize env #f (copy orig-form (make-list i)) line outer-vars)))))
-
+ (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 (hash-table-ref (fragments leaves) (list reduced-form))))
+ (let ((fvars (let ((fcase (and (< leaves *fragment-max-size*)
+ (hash-table-ref (vector-ref fragments leaves) (list reduced-form)))))
(and (vector? fcase)
(vector-ref fcase 2)))))
(when (pair? fvars)
@@ -21033,7 +21190,7 @@
;; -------- walk head=symbol --------
(define walk-symbol
(letrec ((unsafe-makers '(sublet inlet copy cons list append make-shared-vector vector hash-table hash-table*
- make-hash-table make-hook #_list-values #_append gentemp or and not))
+ make-hash-table make-hook list-values append gentemp or and not))
(equal-ignoring-constants?
(lambda (a b)
@@ -21051,7 +21208,7 @@
(lambda (caller head form env)
(let ((v (var-member head env)))
- (if (and (var? v)
+ (if (and v
(not (memq form (var-history v))))
(begin
(set! (var-history v) (cons form (var-history v)))
@@ -21094,7 +21251,7 @@
(truncated-list->string (list-ref body len)))))))))
(when (and (eq? (car arg) 'or)
(proper-list? arg))
- (let ((else-clause (let ((last-clause (list-ref arg (- (length arg) 1))))
+ (let ((else-clause (let ((last-clause (last-ref arg)))
(if (and (pair? last-clause)
(memq (car last-clause) '(error throw)))
last-clause
@@ -21120,7 +21277,7 @@
(else ,else-clause))))))))))
(unless (or (<= branches 2)
(any-macro? head env)
- (memq head '(for-each map #_list-values * + - /)))
+ (memq head '(for-each map list-values * + - /)))
(let ((leaves (tree-leaves form)))
(when (> leaves (max *report-bloated-arg* (* branches 3)))
(do ((p (cdr form) (cdr p))
@@ -21150,8 +21307,7 @@
(if (and (memq (caar p) '(let let*))
(list? (cadar p))
(not (assq head (cadar p)))) ; actually not intersection header+trailer (map car cadr)
- (let ((last (let ((body (cddar p)))
- (list-ref body (- (length body) 1)))))
+ (let ((last (last-ref (cddar p))))
(if (< (tree-leaves last) 12)
(format #f "(~A ... ~A)"
(caar p)
@@ -21168,7 +21324,7 @@
(for-each (lambda (arg)
(if (symbol? arg)
(let ((v (var-member arg env)))
- (if (and (var? v)
+ (if (and v
(not (memq form (var-history v))))
(begin
(set! (var-history v) (cons form (var-history v)))
@@ -21194,11 +21350,13 @@
(for-each (lambda (p)
(when (let constable? ((cp p))
(and (len>1? cp)
- (memq (car cp) '(list vector))
- (every? (lambda (inp)
- (or (code-constant? inp)
- (constable? inp)))
- (cdr cp))))
+ (memq (car cp) '(list vector int-vector float-vector byte-vector))
+ (lint-every? (lambda (inp)
+ (and (or (not (symbol? inp)) ; leave (list pi *stderr*) unrewritten
+ (keyword? inp))
+ (or (code-constant? inp)
+ (constable? inp))))
+ (cdr cp))))
(let ((pval (eval/error caller p)))
(if (not (eq? pval :error))
(lint-format "perhaps ~A -> ~A~A" caller
@@ -21224,47 +21382,61 @@
(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 (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
;; need true+false in every case, and need to be contiguous
;; case/cond happen here, but very rarely in a way we can combine via values
+#|
+ ;; happens a lot but is it useful?
+ ;; currently depends on sandbox in stuff.scm
+ (if (and (var? v)
+ (memq (var-ftype v) '(define-macro define-macro* defmacro defmacro* define-expansion)))
+ (let ((expansion (sandbox `(let () ,(var-initial-value v) (macroexpand ,form)))))
+ (if expansion ; #f means sandbox is unwilling to evaluate the form
+ (if (and (code-constant? expansion) ; really dumb (C macro) and we already complain about this elsewhere
+ (not (string? expansion))) ; probably the encapsulated error
+ (lint-format "~A is ~S~%" caller (truncated-list->string form) expansion))
+ ;; here we could walk the new form.
+ )))
+|#
(unless (any-macro? head env) ; actually most macros are safe here...
- (let ((p (member 'if (cdr form) (lambda (x q)
- (and (len>2? q)
- (eq? (car q) 'if) ; it's an if expression
- (pair? (cdddr q))))))) ; and a false branch (similarly below)
- (when (pair? p)
- (do ((test (cadar p))
- (q (cdr p) (cdr q)))
- ((not (and (pair? q)
- (let ((x (car q)))
- (and (len>2? x)
- (eq? (car x) 'if)
- (equal? (cadr x) test)
- (pair? (cdddr x))))))
- (unless (eq? q (cdr p))
- (let ((header (do ((i 1 (+ i 1))
- (r (cdr form) (cdr r)))
- ((eq? r p)
- (copy form (make-list i)))))
- (middle (do ((r p (cdr r))
- (trues ())
- (falses ()))
- ((eq? r q)
- (list 'if test
- (cons 'values (reverse trues))
- (cons 'values (reverse falses))))
- (set! trues (cons (caddar r) trues))
- (set! falses (cons (car (cdddar r)) falses)))))
- ;; (+ (if A B C) (if A C D) y) -> (+ (if A (values B C) (values C D)) y)
- (lint-format "perhaps~A ~A" caller
- (if (side-effect? test env)
- (format #f " (ignoring ~S's possible side-effects)" test)
- "")
- (lists->string form (append header (cons middle q))))))))))))
+ (do ((p (cdr form) (cdr p)))
+ ((or (not (pair? p))
+ (and (len>2? (car p))
+ (eq? (caar p) 'if)
+ (pair? (cdddar p))))
+ (when (pair? p)
+ (do ((test (cadar p))
+ (q (cdr p) (cdr q)))
+ ((not (and (pair? q)
+ (let ((x (car q)))
+ (and (len>2? x)
+ (eq? (car x) 'if)
+ (equal? (cadr x) test)
+ (pair? (cdddr x))))))
+ (unless (eq? q (cdr p))
+ (let ((header (do ((i 1 (+ i 1))
+ (r (cdr form) (cdr r)))
+ ((eq? r p)
+ (copy form (make-list i)))))
+ (middle (do ((r p (cdr r))
+ (trues ())
+ (falses ()))
+ ((eq? r q)
+ (list 'if test
+ (cons 'values (reverse trues))
+ (cons 'values (reverse falses))))
+ (set! trues (cons (caddar r) trues))
+ (set! falses (cons (car (cdddar r)) falses)))))
+ ;; (+ (if A B C) (if A C D) y) -> (+ (if A (values B C) (values C D)) y)
+ (lint-format "perhaps~A ~A" caller
+ (if (side-effect? test env)
+ (format #f " (ignoring ~S's possible side-effects)" test)
+ "")
+ (lists->string form (append header (cons middle q)))))))))))))
(walk-rest caller form env))))
;; -------- walk head=pair --------
@@ -21299,7 +21471,7 @@
(cons 'let (cons () (cddr head)))))))
((and (proper-pair? (cddr head)) ; ((lambda (...) ...) ...) -> (let ...) -- lambda here is ugly and slow
- (not (any? (lambda (a) (mv-range a env)) (cdr form))))
+ (not (lint-any? (lambda (a) (mv-range a env)) (cdr form))))
(call-with-exit
(lambda (quit) ; uncountably many things can go wrong with the lambda form
(let ((vars ())
@@ -21355,15 +21527,15 @@
(lambda (caller head form env)
(for-each (lambda (p)
(let ((sym (and (symbol? p) p)))
- (when sym
- (let ((v (var-member sym env)))
- (if (var? v)
- (set-ref sym caller form env)
- (if (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))))))))))
+ (cond ((not sym)
+ #f)
+ ((var-member sym env)
+ (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))))))))
(cdr form))
(let ((old-current-form lint-current-form))
@@ -21372,11 +21544,11 @@
(eq? lint-current-form qq-form))
(if (not lint-current-form) (set! lint-current-form form))
(set! qq-form lint-current-form) ; only interested in simplest cases here
- (if (eq? head #_append) ; `(f . g) -> (cons f g) ignoring quotes etc
- (if (and (= (length form) 3) ; `(f . (g . h)) -> (cons f (cons g h))
+ (if (eq? head 'append) ; `(f . g) -> (cons f g) ignoring quotes etc
+ (if (and (= (length form) 3) ; `(f . (g . h)) -> (cons f (cons g h))
(pair? (cadr form))
- (eq? (caadr form) #_list-values)
- (not (tree-set-member '(#_apply-values #_append unquote) (cdr form))))
+ (eq? (caadr form) 'list-values)
+ (not (tree-set-memq '(apply-values append unquote) (cdr form))))
(let ((lst (unlist-values (cadr form)))
(rest (caddr form)))
(if (pair? rest) (set! rest (unlist-values rest)))
@@ -21388,26 +21560,28 @@
`(cons ,(cadr lst)
(cons ,(caddr lst) ,rest)))))))))
- (when (eq? head #_list-values)
+ (when (eq? head 'list-values)
(case (length form)
((1) #f) ; this never happens
((2)
(let ((arg1 (cadr form)))
(cond ((and (pair? arg1)
- (eq? (car arg1) #_apply-values) ; `(, at x) -> (copy x)
- (not (qq-tree? (cadr arg1))))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (unlist-values (if (pair? (cadr arg1))
- (cadr arg1)
- (list 'copy (cadr arg1)))))))
+ (eq? (car arg1) 'apply-values)) ; `(, at x) -> (copy x)
+ (if (not (pair? (cdr arg1)))
+ (lint-format "apply-values needs an argument: ~A" caller form)
+ (if (not (qq-tree? (cadr arg1)))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (unlist-values (if (pair? (cadr arg1))
+ (cadr arg1)
+ (list 'copy (cadr arg1)))))))))
((or (symbol? arg1)
(quoted-symbol? arg1))
(lint-format "perhaps ~A" caller ; `(,x) -> (list x)
(lists->string form (list 'list arg1))))
((and (pair? arg1) ; `((a ,b)) -> (list (list 'a b))
- (not (tree-set-member '(#_apply-values unquote) arg1)))
+ (not (tree-set-memq '(apply-values unquote) arg1)))
(lint-format "perhaps ~A" caller
((if (< (tree-leaves form) 50) lists->string truncated-lists->string)
form
@@ -21421,54 +21595,57 @@
(eq? (car arg1) 'quote)
(eq? (cadr arg1) 'begin)
(not (and (pair? arg2)
- (eq? (car arg2) #_apply-values)))) ; no other way to splice here, I hope
+ (eq? (car arg2) 'apply-values)))) ; no other way to splice here, I hope
(lint-format "pointless begin: ~A" caller
(lists->string form (caddr form))))
- (cond ((not (or (and (pair? arg1)
- (tree-set-member '(#_apply-values #_append unquote) arg1))
+ (cond ((and (len=1? arg2)
+ (eq? (car arg2) 'apply-values))
+ (lint-format "apply-values takes one argument: ~A" caller form))
+
+ ((not (or (and (pair? arg1)
+ (tree-set-memq '(apply-values append unquote) arg1))
(and (pair? arg2)
- (or (tree-set-member '(#_append unquote) arg2)
- (tree-set-member '(#_list-values #_apply-values) (cdr arg2))))))
+ (or (tree-set-memq '(append unquote) arg2)
+ (tree-set-memq '(list-values apply-values) (cdr arg2))))))
(lint-format "perhaps ~A" caller ; `(f ,(map g x)) -> (list 'f (map g x))
(lists->string form ; `(f ,@(map g x)) -> (cons 'f (map g x))
(if (pair? arg2)
(case (car arg2)
- ((#_apply-values)
+ ((apply-values)
(list 'cons (unlist-values arg1) (cadr arg2)))
- ((#_list-values)
+ ((list-values)
(list 'list (unlist-values arg1) (cons 'list (cdr arg2))))
(else
(list 'list (unlist-values arg1) arg2)))
(list 'list (unlist-values arg1) arg2)))))
((and (len=2? arg1)
- (eq? (car arg1) #_apply-values)
+ (eq? (car arg1) 'apply-values)
(not (qq-tree? (cadr arg1))))
(if (and (len=2? arg2)
(not (qq-tree? (cadr arg2)))
- (eq? (car arg2) #_apply-values)) ; `(, at x , at y) -> (append x y)
+ (eq? (car arg2) 'apply-values)) ; `(, at x , at y) -> (append x y)
(lint-format "perhaps ~A" caller
(lists->string form
(list 'append
(unlist-values (cadr arg1))
(unlist-values (cadr arg2)))))
(if (not (and (pair? arg2)
- (tree-set-member '(#_apply-values #_append unquote) arg2)))
+ (tree-set-memq '(apply-values append unquote) arg2)))
(lint-format "perhaps ~A" caller ; `(, at x ,y) -> (append x (list y))
(lists->string form
(list 'append
(unlist-values (cadr arg1))
(list 'list (unlist-values arg2))))))))
- ((and (pair? arg1)
- (= (length arg1) 3) ; `((a . b) (c . d)) -> (list (cons a b) (cons c d))
- (eq? (car arg1) #_append) ; `((a . (b . c))...) -> (list (cons a (cons b c)) ...)
+
+ ((and (len=3? arg1) ; `((a . b) (c . d)) -> (list (cons a b) (cons c d))
+ (eq? (car arg1) 'append) ; `((a . (b . c))...) -> (list (cons a (cons b c)) ...)
(pair? (cadr arg1))
- (eq? (caadr arg1) #_list-values)
- (pair? arg2)
- (= (length arg2) 3)
- (eq? (car arg2) #_append)
+ (eq? (caadr arg1) 'list-values)
+ (len=3? arg2)
+ (eq? (car arg2) 'append)
(pair? (cadr arg2))
- (eq? (caadr arg2) #_list-values))
+ (eq? (caadr arg2) 'list-values))
(let ((ca1 (cadr arg1))
(ca2 (cadr arg2)))
(let ((len1 (length ca1))
@@ -21484,7 +21661,7 @@
(lint-format "perhaps ~A" caller
(lists->string form (list 'list pa1 pa2))))))))
- ((not (tree-set-member '(#_apply-values unquote) (cdr form)))
+ ((not (tree-set-memq '(apply-values unquote) (cdr form)))
(lint-format "perhaps ~A" caller
((if (< (tree-leaves form) 100) lists->string truncated-lists->string)
form
@@ -21493,28 +21670,35 @@
(else ; checked already that form is a proper-list, so the length here is > 3
(define (safe-av? p)
(and (pair? p)
- (eq? (car p) #_apply-values)
- (not (tree-set-member '(#_apply-values #_list-values #_append unquote) (cdr p)))))
+ (eq? (car p) 'apply-values)
+ (not (tree-set-memq '(apply-values list-values append unquote) (cdr p)))))
- (let ((args (cdr form))) ; car is #_list-values
- (cond ((every? (lambda (p) ; `((f . ,a) (g . ,b)...) -> (list (cons f a) (cons g b) ...)
- (and (pair? p) ; from (append (list x) y) -> (cons x y)
- (eq? (car p) #_append)
- (len=2? (cdr p))
- (len=2? (cadr p))
- (eq? (caadr p) #_list-values)))
- args)
+ (let ((args (cdr form))) ; car is list-values
+ (cond ((lint-every? (lambda (p) ; `((f . ,a) (g . ,b)...) -> (list (cons f a) (cons g b) ...)
+ (and (pair? p) ; from (append (list x) y) -> (cons x y)
+ (eq? (car p) 'append)
+ (len=2? (cdr p))
+ (len=2? (cadr p))
+ (eq? (caadr p) 'list-values)))
+ args)
(lint-format "perhaps ~A" caller
(truncated-lists->string form
`(list (cons ,(cadadr (car args)) ,(caddar args))
(cons ,(cadadr (cadr args)) ,(caddr (cadr args)))
...))))
- ((not (every? safe-av? (cddr args)))
+
+ ((lint-any? (lambda (p)
+ (and (len=1? p)
+ (eq? (car p) 'apply-values)))
+ args)
+ (lint-format "apply-values needs an argument: ~A" caller form))
+
+ ((not (lint-every? safe-av? (cddr args)))
(if (and (len=3? args)
(safe-av? (car args)) ; `(, at x , at y ,z) -> (append x y (list z)) etc
(safe-av? (cadr args))
(not (and (pair? (caddr args))
- (memq (caaddr args) '(#_apply-values #_append unquote)))))
+ (memq (caaddr args) '(apply-values append unquote)))))
(lint-format "perhaps ~A" caller
(lists->string form
(list 'append (cadar args) (cadadr args)
@@ -21529,13 +21713,13 @@
(lint-format "perhaps ~A" caller
(lists->string form
(cons 'append (map cadr args))))
- (if (not (tree-set-member '(#_apply-values #_append unquote) (car args)))
+ (if (not (tree-set-memq '(apply-values append unquote) (car args)))
(lint-format "perhaps ~A" caller
(lists->string form
`(cons ,(unlist-values (car args)) (append ,@(map cadr (cdr args)))))))))
- ((not (or (tree-set-member '(#_apply-values #_append unquote) (car args))
- (tree-set-member '(#_apply-values #_append unquote) (cadr args))))
+ ((not (or (tree-set-memq '(apply-values append unquote) (car args))
+ (tree-set-memq '(apply-values append unquote) (cadr args))))
(lint-format "perhaps ~A" caller
(lists->string form
`(cons ,(unlist-values (car args))
@@ -21545,7 +21729,7 @@
(cons 'append (map cadr (cddr args)))))))))
((and (len=3? args)
(safe-av? (car args)) ; `(, at x ,y , at z) -> (append x (cons y z))
- (not (tree-set-member '(#_apply-values #_append unquote) (cadr args))))
+ (not (tree-set-memq '(apply-values append unquote) (cadr args))))
(lint-format "perhaps ~A" caller
(lists->string form
(list 'append (cadar args)
@@ -21559,11 +21743,11 @@
(lambda (caller form env)
(let ((head (car form)))
- (if (or (= line-number -1)
- (positive? (pair-line-number form)))
- (set! line-number (pair-line-number form)))
+ (set! line-number (or (pair-line-number form) line-number))
- (lint-fragment form env)
+ (if *report-repeated-code-fragments*
+ (lint-fragment form env))
+
;; (error...) as arg happens very rarely (a half-dozen hits, one: (values (error...))!
(cond
@@ -21581,24 +21765,21 @@
(lint-format "unexpected dot: ~A" caller (truncated-list->string form)))
env)
+ ((and *report-quasiquote-rewrites*
+ (memq head '(list-values apply-values)))
+ (walk-qq caller head form env))
+
((symbol? head)
(walk-symbol caller head form env))
((pair? head)
(walk-pair caller head form env))
- ((and *report-quasiquote-rewrites*
- (procedure? head)
- (memq head '(#_list-values #_apply-values #_append)))
- (walk-qq caller head form env))
-
(else (walk-rest caller form env)))))))
;; -------- lint-walk --------
(define (lint-walk caller form env)
(cond ((symbol? form)
- (if (memq form '(+i -i)) ; a check for other malformed numbers got no hits
- (format outport "~NC~A is not a number in s7~%" lint-left-margin #\space form))
(set-ref form caller #f env)) ; returns env
((pair? form)
@@ -21613,19 +21794,41 @@
env)
((vector? form)
- (let ((happy #t))
- (for-each
- (lambda (x)
- (when (and (pair? x)
- (eq? (car x) 'unquote))
- (lint-walk caller (cadr x) env) ; register refs
- (set! happy #f)))
- form)
- ;; (begin (define x 1) `#(,x))
- (if (not happy)
- (lint-format "quasiquoted vectors are not supported: ~A~%~NCperhaps use `(vector ...) rather than `#(...)" caller
- (truncated-list->string form)
- (+ lint-left-margin 4) #\space)))
+ (unless (or (int-vector? form)
+ (float-vector? form))
+ (let ((len (length form)))
+ (when (positive? len)
+ (if (integer? (form 0))
+ (do ((i 1 (+ i 1)))
+ ((or (= i len)
+ (not (integer? (vector-ref form i))))
+ (if (= i len)
+ (lint-format "~A could be ~A" caller
+ (let-temporarily (((*s7* 'print-length) 8))
+ (values (object->string form)
+ (object->string (copy form (make-int-vector len)))))))))
+ (if (float? (form 0))
+ (do ((i 1 (+ i 1)))
+ ((or (= i len)
+ (not (float? (vector-ref form i))))
+ (if (= i len)
+ (lint-format "~A could be ~A" caller
+ (let-temporarily (((*s7* 'print-length) 8))
+ (values (object->string form)
+ (object->string (copy form (make-float-vector len)))))))))))
+ (let ((happy #t))
+ (for-each
+ (lambda (x)
+ (when (and (pair? x)
+ (eq? (car x) 'unquote))
+ (lint-walk caller (cadr x) env) ; register refs
+ (set! happy #f)))
+ form)
+ ;; (begin (define x 1) `#(,x))
+ (if (not happy)
+ (lint-format "quasiquoted vectors are not supported: ~A~%~NCperhaps use `(vector ...) rather than `#(...)" caller
+ (truncated-list->string form)
+ (+ lint-left-margin 4) #\space))))))
;; `(x #(,x)) for example will not work in s7, but `(,x ,(vector x)) will
env)
@@ -21649,7 +21852,7 @@
(when *report-input*
(format outport
(if (and (output-port? outport)
- (not (memq outport (list *stderr* *stdout*))))
+ (not (member outport (list *stderr* *stdout*))))
(values "~%~NC~%;~A~%" (+ lint-left-margin 16) #\-)
";~A~%")
file))
@@ -21678,29 +21881,30 @@
(score-cutoff (if (integer? *report-repeated-code-fragments*) *report-repeated-code-fragments* 130)))
(do ((i *fragment-min-size* (+ i 1)))
((= i *fragment-max-size*))
- (for-each (lambda (kv)
- (let ((vals (cdr kv)))
- (when (> (vals 0) 1) ; more than 1 use of fragment
- (let ((score (* i (vals 0) (vals 0))))
- (when (and (> score score-cutoff)
- (or (> i size-cutoff)
- (let ((count 0))
- (let counter ((tree (car kv)))
- (if (pair? tree)
- (begin
- (counter (car tree))
- (counter (cdr tree)))
- (if (and (symbol? tree)
- (memq tree '(_1_ _2_ _3_ _4_ _5_ _6_)))
- (set! count (+ count 1)))))
- (> (- i count) *fragment-min-size*))))
- (vector-set! vals 1 (map (lambda (b) ; line numbers of use points
- (if (< 0 b 100000)
- b
- (values)))
- (reverse (vector-ref vals 1))))
- (set! reportables (cons (list score i kv) reportables)))))))
- (fragments i)))
+ (when (> (hash-table-entries (vector-ref fragments i)) 0)
+ (for-each (lambda (kv)
+ (let ((vals (cdr kv)))
+ (when (> (vals 0) 1) ; more than 1 use of fragment
+ (let ((score (* i (vals 0) (vals 0))))
+ (when (and (> score score-cutoff)
+ (or (> i size-cutoff)
+ (let ((count 0))
+ (let counter ((tree (car kv)))
+ (if (pair? tree)
+ (begin
+ (counter (car tree))
+ (counter (cdr tree)))
+ (if (and (symbol? tree)
+ (memq tree '(_1_ _2_ _3_ _4_)))
+ (set! count (+ count 1)))))
+ (> (- i count) *fragment-min-size*))))
+ (vector-set! vals 1 (map (lambda (b) ; line numbers of use points
+ (if (< 0 b 100000)
+ b
+ (values)))
+ (reverse (vector-ref vals 1))))
+ (set! reportables (cons (list score i kv) reportables)))))))
+ (vector-ref fragments i))))
(let ((reported-lines ())
(reported #f)
(reports 0))
@@ -21758,7 +21962,7 @@
vars) ; lint-file-1 should return the environment
(if (pair? form)
- (set! line (max line (pair-line-number form))))
+ (set! line (max line (or (pair-line-number form) 0))))
(if (not (or (= last-line-number -1)
(side-effect? last-form vars)))
@@ -21769,7 +21973,7 @@
(set! last-line-number line)
(if (and (len>1? form)
- (hash-table-ref definers (car form)) ; set! case is handled elsewhere
+ (hash-table-ref definers-table (car form)) ; set! case is handled elsewhere
(not (memq (car form) '(eval eval-string load require))) ; (eval-string|load (string-append...)) (eval (string->symbol...))
(or (pair? (cadr form))
(symbol? (cadr form))))
@@ -21778,7 +21982,7 @@
(hash-table-ref built-in-functions f))
(format outport "~NCtop-level ~Aredefinition of built-in function ~A: ~A~%"
lint-left-margin #\space
- (if (> (pair-line-number form) 0)
+ (if (pair-line-number form)
(format #f "(line ~D) " (pair-line-number form))
"")
f (truncated-list->string form)))))
@@ -21830,16 +22034,215 @@
;;; lint itself
;;;
(let ((documentation "(lint file port) looks for infelicities in file's scheme code")
- (signature (list #t string? output-port? boolean?)))
+ (signature (list #t string? output-port? boolean?))
+ (readers
+ (list (cons #\e (lambda (str)
+ (unless (string=? str "e")
+ (let ((num (string->number (substring str 1))))
+ (cond ((not num))
+ ((rational? num)
+ (format outport "~NCthis #e is dumb, #~A -> ~A~%" lint-left-margin #\space str (substring str 1)))
+ ((not (real? num))
+ (format outport "~NC#e can't handle complex numbers, #~A -> ~A~%" lint-left-margin #\space str num))
+ ((= num (floor num))
+ (format outport "~NCperhaps #~A -> ~A~%" lint-left-margin #\space str (floor num))))))
+ #f))
+ (cons #\i (lambda (str)
+ (unless (string=? str "i")
+ (let ((num (string->number (substring str 1))))
+ (when num
+ (format outport
+ (if (not (rational? num))
+ (values "~NCthis #i is dumb, #~A -> ~A~%" lint-left-margin #\space str (substring str 1))
+ (values "~NCperhaps #~A -> ~A~%" lint-left-margin #\space str (* 1.0 num)))))))
+ #f))
+ (cons #\d (lambda (str)
+ (if (and (not (string=? str "d"))
+ (string->number (substring str 1)))
+ (format outport "~NC#d is pointless, #~A -> ~A~%" lint-left-margin #\space str (substring str 1)))
+ #f))
+
+ (cons #\' (lambda (str) ; for Guile (and syntax-rules, I think)
+ (list 'syntax (if (string=? str "'") (read) (string->symbol (substring str 1))))))
+
+ (cons #\` (lambda (str) ; for Guile (sigh)
+ (list 'quasisyntax (if (string=? str "`") (read) (string->symbol (substring str 1))))))
+
+ (cons #\, (lambda (str) ; the same, the last is #,@ -> unsyntax-splicing -- right.
+ (list 'unsyntax (if (string=? str ",") (read) (string->symbol (substring str 1))))))
+
+ (cons #\& (lambda (str) ; ancient Guile code
+ (string->keyword (substring str 1))))
+
+ (cons #\\ (lambda (str)
+ (cond ((assoc str '(("\\x0" . #\null)
+ ("\\x7" . #\alarm)
+ ("\\x8" . #\backspace)
+ ("\\x9" . #\tab)
+ ("\\xd" . #\return)
+ ("\\xa" . #\newline)
+ ("\\1b" . #\escape)
+ ("\\x20" . #\space)
+ ("\\x7f" . #\delete)))
+ => (lambda (c)
+ (format outport "~NC#\\~A is ~W~%" lint-left-margin #\space (substring str 1) (cdr c)))))
+ #f))
+
+ (cons #\! (lambda (str)
+ (if (member str '("!optional" "!default" "!rest" "!key" "!aux" "!false" "!true" "!r6rs") string-ci=?) ; for MIT-scheme
+ (string->keyword (substring str 1))
+ (if (string=? str "!eof") ; Bigloo? or Chicken? Guile writes it as #<eof> but can't read it
+ (begin
+ (format outport "~NC#!eof is probably #<eof> in s7~%" lint-left-margin #\space)
+ #<eof>)
+ (let ((lc (str 0))) ; s7 should handle this, but...
+ (do ((c (read-char) (read-char)))
+ ((or (and (eof-object? c)
+ (or (format outport "~NCunclosed block comment~%" lint-left-margin #\space)
+ #t))
+ (and (char=? lc #\!)
+ (char=? c #\#)))
+ #f)
+ (set! lc c)))))))))
+ (read-hooks
+ ;; try to get past all the # and \ stuff in other Schemes
+ ;; main remaining problem: [] used as parentheses (Gauche and Chicken for example)
+ (list (lambda (h)
+ (let ((data (h 'data))
+ (line (port-line-number)))
+ (if (not (h 'type))
+ (begin
+ (format outport "~NCreader[~A]: unknown \\ usage: \\~C~%" lint-left-margin #\space line data)
+ (set! (h 'result) data))
+ (begin
+ (format outport "~NCreader[~A]: unknown # object: #~A~%" lint-left-margin #\space line data)
+ (set! (h 'result)
+ (catch #t
+ (lambda ()
+ (case (data 0)
+ ((#\;) (read) (values))
+
+ ((#\T)
+ (and (string=? data "T")
+ (format outport "#T should be #t~%")
+ #t))
+
+ ((#\F)
+ (and (string=? data "F")
+ (format outport "#F should be #f~%")
+ ''#f))
+
+ ((#\X #\B #\O #\D)
+ (let ((num (string->number (substring data 1) (case (data 0) ((#\X) 16) ((#\O) 8) ((#\B) 2) ((#\D) 10)))))
+ (if (number? num)
+ (begin
+ (format outport "~NCuse #~A~A not #~A~%"
+ lint-left-margin #\space
+ (char-downcase (data 0)) (substring data 1) data)
+ num)
+ (string->symbol data))))
+
+ ((#\i)
+ (format outport "#i is used for int-vectors in s7, not numbers.~%")
+ (cond ((string->number (substring data 1)) => exact->inexact) (else #f)))
+
+ ((#\r)
+ (format outport "#r is used for float-vectors in s7, not numbers.~%")
+ #f)
+
+ ((#\l #\z)
+ (let ((num (string->number (substring data 1)))) ; Bigloo (also has #ex #lx #z and on and on)
+ (if (number? num)
+ (begin
+ (format outport "~NCjust omit this silly #~C!~%" lint-left-margin #\space (data 0))
+ num)
+ (string->symbol data))))
+
+ ((#\u) ; for Bigloo
+ (if (string=? data "unspecified")
+ (format outport "~NCuse #<unspecified>, not #unspecified~%" lint-left-margin #\space))
+ ;; #<unspecified> seems to hit the no-values check?
+ (string->symbol data))
+ ;; Bigloo also seems to use #" for here-doc concatenation??
+
+ ((#\v) ; r6rs byte-vectors?
+ (if (string=? data "vu8")
+ (format outport "~NCuse #u8 in s7, not #vu8~%" lint-left-margin #\space))
+ (string->symbol data))
+
+ ((#\>) ; for Chicken, apparently #>...<# encloses in-place C code
+ (do ((last #\#)
+ (c (read-char) (read-char)))
+ ((and (char=? last #\<)
+ (char=? c #\#))
+ (values))
+ (if (char=? c #\newline)
+ (set! (port-line-number ()) (+ (port-line-number) 1)))
+ (set! last c)))
+
+ ((#\<) ; Chicken also, #<<EOF -> EOF
+ (if (string=? data "<undef>") ; #<undef> chibi et al
+ #<undefined>
+ (if (and (char=? (data 1) #\<)
+ (> (length data) 2))
+ (do ((end (substring data 2))
+ (c (read-line) (read-line)))
+ ((string-position end c)
+ (values)))
+ (string->symbol data))))
+
+ ((#\\)
+ (cond ((assoc data '(("\\newline" . #\newline)
+ ("\\return" . #\return)
+ ("\\space" . #\space)
+ ("\\tab" . #\tab)
+ ("\\null" . #\null)
+ ("\\nul" . #\null)
+ ("\\linefeed" . #\linefeed)
+ ("\\alarm" . #\alarm)
+ ("\\esc" . #\escape)
+ ("\\escape" . #\escape)
+ ("\\rubout" . #\delete)
+ ("\\delete" . #\delete)
+ ("\\backspace" . #\backspace)
+ ("\\page" . #\xc)
+ ("\\altmode" . #\escape)
+ ("\\bel" . #\alarm) ; #\x07
+ ("\\sub" . #\x1a)
+ ("\\soh" . #\x01)
+
+ ;; these are for Guile
+ ("\\vt" . #\xb)
+ ("\\bs" . #\backspace)
+ ("\\cr" . #\newline)
+ ("\\sp" . #\space)
+ ("\\lf" . #\linefeed)
+ ("\\nl" . #\null)
+ ("\\ht" . #\tab)
+ ("\\ff" . #\xc)
+ ("\\np" . #\xc))
+ string-ci=?)
+ => (lambda (c)
+ (format outport "~NCperhaps use ~W instead~%" (+ lint-left-margin 4) #\space (cdr c))
+ (cdr c)))
+ (else
+ (string->symbol (substring data 1)))))
+ (else
+ (string->symbol data))))
+ (lambda args #f))))))))))
+
(lambda* (file (outp *output-port*) (report-input #t))
(set! outport outp)
(set! other-identifiers (make-hash-table))
(set! linted-files ())
(fill! other-names-counts 0)
- (do ((i 0 (+ i 1)))
- ((= i *fragment-max-size*))
- (fill! (fragments i) #f))
+ (set! fragmax (min fragmax (- *fragment-max-size* 1)))
+ (do ((i fragmin (+ i 1)))
+ ((> i fragmax))
+ (if (> (length (vector-ref fragments i)) 16)
+ (vector-set! fragments i (make-hash-table))
+ (fill! (vector-ref fragments i) #f)))
(set! last-simplify-boolean-line-number -1)
(set! last-simplify-numeric-line-number -1)
@@ -21857,202 +22260,17 @@
(set! pp-left-margin 0)
(set! lint-left-margin -3) ; lint-file above adds 4
(set! big-constants (make-hash-table))
+ (set! fragmin *fragment-max-size*)
+ (set! fragmax 0)
(set! *report-input* report-input)
(set! *report-nested-if* (if (integer? *report-nested-if*) (max 3 *report-nested-if*) 4))
(set! *report-short-branch* (if (integer? *report-short-branch*) (max 0 *report-short-branch*) 12))
-
- (set! *#readers*
- (list (cons #\e (lambda (str)
- (unless (string=? str "e")
- (let ((num (string->number (substring str 1))))
- (cond ((not num))
- ((rational? num)
- (format outport "~NCthis #e is dumb, #~A -> ~A~%" lint-left-margin #\space str (substring str 1)))
- ((not (real? num))
- (format outport "~NC#e can't handle complex numbers, #~A -> ~A~%" lint-left-margin #\space str num))
- ((= num (floor num))
- (format outport "~NCperhaps #~A -> ~A~%" lint-left-margin #\space str (floor num))))))
- #f))
- (cons #\i (lambda (str)
- (unless (string=? str "i")
- (let ((num (string->number (substring str 1))))
- (when num
- (format outport
- (if (not (rational? num))
- (values "~NCthis #i is dumb, #~A -> ~A~%" lint-left-margin #\space str (substring str 1))
- (values "~NCperhaps #~A -> ~A~%" lint-left-margin #\space str (* 1.0 num)))))))
- #f))
- (cons #\d (lambda (str)
- (if (and (not (string=? str "d"))
- (string->number (substring str 1)))
- (format outport "~NC#d is pointless, #~A -> ~A~%" lint-left-margin #\space str (substring str 1)))
- #f))
-
- (cons #\' (lambda (str) ; for Guile (and syntax-rules, I think)
- (list 'syntax (if (string=? str "'") (read) (string->symbol (substring str 1))))))
-
- (cons #\` (lambda (str) ; for Guile (sigh)
- (list 'quasisyntax (if (string=? str "`") (read) (string->symbol (substring str 1))))))
-
- (cons #\, (lambda (str) ; the same, the last is #,@ -> unsyntax-splicing -- right.
- (list 'unsyntax (if (string=? str ",") (read) (string->symbol (substring str 1))))))
-
- (cons #\& (lambda (str) ; ancient Guile code
- (string->keyword (substring str 1))))
-
- (cons #\\ (lambda (str)
- (cond ((assoc str '(("\\x0" . #\null)
- ("\\x7" . #\alarm)
- ("\\x8" . #\backspace)
- ("\\x9" . #\tab)
- ("\\xd" . #\return)
- ("\\xa" . #\newline)
- ("\\1b" . #\escape)
- ("\\x20" . #\space)
- ("\\x7f" . #\delete)))
- => (lambda (c)
- (format outport "~NC#\\~A is ~W~%" lint-left-margin #\space (substring str 1) (cdr c)))))
- #f))
-
- (cons #\! (lambda (str)
- (if (member str '("!optional" "!default" "!rest" "!key" "!aux" "!false" "!true" "!r6rs") string-ci=?) ; for MIT-scheme
- (string->keyword (substring str 1))
- (if (string=? str "!eof") ; Bigloo? or Chicken? Guile writes it as #<eof> but can't read it
- (begin
- (format outport "~NC#!eof is probably #<eof> in s7~%" lint-left-margin #\space)
- #<eof>)
- (let ((lc (str 0))) ; s7 should handle this, but...
- (do ((c (read-char) (read-char)))
- ((or (and (eof-object? c)
- (or (format outport "~NCunclosed block comment~%" lint-left-margin #\space)
- #t))
- (and (char=? lc #\!)
- (char=? c #\#)))
- #f)
- (set! lc c)))))))))
-
- ;; try to get past all the # and \ stuff in other Schemes
- ;; main remaining problem: [] used as parentheses (Gauche and Chicken for example)
- (set! (hook-functions *read-error-hook*)
- (list (lambda (h)
- (let ((data (h 'data))
- (line (port-line-number)))
- (if (not (h 'type))
- (begin
- (format outport "~NCreader[~A]: unknown \\ usage: \\~C~%" lint-left-margin #\space line data)
- (set! (h 'result) data))
- (begin
- (format outport "~NCreader[~A]: unknown # object: #~A~%" lint-left-margin #\space line data)
- (set! (h 'result)
- (catch #t
- (lambda ()
- (case (data 0)
- ((#\;) (read) (values))
-
- ((#\T)
- (and (string=? data "T")
- (format outport "#T should be #t~%")
- #t))
-
- ((#\F)
- (and (string=? data "F")
- (format outport "#F should be #f~%")
- ''#f))
-
- ((#\X #\B #\O #\D)
- (let ((num (string->number (substring data 1) (case (data 0) ((#\X) 16) ((#\O) 8) ((#\B) 2) ((#\D) 10)))))
- (if (number? num)
- (begin
- (format outport "~NCuse #~A~A not #~A~%"
- lint-left-margin #\space
- (char-downcase (data 0)) (substring data 1) data)
- num)
- (string->symbol data))))
-
- ((#\l #\z)
- (let ((num (string->number (substring data 1)))) ; Bigloo (also has #ex #lx #z and on and on)
- (if (number? num)
- (begin
- (format outport "~NCjust omit this silly #~C!~%" lint-left-margin #\space (data 0))
- num)
- (string->symbol data))))
-
- ((#\u) ; for Bigloo
- (if (string=? data "unspecified")
- (format outport "~NCuse #<unspecified>, not #unspecified~%" lint-left-margin #\space))
- ;; #<unspecified> seems to hit the no-values check?
- (string->symbol data))
- ;; Bigloo also seems to use #" for here-doc concatenation??
-
- ((#\v) ; r6rs byte-vectors?
- (if (string=? data "vu8")
- (format outport "~NCuse #u8 in s7, not #vu8~%" lint-left-margin #\space))
- (string->symbol data))
-
- ((#\>) ; for Chicken, apparently #>...<# encloses in-place C code
- (do ((last #\#)
- (c (read-char) (read-char)))
- ((and (char=? last #\<)
- (char=? c #\#))
- (values))
- (if (char=? c #\newline)
- (set! (port-line-number ()) (+ (port-line-number) 1)))
- (set! last c)))
-
- ((#\<) ; Chicken also, #<<EOF -> EOF
- (if (string=? data "<undef>") ; #<undef> chibi et al
- #<undefined>
- (if (and (char=? (data 1) #\<)
- (> (length data) 2))
- (do ((end (substring data 2))
- (c (read-line) (read-line)))
- ((string-position end c)
- (values)))
- (string->symbol data))))
-
- ((#\\)
- (cond ((assoc data '(("\\newline" . #\newline)
- ("\\return" . #\return)
- ("\\space" . #\space)
- ("\\tab" . #\tab)
- ("\\null" . #\null)
- ("\\nul" . #\null)
- ("\\linefeed" . #\linefeed)
- ("\\alarm" . #\alarm)
- ("\\esc" . #\escape)
- ("\\escape" . #\escape)
- ("\\rubout" . #\delete)
- ("\\delete" . #\delete)
- ("\\backspace" . #\backspace)
- ("\\page" . #\xc)
- ("\\altmode" . #\escape)
- ("\\bel" . #\alarm) ; #\x07
- ("\\sub" . #\x1a)
- ("\\soh" . #\x01)
-
- ;; these are for Guile
- ("\\vt" . #\xb)
- ("\\bs" . #\backspace)
- ("\\cr" . #\newline)
- ("\\sp" . #\space)
- ("\\lf" . #\linefeed)
- ("\\nl" . #\null)
- ("\\ht" . #\tab)
- ("\\ff" . #\xc)
- ("\\np" . #\xc))
- string-ci=?)
- => (lambda (c)
- (format outport "~NCperhaps use ~W instead~%" (+ lint-left-margin 4) #\space (cdr c))
- (cdr c)))
- (else
- (string->symbol (substring data 1)))))
- (else
- (string->symbol data))))
- (lambda args #f)))))))))
+ (set! *#readers* readers)
+ (set! (hook-functions *read-error-hook*) read-hooks)
;; preset list-tail and list-ref
- (hash-table-set! (fragments 10) '((if (zero? _2_) _1_ (_F_ (cdr _1_) (- _2_ 1))))
+ (hash-table-set! (vector-ref fragments 10) '((if (zero? _2_) _1_ (_F_ (cdr _1_) (- _2_ 1))))
(vector 0 ()
(list (cons 'list-tail
(inlet :initial-value '(define (list-tail x k) (if (zero? k) x (list-tail (cdr x) (- k 1))))
@@ -22061,7 +22279,7 @@
'(define (list-tail x k) (if (zero? k) x (list-tail (cdr x) (- k 1))))
#f))
- (hash-table-set! (fragments 12) '((if (= _2_ 0) (car _1_) (_F_ (cdr _1_) (- _2_ 1))))
+ (hash-table-set! (vector-ref fragments 12) '((if (= _2_ 0) (car _1_) (_F_ (cdr _1_) (- _2_ 1))))
(vector 0 ()
(list (cons 'list-ref (inlet :initial-value '(define (list-ref items n) (if (= n 0) (car items) (list-ref (cdr items) (- n 1))))
:arglist '(items n)
@@ -22280,10 +22498,7 @@
#f))
|#
-;;; tons of rewrites in lg* (3000 lines)
-;;; expand-in-place simple functions and simplify
-;;; (define x (let () ...defines... (lambda (...) (let...)))) suggests moving defines into the interior let (pvoc.scm)
+;;; 62 31733 883913
;;;
-;;; count opt-style patterns throughout and seqs thereof
-;;;
-;;; 201 29437 826503
+;;; combine do|case|cond: currently combine-successive-ifs for if|when|unless 12874 (see t605 for examples)
+
diff --git a/marks.scm b/marks.scm
index a9eb378..1593c68 100644
--- a/marks.scm
+++ b/marks.scm
@@ -298,24 +298,24 @@
(define snap-mark-to-beat
(let ((documentation "(snap-mark-to-beat) ensures that when a mark is dragged, its released position is always on a beat"))
(lambda ()
- (let ((mark-release 4))
- (hook-push mark-hook
- (lambda (hook)
- (let ((mrk (hook 'id))
- (snd (hook 'snd))
- (chn (hook 'chn))
- (reason (hook 'reason)))
- (if (= reason mark-release)
- (let* ((samp (mark-sample mrk))
- (bps (/ (beats-per-minute snd chn) 60.0))
- (sr (srate snd))
- (beat (floor (/ (* samp bps) sr))))
- (let ((lower (floor (/ (* beat sr) bps)))
- (higher (floor (/ (* (+ 1 beat) sr) bps))))
- (set! (mark-sample mrk)
- (if (< (- samp lower) (- higher samp))
- lower
- higher))))))))))))
+ (hook-push mark-hook
+ (lambda (hook)
+ (let ((mrk (hook 'id))
+ (snd (hook 'snd))
+ (chn (hook 'chn))
+ (reason (hook 'reason))
+ (mark-release 4))
+ (if (= reason mark-release)
+ (let* ((samp (mark-sample mrk))
+ (bps (/ (beats-per-minute snd chn) 60.0))
+ (sr (srate snd))
+ (beat (floor (/ (* samp bps) sr))))
+ (let ((lower (floor (/ (* beat sr) bps)))
+ (higher (floor (/ (* (+ 1 beat) sr) bps))))
+ (set! (mark-sample mrk)
+ (if (< (- samp lower) (- higher samp))
+ lower
+ higher)))))))))))
;;; -------- mark-explode
;;;
diff --git a/misc.scm b/misc.scm
index e80d429..4bf9a73 100644
--- a/misc.scm
+++ b/misc.scm
@@ -16,36 +16,31 @@
;(define wd (make-pixmap (cadr (main-widgets)) rough)) ; this comes from new-backgrounds.scm
;(for-each-child (cadr (main-widgets)) (lambda (w) (XtSetValues w (list XmNbackgroundPixmap wd))))
-(define wd (make-pixmap (cadr (main-widgets)) rough))
-
-;(define (paint-all widget)
-; (for-each-child
-; widget
-; (lambda (w)
-; (XtSetValues w (list XmNbackgroundPixmap wd)))))
-
-(define (paint-all widget)
- (for-each-child
- widget
- (lambda (w)
- (if (and (Widget? w)
- (or (not (XmIsPushButton w))
- (member (XtName w) '("revscl-label" "contrast-label" "expand-label" "srate-label" "amp-label") string=?)))
- (XtSetValues w (list XmNbackgroundPixmap wd))))))
-
-(paint-all (cadr (main-widgets)))
-(for-each
- (lambda (w)
- (if (and w
- (Widget? w))
- (paint-all w)))
- (dialog-widgets))
-
-(define (hook-paint-all hook)
- (paint-all (hook 'widget)))
-
-(if (not (hook-member hook-paint-all new-widget-hook))
- (hook-push new-widget-hook hook-paint-all))
+
+(let ((paint-all
+ (let ((wd (make-pixmap (cadr (main-widgets)) rough)))
+ (lambda (widget)
+ (for-each-child
+ widget
+ (lambda (w)
+ (if (and (Widget? w)
+ (or (not (XmIsPushButton w))
+ (member (XtName w) '("revscl-label" "contrast-label" "expand-label" "srate-label" "amp-label") string=?)))
+ (XtSetValues w (list XmNbackgroundPixmap wd)))))))))
+
+ (define (hook-paint-all hook)
+ (paint-all (hook 'widget)))
+
+ (paint-all (cadr (main-widgets)))
+ (for-each
+ (lambda (w)
+ (if (and w
+ (Widget? w))
+ (paint-all w)))
+ (dialog-widgets))
+
+ (if (not (hook-member hook-paint-all new-widget-hook))
+ (hook-push new-widget-hook hook-paint-all)))
(set! *mix-waveform-height* 32)
@@ -176,17 +171,17 @@
;;; additions to Edit menu
;;;
-(define selctr 0)
-
;;; -------- cut selection -> new file
-(define (cut-selection->new)
- (if (selection?)
- (let ((new-file-name (format #f "sel-~D.snd" selctr)))
- (set! selctr (+ selctr 1))
- (save-selection new-file-name)
- (delete-selection)
- (open-sound new-file-name))))
+(define cut-selection->new
+ (let ((selctr 0))
+ (lambda ()
+ (if (selection?)
+ (let ((new-file-name (format #f "sel-~D.snd" selctr)))
+ (set! selctr (+ selctr 1))
+ (save-selection new-file-name)
+ (delete-selection)
+ (open-sound new-file-name))))))
;;; (add-to-menu 1 "Cut Selection -> New" cut-selection->new)
diff --git a/new-backgrounds.scm b/new-backgrounds.scm
index c760f50..5a60f21 100644
--- a/new-backgrounds.scm
+++ b/new-backgrounds.scm
@@ -907,9 +907,8 @@
" c None"
". c #0D5483")
(do ((i 0 (+ i 1))
- (lst ()))
- ((= i 64) lst)
- (set! lst (cons (make-string 64 #\.) lst)))))
+ (lst () (cons (make-string 64 #\.) lst)))
+ ((= i 64) lst))))
(define smoke (list
"244 244 63 1"
diff --git a/new-effects.scm b/new-effects.scm
index 55faf41..fdfcc85 100644
--- a/new-effects.scm
+++ b/new-effects.scm
@@ -525,7 +525,7 @@
(map-chan-over-target-with-sync
(lambda (input-samps)
(let ((flt (make-fir-filter :order 4
- :xcoeffs (float-vector .125 .25 .25 .125)))
+ :xcoeffs #r(.125 .25 .25 .125)))
(del (make-delay (round (* flecho-delay (srate)))))
(genv (make-env (list 0.0 1.0 input-samps 1.0 (+ input-samps 1) 0.0 (+ input-samps 100) 0.0)
:length (+ input-samps 100))))
@@ -690,26 +690,14 @@ the delay time in seconds, the modulation frequency, and the echo amplitude."))
;;; FILTERS
;;;
- (define effects-comb-filter
- (let ((documentation "(effects-comb-filter scaler-1 size beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
- (lambda* (scaler size beg dur snd chn)
- (let ((delay-line (make-float-vector size))
- (delay-loc 0))
- (lambda (x)
- (let ((result (delay-line delay-loc)))
- (set! (delay-line delay-loc) (+ x (* scaler result)))
- (set! delay-loc (+ 1 delay-loc))
- (if (= delay-loc size) (set! delay-loc 0))
- result))))))
-
- (let* ((filter-menu-list ())
- (filter-menu (XmCreatePulldownMenu (main-menu effects-menu) "Filter Effects"
- (list XmNbackground *basic-color*)))
- (filter-cascade (XtCreateManagedWidget "Filter Effects" xmCascadeButtonWidgetClass (main-menu effects-menu)
- (list XmNsubMenuId filter-menu
- XmNbackground *basic-color*))))
-
- (XtAddCallback filter-cascade XmNcascadingCallback (lambda (w c i) (update-label filter-menu-list)))
+ (let ((filter-menu-list ())
+ (filter-menu (XmCreatePulldownMenu (main-menu effects-menu) "Filter Effects"
+ (list XmNbackground *basic-color*))))
+
+ (let ((filter-cascade (XtCreateManagedWidget "Filter Effects" xmCascadeButtonWidgetClass (main-menu effects-menu)
+ (list XmNsubMenuId filter-menu
+ XmNbackground *basic-color*))))
+ (XtAddCallback filter-cascade XmNcascadingCallback (lambda (w c i) (update-label filter-menu-list))))
;;; -------- Butterworth band-pass filter
@@ -1011,7 +999,14 @@ the delay time in seconds, the modulation frequency, and the echo amplitude."))
(lambda (w context info)
(map-chan-over-target-with-sync
(lambda (ignored)
- (effects-comb-filter comb-scaler comb-size))
+ (let ((delay-line (make-float-vector comb-size))
+ (delay-loc 0))
+ (lambda (x)
+ (let ((result (delay-line delay-loc)))
+ (set! (delay-line delay-loc) (+ x (* comb-scaler result)))
+ (set! delay-loc (+ 1 delay-loc))
+ (if (= delay-loc comb-size) (set! delay-loc 0))
+ result))))
comb-target
(lambda (target samps)
(format #f "effects-comb-filter ~A ~A" comb-scaler comb-size))
@@ -1168,25 +1163,22 @@ the delay time in seconds, the modulation frequency, and the echo amplitude."))
;;; -------- Moog filter
;;;
-
(let ((moog-cutoff-frequency 10000)
(moog-resonance 0.5))
(let* ((post-moog-dialog
- (let ((moog-label "Moog filter")
- (moog-dialog #f)
- (moog-target 'sound))
-
- (define (moog freq Q)
- (let ((gen (make-moog-filter freq Q)))
- (lambda (inval)
- (moog-filter gen inval))))
-
+ (let ((moog-dialog #f)
+ (moog-target 'sound)
+ (moog (lambda (freq Q)
+ (let ((gen (make-moog-filter freq Q)))
+ (lambda (inval)
+ (moog-filter gen inval))))))
(lambda ()
(unless (Widget? moog-dialog)
;; if moog-dialog doesn't exist, create it
(let ((initial-moog-cutoff-frequency 10000)
(initial-moog-resonance 0.5)
- (sliders ()))
+ (sliders ())
+ (moog-label "Moog filter"))
(set! moog-dialog
(make-effect-dialog
moog-label
@@ -1429,11 +1421,11 @@ Move the sliders to set the filter cutoff frequency and resonance."))
(src-timevar-dialog #f)
(src-timevar-target 'sound)
(src-timevar-envelope #f))
+ (define (scale-envelope e scl)
+ (if (null? e)
+ ()
+ (cons (car e) (cons (* scl (cadr e)) (scale-envelope (cddr e) scl)))))
(lambda ()
- (define (scale-envelope e scl)
- (if (null? e)
- ()
- (cons (car e) (cons (* scl (cadr e)) (scale-envelope (cddr e) scl)))))
(if (Widget? src-timevar-dialog)
(activate-dialog src-timevar-dialog)
@@ -1533,18 +1525,17 @@ Move the sliders to set the filter cutoff frequency and resonance."))
(am-effect-envelope #f)
(am-effect-target 'sound)
(am-effect-dialog #f))
- (lambda ()
- (define am-effect
- (lambda (freq)
- (let ((os (make-oscil freq))
- (e (and (not (equal? (xe-envelope am-effect-envelope) '(0.0 1.0 1.0 1.0)))
- (make-env (xe-envelope am-effect-envelope) :length (effect-framples am-effect-target)))))
- (if (env? e)
- (lambda (inval)
- (amplitude-modulate 1.0 inval (* (env e) (oscil os))))
- (lambda (inval)
- (amplitude-modulate 1.0 inval (oscil os)))))))
-
+ (define am-effect
+ (lambda (freq)
+ (let ((os (make-oscil freq))
+ (e (and (not (equal? (xe-envelope am-effect-envelope) '(0.0 1.0 1.0 1.0)))
+ (make-env (xe-envelope am-effect-envelope) :length (effect-framples am-effect-target)))))
+ (if (env? e)
+ (lambda (inval)
+ (amplitude-modulate 1.0 inval (* (env e) (oscil os))))
+ (lambda (inval)
+ (amplitude-modulate 1.0 inval (oscil os)))))))
+ (lambda ()
(if (Widget? am-effect-dialog)
(activate-dialog am-effect-dialog)
;; if am-effect-dialog doesn't exist, create it
@@ -1626,18 +1617,17 @@ Move the sliders to set the filter cutoff frequency and resonance."))
(rm-target 'sound)
(rm-envelope #f)
(rm-dialog #f))
- (lambda ()
- (define rm-effect ; avoid collision with examp.scm
- (lambda (freq gliss-env)
- (let ((os (make-oscil freq))
- (e (and (not (equal? (xe-envelope rm-envelope) '(0.0 1.0 1.0 1.0)))
- (make-env (xe-envelope rm-envelope) :length (effect-framples rm-target)))))
- (if (env? e)
- (lambda (inval)
- (* inval (env e) (oscil os)))
- (lambda (inval)
- (* inval (oscil os)))))))
-
+ (define rm-effect ; avoid collision with examp.scm
+ (lambda (freq gliss-env)
+ (let ((os (make-oscil freq))
+ (e (and (not (equal? (xe-envelope rm-envelope) '(0.0 1.0 1.0 1.0)))
+ (make-env (xe-envelope rm-envelope) :length (effect-framples rm-target)))))
+ (if (env? e)
+ (lambda (inval)
+ (* inval (env e) (oscil os)))
+ (lambda (inval)
+ (* inval (oscil os)))))))
+ (lambda ()
(if (Widget? rm-dialog)
(activate-dialog rm-dialog)
;; if rm-dialog doesn't exist, create it
@@ -2875,4 +2865,4 @@ the synthesis amplitude, the FFT size, and the radius value."))
(add-to-menu effects-menu "Null phase" zero-phase)
- )
\ No newline at end of file
+ )
diff --git a/nrev.scm b/nrev.scm
index a68b6cc..21df485 100644
--- a/nrev.scm
+++ b/nrev.scm
@@ -13,9 +13,9 @@
;; output-scale can be used to boost the reverb output
(let ((dly-len (if (= (floor *clm-srate*) 44100)
- #(2467 2753 3217 3533 3877 4127 599 197 67 101 97 73 67 53 37)
+ #i(2467 2753 3217 3533 3877 4127 599 197 67 101 97 73 67 53 37)
(and (= (floor *clm-srate*) 22050)
- #(1237 1381 1607 1777 1949 2063 307 97 31 53 47 37 31 29 17))))
+ #i(1237 1381 1607 1777 1949 2063 307 97 31 53 47 37 31 29 17))))
(chan2 (> (channels *output*) 1))
(chan4 (= (channels *output*) 4)))
@@ -32,7 +32,7 @@
(> i lim)))))
val)))))
- (set! dly-len #(1433 1601 1867 2053 2251 2399 347 113 37 59 53 43 37 29 19))
+ (set! dly-len #i(1433 1601 1867 2053 2251 2399 347 113 37 59 53 43 37 29 19))
(do ((i 0 (+ i 1)))
((= i 15))
(let ((val (floor (* srscale (dly-len i)))))
@@ -63,13 +63,34 @@
(vector allpass5 allpass6 allpass7 allpass8))))
(combs (make-comb-bank (vector comb1 comb2 comb3 comb4 comb5 comb6)))
(allpasses (make-all-pass-bank (vector allpass1 allpass2 allpass3))))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (out-bank filts i
- (all-pass allpass4
- (one-pole low
- (all-pass-bank allpasses
- (comb-bank combs (* volume (ina i *reverb*))))))))))))
-
+
+ (if chan4
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (out-bank filts i
+ (all-pass allpass4
+ (one-pole low
+ (all-pass-bank allpasses
+ (comb-bank combs (* volume (ina i *reverb*))))))))
+ (if chan2
+ (let ((gen1 (filts 0))
+ (gen2 (filts 1)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let ((val (all-pass allpass4
+ (one-pole low
+ (all-pass-bank allpasses
+ (comb-bank combs (* volume (ina i *reverb*))))))))
+ (outa i (all-pass gen1 val))
+ (outb i (all-pass gen2 val)))))
+
+ (let ((gen (filts 0)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (outa i (all-pass gen
+ (all-pass allpass4
+ (one-pole low
+ (all-pass-bank allpasses
+ (comb-bank combs (* volume (ina i *reverb*))))))))))))))))
;;; (with-sound (:reverb nrev) (outa 0 .1) (outa 0 .5 *reverb*))
diff --git a/old-number-tests.scm b/old-number-tests.scm
new file mode 100644
index 0000000..3a21836
--- /dev/null
+++ b/old-number-tests.scm
@@ -0,0 +1,683 @@
+;;; various #i #e #d and funny exponent tests
+;;; these no longer work in s7
+
+(format *stderr* "old-numbers...~%")
+
+(test (eqv? #i3/5 #i3/5) #t)
+(test (eqv? #e0.6 #e0.6) #t)
+
+(test (case 1.0 ((#i1) 2) ((1e0) 3) ((1.0) 4) (else 5)) 2)
+(test (case 1 ((#i1) 2) ((1e0) 3) ((1.0) 4) (else 5)) 5)
+
+;(num-test (string->number "#e#t11.3") 53/4)
+;(num-test (string->number "#t#e1.5") 17/12)
+;(num-test (string->number "#i#t1a") 22.0)
+;(num-test (string->number "#t#i1a") 22.0) ; ??? this is analogous to #x#i1a = 26.0
+
+(when with-bignums
+ (num-test (max 12345678901234567890 12345678901234567891) 12345678901234567891)
+ (num-test (max 9223372036854776/9223372036854775807 #i9223372036854775/9223372036854775000) 1.000000000000000020925101928970235578612E-3)
+ (num-test (max #i9223372036854776/9223372036854775807 9223372036854775/9223372036854775000) 1.000000000000000020925101928970235578612E-3)
+ (num-test (max #i92233720368547757/9223372036854775807 92233720368547758/9223372036854775807) 9.999999999999999992410584792601468961145E-3)
+ (num-test (max 92233720368547757/9223372036854775807 #i92233720368547758/9223372036854775807) 9.999999999999999992410584792601468961145E-3)
+
+ ;; in these cases, the non-gmp s7 can't win:
+ ;; :(max 9223372036854776/9223372036854775807 #i9223372036854775/9223372036854775000)
+ ;; 9223372036854776/9223372036854775807
+ ;; :(max #i9223372036854776/9223372036854775807 9223372036854775/9223372036854775000)
+ ;; 0.001
+ ;; :(max #i92233720368547757/9223372036854775807 92233720368547758/9223372036854775807)
+ ;; 0.01
+ ;; :(max 92233720368547757/9223372036854775807 #i92233720368547758/9223372036854775807)
+ ;; 92233720368547757/9223372036854775807
+ )
+
+(test (= #i3/5 #i3/5) #t)
+
+(test (string->number "#i") #f)
+(test (string->number "#e") #f)
+(num-test (string->number "#i1 at 01" 16) 16.0)
+(num-test (string->number "#d.0 at -11" 10) 0.0)
+(num-test (string->number "#i+1 at 002" 10) 100.0)
+(test (= #i3/5 (string->number "#i3/5")) #t)
+
+(when with-bignums
+ (test (number? (string->number "#e1.0e564")) #t)
+ (test (number? (string->number "#e1.0e307")) #t)
+ (test (number? (string->number "#e1.0e310")) #t)
+ (num-test (string->number "#e1624540914719833702142058941") 1624540914719833702142058941)
+ (num-test (string->number "#i1624540914719833702142058941") 1.624540914719833702142058941E27)
+ (num-test (string->number "#e8978167593632120808315265/5504938256213345873657899") 8978167593632120808315265/5504938256213345873657899)
+ (num-test (string->number "#i8978167593632120808315265/5504938256213345873657899") 1.630929753571457437099527114342760854299E0)
+ (num-test (string->number "#i119601499942330812329233874099/12967220607") 9.223372036854775808414213562473095048798E18)
+ ;; this next test needs more bits to compare with other schemes -- this is the result if 128 bits
+ (num-test (string->number "#e005925563891587147521650777143.74135805596e05") 826023606487248364518118333837545313/1394)
+ (num-test (string->number "#e-1559696614.857e28") -15596966148570000000000000000000000000)
+ (test (integer? (string->number "#e1e310")) #t)
+ (test (number? (string->number "#e1.0e310")) #t))
+;; in the non-gmp case #e1e321 is a read error -- should s7 return NaN silently?
+
+(when (not with-bignums)
+ (test (string->number "#e1e307") #f)
+ (test (eval-string "(number? #e1.0e564)") 'error)
+ (test (string->number "#e005925563891587147521650777143.74135805596e05") #f)
+ (test (string->number "#e78.5e65") #f)
+ (test (string->number "#e1e543") #f)
+ (test (string->number "#e120d21") #f)
+ (test (string->number "#e-2.2e021") #f)
+ (if (provided? '@-exponent)
+ (test (infinite? (string->number "9221. at 9129" 10)) #t))
+ (test (string->number "#e120 at 21" 12) #f)
+ (test (string->number "#d#e120 at 21") #f)
+ (test (string->number "#b#e120 at 21") #f)
+ (test (string->number "#e#b120 at 21") #f)
+ (test (string->number "#e#d120 at 21") #f)
+ (test (nan? (string->number "0f0/00" 16)) #t)
+ (test (string->number "#e-1559696614.857e28") #f)
+ (test (string->number "#e1+1i") #f)
+ (test (= 0 00 -000 #e-0 0/1 #e#x0 #b0000 #e#d0.0 -0 +0) #t))
+
+(num-test #i1.0e8 100000000.0)
+
+(test (string->number "#b#i0/0") #f)
+(test (string->number "#b#e0/0") #f)
+(test (string->number "#b#e1/0+i") #f) ; inf+i?
+(test (string->number "#e#b0/0") #f)
+(test (string->number "#i#b0/0") #f)
+(test (string->number "#e0/0") #f)
+(test (number? (string->number "#i0/0")) #t) ; nan since (number? 0/0) is #t
+(test (string->number "#e#b1/0") #f)
+(test (string->number "#i#b1/0") #f)
+(test (string->number "#e1/0") #f)
+(test (number? (string->number "#i1/0")) #t)
+(test (string->number "#e#b1/0+i") #f)
+(test (string->number "#i#b1/0+i") #f) ; inf+i?
+(test (string->number "#e1/0+i") #f)
+(test (number? (string->number "#i1/0+i")) #t)
+(test (number? (string->number "#i0/0+i")) #t)
+(test (nan? #i0/0) #t) ; but #i#d0/0 is a read error?
+
+(num-test (string->number "#b#e11e30") 3221225472) ; very confusing!
+(num-test (string->number "#b#i11e30") 3221225472.0)
+(num-test (string->number "#e#b11e30") 3221225472)
+(num-test (string->number "#i#b11e30") 3221225472.0)
+(num-test (string->number "#b#e+1e+1+0e+10i") 2)
+(num-test (string->number "#e+.0e-00-0i") 0)
+(num-test (string->number "#e-0/1110010") 0)
+(num-test (string->number "#x#e00110e") 4366)
+(num-test (string->number "#e#x-e/001") -14)
+(num-test (string->number "#e.001e-11") 0)
+(num-test (string->number "#x#e00/00e") 0)
+(num-test (string->number "#e#x+1e.01e10100") 65366158/2178339)
+(num-test (string->number "#i#x0e10-000i") 3600.0)
+(num-test (string->number "#x0/e010-e/1i") 0-14i)
+(num-test (string->number "#i-1/1-1.0e1i") -1-10i)
+(num-test (string->number "#e#x001ee11e1") 32379361)
+(num-test (string->number "#e#x010e10.e1") 17699041/256)
+(num-test #b#i.110e-1 0.375)
+(num-test #e01.1e1+00.i 11)
+
+(when (provided? 'dfls-exponents)
+ (num-test (string->number "#d.0d1+i") 0+1i)
+ (num-test (string->number "+.0d-1+i") 0+1i)
+ (num-test (string->number "#d1d+0-1d-1i") 1-0.1i)
+ (num-test (string->number "#i+1+0.d-0i") 1.0)
+ (num-test (string->number "#o#i-101d+0") -65.0)
+ (num-test (string->number "+001.110d+1") 11.1)
+ (num-test (string->number "#e01+0d000i") 1)
+ (num-test (string->number "#d1d0-0.d0i") 1.0)
+ (num-test (string->number "#d#i001d+00") 1.0)
+ (num-test (string->number "#o0010111/1") 4169)
+ (num-test (string->number "0d00-0.d+0i") 0.0)
+ (num-test (string->number "#o1.d0+10.d00i") 1+8i)
+ (num-test (string->number "0d+01+1e+1i") 0+10i)
+ (num-test (string->number "10.d-005" 2) 0.0625)
+ (num-test (string->number "+7f2-73i" 8) 448-59i))
+
+(num-test (string->number "#i#d1e1+.0i") 10.0)
+(num-test (string->number "#i#d+1e+1+1e+1i") 10+10i)
+(test (string->number "#e+1e+1+1e+1i") #f)
+;; these depend on rationalize's default error I think
+;; and they cause valgrind to hang!!
+;;(num-test (string->number "#e.1e-11") 0)
+;;(num-test (string->number "#e1e-12") 0)
+(num-test (string->number "#e1e-11") 1/90909090910)
+(test (string->number "#e#f1") #f)
+
+(when with-bignums
+ (test (= (string->number "#e1e19") (string->number "#e.1e20")) #t)
+ (test (= (string->number "#e1e19") (* 10 (string->number "#e1e18"))) #t)
+ (test (= (string->number "#e1e20") (* 100 (string->number "#e1e18"))) #t)
+ (num-test (string->number "#b#e-11e+111") -7788445287802241442795744493830144)
+ (num-test (string->number "#i#b-11e+111") -7.788445287802241442795744493830144E33)
+ (num-test (string->number "#b#i-11e+111") -7.788445287802241442795744493830144E33)
+ (num-test (string->number "#i3e+111") 3.0e111)
+ (num-test (string->number "#e3e30") 3000000000000000000000000000000)
+ (num-test (string->number "#i3e30") 3.000E30)
+ (num-test (string->number "#b#e11e80") 3626777458843887524118528)
+ (num-test (string->number "#b#i11e80") 3626777458843887524118528.0)
+ (num-test (string->number "#e#b11e80") 3626777458843887524118528)
+ (num-test (string->number "#i#b11e80") 3626777458843887524118528.0))
+
+(test (= #i1e19 #i.1e20) #t)
+(num-test #b#e-.1 -1/2)
+(num-test #o#e-.1 -1/8)
+(num-test #d#e-.1 -1/10)
+(num-test #x#e-.1 -1/16)
+(num-test #b#e1.1e2 6)
+(num-test #o#e1.1e2 72)
+(num-test #d#e1.1e2 110)
+(num-test #b#i-1.1e-2 -0.375)
+(num-test #o#i-1.1e-2 -0.017578125)
+(num-test #d#i-1.1e-2 -0.011)
+(num-test #e#b1e-10 1/1024)
+(num-test #e#b+1.1 3/2)
+(num-test #e#o+1.1 9/8)
+(num-test #e#d+1.1 11/10)
+(num-test #e#x+1.1 17/16)
+(num-test #e#b+1.1e+2 6)
+(num-test #e#o+1.1e+2 72)
+(num-test #e#d+1.1e+2 110)
+(num-test #i#b.001 0.125)
+(num-test #i#b000000000011 3.0)
+(num-test #i#b-000000000011e1 -6.0)
+(num-test #i#b-000000000011e+11 -6144.0)
+;;(num-test #b#e0+i 0+1i) ; these 2 are now read-errors (#e0+i is an error because inexact->exact does not accept complex args in s7)
+;;(num-test #b#e0+1.1i 0+1.5i)
+(test (string->number "#b#e0+i") #f)
+(num-test #i#xf/c 1.25)
+(num-test #e#x1.4 5/4)
+(num-test #e2/3 2/3)
+(num-test #b#e+.1e+1 1)
+(num-test #b#e.011-0.i 3/8)
+(num-test #b#i1.1e0-.0i 1.5)
+(num-test #b#e1.1e0-.0i 3/2)
+(num-test #b#e-1.00e+001 -2)
+(num-test #b#e+.01011100 23/64)
+(num-test #b#i-00-0/001i 0.0)
+(num-test #e#x1234/12 (string->number "#x#e1234/12"))
+(num-test #x#e.1 #e#x.1)
+
+(num-test #e-.0 0)
+(num-test #e-123.0 -123)
+(num-test #i-123 -123.0)
+(num-test #e+123.0 123)
+(num-test #i+123 123.0)
+(num-test #i-0 0.0)
+(num-test #e-0.0 0)
+;;; in guile #e1e-10 is 7737125245533627/77371252455336267181195264
+
+(num-test #d#i1/10 #i#d1/10)
+
+(num-test #b#i0-0i 0.0)
+(num-test #b#e1e01 2)
+(num-test #b#e1e-0 1)
+(num-test #b#e11e-1 3/2)
+;;(num-test #b#e-0/1+i 0+1i)
+(test (string->number "#b#e-1/1+01.1e1i") #f)
+(test (string->number "#d#i0/0") #f)
+(test (string->number "#i#x0/0") #f)
+(test (exact? #i#b1) #f)
+(test (exact? #e#b1) #t)
+(num-test #x#e1.5 21/16)
+(num-test #x#i3 3.0)
+
+(test (exact? #i1) #f)
+(test (exact? #e1.0) #t)
+(test (exact? #i1.0) #f)
+(test (exact? #e1) #t)
+
+(num-test #x#if 15.0)
+(num-test #i1/1 1.0)
+(test (< (abs (- #i3/2 1.5)) 1e-12) #t)
+(test (< (abs (- #i1 1.0)) 1e-12) #t)
+(test (< (abs (- #i-1/10 -0.1)) 1e-12) #t)
+(test (< (abs (- #i1.5 1.5)) 1e-12) #t)
+
+(when (provided? 'dfls-exponents)
+ (num-test (string->number "#i1s0") 1.0) ; need the s->n to avoid confusing reader in non-dfls case
+ (num-test -0d-0 0.0)
+ (num-test +1d+1 10.0)
+ (num-test +1s00 1.0))
+
+(num-test (string->number "#i-0.e11" 2) 0.0)
+(num-test (string->number "#i+9/9" 10) 1.0)
+(num-test (string->number "#e9e-999" 10) 0)
+(num-test (string->number "#e-9.e-9" 10) -1/111098767)
+(num-test (string->number "#e-.9e+9" 10) -900000000)
+(num-test (string->number "#e-.9e+9" 10) -900000000)
+(num-test #e+32/1-0.i 32)
+(num-test #e+32.-0/1i 32)
+(num-test #e-32/1+.0i -32)
+(num-test #e+2.-0/31i 2)
+(num-test #b#e.01 1/4)
+(num-test #e#b.01 1/4)
+(num-test #b#e10. 2)
+(num-test #e#b10. 2)
+(num-test #b#e0.e11 0)
+(num-test #b#e1.e10 1024)
+(num-test #b#e-0.e+1 0)
+(num-test #b#e+.1e-0 1/2)
+(num-test #b#e+1.e-0 1)
+(num-test #b#e-1.e+0 -1)
+
+(num-test (string->number "#e87" 16) 135)
+(num-test (string->number "#e87" 10) 87)
+(num-test (string->number "#e#x87" 10) 135)
+(num-test (string->number "#e#x87" 16) 135)
+(num-test (string->number "#x#e87" 10) 135)
+(num-test (string->number "#i87" 16) 135.0)
+(num-test (string->number "#i87" 12) 103.0)
+(num-test (string->number "#ee" 16) 14)
+(num-test (string->number "#if" 16) 15.0)
+
+(num-test (string->number "#e10.01" 2) 9/4)
+(num-test (string->number "#e10.01" 6) 217/36)
+(num-test (string->number "#e10.01" 10) 1001/100)
+(num-test (string->number "#e10.01" 14) 2745/196)
+(num-test (string->number "#i10.01" 2) 2.25)
+(num-test (string->number "#i10.01" 6) 6.0277777777778)
+(num-test (string->number "#i10.01" 10) 10.01)
+(num-test (string->number "#i10.01" 14) 14.005102040816)
+(num-test (string->number "#i-.c2e9" 16) -0.76136779785156)
+
+(num-test (string->number "#i\x32\x38\x36") 286.0)
+(let ((string->number-2 (lambda (str radix)
+ (let ((old-str (if (string? str) (string-copy str) str)))
+ (let ((val (string->number str radix)))
+ (if (not (string=? str old-str))
+ (error 'string->number-messed-up)
+ val)))))
+ (string->number-1 (lambda (str)
+ (let ((old-str (if (string? str) (string-copy str) str)))
+ (let ((val (string->number str)))
+ (if (not (string=? str old-str))
+ (error 'string->number-messed-up)
+ val))))))
+ (test (string->number-1 "#i1-1ei") #f)
+ (test (string->number-1 "#i-2e+i") #f)
+ (test (string->number-1 "#i1+i1i") #f)
+ (test (string->number-1 "#i1+1") #f)
+ (test (string->number-1 "#i2i.") #f)
+ (num-test (string->number-1 "#x#e-2e2") -738))
+
+(do ((i 0 (+ i 1)))
+ ((= i 30))
+ (for-each
+ (lambda (lst)
+ (for-each
+ (lambda (str)
+ (let ((val (catch #t (lambda () (string->number str)) (lambda args 'error))))
+ (if (or (not (number? val))
+ (> (abs (- val 1.0)) 1.0e-15))
+ (format-logged #t ";(string->number ~S) = ~A?~%" str val))))
+ lst))
+ (list
+ (list "1")
+
+ (list "01" "+1" "1.")
+
+ (list "001" "+01" "#e1" "#i1" "1/1" "#b1" "#x1" "#d1" "#o1" "1.0" "1e0" "9/9" "01." "+1." "1E0")
+
+ (list "0001" "+001" "#e01" "#i01" "1/01" "#b01" "#x01" "#d01" "#o01" "#e+1" "#i+1" "#b+1" "#x+1" "#d+1" "#o+1" ".1e1" "01/1" "+1/1" "1.00" "1e00" "01.0" "+1.0" "1e+0" "1e-0" "01e0" "+1e0" "1.e0" "9/09" "09/9" "+9/9" "001." "+01." "#e1." "#i1." "1+0i" "1-0i" "#d1.")
+
+ (list "11/11" "00001" "+0001" "#e001" "#i001" "1/001" "#b001" "#x001" "#d001" "#o001" "#e+01" "#i+01" "#b+01" "#x+01" "#d+01" "#o+01" ".1e01" "01/01" "+1/01" "91/91" ".1e+1" "10e-1" "0.1e1" "+.1e1" ".10e1" "#b#e1" "#x#e1" "#d#e1" "#o#e1" "#b#i1" "#x#i1" "#d#i1" "#o#i1" "001/1" "+01/1" "#e1/1" "#i1/1" "#b1/1" "#x1/1" "#d1/1" "#o1/1" "#e#b1" "#i#b1" "#e#x1" "#i#x1" "#e#d1" "#i#d1" "#e#o1" "#i#o1" "10/10" "1.000" "1e000" "01.00" "+1.00" "1e+00" "1e-00" "01e00" "+1e00" "1.e00" "90/90" "001.0" "+01.0" "#e1.0" "#i1.0" "01e+0" "+1e+0" "1.e+0" "01e-0" "+1e-0" "1.e-0" "001e0" "+01e0" "#e1e0" "#i1e0" "1.0e0" "01.e0" "+1.e0" "19/19" "9/009" "09/09" "+9/09" "99/99" "009/9" "+09/9" "#e9/9" "#i9/9" "#x9/9" "#d9/9" "0001." "+001." "#e01." "#i01." "#e+1." "#i+1." "#xe/e" "1+00i" "1-00i" "1+.0i" "1-.0i" "01+0i" "+1+0i" "1.+0i" "01-0i" "+1-0i" "1.-0i" "1+0.i" "1-0.i" "#xb/b" "#xd/d" "#xf/f")
+
+ ;; remove "9":
+
+ (list "11/011" "011/11" "+11/11" "000001" "+00001" "#e0001" "#i0001" "1/0001" "#b0001" "#x0001" "#d0001" "#o0001" "#e+001" "#i+001" "#b+001" "#x+001" "#d+001" "#o+001" ".1e001" "01/001" "+1/001" ".1e+01" "10e-01" "0.1e01" "+.1e01" ".10e01" "#b#e01" "#x#e01" "#d#e01" "#o#e01" "#b#i01" "#x#i01" "#d#i01" "#o#i01" "001/01" "+01/01" "#e1/01" "#i1/01" "#b1/01" "#x1/01" "#d1/01" "#o1/01" "#e#b01" "#i#b01" "#e#x01" "#i#x01" "#e#d01" "#i#d01" "#e#o01" "#i#o01" "0.1e+1" "+.1e+1" ".10e+1" "#b#e+1" "#x#e+1" "#d#e+1" "#o#e+1" "#b#i+1" "#x#i+1" "#d#i+1" "#o#i+1" "#e#b+1" "#i#b+1" "#e#x+1" "#i#x+1" "#e#d+1" "#i#d+1" "#e#o+1" "#i#o+1" "010e-1" "+10e-1" "10.e-1" "00.1e1" "+0.1e1" "#e.1e1" "#i.1e1" "0.10e1" "+.10e1" ".100e1" "0001/1" "+001/1" "#e01/1" "#i01/1" "#b01/1" "#x01/1" "#d01/1" "#o01/1" "#e+1/1" "#i+1/1" "#b+1/1" "#x+1/1" "#d+1/1" "#o+1/1" "10/010" "010/10" "+10/10" "1.0000" "1e0000" "01.000" "+1.000" "1e+000" "1e-000" "01e000" "+1e000" "1.e000" "001.00" "+01.00" "#e1.00" "#i1.00" "01e+00" "+1e+00" "1.e+00" "01e-00" "+1e-00" "1.e-00" "001e00" "+01e00" "#e1e00" "#i1e00" "1.0e00" "01.e00" "+1.e00" "0001.0" "+001.0" "#e01.0" "#i01.0" "#e+1.0" "#i+1.0" "001e+0" "+01e+0" "#e1e+0" "#i1e+0" "1.0e+0" "01.e+0" "+1.e+0" "001e-0" "+01e-0" "#e1e-0" "#i1e-0" "1.0e-0" "01.e-0" "+1.e-0" "0001e0" "+001e0" "#e01e0" "#i01e0" "#e+1e0" "#i+1e0" "1.00e0" "01.0e0" "+1.0e0" "001.e0" "+01.e0" "#e1.e0" "#i1.e0" "00001." "+0001." "#e001." "#i001." "#e+01." "#i+01." "#xe/0e" "#x0e/e" "#x+e/e" "1+0e1i" "1-0e1i" "1+0/1i" "1-0/1i" "1+000i" "1-000i" "1+.00i" "1-.00i" "01+00i" "+1+00i" "1.+00i" "01-00i" "+1-00i" "1.-00i" "1+0.0i" "1-0.0i" "01+.0i" "+1+.0i" "1.+.0i" "01-.0i" "+1-.0i" "1.-.0i" "001+0i" "+01+0i" "#e1+0i" "#i1+0i" "1/1+0i" "1.0+0i" "1e0+0i" "01.+0i" "+1.+0i" "001-0i" "+01-0i" "#e1-0i" "#i1-0i" "1/1-0i" "1.0-0i" "1e0-0i" "01.-0i" "+1.-0i" "1+0e0i" "1-0e0i" "1+00.i" "1-00.i" "01+0.i" "+1+0.i" "1.+0.i" "01-0.i" "+1-0.i" "1.-0.i" "#xb/0b" "#x0b/b" "#x+b/b" "#xd/0d" "#x0d/d" "#x+d/d" "#xf/0f" "#x0f/f" "#x+f/f")
+
+ (list "111/111" "11/0011" "011/011" "+11/011" "0011/11" "+011/11" "#e11/11" "#i11/11" "#b11/11" "#x11/11" "#d11/11" "#o11/11" "101/101" "0000001" "+000001" "#e00001" "#i00001" "1/00001" "#b00001" "#x00001" "#d00001" "#o00001" "#e+0001" "#i+0001" "#b+0001" "#x+0001" "#d+0001" "#o+0001" ".1e0001" "01/0001" "+1/0001" ".1e+001" "10e-001" "0.1e001" "+.1e001" ".10e001" "#b#e001" "#x#e001" "#d#e001" "#o#e001" "#b#i001" "#x#i001" "#d#i001" "#o#i001" "001/001" "+01/001" "#e1/001" "#i1/001" "#b1/001" "#x1/001" "#d1/001" "#o1/001" "#e#b001" "#i#b001" "#e#x001" "#i#x001" "#e#d001" "#i#d001" "#e#o001" "#i#o001" "0.1e+01" "+.1e+01" ".10e+01" "#b#e+01" "#x#e+01" "#d#e+01" "#o#e+01" "#b#i+01" "#x#i+01" "#d#i+01" "#o#i+01" "#e#b+01" "#i#b+01" "#e#x+01" "#i#x+01" "#e#d+01" "#i#d+01" "#e#o+01" "#i#o+01" "010e-01" "+10e-01" "10.e-01" "1.00000" "1e00000" "01.0000" "+1.0000" "1e+0000" "1e-0000" "01e0000" "+1e0000" "1.e0000" "001.000" "+01.000" "#e1.000" "#i1.000" "#d1.000" "01e+000" "+1e+000" "1.e+000" "01e-000" "+1e-000" "1.e-000" "001e000" "+01e000" "#e1e000" "#i1e000" "#d1e000" "1.0e000" "+1.e000" "0001.00" "+001.00" "#e01.00" "#i01.00" "#d01.00" "#e+1.00" "#i+1.00" "#d+1.00" "001e+00" "+01e+00" "#e1e+00" "#i1e+00" "#d1e+00" "1.0e+00" "01.e+00" "+1.e+00" "001e-00" "+01e-00" "#e1e-00" "#i1e-00" "#d1e-00" "1.0e-00" "01.e-00" "+1.e-00" "000001." "+00001." "#e0001." "#i0001." "#d0001." "#e+001." "#i+001." "#d+001." "#d#e01." "#d#i01." "#e#d01." "#i#d01." "#d#e+1." "#d#i+1." "#e#d+1." "#i#d+1." "#x1e/1e" "#xe/00e" "#x0e/0e" "#x+e/0e" "#xee/ee" "#x00e/e" "#x+0e/e" "#x#ee/e" "#x#ie/e" "#e#xe/e" "#i#xe/e" "#xbe/be" "#xde/de" "1+0e11i" "1-0e11i" "1+0/11i" "1-0/11i" "1+0e01i" "1-0e01i" "1+0/01i" "1-0/01i" "1+0e+1i" "1-0e+1i" "1+0e-1i" "1-0e-1i" "1+00e1i" "1-00e1i" "1+.0e1i" "1-.0e1i" "01+0e1i" "+1+0e1i" "1.+0e1i" "01-0e1i" "+1-0e1i" "1.-0e1i" "1+0.e1i" "1-0.e1i" "1+00/1i" "1-00/1i" "01+0/1i" "+1+0/1i" "1.+0/1i" "01-0/1i" "+1-0/1i" "1.-0/1i" "1+0e10i" "1-0e10i" "1+0/10i" "1-0/10i" "1+0000i" "1-0000i" "1+.000i" "1-.000i" "01+000i" "+1+000i" "1.+000i" "01-000i" "+1-000i" "1.-000i" "1+0.00i" "1-0.00i" "01+.00i" "+1+.00i" "1.+.00i" "01-.00i" "+1-.00i" "1.-.00i" "001+00i" "+01+00i" "#e1+00i" "#i1+00i" "1/1+00i" "#b1+00i" "#x1+00i" "#d1+00i" "#o1+00i" "1.0+00i" "1e0+00i" "01.+00i" "+1.+00i" "001-00i" "+01-00i" "#e1-00i" "#i1-00i" "1/1-00i" "#b1-00i" "#x1-00i" "#d1-00i" "#o1-00i" "1.0-00i" "1e0-00i" "01.-00i" "+1.-00i" "1+0e00i" "1-0e00i" "1+00.0i" "1-00.0i" "01+0.0i" "+1+0.0i" "1.+0.0i" "01-0.0i" "+1-0.0i" "1.-0.0i" "001+.0i" "+01+.0i" "#e1+.0i" "#i1+.0i" "1/1+.0i" "#d1+.0i" "1.0+.0i" "1e0+.0i" "01.+.0i" "+1.+.0i" "001-.0i" "+01-.0i" "#e1-.0i" "#i1-.0i" "1/1-.0i" "#d1-.0i" "1.0-.0i" "1e0-.0i" "01.-.0i" "+1.-.0i" "0001+0i" "+001+0i" "#e01+0i" "#i01+0i" "1/01+0i" "#b01+0i" "#x01+0i" "#d01+0i" "#o01+0i" "#e+1+0i" "#i+1+0i" "#b+1+0i" "#x+1+0i" "#d+1+0i" "#o+1+0i" ".1e1+0i" "01/1+0i" "+1/1+0i" "1.00+0i" "1e00+0i" "01.0+0i" "+1.0+0i" "1e+0+0i" "1e-0+0i" "01e0+0i" "+1e0+0i" "1.e0+0i" "001.+0i" "+01.+0i" "#e1.+0i" "#i1.+0i" "#d1.+0i" "1+0e+0i" "1-0e+0i" "0001-0i" "+001-0i" "#e01-0i" "#i01-0i" "1/01-0i" "#b01-0i" "#x01-0i" "#d01-0i" "#o01-0i" "#e+1-0i" "#i+1-0i" "#b+1-0i" "#x+1-0i" "#d+1-0i" "#o+1-0i" ".1e1-0i" "01/1-0i" "+1/1-0i" "1.00-0i" "1e00-0i" "01.0-0i" "+1.0-0i" "1e+0-0i" "1e-0-0i" "01e0-0i" "+1e0-0i" "1.e0-0i" "001.-0i" "+01.-0i" "#e1.-0i" "#i1.-0i" "#d1.-0i" "1+0e-0i" "1-0e-0i" "1+00e0i" "1-00e0i" "1+.0e0i" "1-.0e0i" "01+0e0i" "+1+0e0i" "1.+0e0i" "01-0e0i" "+1-0e0i" "1.-0e0i" "1+0.e0i" "1-0.e0i" "1+000.i" "1-000.i" "01+00.i" "+1+00.i" "1.+00.i" "01-00.i" "+1-00.i" "1.-00.i" "001+0.i" "+01+0.i" "#e1+0.i" "#i1+0.i" "1/1+0.i" "#d1+0.i" "1.0+0.i" "1e0+0.i" "+1.+0.i" "001-0.i" "+01-0.i" "#e1-0.i" "#i1-0.i" "1/1-0.i" "#d1-0.i" "1.0-0.i" "1e0-0.i" "01.-0.i" "+1.-0.i" "#xb/00b" "#x0b/0b" "#x+b/0b" "#xeb/eb" "#x00b/b" "#x+0b/b" "#x#eb/b" "#x#ib/b" "#e#xb/b" "#i#xb/b" "#xbb/bb" "#xdb/db" "#xd/00d" "#x0d/0d" "#x+d/0d" "#xed/ed")
+
+;;; selected ones...
+
+ (list "#i+11/011" "+101/0101" "#o#e11/11" "#d+11/011" "#e1/0001" "#e#b+001" "#e10e-1"
+ "#x#e1/001" "000000001" "#i+.1e+01" "#d+.1e+01" "00.10e+01" "+0.10e+01" "#e.10e+01" "#i.10e+01" "#d.10e+01"
+ "#e.10e+01" "#i10.0e-01" "+010.e-01" "#e10.e-01" "#e00.1e01" "#e#d.1e01" "#i#d1e0+0e0i"
+ "#e#d10e-1+0e-2i" "#e#d1e0+0e-2i" "#i#d+0.001e+03+0.0e-10i" "#i#d+1/1-0/1i"
+ )
+ )))
+
+(for-each
+ (lambda (str)
+ (let ((val (catch #t (lambda () (string->number str)) (lambda args 'error))))
+ (if (or (not (number? val))
+ (= val 1))
+ (format-logged #t ";(string->number ~S = ~A?~%" str val))))
+ (list "011e0" "11e-00" "00.e01-i" "+10e10+i" "+1.110+i" "10011-0i" "-000.111" "0.100111" "-11.1111" "10.00011" "110e00+i"
+ "1e-011+i" "101001+i" "+11e-0-0i" "11+00e+0i" "-11101.-i" "1110e-0-i"))
+
+(for-each
+ (lambda (str)
+ (test (string->number str) #f)) ; an error but string->number is not supposed to return an error -- just #f or a number
+ (list "#e1+i" "#e1-i" "#e01+i" "#e+1+i" "#e1.+i" "#e01-i" "#e+1-i" "#e1.-i" "#e1+1i" "#e1-1i"))
+
+(num-test (let ((0- 1) (1+ 2) (-0+ 3) (1e 4) (1/+2 5) (--1 6)) (+ 0- 1+ -0+ 1e 1/+2 --1)) 21)
+
+(for-each
+ (lambda (str)
+ (let ((val (catch #t (lambda () (string->number str)) (lambda args 'error))))
+ (if val ;(number? val)
+ (format-logged #t ";(string->number ~S) = ~A?~%" str val))))
+ (list "#b#e#e1" "#x#e#e1" "#d#e#e1" "#o#e#e1" "#b#i#e1" "#x#i#e1" "#d#i#e1" "#o#i#e1" "#e#b#e1" "#i#b#e1" "#e#x#e1" "#i#x#e1"
+ "#e#d#e1" "#i#d#e1" "#e#o#e1" "#i#o#e1" "#e#b#i1" "#e#x#i1" "#e#d#i1" "#e#o#i1" "#b#e#b1" "#x#e#b1" "#d#e#b1" "#o#e#b1"
+ "#b#i#b1" "#x#i#b1" "#d#i#b1" "#o#i#b1" "#b#e#x1" "#x#e#x1" "#d#e#x1" "#o#e#x1" "#b#i#x1" "#x#i#x1" "#d#i#x1" "#o#i#x1"
+ "#b#e#d1" "#x#e#d1" "#d#e#d1" "#o#e#d1" "#b#i#d1" "#x#i#d1" "#d#i#d1" "#o#i#d1" "#b#e#o1" "#x#e#o1" "#d#e#o1" "#o#e#o1"
+ "#b#i#o1" "#x#i#o1" "#d#i#o1" "#o#i#o1"
+
+ "+1ei" "-1ei" "+0ei" "-0ei" "+1di" "-1di" "+0di" "-0di" "+1fi" "-1fi" "+0fi" "-0fi" "0e-+i" "1d-+i"
+ "0d-+i" "1f-+i" "0f-+i" "1e++i" "0e++i" "1d++i" ".10-10." "-1.e++i" "0e--01i" "1-00." "0-00." "#xf+b"
+ "#x1+d" "0f++1i" "1+0d-i" ".0f--i" "1-0d-i" "#xe-ff" "0-" "0-e0"
+
+ "-#b1" "#b.i" "#b+i" "#b1e.1" "#b1+1" "#b#e#e1" "#b#ee1" "#b#e0e" "#d#d1" "#d#1d1"
+ "#b+1ei" "#b-1ei" "#b+0ei" "#b-0ei" "#b+1di" "#b-1di" "#b+0di" "#b-0di" "#b+1fi" "#b-1fi" "#b+0fi" "#b-0fi" "#b0e-+i" "#b1d-+i"
+ ))
+(num-test #i00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001/00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 1.0)
+
+(test (cadr '(1 .#d2)) '.#d2)
+
+(when (provided? 'dfls-exponents)
+ ;; proof that these exponents should be disallowed
+ (num-test (string->number "1l1") 10.0)
+ (num-test (string->number "1l1+1l1i") 10+10i)
+ (num-test (string->number "1l11+11l1i") 100000000000+110i)
+ (num-test (string->number "#d1d1") 10.0)
+ (num-test (string->number "#d0001d0001") 10.0))
+(test (#|#<|# = #|#f#|# #o#e0 #|#>|# #e#o0 #|#t#|#) #t)
+
+(num-test #d9223372036854775807 most-positive-fixnum)
+(num-test #d-9223372036854775808 most-negative-fixnum)
+(num-test #d1.0e8 100000000.0)
+(num-test (string->number "#e#d+11.e-0") 11)
+(num-test (string->number "#d.0e011110") 0.0)
+
+(when with-bignums (num-test (string->number "#d3000000000000000000000000000000") 3000000000000000000000000000000))
+(num-test #d-1/2 -1/2)
+(num-test #d+1/2 1/2)
+(num-test #d1.0e-8 1.0e-8)
+(num-test #d-.1 -0.1)
+(num-test #d+.1 +0.1)
+(num-test #d+.1e+1 1.0)
+(num-test #d1/2 1/2)
+(num-test #d3/4 3/4)
+(num-test #d11/2 11/2)
+(num-test #d9223372036854775807/7 1317624576693539401)
+(num-test (string->number "#d9.11" 16) 9.11)
+(num-test (string->number "#d9.11" 10) 9.11)
+
+;; nutty: #e+inf.0 #e+nan.0
+;; these don't arise in s7 because we don't define inf.0 and nan.0
+(if with-bignums (num-test #e9007199254740995.0 9007199254740995))
+
+(test (= 1 #e1 1/1 #e1/1 #e1.0 #e1e0 #b1 #x1 #o1 #d1 #o001 #o+1 #o#e1 #e#x1 #e1+0i #e10e-1 #e0.1e1 #e+1-0i #e#b1) #t)
+;(test (= 0.3 3e-1 0.3e0 3e-1) #t)
+(test (= 0 +0 0.0 +0.0 0/1 +0/24 0+0i #e0 #b0 #x0 #o0 #e#b0) #t)
+
+(let ((things (vector 123 #e123 #b1111011 #e#b1111011 #b#e1111011 #o173 #e#o173 #o#e173
+ #x7b #e#x7b #x#e7b (string->number "123") 246/2 #e123/1 #d123 #e#d123 #d#e123)))
+ (do ((i 0 (+ i 1)))
+ ((= i (- (vector-length things) 1)))
+ (do ((j (+ i 1) (+ j 1)))
+ ((= j (vector-length things)))
+ (if (not (eqv? (vector-ref things i) (vector-ref things j)))
+ (begin
+ (display "(eqv? ") (display (vector-ref things i)) (display " ") (display (vector-ref things j)) (display ") -> #f?") (newline))))))
+
+(for-each
+ (lambda (p)
+ (let ((sym (car p))
+ (num (cdr p)))
+ (let ((tag (catch #t (lambda () (string->number sym)) (lambda args 'error))))
+ (if (not (equal? num tag))
+ (format-logged #t ";(string->number ~S) = ~A [~A]~%" sym tag num)))))
+ '(("#xe/d" . 14/13) ("#xb/d" . 11/13) ("#xf/d" . 15/13) ("#x1/f" . 1/15) ("#xd/f" . 13/15) ("#xe/f" . 14/15) ("#d.1" . .1) ("#d01" . 1)
+ ("#d+1" . 1) ("#d+0" . 0) ("#d0+i" . 0+i) ("#xe+i" . 14.0+1.0i) ("#xf+i" . 15.0+1.0i) ("#d1-i" . 1.0-1.0i)))
+
+(num-test #d0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300 1.0)
+
+
+(test (char? #e1) #f)
+(test (eval-string "(char? #\\x#e0.0") 'error)
+(test (eval-string "(char? #\\x#e0e100") 'error)
+(test (eval-string "(char? #\\x#e0.0)") 'error)
+(test (eval-string "(char? #\\x#e0e100)") 'error)
+
+(test (= 1/2 '#e#b1e-1) #t)
+(num-test `,#e.1 1/10)
+;(num-test (string->number "#e#x-142.1e-1") -554/49)
+;(num-test (string->number "#e#ta.a") 65/6)
+;(num-test (string->number "#e#t11.6") 27/2)
+
+(test (integer? #e.1e010) #t)
+;#e4611686018427388404.0 -> 4611686018427387904
+
+(when with-bignums
+ (num-test #e9007199254740995.0 9007199254740995)
+ (num-test #e4611686018427388404.0 4611686018427388404))
+
+(num-test (lognot #e10e011) -1000000000001)
+(num-test (ceiling #e-01-0i ) -1)
+(test (lcm 1 ' #e1.(logior )) 0) ; (lcm 1 1 0)
+;(test (= (string->number "#e.1e20") 1e19) #t)
+(num-test (expt #e1 -111) 1)
+(num-test (expt -0(quasiquote #e0)) 1)
+(num-test (string->number "#e0a" 16) 10)
+(num-test #e1.0e8 100000000)
+
+(test (string->number "#o#e10.+1.i") #f)
+(test (string->number "#x#e1+i") #f)
+(test (string->number "#x#1+#e1i") #f)
+(test (string->number "#x#e1+#e1i") #f)
+(test (string->number "#b#e1+i") #f)
+(test (string->number "#o#e1-110.i") #f)
+(num-test (string->number "#e1+0i") 1)
+(num-test (string->number "#x#e1+0i") 1)
+(num-test (string->number "#e#x1+0i") 1)
+
+(num-test #e0.1 1/10)
+(test (equal? #e1.5 3/2) #t)
+(test (equal? #e1.0 1) #t)
+(test (equal? #e-.1 -1/10) #t)
+(test (equal? #e1 1) #t)
+(test (equal? #e3/2 3/2) #t)
+(num-test (string->number "#e8/2" 11) 4)
+;(num-test (string->number "#eb8235.9865c01" 13) 19132998081/57607)
+; this one depends on the underlying size (32/64)
+
+(num-test #e0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300 1)
+(num-test #e0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e309 1)
+(num-test #e0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123e309 123/100)
+(num-test #e-.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123456e314 -123456)
+
+(num-test #e1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-300 1)
+(num-test #e1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309 1)
+(num-test #e-1234000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309 -617/500)
+
+(num-test #e1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-300 1)
+(num-test #e1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309 1)
+(num-test #e1.0e0000000000000000000000000000000000001 10)
+(num-test #e1.0e-0000000000000000000000000000000000001 1/10)
+(num-test #e00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 10)
+
+(when with-bignums
+ (test (bignum? (bignum "#e1.5")) #t))
+
+(when (provided? 'dfls-exponents)
+ (num-test (tanh 1s13) 1s0)
+ (num-test (tanh 1s3) 1s0)
+ (num-test (tanh 1s2) 1s0)
+ (num-test (tanh 1s1) 1s0)
+ (num-test (tanh 1l0) 0.7615941559557648881L0)
+ (num-test (tanh 1l1) 0.9999999958776927636L0)
+ (num-test (tanh 1l100) 1L0)
+ (num-test (tanh 1f10) 1f0)
+ (num-test (tanh 1L-10) 1L-10)
+ (num-test (tanh 1L-17) 1L-17)
+ (num-test (tanh 1L-47) 1L-47))
+
+(when (provided? 'dfls-exponents)
+ (test (> 1.0L10 1.0e9) #t)
+ (test (> 1.0l10 1.0e9) #t)
+ (test (> 1.0s10 1.0e9) #t)
+ (test (> 1.0S10 1.0e9) #t)
+ (test (> 1.0d10 1.0e9) #t)
+ (test (> 1.0D10 1.0e9) #t)
+ (test (> 1.0f10 1.0e9) #t)
+ (test (> 1.0F10 1.0e9) #t)
+
+ (test (> (real-part 1.0L10+i) 1.0e9) #t)
+ (test (> (real-part 1.0l10+i) 1.0e9) #t)
+ (test (> (real-part 1.0s10+i) 1.0e9) #t)
+ (test (> (real-part 1.0S10+i) 1.0e9) #t)
+ (test (> (real-part 1.0d10+i) 1.0e9) #t)
+ (test (> (real-part 1.0D10+i) 1.0e9) #t)
+ (test (> (real-part 1.0f10+i) 1.0e9) #t)
+ (test (> (real-part 1.0F10+i) 1.0e9) #t)
+
+ (test (> (imag-part 1.0+1.0L10i) 1.0e9) #t)
+ (test (> (imag-part 1.0+1.0l10i) 1.0e9) #t)
+ (test (> (imag-part 1.0+1.0s10i) 1.0e9) #t)
+ (test (> (imag-part 1.0+1.0S10i) 1.0e9) #t)
+ (test (> (imag-part 1.0+1.0d10i) 1.0e9) #t)
+ (test (> (imag-part 1.0+1.0D10i) 1.0e9) #t)
+ (test (> (imag-part 1.0+1.0f10i) 1.0e9) #t)
+ (test (> (imag-part 1.0+1.0F10i) 1.0e9) #t)
+
+ (test (> (string->number "1.0L10") 1.0e9) #t)
+ (test (> (string->number "1.0l10") 1.0e9) #t)
+ (test (> (string->number "1.0s10") 1.0e9) #t)
+ (test (> (string->number "1.0S10") 1.0e9) #t)
+ (test (> (string->number "1.0d10") 1.0e9) #t)
+ (test (> (string->number "1.0D10") 1.0e9) #t)
+ (test (> (string->number "1.0f10") 1.0e9) #t)
+ (test (> (string->number "1.0F10") 1.0e9) #t)
+
+ (test (> (real-part (string->number "1.0L10+i")) 1.0e9) #t)
+ (test (> (real-part (string->number "1.0l10+i")) 1.0e9) #t)
+ (test (> (real-part (string->number "1.0s10+i")) 1.0e9) #t)
+ (test (> (real-part (string->number "1.0S10+i")) 1.0e9) #t)
+ (test (> (real-part (string->number "1.0d10+i")) 1.0e9) #t)
+ (test (> (real-part (string->number "1.0D10+i")) 1.0e9) #t)
+ (test (> (real-part (string->number "1.0f10+i")) 1.0e9) #t)
+ (test (> (real-part (string->number "1.0F10+i")) 1.0e9) #t)
+
+ (test (> (imag-part (string->number "1.0+1.0L10i")) 1.0e9) #t)
+ (test (> (imag-part (string->number "1.0+1.0l10i")) 1.0e9) #t)
+ (test (> (imag-part (string->number "1.0+1.0s10i")) 1.0e9) #t)
+ (test (> (imag-part (string->number "1.0+1.0S10i")) 1.0e9) #t)
+ (test (> (imag-part (string->number "1.0+1.0d10i")) 1.0e9) #t)
+ (test (> (imag-part (string->number "1.0+1.0D10i")) 1.0e9) #t)
+ (test (> (imag-part (string->number "1.0+1.0f10i")) 1.0e9) #t)
+ (test (> (imag-part (string->number "1.0+1.0F10i")) 1.0e9) #t)
+
+ (when with-bignums
+ (test (> (string->number "1.0L100") 1.0e98) #t)
+ (test (> (string->number "1.0l100") 1.0e98) #t)
+ (test (> (string->number "1.0s100") 1.0e98) #t)
+ (test (> (string->number "1.0S100") 1.0e98) #t)
+ (test (> (string->number "1.0d100") 1.0e98) #t)
+ (test (> (string->number "1.0D100") 1.0e98) #t)
+ (test (> (string->number "1.0f100") 1.0e98) #t)
+ (test (> (string->number "1.0F100") 1.0e98) #t)
+ (test (> (string->number "1.0E100") 1.0e98) #t)
+
+ (test (> 1.0L100 1.0e98) #t)
+ (test (> 1.0l100 1.0e98) #t)
+ (test (> 1.0s100 1.0e98) #t)
+ (test (> 1.0S100 1.0e98) #t)
+ (test (> 1.0d100 1.0e98) #t)
+ (test (> 1.0D100 1.0e98) #t)
+ (test (> 1.0f100 1.0e98) #t)
+ (test (> 1.0F100 1.0e98) #t)
+
+ (test (> (real-part (string->number "1.0L100+i")) 1.0e98) #t)
+ (test (> (real-part (string->number "1.0l100+i")) 1.0e98) #t)
+ (test (> (real-part (string->number "1.0s100+i")) 1.0e98) #t)
+ (test (> (real-part (string->number "1.0S100+i")) 1.0e98) #t)
+ (test (> (real-part (string->number "1.0d100+i")) 1.0e98) #t)
+ (test (> (real-part (string->number "1.0D100+i")) 1.0e98) #t)
+ (test (> (real-part (string->number "1.0f100+i")) 1.0e98) #t)
+ (test (> (real-part (string->number "1.0F100+i")) 1.0e98) #t)
+
+ (test (> (real-part 1.0L100+i) 1.0e98) #t)
+ (test (> (real-part 1.0l100+i) 1.0e98) #t)
+ (test (> (real-part 1.0s100+i) 1.0e98) #t)
+ (test (> (real-part 1.0S100+i) 1.0e98) #t)
+ (test (> (real-part 1.0d100+i) 1.0e98) #t)
+ (test (> (real-part 1.0D100+i) 1.0e98) #t)
+ (test (> (real-part 1.0f100+i) 1.0e98) #t)
+ (test (> (real-part 1.0F100+i) 1.0e98) #t)
+
+ (test (> (imag-part (string->number "1.0+1.0L100i")) 1.0e98) #t)
+ (test (> (imag-part (string->number "1.0+1.0l100i")) 1.0e98) #t)
+ (test (> (imag-part (string->number "1.0+1.0s100i")) 1.0e98) #t)
+ (test (> (imag-part (string->number "1.0+1.0S100i")) 1.0e98) #t)
+ (test (> (imag-part (string->number "1.0+1.0d100i")) 1.0e98) #t)
+ (test (> (imag-part (string->number "1.0+1.0D100i")) 1.0e98) #t)
+ (test (> (imag-part (string->number "1.0+1.0f100i")) 1.0e98) #t)
+ (test (> (imag-part (string->number "1.0+1.0F100i")) 1.0e98) #t)
+
+ (test (> (imag-part 1.0+1.0L100i) 1.0e98) #t)
+ (test (> (imag-part 1.0+1.0l100i) 1.0e98) #t)
+ (test (> (imag-part 1.0+1.0s100i) 1.0e98) #t)
+ (test (> (imag-part 1.0+1.0S100i) 1.0e98) #t)
+ (test (> (imag-part 1.0+1.0d100i) 1.0e98) #t)
+ (test (> (imag-part 1.0+1.0D100i) 1.0e98) #t)
+ (test (> (imag-part 1.0+1.0f100i) 1.0e98) #t)
+ (test (> (imag-part 1.0+1.0F100i) 1.0e98) #t)))
+
+(when (provided? 'dfls-exponents)
+ (test (string->number "1D1") 10.0)
+ (test (string->number "1S1") 10.0)
+ (test (string->number "1F1") 10.0)
+ (test (string->number "1L1") 10.0)
+ (test (string->number "1d1") 10.0)
+ (test (string->number "1s1") 10.0)
+ (test (string->number "1f1") 10.0)
+ (test (string->number "1l1") 10.0))
+
+(when (provided? 'dfls-exponents)
+ (for-each
+ (lambda (n)
+ (let ((nb
+ (catch #t
+ (lambda ()
+ (number? n))
+ (lambda args
+ 'error))))
+ (if (not nb)
+ (begin
+ (display "(number? ") (display n) (display ") returned #f?") (newline)))))
+
+ (list 1 -1 +1 +.1 -.1 .1 .0 0. 0.0 -0 +0 -0. +0.
+ +1.1 -1.1 1.1
+ '1.0e2 '-1.0e2 '+1.0e2
+ '1.1e-2 '-1.1e-2 '+1.1e-2
+ '1.1e+2 '-1.1e+2 '+1.1e+2
+ '1/2 '-1/2 '+1/2
+ '1.0s2 '-1.0s2 '+1.0s2
+ '1.0d2 '-1.0d2 '+1.0d2
+ '1.0f2 '-1.0f2 '+1.0f2
+ '1.0l2 '-1.0l2 '+1.0l2
+ '1.0+1.0i '1.0-1.0i '-1.0-1.0i '-1.0+1.0i
+ '1+i '1-i '-1-i '-1+i
+ '2/3+i '2/3-i '-2/3+i
+ '1+2/3i '1-2/3i '2/3+2/3i '2.3-2/3i '2/3-2.3i
+ '2e2+1e3i '2e2-2e2i '2.0e2+i '1+2.0e2i '2.0e+2-2.0e-1i '2/3-2.0e3i '2e-3-2/3i
+ '-2.0e-2-2.0e-2i '+2.0e+2+2.0e+2i '+2/3-2/3i '2e2-2/3i
+ '1e1-i '1.-i '.0+i '-.0-1e-1i '1.+.1i '0.-.1i
+ '.1+.0i '1.+.0i '.1+.1i '1.-.1i '.0+.00i '.10+.0i '-1.+.0i '.1-.01i '1.0+.1i
+ '1e1+.1i '-1.-.10i '1e01+.0i '0e11+.0i '1.e1+.0i '1.00-.0i '-1e1-.0i '1.-.1e0i
+ '1.+.001i '1e10-.1i '1e+0-.1i '-0e0-.1i
+ '-1.0e-1-1.0e-1i '-111e1-.1i '1.1-.1e11i '-1e-1-.11i '-1.1-.1e1i '-.1+.1i)))
+
+
+(num-test #i00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001/00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 1.0)
+
+(do ((i (char->integer #\") (+ i 1)))
+ ((= i 127))
+ (when (not (member (integer->char i) '(#\( #\: #\|)))
+ (set! *#readers* (cons (cons (integer->char i) (lambda (str) (string->number (substring str 1)))) ()))
+ (let ((val (eval (with-input-from-string (string-append "(+ 10 #" (string (integer->char i)) "12)") read))))
+ (if (not (equal? val 22)) (format *stderr* "~D (~C): ~A~%" i (integer->char i) val)))))
+
diff --git a/peak-phases.scm b/peak-phases.scm
index d52c8eb..3f3d923 100644
--- a/peak-phases.scm
+++ b/peak-phases.scm
@@ -11,14 +11,14 @@
(define noid-min-peak-phases (vector
-(vector 1 1.0 #(0))
-(vector 2 1.76 #(0 0))
+(vector 1 1.0 #r(0))
+(vector 2 1.76 #r(0 0))
;; the 1.76 can be calculated (given here that 0 is the min)
;; take derivative of sin(x) + sin(2x) = cos(x) + 2cos(2x)
;; use cos(2x) = 2cos^2(x) - 1 to turn this into a quadratic polynomial in cos(x)
;; 4cos^2(x) + cos(x) - 2
-;; let x be cos(x), quadratic formula gives (-1 + sqrt(33))/8, [poly-roots #(-2 1 4) -> (0.59307033081725 -0.84307033081725)]
+;; let x be cos(x), quadratic formula gives (-1 + sqrt(33))/8, [poly-roots #r(-2 1 4) -> (0.59307033081725 -0.84307033081725)]
;; take acos of that to get cos(x):
;; (acos (+ -1/8 (/ (sqrt (+ 1 32)) 8))) -> 0.93592945566133
;; plug that into the original:
@@ -50,1453 +50,1452 @@
;;; 3 all --------------------------------------------------------------------------------
-(vector 3 2.1949383250709 #(0 0 1)
+(vector 3 2.1949383250709 #r(0 0 1)
- 1.9798054823226 #(0.0 5.897251124274717204443163609539624303579E-1 3.166675693251937984129540382127743214369E-1)
- 1.9798054823222 #(0.0 4.102748875720859667026729766803327947855E-1 1.683332430673265878162681019603041931987E0)
- 1.9798054823226 #(0.0 1.58972511242745917492413809668505564332E0 3.166675693251493894919690319511573761702E-1)
- 1.9798054823222 #(0.0 1.410274887572085966702672976680332794785E0 1.683332430673265878162681019603041931987E0)
+ 1.9798054823226 #r(0.0 5.897251124274717204443163609539624303579E-1 3.166675693251937984129540382127743214369E-1)
+ 1.9798054823222 #r(0.0 4.102748875720859667026729766803327947855E-1 1.683332430673265878162681019603041931987E0)
+ 1.9798054823226 #r(0.0 1.58972511242745917492413809668505564332E0 3.166675693251493894919690319511573761702E-1)
+ 1.9798054823222 #r(0.0 1.410274887572085966702672976680332794785E0 1.683332430673265878162681019603041931987E0)
- ;; :(tstall #(0 62/39 19/60))
+ ;; :(tstall #r(0 62/39 19/60))
;; (1.979860844111887127172689015942912379187E0 5.5534000000004)
- ;; same for #(0 23/39 19/60), always the case (it's symmetric in the 2nd), sin(x) +/- sin(2x + a) + sin(3x + b)
- ;; :(tstall #(0.0 5.897251124274717204443163609539624303579E-1 3.166675693251937984129540382127743214369E-1) 0.0000001)
+ ;; same for #r(0 23/39 19/60), always the case (it's symmetric in the 2nd), sin(x) +/- sin(2x + a) + sin(3x + b)
+ ;; :(tstall #r(0.0 5.897251124274717204443163609539624303579E-1 3.166675693251937984129540382127743214369E-1) 0.0000001)
;; (1.979806197137575924716806491964687429097E0 0.1714663000039)
- 1.9797181063317 #(0.0 0.41022177723939 1.6832780274654)
- 1.979716725384 #(0.0 1.5897793760084 0.31672588155614)
- 1.9797162690553 #(0.0 1.4102202429311 1.6832728267862)
+ 1.9797181063317 #r(0.0 0.41022177723939 1.6832780274654)
+ 1.979716725384 #r(0.0 1.5897793760084 0.31672588155614)
+ 1.9797162690553 #r(0.0 1.4102202429311 1.6832728267862)
;; polynomial is surprisingly good:
- ;; :all 3 #(1.9797767193773 0.066455282926612 1.7863254855475)
+ ;; :all 3 #r(1.9797767193773 0.066455282926612 1.7863254855475)
;; big fft
- 1.979806 #(0.000000 0.410275 1.683332)
+ 1.979806 #r(0.000000 0.410275 1.683332)
)
;;; 4 all --------------------------------------------------------------------------------
-(vector 4 2.2962718935302 #(0 1 1 1)
+(vector 4 2.2962718935302 #r(0 1 1 1)
- 2.040 #(0 33/35 67/50 10/9) ;(vector 0 1/9 17/24 71/36) -- 2.04242
- 2.04012799263 #(0.000 0.072 0.674 1.912)
- 2.04012799263 #(0.000 0.928 1.326 1.088)
- 2.04012799263 #(0.000 1.072 0.674 0.912)
- 2.04012799263 #(0.000 1.928 1.326 0.088)
+ 2.040 #r(0 33/35 67/50 10/9) ;(vector 0 1/9 17/24 71/36) -- 2.04242
+ 2.04012799263 #r(0.000 0.072 0.674 1.912)
+ 2.04012799263 #r(0.000 0.928 1.326 1.088)
+ 2.04012799263 #r(0.000 1.072 0.674 0.912)
+ 2.04012799263 #r(0.000 1.928 1.326 0.088)
- 2.0392323180235 #(0.0 9.429973765023149656627765580196864902973E-1 1.340090256365081833322960846999194473028E0 1.112605206055434337031329050660133361816E0)
+ 2.0392323180235 #r(0.0 9.429973765023149656627765580196864902973E-1 1.340090256365081833322960846999194473028E0 1.112605206055434337031329050660133361816E0)
- 2.038956 #(0.000000 0.944585 1.341508 1.115059)
- 2.038954 #(0.000000 1.055406 0.658486 0.884929)
- 2.038954 #(0.000000 0.055405 0.658485 1.884926)
- 2.038954 #(0.000000 1.944593 1.341515 0.115071)
+ 2.038956 #r(0.000000 0.944585 1.341508 1.115059)
+ 2.038954 #r(0.000000 1.055406 0.658486 0.884929)
+ 2.038954 #r(0.000000 0.055405 0.658485 1.884926)
+ 2.038954 #r(0.000000 1.944593 1.341515 0.115071)
- ;; :all 4 #(2.060278672942 -0.70579973196553 0.90455920034382)
+ ;; :all 4 #r(2.060278672942 -0.70579973196553 0.90455920034382)
;; big fft
- 2.039104 #(0.000000 0.055486 0.658542 1.885004)
- 2.039103 #(0.000000 0.055488 0.658545 1.885009)
+ 2.039104 #r(0.000000 0.055486 0.658542 1.885004)
+ 2.039103 #r(0.000000 0.055488 0.658545 1.885009)
)
;;; 5 all -------------------------------------------------------------------------------- ; 2.23
-(vector 5 2.5405211753511 #(0 1 0 0 0)
+(vector 5 2.5405211753511 #r(0 1 0 0 0)
- 2.3434929847717 #(0.0 0.84531772136688 1.6645057201385 1.4203575849533 1.5933285951614)
- 2.3434844481891 #(0.0 1.8453152570243 1.6649825491504 0.42142125263938 1.5942588576594)
+ 2.3434929847717 #r(0.0 0.84531772136688 1.6645057201385 1.4203575849533 1.5933285951614)
+ 2.3434844481891 #r(0.0 1.8453152570243 1.6649825491504 0.42142125263938 1.5942588576594)
- 2.343549 #(0.000000 1.845237 1.664402 0.420189 1.593154)
- 2.343533 #(0.000000 1.154716 0.335535 0.579695 0.406714)
- 2.343497 #(0.000000 0.845320 1.664496 1.420334 1.593308)
+ 2.343549 #r(0.000000 1.845237 1.664402 0.420189 1.593154)
+ 2.343533 #r(0.000000 1.154716 0.335535 0.579695 0.406714)
+ 2.343497 #r(0.000000 0.845320 1.664496 1.420334 1.593308)
- 2.343527 #(0.000000 0.154667 0.335503 1.579672 0.406698)
- 2.343513 #(0.000000 0.154687 0.335490 1.579647 0.406677)
- 2.343508 #(0.000000 1.845332 1.664532 0.420369 1.593338)
+ 2.343527 #r(0.000000 0.154667 0.335503 1.579672 0.406698)
+ 2.343513 #r(0.000000 0.154687 0.335490 1.579647 0.406677)
+ 2.343508 #r(0.000000 1.845332 1.664532 0.420369 1.593338)
;; pp:
- 2.343485 #(0.000000 1.154683 0.335509 0.579687 0.406716)
+ 2.343485 #r(0.000000 1.154683 0.335509 0.579687 0.406716)
)
;;; 6 all -------------------------------------------------------------------------------- ; 2.4494
-(vector 6 2.8200183503167 #(0 0 0 0 1 0)
+(vector 6 2.8200183503167 #r(0 0 0 0 1 0)
- 2.5509102344513 #(0.0 0.88722838124921 0.26020415169852 1.2966409163042 1.3233535939997 1.15281977798)
- 2.5493413065822 #(0.0 0.88655948906463 0.26426014425456 1.3003055923199 1.3306838066896 1.1573162129407)
+ 2.5509102344513 #r(0.0 0.88722838124921 0.26020415169852 1.2966409163042 1.3233535939997 1.15281977798)
+ 2.5493413065822 #r(0.0 0.88655948906463 0.26426014425456 1.3003055923199 1.3306838066896 1.1573162129407)
- 2.549466 #(0.000000 1.113453 1.735461 0.699472 0.668803 0.842320)
- 2.549414 #(0.000000 0.886661 0.264519 1.300599 1.331194 1.157723)
- 2.549386 #(0.000000 0.113427 1.735535 1.699526 0.668940 1.842412)
- 2.549385 #(0.000000 1.886568 0.264458 0.300485 1.331039 0.157570)
- 2.549360 #(0.000000 0.886491 0.264319 1.300337 1.330828 1.157371)
+ 2.549466 #r(0.000000 1.113453 1.735461 0.699472 0.668803 0.842320)
+ 2.549414 #r(0.000000 0.886661 0.264519 1.300599 1.331194 1.157723)
+ 2.549386 #r(0.000000 0.113427 1.735535 1.699526 0.668940 1.842412)
+ 2.549385 #r(0.000000 1.886568 0.264458 0.300485 1.331039 0.157570)
+ 2.549360 #r(0.000000 0.886491 0.264319 1.300337 1.330828 1.157371)
- 2.549302 #(0.000000 0.886538 0.264356 1.300390 1.330858 1.157418)
+ 2.549302 #r(0.000000 0.886538 0.264356 1.300390 1.330858 1.157418)
;; random runs:
- 2.549303 #(0.000000 -0.113461 0.264357 0.300392 -0.669139 0.157420)
- 2.549303 #(0.000000 0.113461 -0.264357 -0.300391 0.669139 -0.157420)
- ;; 2.549304 #(0.000000 0.113458 -0.264363 1.699605 0.669131 1.842572)
- 2.549303 #(0.000000 0.113461 1.735641 -0.300392 0.669137 -0.157422)
- 2.549303 #(0.000000 0.886537 0.264354 1.300389 1.330856 1.157416)
+ 2.549303 #r(0.000000 -0.113461 0.264357 0.300392 -0.669139 0.157420)
+ 2.549303 #r(0.000000 0.113461 -0.264357 -0.300391 0.669139 -0.157420)
+ ;; 2.549304 #r(0.000000 0.113458 -0.264363 1.699605 0.669131 1.842572)
+ 2.549303 #r(0.000000 0.113461 1.735641 -0.300392 0.669137 -0.157422)
+ 2.549303 #r(0.000000 0.886537 0.264354 1.300389 1.330856 1.157416)
)
;;; 7 all -------------------------------------------------------------------------------- ; 2.64575
-(vector 7 3.072141248417 #(0 0 0 1 1 0 1)
+(vector 7 3.072141248417 #r(0 0 0 1 1 0 1)
- 2.639426 #(0.000000 0.904980 0.986109 1.721148 1.291116 1.621443 0.966099)
- 2.639402 #(0.000000 0.095202 1.014213 1.278914 0.709149 1.378847 1.034223)
- 2.639371 #(0.000000 1.095652 1.014884 0.279318 0.709755 0.379605 1.035166)
- 2.639364 #(0.000000 1.904695 0.985719 0.720925 1.290796 0.621014 0.965536)
+ 2.639426 #r(0.000000 0.904980 0.986109 1.721148 1.291116 1.621443 0.966099)
+ 2.639402 #r(0.000000 0.095202 1.014213 1.278914 0.709149 1.378847 1.034223)
+ 2.639371 #r(0.000000 1.095652 1.014884 0.279318 0.709755 0.379605 1.035166)
+ 2.639364 #r(0.000000 1.904695 0.985719 0.720925 1.290796 0.621014 0.965536)
)
;;; 8 all -------------------------------------------------------------------------------- ; 2.8284
-(vector 8 3.4905790371793 #(0 1 0 0 1 1 1 0)
+(vector 8 3.4905790371793 #r(0 1 0 0 1 1 1 0)
- 2.795099 #(0.000000 1.333103 1.192134 0.394213 1.162609 1.955320 1.855302 0.126169)
- 2.794748 #(0.000000 0.333225 1.192073 1.394414 1.162519 0.954914 1.855082 1.126189)
- 2.794737 #(0.000000 1.666686 0.807757 0.605305 0.837099 1.044558 0.144428 0.873255)
- 2.794719 #(0.000000 0.666709 0.807769 1.605408 0.837217 0.044625 0.144433 1.873342)
- 2.794585 #(0.000000 0.666699 0.807707 1.605285 0.837106 0.044540 0.144374 1.873180)
+ 2.795099 #r(0.000000 1.333103 1.192134 0.394213 1.162609 1.955320 1.855302 0.126169)
+ 2.794748 #r(0.000000 0.333225 1.192073 1.394414 1.162519 0.954914 1.855082 1.126189)
+ 2.794737 #r(0.000000 1.666686 0.807757 0.605305 0.837099 1.044558 0.144428 0.873255)
+ 2.794719 #r(0.000000 0.666709 0.807769 1.605408 0.837217 0.044625 0.144433 1.873342)
+ 2.794585 #r(0.000000 0.666699 0.807707 1.605285 0.837106 0.044540 0.144374 1.873180)
;; pp:
- 2.880745 #(0.000000 0.873927 1.696839 1.009332 0.354675 0.227015 0.156852 0.523641)
+ 2.880745 #r(0.000000 0.873927 1.696839 1.009332 0.354675 0.227015 0.156852 0.523641)
;; big fft
- 2.794684 #(0.000000 0.333223 1.192169 1.394521 1.162690 0.955202 1.855341 1.126445)
+ 2.794684 #r(0.000000 0.333223 1.192169 1.394521 1.162690 0.955202 1.855341 1.126445)
)
;;; 9 all --------------------------------------------------------------------------------
-(vector 9 3.5954569026984 #(0 1 1 0 1 0 1 1 1)
+(vector 9 3.5954569026984 #r(0 1 1 0 1 0 1 1 1)
- 2.962087 #(0.000000 0.872517 1.501013 0.464057 -0.056897 1.063020 1.251698 1.436014 1.254131)
- 2.962094 #(0.000000 1.127564 0.498862 1.535743 0.056794 0.936657 0.748023 0.563510 0.745376)
- 2.962065 #(0.000000 -0.127444 1.501316 1.464492 -0.056263 0.063823 1.252240 0.437075 1.255320)
- 2.961916 #(0.000000 0.127632 0.498978 0.536080 0.057253 -0.062716 0.748729 1.564172 0.746161)
- 2.961829 #(0.000000 1.872309 1.500693 1.463585 1.942384 0.062267 1.250564 0.435026 1.252813)
- 2.961652 #(0.000000 1.872337 1.500914 1.463820 1.942618 0.062504 1.251193 0.435609 1.253539)
+ 2.962087 #r(0.000000 0.872517 1.501013 0.464057 -0.056897 1.063020 1.251698 1.436014 1.254131)
+ 2.962094 #r(0.000000 1.127564 0.498862 1.535743 0.056794 0.936657 0.748023 0.563510 0.745376)
+ 2.962065 #r(0.000000 -0.127444 1.501316 1.464492 -0.056263 0.063823 1.252240 0.437075 1.255320)
+ 2.961916 #r(0.000000 0.127632 0.498978 0.536080 0.057253 -0.062716 0.748729 1.564172 0.746161)
+ 2.961829 #r(0.000000 1.872309 1.500693 1.463585 1.942384 0.062267 1.250564 0.435026 1.252813)
+ 2.961652 #r(0.000000 1.872337 1.500914 1.463820 1.942618 0.062504 1.251193 0.435609 1.253539)
;; pp:
- 2.961653 #(0.000000 0.872337 1.500915 0.463821 1.942617 1.062504 1.251196 1.435614 1.253542)
+ 2.961653 #r(0.000000 0.872337 1.500915 0.463821 1.942617 1.062504 1.251196 1.435614 1.253542)
)
;;; 10 all -------------------------------------------------------------------------------- ; 3.162
-(vector 10 3.7587492407668 #(0 1 1 0 1 1 1 0 0 0)
+(vector 10 3.7587492407668 #r(0 1 1 0 1 1 1 0 0 0)
- 3.102964 #(0.000000 0.071632 0.396251 0.504925 0.052683 0.212597 1.057168 -0.172275 1.102043 0.501144)
- 3.102823 #(0.000000 1.070629 0.394872 1.503703 0.050925 1.211208 1.054650 0.825637 1.099957 1.498128)
- 3.102782 #(0.000000 0.927743 1.602314 0.494139 -0.054832 0.785103 0.940332 1.169212 0.894844 0.494709)
- 3.102734 #(0.000000 1.928606 1.603786 1.495372 -0.052790 1.786999 0.942669 0.172108 0.897837 1.498611)
- 3.102303 #(0.000000 -0.071891 1.603086 1.494633 -0.053985 1.786024 0.941426 0.170569 0.896122 1.496522)
+ 3.102964 #r(0.000000 0.071632 0.396251 0.504925 0.052683 0.212597 1.057168 -0.172275 1.102043 0.501144)
+ 3.102823 #r(0.000000 1.070629 0.394872 1.503703 0.050925 1.211208 1.054650 0.825637 1.099957 1.498128)
+ 3.102782 #r(0.000000 0.927743 1.602314 0.494139 -0.054832 0.785103 0.940332 1.169212 0.894844 0.494709)
+ 3.102734 #r(0.000000 1.928606 1.603786 1.495372 -0.052790 1.786999 0.942669 0.172108 0.897837 1.498611)
+ 3.102303 #r(0.000000 -0.071891 1.603086 1.494633 -0.053985 1.786024 0.941426 0.170569 0.896122 1.496522)
;; pp:
- 3.270687 #(0.000000 1.665169 -0.138115 1.364203 0.226693 -0.150959 1.661874 0.514042 1.098209 1.445028)
+ 3.270687 #r(0.000000 1.665169 -0.138115 1.364203 0.226693 -0.150959 1.661874 0.514042 1.098209 1.445028)
)
;;; 11 all -------------------------------------------------------------------------------- ; 3.31662
-(vector 11 3.8018732822274 #(0 1 0 0 1 0 0 0 1 1 1)
+(vector 11 3.8018732822274 #r(0 1 0 0 1 0 0 0 1 1 1)
- 3.218745 #(0.000000 1.518100 1.908924 1.617043 1.540909 0.660141 -0.056826 0.670660 1.165195 1.212229 0.198401)
- 3.218587 #(0.000000 0.518100 1.908924 0.617043 1.540909 1.660141 -0.056826 1.670660 1.165195 0.212229 0.198401)
- 3.218514 #(0.000000 0.481786 0.091759 0.383540 0.459429 1.340439 0.058075 1.330988 0.836240 0.789345 -0.196819)
- 3.218444 #(0.000000 0.482127 0.090769 0.383093 0.459045 1.339823 0.056682 1.328792 0.834826 0.787716 -0.199032)
- 3.217965 #(0.000000 0.482287 0.091029 0.383292 0.459507 1.340271 0.057231 1.329368 0.835616 0.788459 -0.198129)
+ 3.218745 #r(0.000000 1.518100 1.908924 1.617043 1.540909 0.660141 -0.056826 0.670660 1.165195 1.212229 0.198401)
+ 3.218587 #r(0.000000 0.518100 1.908924 0.617043 1.540909 1.660141 -0.056826 1.670660 1.165195 0.212229 0.198401)
+ 3.218514 #r(0.000000 0.481786 0.091759 0.383540 0.459429 1.340439 0.058075 1.330988 0.836240 0.789345 -0.196819)
+ 3.218444 #r(0.000000 0.482127 0.090769 0.383093 0.459045 1.339823 0.056682 1.328792 0.834826 0.787716 -0.199032)
+ 3.217965 #r(0.000000 0.482287 0.091029 0.383292 0.459507 1.340271 0.057231 1.329368 0.835616 0.788459 -0.198129)
;; pp:
- 3.468683 #(0.000000 0.627804 1.366835 0.412917 1.258123 0.658181 0.350130 1.736695 1.823585 1.864191 0.254629)
+ 3.468683 #r(0.000000 0.627804 1.366835 0.412917 1.258123 0.658181 0.350130 1.736695 1.823585 1.864191 0.254629)
)
;;; 12 all -------------------------------------------------------------------------------- ; 3.464
-(vector 12 3.7616552322386 #(0 1 1 0 0 1 0 1 0 0 0 0)
+(vector 12 3.7616552322386 #r(0 1 1 0 0 1 0 1 0 0 0 0)
- 3.389586 #(0.000000 0.076743 0.348321 0.615321 0.763893 0.188090 0.117764 1.147735 1.461927 0.591300 1.497863 0.867456)
- 3.389547 #(0.000000 -0.079085 1.648740 1.380212 1.228354 1.804105 1.875295 0.844196 0.527781 1.396624 0.490362 1.119947)
- 3.389430 #(0.000000 1.081078 0.354514 1.624157 0.776410 1.200581 0.129241 0.162495 1.480822 1.614178 1.518801 1.892528)
- 3.389128 #(0.000000 1.076659 0.348730 1.615059 0.764020 1.188577 0.117561 0.148053 1.462454 1.591386 1.497945 1.868055)
- 3.388654 #(0.000000 1.076620 0.347797 1.614462 0.764164 1.188107 0.116910 0.147164 1.461571 1.590619 1.496557 1.866148)
+ 3.389586 #r(0.000000 0.076743 0.348321 0.615321 0.763893 0.188090 0.117764 1.147735 1.461927 0.591300 1.497863 0.867456)
+ 3.389547 #r(0.000000 -0.079085 1.648740 1.380212 1.228354 1.804105 1.875295 0.844196 0.527781 1.396624 0.490362 1.119947)
+ 3.389430 #r(0.000000 1.081078 0.354514 1.624157 0.776410 1.200581 0.129241 0.162495 1.480822 1.614178 1.518801 1.892528)
+ 3.389128 #r(0.000000 1.076659 0.348730 1.615059 0.764020 1.188577 0.117561 0.148053 1.462454 1.591386 1.497945 1.868055)
+ 3.388654 #r(0.000000 1.076620 0.347797 1.614462 0.764164 1.188107 0.116910 0.147164 1.461571 1.590619 1.496557 1.866148)
;; pp:
- 3.546003 #(0.000000 0.813150 -1.878303 1.450426 -0.112095 -1.110299 -0.487466 -0.181683 0.060170 -0.004101 -0.103775 -0.960524)
+ 3.546003 #r(0.000000 0.813150 -1.878303 1.450426 -0.112095 -1.110299 -0.487466 -0.181683 0.060170 -0.004101 -0.103775 -0.960524)
)
;;; 13 all -------------------------------------------------------------------------------- ; 3.6055
-(vector 13 4.1211657406183 #(0 0 0 0 0 0 1 1 0 0 1 0 1)
+(vector 13 4.1211657406183 #r(0 0 0 0 0 0 1 1 0 0 1 0 1)
- 3.525309 #(0.000000 1.051846 0.170520 1.635159 0.455907 1.511384 -0.147127 1.055447 1.000548 0.097871 0.005880 0.160672 0.616896)
- 3.525164 #(0.000000 0.947554 1.827637 0.362791 1.540717 0.485315 0.143016 0.940517 0.994364 1.896615 -0.012058 1.833412 1.375539)
- 3.525069 #(0.000000 0.947187 1.827546 0.362752 1.541123 0.485247 0.142279 0.941021 0.994821 1.896143 -0.012766 1.832600 1.375866)
+ 3.525309 #r(0.000000 1.051846 0.170520 1.635159 0.455907 1.511384 -0.147127 1.055447 1.000548 0.097871 0.005880 0.160672 0.616896)
+ 3.525164 #r(0.000000 0.947554 1.827637 0.362791 1.540717 0.485315 0.143016 0.940517 0.994364 1.896615 -0.012058 1.833412 1.375539)
+ 3.525069 #r(0.000000 0.947187 1.827546 0.362752 1.541123 0.485247 0.142279 0.941021 0.994821 1.896143 -0.012766 1.832600 1.375866)
;; tstall (flip odds):
- 3.5254909 #(0.000000 0.051846 0.170520 0.635159 0.455907 0.511384 -0.147127 0.055447 1.000548 1.097871 0.005880 1.160672 0.616896)
+ 3.5254909 #r(0.000000 0.051846 0.170520 0.635159 0.455907 0.511384 -0.147127 0.055447 1.000548 1.097871 0.005880 1.160672 0.616896)
- 3.525038 #(0.000000 0.946517 1.827042 0.361916 1.539603 0.484426 0.141403 0.938505 0.992273 1.893878 -0.015423 1.830018 1.372777)
- 3.524879 #(0.000000 0.948502 1.829668 0.364984 1.544240 0.488687 0.147763 0.945396 1.000061 1.903153 -0.004551 1.840699 1.384079)
- 3.524127 #(0.000000 0.948325 1.829839 0.364837 1.544231 0.489035 0.147691 0.944940 1.000036 1.902764 -0.004752 1.840449 1.384160)
+ 3.525038 #r(0.000000 0.946517 1.827042 0.361916 1.539603 0.484426 0.141403 0.938505 0.992273 1.893878 -0.015423 1.830018 1.372777)
+ 3.524879 #r(0.000000 0.948502 1.829668 0.364984 1.544240 0.488687 0.147763 0.945396 1.000061 1.903153 -0.004551 1.840699 1.384079)
+ 3.524127 #r(0.000000 0.948325 1.829839 0.364837 1.544231 0.489035 0.147691 0.944940 1.000036 1.902764 -0.004752 1.840449 1.384160)
;; others:
- 3.52549096213107 #(0.0 1.948154 1.82948 1.364841 1.544093 1.488616 0.147127 1.944553 0.999452 0.902129 1.99412 0.839328 1.383104)
- 3.52549096875855 #(0.0 0.948154 1.82948 0.364841 1.544093 0.488616 0.147127 0.944553 0.999452 1.902129 1.99412 1.839328 1.383104)
- 3.52549096484103 #(0.0 0.051846 0.17052 0.63516 0.455907 0.511384 -0.147127 0.055447 1.000548 1.097871 0.00588 1.160672 0.616896)
+ 3.52549096213107 #r(0.0 1.948154 1.82948 1.364841 1.544093 1.488616 0.147127 1.944553 0.999452 0.902129 1.99412 0.839328 1.383104)
+ 3.52549096875855 #r(0.0 0.948154 1.82948 0.364841 1.544093 0.488616 0.147127 0.944553 0.999452 1.902129 1.99412 1.839328 1.383104)
+ 3.52549096484103 #r(0.0 0.051846 0.17052 0.63516 0.455907 0.511384 -0.147127 0.055447 1.000548 1.097871 0.00588 1.160672 0.616896)
;; pp:
- 3.850623 #(0.000000 0.969515 0.236902 1.700081 1.532485 1.012414 0.716276 0.879825 0.831162 1.111747 1.357361 -0.014630 0.962342)
+ 3.850623 #r(0.000000 0.969515 0.236902 1.700081 1.532485 1.012414 0.716276 0.879825 0.831162 1.111747 1.357361 -0.014630 0.962342)
;; random runs:
- 3.548466 #(0.000000 0.145104 0.529448 0.690774 0.918949 0.803743 0.300955 0.527094 1.381692 -0.078636 0.898029 0.095477 1.535845)
- 3.551952 #(0.000000 0.200284 0.556001 0.721731 0.948469 0.867294 0.332298 0.608081 1.523631 -0.027439 1.029613 0.233328 1.650494)
- 3.565324 #(0.000000 1.479692 0.716290 0.470867 1.057103 -0.084215 -0.738273 -0.085308 0.431895 0.677280 0.250455 0.062101 0.461117)
+ 3.548466 #r(0.000000 0.145104 0.529448 0.690774 0.918949 0.803743 0.300955 0.527094 1.381692 -0.078636 0.898029 0.095477 1.535845)
+ 3.551952 #r(0.000000 0.200284 0.556001 0.721731 0.948469 0.867294 0.332298 0.608081 1.523631 -0.027439 1.029613 0.233328 1.650494)
+ 3.565324 #r(0.000000 1.479692 0.716290 0.470867 1.057103 -0.084215 -0.738273 -0.085308 0.431895 0.677280 0.250455 0.062101 0.461117)
)
;;; 14 all -------------------------------------------------------------------------------- ; 3.7416
-(vector 14 4.1603193984251 #(0 1 0 1 1 0 1 0 0 0 1 0 0 0)
+(vector 14 4.1603193984251 #r(0 1 0 1 1 0 1 0 0 0 1 0 0 0)
- 3.613280 #(0.000000 0.028982 0.530538 0.496734 -0.474935 -0.580078 0.104750 1.488617 -0.565757 -0.157842 -1.258035 -0.057079 0.253472 -0.294346)
- 3.613121 #(0.000000 0.028974 0.530453 0.496128 -0.475742 -0.580534 0.104588 -0.512201 1.433649 1.841085 0.741103 -0.058374 0.252301 -0.295482)
- 3.612244 #(0.000000 0.028654 0.530107 0.495786 -0.476137 -0.581023 0.103729 -0.513152 1.433095 1.840437 0.739729 -0.059420 0.251093 -0.296875)
+ 3.613280 #r(0.000000 0.028982 0.530538 0.496734 -0.474935 -0.580078 0.104750 1.488617 -0.565757 -0.157842 -1.258035 -0.057079 0.253472 -0.294346)
+ 3.613121 #r(0.000000 0.028974 0.530453 0.496128 -0.475742 -0.580534 0.104588 -0.512201 1.433649 1.841085 0.741103 -0.058374 0.252301 -0.295482)
+ 3.612244 #r(0.000000 0.028654 0.530107 0.495786 -0.476137 -0.581023 0.103729 -0.513152 1.433095 1.840437 0.739729 -0.059420 0.251093 -0.296875)
;; pp:
- 3.738333 #(0.000000 0.876144 1.749283 0.255257 1.233908 0.925717 1.713300 0.790918 0.423428 0.079568 -0.060539 0.064404 0.601933 0.291808)
+ 3.738333 #r(0.000000 0.876144 1.749283 0.255257 1.233908 0.925717 1.713300 0.790918 0.423428 0.079568 -0.060539 0.064404 0.601933 0.291808)
;; others:
- 3.612481978033266 #(0.0 0.971346 1.469893 0.504214 0.476137 1.581023 1.896271 1.513152 0.566905 1.159563 1.260271 1.05942 1.748907 1.296875)
- 3.612481989948184 #(0.0 1.971346 1.469893 1.504214 0.476137 0.581023 1.896271 0.513152 0.566905 0.159563 1.260271 0.05942 1.748907 0.296875)
- 3.612481914145143 #(0.0 1.028654 0.530107 1.495786 -0.476137 0.418977 0.103729 0.486848 1.433095 0.840437 0.739729 0.94058 0.251093 0.703125)
+ 3.612481978033266 #r(0.0 0.971346 1.469893 0.504214 0.476137 1.581023 1.896271 1.513152 0.566905 1.159563 1.260271 1.05942 1.748907 1.296875)
+ 3.612481989948184 #r(0.0 1.971346 1.469893 1.504214 0.476137 0.581023 1.896271 0.513152 0.566905 0.159563 1.260271 0.05942 1.748907 0.296875)
+ 3.612481914145143 #r(0.0 1.028654 0.530107 1.495786 -0.476137 0.418977 0.103729 0.486848 1.433095 0.840437 0.739729 0.94058 0.251093 0.703125)
;; random runs:
- 3.650982 #(0.000000 0.112109 0.601952 0.789556 0.321827 0.641689 1.325218 0.620188 0.862204 0.131948 1.628685 0.381668 1.695079 1.331292)
- 3.672439 #(0.000000 1.298581 0.470888 1.081624 -0.056336 1.648423 0.916941 0.524303 1.082817 1.859457 0.055963 1.803632 1.767059 0.115666)
- 3.727206 #(0.000000 1.840981 0.831398 1.214172 0.497021 1.582168 0.468315 0.998613 1.548880 1.565691 1.193536 -0.412758 1.463929 0.679465)
+ 3.650982 #r(0.000000 0.112109 0.601952 0.789556 0.321827 0.641689 1.325218 0.620188 0.862204 0.131948 1.628685 0.381668 1.695079 1.331292)
+ 3.672439 #r(0.000000 1.298581 0.470888 1.081624 -0.056336 1.648423 0.916941 0.524303 1.082817 1.859457 0.055963 1.803632 1.767059 0.115666)
+ 3.727206 #r(0.000000 1.840981 0.831398 1.214172 0.497021 1.582168 0.468315 0.998613 1.548880 1.565691 1.193536 -0.412758 1.463929 0.679465)
)
;;; 15 all -------------------------------------------------------------------------------- ; 3.8729
-(vector 15 4.4060654286219 #(0 1 0 1 0 1 1 1 1 1 0 1 1 0 0) ; 3.87298 (3.8729833462074)
+(vector 15 4.4060654286219 #r(0 1 0 1 0 1 1 1 1 1 0 1 1 0 0) ; 3.87298 (3.8729833462074)
- 3.768991 #(0.000000 0.863434 1.069349 1.651266 0.272078 0.287377 1.735528 1.050008 0.997192 -0.020076 1.092043 1.658049 1.188297 1.641481 1.391589)
- 3.768033 #(0.000000 0.863152 1.069135 1.651353 0.271851 0.287255 1.735115 1.049678 0.996877 -0.020587 1.091869 1.657562 1.187769 1.641176 1.391193)
+ 3.768991 #r(0.000000 0.863434 1.069349 1.651266 0.272078 0.287377 1.735528 1.050008 0.997192 -0.020076 1.092043 1.658049 1.188297 1.641481 1.391589)
+ 3.768033 #r(0.000000 0.863152 1.069135 1.651353 0.271851 0.287255 1.735115 1.049678 0.996877 -0.020587 1.091869 1.657562 1.187769 1.641176 1.391193)
;; pp:
- 3.859726 #(0.000000 0.426404 1.082257 -0.378600 0.672681 0.084435 0.794375 -0.135830 -0.492292 -0.747360 0.439828 0.395595 0.865535 0.672400 -1.271921)
+ 3.859726 #r(0.000000 0.426404 1.082257 -0.378600 0.672681 0.084435 0.794375 -0.135830 -0.492292 -0.747360 0.439828 0.395595 0.865535 0.672400 -1.271921)
)
;;; 16 all --------------------------------------------------------------------------------
-(vector 16 4.5445760745314 #(0 1 1 0 1 0 1 0 0 0 1 1 0 0 0 0)
+(vector 16 4.5445760745314 #r(0 1 1 0 1 0 1 0 0 0 1 1 0 0 0 0)
- 3.875080 #(0.000000 0.730612 0.678979 1.195144 1.632126 1.276744 -0.008560 1.467028 0.525375 0.204869 -0.166129 -0.115302 1.317856 1.622654 0.244306 1.412402)
- 3.873760 #(0.000000 0.727564 0.672436 1.188603 1.622426 1.266314 -0.018679 1.451325 0.507181 0.185750 -0.189066 -0.140317 1.293402 1.595942 0.216437 1.382779)
+ 3.875080 #r(0.000000 0.730612 0.678979 1.195144 1.632126 1.276744 -0.008560 1.467028 0.525375 0.204869 -0.166129 -0.115302 1.317856 1.622654 0.244306 1.412402)
+ 3.873760 #r(0.000000 0.727564 0.672436 1.188603 1.622426 1.266314 -0.018679 1.451325 0.507181 0.185750 -0.189066 -0.140317 1.293402 1.595942 0.216437 1.382779)
;; pp:
- 3.898248 #(0.000000 0.999637 1.627971 0.563839 1.354119 0.602036 1.818873 1.125095 0.889883 0.658070 0.547416 0.178002 0.696357 0.711221 1.277932 1.486763)
+ 3.898248 #r(0.000000 0.999637 1.627971 0.563839 1.354119 0.602036 1.818873 1.125095 0.889883 0.658070 0.547416 0.178002 0.696357 0.711221 1.277932 1.486763)
)
;;; 17 all -------------------------------------------------------------------------------- ; 4.1231
-(vector 17 4.7654988506492 #(0 0 0 0 1 1 0 1 0 0 1 1 1 0 1 1 1)
+(vector 17 4.7654988506492 #r(0 0 0 0 1 1 0 1 0 0 1 1 1 0 1 1 1)
- 3.981459 #(0.000000 0.520484 1.429480 0.505816 -0.891395 0.114390 0.146335 0.416197 0.938893 0.898753 0.507264 0.650687 -0.081499 -0.607990 0.213218 -0.096782 -0.652476)
- 3.980210 #(0.000000 0.519908 1.429364 0.506455 -0.889349 0.115888 0.147799 0.418944 0.941982 0.901488 0.510707 0.653289 -0.078010 -0.603698 0.217190 -0.091931 -0.646982)
+ 3.981459 #r(0.000000 0.520484 1.429480 0.505816 -0.891395 0.114390 0.146335 0.416197 0.938893 0.898753 0.507264 0.650687 -0.081499 -0.607990 0.213218 -0.096782 -0.652476)
+ 3.980210 #r(0.000000 0.519908 1.429364 0.506455 -0.889349 0.115888 0.147799 0.418944 0.941982 0.901488 0.510707 0.653289 -0.078010 -0.603698 0.217190 -0.091931 -0.646982)
;; pp:
- 4.025451 #(0.000000 0.806442 1.640772 0.524823 1.518315 0.179778 1.375417 0.889535 -0.006539 1.626695 1.126057 1.328368 0.940320 1.091090 1.265244 1.868967 -0.027469)
+ 4.025451 #r(0.000000 0.806442 1.640772 0.524823 1.518315 0.179778 1.375417 0.889535 -0.006539 1.626695 1.126057 1.328368 0.940320 1.091090 1.265244 1.868967 -0.027469)
)
;;; 18 all -------------------------------------------------------------------------------- ; 4.24264
-(vector 18 4.795 #(0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 0 1 0)
+(vector 18 4.795 #r(0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 0 1 0)
- 4.145376 #(0.000000 0.815970 1.442468 0.022437 0.838057 0.561089 1.647234 0.678944 1.711039 1.021597 1.327383 0.016884 -0.030470 1.937927 0.480054 1.947188 1.779952 1.482341)
- 4.139748 #(0.000000 0.841029 1.468092 0.061368 0.883567 0.618102 1.726318 0.769330 1.807136 1.123961 1.445068 0.140416 0.092314 0.077559 0.642622 0.110176 1.960387 1.676428)
- 4.139675 #(0.000000 0.843694 1.471411 0.063968 0.889446 0.622071 1.732660 0.775711 1.815657 1.135238 1.453657 0.151363 0.100548 0.088867 0.654716 0.119261 -0.025900 1.692198)
+ 4.145376 #r(0.000000 0.815970 1.442468 0.022437 0.838057 0.561089 1.647234 0.678944 1.711039 1.021597 1.327383 0.016884 -0.030470 1.937927 0.480054 1.947188 1.779952 1.482341)
+ 4.139748 #r(0.000000 0.841029 1.468092 0.061368 0.883567 0.618102 1.726318 0.769330 1.807136 1.123961 1.445068 0.140416 0.092314 0.077559 0.642622 0.110176 1.960387 1.676428)
+ 4.139675 #r(0.000000 0.843694 1.471411 0.063968 0.889446 0.622071 1.732660 0.775711 1.815657 1.135238 1.453657 0.151363 0.100548 0.088867 0.654716 0.119261 -0.025900 1.692198)
)
;;; 19 all -------------------------------------------------------------------------------- ; 4.35889
-(vector 19 4.957 #(0 1 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1)
+(vector 19 4.957 #r(0 1 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1)
- 4.220950 #(0.000000 0.963878 0.724427 1.142775 1.347933 0.681634 0.858134 1.165699 1.071759 -0.202310 0.544201 1.698473 0.575529 0.392352 1.327300 -0.513540 0.980505 1.004716 0.307249)
- 4.218225 #(0.000000 0.975837 0.737298 1.163191 1.372213 0.708367 0.893430 1.205301 1.114000 -0.155007 0.595375 1.754296 0.630178 0.457584 1.398341 -0.439927 1.059040 1.087418 0.391362)
+ 4.220950 #r(0.000000 0.963878 0.724427 1.142775 1.347933 0.681634 0.858134 1.165699 1.071759 -0.202310 0.544201 1.698473 0.575529 0.392352 1.327300 -0.513540 0.980505 1.004716 0.307249)
+ 4.218225 #r(0.000000 0.975837 0.737298 1.163191 1.372213 0.708367 0.893430 1.205301 1.114000 -0.155007 0.595375 1.754296 0.630178 0.457584 1.398341 -0.439927 1.059040 1.087418 0.391362)
;; pp:
- 4.321309 #(0.000000 0.745098 1.155175 -0.037958 0.532342 1.473567 0.665377 -0.049708 1.767937 0.914818 -0.119772 -0.388406 1.775638 1.206519 1.079401 1.118695 1.930701 1.737887 -0.008406)
+ 4.321309 #r(0.000000 0.745098 1.155175 -0.037958 0.532342 1.473567 0.665377 -0.049708 1.767937 0.914818 -0.119772 -0.388406 1.775638 1.206519 1.079401 1.118695 1.930701 1.737887 -0.008406)
;; 20 - 1
- 4.368453 #(0.000000 1.547665 1.565484 -0.064501 -0.355088 0.488366 0.392690 -0.094784 0.724088 1.208934 0.016380 0.236409 -0.498288 1.627216 1.538939 0.284041 1.423487 0.812330 1.368338)
+ 4.368453 #r(0.000000 1.547665 1.565484 -0.064501 -0.355088 0.488366 0.392690 -0.094784 0.724088 1.208934 0.016380 0.236409 -0.498288 1.627216 1.538939 0.284041 1.423487 0.812330 1.368338)
)
;;; 20 all -------------------------------------------------------------------------------- ; 4.4721
-(vector 20 5.202707605727 #(0 0 0 0 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0)
+(vector 20 5.202707605727 #r(0 0 0 0 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0)
- 4.288981 #(0.000000 1.288096 1.467454 -0.169090 1.858403 0.280935 0.217741 -0.031571 0.876318 1.220549 0.027164 0.381448 1.736192 1.508757 1.292734 0.007137 1.225400 0.645757 1.237414 0.420948)
- 4.288007 #(0.000000 1.310045 1.497604 -0.134812 -0.097725 0.328441 0.281976 0.032570 0.953720 1.303826 0.111501 0.480774 -0.149523 1.625674 1.415263 0.146621 1.360870 0.796858 1.390400 0.590613)
- 4.287958 #(0.000000 1.307843 1.492560 -0.136998 -0.104073 0.320652 0.273544 0.026577 0.942663 1.293828 0.101160 0.467007 -0.161748 1.610386 1.399614 0.127790 1.342419 0.775594 1.372823 0.570440)
+ 4.288981 #r(0.000000 1.288096 1.467454 -0.169090 1.858403 0.280935 0.217741 -0.031571 0.876318 1.220549 0.027164 0.381448 1.736192 1.508757 1.292734 0.007137 1.225400 0.645757 1.237414 0.420948)
+ 4.288007 #r(0.000000 1.310045 1.497604 -0.134812 -0.097725 0.328441 0.281976 0.032570 0.953720 1.303826 0.111501 0.480774 -0.149523 1.625674 1.415263 0.146621 1.360870 0.796858 1.390400 0.590613)
+ 4.287958 #r(0.000000 1.307843 1.492560 -0.136998 -0.104073 0.320652 0.273544 0.026577 0.942663 1.293828 0.101160 0.467007 -0.161748 1.610386 1.399614 0.127790 1.342419 0.775594 1.372823 0.570440)
;; pp:
- 4.467948 #(0.000000 0.926509 1.348679 0.244038 1.242002 0.019828 1.173056 0.068338 1.504010 1.041584 0.276603 1.806452 1.767012 1.665479 1.374797 1.361818 1.827476 0.132481 0.796064 0.727142)
+ 4.467948 #r(0.000000 0.926509 1.348679 0.244038 1.242002 0.019828 1.173056 0.068338 1.504010 1.041584 0.276603 1.806452 1.767012 1.665479 1.374797 1.361818 1.827476 0.132481 0.796064 0.727142)
;; random runs:
- 4.373082 #(0.000000 1.736543 0.590014 1.257228 0.334821 0.741756 0.000141 0.933820 1.343880 -0.194453 0.086640 0.579672 0.170191 -0.135507 0.196326 1.615939 0.150737 -0.099336 1.018007 0.681284)
- 4.391790 #(0.000000 0.479270 0.750624 0.806661 0.057204 -0.463791 0.651494 0.232581 0.978315 0.716505 0.027486 0.118399 -0.244751 -0.223933 0.200251 0.798723 -0.077942 -1.206866 -0.599515 -1.192337)
+ 4.373082 #r(0.000000 1.736543 0.590014 1.257228 0.334821 0.741756 0.000141 0.933820 1.343880 -0.194453 0.086640 0.579672 0.170191 -0.135507 0.196326 1.615939 0.150737 -0.099336 1.018007 0.681284)
+ 4.391790 #r(0.000000 0.479270 0.750624 0.806661 0.057204 -0.463791 0.651494 0.232581 0.978315 0.716505 0.027486 0.118399 -0.244751 -0.223933 0.200251 0.798723 -0.077942 -1.206866 -0.599515 -1.192337)
)
;;; 21 all -------------------------------------------------------------------------------- ; 4.5825
-(vector 21 5.3164971341632 #(0 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 0 0 0 1 0)
+(vector 21 5.3164971341632 #r(0 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 0 0 0 1 0)
- 4.482399 #(0.000000 1.397497 1.231727 1.288294 -0.006341 1.417563 -0.224775 1.544084 0.158820 1.058039 0.318600 1.788531 1.041209 0.988222 1.527762 0.536397 0.600751 0.298693 0.721205 1.590350 -0.083320)
+ 4.482399 #r(0.000000 1.397497 1.231727 1.288294 -0.006341 1.417563 -0.224775 1.544084 0.158820 1.058039 0.318600 1.788531 1.041209 0.988222 1.527762 0.536397 0.600751 0.298693 0.721205 1.590350 -0.083320)
;; pp:
- 4.574194 #(0.000000 0.830108 1.212818 -0.114835 0.663864 1.570276 0.585550 1.478198 0.603181 0.202958 1.649503 0.901982 0.255866 0.012434 0.019243 -0.386770 -0.332788 -0.375429 0.023280 0.553342 0.478240)
+ 4.574194 #r(0.000000 0.830108 1.212818 -0.114835 0.663864 1.570276 0.585550 1.478198 0.603181 0.202958 1.649503 0.901982 0.255866 0.012434 0.019243 -0.386770 -0.332788 -0.375429 0.023280 0.553342 0.478240)
;;20+1
- 4.466298 #(0.000000 0.909097 0.238169 0.468983 0.883242 -0.050068 0.873199 0.299129 0.119990 0.693144 0.718516 0.626261 1.588601 1.027074 -0.097623 0.296983 1.533310 -0.381362 -0.344831 0.732964 0.856609)
- 4.446059 #(0.000000 0.180019 0.218530 0.984925 -0.958137 -0.620910 0.483363 0.553272 0.541028 -0.013728 0.552503 0.454333 1.235179 -1.297121 0.258699 -0.559729 -0.469061 0.813196 -0.429872 0.235309 -0.551694)
- 4.442505 #(0.000000 0.229264 0.300308 1.095021 -0.794869 -0.465067 0.642830 0.761336 0.766200 0.262204 0.844388 0.785992 1.557676 -0.940794 0.628826 -0.139027 -0.056712 1.215181 0.022101 0.740212 -0.084960)
+ 4.466298 #r(0.000000 0.909097 0.238169 0.468983 0.883242 -0.050068 0.873199 0.299129 0.119990 0.693144 0.718516 0.626261 1.588601 1.027074 -0.097623 0.296983 1.533310 -0.381362 -0.344831 0.732964 0.856609)
+ 4.446059 #r(0.000000 0.180019 0.218530 0.984925 -0.958137 -0.620910 0.483363 0.553272 0.541028 -0.013728 0.552503 0.454333 1.235179 -1.297121 0.258699 -0.559729 -0.469061 0.813196 -0.429872 0.235309 -0.551694)
+ 4.442505 #r(0.000000 0.229264 0.300308 1.095021 -0.794869 -0.465067 0.642830 0.761336 0.766200 0.262204 0.844388 0.785992 1.557676 -0.940794 0.628826 -0.139027 -0.056712 1.215181 0.022101 0.740212 -0.084960)
)
;;; 22 all -------------------------------------------------------------------------------- ; 4.6904
-(vector 22 5.292244006282 #(0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 0 1 0 1 0)
+(vector 22 5.292244006282 #r(0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 0 1 0 1 0)
- 4.586632 #(0.000000 -0.097347 1.080504 0.590888 -0.253961 1.023423 0.714156 1.899465 -0.021982 0.277218 1.158938 0.994197 1.053415 1.055197 1.429563 0.904330 0.879709 1.421582 0.356096 1.550705 0.340822 1.056446)
+ 4.586632 #r(0.000000 -0.097347 1.080504 0.590888 -0.253961 1.023423 0.714156 1.899465 -0.021982 0.277218 1.158938 0.994197 1.053415 1.055197 1.429563 0.904330 0.879709 1.421582 0.356096 1.550705 0.340822 1.056446)
;; pp:
- 4.652382 #(0.000000 0.770633 1.384088 0.317715 1.400813 0.382294 1.252492 0.280512 1.930558 1.151783 0.690579 0.045402 0.011035 1.255532 1.463333 1.386585 0.797105 0.928163 1.091040 1.178341 1.461782 1.888245)
+ 4.652382 #r(0.000000 0.770633 1.384088 0.317715 1.400813 0.382294 1.252492 0.280512 1.930558 1.151783 0.690579 0.045402 0.011035 1.255532 1.463333 1.386585 0.797105 0.928163 1.091040 1.178341 1.461782 1.888245)
;; 20+2
- 4.571664 #(0.000000 1.311821 0.851164 0.580547 0.048402 1.274604 0.456442 1.682804 0.779139 1.627033 1.074351 1.013793 0.652224 0.595232 0.638584 1.055905 1.176957 1.287858 0.085124 0.572185 1.547525 0.045133)
- 4.539850 #(0.000000 1.877088 1.220531 0.766350 0.912511 -0.049264 -0.015453 1.476348 0.128719 1.226510 1.377381 1.241269 1.228768 0.089299 1.482606 0.589500 -0.172007 0.157776 0.679537 0.684018 -0.353829 0.532234)
+ 4.571664 #r(0.000000 1.311821 0.851164 0.580547 0.048402 1.274604 0.456442 1.682804 0.779139 1.627033 1.074351 1.013793 0.652224 0.595232 0.638584 1.055905 1.176957 1.287858 0.085124 0.572185 1.547525 0.045133)
+ 4.539850 #r(0.000000 1.877088 1.220531 0.766350 0.912511 -0.049264 -0.015453 1.476348 0.128719 1.226510 1.377381 1.241269 1.228768 0.089299 1.482606 0.589500 -0.172007 0.157776 0.679537 0.684018 -0.353829 0.532234)
)
;;; 23 all -------------------------------------------------------------------------------- ; 4.7958
-(vector 23 5.3592889520338 #(0 0 1 1 0 1 1 0 0 1 1 1 1 0 0 1 0 1 0 1 1 1 1)
+(vector 23 5.3592889520338 #r(0 0 1 1 0 1 1 0 0 1 1 1 1 0 0 1 0 1 0 1 1 1 1)
- 4.605166 #(0.000000 0.690307 -0.223703 0.265767 1.214689 0.913389 0.192629 1.489393 1.370656 0.848931 0.362934 0.592228 0.586290 0.001276 1.085398 1.699229 1.577973 0.044583 0.292577 1.343812 0.079208 -0.074880 0.197817)
- 4.603716 #(0.000000 0.728519 -0.170578 0.343467 1.289714 1.021005 0.302988 1.638069 1.530207 1.013139 0.545865 0.789599 0.817820 0.223908 1.348504 -0.016545 -0.131209 0.351331 0.607617 -0.321862 0.423879 0.291671 0.585222)
+ 4.605166 #r(0.000000 0.690307 -0.223703 0.265767 1.214689 0.913389 0.192629 1.489393 1.370656 0.848931 0.362934 0.592228 0.586290 0.001276 1.085398 1.699229 1.577973 0.044583 0.292577 1.343812 0.079208 -0.074880 0.197817)
+ 4.603716 #r(0.000000 0.728519 -0.170578 0.343467 1.289714 1.021005 0.302988 1.638069 1.530207 1.013139 0.545865 0.789599 0.817820 0.223908 1.348504 -0.016545 -0.131209 0.351331 0.607617 -0.321862 0.423879 0.291671 0.585222)
;; pp:
- 4.710615 #(0.000000 0.902511 1.536988 0.243249 1.001545 1.634662 0.695827 1.858861 0.975507 -0.294658 1.045533 0.585569 -0.187029 1.386517 1.153500 1.032794 1.102165 0.705294 0.968823 1.234672 1.719694 1.916952 0.231307)
+ 4.710615 #r(0.000000 0.902511 1.536988 0.243249 1.001545 1.634662 0.695827 1.858861 0.975507 -0.294658 1.045533 0.585569 -0.187029 1.386517 1.153500 1.032794 1.102165 0.705294 0.968823 1.234672 1.719694 1.916952 0.231307)
)
;;; 24 all -------------------------------------------------------------------------------- ; 4.89897
-(vector 24 5.6358969066981 #(0 0 0 1 0 1 1 1 0 0 0 1 1 0 1 1 1 1 1 1 0 1 1 0)
+(vector 24 5.6358969066981 #r(0 0 0 1 0 1 1 1 0 0 0 1 1 0 1 1 1 1 1 1 0 1 1 0)
- 4.728042 #(0.000000 1.858980 1.366314 1.303093 0.303565 0.363906 -0.013052 0.288365 1.150614 1.733252 0.305478 1.054343 0.956930 0.688496 0.150610 0.766590 0.723928 0.358579 1.444965 0.475911 1.678841 0.331630 0.146133 0.753447)
+ 4.728042 #r(0.000000 1.858980 1.366314 1.303093 0.303565 0.363906 -0.013052 0.288365 1.150614 1.733252 0.305478 1.054343 0.956930 0.688496 0.150610 0.766590 0.723928 0.358579 1.444965 0.475911 1.678841 0.331630 0.146133 0.753447)
;; pp:
- 4.889570 #(0.000000 0.652535 1.042108 0.029625 0.992596 0.108788 0.963358 1.727152 1.075228 0.458712 1.655013 0.983185 0.212822 0.044079 1.553136 1.514188 1.228593 0.684074 0.951192 1.149281 1.171121 1.382495 1.676492 0.457795)
+ 4.889570 #r(0.000000 0.652535 1.042108 0.029625 0.992596 0.108788 0.963358 1.727152 1.075228 0.458712 1.655013 0.983185 0.212822 0.044079 1.553136 1.514188 1.228593 0.684074 0.951192 1.149281 1.171121 1.382495 1.676492 0.457795)
;; 23+1
- 4.797502 #(0.000000 0.815912 -0.489010 0.238747 0.464672 -0.791156 -0.258728 1.104213 0.634676 0.636859 0.115975 -0.179694 0.187452 -0.818880 0.261843 -0.587852 -0.717075 0.590119 -0.373998 0.804963 -0.982681 -0.821174 -0.611885 -0.513579)
+ 4.797502 #r(0.000000 0.815912 -0.489010 0.238747 0.464672 -0.791156 -0.258728 1.104213 0.634676 0.636859 0.115975 -0.179694 0.187452 -0.818880 0.261843 -0.587852 -0.717075 0.590119 -0.373998 0.804963 -0.982681 -0.821174 -0.611885 -0.513579)
)
;;; 25 all -------------------------------------------------------------------------------- ; 5
-(vector 25 5.6488965032573 #(0 1 0 1 1 0 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 1 0)
+(vector 25 5.6488965032573 #r(0 1 0 1 1 0 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 1 0)
- 4.852860 #(0.000000 0.230967 1.727317 0.450764 0.017370 0.018890 0.465256 0.875082 0.612377 0.658132 0.067557 0.830777 0.581695 -0.075473 -0.106051 1.748399 0.582315 0.898509 1.395989 0.676438 1.853985 1.350704 1.785330 0.662329 1.015229)
+ 4.852860 #r(0.000000 0.230967 1.727317 0.450764 0.017370 0.018890 0.465256 0.875082 0.612377 0.658132 0.067557 0.830777 0.581695 -0.075473 -0.106051 1.748399 0.582315 0.898509 1.395989 0.676438 1.853985 1.350704 1.785330 0.662329 1.015229)
;; pp:
- 4.921362 #(0.000000 0.851508 1.100092 -0.096894 0.569229 1.392351 1.000621 -0.034780 0.968948 0.124084 0.790431 -0.082333 0.100565 1.032584 0.439519 0.313536 0.111622 0.176204 1.585564 1.488261 0.160713 -0.042818 0.611461 0.760689 0.720307)
+ 4.921362 #r(0.000000 0.851508 1.100092 -0.096894 0.569229 1.392351 1.000621 -0.034780 0.968948 0.124084 0.790431 -0.082333 0.100565 1.032584 0.439519 0.313536 0.111622 0.176204 1.585564 1.488261 0.160713 -0.042818 0.611461 0.760689 0.720307)
;; 24+1?
- 4.867199 #(0.000000 0.511988 0.599074 1.109026 -0.258266 -0.311525 -0.180815 0.514703 -0.058310 0.500087 -0.447647 -1.097227 -0.392984 -0.773229 -0.739391 1.039107 0.423028 -0.118139 1.262658 1.681945 -0.043110 1.191717 1.700807 0.042704 -0.767223)
+ 4.867199 #r(0.000000 0.511988 0.599074 1.109026 -0.258266 -0.311525 -0.180815 0.514703 -0.058310 0.500087 -0.447647 -1.097227 -0.392984 -0.773229 -0.739391 1.039107 0.423028 -0.118139 1.262658 1.681945 -0.043110 1.191717 1.700807 0.042704 -0.767223)
)
;;; 26 all -------------------------------------------------------------------------------- ; 5.0990
-(vector 26 5.7865648269653 #(0 1 0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 1 0 0)
+(vector 26 5.7865648269653 #r(0 1 0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 1 0 0)
- 5.004963 #(0.000000 0.356503 0.613044 0.799459 0.607543 -0.552567 0.275717 0.954617 0.539225 0.390115 0.747516 -0.287816 0.661916 1.821078 -0.045167 -0.217306 1.531723 0.896950 0.283527 0.968137 0.942126 0.004913 -0.474898 0.935500 1.374671 0.106691)
- 4.982437 #(0.000000 0.157773 0.357579 0.470573 0.208359 -1.095460 -0.324361 0.305853 -0.246382 -0.421030 -0.124942 -1.314179 -0.526336 0.680713 -1.271118 -1.537428 0.186315 -0.648152 -1.272801 -0.741946 -0.801258 -1.769664 -0.386094 -1.048075 -0.774396 -0.009812)
- 4.981911 #(0.000000 0.114804 0.305276 0.394495 0.122048 -1.227102 -0.469461 0.152164 -0.415952 -0.596715 -0.349375 -1.548844 -0.778154 0.402539 -1.542539 -1.840236 -0.152677 -0.992660 -1.641041 -1.138828 -1.199533 -0.219776 -0.823305 -1.512557 -1.273176 -0.520822)
+ 5.004963 #r(0.000000 0.356503 0.613044 0.799459 0.607543 -0.552567 0.275717 0.954617 0.539225 0.390115 0.747516 -0.287816 0.661916 1.821078 -0.045167 -0.217306 1.531723 0.896950 0.283527 0.968137 0.942126 0.004913 -0.474898 0.935500 1.374671 0.106691)
+ 4.982437 #r(0.000000 0.157773 0.357579 0.470573 0.208359 -1.095460 -0.324361 0.305853 -0.246382 -0.421030 -0.124942 -1.314179 -0.526336 0.680713 -1.271118 -1.537428 0.186315 -0.648152 -1.272801 -0.741946 -0.801258 -1.769664 -0.386094 -1.048075 -0.774396 -0.009812)
+ 4.981911 #r(0.000000 0.114804 0.305276 0.394495 0.122048 -1.227102 -0.469461 0.152164 -0.415952 -0.596715 -0.349375 -1.548844 -0.778154 0.402539 -1.542539 -1.840236 -0.152677 -0.992660 -1.641041 -1.138828 -1.199533 -0.219776 -0.823305 -1.512557 -1.273176 -0.520822)
;; pp:
- 5.069005 #(0.000000 0.693839 1.223177 0.171124 0.655819 1.659284 0.862412 0.167152 1.036280 0.233275 1.065043 0.332100 0.088514 1.217811 0.718617 0.463929 -0.022907 0.301609 1.664942 1.593693 1.159306 1.575199 1.658356 1.791865 0.367495 0.523068)
+ 5.069005 #r(0.000000 0.693839 1.223177 0.171124 0.655819 1.659284 0.862412 0.167152 1.036280 0.233275 1.065043 0.332100 0.088514 1.217811 0.718617 0.463929 -0.022907 0.301609 1.664942 1.593693 1.159306 1.575199 1.658356 1.791865 0.367495 0.523068)
;; 25+1
- 5.143899 #(0.000000 0.339898 1.703660 0.334703 -0.033066 0.152772 0.352050 0.937913 0.431489 0.569881 0.083296 0.920798 0.392044 -0.279901 -0.309500 1.803373 0.465037 0.973772 1.156286 0.616150 1.812432 1.192020 1.791336 0.747339 0.851095 0.182401)
+ 5.143899 #r(0.000000 0.339898 1.703660 0.334703 -0.033066 0.152772 0.352050 0.937913 0.431489 0.569881 0.083296 0.920798 0.392044 -0.279901 -0.309500 1.803373 0.465037 0.973772 1.156286 0.616150 1.812432 1.192020 1.791336 0.747339 0.851095 0.182401)
)
;;; 27 all -------------------------------------------------------------------------------- ; 5.1961
-(vector 27 5.8753981590271 #(0 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 0)
+(vector 27 5.8753981590271 #r(0 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 0)
- 5.063979 #(0.000000 1.181312 1.011523 -0.037795 0.952214 0.743188 0.046346 -0.011550 1.593930 1.829003 1.926981 0.836368 0.497093 0.820784 0.581154 1.308971 0.813642 0.203348 0.448693 0.869589 1.163120 0.319576 0.498929 -0.074366 0.820574 1.666665 0.421783)
+ 5.063979 #r(0.000000 1.181312 1.011523 -0.037795 0.952214 0.743188 0.046346 -0.011550 1.593930 1.829003 1.926981 0.836368 0.497093 0.820784 0.581154 1.308971 0.813642 0.203348 0.448693 0.869589 1.163120 0.319576 0.498929 -0.074366 0.820574 1.666665 0.421783)
;; pp:
- 5.178190 #(0.000000 0.576339 1.415874 0.213916 0.629425 1.693659 0.296051 1.239867 0.501966 1.807544 0.478176 -0.072336 1.103954 0.283214 0.269354 -0.586084 0.967552 0.762560 0.644862 0.769649 0.453206 0.327359 1.119459 1.407959 1.575398 0.090804 0.240986)
+ 5.178190 #r(0.000000 0.576339 1.415874 0.213916 0.629425 1.693659 0.296051 1.239867 0.501966 1.807544 0.478176 -0.072336 1.103954 0.283214 0.269354 -0.586084 0.967552 0.762560 0.644862 0.769649 0.453206 0.327359 1.119459 1.407959 1.575398 0.090804 0.240986)
;; 26+1
- 5.126119 #(0.000000 0.900772 1.219713 0.169043 1.065297 1.224400 0.165897 0.980264 0.050341 1.214424 0.625722 0.135385 1.464791 0.070454 0.417426 0.174034 0.437373 0.493624 0.582463 1.623009 1.820016 1.778385 0.847413 1.132593 0.293556 1.847407 0.436103)
+ 5.126119 #r(0.000000 0.900772 1.219713 0.169043 1.065297 1.224400 0.165897 0.980264 0.050341 1.214424 0.625722 0.135385 1.464791 0.070454 0.417426 0.174034 0.437373 0.493624 0.582463 1.623009 1.820016 1.778385 0.847413 1.132593 0.293556 1.847407 0.436103)
)
;;; 28 all -------------------------------------------------------------------------------- ; 5.2915
-(vector 28 6.0962085723877 #(0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 0 0 0 1 1 1)
+(vector 28 6.0962085723877 #r(0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 0 0 0 1 1 1)
- 5.157284 #(0.000000 0.613262 -0.034248 0.167107 1.753362 0.009121 1.168065 1.319935 0.754215 1.452315 0.403030 1.384036 -0.445049 1.700477 0.448730 1.102474 0.302577 0.114957 0.813938 -1.221580 0.733588 -0.228287 1.379195 0.775101 0.357079 0.863661 0.744441 -0.542730)
- 5.156726 #(0.000000 0.621583 -0.025615 0.185073 1.770611 0.035230 1.190822 1.343738 0.783921 1.481359 0.438924 1.421434 -0.401379 1.746999 0.501100 1.159948 0.364927 0.179358 0.879866 -1.146659 0.808429 -0.150109 1.458018 0.864191 0.450456 0.959743 0.840089 -0.445751)
+ 5.157284 #r(0.000000 0.613262 -0.034248 0.167107 1.753362 0.009121 1.168065 1.319935 0.754215 1.452315 0.403030 1.384036 -0.445049 1.700477 0.448730 1.102474 0.302577 0.114957 0.813938 -1.221580 0.733588 -0.228287 1.379195 0.775101 0.357079 0.863661 0.744441 -0.542730)
+ 5.156726 #r(0.000000 0.621583 -0.025615 0.185073 1.770611 0.035230 1.190822 1.343738 0.783921 1.481359 0.438924 1.421434 -0.401379 1.746999 0.501100 1.159948 0.364927 0.179358 0.879866 -1.146659 0.808429 -0.150109 1.458018 0.864191 0.450456 0.959743 0.840089 -0.445751)
;; pp:
- 5.257514 #(0.000000 0.637044 1.032618 -0.063334 0.493709 1.172496 0.265676 1.071428 0.186660 1.119263 0.450916 1.523906 0.926797 0.655305 -0.125687 1.119620 1.002091 0.595772 0.366822 0.141548 0.074245 -0.326675 0.086270 0.158575 0.648670 0.735199 1.036773 -0.335597)
+ 5.257514 #r(0.000000 0.637044 1.032618 -0.063334 0.493709 1.172496 0.265676 1.071428 0.186660 1.119263 0.450916 1.523906 0.926797 0.655305 -0.125687 1.119620 1.002091 0.595772 0.366822 0.141548 0.074245 -0.326675 0.086270 0.158575 0.648670 0.735199 1.036773 -0.335597)
)
;;; 29 all -------------------------------------------------------------------------------- ; 5.38516
-(vector 29 6.168496131897 #(0 1 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 0 1 0 1)
+(vector 29 6.168496131897 #r(0 1 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 0 1 0 1)
- 5.241325 #(0.000000 1.424549 1.434579 0.952506 0.877300 1.948583 1.592791 0.964559 0.950012 1.429458 0.788068 0.556113 0.404906 0.813692 1.604109 0.138120 0.925420 1.345282 1.048370 1.281239 1.347177 1.752489 1.781053 0.782127 0.063659 1.163981 0.330203 1.128951 1.871926)
+ 5.241325 #r(0.000000 1.424549 1.434579 0.952506 0.877300 1.948583 1.592791 0.964559 0.950012 1.429458 0.788068 0.556113 0.404906 0.813692 1.604109 0.138120 0.925420 1.345282 1.048370 1.281239 1.347177 1.752489 1.781053 0.782127 0.063659 1.163981 0.330203 1.128951 1.871926)
;; pp:
- 5.354004 #(0.000000 0.686564 1.165583 1.805539 0.645303 1.392789 0.389959 1.584227 0.184212 1.132208 0.594808 1.885153 0.760508 0.108139 1.597930 1.248057 0.449409 0.388311 -0.040221 -0.137762 0.035489 0.097197 1.554759 1.643774 1.707832 0.439164 0.286463 0.690398 1.001814)
+ 5.354004 #r(0.000000 0.686564 1.165583 1.805539 0.645303 1.392789 0.389959 1.584227 0.184212 1.132208 0.594808 1.885153 0.760508 0.108139 1.597930 1.248057 0.449409 0.388311 -0.040221 -0.137762 0.035489 0.097197 1.554759 1.643774 1.707832 0.439164 0.286463 0.690398 1.001814)
;; 28+1
- 5.309949 #(0.000000 0.846874 0.241547 0.392668 0.105733 0.593095 -0.055728 1.769258 1.471201 0.259232 1.487017 0.394902 0.593301 0.594134 1.608339 0.527615 1.618053 1.488443 0.038033 0.264977 0.515061 1.719999 1.612303 0.816240 0.367893 0.553084 0.901271 1.615714 0.762730)
+ 5.309949 #r(0.000000 0.846874 0.241547 0.392668 0.105733 0.593095 -0.055728 1.769258 1.471201 0.259232 1.487017 0.394902 0.593301 0.594134 1.608339 0.527615 1.618053 1.488443 0.038033 0.264977 0.515061 1.719999 1.612303 0.816240 0.367893 0.553084 0.901271 1.615714 0.762730)
)
;;; 30 all -------------------------------------------------------------------------------- ; 5.4772
-(vector 30 6.257221698761 #(0 1 0 1 1 1 1 0 0 1 0 0 0 1 1 0 0 1 1 0 1 0 0 1 1 1 1 1 0 1)
+(vector 30 6.257221698761 #r(0 1 0 1 1 1 1 0 0 1 0 0 0 1 1 0 0 1 1 0 1 0 0 1 1 1 1 1 0 1)
- 5.361273 #(0.000000 1.372797 0.670580 1.057136 -0.495516 0.360919 0.095174 0.542106 0.748047 0.327246 -0.458569 -0.196062 0.499790 0.195141 -0.041091 1.640040 0.876134 1.017379 1.243023 0.157336 0.532420 -0.270945 0.222972 -0.454366 0.519190 0.206280 0.985739 0.329627 0.782987 0.753526)
+ 5.361273 #r(0.000000 1.372797 0.670580 1.057136 -0.495516 0.360919 0.095174 0.542106 0.748047 0.327246 -0.458569 -0.196062 0.499790 0.195141 -0.041091 1.640040 0.876134 1.017379 1.243023 0.157336 0.532420 -0.270945 0.222972 -0.454366 0.519190 0.206280 0.985739 0.329627 0.782987 0.753526)
;; pp:
- 5.457123 #(0.000000 0.579295 1.086489 0.271361 0.351869 1.393293 0.343724 1.326421 0.262824 0.711061 0.185497 1.430027 0.435525 0.024911 1.289605 1.541120 0.534068 0.426466 1.770822 1.448308 1.691046 1.363221 0.940381 1.411829 1.232407 1.698674 -0.061281 0.480912 0.397265 0.093509)
- 5.457522 #(0.000000 0.180374 0.737535 -0.629271 -0.119582 0.936316 1.168308 1.717509 -0.402864 -0.373354 0.211140 0.477066 1.180570 -1.170786 0.943217 0.201779 -0.611919 0.922150 1.095538 0.984255 -0.262406 0.845304 1.611083 0.846240 0.705768 -0.037782 -0.632928 0.048519 -0.449702 1.337980)
+ 5.457123 #r(0.000000 0.579295 1.086489 0.271361 0.351869 1.393293 0.343724 1.326421 0.262824 0.711061 0.185497 1.430027 0.435525 0.024911 1.289605 1.541120 0.534068 0.426466 1.770822 1.448308 1.691046 1.363221 0.940381 1.411829 1.232407 1.698674 -0.061281 0.480912 0.397265 0.093509)
+ 5.457522 #r(0.000000 0.180374 0.737535 -0.629271 -0.119582 0.936316 1.168308 1.717509 -0.402864 -0.373354 0.211140 0.477066 1.180570 -1.170786 0.943217 0.201779 -0.611919 0.922150 1.095538 0.984255 -0.262406 0.845304 1.611083 0.846240 0.705768 -0.037782 -0.632928 0.048519 -0.449702 1.337980)
;; 29+1
- 5.407828 #(0.000000 1.401096 1.376571 1.008941 1.027589 -0.085696 1.660515 0.983168 0.985870 1.410812 0.796458 0.476205 0.194328 1.091142 1.765086 0.052662 1.081109 1.265325 0.992243 1.285402 1.599846 1.557990 0.374401 1.559263 0.508151 1.671660 0.671171 1.718845 -0.085252 0.533771)
+ 5.407828 #r(0.000000 1.401096 1.376571 1.008941 1.027589 -0.085696 1.660515 0.983168 0.985870 1.410812 0.796458 0.476205 0.194328 1.091142 1.765086 0.052662 1.081109 1.265325 0.992243 1.285402 1.599846 1.557990 0.374401 1.559263 0.508151 1.671660 0.671171 1.718845 -0.085252 0.533771)
)
;;; 31 all -------------------------------------------------------------------------------- ; 5.56776
-(vector 31 6.3243918418884 #(0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1)
+(vector 31 6.3243918418884 #r(0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1)
- 5.479252 #(0.000000 1.715332 0.740879 1.282120 0.005121 1.133820 1.648029 0.843835 0.870127 0.362478 -0.012264 1.508703 0.898921 1.010311 1.653601 0.519170 0.543334 0.643526 1.650052 0.937580 0.006302 1.745072 0.413200 1.629321 0.671152 0.807947 1.140772 1.157434 0.674253 1.101147 1.176272)
- 5.478665 #(0.000000 1.772425 0.803174 1.328405 0.081611 1.219664 1.725421 0.969769 1.009467 0.524607 0.150580 1.691934 1.088386 1.212688 1.849460 0.777872 0.785597 0.893510 -0.072450 1.225337 0.333131 0.071155 0.764064 0.012661 1.020004 1.202423 1.541822 1.587594 1.095956 1.541832 1.635240)
+ 5.479252 #r(0.000000 1.715332 0.740879 1.282120 0.005121 1.133820 1.648029 0.843835 0.870127 0.362478 -0.012264 1.508703 0.898921 1.010311 1.653601 0.519170 0.543334 0.643526 1.650052 0.937580 0.006302 1.745072 0.413200 1.629321 0.671152 0.807947 1.140772 1.157434 0.674253 1.101147 1.176272)
+ 5.478665 #r(0.000000 1.772425 0.803174 1.328405 0.081611 1.219664 1.725421 0.969769 1.009467 0.524607 0.150580 1.691934 1.088386 1.212688 1.849460 0.777872 0.785597 0.893510 -0.072450 1.225337 0.333131 0.071155 0.764064 0.012661 1.020004 1.202423 1.541822 1.587594 1.095956 1.541832 1.635240)
- 5.457715 #(0.000000 0.335441 1.084827 0.018253 0.737437 1.328926 0.232615 1.324648 1.548727 1.102230 0.582938 0.356482 1.414652 1.240061 0.257198 0.650632 1.787556 1.748026 -0.020851 0.033891 1.146224 0.784975 1.568424 1.015644 1.832440 -0.392011 -0.347982 -0.739222 -0.325456 -0.578410 0.397608)
- 5.453054 #(0.000000 0.330034 1.062392 -0.018048 0.701747 1.293007 0.182311 1.269874 1.478913 1.017407 0.501409 0.269712 1.315062 1.138628 0.142159 0.526931 -0.345056 1.613950 -0.162150 -0.111306 0.991533 0.609140 1.408136 0.828750 1.658057 -0.598529 -0.552356 -0.936876 -0.551564 -0.796775 0.156224)
+ 5.457715 #r(0.000000 0.335441 1.084827 0.018253 0.737437 1.328926 0.232615 1.324648 1.548727 1.102230 0.582938 0.356482 1.414652 1.240061 0.257198 0.650632 1.787556 1.748026 -0.020851 0.033891 1.146224 0.784975 1.568424 1.015644 1.832440 -0.392011 -0.347982 -0.739222 -0.325456 -0.578410 0.397608)
+ 5.453054 #r(0.000000 0.330034 1.062392 -0.018048 0.701747 1.293007 0.182311 1.269874 1.478913 1.017407 0.501409 0.269712 1.315062 1.138628 0.142159 0.526931 -0.345056 1.613950 -0.162150 -0.111306 0.991533 0.609140 1.408136 0.828750 1.658057 -0.598529 -0.552356 -0.936876 -0.551564 -0.796775 0.156224)
;; pp:
- 5.506117 #(0.000000 0.677676 1.291605 1.787569 0.657442 1.382372 0.087522 0.893379 -0.050356 0.800441 -0.050934 1.224977 0.724031 1.793437 1.031051 0.628566 0.200527 1.931215 1.228105 1.043046 0.856098 0.884359 0.667113 1.148772 0.506576 0.784927 0.816254 1.304861 1.786988 1.852001 0.224722)
+ 5.506117 #r(0.000000 0.677676 1.291605 1.787569 0.657442 1.382372 0.087522 0.893379 -0.050356 0.800441 -0.050934 1.224977 0.724031 1.793437 1.031051 0.628566 0.200527 1.931215 1.228105 1.043046 0.856098 0.884359 0.667113 1.148772 0.506576 0.784927 0.816254 1.304861 1.786988 1.852001 0.224722)
;;; 30+1
- 5.550882 #(0.000000 1.425022 0.538933 1.069581 -0.597930 0.307695 0.154011 0.587861 0.779449 0.144783 -0.543105 -0.308223 0.381009 0.256948 -0.103754 1.614961 0.898101 1.043268 1.242618 0.013120 0.441700 -0.261691 0.222365 -0.327392 0.395779 0.143572 0.965764 0.164756 0.636599 0.716823 0.000189)
+ 5.550882 #r(0.000000 1.425022 0.538933 1.069581 -0.597930 0.307695 0.154011 0.587861 0.779449 0.144783 -0.543105 -0.308223 0.381009 0.256948 -0.103754 1.614961 0.898101 1.043268 1.242618 0.013120 0.441700 -0.261691 0.222365 -0.327392 0.395779 0.143572 0.965764 0.164756 0.636599 0.716823 0.000189)
)
;;; 32 all -------------------------------------------------------------------------------- ; 5.65685
-(vector 32 6.4451498985291 #(0 0 0 0 0 0 0 0 1 1 0 1 0 0 1 0 0 0 1 1 0 1 1 0 0 0 1 1 1 0 1 0)
+(vector 32 6.4451498985291 #r(0 0 0 0 0 0 0 0 1 1 0 1 0 0 1 0 0 0 1 1 0 1 1 0 0 0 1 1 1 0 1 0)
- 5.525650 #(0.000000 -0.351133 1.293972 -0.243467 0.375774 0.341597 0.388720 0.121948 0.157486 1.353778 0.236182 0.278745 0.140738 1.315014 1.717753 1.193420 1.734782 1.635830 0.448546 0.657631 0.934238 0.325644 1.910640 1.330301 0.498135 1.394503 1.747576 0.388629 0.706077 0.075100 0.832948 -0.013902)
+ 5.525650 #r(0.000000 -0.351133 1.293972 -0.243467 0.375774 0.341597 0.388720 0.121948 0.157486 1.353778 0.236182 0.278745 0.140738 1.315014 1.717753 1.193420 1.734782 1.635830 0.448546 0.657631 0.934238 0.325644 1.910640 1.330301 0.498135 1.394503 1.747576 0.388629 0.706077 0.075100 0.832948 -0.013902)
;; pp:
- 5.604748 #(0.000000 0.799811 1.174111 -0.060224 0.824446 1.499635 0.054636 1.116026 0.103247 0.980855 0.143722 1.410098 0.567912 -0.275862 1.109567 0.582020 0.052513 1.796805 1.346558 0.470148 0.633702 0.311062 0.341355 0.120966 0.347342 -0.087220 -0.235617 0.166536 0.617003 0.982789 1.015963 1.699479)
+ 5.604748 #r(0.000000 0.799811 1.174111 -0.060224 0.824446 1.499635 0.054636 1.116026 0.103247 0.980855 0.143722 1.410098 0.567912 -0.275862 1.109567 0.582020 0.052513 1.796805 1.346558 0.470148 0.633702 0.311062 0.341355 0.120966 0.347342 -0.087220 -0.235617 0.166536 0.617003 0.982789 1.015963 1.699479)
)
;;; 33 all -------------------------------------------------------------------------------- ; 5.74456
-(vector 33 6.5579299926758 #(0 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 1 0 0 0 0)
+(vector 33 6.5579299926758 #r(0 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 1 0 0 0 0)
- 5.631190 #(0.000000 0.097616 0.529848 0.847242 0.662939 0.833596 1.914696 0.035703 0.153599 0.327398 1.407575 -0.021932 0.932495 1.243452 0.370234 0.653095 -0.062589 1.855791 0.441043 0.248847 0.782346 0.465080 -0.161731 0.929949 0.594824 1.321736 1.693332 1.192619 0.260596 1.271517 1.690356 1.109725 0.567421)
- 5.610410 #(0.000000 0.121938 0.577637 0.964946 0.701543 0.945275 0.057342 0.144831 0.337733 0.549414 1.625058 0.265950 1.238074 1.576246 0.724815 0.984490 0.297228 0.251221 0.699155 0.548588 1.186306 0.951889 0.285802 1.345917 1.014217 1.823546 0.088927 1.726245 0.867511 1.795939 0.286630 1.739958 1.218430)
- 5.608483 #(0.000000 0.127672 0.575757 0.971725 0.693309 0.950898 0.070948 0.160557 0.341181 0.560186 1.645087 0.281844 1.260852 1.598287 0.730804 1.014936 0.316122 0.275621 0.725241 0.597914 1.221833 0.996203 0.324966 1.372541 1.062261 1.875167 0.130133 1.748519 0.894847 1.849289 0.335743 1.776799 1.261232)
+ 5.631190 #r(0.000000 0.097616 0.529848 0.847242 0.662939 0.833596 1.914696 0.035703 0.153599 0.327398 1.407575 -0.021932 0.932495 1.243452 0.370234 0.653095 -0.062589 1.855791 0.441043 0.248847 0.782346 0.465080 -0.161731 0.929949 0.594824 1.321736 1.693332 1.192619 0.260596 1.271517 1.690356 1.109725 0.567421)
+ 5.610410 #r(0.000000 0.121938 0.577637 0.964946 0.701543 0.945275 0.057342 0.144831 0.337733 0.549414 1.625058 0.265950 1.238074 1.576246 0.724815 0.984490 0.297228 0.251221 0.699155 0.548588 1.186306 0.951889 0.285802 1.345917 1.014217 1.823546 0.088927 1.726245 0.867511 1.795939 0.286630 1.739958 1.218430)
+ 5.608483 #r(0.000000 0.127672 0.575757 0.971725 0.693309 0.950898 0.070948 0.160557 0.341181 0.560186 1.645087 0.281844 1.260852 1.598287 0.730804 1.014936 0.316122 0.275621 0.725241 0.597914 1.221833 0.996203 0.324966 1.372541 1.062261 1.875167 0.130133 1.748519 0.894847 1.849289 0.335743 1.776799 1.261232)
;; pp:
- 5.744046 #(0.000000 0.648617 1.091146 -0.080415 0.482263 1.100917 0.071191 1.062577 0.109918 0.836095 -0.052549 1.287445 0.382948 1.391104 0.926942 0.308725 1.631613 0.947331 0.900375 0.124874 0.064712 1.506574 1.488794 1.444593 1.476988 1.247778 1.089616 1.639634 -0.152998 -0.001330 0.434944 0.915078 0.903432)
+ 5.744046 #r(0.000000 0.648617 1.091146 -0.080415 0.482263 1.100917 0.071191 1.062577 0.109918 0.836095 -0.052549 1.287445 0.382948 1.391104 0.926942 0.308725 1.631613 0.947331 0.900375 0.124874 0.064712 1.506574 1.488794 1.444593 1.476988 1.247778 1.089616 1.639634 -0.152998 -0.001330 0.434944 0.915078 0.903432)
;; 32+1
- 5.661968 #(0.000000 -0.352238 1.421554 -0.062497 0.287660 0.210756 0.410931 0.134572 0.285343 1.484578 0.353937 0.356204 0.097780 1.509309 1.823077 1.336946 1.794210 1.915189 0.597192 0.803204 1.197066 0.523451 0.168550 1.601444 0.858978 1.682815 0.027376 0.555153 1.077928 0.275560 1.108578 0.224908 -0.307634)
+ 5.661968 #r(0.000000 -0.352238 1.421554 -0.062497 0.287660 0.210756 0.410931 0.134572 0.285343 1.484578 0.353937 0.356204 0.097780 1.509309 1.823077 1.336946 1.794210 1.915189 0.597192 0.803204 1.197066 0.523451 0.168550 1.601444 0.858978 1.682815 0.027376 0.555153 1.077928 0.275560 1.108578 0.224908 -0.307634)
)
;;; 34 all -------------------------------------------------------------------------------- ; 5.8309518
-(vector 34 6.6782836914062 #(0 0 1 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 0 0 0)
+(vector 34 6.6782836914062 #r(0 0 1 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 0 0 0)
- 5.716435 #(0.000000 1.537850 0.239691 0.279680 1.093753 0.273847 0.872235 1.496985 1.522928 0.760723 1.655491 0.025814 1.234543 0.204722 1.320964 0.722548 0.795411 1.810303 1.109323 1.456118 1.072015 0.656715 1.724740 1.409441 -0.521616 1.350972 1.541354 1.489386 0.627886 0.677049 0.878489 -0.127150 -0.020441 0.557443)
- 5.715522 #(0.000000 1.535834 0.312631 0.280224 1.148017 0.182965 0.826725 1.571414 1.581831 0.887796 1.704031 0.067574 1.286355 0.321441 1.363349 0.812149 0.980936 1.891675 1.179822 1.532746 1.177536 0.667908 1.925108 1.578399 -0.430841 1.453028 1.642459 1.613448 0.724642 0.739942 1.051391 0.000286 0.024547 0.665325)
- 5.715061 #(0.000000 1.557376 0.316186 0.303275 1.175381 0.206598 0.863890 1.615342 1.613470 0.958427 1.750728 0.111536 1.351364 0.386942 1.439281 0.903963 1.075401 -0.020759 1.279610 1.643520 1.269919 0.800947 0.050818 1.687932 -0.298939 1.577236 -0.205754 -0.244682 0.852707 0.888744 1.194917 0.175251 0.202437 0.844132)
+ 5.716435 #r(0.000000 1.537850 0.239691 0.279680 1.093753 0.273847 0.872235 1.496985 1.522928 0.760723 1.655491 0.025814 1.234543 0.204722 1.320964 0.722548 0.795411 1.810303 1.109323 1.456118 1.072015 0.656715 1.724740 1.409441 -0.521616 1.350972 1.541354 1.489386 0.627886 0.677049 0.878489 -0.127150 -0.020441 0.557443)
+ 5.715522 #r(0.000000 1.535834 0.312631 0.280224 1.148017 0.182965 0.826725 1.571414 1.581831 0.887796 1.704031 0.067574 1.286355 0.321441 1.363349 0.812149 0.980936 1.891675 1.179822 1.532746 1.177536 0.667908 1.925108 1.578399 -0.430841 1.453028 1.642459 1.613448 0.724642 0.739942 1.051391 0.000286 0.024547 0.665325)
+ 5.715061 #r(0.000000 1.557376 0.316186 0.303275 1.175381 0.206598 0.863890 1.615342 1.613470 0.958427 1.750728 0.111536 1.351364 0.386942 1.439281 0.903963 1.075401 -0.020759 1.279610 1.643520 1.269919 0.800947 0.050818 1.687932 -0.298939 1.577236 -0.205754 -0.244682 0.852707 0.888744 1.194917 0.175251 0.202437 0.844132)
;; pp:
- 5.801677 #(0.000000 0.960590 1.230620 -0.161839 0.543814 1.323075 0.313096 0.853533 -0.212153 1.135960 -0.100861 0.915755 0.332189 1.257774 0.850007 0.263168 1.528284 0.501744 0.475602 -0.081405 1.503307 1.166122 1.260528 0.746339 0.481380 0.722221 0.959406 1.108477 0.637618 0.962601 1.236659 1.273002 -0.011533 0.165609)
+ 5.801677 #r(0.000000 0.960590 1.230620 -0.161839 0.543814 1.323075 0.313096 0.853533 -0.212153 1.135960 -0.100861 0.915755 0.332189 1.257774 0.850007 0.263168 1.528284 0.501744 0.475602 -0.081405 1.503307 1.166122 1.260528 0.746339 0.481380 0.722221 0.959406 1.108477 0.637618 0.962601 1.236659 1.273002 -0.011533 0.165609)
)
;;; 35 all -------------------------------------------------------------------------------- ; 5.9160
-(vector 35 6.7637429237366 #(0 1 1 0 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0)
+(vector 35 6.7637429237366 #r(0 1 1 0 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0)
- 5.764294 #(0.000000 0.100183 1.398707 0.822554 1.459800 0.154045 1.619372 1.535907 1.542373 0.876004 1.322076 1.293113 1.412723 0.146555 1.058946 0.645359 1.390817 1.072269 0.132103 0.365169 1.845456 1.487696 0.791518 1.753949 0.991873 1.205376 0.200418 -0.166259 0.161894 -0.021712 0.362318 0.686081 1.632970 0.565468 0.901578)
- 5.761550 #(0.000000 0.109331 1.415904 0.863973 1.504657 0.200254 1.669142 1.598436 1.595369 0.964840 1.410141 1.378302 1.505772 0.261951 1.178950 0.757734 1.524984 1.223665 0.264922 0.531725 0.000853 1.660270 0.971853 -0.071328 1.201271 1.414050 0.409445 0.053601 0.377052 0.191601 0.609357 0.945758 -0.105595 0.829816 1.179558)
+ 5.764294 #r(0.000000 0.100183 1.398707 0.822554 1.459800 0.154045 1.619372 1.535907 1.542373 0.876004 1.322076 1.293113 1.412723 0.146555 1.058946 0.645359 1.390817 1.072269 0.132103 0.365169 1.845456 1.487696 0.791518 1.753949 0.991873 1.205376 0.200418 -0.166259 0.161894 -0.021712 0.362318 0.686081 1.632970 0.565468 0.901578)
+ 5.761550 #r(0.000000 0.109331 1.415904 0.863973 1.504657 0.200254 1.669142 1.598436 1.595369 0.964840 1.410141 1.378302 1.505772 0.261951 1.178950 0.757734 1.524984 1.223665 0.264922 0.531725 0.000853 1.660270 0.971853 -0.071328 1.201271 1.414050 0.409445 0.053601 0.377052 0.191601 0.609357 0.945758 -0.105595 0.829816 1.179558)
;; pp:
- 5.895826 #(0.000000 0.643741 1.250469 1.867865 0.530176 1.122535 0.024737 1.205120 0.194580 0.988315 1.702722 0.964190 0.348453 1.456006 0.520276 -0.302930 1.556990 0.638548 -0.211365 1.748454 1.424618 0.940371 0.466444 0.212559 0.146415 0.251126 0.228984 -0.138555 0.352126 0.459061 0.664909 1.353503 1.665947 1.723726 0.002732)
+ 5.895826 #r(0.000000 0.643741 1.250469 1.867865 0.530176 1.122535 0.024737 1.205120 0.194580 0.988315 1.702722 0.964190 0.348453 1.456006 0.520276 -0.302930 1.556990 0.638548 -0.211365 1.748454 1.424618 0.940371 0.466444 0.212559 0.146415 0.251126 0.228984 -0.138555 0.352126 0.459061 0.664909 1.353503 1.665947 1.723726 0.002732)
)
;;; 36 all -------------------------------------------------------------------------------- ; 6
-(vector 36 6.8008880615234 #(0 0 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1)
+(vector 36 6.8008880615234 #r(0 0 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1)
- 5.926043 #(0.000000 1.020111 0.677817 0.140140 0.932921 0.775557 0.190635 1.853238 0.762697 0.237889 0.277245 0.161572 1.553054 0.008070 0.283378 1.674361 -0.347149 0.590912 0.944213 0.823255 0.043034 -0.091562 0.229555 1.352871 0.981843 0.171776 0.581947 0.691871 1.000348 0.829120 1.162722 1.690975 0.634924 1.730234 0.452876 1.429867)
+ 5.926043 #r(0.000000 1.020111 0.677817 0.140140 0.932921 0.775557 0.190635 1.853238 0.762697 0.237889 0.277245 0.161572 1.553054 0.008070 0.283378 1.674361 -0.347149 0.590912 0.944213 0.823255 0.043034 -0.091562 0.229555 1.352871 0.981843 0.171776 0.581947 0.691871 1.000348 0.829120 1.162722 1.690975 0.634924 1.730234 0.452876 1.429867)
;; pp:
- 5.876240 #(0.000000 0.880722 1.509714 0.204909 0.817303 1.618536 0.560409 1.279749 0.308262 -0.524358 0.395653 -0.826907 0.386964 -0.034537 1.535549 1.090154 0.375322 1.512598 1.132860 1.558960 0.892393 0.587406 0.099621 0.325394 -0.086852 -0.097620 -0.036583 0.411674 0.423371 -0.013442 0.469946 0.536299 1.271922 -0.393606 -0.170370 0.277903)
- 5.872670 #(0.000000 1.008642 1.468259 0.136066 0.832884 1.675080 0.561995 1.215779 0.176163 -0.645512 0.301135 -0.915574 0.346533 -0.147416 1.414097 1.167654 0.437921 1.345264 1.026772 1.438289 0.848806 0.422687 -0.153016 0.254467 -0.256778 -0.257882 -0.180820 0.369974 0.206740 -0.196159 0.361067 0.357334 1.155902 -0.541647 -0.334470 0.076521)
- 5.871695 #(0.000000 0.976078 1.428851 0.077798 0.772784 1.602082 0.472100 1.111861 0.058266 -0.754466 0.191131 -1.049850 0.189192 -0.311703 1.251680 0.977617 0.232753 1.137715 0.806190 1.201023 0.616244 0.157943 -0.415443 -0.020130 -0.548605 -0.551223 -0.509170 0.040073 -0.121612 -0.560043 -0.007571 -0.025396 0.766768 -0.951503 -0.743309 -0.341165)
+ 5.876240 #r(0.000000 0.880722 1.509714 0.204909 0.817303 1.618536 0.560409 1.279749 0.308262 -0.524358 0.395653 -0.826907 0.386964 -0.034537 1.535549 1.090154 0.375322 1.512598 1.132860 1.558960 0.892393 0.587406 0.099621 0.325394 -0.086852 -0.097620 -0.036583 0.411674 0.423371 -0.013442 0.469946 0.536299 1.271922 -0.393606 -0.170370 0.277903)
+ 5.872670 #r(0.000000 1.008642 1.468259 0.136066 0.832884 1.675080 0.561995 1.215779 0.176163 -0.645512 0.301135 -0.915574 0.346533 -0.147416 1.414097 1.167654 0.437921 1.345264 1.026772 1.438289 0.848806 0.422687 -0.153016 0.254467 -0.256778 -0.257882 -0.180820 0.369974 0.206740 -0.196159 0.361067 0.357334 1.155902 -0.541647 -0.334470 0.076521)
+ 5.871695 #r(0.000000 0.976078 1.428851 0.077798 0.772784 1.602082 0.472100 1.111861 0.058266 -0.754466 0.191131 -1.049850 0.189192 -0.311703 1.251680 0.977617 0.232753 1.137715 0.806190 1.201023 0.616244 0.157943 -0.415443 -0.020130 -0.548605 -0.551223 -0.509170 0.040073 -0.121612 -0.560043 -0.007571 -0.025396 0.766768 -0.951503 -0.743309 -0.341165)
;; 35+1
- 5.968866 #(0.000000 0.133611 1.230434 0.841852 1.312856 0.529755 1.370310 1.332590 1.580324 0.930341 1.428865 1.755052 1.561249 -0.230712 1.582178 0.486609 1.188339 0.984457 0.043840 -0.015979 -0.155552 1.235391 0.874947 1.643065 1.184316 0.952918 0.543242 -0.381983 0.458292 0.068269 0.575524 0.723748 -0.044728 0.683083 1.573491 0.035965)
+ 5.968866 #r(0.000000 0.133611 1.230434 0.841852 1.312856 0.529755 1.370310 1.332590 1.580324 0.930341 1.428865 1.755052 1.561249 -0.230712 1.582178 0.486609 1.188339 0.984457 0.043840 -0.015979 -0.155552 1.235391 0.874947 1.643065 1.184316 0.952918 0.543242 -0.381983 0.458292 0.068269 0.575524 0.723748 -0.044728 0.683083 1.573491 0.035965)
)
;;; 37 all -------------------------------------------------------------------------------- ; 6.0827
-(vector 37 7.0251078605652 #(0 0 0 0 1 0 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 0 0 0 1 0 0 0 0 1 0 1 0 0 0)
+(vector 37 7.0251078605652 #r(0 0 0 0 1 0 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 0 0 0 1 0 0 0 0 1 0 1 0 0 0)
- 5.927989 #(0.000000 1.362671 1.825924 0.295316 1.739841 1.835463 1.048945 1.351967 0.301179 0.388225 1.780488 1.534131 0.435239 0.318363 -0.101295 0.220840 0.998360 1.646237 1.362259 0.730890 0.388056 1.327874 0.110340 1.924981 0.324484 0.429209 1.542714 0.665030 0.018148 0.321441 1.812097 0.446891 1.633693 1.056009 1.344989 1.426723 1.818561)
- 5.918646 #(0.000000 1.276868 1.775826 0.292236 1.788221 1.829337 1.043839 1.351449 0.259082 0.375705 1.700935 1.487286 0.337951 0.306327 -0.126317 0.091444 0.949870 1.546870 1.374856 0.654967 0.351723 1.285561 0.074903 1.824326 0.227704 0.400930 1.466430 0.609151 0.009920 0.222861 1.672440 0.383746 1.542055 1.018281 1.254945 1.323042 1.739217)
- 5.918139 #(0.000000 1.268085 1.769551 0.285066 1.784410 1.812873 1.034440 1.342674 0.256292 0.366678 1.679577 1.477236 0.317949 0.294007 -0.148484 0.067735 0.925643 1.526359 1.349946 0.624511 0.326721 1.258438 0.049695 1.798322 0.189031 0.360477 1.435009 0.581192 -0.024865 0.191624 1.638560 0.341145 1.503234 0.980493 1.208657 1.269237 1.688696)
+ 5.927989 #r(0.000000 1.362671 1.825924 0.295316 1.739841 1.835463 1.048945 1.351967 0.301179 0.388225 1.780488 1.534131 0.435239 0.318363 -0.101295 0.220840 0.998360 1.646237 1.362259 0.730890 0.388056 1.327874 0.110340 1.924981 0.324484 0.429209 1.542714 0.665030 0.018148 0.321441 1.812097 0.446891 1.633693 1.056009 1.344989 1.426723 1.818561)
+ 5.918646 #r(0.000000 1.276868 1.775826 0.292236 1.788221 1.829337 1.043839 1.351449 0.259082 0.375705 1.700935 1.487286 0.337951 0.306327 -0.126317 0.091444 0.949870 1.546870 1.374856 0.654967 0.351723 1.285561 0.074903 1.824326 0.227704 0.400930 1.466430 0.609151 0.009920 0.222861 1.672440 0.383746 1.542055 1.018281 1.254945 1.323042 1.739217)
+ 5.918139 #r(0.000000 1.268085 1.769551 0.285066 1.784410 1.812873 1.034440 1.342674 0.256292 0.366678 1.679577 1.477236 0.317949 0.294007 -0.148484 0.067735 0.925643 1.526359 1.349946 0.624511 0.326721 1.258438 0.049695 1.798322 0.189031 0.360477 1.435009 0.581192 -0.024865 0.191624 1.638560 0.341145 1.503234 0.980493 1.208657 1.269237 1.688696)
;; pp:
- 5.974361 #(0.000000 0.722538 1.156373 1.818176 0.424359 1.001884 -0.224545 0.967675 0.089627 0.943734 -0.013572 0.947114 1.914887 1.102823 0.609766 -0.045075 0.989242 0.549752 1.615428 1.344389 0.949028 0.684491 0.483044 1.586745 1.704247 1.024089 1.360720 1.162825 1.209506 1.208578 0.870877 1.201701 1.782696 0.290706 0.253842 0.466340 0.855161)
+ 5.974361 #r(0.000000 0.722538 1.156373 1.818176 0.424359 1.001884 -0.224545 0.967675 0.089627 0.943734 -0.013572 0.947114 1.914887 1.102823 0.609766 -0.045075 0.989242 0.549752 1.615428 1.344389 0.949028 0.684491 0.483044 1.586745 1.704247 1.024089 1.360720 1.162825 1.209506 1.208578 0.870877 1.201701 1.782696 0.290706 0.253842 0.466340 0.855161)
)
;;; 38 all -------------------------------------------------------------------------------- ; 6.1644
-(vector 38 7.0688242912292 #(0 0 1 1 0 1 0 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0)
+(vector 38 7.0688242912292 #r(0 0 1 1 0 1 0 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0)
- 6.106333 #(0.000000 0.434523 1.232452 1.590516 0.836713 0.138216 -0.095509 1.537371 0.469612 0.772082 0.748819 1.723571 1.820323 0.854103 0.903800 0.048646 1.316356 0.369282 0.213334 0.798970 0.966914 1.376827 0.274641 1.618764 1.873131 -0.092091 -0.470518 1.150403 0.773945 1.198395 0.586433 1.306012 0.434228 0.963298 1.320012 1.145313 0.975992 1.528312)
+ 6.106333 #r(0.000000 0.434523 1.232452 1.590516 0.836713 0.138216 -0.095509 1.537371 0.469612 0.772082 0.748819 1.723571 1.820323 0.854103 0.903800 0.048646 1.316356 0.369282 0.213334 0.798970 0.966914 1.376827 0.274641 1.618764 1.873131 -0.092091 -0.470518 1.150403 0.773945 1.198395 0.586433 1.306012 0.434228 0.963298 1.320012 1.145313 0.975992 1.528312)
;; pp:
- 6.069129 #(0.000000 0.353204 1.147865 -0.165608 0.617213 1.415461 0.231168 1.083939 0.117365 0.131316 1.707213 1.274701 0.816253 0.960543 -0.063212 0.270965 1.418066 0.902830 1.619238 0.591718 0.977208 0.940720 1.787513 0.746703 0.165197 1.177699 0.830675 1.652814 1.371740 1.118022 1.133381 1.232097 1.370669 1.218425 0.194971 -0.026100 0.615354 0.750336)
+ 6.069129 #r(0.000000 0.353204 1.147865 -0.165608 0.617213 1.415461 0.231168 1.083939 0.117365 0.131316 1.707213 1.274701 0.816253 0.960543 -0.063212 0.270965 1.418066 0.902830 1.619238 0.591718 0.977208 0.940720 1.787513 0.746703 0.165197 1.177699 0.830675 1.652814 1.371740 1.118022 1.133381 1.232097 1.370669 1.218425 0.194971 -0.026100 0.615354 0.750336)
;; 37+1
- 6.055823 #(0.000000 1.140317 1.804958 0.269386 1.581973 1.647143 0.908514 1.357676 0.255360 0.413319 1.759464 1.403831 0.462290 0.275768 -0.260643 0.081477 0.945988 1.674168 1.558839 0.619719 0.448569 1.181188 0.261467 0.173066 0.317765 0.523175 1.483135 0.623965 0.065573 0.279749 1.647027 0.558187 1.546480 1.177439 1.567967 1.574734 1.849511 0.049835)
+ 6.055823 #r(0.000000 1.140317 1.804958 0.269386 1.581973 1.647143 0.908514 1.357676 0.255360 0.413319 1.759464 1.403831 0.462290 0.275768 -0.260643 0.081477 0.945988 1.674168 1.558839 0.619719 0.448569 1.181188 0.261467 0.173066 0.317765 0.523175 1.483135 0.623965 0.065573 0.279749 1.647027 0.558187 1.546480 1.177439 1.567967 1.574734 1.849511 0.049835)
)
;;; 39 all -------------------------------------------------------------------------------- ; 6.2449
-(vector 39 7.1506487936623 #(0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 0 0 1)
+(vector 39 7.1506487936623 #r(0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 0 0 1)
- 6.123916 #(0.000000 0.040215 0.172894 1.637830 1.177239 0.763654 -0.119272 0.532576 0.565933 -0.105342 -0.131500 0.223610 0.603849 1.034619 1.719874 1.942807 1.262885 -0.012239 1.521972 1.205939 0.909582 1.593149 1.660841 1.495691 0.901808 0.173365 0.594080 1.535985 0.099680 1.416781 0.772460 -0.143795 1.283054 1.611294 1.560252 0.291114 1.497861 0.152708 0.428638)
- 6.123617 #(0.000000 0.022194 0.139382 1.578109 1.109939 0.686598 -0.209261 0.437705 0.449420 -0.232701 -0.273875 0.070822 0.433690 0.853619 1.527629 -0.258054 1.050086 -0.235174 1.275677 0.950078 0.647199 1.303772 1.358361 1.189190 0.591278 -0.165906 0.244128 1.187114 -0.273717 1.031390 0.371517 -0.540240 0.858520 1.177992 1.114387 -0.172733 1.027118 -0.340480 -0.076231)
+ 6.123916 #r(0.000000 0.040215 0.172894 1.637830 1.177239 0.763654 -0.119272 0.532576 0.565933 -0.105342 -0.131500 0.223610 0.603849 1.034619 1.719874 1.942807 1.262885 -0.012239 1.521972 1.205939 0.909582 1.593149 1.660841 1.495691 0.901808 0.173365 0.594080 1.535985 0.099680 1.416781 0.772460 -0.143795 1.283054 1.611294 1.560252 0.291114 1.497861 0.152708 0.428638)
+ 6.123617 #r(0.000000 0.022194 0.139382 1.578109 1.109939 0.686598 -0.209261 0.437705 0.449420 -0.232701 -0.273875 0.070822 0.433690 0.853619 1.527629 -0.258054 1.050086 -0.235174 1.275677 0.950078 0.647199 1.303772 1.358361 1.189190 0.591278 -0.165906 0.244128 1.187114 -0.273717 1.031390 0.371517 -0.540240 0.858520 1.177992 1.114387 -0.172733 1.027118 -0.340480 -0.076231)
;; pp:
- 6.206556 #(0.000000 0.714125 0.999676 1.714571 0.529099 1.103279 1.739177 0.796762 1.681925 0.899057 1.703669 0.970830 1.925662 0.861561 -0.048288 1.636413 0.684994 0.118298 1.376444 0.590000 0.292657 1.963808 1.418598 1.344996 0.647105 0.610362 0.012866 0.209613 -0.013687 0.186819 0.011104 -0.022072 0.158390 0.584179 1.099029 1.037543 1.650004 1.749468 0.443068)
+ 6.206556 #r(0.000000 0.714125 0.999676 1.714571 0.529099 1.103279 1.739177 0.796762 1.681925 0.899057 1.703669 0.970830 1.925662 0.861561 -0.048288 1.636413 0.684994 0.118298 1.376444 0.590000 0.292657 1.963808 1.418598 1.344996 0.647105 0.610362 0.012866 0.209613 -0.013687 0.186819 0.011104 -0.022072 0.158390 0.584179 1.099029 1.037543 1.650004 1.749468 0.443068)
)
;;; 40 all -------------------------------------------------------------------------------- ; 6.3245
-(vector 40 7.3913831710815 #(0 1 0 1 0 1 0 0 0 1 1 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 0 1 1 1 1 0 0 0 1 0 0 0 0 0)
+(vector 40 7.3913831710815 #r(0 1 0 1 0 1 0 0 0 1 1 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 0 1 1 1 1 0 0 0 1 0 0 0 0 0)
- 6.288342 #(0.000000 1.454424 1.336242 0.229719 0.982419 1.371484 1.659070 1.721074 -0.039860 0.456961 0.523564 1.259764 0.318922 0.087125 -0.000634 1.738216 -0.345360 -0.093074 0.023146 0.160891 -0.147874 1.232278 0.789559 0.888228 0.482450 1.447335 0.166012 1.058063 1.516605 1.834071 1.250289 0.562291 1.417730 1.678824 0.619402 -0.109426 1.547164 0.339656 1.224949 0.726676)
+ 6.288342 #r(0.000000 1.454424 1.336242 0.229719 0.982419 1.371484 1.659070 1.721074 -0.039860 0.456961 0.523564 1.259764 0.318922 0.087125 -0.000634 1.738216 -0.345360 -0.093074 0.023146 0.160891 -0.147874 1.232278 0.789559 0.888228 0.482450 1.447335 0.166012 1.058063 1.516605 1.834071 1.250289 0.562291 1.417730 1.678824 0.619402 -0.109426 1.547164 0.339656 1.224949 0.726676)
;; pp.scm using (+ pi (/ pi 40)) and (- (/ pi 2))
- 6.236401 #(0.000000 0.772219 1.201231 0.091963 0.183059 1.041989 1.811758 0.387321 1.330915 0.336134 1.429758 0.457811 -0.040075 1.279315 -0.162113 0.993833 0.310259 1.390530 1.133639 0.515117 -0.283405 1.239507 1.056859 0.563309 0.888313 0.077823 -0.241421 1.625166 1.389376 1.528163 1.539643 1.801710 1.314626 1.482031 0.189224 0.088532 0.546429 0.832570 1.329921 1.394636)
+ 6.236401 #r(0.000000 0.772219 1.201231 0.091963 0.183059 1.041989 1.811758 0.387321 1.330915 0.336134 1.429758 0.457811 -0.040075 1.279315 -0.162113 0.993833 0.310259 1.390530 1.133639 0.515117 -0.283405 1.239507 1.056859 0.563309 0.888313 0.077823 -0.241421 1.625166 1.389376 1.528163 1.539643 1.801710 1.314626 1.482031 0.189224 0.088532 0.546429 0.832570 1.329921 1.394636)
;; 39+1
- 6.223875 #(0.000000 0.017488 0.395122 1.676489 1.264189 0.771372 -0.011418 0.532062 0.348765 -0.291944 -0.034478 0.399358 0.691637 1.117218 1.716574 0.114046 1.298557 0.074462 1.617194 1.080550 1.108787 1.427161 1.645893 1.492515 0.908836 0.183198 0.586816 1.733289 0.192174 1.419647 0.686684 -0.174875 1.274049 1.555620 1.606137 0.123322 1.462205 0.157438 0.491542 -0.249961)
+ 6.223875 #r(0.000000 0.017488 0.395122 1.676489 1.264189 0.771372 -0.011418 0.532062 0.348765 -0.291944 -0.034478 0.399358 0.691637 1.117218 1.716574 0.114046 1.298557 0.074462 1.617194 1.080550 1.108787 1.427161 1.645893 1.492515 0.908836 0.183198 0.586816 1.733289 0.192174 1.419647 0.686684 -0.174875 1.274049 1.555620 1.606137 0.123322 1.462205 0.157438 0.491542 -0.249961)
)
;;; 41 all -------------------------------------------------------------------------------- ; 6.4031
-(vector 41 7.4106826782227 #(0 0 1 1 0 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 0 1 1 1 1)
+(vector 41 7.4106826782227 #r(0 0 1 1 0 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 0 1 1 1 1)
- 6.328763 #(0.000000 1.142395 1.764533 -0.297234 1.214342 1.074168 0.499096 0.455971 1.425043 1.900660 0.405160 0.299024 -1.901144 1.886599 1.644748 1.176229 0.661037 1.678309 0.464540 0.540147 1.345672 0.396385 -0.079815 0.750463 0.469580 0.512532 0.818295 0.900948 1.176821 -0.024695 0.941067 1.661160 0.722192 0.141569 0.127463 0.210921 0.877068 0.077777 1.493046 0.191845 0.414613)
- 6.279752 #(0.000000 1.039440 1.670537 -0.269122 1.058663 1.073053 0.461356 0.338125 1.379608 1.686032 0.168477 0.220127 -0.046702 -0.025677 1.700045 1.127479 0.601951 1.764849 0.395397 0.778987 1.079511 0.525179 -0.400733 0.741798 0.221415 0.104621 0.721445 0.669340 0.961099 -0.201573 0.643173 1.703776 0.553797 -0.208803 -0.109492 0.033494 0.694117 0.116494 1.191608 0.020301 0.131256)
- 6.278483 #(0.000000 1.038469 1.689102 -0.246889 1.070891 1.081477 0.456681 0.352855 1.380232 1.717208 0.185595 0.242413 -0.037760 -0.028341 1.684169 1.135689 0.606635 1.756147 0.422850 0.765104 1.090059 0.552553 -0.368817 0.733599 0.247441 0.131196 0.725118 0.703272 0.972734 -0.170957 0.673987 1.704514 0.578697 -0.183550 -0.096757 0.046184 0.705164 0.130867 1.217191 0.056397 0.199710)
+ 6.328763 #r(0.000000 1.142395 1.764533 -0.297234 1.214342 1.074168 0.499096 0.455971 1.425043 1.900660 0.405160 0.299024 -1.901144 1.886599 1.644748 1.176229 0.661037 1.678309 0.464540 0.540147 1.345672 0.396385 -0.079815 0.750463 0.469580 0.512532 0.818295 0.900948 1.176821 -0.024695 0.941067 1.661160 0.722192 0.141569 0.127463 0.210921 0.877068 0.077777 1.493046 0.191845 0.414613)
+ 6.279752 #r(0.000000 1.039440 1.670537 -0.269122 1.058663 1.073053 0.461356 0.338125 1.379608 1.686032 0.168477 0.220127 -0.046702 -0.025677 1.700045 1.127479 0.601951 1.764849 0.395397 0.778987 1.079511 0.525179 -0.400733 0.741798 0.221415 0.104621 0.721445 0.669340 0.961099 -0.201573 0.643173 1.703776 0.553797 -0.208803 -0.109492 0.033494 0.694117 0.116494 1.191608 0.020301 0.131256)
+ 6.278483 #r(0.000000 1.038469 1.689102 -0.246889 1.070891 1.081477 0.456681 0.352855 1.380232 1.717208 0.185595 0.242413 -0.037760 -0.028341 1.684169 1.135689 0.606635 1.756147 0.422850 0.765104 1.090059 0.552553 -0.368817 0.733599 0.247441 0.131196 0.725118 0.703272 0.972734 -0.170957 0.673987 1.704514 0.578697 -0.183550 -0.096757 0.046184 0.705164 0.130867 1.217191 0.056397 0.199710)
;; 40+1
- 6.357979 #(0.000000 -0.014992 0.249240 1.543670 1.126815 0.662312 -0.052816 0.619055 0.369857 -0.115477 -0.003391 0.180442 0.565001 0.924831 1.661456 -0.128503 1.291579 -0.077357 1.542827 0.991944 0.960719 1.395109 1.631218 1.333505 0.925448 -0.150607 0.489479 1.798022 -0.099011 1.252747 0.567676 -0.055660 1.075602 1.407498 1.261622 0.087709 1.323935 -0.086458 0.259809 -0.431448 0.139996)
+ 6.357979 #r(0.000000 -0.014992 0.249240 1.543670 1.126815 0.662312 -0.052816 0.619055 0.369857 -0.115477 -0.003391 0.180442 0.565001 0.924831 1.661456 -0.128503 1.291579 -0.077357 1.542827 0.991944 0.960719 1.395109 1.631218 1.333505 0.925448 -0.150607 0.489479 1.798022 -0.099011 1.252747 0.567676 -0.055660 1.075602 1.407498 1.261622 0.087709 1.323935 -0.086458 0.259809 -0.431448 0.139996)
)
;;; 42 all -------------------------------------------------------------------------------- ; 6.4807
-(vector 42 7.6252284049988 #(0 0 1 1 0 0 1 1 1 0 0 0 1 0 1 1 0 0 1 0 1 1 0 1 0 1 0 0 1 0 1 1 1 0 0 0 0 0 0 0 0 0)
+(vector 42 7.6252284049988 #r(0 0 1 1 0 0 1 1 1 0 0 0 1 0 1 1 0 0 1 0 1 1 0 1 0 1 0 0 1 0 1 1 1 0 0 0 0 0 0 0 0 0)
- 6.458009 #(0.000000 1.779914 1.358689 1.879744 1.431714 1.455314 0.050417 0.106324 1.650278 0.287736 1.685176 1.015814 0.661574 0.193645 0.754970 0.912901 1.865274 -0.192264 1.123351 1.730828 0.304030 1.844656 1.379904 1.178786 0.508869 0.433728 0.920606 1.193377 1.562403 0.705424 1.521220 0.671316 1.715032 0.818246 0.696173 0.646766 1.054986 -0.067193 0.041834 0.484025 0.025667 0.817193)
+ 6.458009 #r(0.000000 1.779914 1.358689 1.879744 1.431714 1.455314 0.050417 0.106324 1.650278 0.287736 1.685176 1.015814 0.661574 0.193645 0.754970 0.912901 1.865274 -0.192264 1.123351 1.730828 0.304030 1.844656 1.379904 1.178786 0.508869 0.433728 0.920606 1.193377 1.562403 0.705424 1.521220 0.671316 1.715032 0.818246 0.696173 0.646766 1.054986 -0.067193 0.041834 0.484025 0.025667 0.817193)
;; pp:
- 6.432404 #(0.000000 0.970539 1.075055 0.363395 0.562687 1.503003 0.305818 1.159109 -0.331893 0.844703 -0.625323 0.633095 -0.150641 1.248856 0.138597 1.484859 0.287309 -0.516557 0.004989 0.635673 0.412760 0.072104 -0.034630 0.781885 1.052252 0.670637 0.477407 0.370916 -0.497791 0.214269 0.268953 -0.018432 0.090095 0.191222 0.329896 1.234637 1.181873 1.460275 -0.201010 0.565027 0.336488 1.227322)
+ 6.432404 #r(0.000000 0.970539 1.075055 0.363395 0.562687 1.503003 0.305818 1.159109 -0.331893 0.844703 -0.625323 0.633095 -0.150641 1.248856 0.138597 1.484859 0.287309 -0.516557 0.004989 0.635673 0.412760 0.072104 -0.034630 0.781885 1.052252 0.670637 0.477407 0.370916 -0.497791 0.214269 0.268953 -0.018432 0.090095 0.191222 0.329896 1.234637 1.181873 1.460275 -0.201010 0.565027 0.336488 1.227322)
;; 41+1
- 6.374134 #(0.000000 1.160594 -0.035009 -0.337995 1.287896 1.152937 0.370349 0.599654 1.434075 0.331903 0.337639 0.227520 0.031784 0.056373 1.754183 1.233325 0.766762 -0.105337 0.381752 0.608417 1.177813 0.853286 -0.000702 0.980553 0.580193 0.503346 0.721433 1.102554 1.338903 -0.104016 1.021288 -0.193635 0.638903 0.186655 0.282480 0.311801 1.029234 0.514030 1.400087 0.298091 0.559980 -0.413468)
+ 6.374134 #r(0.000000 1.160594 -0.035009 -0.337995 1.287896 1.152937 0.370349 0.599654 1.434075 0.331903 0.337639 0.227520 0.031784 0.056373 1.754183 1.233325 0.766762 -0.105337 0.381752 0.608417 1.177813 0.853286 -0.000702 0.980553 0.580193 0.503346 0.721433 1.102554 1.338903 -0.104016 1.021288 -0.193635 0.638903 0.186655 0.282480 0.311801 1.029234 0.514030 1.400087 0.298091 0.559980 -0.413468)
)
;;; 43 all -------------------------------------------------------------------------------- ; 6.5574
-(vector 43 7.6619415283203 #(0 1 0 1 0 1 1 1 1 0 1 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1)
+(vector 43 7.6619415283203 #r(0 1 0 1 0 1 1 1 1 0 1 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1)
- 6.474636 #(0.000000 1.150199 1.694193 1.156056 0.712558 0.642330 1.062359 0.333465 0.208319 1.376434 0.672147 0.421707 0.175691 0.110131 0.012554 0.457050 1.790874 1.449901 0.302494 0.007271 0.824529 0.122259 0.582806 0.097251 0.623774 0.359297 1.299289 0.938333 1.768060 0.180654 1.104716 1.340371 1.395970 0.480619 1.800871 0.228016 0.933560 0.262964 0.673103 1.298731 1.471774 -0.223423 0.770589)
+ 6.474636 #r(0.000000 1.150199 1.694193 1.156056 0.712558 0.642330 1.062359 0.333465 0.208319 1.376434 0.672147 0.421707 0.175691 0.110131 0.012554 0.457050 1.790874 1.449901 0.302494 0.007271 0.824529 0.122259 0.582806 0.097251 0.623774 0.359297 1.299289 0.938333 1.768060 0.180654 1.104716 1.340371 1.395970 0.480619 1.800871 0.228016 0.933560 0.262964 0.673103 1.298731 1.471774 -0.223423 0.770589)
;; 42+1
- 6.484540 #(0.000000 0.799805 0.296138 -0.181661 1.243255 0.972255 0.211011 0.157981 1.334009 0.607658 0.666111 0.172358 0.489130 0.433262 0.074913 -0.108461 0.327642 -0.177912 0.391650 0.361860 1.366441 1.197611 0.114750 0.879694 0.781347 0.470866 0.964657 1.349973 1.443504 0.050313 1.040919 -0.331503 1.092413 0.101381 0.547246 0.325671 1.577550 0.316146 1.327141 0.900920 0.939639 -0.347989 0.327657)
+ 6.484540 #r(0.000000 0.799805 0.296138 -0.181661 1.243255 0.972255 0.211011 0.157981 1.334009 0.607658 0.666111 0.172358 0.489130 0.433262 0.074913 -0.108461 0.327642 -0.177912 0.391650 0.361860 1.366441 1.197611 0.114750 0.879694 0.781347 0.470866 0.964657 1.349973 1.443504 0.050313 1.040919 -0.331503 1.092413 0.101381 0.547246 0.325671 1.577550 0.316146 1.327141 0.900920 0.939639 -0.347989 0.327657)
)
;;; 44 all -------------------------------------------------------------------------------- ; 6.6332
-(vector 44 7.9767818450928 #(0 1 0 0 1 1 0 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 1 0 1 0 1)
+(vector 44 7.9767818450928 #r(0 1 0 0 1 1 0 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 1 0 1 0 1)
- 6.544063 #(0.000000 0.521564 0.221232 0.526957 -0.268317 1.919404 -0.035203 -0.157289 0.069290 1.705251 1.788014 0.459816 0.274398 0.505529 1.163758 0.357930 -1.720040 0.469129 0.146265 1.215606 1.405712 0.742844 1.668145 1.402279 0.067840 0.255308 0.567789 0.756058 -0.027555 1.587315 0.915687 1.314433 0.227656 0.688969 1.566702 0.434208 -0.041884 1.283408 0.878206 0.471503 1.018383 0.062893 1.376612 0.157588)
+ 6.544063 #r(0.000000 0.521564 0.221232 0.526957 -0.268317 1.919404 -0.035203 -0.157289 0.069290 1.705251 1.788014 0.459816 0.274398 0.505529 1.163758 0.357930 -1.720040 0.469129 0.146265 1.215606 1.405712 0.742844 1.668145 1.402279 0.067840 0.255308 0.567789 0.756058 -0.027555 1.587315 0.915687 1.314433 0.227656 0.688969 1.566702 0.434208 -0.041884 1.283408 0.878206 0.471503 1.018383 0.062893 1.376612 0.157588)
;; 43+1
- 6.617718 #(0.000000 0.929303 0.214195 -0.305607 1.575411 0.960005 0.543631 0.816651 1.159803 0.112080 0.077010 0.590695 -0.040249 -0.288217 1.448848 1.235788 0.754544 -0.407692 0.476307 0.769330 1.241658 1.259441 0.282090 0.960527 0.572071 0.268642 0.862727 -0.063301 1.181813 0.657762 0.694907 0.056205 0.912295 0.475141 0.694152 0.927496 1.094556 1.105653 1.775202 -0.143116 1.075592 -0.229850 0.469130 -0.375239)
+ 6.617718 #r(0.000000 0.929303 0.214195 -0.305607 1.575411 0.960005 0.543631 0.816651 1.159803 0.112080 0.077010 0.590695 -0.040249 -0.288217 1.448848 1.235788 0.754544 -0.407692 0.476307 0.769330 1.241658 1.259441 0.282090 0.960527 0.572071 0.268642 0.862727 -0.063301 1.181813 0.657762 0.694907 0.056205 0.912295 0.475141 0.694152 0.927496 1.094556 1.105653 1.775202 -0.143116 1.075592 -0.229850 0.469130 -0.375239)
)
;;; 45 all -------------------------------------------------------------------------------- ; 6.7082
-(vector 45 8.1777801513672 #(0 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 1)
+(vector 45 8.1777801513672 #r(0 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 1)
- 6.629206 #(0.000000 0.961180 -0.043617 -0.239190 1.278111 0.166389 0.542833 0.768578 1.444629 -0.095831 1.211952 -0.026602 1.739185 0.951577 1.809231 0.253449 0.320575 0.356270 1.309005 0.639731 1.394153 0.026971 -0.051944 0.744827 0.030297 -0.420287 0.144422 1.021322 1.302658 0.297709 -0.048481 -0.152658 1.144902 1.677136 1.170155 1.132592 1.153458 -0.076024 1.369092 1.009916 0.503324 -0.247395 0.103592 1.569752 0.081999)
- 6.624045 #(0.000000 1.027137 -0.006949 -0.241567 1.292392 0.249243 0.688163 0.937733 1.490593 0.055551 1.221039 0.178575 1.739730 1.011821 -0.089036 0.442654 0.375914 0.532475 1.410268 0.844396 1.467724 0.085993 0.105745 0.803510 0.299479 -0.089745 0.369095 1.074672 1.565553 0.558935 0.123221 0.059937 1.431538 -0.190214 1.489626 1.543857 1.489693 0.130690 1.680298 1.260465 0.724859 0.164445 0.433945 -0.212764 0.411030)
- 6.612690 #(0.000000 0.809914 0.760766 -0.199070 0.584393 1.010129 -0.444768 -0.272636 0.950655 0.770420 -0.288810 0.049214 -1.454088 0.191424 -1.076560 -0.306479 -0.326951 -1.245176 0.685415 0.506132 0.101749 0.628099 0.641810 0.560186 1.064779 -0.804404 -0.612448 0.708592 1.898500 0.642577 0.682702 -0.598959 -1.216733 -1.420060 0.084743 0.265460 1.286043 0.185429 1.160604 0.022683 -0.437513 0.122344 -0.218434 -0.653674 -1.002688)
+ 6.629206 #r(0.000000 0.961180 -0.043617 -0.239190 1.278111 0.166389 0.542833 0.768578 1.444629 -0.095831 1.211952 -0.026602 1.739185 0.951577 1.809231 0.253449 0.320575 0.356270 1.309005 0.639731 1.394153 0.026971 -0.051944 0.744827 0.030297 -0.420287 0.144422 1.021322 1.302658 0.297709 -0.048481 -0.152658 1.144902 1.677136 1.170155 1.132592 1.153458 -0.076024 1.369092 1.009916 0.503324 -0.247395 0.103592 1.569752 0.081999)
+ 6.624045 #r(0.000000 1.027137 -0.006949 -0.241567 1.292392 0.249243 0.688163 0.937733 1.490593 0.055551 1.221039 0.178575 1.739730 1.011821 -0.089036 0.442654 0.375914 0.532475 1.410268 0.844396 1.467724 0.085993 0.105745 0.803510 0.299479 -0.089745 0.369095 1.074672 1.565553 0.558935 0.123221 0.059937 1.431538 -0.190214 1.489626 1.543857 1.489693 0.130690 1.680298 1.260465 0.724859 0.164445 0.433945 -0.212764 0.411030)
+ 6.612690 #r(0.000000 0.809914 0.760766 -0.199070 0.584393 1.010129 -0.444768 -0.272636 0.950655 0.770420 -0.288810 0.049214 -1.454088 0.191424 -1.076560 -0.306479 -0.326951 -1.245176 0.685415 0.506132 0.101749 0.628099 0.641810 0.560186 1.064779 -0.804404 -0.612448 0.708592 1.898500 0.642577 0.682702 -0.598959 -1.216733 -1.420060 0.084743 0.265460 1.286043 0.185429 1.160604 0.022683 -0.437513 0.122344 -0.218434 -0.653674 -1.002688)
;; 44+1
- 6.714595 #(0.000000 0.564364 0.130777 0.656228 -0.319916 1.775107 -0.124290 -0.070841 0.124442 1.500414 1.820670 0.445101 0.236733 0.416487 1.155210 0.503587 -1.734245 0.426011 0.254073 1.069259 1.324509 0.611279 1.824321 1.376553 -0.114105 0.172880 0.631450 0.863080 -0.077524 1.662079 0.769087 1.304043 0.122140 0.610255 1.653927 0.326711 -0.168576 1.291324 0.851943 0.606010 1.047149 0.079373 1.047078 0.035371 -0.264517)
+ 6.714595 #r(0.000000 0.564364 0.130777 0.656228 -0.319916 1.775107 -0.124290 -0.070841 0.124442 1.500414 1.820670 0.445101 0.236733 0.416487 1.155210 0.503587 -1.734245 0.426011 0.254073 1.069259 1.324509 0.611279 1.824321 1.376553 -0.114105 0.172880 0.631450 0.863080 -0.077524 1.662079 0.769087 1.304043 0.122140 0.610255 1.653927 0.326711 -0.168576 1.291324 0.851943 0.606010 1.047149 0.079373 1.047078 0.035371 -0.264517)
)
;;; 46 all -------------------------------------------------------------------------------- ; 6.7823
-(vector 46 8.22203540802 #(0 1 0 1 0 0 0 0 1 0 0 1 1 0 1 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 0 1 1 0 0 1 0 0 1 0 1 0 0 0 0)
+(vector 46 8.22203540802 #r(0 1 0 1 0 0 0 0 1 0 0 1 1 0 1 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 0 1 1 0 0 1 0 0 1 0 1 0 0 0 0)
- 6.691037 #(0.000000 1.445996 1.082935 1.926602 0.599270 0.110590 0.061353 0.197460 1.126524 0.801213 0.136799 1.544533 0.424316 0.988423 1.042912 0.904549 0.394264 1.877367 1.781398 0.106378 0.814176 1.462479 1.299353 0.505357 0.691608 0.079788 0.741755 1.296349 0.923407 1.954315 1.519832 1.193777 1.868646 1.501978 -0.016089 0.928107 1.377054 1.114171 1.348483 1.466927 0.885968 1.244812 -0.112245 0.649026 0.159882 0.999017)
+ 6.691037 #r(0.000000 1.445996 1.082935 1.926602 0.599270 0.110590 0.061353 0.197460 1.126524 0.801213 0.136799 1.544533 0.424316 0.988423 1.042912 0.904549 0.394264 1.877367 1.781398 0.106378 0.814176 1.462479 1.299353 0.505357 0.691608 0.079788 0.741755 1.296349 0.923407 1.954315 1.519832 1.193777 1.868646 1.501978 -0.016089 0.928107 1.377054 1.114171 1.348483 1.466927 0.885968 1.244812 -0.112245 0.649026 0.159882 0.999017)
;; 45+1
- 6.737496 #(0.000000 0.891082 0.437629 -0.631499 1.355029 0.088312 0.525030 0.893686 1.472031 -0.146846 0.973741 0.114371 1.794819 1.120888 1.803610 0.267646 0.313821 0.176598 1.483030 0.561548 1.444435 0.111178 -0.116383 0.572485 0.384889 -0.539242 -0.000026 1.504176 1.488659 0.718239 -0.059775 0.251172 1.363526 1.830593 1.709614 1.067908 1.076519 0.522533 1.398513 0.992929 0.954368 -0.123192 0.213695 1.865385 0.089802 -0.018905)
+ 6.737496 #r(0.000000 0.891082 0.437629 -0.631499 1.355029 0.088312 0.525030 0.893686 1.472031 -0.146846 0.973741 0.114371 1.794819 1.120888 1.803610 0.267646 0.313821 0.176598 1.483030 0.561548 1.444435 0.111178 -0.116383 0.572485 0.384889 -0.539242 -0.000026 1.504176 1.488659 0.718239 -0.059775 0.251172 1.363526 1.830593 1.709614 1.067908 1.076519 0.522533 1.398513 0.992929 0.954368 -0.123192 0.213695 1.865385 0.089802 -0.018905)
)
;;; 47 all -------------------------------------------------------------------------------- ; 6.8556
-(vector 47 8.3221893310547 #(0 0 1 0 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 1 0 1 1 0 1 0 0)
+(vector 47 8.3221893310547 #r(0 0 1 0 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 1 0 1 1 0 1 0 0)
- 6.827640 #(0.000000 1.713417 0.880595 0.228916 0.656232 0.000986 0.228917 -0.027955 1.208960 0.359921 0.457263 0.229897 0.942770 1.345553 -0.054940 0.652154 0.967593 1.474188 0.749564 1.214391 0.623653 1.483712 1.914097 -0.195445 1.486123 0.775521 1.114155 1.267810 1.798008 0.660315 0.102413 1.302210 1.004781 1.037205 1.145399 0.299807 1.478644 1.078433 0.364686 1.769537 0.263449 0.339932 0.328599 1.167886 1.782492 1.089675 1.333666)
+ 6.827640 #r(0.000000 1.713417 0.880595 0.228916 0.656232 0.000986 0.228917 -0.027955 1.208960 0.359921 0.457263 0.229897 0.942770 1.345553 -0.054940 0.652154 0.967593 1.474188 0.749564 1.214391 0.623653 1.483712 1.914097 -0.195445 1.486123 0.775521 1.114155 1.267810 1.798008 0.660315 0.102413 1.302210 1.004781 1.037205 1.145399 0.299807 1.478644 1.078433 0.364686 1.769537 0.263449 0.339932 0.328599 1.167886 1.782492 1.089675 1.333666)
;; pp.scm
- 6.756605 #(0.000000 0.765562 1.030062 1.788209 0.493707 1.020553 1.799942 0.685170 1.481088 0.566613 1.302518 0.066670 1.157386 0.282906 1.328526 0.161298 1.388649 0.879050 1.843229 1.039366 0.409576 -0.055025 1.222366 0.535280 0.169247 1.679128 1.342099 0.894436 0.643082 0.345708 0.301808 -0.401334 0.022950 1.550170 1.565812 1.633017 1.764984 1.880338 1.607034 1.569498 0.111731 0.416082 0.781558 0.894597 1.438223 1.659212 0.166997)
+ 6.756605 #r(0.000000 0.765562 1.030062 1.788209 0.493707 1.020553 1.799942 0.685170 1.481088 0.566613 1.302518 0.066670 1.157386 0.282906 1.328526 0.161298 1.388649 0.879050 1.843229 1.039366 0.409576 -0.055025 1.222366 0.535280 0.169247 1.679128 1.342099 0.894436 0.643082 0.345708 0.301808 -0.401334 0.022950 1.550170 1.565812 1.633017 1.764984 1.880338 1.607034 1.569498 0.111731 0.416082 0.781558 0.894597 1.438223 1.659212 0.166997)
)
;;; 48 all -------------------------------------------------------------------------------- ; 6.9282
-(vector 48 8.4671268463135 #(0 0 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 1 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 1 1)
+(vector 48 8.4671268463135 #r(0 0 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 1 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 1 1)
- 6.861797 #(0.000000 0.598880 1.244788 1.029903 1.049082 0.596958 1.659653 1.333585 0.658254 1.786003 1.335584 0.009329 0.382880 1.914281 0.167535 0.198984 1.572176 1.516863 0.640701 0.516067 0.942009 -0.405338 1.601326 0.836539 0.796978 0.739838 0.171913 0.969497 0.363583 0.469203 1.258504 0.656687 1.162915 0.889585 1.702682 0.725369 0.456133 0.349105 0.208023 0.802519 1.129136 1.479603 0.312580 1.579555 0.353334 0.757965 1.599847 0.626811)
+ 6.861797 #r(0.000000 0.598880 1.244788 1.029903 1.049082 0.596958 1.659653 1.333585 0.658254 1.786003 1.335584 0.009329 0.382880 1.914281 0.167535 0.198984 1.572176 1.516863 0.640701 0.516067 0.942009 -0.405338 1.601326 0.836539 0.796978 0.739838 0.171913 0.969497 0.363583 0.469203 1.258504 0.656687 1.162915 0.889585 1.702682 0.725369 0.456133 0.349105 0.208023 0.802519 1.129136 1.479603 0.312580 1.579555 0.353334 0.757965 1.599847 0.626811)
;; 47+1
- 6.892392 #(0.000000 0.688844 1.275690 -0.029196 0.666687 1.219038 1.796126 0.686703 1.387045 0.299015 1.486000 0.217586 1.168099 0.122356 1.320410 0.506266 1.401144 0.705689 0.099274 1.001293 0.250881 -0.338513 1.011906 0.589633 -0.026149 1.658621 0.999181 0.670111 0.425438 0.181969 0.283085 -0.428382 -0.237009 1.436619 1.467751 1.345785 1.658556 -0.130875 1.611827 1.446511 -0.136029 0.162128 0.614874 0.798756 1.306679 1.726452 0.077838 -0.060906)
+ 6.892392 #r(0.000000 0.688844 1.275690 -0.029196 0.666687 1.219038 1.796126 0.686703 1.387045 0.299015 1.486000 0.217586 1.168099 0.122356 1.320410 0.506266 1.401144 0.705689 0.099274 1.001293 0.250881 -0.338513 1.011906 0.589633 -0.026149 1.658621 0.999181 0.670111 0.425438 0.181969 0.283085 -0.428382 -0.237009 1.436619 1.467751 1.345785 1.658556 -0.130875 1.611827 1.446511 -0.136029 0.162128 0.614874 0.798756 1.306679 1.726452 0.077838 -0.060906)
;; 50-2
- 6.804078 #(0.000000 0.874821 0.948620 -0.030050 0.326575 1.258972 -0.088513 0.113859 0.340515 -0.014269 1.691477 0.675893 0.119114 -0.035346 1.426532 1.152480 0.791174 0.976063 0.731143 1.014136 1.203667 0.311022 -0.203371 1.591275 1.628122 -0.181766 0.450459 0.902610 0.339563 -0.440014 -0.112189 0.959920 1.425584 0.089561 1.717366 0.518887 0.024084 1.133195 1.349821 0.385099 1.797184 0.189610 0.147986 1.156584 -0.006309 1.527354 0.195815 0.002013)
+ 6.804078 #r(0.000000 0.874821 0.948620 -0.030050 0.326575 1.258972 -0.088513 0.113859 0.340515 -0.014269 1.691477 0.675893 0.119114 -0.035346 1.426532 1.152480 0.791174 0.976063 0.731143 1.014136 1.203667 0.311022 -0.203371 1.591275 1.628122 -0.181766 0.450459 0.902610 0.339563 -0.440014 -0.112189 0.959920 1.425584 0.089561 1.717366 0.518887 0.024084 1.133195 1.349821 0.385099 1.797184 0.189610 0.147986 1.156584 -0.006309 1.527354 0.195815 0.002013)
)
;;; 49 all -------------------------------------------------------------------------------- ; 7
-(vector 49 8.5157623291016 #(0 1 1 0 0 0 0 0 1 0 0 1 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 0 0 1 0 1 0 0)
+(vector 49 8.5157623291016 #r(0 1 1 0 0 0 0 0 1 0 0 1 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 0 0 1 0 1 0 0)
- 6.911687 #(0.000000 1.423917 -0.117078 -0.215912 1.065526 1.018507 0.645263 1.632151 0.540556 0.415851 1.870183 1.161732 0.983376 1.723916 0.372700 0.063452 0.534166 1.512588 1.454603 0.719318 0.962295 1.537720 1.562020 1.433858 0.930756 1.181983 1.504188 -0.167777 1.662278 0.680834 0.246207 0.675469 0.268474 1.089455 0.369548 -0.146942 -0.055836 1.091821 1.976652 0.486415 1.202030 0.175707 0.854435 0.506884 1.646470 0.139127 0.235704 1.857608 0.297006)
+ 6.911687 #r(0.000000 1.423917 -0.117078 -0.215912 1.065526 1.018507 0.645263 1.632151 0.540556 0.415851 1.870183 1.161732 0.983376 1.723916 0.372700 0.063452 0.534166 1.512588 1.454603 0.719318 0.962295 1.537720 1.562020 1.433858 0.930756 1.181983 1.504188 -0.167777 1.662278 0.680834 0.246207 0.675469 0.268474 1.089455 0.369548 -0.146942 -0.055836 1.091821 1.976652 0.486415 1.202030 0.175707 0.854435 0.506884 1.646470 0.139127 0.235704 1.857608 0.297006)
;; 50-1
- 6.874368 #(0.000000 1.204417 0.954334 -0.405108 0.059322 1.004871 -0.307909 0.766418 1.079079 0.002645 1.437193 0.338324 0.101886 -0.559571 1.466710 1.621612 0.973989 1.377429 0.337678 1.035741 0.679343 0.146983 1.275159 -0.370675 -0.331425 0.304277 -0.450477 1.075881 -0.790453 -0.423723 -0.417480 0.648387 -0.501882 -0.980950 -0.159587 0.593728 -0.757113 1.129266 0.980355 0.172786 -0.231542 -0.093435 -0.126900 0.604505 0.503262 0.476708 0.056575 0.183795 0.839623)
- 6.871628 #(0.000000 1.197339 0.943600 -0.418761 0.049685 1.002197 -0.323377 0.763534 1.062841 -0.005796 1.425933 0.322430 0.084053 -0.585670 1.449690 1.603999 0.946354 1.356731 0.301596 1.002372 0.650650 0.119315 1.243049 -0.407370 -0.367523 0.258301 -0.505816 1.032723 -0.832489 -0.467654 -0.467807 0.598599 -0.548874 -1.027291 -0.206361 0.534378 -0.811327 1.081884 0.922436 0.108022 -0.303016 -0.150120 -0.199521 0.546600 0.438688 0.415808 -0.008696 0.110784 0.758574)
+ 6.874368 #r(0.000000 1.204417 0.954334 -0.405108 0.059322 1.004871 -0.307909 0.766418 1.079079 0.002645 1.437193 0.338324 0.101886 -0.559571 1.466710 1.621612 0.973989 1.377429 0.337678 1.035741 0.679343 0.146983 1.275159 -0.370675 -0.331425 0.304277 -0.450477 1.075881 -0.790453 -0.423723 -0.417480 0.648387 -0.501882 -0.980950 -0.159587 0.593728 -0.757113 1.129266 0.980355 0.172786 -0.231542 -0.093435 -0.126900 0.604505 0.503262 0.476708 0.056575 0.183795 0.839623)
+ 6.871628 #r(0.000000 1.197339 0.943600 -0.418761 0.049685 1.002197 -0.323377 0.763534 1.062841 -0.005796 1.425933 0.322430 0.084053 -0.585670 1.449690 1.603999 0.946354 1.356731 0.301596 1.002372 0.650650 0.119315 1.243049 -0.407370 -0.367523 0.258301 -0.505816 1.032723 -0.832489 -0.467654 -0.467807 0.598599 -0.548874 -1.027291 -0.206361 0.534378 -0.811327 1.081884 0.922436 0.108022 -0.303016 -0.150120 -0.199521 0.546600 0.438688 0.415808 -0.008696 0.110784 0.758574)
)
;;; 50 all -------------------------------------------------------------------------------- ; 7.071
-(vector 50 8.7809114456177 #(0 0 1 0 1 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 0 0 1 0 1 0 0 1 1 1 1 0 1 1 1 0 1 1 0 1 0 0 1)
+(vector 50 8.7809114456177 #r(0 0 1 0 1 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 0 0 1 0 1 0 0 1 1 1 1 0 1 1 1 0 1 1 0 1 0 0 1)
- 7.001572 #(0.000000 1.510483 0.569660 1.177547 -0.063746 1.651491 0.398933 1.945813 1.189455 0.886784 0.877834 1.209513 -0.281791 0.817195 0.562593 1.509576 -0.448618 -0.075249 1.004074 1.022851 1.197099 0.475529 0.725043 0.148549 0.625214 0.676229 0.641014 0.276388 1.297552 1.512294 0.880442 -0.093329 0.470630 1.205879 -0.595773 0.927383 1.198964 0.435022 1.291534 0.884451 -0.190056 1.483748 1.136079 1.665203 0.167401 0.524695 0.182147 -0.336866 0.803181 1.503900)
+ 7.001572 #r(0.000000 1.510483 0.569660 1.177547 -0.063746 1.651491 0.398933 1.945813 1.189455 0.886784 0.877834 1.209513 -0.281791 0.817195 0.562593 1.509576 -0.448618 -0.075249 1.004074 1.022851 1.197099 0.475529 0.725043 0.148549 0.625214 0.676229 0.641014 0.276388 1.297552 1.512294 0.880442 -0.093329 0.470630 1.205879 -0.595773 0.927383 1.198964 0.435022 1.291534 0.884451 -0.190056 1.483748 1.136079 1.665203 0.167401 0.524695 0.182147 -0.336866 0.803181 1.503900)
;; 49+1
- 7.064944 #(0.000000 1.558009 -0.108565 -0.226913 0.920197 1.180894 0.537671 1.554384 0.613756 0.458358 0.091191 1.387557 0.869986 1.858139 0.547904 0.135691 0.583740 1.710905 1.421339 0.744505 1.032127 1.414994 1.701011 1.686329 0.940524 1.064348 1.388446 -0.279583 1.723434 0.898036 0.320378 0.547937 0.335420 1.264319 0.407052 0.022184 -0.017105 0.905945 1.912730 0.523724 1.239641 0.158867 0.840449 0.693502 1.785642 0.002311 0.342012 1.897108 0.429747 0.359280)
+ 7.064944 #r(0.000000 1.558009 -0.108565 -0.226913 0.920197 1.180894 0.537671 1.554384 0.613756 0.458358 0.091191 1.387557 0.869986 1.858139 0.547904 0.135691 0.583740 1.710905 1.421339 0.744505 1.032127 1.414994 1.701011 1.686329 0.940524 1.064348 1.388446 -0.279583 1.723434 0.898036 0.320378 0.547937 0.335420 1.264319 0.407052 0.022184 -0.017105 0.905945 1.912730 0.523724 1.239641 0.158867 0.840449 0.693502 1.785642 0.002311 0.342012 1.897108 0.429747 0.359280)
;; 51-1?
- 6.966444 #(0.000000 0.969561 1.094228 1.889603 0.178237 1.243506 -0.179029 0.498784 0.715615 0.064553 1.519591 0.490911 0.171201 1.825529 1.138600 1.243991 0.920476 1.084610 0.315165 0.739666 0.806931 0.459500 1.392905 1.470398 1.703973 -0.154232 0.175316 0.961121 -0.195877 -0.203581 -0.104914 0.596805 1.500152 -0.064411 1.474852 0.495330 -0.345550 1.291380 1.361659 0.279253 1.587805 0.037979 -0.094175 0.955070 0.189359 0.883451 0.286407 -0.239876 1.359571 1.605865)
- 6.966047 #(0.000000 0.962905 1.097330 1.888512 0.176170 1.249181 -0.168544 0.509171 0.717525 0.069686 1.526076 0.503308 0.181151 1.831084 1.142478 1.254775 0.935821 1.099009 0.324329 0.750637 0.817716 0.473950 1.405312 1.489970 1.715244 -0.138333 0.191055 0.986798 -0.177541 -0.183900 -0.081646 0.626605 1.530354 -0.052123 1.504605 0.533551 -0.327117 1.309658 1.385783 0.305850 1.613358 0.056196 -0.069816 0.982784 0.217704 0.915410 0.315681 -0.214270 1.383464 1.628385)
+ 6.966444 #r(0.000000 0.969561 1.094228 1.889603 0.178237 1.243506 -0.179029 0.498784 0.715615 0.064553 1.519591 0.490911 0.171201 1.825529 1.138600 1.243991 0.920476 1.084610 0.315165 0.739666 0.806931 0.459500 1.392905 1.470398 1.703973 -0.154232 0.175316 0.961121 -0.195877 -0.203581 -0.104914 0.596805 1.500152 -0.064411 1.474852 0.495330 -0.345550 1.291380 1.361659 0.279253 1.587805 0.037979 -0.094175 0.955070 0.189359 0.883451 0.286407 -0.239876 1.359571 1.605865)
+ 6.966047 #r(0.000000 0.962905 1.097330 1.888512 0.176170 1.249181 -0.168544 0.509171 0.717525 0.069686 1.526076 0.503308 0.181151 1.831084 1.142478 1.254775 0.935821 1.099009 0.324329 0.750637 0.817716 0.473950 1.405312 1.489970 1.715244 -0.138333 0.191055 0.986798 -0.177541 -0.183900 -0.081646 0.626605 1.530354 -0.052123 1.504605 0.533551 -0.327117 1.309658 1.385783 0.305850 1.613358 0.056196 -0.069816 0.982784 0.217704 0.915410 0.315681 -0.214270 1.383464 1.628385)
)
;;; 51 all -------------------------------------------------------------------------------- ; 7.141
-(vector 51 8.8213935921978 #(0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 1 1 0 0 1 0 1 0 0 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 1 0 0 1)
+(vector 51 8.8213935921978 #r(0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 1 1 0 0 1 0 1 0 0 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 1 0 0 1)
- 7.062061 #(0.000000 1.277482 1.272374 1.604932 -0.114681 1.091849 -0.113655 0.581995 0.517152 0.112646 1.392203 0.473053 0.525951 1.781540 1.014930 1.311666 0.597941 1.173291 0.649975 0.688396 0.657382 0.570575 1.699334 1.669408 1.662666 -0.233111 0.196711 0.718758 -0.174442 0.105462 -0.039308 0.924279 1.329687 1.401301 1.538357 0.347724 -0.110320 1.449195 1.223831 0.349599 1.470761 0.191238 1.885833 0.819453 0.145490 0.967802 0.015777 -0.014902 1.276127 1.513254 0.227467)
- 6.975170 #(0.000000 1.372924 1.059217 -0.645861 1.097945 1.058807 0.153152 0.527074 0.651159 0.424719 0.459322 0.332180 0.264613 -0.372847 0.683198 1.120562 0.213922 0.685600 0.345552 0.459914 1.129925 0.756644 0.458857 -0.052979 1.594004 -0.921247 0.485511 1.115573 -0.083642 0.773245 0.508692 1.481091 0.025171 1.228864 1.684948 0.240036 0.474172 0.435815 1.326902 1.195703 -0.007047 1.017216 0.874417 1.846797 0.909867 1.892877 1.240478 -0.484663 1.778802 -0.122729 0.589405)
- 6.971782 #(0.000000 1.381134 1.053573 -0.642284 1.106927 1.065731 0.156795 0.531640 0.658480 0.423307 0.458153 0.332929 0.258309 -0.378345 0.690163 1.115051 0.213852 0.690863 0.353610 0.459744 1.132735 0.758828 0.447315 -0.071617 1.577100 -0.919334 0.495653 1.111932 -0.086022 0.770249 0.516654 1.486418 0.018200 1.218929 1.677748 0.244186 0.465632 0.411266 1.326302 1.201131 -0.010901 1.028025 0.862583 1.846154 0.922121 1.887046 1.218211 -0.479984 1.767657 -0.113149 0.573554)
+ 7.062061 #r(0.000000 1.277482 1.272374 1.604932 -0.114681 1.091849 -0.113655 0.581995 0.517152 0.112646 1.392203 0.473053 0.525951 1.781540 1.014930 1.311666 0.597941 1.173291 0.649975 0.688396 0.657382 0.570575 1.699334 1.669408 1.662666 -0.233111 0.196711 0.718758 -0.174442 0.105462 -0.039308 0.924279 1.329687 1.401301 1.538357 0.347724 -0.110320 1.449195 1.223831 0.349599 1.470761 0.191238 1.885833 0.819453 0.145490 0.967802 0.015777 -0.014902 1.276127 1.513254 0.227467)
+ 6.975170 #r(0.000000 1.372924 1.059217 -0.645861 1.097945 1.058807 0.153152 0.527074 0.651159 0.424719 0.459322 0.332180 0.264613 -0.372847 0.683198 1.120562 0.213922 0.685600 0.345552 0.459914 1.129925 0.756644 0.458857 -0.052979 1.594004 -0.921247 0.485511 1.115573 -0.083642 0.773245 0.508692 1.481091 0.025171 1.228864 1.684948 0.240036 0.474172 0.435815 1.326902 1.195703 -0.007047 1.017216 0.874417 1.846797 0.909867 1.892877 1.240478 -0.484663 1.778802 -0.122729 0.589405)
+ 6.971782 #r(0.000000 1.381134 1.053573 -0.642284 1.106927 1.065731 0.156795 0.531640 0.658480 0.423307 0.458153 0.332929 0.258309 -0.378345 0.690163 1.115051 0.213852 0.690863 0.353610 0.459744 1.132735 0.758828 0.447315 -0.071617 1.577100 -0.919334 0.495653 1.111932 -0.086022 0.770249 0.516654 1.486418 0.018200 1.218929 1.677748 0.244186 0.465632 0.411266 1.326302 1.201131 -0.010901 1.028025 0.862583 1.846154 0.922121 1.887046 1.218211 -0.479984 1.767657 -0.113149 0.573554)
)
;;; 52 all -------------------------------------------------------------------------------- ; 7.211
-(vector 52 8.9920463562012 #(0 1 1 0 1 0 0 0 0 0 1 0 0 0 1 0 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 0 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 0)
+(vector 52 8.9920463562012 #r(0 1 1 0 1 0 0 0 0 0 1 0 0 0 1 0 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 0 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 0)
- 7.134954 #(0.000000 0.621560 1.464578 1.482376 0.135707 1.345519 0.584967 0.540885 1.784345 0.393329 1.745283 0.530433 1.414971 1.247472 1.329889 0.999552 0.933504 1.580199 0.519254 0.315472 0.473007 1.123477 -0.056053 0.241576 0.391709 1.244898 1.883529 1.120931 1.698334 -0.149261 0.218191 1.134898 0.533381 1.222211 0.249553 -0.114715 1.262472 0.846800 0.877356 0.688478 0.673983 1.103698 1.385836 1.036560 1.331275 0.414915 1.604362 0.874160 0.543444 1.406115 1.239524 0.816202)
- 7.102459 #(0.000000 0.648837 1.347937 1.394205 0.228772 1.369761 0.659192 0.578381 -0.056010 0.281439 1.788400 0.481565 1.424466 1.245338 1.307438 1.071654 0.849375 1.612358 0.470180 0.053038 0.353912 1.080684 -0.161116 0.151468 0.433202 1.019193 1.757938 0.968555 1.596947 -0.203879 0.025193 0.991804 0.446937 1.059356 0.023869 -0.400100 1.079870 0.688268 0.741558 0.481001 0.496940 1.006445 1.004308 0.856157 1.144916 0.288878 1.267244 0.487227 0.316277 1.265206 1.008151 0.448535)
- 7.101828 #(0.000000 0.646351 1.348437 1.394446 0.228508 1.370485 0.660337 0.579558 -0.056026 0.283749 1.791709 0.481733 1.428712 1.245523 1.307690 1.074069 0.851835 1.612005 0.472059 0.051512 0.355641 1.080975 -0.158863 0.150463 0.435366 1.019121 1.758753 0.965820 1.596435 -0.205826 0.026983 0.989221 0.450040 1.062201 0.025319 -0.395664 1.085851 0.689762 0.740855 0.484733 0.501691 1.010487 1.006025 0.857003 1.147326 0.289999 1.266663 0.490356 0.319639 1.268445 1.014342 0.448435)
+ 7.134954 #r(0.000000 0.621560 1.464578 1.482376 0.135707 1.345519 0.584967 0.540885 1.784345 0.393329 1.745283 0.530433 1.414971 1.247472 1.329889 0.999552 0.933504 1.580199 0.519254 0.315472 0.473007 1.123477 -0.056053 0.241576 0.391709 1.244898 1.883529 1.120931 1.698334 -0.149261 0.218191 1.134898 0.533381 1.222211 0.249553 -0.114715 1.262472 0.846800 0.877356 0.688478 0.673983 1.103698 1.385836 1.036560 1.331275 0.414915 1.604362 0.874160 0.543444 1.406115 1.239524 0.816202)
+ 7.102459 #r(0.000000 0.648837 1.347937 1.394205 0.228772 1.369761 0.659192 0.578381 -0.056010 0.281439 1.788400 0.481565 1.424466 1.245338 1.307438 1.071654 0.849375 1.612358 0.470180 0.053038 0.353912 1.080684 -0.161116 0.151468 0.433202 1.019193 1.757938 0.968555 1.596947 -0.203879 0.025193 0.991804 0.446937 1.059356 0.023869 -0.400100 1.079870 0.688268 0.741558 0.481001 0.496940 1.006445 1.004308 0.856157 1.144916 0.288878 1.267244 0.487227 0.316277 1.265206 1.008151 0.448535)
+ 7.101828 #r(0.000000 0.646351 1.348437 1.394446 0.228508 1.370485 0.660337 0.579558 -0.056026 0.283749 1.791709 0.481733 1.428712 1.245523 1.307690 1.074069 0.851835 1.612005 0.472059 0.051512 0.355641 1.080975 -0.158863 0.150463 0.435366 1.019121 1.758753 0.965820 1.596435 -0.205826 0.026983 0.989221 0.450040 1.062201 0.025319 -0.395664 1.085851 0.689762 0.740855 0.484733 0.501691 1.010487 1.006025 0.857003 1.147326 0.289999 1.266663 0.490356 0.319639 1.268445 1.014342 0.448435)
;; 51+1
- 7.145012 #(0.000000 1.352385 1.096112 -0.482272 0.885332 0.870800 0.112570 0.382211 0.798266 0.531129 0.345406 0.278068 0.081547 -0.522592 0.532216 1.052537 0.102793 0.798891 0.416786 0.277444 0.906912 0.754729 0.700156 -0.252504 1.434329 -1.160114 0.522833 0.926005 -0.230879 0.705542 0.399151 1.195170 -0.005753 1.038829 1.626916 0.206308 0.196067 0.121343 1.290769 1.164188 0.034677 0.629244 0.574748 1.749902 0.694682 1.749273 1.187350 -0.674905 1.512501 -0.358396 0.363063 -0.122492)
- 7.144789 #(0.000000 1.352391 1.096101 -0.482270 0.885354 0.870760 0.112575 0.382220 0.798263 0.531121 0.345380 0.278012 0.081522 -0.522597 0.532194 1.052519 0.102779 0.798921 0.416757 0.277445 0.906956 0.754684 0.700152 -0.252540 1.434318 -1.160054 0.522800 0.925955 -0.230874 0.705534 0.399191 1.195193 -0.005723 1.038783 1.626886 0.206343 0.196079 0.121327 1.290786 1.164142 0.034729 0.629201 0.574727 1.749850 0.694693 1.749269 1.187356 -0.674899 1.512518 -0.358412 0.362988 -0.122524)
+ 7.145012 #r(0.000000 1.352385 1.096112 -0.482272 0.885332 0.870800 0.112570 0.382211 0.798266 0.531129 0.345406 0.278068 0.081547 -0.522592 0.532216 1.052537 0.102793 0.798891 0.416786 0.277444 0.906912 0.754729 0.700156 -0.252504 1.434329 -1.160114 0.522833 0.926005 -0.230879 0.705542 0.399151 1.195170 -0.005753 1.038829 1.626916 0.206308 0.196067 0.121343 1.290769 1.164188 0.034677 0.629244 0.574748 1.749902 0.694682 1.749273 1.187350 -0.674905 1.512501 -0.358396 0.363063 -0.122492)
+ 7.144789 #r(0.000000 1.352391 1.096101 -0.482270 0.885354 0.870760 0.112575 0.382220 0.798263 0.531121 0.345380 0.278012 0.081522 -0.522597 0.532194 1.052519 0.102779 0.798921 0.416757 0.277445 0.906956 0.754684 0.700152 -0.252540 1.434318 -1.160054 0.522800 0.925955 -0.230874 0.705534 0.399191 1.195193 -0.005723 1.038783 1.626886 0.206343 0.196079 0.121327 1.290786 1.164142 0.034729 0.629201 0.574727 1.749850 0.694693 1.749269 1.187356 -0.674899 1.512518 -0.358412 0.362988 -0.122524)
)
;;; 53 all -------------------------------------------------------------------------------- ; 7.280
-(vector 53 9.0914754867554 #(0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 0 1 1 0 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 1 1 0 0 1 1 0 0)
+(vector 53 9.0914754867554 #r(0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 0 1 1 0 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 1 1 0 0 1 1 0 0)
- 7.198047 #(0.000000 0.609644 0.849387 1.600527 1.158365 1.715833 0.524245 -0.059778 0.291176 0.319451 0.985683 1.372433 1.089427 1.749317 1.594481 0.166060 0.927925 -0.362027 0.850015 1.635397 0.732972 1.007069 0.880865 0.290674 0.176669 0.886718 1.772633 0.908528 -0.020813 0.082874 0.257671 1.590012 0.330359 1.893554 1.401328 1.102801 0.720925 0.360594 1.357080 1.833049 0.574052 1.403405 1.851942 1.638866 1.670052 -0.125543 1.654904 0.840665 0.189500 1.798641 0.330271 0.101100 1.702877)
+ 7.198047 #r(0.000000 0.609644 0.849387 1.600527 1.158365 1.715833 0.524245 -0.059778 0.291176 0.319451 0.985683 1.372433 1.089427 1.749317 1.594481 0.166060 0.927925 -0.362027 0.850015 1.635397 0.732972 1.007069 0.880865 0.290674 0.176669 0.886718 1.772633 0.908528 -0.020813 0.082874 0.257671 1.590012 0.330359 1.893554 1.401328 1.102801 0.720925 0.360594 1.357080 1.833049 0.574052 1.403405 1.851942 1.638866 1.670052 -0.125543 1.654904 0.840665 0.189500 1.798641 0.330271 0.101100 1.702877)
;; 54-1
- 7.176884 #(0.000000 0.737356 0.760874 1.677578 1.139788 1.733776 0.512545 0.168962 0.294969 0.278922 1.229915 1.512859 1.087438 -0.081926 1.604920 0.197320 1.063397 -0.398250 0.879705 1.816289 0.744289 1.022891 1.064721 0.415657 0.347902 0.773736 1.527156 1.136404 0.028489 0.350665 0.276554 1.845571 0.604279 0.038246 1.467967 1.374232 0.791320 0.557650 1.482264 -0.049230 0.938062 1.746697 0.132063 1.652819 1.777078 0.039226 1.666124 1.061506 0.103648 0.026453 0.558713 0.008013 0.082476)
- 7.170025 #(0.000000 0.735367 0.761108 1.674444 1.148859 1.727214 0.506019 0.166885 0.301941 0.289424 1.228914 1.514765 1.088336 -0.084927 1.605465 0.191699 1.059128 -0.394739 0.884851 1.807751 0.747579 1.030098 1.071564 0.404714 0.353145 0.766117 1.522688 1.133668 0.028958 0.353932 0.272825 1.843589 0.590551 0.041758 1.471960 1.368203 0.792332 0.554867 1.486774 -0.039669 0.938500 1.744333 0.139825 1.659686 1.776069 0.036261 1.664792 1.057651 0.104623 0.024123 0.551601 0.015304 0.093561)
- 7.168422 #(0.000000 0.734800 0.755002 1.678637 1.148472 1.726884 0.506566 0.162329 0.304752 0.290731 1.237477 1.522988 1.097235 -0.074667 1.611785 0.203012 1.069009 -0.398864 0.892774 1.815871 0.743283 1.031741 1.066124 0.407989 0.358481 0.762020 1.519272 1.133826 0.019027 0.362472 0.267333 1.835621 0.594226 0.045578 1.461712 1.370620 0.794797 0.554188 1.488530 -0.030031 0.948673 1.753818 0.146713 1.671920 1.781890 0.035858 1.658572 1.054561 0.107770 0.028848 0.546289 0.017191 0.104880)
+ 7.176884 #r(0.000000 0.737356 0.760874 1.677578 1.139788 1.733776 0.512545 0.168962 0.294969 0.278922 1.229915 1.512859 1.087438 -0.081926 1.604920 0.197320 1.063397 -0.398250 0.879705 1.816289 0.744289 1.022891 1.064721 0.415657 0.347902 0.773736 1.527156 1.136404 0.028489 0.350665 0.276554 1.845571 0.604279 0.038246 1.467967 1.374232 0.791320 0.557650 1.482264 -0.049230 0.938062 1.746697 0.132063 1.652819 1.777078 0.039226 1.666124 1.061506 0.103648 0.026453 0.558713 0.008013 0.082476)
+ 7.170025 #r(0.000000 0.735367 0.761108 1.674444 1.148859 1.727214 0.506019 0.166885 0.301941 0.289424 1.228914 1.514765 1.088336 -0.084927 1.605465 0.191699 1.059128 -0.394739 0.884851 1.807751 0.747579 1.030098 1.071564 0.404714 0.353145 0.766117 1.522688 1.133668 0.028958 0.353932 0.272825 1.843589 0.590551 0.041758 1.471960 1.368203 0.792332 0.554867 1.486774 -0.039669 0.938500 1.744333 0.139825 1.659686 1.776069 0.036261 1.664792 1.057651 0.104623 0.024123 0.551601 0.015304 0.093561)
+ 7.168422 #r(0.000000 0.734800 0.755002 1.678637 1.148472 1.726884 0.506566 0.162329 0.304752 0.290731 1.237477 1.522988 1.097235 -0.074667 1.611785 0.203012 1.069009 -0.398864 0.892774 1.815871 0.743283 1.031741 1.066124 0.407989 0.358481 0.762020 1.519272 1.133826 0.019027 0.362472 0.267333 1.835621 0.594226 0.045578 1.461712 1.370620 0.794797 0.554188 1.488530 -0.030031 0.948673 1.753818 0.146713 1.671920 1.781890 0.035858 1.658572 1.054561 0.107770 0.028848 0.546289 0.017191 0.104880)
)
;;; 54 all -------------------------------------------------------------------------------- ; 7.348
-(vector 54 9.1825122833252 #(0 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 0 1 1 1 0 1 1 0 0 0 0 1 0 0 1 1)
+(vector 54 9.1825122833252 #r(0 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 0 1 1 1 0 1 1 0 0 0 0 1 0 0 1 1)
- 7.253898 #(0.000000 1.663275 -0.127344 1.382101 -0.144643 1.243444 0.071415 0.455351 1.200018 -0.228088 0.114774 0.009236 0.130605 1.041538 -0.220166 0.676007 1.432141 0.450339 0.554653 1.087402 1.040513 0.270076 0.433523 0.188787 1.457394 -0.061608 1.604147 1.071620 1.033490 -0.059301 1.622008 1.136168 0.012303 1.419176 0.768515 0.526817 1.171505 0.678139 1.461086 0.399056 0.554571 0.834287 1.199853 0.770698 1.010430 1.778823 1.630548 0.874770 0.206125 0.453526 0.079377 1.237714 0.535149 0.779971)
- 7.246128 #(0.000000 1.690671 -0.136333 1.336875 -0.134620 1.250743 0.054577 0.501967 1.180021 -0.191687 0.078154 -0.016563 0.154368 1.002103 -0.214317 0.587755 1.338737 0.453959 0.537717 1.091959 0.985931 0.262538 0.420710 0.232601 1.445283 -0.098407 1.587696 0.956027 0.987798 -0.092532 1.496016 1.083347 0.008893 1.420578 0.727868 0.503289 1.042996 0.653965 1.415827 0.315669 0.540912 0.741976 1.142476 0.660826 0.954089 1.754673 1.467880 0.779704 0.086156 0.370375 0.034370 1.174035 0.430349 0.715725)
- 7.245591 #(0.000000 1.686555 -0.134051 1.339159 -0.139744 1.249317 0.052837 0.496203 1.186868 -0.190398 0.085087 -0.014578 0.148546 1.002089 -0.222856 0.596406 1.341405 0.448014 0.534314 1.092500 0.986488 0.256202 0.422281 0.225300 1.439830 -0.098135 1.589744 0.958350 0.982778 -0.091329 1.504731 1.087277 -0.000312 1.417081 0.729922 0.495573 1.045881 0.653448 1.408480 0.315198 0.535103 0.741972 1.142084 0.667364 0.951873 1.748001 1.479988 0.783357 0.087811 0.364817 0.035646 1.164454 0.433389 0.712104)
+ 7.253898 #r(0.000000 1.663275 -0.127344 1.382101 -0.144643 1.243444 0.071415 0.455351 1.200018 -0.228088 0.114774 0.009236 0.130605 1.041538 -0.220166 0.676007 1.432141 0.450339 0.554653 1.087402 1.040513 0.270076 0.433523 0.188787 1.457394 -0.061608 1.604147 1.071620 1.033490 -0.059301 1.622008 1.136168 0.012303 1.419176 0.768515 0.526817 1.171505 0.678139 1.461086 0.399056 0.554571 0.834287 1.199853 0.770698 1.010430 1.778823 1.630548 0.874770 0.206125 0.453526 0.079377 1.237714 0.535149 0.779971)
+ 7.246128 #r(0.000000 1.690671 -0.136333 1.336875 -0.134620 1.250743 0.054577 0.501967 1.180021 -0.191687 0.078154 -0.016563 0.154368 1.002103 -0.214317 0.587755 1.338737 0.453959 0.537717 1.091959 0.985931 0.262538 0.420710 0.232601 1.445283 -0.098407 1.587696 0.956027 0.987798 -0.092532 1.496016 1.083347 0.008893 1.420578 0.727868 0.503289 1.042996 0.653965 1.415827 0.315669 0.540912 0.741976 1.142476 0.660826 0.954089 1.754673 1.467880 0.779704 0.086156 0.370375 0.034370 1.174035 0.430349 0.715725)
+ 7.245591 #r(0.000000 1.686555 -0.134051 1.339159 -0.139744 1.249317 0.052837 0.496203 1.186868 -0.190398 0.085087 -0.014578 0.148546 1.002089 -0.222856 0.596406 1.341405 0.448014 0.534314 1.092500 0.986488 0.256202 0.422281 0.225300 1.439830 -0.098135 1.589744 0.958350 0.982778 -0.091329 1.504731 1.087277 -0.000312 1.417081 0.729922 0.495573 1.045881 0.653448 1.408480 0.315198 0.535103 0.741972 1.142084 0.667364 0.951873 1.748001 1.479988 0.783357 0.087811 0.364817 0.035646 1.164454 0.433389 0.712104)
)
;;; 55 all -------------------------------------------------------------------------------- ; 7.416
-(vector 55 9.0889595835043 #(0 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 0 1 0 1)
+(vector 55 9.0889595835043 #r(0 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 0 1 0 1)
- 7.328036 #(0.000000 0.947722 0.378414 1.734925 1.134763 1.116950 -0.197611 1.060282 0.984801 1.744033 0.450580 0.852453 1.635373 0.966832 1.084419 1.003901 1.404608 1.476265 -0.291566 1.533682 1.691990 0.972863 0.920394 1.410967 0.405768 0.418479 1.362359 0.024022 1.434953 0.091943 0.952661 1.025574 1.292952 0.834214 1.423909 0.663594 1.666584 0.346034 0.453528 -0.158265 1.069551 0.339500 0.250235 -0.001369 1.635787 0.775741 0.405595 1.391152 1.825120 -0.221132 -0.233774 0.866177 1.169485 0.610484 1.501517)
- 7.300139 #(0.000000 1.020956 0.293768 1.798256 1.119674 1.146994 -0.132937 1.003662 0.949888 1.796803 0.459925 0.880925 1.582417 0.875464 1.100289 0.952720 1.490815 1.407379 -0.298626 1.479744 1.580341 1.028316 0.802627 1.364981 0.250262 0.211014 1.412363 -0.072953 1.428751 0.047277 0.916222 0.964928 1.114795 0.871317 1.452807 0.648605 1.592871 0.307802 0.554241 -0.122514 1.103516 0.321014 0.250400 0.032285 1.623249 0.802559 0.366667 1.421272 1.732780 -0.264221 -0.262668 0.728446 1.186912 0.469786 1.716376)
- 7.299987 #(0.000000 1.020969 0.293796 1.798197 1.119668 1.147020 -0.132959 1.003677 0.949931 1.796829 0.459947 0.880914 1.582469 0.875424 1.100277 0.952769 1.490876 1.407382 -0.298616 1.479769 1.580356 1.028332 0.802614 1.364991 0.250327 0.211041 1.412324 -0.072992 1.428778 0.047292 0.916259 0.964910 1.114739 0.871338 1.452857 0.648648 1.592866 0.307820 0.554266 -0.122522 1.103511 0.320958 0.250360 0.032244 1.623283 0.802510 0.366699 1.421281 1.732770 -0.264247 -0.262690 0.728471 1.186845 0.469835 1.716425)
+ 7.328036 #r(0.000000 0.947722 0.378414 1.734925 1.134763 1.116950 -0.197611 1.060282 0.984801 1.744033 0.450580 0.852453 1.635373 0.966832 1.084419 1.003901 1.404608 1.476265 -0.291566 1.533682 1.691990 0.972863 0.920394 1.410967 0.405768 0.418479 1.362359 0.024022 1.434953 0.091943 0.952661 1.025574 1.292952 0.834214 1.423909 0.663594 1.666584 0.346034 0.453528 -0.158265 1.069551 0.339500 0.250235 -0.001369 1.635787 0.775741 0.405595 1.391152 1.825120 -0.221132 -0.233774 0.866177 1.169485 0.610484 1.501517)
+ 7.300139 #r(0.000000 1.020956 0.293768 1.798256 1.119674 1.146994 -0.132937 1.003662 0.949888 1.796803 0.459925 0.880925 1.582417 0.875464 1.100289 0.952720 1.490815 1.407379 -0.298626 1.479744 1.580341 1.028316 0.802627 1.364981 0.250262 0.211014 1.412363 -0.072953 1.428751 0.047277 0.916222 0.964928 1.114795 0.871317 1.452807 0.648605 1.592871 0.307802 0.554241 -0.122514 1.103516 0.321014 0.250400 0.032285 1.623249 0.802559 0.366667 1.421272 1.732780 -0.264221 -0.262668 0.728446 1.186912 0.469786 1.716376)
+ 7.299987 #r(0.000000 1.020969 0.293796 1.798197 1.119668 1.147020 -0.132959 1.003677 0.949931 1.796829 0.459947 0.880914 1.582469 0.875424 1.100277 0.952769 1.490876 1.407382 -0.298616 1.479769 1.580356 1.028332 0.802614 1.364991 0.250327 0.211041 1.412324 -0.072992 1.428778 0.047292 0.916259 0.964910 1.114739 0.871338 1.452857 0.648648 1.592866 0.307820 0.554266 -0.122522 1.103511 0.320958 0.250360 0.032244 1.623283 0.802510 0.366699 1.421281 1.732770 -0.264247 -0.262690 0.728471 1.186845 0.469835 1.716425)
;; 54+1
- 7.432099 #(0.000000 1.618747 -0.153449 1.551651 0.057022 0.983319 0.329322 0.592671 1.061368 -0.265451 0.093666 0.073689 0.191970 0.941940 -0.226532 0.630718 1.504459 0.398912 0.677456 0.969759 0.922508 0.474687 0.473824 0.106191 1.485519 0.211317 1.508720 1.087336 1.052013 0.035924 1.550864 1.050089 0.185510 1.339619 0.715238 0.544593 0.922333 0.813638 1.418714 0.428930 0.510114 0.892067 1.174189 0.405049 1.026718 -0.076773 1.305507 0.682450 0.215555 0.324834 -0.145842 1.269187 0.603278 0.899585 -0.345857)
+ 7.432099 #r(0.000000 1.618747 -0.153449 1.551651 0.057022 0.983319 0.329322 0.592671 1.061368 -0.265451 0.093666 0.073689 0.191970 0.941940 -0.226532 0.630718 1.504459 0.398912 0.677456 0.969759 0.922508 0.474687 0.473824 0.106191 1.485519 0.211317 1.508720 1.087336 1.052013 0.035924 1.550864 1.050089 0.185510 1.339619 0.715238 0.544593 0.922333 0.813638 1.418714 0.428930 0.510114 0.892067 1.174189 0.405049 1.026718 -0.076773 1.305507 0.682450 0.215555 0.324834 -0.145842 1.269187 0.603278 0.899585 -0.345857)
)
;;; 56 all -------------------------------------------------------------------------------- ; 7.483
-(vector 56 9.1394176483154 #(0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 1 0 0 1 1 1 1 0 0 0 1 0 1 1 1 1 1 0)
+(vector 56 9.1394176483154 #r(0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 1 0 0 1 1 1 1 0 0 0 1 0 1 1 1 1 1 0)
- 7.349437 #(0.000000 1.546087 1.523699 -0.222814 1.563242 0.073887 1.226569 1.346857 0.292837 1.634387 -0.251778 0.060895 -0.022143 1.595396 1.558207 0.543894 0.524391 1.131307 0.107395 0.049540 1.190567 0.105407 1.309188 1.049686 1.847136 1.739252 0.730834 0.631473 0.965848 1.428286 1.258515 1.585209 1.811352 1.268900 -0.020138 0.642231 1.575017 1.141819 0.549674 0.685664 0.941820 0.311404 0.683359 0.230880 0.725054 -0.246162 1.525527 0.596605 1.235099 0.021275 1.782957 1.875900 1.027532 0.553643 1.151157 -1.905652)
+ 7.349437 #r(0.000000 1.546087 1.523699 -0.222814 1.563242 0.073887 1.226569 1.346857 0.292837 1.634387 -0.251778 0.060895 -0.022143 1.595396 1.558207 0.543894 0.524391 1.131307 0.107395 0.049540 1.190567 0.105407 1.309188 1.049686 1.847136 1.739252 0.730834 0.631473 0.965848 1.428286 1.258515 1.585209 1.811352 1.268900 -0.020138 0.642231 1.575017 1.141819 0.549674 0.685664 0.941820 0.311404 0.683359 0.230880 0.725054 -0.246162 1.525527 0.596605 1.235099 0.021275 1.782957 1.875900 1.027532 0.553643 1.151157 -1.905652)
)
;;; 57 all -------------------------------------------------------------------------------- ; 7.5498
-(vector 57 9.370246887207 #(0 1 1 0 1 0 1 0 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 1 0 0)
+(vector 57 9.370246887207 #r(0 1 1 0 1 0 1 0 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 1 0 0)
- 7.442633 #(0.000000 0.628456 1.084630 0.786609 1.548782 0.496773 0.435493 0.422694 1.803774 0.918361 0.997194 1.049098 0.185525 0.660957 1.525706 1.561906 1.871425 -0.071743 1.628047 1.493214 -0.116955 0.206404 -0.134909 1.268493 0.758821 0.611040 1.564268 1.138473 1.072129 1.438518 1.711282 0.723211 0.929199 1.378242 0.744685 0.403345 1.655964 0.451399 1.464052 1.394001 0.957137 1.897197 1.337811 0.214489 1.090057 0.644474 1.099729 1.418576 0.330091 1.432560 0.258645 0.901692 0.058744 1.707516 1.251524 1.445949 1.245045)
- 7.441636 #(0.000000 0.622348 1.085878 0.781116 1.543398 0.503464 0.436201 0.436360 1.804081 0.922203 0.997170 1.054550 0.182189 0.658266 1.514505 1.560476 1.876098 -0.073438 1.631568 1.494541 -0.115431 0.197586 -0.136568 1.260188 0.759194 0.602693 1.552249 1.137538 1.078917 1.441614 1.707363 0.723396 0.932457 1.367004 0.727498 0.408065 1.643814 0.447632 1.455697 1.392558 0.945330 1.895625 1.343191 0.216675 1.082075 0.643569 1.094957 1.407053 0.340178 1.425341 0.271660 0.889612 0.056066 1.700603 1.245948 1.440641 1.250791)
- 7.441467 #(0.000000 0.622317 1.086709 0.781210 1.543555 0.503242 0.435992 0.435167 1.805588 0.922076 0.997063 1.053812 0.182167 0.657560 1.514895 1.560202 1.875822 -0.073404 1.631644 1.494624 -0.115787 0.198249 -0.137542 1.260390 0.759500 0.603371 1.553048 1.137852 1.078723 1.442159 1.707807 0.723280 0.931846 1.367412 0.727839 0.407781 1.645303 0.447632 1.455182 1.393340 0.945452 1.895842 1.343341 0.216348 1.083126 0.643542 1.095796 1.407207 0.340817 1.425984 0.271019 0.890314 0.056560 1.699782 1.246486 1.440900 1.252017)
+ 7.442633 #r(0.000000 0.628456 1.084630 0.786609 1.548782 0.496773 0.435493 0.422694 1.803774 0.918361 0.997194 1.049098 0.185525 0.660957 1.525706 1.561906 1.871425 -0.071743 1.628047 1.493214 -0.116955 0.206404 -0.134909 1.268493 0.758821 0.611040 1.564268 1.138473 1.072129 1.438518 1.711282 0.723211 0.929199 1.378242 0.744685 0.403345 1.655964 0.451399 1.464052 1.394001 0.957137 1.897197 1.337811 0.214489 1.090057 0.644474 1.099729 1.418576 0.330091 1.432560 0.258645 0.901692 0.058744 1.707516 1.251524 1.445949 1.245045)
+ 7.441636 #r(0.000000 0.622348 1.085878 0.781116 1.543398 0.503464 0.436201 0.436360 1.804081 0.922203 0.997170 1.054550 0.182189 0.658266 1.514505 1.560476 1.876098 -0.073438 1.631568 1.494541 -0.115431 0.197586 -0.136568 1.260188 0.759194 0.602693 1.552249 1.137538 1.078917 1.441614 1.707363 0.723396 0.932457 1.367004 0.727498 0.408065 1.643814 0.447632 1.455697 1.392558 0.945330 1.895625 1.343191 0.216675 1.082075 0.643569 1.094957 1.407053 0.340178 1.425341 0.271660 0.889612 0.056066 1.700603 1.245948 1.440641 1.250791)
+ 7.441467 #r(0.000000 0.622317 1.086709 0.781210 1.543555 0.503242 0.435992 0.435167 1.805588 0.922076 0.997063 1.053812 0.182167 0.657560 1.514895 1.560202 1.875822 -0.073404 1.631644 1.494624 -0.115787 0.198249 -0.137542 1.260390 0.759500 0.603371 1.553048 1.137852 1.078723 1.442159 1.707807 0.723280 0.931846 1.367412 0.727839 0.407781 1.645303 0.447632 1.455182 1.393340 0.945452 1.895842 1.343341 0.216348 1.083126 0.643542 1.095796 1.407207 0.340817 1.425984 0.271019 0.890314 0.056560 1.699782 1.246486 1.440900 1.252017)
;; 56+1
- 7.588529 #(0.000000 1.559006 1.528143 -0.234828 1.510743 0.072763 1.134383 1.362254 0.303204 1.570684 -0.091506 0.027141 0.127155 1.600459 1.489127 0.559851 0.585109 1.217750 0.060591 0.195572 1.371350 0.291252 1.406886 1.100984 -0.016324 1.766768 0.695302 0.610137 0.999643 1.441896 1.186797 1.655783 1.557906 1.163328 -0.045033 0.552673 1.529458 1.154094 0.507727 0.569429 0.791719 0.355519 0.577628 0.178344 0.617622 -0.241675 1.589877 0.728380 1.261435 0.065292 1.580960 -0.002275 1.148223 0.618586 1.286855 -1.867003 0.103477)
+ 7.588529 #r(0.000000 1.559006 1.528143 -0.234828 1.510743 0.072763 1.134383 1.362254 0.303204 1.570684 -0.091506 0.027141 0.127155 1.600459 1.489127 0.559851 0.585109 1.217750 0.060591 0.195572 1.371350 0.291252 1.406886 1.100984 -0.016324 1.766768 0.695302 0.610137 0.999643 1.441896 1.186797 1.655783 1.557906 1.163328 -0.045033 0.552673 1.529458 1.154094 0.507727 0.569429 0.791719 0.355519 0.577628 0.178344 0.617622 -0.241675 1.589877 0.728380 1.261435 0.065292 1.580960 -0.002275 1.148223 0.618586 1.286855 -1.867003 0.103477)
)
;;; 58 all -------------------------------------------------------------------------------- ; 7.6157
-(vector 58 9.4419231414795 #(0 0 1 1 1 0 1 1 0 0 0 0 1 0 1 0 1 0 0 0 0 0 0 0 0 0 1 0 1 1 1 1 0 1 0 0 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 1)
+(vector 58 9.4419231414795 #r(0 0 1 1 1 0 1 1 0 0 0 0 1 0 1 0 1 0 0 0 0 0 0 0 0 0 1 0 1 1 1 1 0 1 0 0 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 1)
- 7.593225 #(0.000000 0.986536 1.505069 0.859324 0.384061 0.501999 -0.052945 0.091682 1.243523 1.160936 0.166126 1.095539 1.756174 -0.122227 0.552109 1.557396 0.685859 1.585162 1.476945 1.055076 1.281043 0.783847 1.368420 0.615588 0.179246 0.641014 1.029588 -0.186574 0.302199 -0.049566 0.358796 -0.163645 1.827318 0.906618 1.173192 -0.306816 0.026558 0.176625 -0.050521 -0.001713 0.047940 0.417922 -0.025755 0.782149 0.436145 0.202813 1.499347 0.776547 1.362707 0.702487 -0.159222 1.853688 0.812543 0.355313 1.668872 1.299867 1.606542 0.186584)
+ 7.593225 #r(0.000000 0.986536 1.505069 0.859324 0.384061 0.501999 -0.052945 0.091682 1.243523 1.160936 0.166126 1.095539 1.756174 -0.122227 0.552109 1.557396 0.685859 1.585162 1.476945 1.055076 1.281043 0.783847 1.368420 0.615588 0.179246 0.641014 1.029588 -0.186574 0.302199 -0.049566 0.358796 -0.163645 1.827318 0.906618 1.173192 -0.306816 0.026558 0.176625 -0.050521 -0.001713 0.047940 0.417922 -0.025755 0.782149 0.436145 0.202813 1.499347 0.776547 1.362707 0.702487 -0.159222 1.853688 0.812543 0.355313 1.668872 1.299867 1.606542 0.186584)
;; pp:
- 7.586012 #(0.000000 0.718317 1.202315 0.028202 0.604627 1.135917 1.727021 0.381274 1.040230 1.739246 0.978472 1.777017 0.523285 1.243580 0.029135 1.381437 0.426286 1.404192 0.617991 1.834215 0.844002 0.191054 1.403866 0.517083 0.013036 1.338892 0.991152 0.141969 1.593581 0.974013 0.805540 -0.094361 1.826176 1.316543 1.040287 0.818373 0.169416 0.148481 -0.005247 1.691109 1.757644 1.290544 1.656395 1.204579 1.394324 1.303854 1.338185 1.515030 1.707660 1.781840 0.030717 0.283137 0.603418 0.969911 1.476088 1.200110 0.180175 0.633552)
+ 7.586012 #r(0.000000 0.718317 1.202315 0.028202 0.604627 1.135917 1.727021 0.381274 1.040230 1.739246 0.978472 1.777017 0.523285 1.243580 0.029135 1.381437 0.426286 1.404192 0.617991 1.834215 0.844002 0.191054 1.403866 0.517083 0.013036 1.338892 0.991152 0.141969 1.593581 0.974013 0.805540 -0.094361 1.826176 1.316543 1.040287 0.818373 0.169416 0.148481 -0.005247 1.691109 1.757644 1.290544 1.656395 1.204579 1.394324 1.303854 1.338185 1.515030 1.707660 1.781840 0.030717 0.283137 0.603418 0.969911 1.476088 1.200110 0.180175 0.633552)
;; pp1:
- 7.594343 #(0.000000 0.749835 1.196036 0.047415 0.621780 1.104858 1.683423 0.410089 0.997331 1.769746 1.019444 1.735512 0.510619 1.182024 0.010849 1.425649 0.362140 1.372448 0.624015 1.767029 0.754918 0.170009 1.406108 0.542718 -0.053715 1.339230 0.959996 0.102424 1.529396 0.978636 0.817177 -0.083573 1.854806 1.266587 1.089732 0.774700 0.147541 0.176983 -0.055229 1.674926 1.784675 1.300584 1.684703 1.169175 1.432021 1.273282 1.317555 1.468408 1.655397 1.821619 -0.009845 0.244752 0.605771 0.971746 1.410204 1.112895 0.141141 0.622757)
+ 7.594343 #r(0.000000 0.749835 1.196036 0.047415 0.621780 1.104858 1.683423 0.410089 0.997331 1.769746 1.019444 1.735512 0.510619 1.182024 0.010849 1.425649 0.362140 1.372448 0.624015 1.767029 0.754918 0.170009 1.406108 0.542718 -0.053715 1.339230 0.959996 0.102424 1.529396 0.978636 0.817177 -0.083573 1.854806 1.266587 1.089732 0.774700 0.147541 0.176983 -0.055229 1.674926 1.784675 1.300584 1.684703 1.169175 1.432021 1.273282 1.317555 1.468408 1.655397 1.821619 -0.009845 0.244752 0.605771 0.971746 1.410204 1.112895 0.141141 0.622757)
- 7.604882 #(0.000000 1.003143 -0.865267 0.010219 -0.099642 -0.478021 -0.093216 0.744325 -0.039294 -0.002416 0.551785 0.316654 -0.123222 0.301399 -0.383480 -0.165893 -0.726009 0.524402 0.651077 -0.962303 0.315215 -0.603015 0.258064 -0.340148 -0.256538 -0.041913 -0.379049 -0.712938 -0.349442 0.451149 -0.446083 0.896871 -0.490206 -0.472734 0.420264 0.151583 0.131069 0.834014 0.859212 0.483964 -0.544840 -0.090156 0.432176 -0.243993 -0.843563 -0.050600 -0.631713 0.342919 0.025289 0.027400 1.444366 -0.042492 -1.145968 0.638141 -0.833781 -0.384767 -0.149344 0.896836)
+ 7.604882 #r(0.000000 1.003143 -0.865267 0.010219 -0.099642 -0.478021 -0.093216 0.744325 -0.039294 -0.002416 0.551785 0.316654 -0.123222 0.301399 -0.383480 -0.165893 -0.726009 0.524402 0.651077 -0.962303 0.315215 -0.603015 0.258064 -0.340148 -0.256538 -0.041913 -0.379049 -0.712938 -0.349442 0.451149 -0.446083 0.896871 -0.490206 -0.472734 0.420264 0.151583 0.131069 0.834014 0.859212 0.483964 -0.544840 -0.090156 0.432176 -0.243993 -0.843563 -0.050600 -0.631713 0.342919 0.025289 0.027400 1.444366 -0.042492 -1.145968 0.638141 -0.833781 -0.384767 -0.149344 0.896836)
;; 57+1
- 7.533390 #(0.000000 0.631892 1.030548 0.996535 1.749363 0.527130 0.477024 0.368639 1.802926 1.003296 1.026792 0.861445 0.354012 0.677047 1.520092 1.568568 1.887052 -0.077599 1.681866 1.559188 -0.163779 -0.032281 -0.010624 1.336711 0.753633 0.560677 1.590572 1.250944 1.018806 1.569329 1.806513 0.820053 1.037991 1.389344 0.762236 0.480656 1.661302 0.465658 1.499904 1.500135 0.971523 1.890287 1.276369 0.072382 1.249962 0.582710 1.223535 1.436175 0.383524 1.412000 0.135455 0.769171 0.142483 1.827353 1.151930 1.547046 1.202745 -0.195258)
+ 7.533390 #r(0.000000 0.631892 1.030548 0.996535 1.749363 0.527130 0.477024 0.368639 1.802926 1.003296 1.026792 0.861445 0.354012 0.677047 1.520092 1.568568 1.887052 -0.077599 1.681866 1.559188 -0.163779 -0.032281 -0.010624 1.336711 0.753633 0.560677 1.590572 1.250944 1.018806 1.569329 1.806513 0.820053 1.037991 1.389344 0.762236 0.480656 1.661302 0.465658 1.499904 1.500135 0.971523 1.890287 1.276369 0.072382 1.249962 0.582710 1.223535 1.436175 0.383524 1.412000 0.135455 0.769171 0.142483 1.827353 1.151930 1.547046 1.202745 -0.195258)
- 7.481139 #(0.000000 0.494120 0.912027 1.088506 1.796520 0.662315 0.621396 0.504785 1.809811 0.899674 1.186628 0.627937 0.587445 0.746949 1.418182 1.435063 1.844205 -0.044267 1.752818 1.424221 -0.141018 -0.093784 -0.133478 1.461699 0.840220 0.767006 1.740731 1.152491 1.108382 1.653182 1.853596 0.981136 1.198681 1.579726 0.839579 0.463906 1.810603 0.643978 1.514569 1.529989 1.033048 0.123830 1.430921 0.210010 1.371841 0.593103 1.143424 1.331116 0.451352 1.357884 0.020742 0.723087 0.311054 -0.015301 1.089900 1.570530 1.273463 -0.350924)
- 7.471443 #(0.000000 0.426257 0.958229 1.101908 1.838005 0.610307 0.610431 0.402294 1.784945 0.821317 1.119801 0.451192 0.541444 0.688311 1.334853 1.336110 1.825022 -0.121597 1.624253 1.303585 -0.201276 -0.206522 -0.234612 1.368607 0.780881 0.700656 1.644105 0.970363 1.079078 1.564363 1.736314 0.925048 1.037757 1.476082 0.706932 0.300800 1.747548 0.507618 1.347506 1.440798 0.870823 -0.047835 1.238022 0.066382 1.125573 0.437220 0.934851 1.197820 0.289481 1.232537 -0.191118 0.529022 0.086441 -0.284966 0.840338 1.327489 1.118018 -0.608987)
+ 7.481139 #r(0.000000 0.494120 0.912027 1.088506 1.796520 0.662315 0.621396 0.504785 1.809811 0.899674 1.186628 0.627937 0.587445 0.746949 1.418182 1.435063 1.844205 -0.044267 1.752818 1.424221 -0.141018 -0.093784 -0.133478 1.461699 0.840220 0.767006 1.740731 1.152491 1.108382 1.653182 1.853596 0.981136 1.198681 1.579726 0.839579 0.463906 1.810603 0.643978 1.514569 1.529989 1.033048 0.123830 1.430921 0.210010 1.371841 0.593103 1.143424 1.331116 0.451352 1.357884 0.020742 0.723087 0.311054 -0.015301 1.089900 1.570530 1.273463 -0.350924)
+ 7.471443 #r(0.000000 0.426257 0.958229 1.101908 1.838005 0.610307 0.610431 0.402294 1.784945 0.821317 1.119801 0.451192 0.541444 0.688311 1.334853 1.336110 1.825022 -0.121597 1.624253 1.303585 -0.201276 -0.206522 -0.234612 1.368607 0.780881 0.700656 1.644105 0.970363 1.079078 1.564363 1.736314 0.925048 1.037757 1.476082 0.706932 0.300800 1.747548 0.507618 1.347506 1.440798 0.870823 -0.047835 1.238022 0.066382 1.125573 0.437220 0.934851 1.197820 0.289481 1.232537 -0.191118 0.529022 0.086441 -0.284966 0.840338 1.327489 1.118018 -0.608987)
)
;;; 59 all -------------------------------------------------------------------------------- ; 7.6811
-(vector 59 9.4819116592407 #(0 1 0 0 1 0 1 1 1 0 0 1 0 1 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 1 1 1 1 1 1 0 0)
+(vector 59 9.4819116592407 #r(0 1 0 0 1 0 1 1 1 0 0 1 0 1 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 1 1 1 1 1 1 0 0)
- 7.633759 #(0.000000 -0.102106 0.411390 1.377383 1.497595 0.124070 0.977823 0.515946 1.620540 0.196166 1.145526 -0.281630 -0.195296 1.404391 0.189637 1.328165 -0.070129 0.678415 0.164240 0.284857 -0.029704 0.602274 0.993542 1.271589 0.492176 0.728322 0.791637 0.338071 1.390375 1.125972 0.444347 0.171840 0.693527 1.264131 0.439002 1.477092 0.989010 0.611429 0.828210 0.480652 -1.722373 1.692898 0.138317 0.412855 0.367615 1.849818 1.092865 1.381771 0.372051 1.523953 1.713816 0.119731 0.675902 0.655871 0.560189 0.993051 1.958772 1.303462 0.504587)
+ 7.633759 #r(0.000000 -0.102106 0.411390 1.377383 1.497595 0.124070 0.977823 0.515946 1.620540 0.196166 1.145526 -0.281630 -0.195296 1.404391 0.189637 1.328165 -0.070129 0.678415 0.164240 0.284857 -0.029704 0.602274 0.993542 1.271589 0.492176 0.728322 0.791637 0.338071 1.390375 1.125972 0.444347 0.171840 0.693527 1.264131 0.439002 1.477092 0.989010 0.611429 0.828210 0.480652 -1.722373 1.692898 0.138317 0.412855 0.367615 1.849818 1.092865 1.381771 0.372051 1.523953 1.713816 0.119731 0.675902 0.655871 0.560189 0.993051 1.958772 1.303462 0.504587)
;; 60-1
- 7.668205 #(0.000000 0.260999 0.306319 0.829788 0.601433 -0.678190 0.032714 -0.031883 1.182121 0.436499 0.860411 1.529871 0.029506 -0.270659 1.490132 0.906453 0.632531 -0.000842 1.433413 0.099705 1.394290 1.492347 1.704612 0.859780 -0.064335 0.888916 0.823173 -0.092258 1.655169 1.087888 0.521033 0.694079 0.255286 0.100258 0.664742 0.255239 -0.004409 -0.020809 -0.246563 0.401722 0.426493 1.163559 0.741366 0.718411 0.770050 0.987515 -0.377733 -0.050194 0.650015 -0.412935 -0.094285 0.634376 0.230847 1.070214 0.078695 0.757129 0.097582 0.734853 -0.028246)
+ 7.668205 #r(0.000000 0.260999 0.306319 0.829788 0.601433 -0.678190 0.032714 -0.031883 1.182121 0.436499 0.860411 1.529871 0.029506 -0.270659 1.490132 0.906453 0.632531 -0.000842 1.433413 0.099705 1.394290 1.492347 1.704612 0.859780 -0.064335 0.888916 0.823173 -0.092258 1.655169 1.087888 0.521033 0.694079 0.255286 0.100258 0.664742 0.255239 -0.004409 -0.020809 -0.246563 0.401722 0.426493 1.163559 0.741366 0.718411 0.770050 0.987515 -0.377733 -0.050194 0.650015 -0.412935 -0.094285 0.634376 0.230847 1.070214 0.078695 0.757129 0.097582 0.734853 -0.028246)
; 58+1
- 7.567729 #(0.000000 0.753874 1.108606 0.974281 0.283985 0.662033 0.650997 0.171167 1.713034 0.855505 1.018749 0.891985 0.435917 0.540560 1.459830 1.555159 -0.222214 -0.376165 1.777521 1.607719 -0.138482 -0.185224 0.145078 1.584935 1.029502 0.327951 1.867036 1.174458 1.172033 1.652747 -0.202580 1.284972 0.919829 1.617599 1.002052 0.275343 0.183263 0.550709 1.391786 1.438151 1.764529 0.225407 1.674751 0.321832 1.364256 0.748496 1.336450 1.931791 0.857675 1.688807 0.307620 0.802036 0.148078 0.020000 1.074227 1.654778 1.010253 0.016684 -0.457710)
- 7.503908 #(0.000000 0.755402 1.031043 1.054810 0.281310 0.638484 0.678755 -0.061091 1.874942 1.026651 1.013456 0.902683 0.466589 0.656849 1.693231 1.404646 -0.263499 -0.445923 1.593863 1.790864 -0.147432 -0.163796 0.230058 1.683194 1.076008 0.167830 1.806973 1.082076 1.043689 1.852409 -0.288292 1.355796 0.902626 1.723859 1.100962 0.151371 0.713536 0.566031 1.310021 1.519736 1.945202 0.276664 -0.060810 0.310036 1.449414 0.880895 1.568827 0.004992 1.081894 1.776013 0.590232 0.884973 0.104276 0.124961 0.994848 1.794748 0.874122 -0.016952 -0.401667)
+ 7.567729 #r(0.000000 0.753874 1.108606 0.974281 0.283985 0.662033 0.650997 0.171167 1.713034 0.855505 1.018749 0.891985 0.435917 0.540560 1.459830 1.555159 -0.222214 -0.376165 1.777521 1.607719 -0.138482 -0.185224 0.145078 1.584935 1.029502 0.327951 1.867036 1.174458 1.172033 1.652747 -0.202580 1.284972 0.919829 1.617599 1.002052 0.275343 0.183263 0.550709 1.391786 1.438151 1.764529 0.225407 1.674751 0.321832 1.364256 0.748496 1.336450 1.931791 0.857675 1.688807 0.307620 0.802036 0.148078 0.020000 1.074227 1.654778 1.010253 0.016684 -0.457710)
+ 7.503908 #r(0.000000 0.755402 1.031043 1.054810 0.281310 0.638484 0.678755 -0.061091 1.874942 1.026651 1.013456 0.902683 0.466589 0.656849 1.693231 1.404646 -0.263499 -0.445923 1.593863 1.790864 -0.147432 -0.163796 0.230058 1.683194 1.076008 0.167830 1.806973 1.082076 1.043689 1.852409 -0.288292 1.355796 0.902626 1.723859 1.100962 0.151371 0.713536 0.566031 1.310021 1.519736 1.945202 0.276664 -0.060810 0.310036 1.449414 0.880895 1.568827 0.004992 1.081894 1.776013 0.590232 0.884973 0.104276 0.124961 0.994848 1.794748 0.874122 -0.016952 -0.401667)
- 7.474074 #(0.000000 0.784407 1.041782 1.035925 0.294935 0.427093 0.721984 0.092420 1.735766 1.156420 1.019936 1.054348 0.499760 0.769486 1.715944 1.586067 -0.192704 -0.173666 1.684164 1.921163 0.055086 -0.007516 0.369080 1.699228 1.136967 0.294437 -0.044080 1.192357 1.158602 -0.133550 -0.087984 1.529854 0.947299 1.902997 1.119257 0.426808 0.806222 0.633135 1.477237 1.877676 0.160692 0.419085 0.158979 0.467821 1.632899 1.068960 1.780863 0.236819 1.171400 0.053940 0.893322 1.037749 0.323864 0.262747 1.171663 1.870355 1.006856 0.079239 0.012532)
- 7.470479 #(0.000000 0.785689 1.041036 1.049808 0.305124 0.429787 0.717256 0.088775 1.726292 1.152522 1.020546 1.048587 0.486018 0.780821 1.724902 1.577515 -0.178695 -0.185526 1.691389 1.934796 0.046932 -0.005323 0.368779 1.699941 1.124598 0.296039 -0.054371 1.191052 1.153518 -0.147974 -0.090335 1.539271 0.964525 1.914880 1.137202 0.430133 0.776829 0.627048 1.462344 1.865385 0.169020 0.418703 0.158957 0.462524 1.623646 1.046298 1.759655 0.230031 1.170263 0.041395 0.885317 1.027465 0.314913 0.257396 1.158882 1.872474 1.012965 0.087584 0.001521)
- 7.469439 #(0.000000 0.786053 1.040825 1.050267 0.305344 0.429180 0.717962 0.088837 1.725419 1.152362 1.020784 1.048370 0.486073 0.781280 1.724120 1.577030 -0.178365 -0.185633 1.691507 1.934596 0.047136 -0.005417 0.368219 1.700165 1.124068 0.296017 -0.054066 1.191543 1.153852 -0.148804 -0.090665 1.539214 0.964764 1.914412 1.137764 0.431014 0.776666 0.626264 1.462361 1.865260 0.168893 0.419387 0.159040 0.463215 1.623762 1.046651 1.759104 0.229882 1.170489 0.041888 0.885618 1.026993 0.314162 0.256790 1.158778 1.872242 1.012776 0.087727 0.001263)
+ 7.474074 #r(0.000000 0.784407 1.041782 1.035925 0.294935 0.427093 0.721984 0.092420 1.735766 1.156420 1.019936 1.054348 0.499760 0.769486 1.715944 1.586067 -0.192704 -0.173666 1.684164 1.921163 0.055086 -0.007516 0.369080 1.699228 1.136967 0.294437 -0.044080 1.192357 1.158602 -0.133550 -0.087984 1.529854 0.947299 1.902997 1.119257 0.426808 0.806222 0.633135 1.477237 1.877676 0.160692 0.419085 0.158979 0.467821 1.632899 1.068960 1.780863 0.236819 1.171400 0.053940 0.893322 1.037749 0.323864 0.262747 1.171663 1.870355 1.006856 0.079239 0.012532)
+ 7.470479 #r(0.000000 0.785689 1.041036 1.049808 0.305124 0.429787 0.717256 0.088775 1.726292 1.152522 1.020546 1.048587 0.486018 0.780821 1.724902 1.577515 -0.178695 -0.185526 1.691389 1.934796 0.046932 -0.005323 0.368779 1.699941 1.124598 0.296039 -0.054371 1.191052 1.153518 -0.147974 -0.090335 1.539271 0.964525 1.914880 1.137202 0.430133 0.776829 0.627048 1.462344 1.865385 0.169020 0.418703 0.158957 0.462524 1.623646 1.046298 1.759655 0.230031 1.170263 0.041395 0.885317 1.027465 0.314913 0.257396 1.158882 1.872474 1.012965 0.087584 0.001521)
+ 7.469439 #r(0.000000 0.786053 1.040825 1.050267 0.305344 0.429180 0.717962 0.088837 1.725419 1.152362 1.020784 1.048370 0.486073 0.781280 1.724120 1.577030 -0.178365 -0.185633 1.691507 1.934596 0.047136 -0.005417 0.368219 1.700165 1.124068 0.296017 -0.054066 1.191543 1.153852 -0.148804 -0.090665 1.539214 0.964764 1.914412 1.137764 0.431014 0.776666 0.626264 1.462361 1.865260 0.168893 0.419387 0.159040 0.463215 1.623762 1.046651 1.759104 0.229882 1.170489 0.041888 0.885618 1.026993 0.314162 0.256790 1.158778 1.872242 1.012776 0.087727 0.001263)
)
;;; 60 all -------------------------------------------------------------------------------- ; 7.7459
-(vector 60 9.575254043103 #(0 0 0 0 1 0 0 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1)
+(vector 60 9.575254043103 #r(0 0 0 0 1 0 0 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1)
- 7.588747 #(0.000000 0.303100 0.261228 0.917131 0.691793 -0.677124 0.027342 -0.014801 1.166154 0.416979 0.851167 1.410955 0.139409 -0.306122 1.416862 1.054300 0.792442 0.062922 1.507148 0.118287 1.375215 1.459904 1.620963 0.828106 -0.237368 0.987982 0.753194 0.096604 1.712227 1.239483 0.673351 0.871862 0.125962 0.260000 0.626286 0.147473 0.131774 0.201212 -0.194457 0.538798 0.418147 1.292448 0.871870 0.794549 0.988888 1.131816 -0.166311 0.052304 0.543793 -0.229410 0.113585 0.733683 0.271039 1.008427 1.788452 0.654055 0.106430 0.828086 0.097436 0.376461)
+ 7.588747 #r(0.000000 0.303100 0.261228 0.917131 0.691793 -0.677124 0.027342 -0.014801 1.166154 0.416979 0.851167 1.410955 0.139409 -0.306122 1.416862 1.054300 0.792442 0.062922 1.507148 0.118287 1.375215 1.459904 1.620963 0.828106 -0.237368 0.987982 0.753194 0.096604 1.712227 1.239483 0.673351 0.871862 0.125962 0.260000 0.626286 0.147473 0.131774 0.201212 -0.194457 0.538798 0.418147 1.292448 0.871870 0.794549 0.988888 1.131816 -0.166311 0.052304 0.543793 -0.229410 0.113585 0.733683 0.271039 1.008427 1.788452 0.654055 0.106430 0.828086 0.097436 0.376461)
- 7.602978 #(0.000000 0.343421 0.247838 0.890443 0.690536 -0.636145 0.032627 -0.000378 1.156652 0.432584 0.839393 1.416383 0.127840 -0.292709 1.416467 1.036542 0.772399 0.056651 1.495999 0.127272 1.372797 1.502550 1.644134 0.832570 -0.243375 0.997261 0.769525 0.097453 1.710505 1.253870 0.665368 0.892296 0.140093 0.282802 0.651418 0.158940 0.136050 0.208538 -0.153899 0.575825 0.407418 1.313964 0.907919 0.810047 0.999387 1.167125 -0.147437 0.049028 0.552121 -0.233036 0.124726 0.749826 0.278658 1.024092 1.803794 0.682067 0.122571 0.837344 0.113035 0.386515)
- 7.590331 #(0.000000 0.311984 0.250997 0.912573 0.685307 -0.665850 0.023992 -0.010652 1.155235 0.412085 0.828254 1.410116 0.128955 -0.317825 1.409520 1.027436 0.770269 0.045987 1.490193 0.103477 1.366721 1.457750 1.601967 0.817113 -0.255006 0.965021 0.733462 0.069204 1.685229 1.226151 0.638827 0.852828 0.104728 0.233598 0.610755 0.125702 0.105148 0.180856 -0.214881 0.523640 0.392812 1.269846 0.858737 0.764879 0.959798 1.115862 -0.192768 0.019990 0.508867 -0.268592 0.089478 0.700272 0.229721 0.977531 1.747500 0.628081 0.078292 0.787525 0.066967 0.336229)
+ 7.602978 #r(0.000000 0.343421 0.247838 0.890443 0.690536 -0.636145 0.032627 -0.000378 1.156652 0.432584 0.839393 1.416383 0.127840 -0.292709 1.416467 1.036542 0.772399 0.056651 1.495999 0.127272 1.372797 1.502550 1.644134 0.832570 -0.243375 0.997261 0.769525 0.097453 1.710505 1.253870 0.665368 0.892296 0.140093 0.282802 0.651418 0.158940 0.136050 0.208538 -0.153899 0.575825 0.407418 1.313964 0.907919 0.810047 0.999387 1.167125 -0.147437 0.049028 0.552121 -0.233036 0.124726 0.749826 0.278658 1.024092 1.803794 0.682067 0.122571 0.837344 0.113035 0.386515)
+ 7.590331 #r(0.000000 0.311984 0.250997 0.912573 0.685307 -0.665850 0.023992 -0.010652 1.155235 0.412085 0.828254 1.410116 0.128955 -0.317825 1.409520 1.027436 0.770269 0.045987 1.490193 0.103477 1.366721 1.457750 1.601967 0.817113 -0.255006 0.965021 0.733462 0.069204 1.685229 1.226151 0.638827 0.852828 0.104728 0.233598 0.610755 0.125702 0.105148 0.180856 -0.214881 0.523640 0.392812 1.269846 0.858737 0.764879 0.959798 1.115862 -0.192768 0.019990 0.508867 -0.268592 0.089478 0.700272 0.229721 0.977531 1.747500 0.628081 0.078292 0.787525 0.066967 0.336229)
;; 59+1
- 7.590282 #(0.000000 0.733138 1.013982 0.976445 0.137462 0.487623 0.751851 0.069472 1.549481 1.155782 1.046980 1.186482 0.568124 0.803953 1.789655 1.516254 -0.191066 -0.219967 1.700371 -0.224496 0.157791 -0.111548 0.405580 1.483434 1.154097 0.317993 -0.073620 0.992764 1.231445 -0.032509 -0.320514 1.522634 0.865145 1.901286 0.960655 0.354881 0.887935 0.632429 1.539449 1.796728 0.215526 0.494912 0.201957 0.338737 1.611488 0.995308 1.769709 0.293624 1.032457 -0.035773 0.969779 0.986746 0.288318 0.266521 1.043059 1.780802 1.010653 0.120423 -0.003596 0.427001)
+ 7.590282 #r(0.000000 0.733138 1.013982 0.976445 0.137462 0.487623 0.751851 0.069472 1.549481 1.155782 1.046980 1.186482 0.568124 0.803953 1.789655 1.516254 -0.191066 -0.219967 1.700371 -0.224496 0.157791 -0.111548 0.405580 1.483434 1.154097 0.317993 -0.073620 0.992764 1.231445 -0.032509 -0.320514 1.522634 0.865145 1.901286 0.960655 0.354881 0.887935 0.632429 1.539449 1.796728 0.215526 0.494912 0.201957 0.338737 1.611488 0.995308 1.769709 0.293624 1.032457 -0.035773 0.969779 0.986746 0.288318 0.266521 1.043059 1.780802 1.010653 0.120423 -0.003596 0.427001)
- 7.603891 #(0.000000 0.869514 1.080279 1.038282 0.135313 0.502512 0.753215 0.089242 1.596695 1.140586 1.072278 1.110589 0.576325 0.731075 1.742992 1.495632 -0.196475 -0.226828 1.727532 -0.133741 0.230207 -0.117450 0.423631 1.531789 1.092093 0.236032 -0.105598 1.029301 1.286697 -0.074793 -0.255644 1.497986 0.908690 1.870731 1.038299 0.451133 0.829007 0.646965 1.519446 -0.162832 0.219693 0.485075 0.227341 0.372733 1.638093 0.931769 1.686949 0.361408 1.025558 -0.066479 0.903195 0.950470 0.309255 0.305219 1.085274 1.776201 0.968529 0.071917 -0.078070 0.465046)
+ 7.603891 #r(0.000000 0.869514 1.080279 1.038282 0.135313 0.502512 0.753215 0.089242 1.596695 1.140586 1.072278 1.110589 0.576325 0.731075 1.742992 1.495632 -0.196475 -0.226828 1.727532 -0.133741 0.230207 -0.117450 0.423631 1.531789 1.092093 0.236032 -0.105598 1.029301 1.286697 -0.074793 -0.255644 1.497986 0.908690 1.870731 1.038299 0.451133 0.829007 0.646965 1.519446 -0.162832 0.219693 0.485075 0.227341 0.372733 1.638093 0.931769 1.686949 0.361408 1.025558 -0.066479 0.903195 0.950470 0.309255 0.305219 1.085274 1.776201 0.968529 0.071917 -0.078070 0.465046)
)
;;; 61 all -------------------------------------------------------------------------------- ; 7.8102
-(vector 61 9.9175914844707 #(0 0 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 1 1 0 1 0 1 1 1 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 1 0 1 0 0 0 1 1 0 1 1 0 0 1 0 1 1 0 0 1 1)
+(vector 61 9.9175914844707 #r(0 0 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 1 1 0 1 0 1 1 1 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 1 0 1 0 0 0 1 1 0 1 1 0 0 1 0 1 1 0 0 1 1)
- 7.764539 #(0.000000 0.501749 1.326260 -0.002830 0.440140 1.954758 -0.008202 0.999918 0.013473 0.542424 0.025115 0.566063 0.591900 -0.196853 0.709527 1.494974 0.701049 1.000710 1.261876 0.543883 0.605458 1.371875 -0.020772 0.931648 0.804346 0.926420 0.633175 0.027958 1.257581 0.427959 1.076239 -0.091270 1.537981 0.146252 0.640848 0.257921 1.798714 0.191485 0.663913 1.946117 1.528077 1.065296 -0.320137 1.459211 1.030583 1.751744 1.068882 0.287431 0.162869 0.095930 0.749409 1.433537 1.416981 -0.082974 0.219907 0.200900 1.575224 1.106230 0.733650 1.327996 1.447241)
+ 7.764539 #r(0.000000 0.501749 1.326260 -0.002830 0.440140 1.954758 -0.008202 0.999918 0.013473 0.542424 0.025115 0.566063 0.591900 -0.196853 0.709527 1.494974 0.701049 1.000710 1.261876 0.543883 0.605458 1.371875 -0.020772 0.931648 0.804346 0.926420 0.633175 0.027958 1.257581 0.427959 1.076239 -0.091270 1.537981 0.146252 0.640848 0.257921 1.798714 0.191485 0.663913 1.946117 1.528077 1.065296 -0.320137 1.459211 1.030583 1.751744 1.068882 0.287431 0.162869 0.095930 0.749409 1.433537 1.416981 -0.082974 0.219907 0.200900 1.575224 1.106230 0.733650 1.327996 1.447241)
;; pp:
- 7.753858 #(0.000000 0.319725 1.167003 1.840366 0.153760 1.056380 1.530371 0.068799 1.142107 1.630458 0.891055 1.372619 0.446834 1.091219 0.302492 1.393205 0.356103 1.143793 0.345744 1.558858 0.517245 1.731373 1.219460 0.122291 1.292388 0.849768 0.068299 1.373758 1.017991 0.385053 1.507703 1.138013 0.742591 0.285609 -0.125056 1.492440 1.058816 0.934160 0.593744 0.533680 -0.158800 0.426341 1.446080 1.766771 1.695866 1.560056 1.478090 1.737231 1.729597 0.116298 0.076540 -0.001350 0.001958 0.473570 1.021992 1.263777 1.530152 1.876463 0.039103 0.812610 1.066132)
+ 7.753858 #r(0.000000 0.319725 1.167003 1.840366 0.153760 1.056380 1.530371 0.068799 1.142107 1.630458 0.891055 1.372619 0.446834 1.091219 0.302492 1.393205 0.356103 1.143793 0.345744 1.558858 0.517245 1.731373 1.219460 0.122291 1.292388 0.849768 0.068299 1.373758 1.017991 0.385053 1.507703 1.138013 0.742591 0.285609 -0.125056 1.492440 1.058816 0.934160 0.593744 0.533680 -0.158800 0.426341 1.446080 1.766771 1.695866 1.560056 1.478090 1.737231 1.729597 0.116298 0.076540 -0.001350 0.001958 0.473570 1.021992 1.263777 1.530152 1.876463 0.039103 0.812610 1.066132)
;; 60+1
- 7.719726 #(0.000000 0.495866 0.238287 0.955451 0.664842 -0.741345 -0.016068 0.189591 1.246084 0.190700 0.813293 1.426582 0.137309 -0.550659 1.409544 1.156142 0.580188 0.236603 1.480403 0.143969 1.355902 1.548768 1.667460 1.127939 -0.533143 1.068231 0.694662 0.416966 1.883169 1.321748 0.722703 0.140270 -0.032806 0.383094 0.464150 -0.057082 0.068615 0.492413 -0.310601 0.595711 0.295373 1.620960 0.719532 0.564630 0.996701 1.168180 -0.350959 0.028358 0.396854 -0.442188 -0.001549 0.385465 0.224100 0.834114 -0.091422 1.036164 0.264065 1.003524 -0.049053 0.311309 -0.096718)
- 7.718493 #(0.000000 0.490794 0.242481 0.957898 0.662750 -0.742881 -0.016296 0.184736 1.253821 0.192761 0.810471 1.424644 0.139002 -0.552618 1.410815 1.159145 0.578377 0.235962 1.481912 0.147798 1.356870 1.551452 1.671348 1.124242 -0.535143 1.068113 0.692544 0.422646 1.876765 1.326092 0.722719 0.142011 -0.034790 0.381612 0.462371 -0.053314 0.063624 0.488941 -0.311525 0.596438 0.293354 1.627834 0.719558 0.563559 0.991769 1.160122 -0.358559 0.031628 0.400641 -0.444384 -0.013306 0.380359 0.226825 0.830723 -0.092522 1.028901 0.262077 1.004376 -0.055799 0.311561 -0.101231)
+ 7.719726 #r(0.000000 0.495866 0.238287 0.955451 0.664842 -0.741345 -0.016068 0.189591 1.246084 0.190700 0.813293 1.426582 0.137309 -0.550659 1.409544 1.156142 0.580188 0.236603 1.480403 0.143969 1.355902 1.548768 1.667460 1.127939 -0.533143 1.068231 0.694662 0.416966 1.883169 1.321748 0.722703 0.140270 -0.032806 0.383094 0.464150 -0.057082 0.068615 0.492413 -0.310601 0.595711 0.295373 1.620960 0.719532 0.564630 0.996701 1.168180 -0.350959 0.028358 0.396854 -0.442188 -0.001549 0.385465 0.224100 0.834114 -0.091422 1.036164 0.264065 1.003524 -0.049053 0.311309 -0.096718)
+ 7.718493 #r(0.000000 0.490794 0.242481 0.957898 0.662750 -0.742881 -0.016296 0.184736 1.253821 0.192761 0.810471 1.424644 0.139002 -0.552618 1.410815 1.159145 0.578377 0.235962 1.481912 0.147798 1.356870 1.551452 1.671348 1.124242 -0.535143 1.068113 0.692544 0.422646 1.876765 1.326092 0.722719 0.142011 -0.034790 0.381612 0.462371 -0.053314 0.063624 0.488941 -0.311525 0.596438 0.293354 1.627834 0.719558 0.563559 0.991769 1.160122 -0.358559 0.031628 0.400641 -0.444384 -0.013306 0.380359 0.226825 0.830723 -0.092522 1.028901 0.262077 1.004376 -0.055799 0.311561 -0.101231)
;; 60+1 again
- 7.740198 #(0.000000 0.626739 1.296742 1.008614 0.293424 0.673945 1.073779 -0.211836 1.789694 0.930583 0.771294 1.085775 0.936451 0.678115 1.636147 1.915783 -0.565114 0.016750 1.572576 0.084592 0.301576 -0.310737 0.302595 1.479719 0.731290 0.568211 0.229456 1.273391 1.255441 -0.231203 -0.609672 1.501491 0.823575 0.038113 1.037421 0.736999 0.580686 0.559838 1.809673 1.766341 0.365552 0.291068 0.626044 0.162497 1.648849 0.838850 1.891879 0.314825 1.268314 0.150269 0.467688 0.951233 0.016958 0.225952 0.821191 0.154682 1.000594 -0.136155 -0.311460 0.356212 0.395845)
- 7.729055 #(0.000000 0.585218 1.217250 0.968645 0.317516 0.671104 1.031096 -0.218820 1.818353 0.927202 0.776661 1.093725 0.958565 0.748559 1.659429 1.900342 -0.549276 -0.033594 1.531030 0.098096 0.293928 -0.287718 0.284175 1.493491 0.641827 0.540804 0.149517 1.305126 1.287830 -0.191264 -0.570626 1.464567 0.809850 0.041962 0.973217 0.694254 0.561611 0.538641 1.801023 1.733931 0.334890 0.298869 0.624020 0.134066 1.666975 0.854407 1.865345 0.369098 1.230856 0.127409 0.434359 0.938522 0.003558 0.217472 0.903037 0.161198 1.059970 -0.106324 -0.400141 0.345606 0.415173)
+ 7.740198 #r(0.000000 0.626739 1.296742 1.008614 0.293424 0.673945 1.073779 -0.211836 1.789694 0.930583 0.771294 1.085775 0.936451 0.678115 1.636147 1.915783 -0.565114 0.016750 1.572576 0.084592 0.301576 -0.310737 0.302595 1.479719 0.731290 0.568211 0.229456 1.273391 1.255441 -0.231203 -0.609672 1.501491 0.823575 0.038113 1.037421 0.736999 0.580686 0.559838 1.809673 1.766341 0.365552 0.291068 0.626044 0.162497 1.648849 0.838850 1.891879 0.314825 1.268314 0.150269 0.467688 0.951233 0.016958 0.225952 0.821191 0.154682 1.000594 -0.136155 -0.311460 0.356212 0.395845)
+ 7.729055 #r(0.000000 0.585218 1.217250 0.968645 0.317516 0.671104 1.031096 -0.218820 1.818353 0.927202 0.776661 1.093725 0.958565 0.748559 1.659429 1.900342 -0.549276 -0.033594 1.531030 0.098096 0.293928 -0.287718 0.284175 1.493491 0.641827 0.540804 0.149517 1.305126 1.287830 -0.191264 -0.570626 1.464567 0.809850 0.041962 0.973217 0.694254 0.561611 0.538641 1.801023 1.733931 0.334890 0.298869 0.624020 0.134066 1.666975 0.854407 1.865345 0.369098 1.230856 0.127409 0.434359 0.938522 0.003558 0.217472 0.903037 0.161198 1.059970 -0.106324 -0.400141 0.345606 0.415173)
)
;;; 62 all -------------------------------------------------------------------------------- ; 7.8740
-(vector 62 9.9292116165161 #(0 0 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 1 1 0 1 0 1 0 1 0 1 1 0 0 1 0 0 0 0 0 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 0 0 0 1 1 0 0 0 0 1 0)
+(vector 62 9.9292116165161 #r(0 0 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 1 1 0 1 0 1 0 1 0 1 1 0 0 1 0 0 0 0 0 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 0 0 0 1 1 0 0 0 0 1 0)
- 7.792971 #(0.000000 0.798156 1.779815 0.185967 1.670273 1.438952 1.815697 1.053871 0.087440 0.689337 0.052342 1.443903 1.423782 0.060887 1.727890 0.158639 0.952692 0.005318 0.914138 1.225205 0.683016 0.673829 0.109419 1.593849 0.225994 1.125995 0.418481 0.240605 0.743642 0.622844 0.353010 1.543180 1.534972 1.657806 0.217386 1.492286 1.132686 0.760213 1.147881 1.490201 0.001889 1.030507 1.289026 1.160822 0.387338 1.616191 1.464636 1.793960 1.874455 0.680274 1.683218 1.490668 0.689023 0.705366 0.946252 1.171040 0.109657 1.208442 0.793211 0.697986 1.263366 1.490757)
- 7.791756 #(0.000000 0.794255 1.776105 0.184372 1.667961 1.440185 1.817320 1.053449 0.082409 0.687457 0.048164 1.444125 1.423252 0.061081 1.727243 0.162932 0.953680 0.005222 0.917056 1.225176 0.682682 0.672057 0.108792 1.597133 0.224159 1.125545 0.417480 0.240811 0.741742 0.625708 0.356451 1.543976 1.537969 1.658348 0.209650 1.492266 1.130024 0.756184 1.143465 1.484763 0.002845 1.030762 1.291665 1.164813 0.385858 1.615844 1.466799 1.796934 1.874708 0.677123 1.684900 1.485354 0.688305 0.708676 0.948779 1.173098 0.106201 1.209490 0.787951 0.696086 1.257404 1.488223)
+ 7.792971 #r(0.000000 0.798156 1.779815 0.185967 1.670273 1.438952 1.815697 1.053871 0.087440 0.689337 0.052342 1.443903 1.423782 0.060887 1.727890 0.158639 0.952692 0.005318 0.914138 1.225205 0.683016 0.673829 0.109419 1.593849 0.225994 1.125995 0.418481 0.240605 0.743642 0.622844 0.353010 1.543180 1.534972 1.657806 0.217386 1.492286 1.132686 0.760213 1.147881 1.490201 0.001889 1.030507 1.289026 1.160822 0.387338 1.616191 1.464636 1.793960 1.874455 0.680274 1.683218 1.490668 0.689023 0.705366 0.946252 1.171040 0.109657 1.208442 0.793211 0.697986 1.263366 1.490757)
+ 7.791756 #r(0.000000 0.794255 1.776105 0.184372 1.667961 1.440185 1.817320 1.053449 0.082409 0.687457 0.048164 1.444125 1.423252 0.061081 1.727243 0.162932 0.953680 0.005222 0.917056 1.225176 0.682682 0.672057 0.108792 1.597133 0.224159 1.125545 0.417480 0.240811 0.741742 0.625708 0.356451 1.543976 1.537969 1.658348 0.209650 1.492266 1.130024 0.756184 1.143465 1.484763 0.002845 1.030762 1.291665 1.164813 0.385858 1.615844 1.466799 1.796934 1.874708 0.677123 1.684900 1.485354 0.688305 0.708676 0.948779 1.173098 0.106201 1.209490 0.787951 0.696086 1.257404 1.488223)
)
;;; 63 all -------------------------------------------------------------------------------- ; 7.9372
-(vector 63 9.9555234909058 #(0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 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 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 0 1 0)
+(vector 63 9.9555234909058 #r(0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 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 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 0 1 0)
- 7.900930 #(0.000000 0.112702 0.086876 0.634314 1.554089 0.214604 -0.203567 1.256800 0.100458 0.246503 1.488987 0.107459 1.914177 1.161772 1.897454 0.320257 1.283205 0.869894 1.466310 1.256681 0.167147 1.720679 0.949230 1.041227 1.129363 1.077459 1.317157 1.129579 0.390441 1.000383 0.208075 1.779398 1.501532 1.375523 -0.023235 1.338796 1.635364 1.234484 1.323162 0.435451 0.903475 1.821268 1.474898 0.271740 1.558504 0.547732 0.837920 0.522756 0.001164 1.566827 1.197274 1.065607 0.155490 1.019206 1.516032 -0.064964 -0.144993 0.026714 1.048953 1.812875 0.299023 0.685547 0.728053)
+ 7.900930 #r(0.000000 0.112702 0.086876 0.634314 1.554089 0.214604 -0.203567 1.256800 0.100458 0.246503 1.488987 0.107459 1.914177 1.161772 1.897454 0.320257 1.283205 0.869894 1.466310 1.256681 0.167147 1.720679 0.949230 1.041227 1.129363 1.077459 1.317157 1.129579 0.390441 1.000383 0.208075 1.779398 1.501532 1.375523 -0.023235 1.338796 1.635364 1.234484 1.323162 0.435451 0.903475 1.821268 1.474898 0.271740 1.558504 0.547732 0.837920 0.522756 0.001164 1.566827 1.197274 1.065607 0.155490 1.019206 1.516032 -0.064964 -0.144993 0.026714 1.048953 1.812875 0.299023 0.685547 0.728053)
- 7.876881 #(0.000000 0.730162 1.053547 1.853555 0.252740 0.906538 1.566071 0.152709 1.015626 1.877411 0.660255 1.513063 -0.004442 1.023537 0.043516 0.973208 -0.080949 0.883081 -0.126245 1.080582 0.224101 1.423101 0.674610 1.604094 0.756913 0.381286 1.606872 1.293154 0.397443 1.644011 1.075770 0.644269 0.164589 -0.255888 1.331182 0.886941 0.357762 0.438290 1.706681 1.847928 1.153249 1.311949 1.226087 1.303371 0.783267 0.589091 0.697039 0.351577 0.554862 0.724022 0.729451 0.902218 0.841292 1.194121 1.061823 1.429706 0.001167 -0.011629 0.776088 1.037188 1.244629 1.522995 0.260285)
+ 7.876881 #r(0.000000 0.730162 1.053547 1.853555 0.252740 0.906538 1.566071 0.152709 1.015626 1.877411 0.660255 1.513063 -0.004442 1.023537 0.043516 0.973208 -0.080949 0.883081 -0.126245 1.080582 0.224101 1.423101 0.674610 1.604094 0.756913 0.381286 1.606872 1.293154 0.397443 1.644011 1.075770 0.644269 0.164589 -0.255888 1.331182 0.886941 0.357762 0.438290 1.706681 1.847928 1.153249 1.311949 1.226087 1.303371 0.783267 0.589091 0.697039 0.351577 0.554862 0.724022 0.729451 0.902218 0.841292 1.194121 1.061823 1.429706 0.001167 -0.011629 0.776088 1.037188 1.244629 1.522995 0.260285)
;; 62+1
- 7.793784 #(0.000000 0.604834 1.810468 0.479158 1.833042 1.567985 -0.008145 1.139628 0.500517 1.068759 0.129009 1.082620 1.606832 0.022087 1.588661 -0.153130 0.676199 0.010115 0.698933 1.351365 0.913525 0.821255 0.678484 1.196033 0.336031 0.980483 0.167734 -0.166196 0.584197 0.895241 0.166400 1.887408 1.404231 1.357967 0.000767 1.273439 0.959305 0.625351 1.435222 1.581734 -0.027156 1.322760 1.634581 1.284691 0.324951 1.829465 1.346510 -0.070824 -0.074038 0.522954 1.755297 1.609271 1.147322 0.784177 0.915115 1.284187 -0.070344 1.582369 1.006518 0.377560 1.009520 1.290325 -0.295994)
- 7.792658 #(0.000000 0.604958 1.810993 0.479572 1.832501 1.568102 -0.008375 1.139554 0.500438 1.068891 0.129208 1.082690 1.606602 0.021403 1.588850 -0.152836 0.676059 0.009863 0.698550 1.351044 0.912935 0.821309 0.678462 1.195880 0.335962 0.980439 0.167296 -0.166103 0.584580 0.895326 0.165904 1.888061 1.403790 1.358315 0.000771 1.273834 0.958915 0.625533 1.434996 1.581517 -0.027021 1.322879 1.634409 1.284726 0.325288 1.829740 1.346606 -0.071117 -0.074172 0.523456 1.755231 1.609173 1.147725 0.784584 0.915037 1.284527 -0.069280 1.582487 1.006637 0.377855 1.009315 1.289847 -0.296346)
+ 7.793784 #r(0.000000 0.604834 1.810468 0.479158 1.833042 1.567985 -0.008145 1.139628 0.500517 1.068759 0.129009 1.082620 1.606832 0.022087 1.588661 -0.153130 0.676199 0.010115 0.698933 1.351365 0.913525 0.821255 0.678484 1.196033 0.336031 0.980483 0.167734 -0.166196 0.584197 0.895241 0.166400 1.887408 1.404231 1.357967 0.000767 1.273439 0.959305 0.625351 1.435222 1.581734 -0.027156 1.322760 1.634581 1.284691 0.324951 1.829465 1.346510 -0.070824 -0.074038 0.522954 1.755297 1.609271 1.147322 0.784177 0.915115 1.284187 -0.070344 1.582369 1.006518 0.377560 1.009520 1.290325 -0.295994)
+ 7.792658 #r(0.000000 0.604958 1.810993 0.479572 1.832501 1.568102 -0.008375 1.139554 0.500438 1.068891 0.129208 1.082690 1.606602 0.021403 1.588850 -0.152836 0.676059 0.009863 0.698550 1.351044 0.912935 0.821309 0.678462 1.195880 0.335962 0.980439 0.167296 -0.166103 0.584580 0.895326 0.165904 1.888061 1.403790 1.358315 0.000771 1.273834 0.958915 0.625533 1.434996 1.581517 -0.027021 1.322879 1.634409 1.284726 0.325288 1.829740 1.346606 -0.071117 -0.074172 0.523456 1.755231 1.609173 1.147725 0.784584 0.915037 1.284527 -0.069280 1.582487 1.006637 0.377855 1.009315 1.289847 -0.296346)
)
;;; 64 all -------------------------------------------------------------------------------- ; 8
-(vector 64 9.957244923706 #(0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 1 0 1 0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 0 0 1 1 1 1 1)
+(vector 64 9.957244923706 #r(0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 1 0 1 0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 0 0 1 1 1 1 1)
- 7.941887 #(0.000000 0.078350 0.185008 1.926703 0.321363 1.181646 1.402668 0.610982 0.623089 1.216601 1.332592 -0.291595 1.818855 1.612142 0.352450 -0.172928 1.880133 1.280898 1.910145 0.775896 0.915424 1.581714 0.463086 0.548034 1.045305 1.495776 -1.677351 1.247040 0.522690 1.227534 1.269499 0.212698 -0.052232 1.635256 1.888480 1.734142 1.150438 1.012285 0.389543 -0.097094 -0.358616 1.129328 0.215283 0.611096 0.487394 1.263156 0.637871 1.355777 0.092029 0.148467 1.060411 0.413204 1.241091 0.569303 1.457881 0.998119 0.874341 0.432403 1.077636 0.523921 0.747328 1.722616 0.867015 0.916274)
+ 7.941887 #r(0.000000 0.078350 0.185008 1.926703 0.321363 1.181646 1.402668 0.610982 0.623089 1.216601 1.332592 -0.291595 1.818855 1.612142 0.352450 -0.172928 1.880133 1.280898 1.910145 0.775896 0.915424 1.581714 0.463086 0.548034 1.045305 1.495776 -1.677351 1.247040 0.522690 1.227534 1.269499 0.212698 -0.052232 1.635256 1.888480 1.734142 1.150438 1.012285 0.389543 -0.097094 -0.358616 1.129328 0.215283 0.611096 0.487394 1.263156 0.637871 1.355777 0.092029 0.148467 1.060411 0.413204 1.241091 0.569303 1.457881 0.998119 0.874341 0.432403 1.077636 0.523921 0.747328 1.722616 0.867015 0.916274)
;; pp.scm:
- 7.992914 #(0.000000 0.651329 1.088511 1.713470 0.442276 0.963521 1.501931 0.310181 1.212960 -0.011104 0.778232 1.515305 0.316833 1.237177 0.296916 1.189311 0.026642 1.098222 -0.017818 1.134719 0.273596 1.474260 0.550810 1.706455 0.919546 0.198719 1.526951 0.883788 0.268629 1.826193 1.021575 0.329612 -0.041590 1.516394 1.042877 0.648305 0.185654 -0.069051 1.607952 1.190320 1.094592 0.588439 0.829542 0.393611 0.610572 0.171199 0.117077 0.152394 -0.147682 0.017404 0.185404 0.037181 0.373288 0.371013 0.642715 0.482850 0.968331 1.382474 1.590294 -0.024057 0.298876 0.749699 1.152958 1.682631)
+ 7.992914 #r(0.000000 0.651329 1.088511 1.713470 0.442276 0.963521 1.501931 0.310181 1.212960 -0.011104 0.778232 1.515305 0.316833 1.237177 0.296916 1.189311 0.026642 1.098222 -0.017818 1.134719 0.273596 1.474260 0.550810 1.706455 0.919546 0.198719 1.526951 0.883788 0.268629 1.826193 1.021575 0.329612 -0.041590 1.516394 1.042877 0.648305 0.185654 -0.069051 1.607952 1.190320 1.094592 0.588439 0.829542 0.393611 0.610572 0.171199 0.117077 0.152394 -0.147682 0.017404 0.185404 0.037181 0.373288 0.371013 0.642715 0.482850 0.968331 1.382474 1.590294 -0.024057 0.298876 0.749699 1.152958 1.682631)
;; 63+1
- 7.852593 #(0.000000 0.825112 1.882318 0.451509 0.012998 1.639009 0.186070 1.361114 0.503493 1.308226 0.187566 1.154228 1.519693 0.016493 1.654055 0.133569 0.677683 0.038167 0.453693 1.326886 0.811770 1.182840 0.767976 1.306039 0.513845 0.875502 0.344585 -0.071461 0.625939 0.904824 0.020665 1.775810 1.364597 1.313323 0.157145 1.372768 1.111614 0.377004 1.340696 1.756191 -0.307041 1.279247 1.512890 1.161668 0.344904 1.870013 1.328981 0.030268 -0.036888 0.551836 1.737903 1.637471 1.164315 0.705326 1.030571 1.361467 -0.181207 1.620264 1.058937 0.469215 1.047362 1.285537 -0.195579 0.052724)
- 7.850378 #(0.000000 0.818256 1.893797 0.447574 0.004615 1.627422 0.174323 1.354149 0.505328 1.291333 0.192178 1.130810 1.484813 -0.020048 1.628923 0.116957 0.662375 0.012432 0.429672 1.291396 0.784440 1.176860 0.720821 1.253711 0.466453 0.835831 0.299457 -0.100473 0.586092 0.852720 -0.020740 1.729307 1.309937 1.257236 0.131855 1.336452 1.066797 0.322890 1.283543 1.689513 -0.371492 1.214117 1.466426 1.111681 0.289267 1.807002 1.269572 -0.053895 -0.092329 0.477788 1.677216 1.588667 1.094746 0.622096 0.954171 1.266653 -0.249077 1.541492 0.994736 0.424957 0.957923 1.192779 -0.269608 -0.039051)
+ 7.852593 #r(0.000000 0.825112 1.882318 0.451509 0.012998 1.639009 0.186070 1.361114 0.503493 1.308226 0.187566 1.154228 1.519693 0.016493 1.654055 0.133569 0.677683 0.038167 0.453693 1.326886 0.811770 1.182840 0.767976 1.306039 0.513845 0.875502 0.344585 -0.071461 0.625939 0.904824 0.020665 1.775810 1.364597 1.313323 0.157145 1.372768 1.111614 0.377004 1.340696 1.756191 -0.307041 1.279247 1.512890 1.161668 0.344904 1.870013 1.328981 0.030268 -0.036888 0.551836 1.737903 1.637471 1.164315 0.705326 1.030571 1.361467 -0.181207 1.620264 1.058937 0.469215 1.047362 1.285537 -0.195579 0.052724)
+ 7.850378 #r(0.000000 0.818256 1.893797 0.447574 0.004615 1.627422 0.174323 1.354149 0.505328 1.291333 0.192178 1.130810 1.484813 -0.020048 1.628923 0.116957 0.662375 0.012432 0.429672 1.291396 0.784440 1.176860 0.720821 1.253711 0.466453 0.835831 0.299457 -0.100473 0.586092 0.852720 -0.020740 1.729307 1.309937 1.257236 0.131855 1.336452 1.066797 0.322890 1.283543 1.689513 -0.371492 1.214117 1.466426 1.111681 0.289267 1.807002 1.269572 -0.053895 -0.092329 0.477788 1.677216 1.588667 1.094746 0.622096 0.954171 1.266653 -0.249077 1.541492 0.994736 0.424957 0.957923 1.192779 -0.269608 -0.039051)
)
;;; 65 all -------------------------------------------------------------------------------- ; 8.0622
-(vector 65 10.157649040222 #(0 0 1 1 1 0 0 0 1 0 1 0 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 1 0 0 0 0 1 0 1 1 0 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 1 0 1 0)
+(vector 65 10.157649040222 #r(0 0 1 1 1 0 0 0 1 0 1 0 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 1 0 0 0 0 1 0 1 1 0 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 1 0 1 0)
- 8.034868 #(0.000000 -0.445401 1.151245 1.279345 1.476130 1.870307 1.647070 -0.199190 0.996479 1.841605 1.029874 1.628641 0.687865 0.948026 1.437242 1.472256 1.713531 0.116128 0.684445 1.801135 -0.030628 1.120947 0.852540 1.164480 1.740537 0.856297 1.486946 0.172686 0.895511 0.630282 1.378315 0.169569 1.750827 0.453225 1.137053 0.474570 0.449455 1.468205 1.690172 0.505222 -0.186497 0.479672 0.299749 1.440549 1.876899 0.243582 0.699167 0.152947 0.932331 0.165767 1.486581 1.086937 1.179952 1.305509 1.186761 0.971873 0.910187 0.131821 0.021623 1.435803 1.077493 0.071755 1.363290 0.536054 0.282812)
+ 8.034868 #r(0.000000 -0.445401 1.151245 1.279345 1.476130 1.870307 1.647070 -0.199190 0.996479 1.841605 1.029874 1.628641 0.687865 0.948026 1.437242 1.472256 1.713531 0.116128 0.684445 1.801135 -0.030628 1.120947 0.852540 1.164480 1.740537 0.856297 1.486946 0.172686 0.895511 0.630282 1.378315 0.169569 1.750827 0.453225 1.137053 0.474570 0.449455 1.468205 1.690172 0.505222 -0.186497 0.479672 0.299749 1.440549 1.876899 0.243582 0.699167 0.152947 0.932331 0.165767 1.486581 1.086937 1.179952 1.305509 1.186761 0.971873 0.910187 0.131821 0.021623 1.435803 1.077493 0.071755 1.363290 0.536054 0.282812)
;; pp:
- 7.973113 #(0.000000 0.586863 1.108547 1.809568 0.236474 0.932200 1.490976 0.236358 1.190604 -0.011282 0.981987 1.626061 0.541325 1.333541 0.166220 1.028548 0.073540 1.235912 0.201403 1.061871 0.289618 1.557561 0.463038 1.533243 0.718960 -0.031407 1.248624 0.634414 -0.029632 1.295765 0.653432 0.144947 1.300831 1.398877 0.579343 0.760977 0.024336 1.714192 1.357070 0.952728 0.458396 0.300957 -0.033236 0.181552 1.850554 1.728158 1.394294 1.294304 1.438841 1.230165 1.383584 1.610036 1.601644 1.798980 0.041945 -0.165907 -0.108364 0.492371 0.832142 1.280146 1.457449 -0.051803 0.040231 0.532391 1.056982)
+ 7.973113 #r(0.000000 0.586863 1.108547 1.809568 0.236474 0.932200 1.490976 0.236358 1.190604 -0.011282 0.981987 1.626061 0.541325 1.333541 0.166220 1.028548 0.073540 1.235912 0.201403 1.061871 0.289618 1.557561 0.463038 1.533243 0.718960 -0.031407 1.248624 0.634414 -0.029632 1.295765 0.653432 0.144947 1.300831 1.398877 0.579343 0.760977 0.024336 1.714192 1.357070 0.952728 0.458396 0.300957 -0.033236 0.181552 1.850554 1.728158 1.394294 1.294304 1.438841 1.230165 1.383584 1.610036 1.601644 1.798980 0.041945 -0.165907 -0.108364 0.492371 0.832142 1.280146 1.457449 -0.051803 0.040231 0.532391 1.056982)
;; 64+1??
- 7.989976 #(0.000000 0.717074 1.790137 0.303763 0.122314 1.682143 0.216359 1.275289 0.381110 1.232945 0.219920 1.195050 1.544622 0.012541 1.697713 0.164535 0.808696 -0.033093 0.436931 1.424336 0.953440 1.075346 0.847229 1.377732 0.455680 0.844396 0.388170 -0.232520 0.566111 1.006265 0.239235 -0.064356 1.478182 1.310771 0.100992 1.360730 1.120501 0.518973 1.403629 1.737998 -0.215831 1.519996 1.486448 1.299685 0.264762 0.058410 1.261254 0.113761 -0.018088 0.416310 -0.086576 1.654308 1.428048 0.818894 0.929752 1.422804 -0.004686 1.681128 1.117926 0.396261 1.114085 1.263468 -0.302127 -0.143751 0.249776)
- 7.986549 #(0.000000 0.705159 -0.181004 0.217327 0.156922 1.778990 0.191147 1.113801 0.272034 1.171044 0.257920 1.334728 -0.188087 -0.096820 -0.018998 0.262759 0.954023 -0.039897 0.341389 1.444996 0.917955 1.089303 1.099624 1.600822 0.474003 1.078678 0.419361 -0.346529 0.769135 1.102121 0.462514 0.194004 1.393289 1.207814 0.168583 1.451937 1.578978 0.606330 1.663672 1.685805 -0.285434 1.500953 1.544223 1.459210 0.522782 0.144120 1.248342 0.284057 0.175310 0.542283 0.012495 1.586311 1.315843 1.018961 1.170529 -0.156886 0.147650 -0.231754 1.368201 0.537962 1.411226 1.416444 -0.114344 -0.050059 0.647067)
+ 7.989976 #r(0.000000 0.717074 1.790137 0.303763 0.122314 1.682143 0.216359 1.275289 0.381110 1.232945 0.219920 1.195050 1.544622 0.012541 1.697713 0.164535 0.808696 -0.033093 0.436931 1.424336 0.953440 1.075346 0.847229 1.377732 0.455680 0.844396 0.388170 -0.232520 0.566111 1.006265 0.239235 -0.064356 1.478182 1.310771 0.100992 1.360730 1.120501 0.518973 1.403629 1.737998 -0.215831 1.519996 1.486448 1.299685 0.264762 0.058410 1.261254 0.113761 -0.018088 0.416310 -0.086576 1.654308 1.428048 0.818894 0.929752 1.422804 -0.004686 1.681128 1.117926 0.396261 1.114085 1.263468 -0.302127 -0.143751 0.249776)
+ 7.986549 #r(0.000000 0.705159 -0.181004 0.217327 0.156922 1.778990 0.191147 1.113801 0.272034 1.171044 0.257920 1.334728 -0.188087 -0.096820 -0.018998 0.262759 0.954023 -0.039897 0.341389 1.444996 0.917955 1.089303 1.099624 1.600822 0.474003 1.078678 0.419361 -0.346529 0.769135 1.102121 0.462514 0.194004 1.393289 1.207814 0.168583 1.451937 1.578978 0.606330 1.663672 1.685805 -0.285434 1.500953 1.544223 1.459210 0.522782 0.144120 1.248342 0.284057 0.175310 0.542283 0.012495 1.586311 1.315843 1.018961 1.170529 -0.156886 0.147650 -0.231754 1.368201 0.537962 1.411226 1.416444 -0.114344 -0.050059 0.647067)
- 7.936705 #(0.000000 1.517428 0.111828 0.173226 0.840059 0.526041 1.411719 1.400612 -0.303887 0.230833 0.238673 -0.042085 0.173922 -0.488247 -0.875499 0.144489 1.065445 -0.071232 -0.251031 -0.143214 0.545256 1.307426 0.624098 1.604714 0.476813 0.403036 0.397383 -0.691500 1.462074 1.550083 0.768183 0.930280 0.458416 0.838168 0.784667 1.167295 -1.040754 0.791308 -0.864278 0.598538 -1.010391 1.656175 0.144524 -0.290241 0.441806 0.078668 -0.056179 -0.659905 1.071833 0.387457 0.707236 1.208921 0.879213 0.283834 1.382955 0.578802 -0.772961 -0.113529 0.594627 1.029134 1.703053 0.890258 0.476451 -1.188193 0.046657)
- 7.935374 #(0.000000 1.516508 0.110662 0.175958 0.836131 0.527757 1.411364 1.402933 -0.304009 0.233367 0.236759 -0.044789 0.175612 -0.486791 -0.877026 0.147806 1.067130 -0.071661 -0.249068 -0.143232 0.548582 1.308817 0.625581 1.605825 0.476254 0.402177 0.399931 -0.689265 1.463205 1.551126 0.770705 0.932593 0.459681 0.842986 0.780890 1.170908 -1.038140 0.797070 -0.861980 0.600440 -1.006688 1.655334 0.145026 -0.290652 0.442934 0.083346 -0.055655 -0.658549 1.077569 0.388346 0.715047 1.209914 0.883597 0.287116 1.384240 0.580259 -0.768209 -0.114151 0.598252 1.027948 1.705250 0.896332 0.480110 -1.183952 0.051204)
+ 7.936705 #r(0.000000 1.517428 0.111828 0.173226 0.840059 0.526041 1.411719 1.400612 -0.303887 0.230833 0.238673 -0.042085 0.173922 -0.488247 -0.875499 0.144489 1.065445 -0.071232 -0.251031 -0.143214 0.545256 1.307426 0.624098 1.604714 0.476813 0.403036 0.397383 -0.691500 1.462074 1.550083 0.768183 0.930280 0.458416 0.838168 0.784667 1.167295 -1.040754 0.791308 -0.864278 0.598538 -1.010391 1.656175 0.144524 -0.290241 0.441806 0.078668 -0.056179 -0.659905 1.071833 0.387457 0.707236 1.208921 0.879213 0.283834 1.382955 0.578802 -0.772961 -0.113529 0.594627 1.029134 1.703053 0.890258 0.476451 -1.188193 0.046657)
+ 7.935374 #r(0.000000 1.516508 0.110662 0.175958 0.836131 0.527757 1.411364 1.402933 -0.304009 0.233367 0.236759 -0.044789 0.175612 -0.486791 -0.877026 0.147806 1.067130 -0.071661 -0.249068 -0.143232 0.548582 1.308817 0.625581 1.605825 0.476254 0.402177 0.399931 -0.689265 1.463205 1.551126 0.770705 0.932593 0.459681 0.842986 0.780890 1.170908 -1.038140 0.797070 -0.861980 0.600440 -1.006688 1.655334 0.145026 -0.290652 0.442934 0.083346 -0.055655 -0.658549 1.077569 0.388346 0.715047 1.209914 0.883597 0.287116 1.384240 0.580259 -0.768209 -0.114151 0.598252 1.027948 1.705250 0.896332 0.480110 -1.183952 0.051204)
)
;;; 66 all -------------------------------------------------------------------------------- ; 8.1240
-(vector 66 10.208241079264 #(0 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 1 0 0)
+(vector 66 10.208241079264 #r(0 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 1 0 0)
- 8.056638 #(0.000000 1.161331 1.936583 0.473825 1.730430 1.710083 1.722704 0.938539 0.650961 -0.301116 0.711382 0.874289 0.712393 1.263523 0.315048 0.391659 1.059022 0.363325 1.881127 0.161704 0.986800 1.590034 -0.289492 0.615410 -0.014906 1.387045 1.412270 1.265945 0.128543 0.445787 0.121476 1.705959 1.084173 1.066949 0.774156 0.933891 1.279265 0.297308 0.298325 1.512363 0.271282 1.243162 1.580605 1.521644 0.312598 0.465014 1.006013 0.269153 1.083812 0.157700 1.646414 0.707835 0.598039 1.973506 0.954025 0.104991 0.944717 0.038847 0.538283 0.734911 0.143649 0.104089 0.567333 0.271330 0.665962 0.751070)
+ 8.056638 #r(0.000000 1.161331 1.936583 0.473825 1.730430 1.710083 1.722704 0.938539 0.650961 -0.301116 0.711382 0.874289 0.712393 1.263523 0.315048 0.391659 1.059022 0.363325 1.881127 0.161704 0.986800 1.590034 -0.289492 0.615410 -0.014906 1.387045 1.412270 1.265945 0.128543 0.445787 0.121476 1.705959 1.084173 1.066949 0.774156 0.933891 1.279265 0.297308 0.298325 1.512363 0.271282 1.243162 1.580605 1.521644 0.312598 0.465014 1.006013 0.269153 1.083812 0.157700 1.646414 0.707835 0.598039 1.973506 0.954025 0.104991 0.944717 0.038847 0.538283 0.734911 0.143649 0.104089 0.567333 0.271330 0.665962 0.751070)
;; 67-1
- 8.015795 #(0.000000 0.482185 1.174631 0.006809 0.401780 1.237554 1.609013 0.588930 1.364153 1.497911 0.479714 1.430977 0.382104 1.324174 0.126882 0.919708 -0.100361 0.979679 -0.154974 0.411044 1.431094 0.610463 0.047752 1.055827 0.418075 1.131057 0.351532 -0.093894 1.532471 1.157174 0.298591 -0.302172 1.190200 0.350212 -0.469230 1.440439 1.054072 0.838197 0.416628 0.293297 -0.104136 -0.061434 0.960707 0.489913 0.124304 0.770013 0.316144 0.728268 0.218632 -0.102007 0.074373 -0.213063 -0.207226 0.313323 0.277535 0.498637 0.514308 0.823833 0.726893 1.568923 -0.149485 0.343111 0.825139 1.056977 1.559384 -0.284248)
- 8.011520 #(0.000000 0.479799 1.169638 0.004612 0.402406 1.230765 1.595897 0.593685 1.374878 1.499275 0.489410 1.425320 0.373395 1.315599 0.138105 0.920155 -0.108520 0.991482 -0.149108 0.410130 1.436361 0.601706 0.046153 1.052899 0.424418 1.134897 0.348693 -0.098617 1.547368 1.151172 0.294748 -0.290030 1.189252 0.345030 -0.465760 1.441002 1.060075 0.832617 0.418488 0.293880 -0.106037 -0.059478 0.956595 0.497960 0.117059 0.767911 0.318840 0.717594 0.220912 -0.113412 0.081739 -0.211641 -0.217173 0.315598 0.272673 0.484197 0.526183 0.827437 0.728223 1.566384 -0.150430 0.337045 0.831304 1.069362 1.566148 -0.280307)
+ 8.015795 #r(0.000000 0.482185 1.174631 0.006809 0.401780 1.237554 1.609013 0.588930 1.364153 1.497911 0.479714 1.430977 0.382104 1.324174 0.126882 0.919708 -0.100361 0.979679 -0.154974 0.411044 1.431094 0.610463 0.047752 1.055827 0.418075 1.131057 0.351532 -0.093894 1.532471 1.157174 0.298591 -0.302172 1.190200 0.350212 -0.469230 1.440439 1.054072 0.838197 0.416628 0.293297 -0.104136 -0.061434 0.960707 0.489913 0.124304 0.770013 0.316144 0.728268 0.218632 -0.102007 0.074373 -0.213063 -0.207226 0.313323 0.277535 0.498637 0.514308 0.823833 0.726893 1.568923 -0.149485 0.343111 0.825139 1.056977 1.559384 -0.284248)
+ 8.011520 #r(0.000000 0.479799 1.169638 0.004612 0.402406 1.230765 1.595897 0.593685 1.374878 1.499275 0.489410 1.425320 0.373395 1.315599 0.138105 0.920155 -0.108520 0.991482 -0.149108 0.410130 1.436361 0.601706 0.046153 1.052899 0.424418 1.134897 0.348693 -0.098617 1.547368 1.151172 0.294748 -0.290030 1.189252 0.345030 -0.465760 1.441002 1.060075 0.832617 0.418488 0.293880 -0.106037 -0.059478 0.956595 0.497960 0.117059 0.767911 0.318840 0.717594 0.220912 -0.113412 0.081739 -0.211641 -0.217173 0.315598 0.272673 0.484197 0.526183 0.827437 0.728223 1.566384 -0.150430 0.337045 0.831304 1.069362 1.566148 -0.280307)
)
;;; 67 all -------------------------------------------------------------------------------- ; 8.1853
-(vector 67 10.422191619873 #(0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 0 1 1 0 1)
+(vector 67 10.422191619873 #r(0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 0 1 1 0 1)
- 8.144904 #(0.000000 0.836848 1.681555 1.191647 0.070261 0.942251 1.797644 1.070294 0.265921 1.462866 0.142770 0.004389 0.118755 0.795004 0.861059 0.364013 1.094070 0.938540 1.352932 1.681133 0.801557 -0.166830 1.660232 1.811404 -0.089491 1.793031 0.410641 1.462829 0.992048 -0.005221 0.624981 -0.049054 -0.100216 0.046599 -0.054149 1.061978 0.471687 -0.484886 1.299787 0.103592 0.873660 1.581185 1.539111 1.747106 0.867454 1.194479 0.984380 1.039016 -0.137566 1.440640 0.758746 0.623227 0.623868 1.161467 1.535042 0.328555 1.691644 -0.115223 0.929805 1.714954 0.103897 1.241682 1.520953 1.062392 0.666399 0.064868 1.788882)
+ 8.144904 #r(0.000000 0.836848 1.681555 1.191647 0.070261 0.942251 1.797644 1.070294 0.265921 1.462866 0.142770 0.004389 0.118755 0.795004 0.861059 0.364013 1.094070 0.938540 1.352932 1.681133 0.801557 -0.166830 1.660232 1.811404 -0.089491 1.793031 0.410641 1.462829 0.992048 -0.005221 0.624981 -0.049054 -0.100216 0.046599 -0.054149 1.061978 0.471687 -0.484886 1.299787 0.103592 0.873660 1.581185 1.539111 1.747106 0.867454 1.194479 0.984380 1.039016 -0.137566 1.440640 0.758746 0.623227 0.623868 1.161467 1.535042 0.328555 1.691644 -0.115223 0.929805 1.714954 0.103897 1.241682 1.520953 1.062392 0.666399 0.064868 1.788882)
;; pp:
- 8.047705 #(0.000000 0.723228 1.099176 -0.100694 0.795584 1.226000 1.797595 0.767514 1.189968 1.770414 0.592457 1.632373 0.568783 1.570965 0.191327 0.911400 -0.022316 0.899532 0.007665 0.667853 1.568194 0.721875 0.202951 1.285669 0.230444 1.429343 0.815993 0.012435 1.649015 1.193109 0.625662 -0.046776 1.588223 0.552563 -0.302890 1.679576 1.260813 0.930680 0.445604 0.348973 1.926722 0.133110 1.169041 0.703410 0.591692 0.750705 0.471868 0.931521 0.435714 0.165223 0.319019 0.050970 0.055362 0.598500 0.290706 1.016017 0.946745 1.221686 1.001124 1.567104 0.056814 0.422743 0.731562 1.013128 1.856895 1.850611 0.319558)
- 8.043962 #(0.000000 0.723361 1.098199 -0.104317 0.796240 1.226712 1.796964 0.767870 1.189764 1.772492 0.590978 1.631570 0.568976 1.570933 0.191811 0.911209 -0.021351 0.900745 0.009021 0.667781 1.566923 0.719770 0.205199 1.286787 0.231357 1.429685 0.816164 0.009201 1.644886 1.192474 0.623028 -0.047424 1.588652 0.551514 -0.304566 1.681018 1.259199 0.930654 0.444058 0.347527 1.926688 0.132038 1.165961 0.703045 0.587795 0.751154 0.472421 0.933684 0.438476 0.165192 0.320128 0.049852 0.054657 0.597137 0.289172 1.017612 0.945610 1.220099 1.001383 1.565341 0.058830 0.420956 0.733110 1.012036 1.857676 1.850677 0.317955)
+ 8.047705 #r(0.000000 0.723228 1.099176 -0.100694 0.795584 1.226000 1.797595 0.767514 1.189968 1.770414 0.592457 1.632373 0.568783 1.570965 0.191327 0.911400 -0.022316 0.899532 0.007665 0.667853 1.568194 0.721875 0.202951 1.285669 0.230444 1.429343 0.815993 0.012435 1.649015 1.193109 0.625662 -0.046776 1.588223 0.552563 -0.302890 1.679576 1.260813 0.930680 0.445604 0.348973 1.926722 0.133110 1.169041 0.703410 0.591692 0.750705 0.471868 0.931521 0.435714 0.165223 0.319019 0.050970 0.055362 0.598500 0.290706 1.016017 0.946745 1.221686 1.001124 1.567104 0.056814 0.422743 0.731562 1.013128 1.856895 1.850611 0.319558)
+ 8.043962 #r(0.000000 0.723361 1.098199 -0.104317 0.796240 1.226712 1.796964 0.767870 1.189764 1.772492 0.590978 1.631570 0.568976 1.570933 0.191811 0.911209 -0.021351 0.900745 0.009021 0.667781 1.566923 0.719770 0.205199 1.286787 0.231357 1.429685 0.816164 0.009201 1.644886 1.192474 0.623028 -0.047424 1.588652 0.551514 -0.304566 1.681018 1.259199 0.930654 0.444058 0.347527 1.926688 0.132038 1.165961 0.703045 0.587795 0.751154 0.472421 0.933684 0.438476 0.165192 0.320128 0.049852 0.054657 0.597137 0.289172 1.017612 0.945610 1.220099 1.001383 1.565341 0.058830 0.420956 0.733110 1.012036 1.857676 1.850677 0.317955)
)
;;; 68 all -------------------------------------------------------------------------------- ; 8.2462
-(vector 68 10.460547747753 #(0 0 1 0 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 0 1 0 1 0 1 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 0 1)
+(vector 68 10.460547747753 #r(0 0 1 0 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 0 1 0 1 0 1 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 0 1)
- 8.168157 #(0.000000 0.354978 1.878673 1.059221 0.759731 0.956747 0.711479 0.720163 0.372733 0.204844 0.455442 0.097446 1.506513 0.919884 0.814781 0.935488 0.786490 1.074073 1.203975 1.052443 0.726494 1.730845 0.062987 1.716136 1.412039 0.233751 0.090641 -0.003605 0.550389 0.691280 1.313887 0.137194 1.521036 1.556316 0.070039 0.198694 1.780701 0.986693 1.284403 1.408455 0.102332 1.273719 0.728671 0.008237 1.436719 1.092816 0.742660 1.480879 0.410157 1.288179 0.559234 1.425899 1.219179 0.189574 0.471285 1.159537 -0.028955 1.469388 0.210392 1.141156 -0.135055 0.687474 1.468060 -0.235268 0.553950 0.681055 0.986756 1.515599)
+ 8.168157 #r(0.000000 0.354978 1.878673 1.059221 0.759731 0.956747 0.711479 0.720163 0.372733 0.204844 0.455442 0.097446 1.506513 0.919884 0.814781 0.935488 0.786490 1.074073 1.203975 1.052443 0.726494 1.730845 0.062987 1.716136 1.412039 0.233751 0.090641 -0.003605 0.550389 0.691280 1.313887 0.137194 1.521036 1.556316 0.070039 0.198694 1.780701 0.986693 1.284403 1.408455 0.102332 1.273719 0.728671 0.008237 1.436719 1.092816 0.742660 1.480879 0.410157 1.288179 0.559234 1.425899 1.219179 0.189574 0.471285 1.159537 -0.028955 1.469388 0.210392 1.141156 -0.135055 0.687474 1.468060 -0.235268 0.553950 0.681055 0.986756 1.515599)
;; 69-1
- 8.131853 #(0.000000 0.784104 1.233565 0.461379 1.122608 1.104526 0.722387 1.255939 1.344588 0.136431 0.691426 1.710711 0.131100 0.566340 0.865438 1.537496 0.878693 0.133465 0.855818 -0.432042 0.379762 0.876524 1.602175 1.021625 -0.093271 -0.210101 0.454316 0.002103 0.079420 0.100395 -0.098889 1.625973 -0.047062 1.737996 0.506589 1.792992 0.939323 -0.140724 1.456990 0.171514 0.906369 -0.130797 0.877514 0.626041 0.619243 -0.783477 0.176466 0.146820 -0.143043 1.354027 1.213392 -0.157870 -0.263919 0.335949 0.779235 0.639234 0.011670 1.687112 1.239883 0.625064 0.203838 -0.430763 -0.038392 -0.419755 0.708217 0.793274 0.717371 0.706499)
- 8.131379 #(0.000000 0.777086 1.225294 0.459335 1.120518 1.101510 0.718447 1.262945 1.346941 0.144684 0.695095 1.701131 0.123010 0.559466 0.867624 1.525977 0.858162 0.137330 0.853375 -0.428338 0.368918 0.875336 1.605285 1.009970 -0.095199 -0.219955 0.449222 0.000464 0.090789 0.090543 -0.094428 1.635821 -0.065302 1.739981 0.500960 1.791399 0.927017 -0.130394 1.444057 0.172796 0.901920 -0.118461 0.861131 0.631330 0.620706 -0.801290 0.162692 0.158567 -0.135443 1.344771 1.192462 -0.162338 -0.266366 0.328646 0.783136 0.650960 0.026458 1.672924 1.221292 0.618317 0.191901 -0.429128 -0.026945 -0.415707 0.709906 0.791929 0.708422 0.702801)
+ 8.131853 #r(0.000000 0.784104 1.233565 0.461379 1.122608 1.104526 0.722387 1.255939 1.344588 0.136431 0.691426 1.710711 0.131100 0.566340 0.865438 1.537496 0.878693 0.133465 0.855818 -0.432042 0.379762 0.876524 1.602175 1.021625 -0.093271 -0.210101 0.454316 0.002103 0.079420 0.100395 -0.098889 1.625973 -0.047062 1.737996 0.506589 1.792992 0.939323 -0.140724 1.456990 0.171514 0.906369 -0.130797 0.877514 0.626041 0.619243 -0.783477 0.176466 0.146820 -0.143043 1.354027 1.213392 -0.157870 -0.263919 0.335949 0.779235 0.639234 0.011670 1.687112 1.239883 0.625064 0.203838 -0.430763 -0.038392 -0.419755 0.708217 0.793274 0.717371 0.706499)
+ 8.131379 #r(0.000000 0.777086 1.225294 0.459335 1.120518 1.101510 0.718447 1.262945 1.346941 0.144684 0.695095 1.701131 0.123010 0.559466 0.867624 1.525977 0.858162 0.137330 0.853375 -0.428338 0.368918 0.875336 1.605285 1.009970 -0.095199 -0.219955 0.449222 0.000464 0.090789 0.090543 -0.094428 1.635821 -0.065302 1.739981 0.500960 1.791399 0.927017 -0.130394 1.444057 0.172796 0.901920 -0.118461 0.861131 0.631330 0.620706 -0.801290 0.162692 0.158567 -0.135443 1.344771 1.192462 -0.162338 -0.266366 0.328646 0.783136 0.650960 0.026458 1.672924 1.221292 0.618317 0.191901 -0.429128 -0.026945 -0.415707 0.709906 0.791929 0.708422 0.702801)
)
;;; 69 all -------------------------------------------------------------------------------- ; 8.3066
-(vector 69 10.495518383865 #(0 0 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0)
+(vector 69 10.495518383865 #r(0 0 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0)
- 8.197146 #(0.000000 0.551719 0.168788 -0.171535 0.603472 1.646430 0.831219 -0.112901 1.600971 0.776706 -0.257580 1.457106 0.729936 0.539913 1.421843 0.548661 0.072361 0.728562 0.364648 -0.109430 1.359599 1.471812 0.472868 -0.088533 0.623026 0.167759 1.605110 0.053141 0.996253 1.258861 1.710199 1.079237 0.316774 0.568130 0.226861 -0.084943 1.702544 1.075688 0.298153 0.507109 1.291563 1.177929 1.707324 -0.001439 0.386332 0.512557 0.380487 0.243873 1.516865 0.101344 -0.768813 1.646072 0.275192 0.139649 1.389985 1.576705 0.346880 0.446918 1.441036 0.376743 1.075298 0.134005 0.942798 0.778785 1.014815 1.144279 1.213481 1.047075 1.249788)
+ 8.197146 #r(0.000000 0.551719 0.168788 -0.171535 0.603472 1.646430 0.831219 -0.112901 1.600971 0.776706 -0.257580 1.457106 0.729936 0.539913 1.421843 0.548661 0.072361 0.728562 0.364648 -0.109430 1.359599 1.471812 0.472868 -0.088533 0.623026 0.167759 1.605110 0.053141 0.996253 1.258861 1.710199 1.079237 0.316774 0.568130 0.226861 -0.084943 1.702544 1.075688 0.298153 0.507109 1.291563 1.177929 1.707324 -0.001439 0.386332 0.512557 0.380487 0.243873 1.516865 0.101344 -0.768813 1.646072 0.275192 0.139649 1.389985 1.576705 0.346880 0.446918 1.441036 0.376743 1.075298 0.134005 0.942798 0.778785 1.014815 1.144279 1.213481 1.047075 1.249788)
;; 70-1
- 8.141488 #(0.000000 0.574183 1.353612 0.374915 1.030848 1.242040 0.744144 1.258569 1.336700 0.191968 0.691270 1.721372 0.311349 0.667908 0.915341 1.702762 0.832541 0.057365 0.926883 -0.151411 0.409001 1.010518 1.740308 1.032309 0.081237 -0.217082 0.415212 -0.071661 0.155303 -0.089140 -0.060725 1.591797 -0.172680 1.694895 0.543894 1.693239 1.206424 -0.050239 1.924102 0.172957 0.976794 0.085955 0.708872 0.776705 0.648853 -0.409925 0.316385 0.431673 -0.080960 1.419047 1.273976 0.066194 -0.289390 0.572552 1.102567 0.973972 -0.045359 1.746990 1.335632 0.698963 0.200154 -0.171320 0.156816 -0.222154 0.877092 0.959484 0.814725 0.645169 0.000279)
- 8.140284 #(0.000000 0.574274 1.353235 0.374880 1.030900 1.241934 0.744056 1.258652 1.336888 0.191881 0.691290 1.721325 0.311221 0.667796 0.914975 1.702712 0.832796 0.057800 0.926778 -0.151752 0.409056 1.010584 1.740825 1.032269 0.081080 -0.217110 0.415261 -0.071717 0.155276 -0.088899 -0.060899 1.591545 -0.172297 1.695170 0.543998 1.693375 1.206363 -0.050497 1.924309 0.173097 0.976699 0.086114 0.708934 0.776887 0.648438 -0.409990 0.317299 0.431348 -0.080917 1.418905 1.274203 0.066144 -0.289260 0.572513 1.102504 0.974167 -0.045152 1.746839 1.335333 0.699271 0.200129 -0.170859 0.156721 -0.222333 0.876801 0.959324 0.814751 0.645600 0.000208)
+ 8.141488 #r(0.000000 0.574183 1.353612 0.374915 1.030848 1.242040 0.744144 1.258569 1.336700 0.191968 0.691270 1.721372 0.311349 0.667908 0.915341 1.702762 0.832541 0.057365 0.926883 -0.151411 0.409001 1.010518 1.740308 1.032309 0.081237 -0.217082 0.415212 -0.071661 0.155303 -0.089140 -0.060725 1.591797 -0.172680 1.694895 0.543894 1.693239 1.206424 -0.050239 1.924102 0.172957 0.976794 0.085955 0.708872 0.776705 0.648853 -0.409925 0.316385 0.431673 -0.080960 1.419047 1.273976 0.066194 -0.289390 0.572552 1.102567 0.973972 -0.045359 1.746990 1.335632 0.698963 0.200154 -0.171320 0.156816 -0.222154 0.877092 0.959484 0.814725 0.645169 0.000279)
+ 8.140284 #r(0.000000 0.574274 1.353235 0.374880 1.030900 1.241934 0.744056 1.258652 1.336888 0.191881 0.691290 1.721325 0.311221 0.667796 0.914975 1.702712 0.832796 0.057800 0.926778 -0.151752 0.409056 1.010584 1.740825 1.032269 0.081080 -0.217110 0.415261 -0.071717 0.155276 -0.088899 -0.060899 1.591545 -0.172297 1.695170 0.543998 1.693375 1.206363 -0.050497 1.924309 0.173097 0.976699 0.086114 0.708934 0.776887 0.648438 -0.409990 0.317299 0.431348 -0.080917 1.418905 1.274203 0.066144 -0.289260 0.572513 1.102504 0.974167 -0.045152 1.746839 1.335333 0.699271 0.200129 -0.170859 0.156721 -0.222333 0.876801 0.959324 0.814751 0.645600 0.000208)
)
;;; 70 all -------------------------------------------------------------------------------- ; 8.3666
-(vector 70 10.532930374146 #(0 1 1 1 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 0 1 1 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0)
+(vector 70 10.532930374146 #r(0 1 1 1 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 0 1 1 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0)
- 8.176963 #(0.000000 0.587989 1.431825 0.221285 0.960638 1.245837 0.795275 1.178692 1.324313 0.151685 0.789663 1.805305 0.407280 0.848410 1.089893 1.582619 0.871354 1.940142 1.022672 -0.098747 0.444755 1.081717 1.884930 1.020069 0.094475 0.162127 0.516048 0.043396 0.218952 -0.075886 0.177709 1.517609 -0.008561 1.566136 0.502844 1.768539 1.199988 0.053518 1.941460 0.082194 1.231659 0.182374 0.578473 0.843872 0.777996 -0.220205 0.467426 0.426401 0.154145 1.445497 1.004198 0.090981 -0.148632 0.673583 1.270739 1.002492 -0.085118 1.727335 1.374618 0.568333 0.205667 -0.017872 0.120962 -0.075966 0.957264 1.025234 0.841047 0.662525 -0.011036 1.297608)
+ 8.176963 #r(0.000000 0.587989 1.431825 0.221285 0.960638 1.245837 0.795275 1.178692 1.324313 0.151685 0.789663 1.805305 0.407280 0.848410 1.089893 1.582619 0.871354 1.940142 1.022672 -0.098747 0.444755 1.081717 1.884930 1.020069 0.094475 0.162127 0.516048 0.043396 0.218952 -0.075886 0.177709 1.517609 -0.008561 1.566136 0.502844 1.768539 1.199988 0.053518 1.941460 0.082194 1.231659 0.182374 0.578473 0.843872 0.777996 -0.220205 0.467426 0.426401 0.154145 1.445497 1.004198 0.090981 -0.148632 0.673583 1.270739 1.002492 -0.085118 1.727335 1.374618 0.568333 0.205667 -0.017872 0.120962 -0.075966 0.957264 1.025234 0.841047 0.662525 -0.011036 1.297608)
)
;;; 71 all -------------------------------------------------------------------------------- ; 8.4261
-(vector 71 10.610488331633 #(0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0)
+(vector 71 10.610488331633 #r(0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0)
- 8.319609 #(0.000000 0.140438 -0.156343 1.390907 0.216508 0.199081 1.047301 1.430567 0.016863 1.549577 0.363516 1.057536 -0.217538 0.646697 0.414461 0.993065 1.127770 0.877766 0.873392 0.440804 0.760841 0.449527 0.494946 1.105821 0.463488 1.200046 1.158237 0.977607 1.309426 0.772719 -0.483517 0.568526 0.817490 0.531524 0.272201 1.656272 -0.164981 0.659567 1.062868 -0.123485 1.015493 0.120132 0.671070 0.461022 1.766703 1.319785 0.775590 0.108288 0.757022 1.176333 1.486331 1.779348 -0.137633 1.540074 -0.041450 0.361903 1.057755 1.116867 0.573932 0.250328 1.480465 0.262890 0.893036 1.148682 1.046983 0.264942 1.618761 0.311598 1.395691 0.570219 0.159607)
+ 8.319609 #r(0.000000 0.140438 -0.156343 1.390907 0.216508 0.199081 1.047301 1.430567 0.016863 1.549577 0.363516 1.057536 -0.217538 0.646697 0.414461 0.993065 1.127770 0.877766 0.873392 0.440804 0.760841 0.449527 0.494946 1.105821 0.463488 1.200046 1.158237 0.977607 1.309426 0.772719 -0.483517 0.568526 0.817490 0.531524 0.272201 1.656272 -0.164981 0.659567 1.062868 -0.123485 1.015493 0.120132 0.671070 0.461022 1.766703 1.319785 0.775590 0.108288 0.757022 1.176333 1.486331 1.779348 -0.137633 1.540074 -0.041450 0.361903 1.057755 1.116867 0.573932 0.250328 1.480465 0.262890 0.893036 1.148682 1.046983 0.264942 1.618761 0.311598 1.395691 0.570219 0.159607)
;; 70+1
- 8.291682 #(0.000000 0.876360 1.340339 0.367854 0.833412 1.105639 0.584245 1.188771 0.943418 0.250187 0.630698 -0.068665 0.279948 0.860334 0.732167 1.695945 0.897917 0.078292 1.045266 -0.333182 0.322926 1.637234 0.164051 1.142522 -0.007921 0.252497 0.780763 0.003414 -0.048763 0.073861 0.171499 1.284103 -0.089733 1.440877 -0.081573 1.527112 0.082712 -0.151289 0.255666 0.094915 1.149112 0.413227 0.691320 1.014965 0.789606 -0.102840 0.792525 0.145016 0.117221 1.222312 1.251613 -0.402327 -0.063091 0.826531 0.883896 0.465081 -0.032634 -0.408593 1.616507 0.441444 0.501925 0.126666 -0.391606 0.529294 1.070538 1.229843 1.052507 0.538182 0.119222 0.991880 0.323259)
- 8.291337 #(0.000000 0.876359 1.340283 0.367845 0.833375 1.105664 0.584271 1.188768 0.943451 0.250250 0.630656 -0.068635 0.279930 0.860317 0.732184 1.695932 0.897961 0.078310 1.045223 -0.333231 0.322957 1.637262 0.164086 1.142535 -0.007984 0.252507 0.780797 0.003458 -0.048747 0.073861 0.171483 1.284136 -0.089705 1.440806 -0.081590 1.527122 0.082721 -0.151244 0.255684 0.094848 1.149118 0.413274 0.691318 1.014955 0.789606 -0.102756 0.792501 0.144964 0.117187 1.222333 1.251710 -0.402265 -0.063046 0.826524 0.883969 0.465066 -0.032718 -0.408605 1.616554 0.441389 0.502001 0.126714 -0.391606 0.529285 1.070446 1.229824 1.052451 0.538215 0.119274 0.991866 0.323308)
+ 8.291682 #r(0.000000 0.876360 1.340339 0.367854 0.833412 1.105639 0.584245 1.188771 0.943418 0.250187 0.630698 -0.068665 0.279948 0.860334 0.732167 1.695945 0.897917 0.078292 1.045266 -0.333182 0.322926 1.637234 0.164051 1.142522 -0.007921 0.252497 0.780763 0.003414 -0.048763 0.073861 0.171499 1.284103 -0.089733 1.440877 -0.081573 1.527112 0.082712 -0.151289 0.255666 0.094915 1.149112 0.413227 0.691320 1.014965 0.789606 -0.102840 0.792525 0.145016 0.117221 1.222312 1.251613 -0.402327 -0.063091 0.826531 0.883896 0.465081 -0.032634 -0.408593 1.616507 0.441444 0.501925 0.126666 -0.391606 0.529294 1.070538 1.229843 1.052507 0.538182 0.119222 0.991880 0.323259)
+ 8.291337 #r(0.000000 0.876359 1.340283 0.367845 0.833375 1.105664 0.584271 1.188768 0.943451 0.250250 0.630656 -0.068635 0.279930 0.860317 0.732184 1.695932 0.897961 0.078310 1.045223 -0.333231 0.322957 1.637262 0.164086 1.142535 -0.007984 0.252507 0.780797 0.003458 -0.048747 0.073861 0.171483 1.284136 -0.089705 1.440806 -0.081590 1.527122 0.082721 -0.151244 0.255684 0.094848 1.149118 0.413274 0.691318 1.014955 0.789606 -0.102756 0.792501 0.144964 0.117187 1.222333 1.251710 -0.402265 -0.063046 0.826524 0.883969 0.465066 -0.032718 -0.408605 1.616554 0.441389 0.502001 0.126714 -0.391606 0.529285 1.070446 1.229824 1.052451 0.538215 0.119274 0.991866 0.323308)
)
;;; 72 all -------------------------------------------------------------------------------- ; 8.4853
-(vector 72 10.800657366855 #(0 1 1 0 1 0 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0)
+(vector 72 10.800657366855 #r(0 1 1 0 1 0 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0)
- 8.472893 #(0.000000 -0.093428 0.860520 0.651650 0.036400 1.174208 -0.214755 0.653075 0.661176 1.355137 1.759893 1.116459 1.283776 0.222435 0.388195 1.541066 0.171819 0.911538 0.292609 1.508023 0.997352 1.385529 0.022962 0.061408 -0.061153 0.241196 0.345845 0.923448 0.626801 0.283115 0.129077 0.499608 0.703807 0.614285 0.908458 0.403245 1.817077 1.458947 0.221667 1.213107 1.163972 1.117128 0.465749 0.627880 0.010093 0.512887 0.278332 0.535697 1.736410 -0.297420 0.467311 1.419905 1.531806 0.300181 0.244309 1.719696 1.200428 1.778805 1.081039 0.613164 1.654092 1.161237 1.675808 0.051072 0.709895 1.432879 0.690303 1.567340 0.453011 1.156931 0.253055 -0.113821)
+ 8.472893 #r(0.000000 -0.093428 0.860520 0.651650 0.036400 1.174208 -0.214755 0.653075 0.661176 1.355137 1.759893 1.116459 1.283776 0.222435 0.388195 1.541066 0.171819 0.911538 0.292609 1.508023 0.997352 1.385529 0.022962 0.061408 -0.061153 0.241196 0.345845 0.923448 0.626801 0.283115 0.129077 0.499608 0.703807 0.614285 0.908458 0.403245 1.817077 1.458947 0.221667 1.213107 1.163972 1.117128 0.465749 0.627880 0.010093 0.512887 0.278332 0.535697 1.736410 -0.297420 0.467311 1.419905 1.531806 0.300181 0.244309 1.719696 1.200428 1.778805 1.081039 0.613164 1.654092 1.161237 1.675808 0.051072 0.709895 1.432879 0.690303 1.567340 0.453011 1.156931 0.253055 -0.113821)
;; pp.scm:
- 8.375884 #(0.000000 0.704287 1.002073 1.665258 0.322937 1.455570 1.095676 0.019520 1.265776 0.283182 0.917991 1.741290 0.286595 0.909432 1.680753 0.853512 1.790234 0.580849 1.462104 0.390604 1.608631 0.491512 1.302107 0.855899 0.376743 0.878628 -0.166734 1.586900 0.799671 -0.063381 1.765431 0.627081 -0.164410 -0.007173 0.940347 0.645761 -0.294937 1.130494 1.024960 0.847385 -0.017840 -0.118371 1.360715 1.113073 0.529708 0.795901 0.574578 0.399736 -0.603738 0.201753 -0.310289 1.521464 1.779789 1.691203 1.658944 1.634184 1.099516 -0.336477 -0.077931 -0.045300 -0.292630 -0.240387 0.307058 0.437574 0.891669 1.282560 1.663663 -0.191286 -0.153149 0.842573 0.846091 1.564507)
- 8.367751 #(0.000000 0.645558 1.020824 1.674879 0.297321 1.478215 1.159425 0.013301 1.239885 0.350033 0.888999 1.831881 0.311808 0.919253 1.727115 0.871519 1.738071 0.513558 1.443664 0.420753 1.667825 0.484271 1.279276 0.823868 0.381782 0.911943 -0.096163 1.562504 0.828536 -0.144974 1.874517 0.768201 -0.125865 0.027788 0.992868 0.715728 -0.253408 1.108264 1.073157 0.786938 -0.002734 -0.154497 1.429041 1.081506 0.490310 0.770013 0.521515 0.288890 -0.695918 0.082180 -0.343666 1.544801 1.719927 1.637916 1.693329 1.678105 1.069958 -0.338832 -0.083132 -0.171885 -0.331886 -0.261796 0.380058 0.414290 0.757097 1.213104 1.511562 -0.172398 -0.158558 0.833537 0.819748 1.537843)
+ 8.375884 #r(0.000000 0.704287 1.002073 1.665258 0.322937 1.455570 1.095676 0.019520 1.265776 0.283182 0.917991 1.741290 0.286595 0.909432 1.680753 0.853512 1.790234 0.580849 1.462104 0.390604 1.608631 0.491512 1.302107 0.855899 0.376743 0.878628 -0.166734 1.586900 0.799671 -0.063381 1.765431 0.627081 -0.164410 -0.007173 0.940347 0.645761 -0.294937 1.130494 1.024960 0.847385 -0.017840 -0.118371 1.360715 1.113073 0.529708 0.795901 0.574578 0.399736 -0.603738 0.201753 -0.310289 1.521464 1.779789 1.691203 1.658944 1.634184 1.099516 -0.336477 -0.077931 -0.045300 -0.292630 -0.240387 0.307058 0.437574 0.891669 1.282560 1.663663 -0.191286 -0.153149 0.842573 0.846091 1.564507)
+ 8.367751 #r(0.000000 0.645558 1.020824 1.674879 0.297321 1.478215 1.159425 0.013301 1.239885 0.350033 0.888999 1.831881 0.311808 0.919253 1.727115 0.871519 1.738071 0.513558 1.443664 0.420753 1.667825 0.484271 1.279276 0.823868 0.381782 0.911943 -0.096163 1.562504 0.828536 -0.144974 1.874517 0.768201 -0.125865 0.027788 0.992868 0.715728 -0.253408 1.108264 1.073157 0.786938 -0.002734 -0.154497 1.429041 1.081506 0.490310 0.770013 0.521515 0.288890 -0.695918 0.082180 -0.343666 1.544801 1.719927 1.637916 1.693329 1.678105 1.069958 -0.338832 -0.083132 -0.171885 -0.331886 -0.261796 0.380058 0.414290 0.757097 1.213104 1.511562 -0.172398 -0.158558 0.833537 0.819748 1.537843)
;; 73-1
- 8.393433 #(0.000000 -1.651316 0.301642 1.466674 0.575226 1.013593 0.593794 -0.111599 1.175040 -0.036844 0.640902 -0.496840 0.997861 0.882127 1.022937 -0.182002 1.272243 -0.123920 0.043991 1.030819 1.511195 1.158707 -0.310897 1.682674 0.196749 1.379163 0.680074 0.977267 1.032336 1.755391 0.420238 0.127288 -0.116036 1.422986 0.200070 0.221084 0.315906 0.920268 0.575823 0.602266 1.097544 0.016105 0.141377 -0.123217 -0.343006 -0.132707 -0.193667 1.477259 0.489569 1.413642 -0.024032 -0.207016 0.154750 0.997956 -0.351070 0.296357 1.115717 0.543150 0.264016 1.680397 1.236837 0.299616 -0.037861 0.721978 -0.322788 -0.300188 1.010597 0.394676 1.139314 -0.124559 -0.185844 1.210473)
+ 8.393433 #r(0.000000 -1.651316 0.301642 1.466674 0.575226 1.013593 0.593794 -0.111599 1.175040 -0.036844 0.640902 -0.496840 0.997861 0.882127 1.022937 -0.182002 1.272243 -0.123920 0.043991 1.030819 1.511195 1.158707 -0.310897 1.682674 0.196749 1.379163 0.680074 0.977267 1.032336 1.755391 0.420238 0.127288 -0.116036 1.422986 0.200070 0.221084 0.315906 0.920268 0.575823 0.602266 1.097544 0.016105 0.141377 -0.123217 -0.343006 -0.132707 -0.193667 1.477259 0.489569 1.413642 -0.024032 -0.207016 0.154750 0.997956 -0.351070 0.296357 1.115717 0.543150 0.264016 1.680397 1.236837 0.299616 -0.037861 0.721978 -0.322788 -0.300188 1.010597 0.394676 1.139314 -0.124559 -0.185844 1.210473)
)
;;; 73 all -------------------------------------------------------------------------------- ; 8.5440
-(vector 73 10.773231506348 #(0 0 1 1 0 0 1 1 1 0 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 1 1 0 0 1 0 1 0 1 0 0 1 1)
+(vector 73 10.773231506348 #r(0 0 1 1 0 0 1 1 1 0 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 1 1 0 0 1 0 1 0 1 0 0 1 1)
- 8.384025 #(0.000000 -1.759204 0.258773 1.490961 0.614632 1.064083 0.749896 -0.054942 1.188953 -0.082775 0.873036 -0.312376 1.062898 0.841428 1.045571 -0.065614 1.274975 -1.916910 0.276098 1.092748 1.503967 1.111596 -0.088316 1.884539 0.350921 1.500472 0.770480 1.064780 1.223070 1.884184 0.475186 0.211115 -0.005807 1.621787 0.302411 0.412290 0.527707 1.021672 0.701884 0.707746 1.214077 0.185530 0.223747 0.017949 -0.122008 -0.024415 -0.102678 1.672194 0.539296 1.640314 0.112358 -0.000335 0.417518 1.145914 1.923035 0.558680 1.387459 0.626065 0.470292 1.786608 1.415338 0.546162 0.422057 0.960620 1.843908 -0.193870 1.077382 0.539432 1.348518 0.161710 0.094632 1.427803 0.677105)
+ 8.384025 #r(0.000000 -1.759204 0.258773 1.490961 0.614632 1.064083 0.749896 -0.054942 1.188953 -0.082775 0.873036 -0.312376 1.062898 0.841428 1.045571 -0.065614 1.274975 -1.916910 0.276098 1.092748 1.503967 1.111596 -0.088316 1.884539 0.350921 1.500472 0.770480 1.064780 1.223070 1.884184 0.475186 0.211115 -0.005807 1.621787 0.302411 0.412290 0.527707 1.021672 0.701884 0.707746 1.214077 0.185530 0.223747 0.017949 -0.122008 -0.024415 -0.102678 1.672194 0.539296 1.640314 0.112358 -0.000335 0.417518 1.145914 1.923035 0.558680 1.387459 0.626065 0.470292 1.786608 1.415338 0.546162 0.422057 0.960620 1.843908 -0.193870 1.077382 0.539432 1.348518 0.161710 0.094632 1.427803 0.677105)
- 8.371506 #(0.000000 -1.867938 0.232496 1.586661 0.641992 0.928863 0.649348 -0.044198 1.085010 0.079229 0.862927 -0.237800 1.012094 0.965795 1.257653 -0.154609 1.363426 -0.126060 0.258325 1.241200 1.562391 1.221551 -0.017796 -0.046230 0.396012 1.553068 0.824411 1.145699 1.128785 -0.049237 0.673355 0.304031 -0.042615 1.642256 0.320764 0.567488 0.582997 1.177975 0.715492 0.736721 1.338915 0.369645 0.312354 0.097607 -0.086716 0.014634 0.001469 1.805330 0.848100 1.689101 -0.032587 0.024783 0.624333 1.292453 0.091180 0.653940 1.534562 0.693020 0.501144 0.009915 1.675154 0.697198 0.435218 1.219144 0.148845 0.005218 1.413815 0.712782 1.528783 0.213630 0.113661 1.648322 0.824916)
+ 8.371506 #r(0.000000 -1.867938 0.232496 1.586661 0.641992 0.928863 0.649348 -0.044198 1.085010 0.079229 0.862927 -0.237800 1.012094 0.965795 1.257653 -0.154609 1.363426 -0.126060 0.258325 1.241200 1.562391 1.221551 -0.017796 -0.046230 0.396012 1.553068 0.824411 1.145699 1.128785 -0.049237 0.673355 0.304031 -0.042615 1.642256 0.320764 0.567488 0.582997 1.177975 0.715492 0.736721 1.338915 0.369645 0.312354 0.097607 -0.086716 0.014634 0.001469 1.805330 0.848100 1.689101 -0.032587 0.024783 0.624333 1.292453 0.091180 0.653940 1.534562 0.693020 0.501144 0.009915 1.675154 0.697198 0.435218 1.219144 0.148845 0.005218 1.413815 0.712782 1.528783 0.213630 0.113661 1.648322 0.824916)
)
;;; 74 all -------------------------------------------------------------------------------- ; 8.6023
-(vector 74 10.684138298035 #(0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 1)
+(vector 74 10.684138298035 #r(0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 1)
- 8.497103 #(0.000000 1.325782 0.182538 1.505234 0.945874 -0.041671 1.080868 0.605444 0.042184 0.866151 0.092779 0.735532 1.859565 0.020319 1.317206 0.107906 1.193633 1.487996 0.330731 0.601261 1.523499 -0.092194 -0.139866 0.997309 1.096776 -0.197191 1.061243 0.954641 0.070885 1.639404 0.509022 -0.561148 1.719565 1.632249 0.046116 -0.076359 1.376098 -0.015465 1.245129 0.220256 -0.000849 1.641349 1.603215 1.034336 0.812483 1.278349 1.510965 -0.515530 0.337854 1.060139 1.372801 0.633196 -0.113165 0.038608 0.288776 0.637200 0.027245 0.289307 1.083582 1.060936 0.972742 0.986362 -0.049682 0.384401 -0.025034 0.779020 0.227500 0.842052 1.419898 1.088862 -0.034683 -0.286302 1.416569 1.188508)
+ 8.497103 #r(0.000000 1.325782 0.182538 1.505234 0.945874 -0.041671 1.080868 0.605444 0.042184 0.866151 0.092779 0.735532 1.859565 0.020319 1.317206 0.107906 1.193633 1.487996 0.330731 0.601261 1.523499 -0.092194 -0.139866 0.997309 1.096776 -0.197191 1.061243 0.954641 0.070885 1.639404 0.509022 -0.561148 1.719565 1.632249 0.046116 -0.076359 1.376098 -0.015465 1.245129 0.220256 -0.000849 1.641349 1.603215 1.034336 0.812483 1.278349 1.510965 -0.515530 0.337854 1.060139 1.372801 0.633196 -0.113165 0.038608 0.288776 0.637200 0.027245 0.289307 1.083582 1.060936 0.972742 0.986362 -0.049682 0.384401 -0.025034 0.779020 0.227500 0.842052 1.419898 1.088862 -0.034683 -0.286302 1.416569 1.188508)
- 8.468489 #(0.000000 1.397351 0.199115 1.454114 1.031715 -0.176142 1.092851 0.462165 -0.016726 0.853430 -0.146725 0.811539 1.707371 -0.117500 1.407819 0.198961 1.078765 1.327293 0.331176 0.524536 1.478718 -0.063221 -0.112592 0.975553 1.167568 -0.244228 0.941673 1.029112 0.072643 1.555004 0.515688 -0.520416 1.848291 1.770668 -0.056909 0.037394 1.125814 -0.215204 1.309496 0.093237 -0.026125 1.523106 1.564912 1.107622 0.871096 1.093068 1.436174 -0.591776 -0.083622 0.913864 1.332465 0.538923 -0.091814 0.025942 0.246267 0.665145 0.061016 0.018831 1.154856 0.928981 0.707435 0.975317 -0.203276 0.390356 -0.015578 0.659407 0.326913 0.774677 1.281753 0.892058 0.125387 -0.275161 1.292193 1.029723)
+ 8.468489 #r(0.000000 1.397351 0.199115 1.454114 1.031715 -0.176142 1.092851 0.462165 -0.016726 0.853430 -0.146725 0.811539 1.707371 -0.117500 1.407819 0.198961 1.078765 1.327293 0.331176 0.524536 1.478718 -0.063221 -0.112592 0.975553 1.167568 -0.244228 0.941673 1.029112 0.072643 1.555004 0.515688 -0.520416 1.848291 1.770668 -0.056909 0.037394 1.125814 -0.215204 1.309496 0.093237 -0.026125 1.523106 1.564912 1.107622 0.871096 1.093068 1.436174 -0.591776 -0.083622 0.913864 1.332465 0.538923 -0.091814 0.025942 0.246267 0.665145 0.061016 0.018831 1.154856 0.928981 0.707435 0.975317 -0.203276 0.390356 -0.015578 0.659407 0.326913 0.774677 1.281753 0.892058 0.125387 -0.275161 1.292193 1.029723)
)
;;; 75 all -------------------------------------------------------------------------------- ; 8.6603
-(vector 75 10.935811368418 #(0 1 0 1 0 1 1 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 1 1 0 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 0 1 0 0 1 1 0 1 0 1 1)
+(vector 75 10.935811368418 #r(0 1 0 1 0 1 1 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 1 1 0 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 0 1 0 0 1 1 0 1 0 1 1)
- 8.611733 #(0.000000 1.755991 1.257704 1.380660 0.149810 0.888775 1.327127 0.155263 0.151577 1.307367 0.881185 1.244394 1.574597 0.297434 0.440838 1.532006 1.732873 0.955224 1.870085 1.039379 1.279345 1.370265 1.314175 1.228630 1.384735 1.656856 0.776266 0.604534 0.261984 1.021399 1.199829 0.578676 0.077339 1.180219 1.340992 0.303192 0.817942 1.840717 0.738716 0.586273 0.790045 1.068192 1.408743 0.034139 1.236420 0.200452 1.339574 1.564413 1.584603 1.696238 1.745531 0.073419 1.093015 0.201959 1.123150 0.434940 -0.158552 1.357895 0.030228 1.300705 0.831156 0.431680 0.205560 1.314167 1.822576 0.046350 0.064332 0.206633 1.539706 0.841946 1.061607 0.243862 0.776250 0.362661 1.442056)
+ 8.611733 #r(0.000000 1.755991 1.257704 1.380660 0.149810 0.888775 1.327127 0.155263 0.151577 1.307367 0.881185 1.244394 1.574597 0.297434 0.440838 1.532006 1.732873 0.955224 1.870085 1.039379 1.279345 1.370265 1.314175 1.228630 1.384735 1.656856 0.776266 0.604534 0.261984 1.021399 1.199829 0.578676 0.077339 1.180219 1.340992 0.303192 0.817942 1.840717 0.738716 0.586273 0.790045 1.068192 1.408743 0.034139 1.236420 0.200452 1.339574 1.564413 1.584603 1.696238 1.745531 0.073419 1.093015 0.201959 1.123150 0.434940 -0.158552 1.357895 0.030228 1.300705 0.831156 0.431680 0.205560 1.314167 1.822576 0.046350 0.064332 0.206633 1.539706 0.841946 1.061607 0.243862 0.776250 0.362661 1.442056)
;; pp:
- 8.821449 #(0.000000 0.643920 1.130972 1.690238 0.292464 0.869774 1.528895 0.096431 0.833368 1.732367 0.427956 1.133243 1.895101 0.800425 1.503313 0.355825 1.366323 0.344133 1.388010 0.331489 1.394341 0.485612 1.420333 0.688914 1.775329 0.789323 0.036609 1.415234 0.580136 1.640322 0.948602 0.310562 1.639770 0.988134 0.358709 1.824434 1.269806 0.767195 0.219365 1.612634 1.203169 0.799392 0.490094 0.057192 1.813674 1.532055 1.111172 0.983185 0.529777 0.494315 0.164905 0.200436 0.060224 0.054336 1.844838 1.742836 -0.015897 1.650654 1.808368 1.772294 1.907511 0.205329 0.331823 0.493249 0.521115 0.584376 0.981386 1.313449 1.561550 1.968782 0.480174 0.693653 1.229745 1.573452 0.052739)
+ 8.821449 #r(0.000000 0.643920 1.130972 1.690238 0.292464 0.869774 1.528895 0.096431 0.833368 1.732367 0.427956 1.133243 1.895101 0.800425 1.503313 0.355825 1.366323 0.344133 1.388010 0.331489 1.394341 0.485612 1.420333 0.688914 1.775329 0.789323 0.036609 1.415234 0.580136 1.640322 0.948602 0.310562 1.639770 0.988134 0.358709 1.824434 1.269806 0.767195 0.219365 1.612634 1.203169 0.799392 0.490094 0.057192 1.813674 1.532055 1.111172 0.983185 0.529777 0.494315 0.164905 0.200436 0.060224 0.054336 1.844838 1.742836 -0.015897 1.650654 1.808368 1.772294 1.907511 0.205329 0.331823 0.493249 0.521115 0.584376 0.981386 1.313449 1.561550 1.968782 0.480174 0.693653 1.229745 1.573452 0.052739)
;; 74+1
- 8.515318 #(0.000000 1.389029 0.053243 1.526646 1.085943 -0.014266 1.021845 0.785533 0.105740 1.066202 0.109541 0.721402 1.481339 -0.062236 1.471506 0.193577 1.353902 1.400242 0.278679 0.324177 1.590186 -0.227902 -0.241771 0.976773 0.943703 -0.115168 1.214668 0.867933 0.090538 1.812393 0.551644 -0.544819 1.885995 1.482864 0.072438 -0.206638 1.277003 0.005949 1.175272 0.161211 -0.337581 1.706146 1.432946 0.961103 0.665555 1.251116 1.581164 -0.454588 0.421031 1.091995 1.387656 0.588011 0.099113 -0.117947 0.106565 0.807292 -0.158839 0.438389 0.959674 0.818415 0.684353 0.940338 0.056996 0.185598 0.120952 0.730169 0.579518 0.929526 1.498906 1.051412 -0.221875 -0.584880 1.336940 1.131418 0.326487)
- 8.512424 #(0.000000 1.411165 0.066815 1.545993 0.946095 -0.013826 1.044201 0.645921 0.167534 0.936997 0.015362 0.752008 1.506866 -0.158860 1.516968 0.188211 1.320449 1.416434 0.301211 0.249914 1.630679 -0.182057 -0.250234 1.010984 0.856089 -0.194871 1.267794 0.818904 0.026503 1.685044 0.447764 -0.570160 1.818021 1.556283 0.065474 -0.160812 1.254420 0.015713 1.097954 0.076322 -0.329350 1.595682 1.328596 0.970473 0.523251 1.172474 1.547586 -0.576799 0.315720 1.005997 1.384889 0.446334 0.034057 -0.043520 0.102641 0.907794 -0.217100 0.330956 0.799047 0.751974 0.718734 0.830887 -0.040874 0.108169 -0.077398 0.706941 0.367992 0.821591 1.448143 1.030496 -0.359435 -0.609102 1.208112 1.153589 0.207741)
+ 8.515318 #r(0.000000 1.389029 0.053243 1.526646 1.085943 -0.014266 1.021845 0.785533 0.105740 1.066202 0.109541 0.721402 1.481339 -0.062236 1.471506 0.193577 1.353902 1.400242 0.278679 0.324177 1.590186 -0.227902 -0.241771 0.976773 0.943703 -0.115168 1.214668 0.867933 0.090538 1.812393 0.551644 -0.544819 1.885995 1.482864 0.072438 -0.206638 1.277003 0.005949 1.175272 0.161211 -0.337581 1.706146 1.432946 0.961103 0.665555 1.251116 1.581164 -0.454588 0.421031 1.091995 1.387656 0.588011 0.099113 -0.117947 0.106565 0.807292 -0.158839 0.438389 0.959674 0.818415 0.684353 0.940338 0.056996 0.185598 0.120952 0.730169 0.579518 0.929526 1.498906 1.051412 -0.221875 -0.584880 1.336940 1.131418 0.326487)
+ 8.512424 #r(0.000000 1.411165 0.066815 1.545993 0.946095 -0.013826 1.044201 0.645921 0.167534 0.936997 0.015362 0.752008 1.506866 -0.158860 1.516968 0.188211 1.320449 1.416434 0.301211 0.249914 1.630679 -0.182057 -0.250234 1.010984 0.856089 -0.194871 1.267794 0.818904 0.026503 1.685044 0.447764 -0.570160 1.818021 1.556283 0.065474 -0.160812 1.254420 0.015713 1.097954 0.076322 -0.329350 1.595682 1.328596 0.970473 0.523251 1.172474 1.547586 -0.576799 0.315720 1.005997 1.384889 0.446334 0.034057 -0.043520 0.102641 0.907794 -0.217100 0.330956 0.799047 0.751974 0.718734 0.830887 -0.040874 0.108169 -0.077398 0.706941 0.367992 0.821591 1.448143 1.030496 -0.359435 -0.609102 1.208112 1.153589 0.207741)
)
;;; 76 all -------------------------------------------------------------------------------- ; 8.7178
-(vector 76 10.689208030701 #(0 0 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 1 1 1 0 0 0 1 0 0 1 0 0 0)
+(vector 76 10.689208030701 #r(0 0 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 1 1 1 0 0 0 1 0 0 1 0 0 0)
- 8.622898 #(0.000000 0.389242 -0.170662 1.421644 1.248164 0.164000 0.718605 1.792721 0.677210 1.518595 0.963267 -0.186472 1.263794 1.595425 0.383743 0.443182 1.535243 0.669172 1.194047 0.802827 1.746269 0.569800 1.408025 1.796723 1.258639 0.620093 0.886554 0.863256 0.711462 1.456391 -0.186271 0.639923 1.414383 -0.059653 0.858601 0.618312 0.847274 0.301714 0.319909 0.359052 0.817062 -0.212571 0.558016 0.169995 1.152558 0.886044 1.332154 0.013242 0.369659 -0.032997 1.710630 1.029547 0.363359 -0.095703 0.197840 0.264645 1.078918 0.774045 1.172991 1.082380 0.650868 1.140749 0.194089 0.747056 0.734148 0.248352 1.094670 0.793873 -0.197763 1.665030 0.915389 0.675623 1.504323 1.585265 1.586133 1.087431)
+ 8.622898 #r(0.000000 0.389242 -0.170662 1.421644 1.248164 0.164000 0.718605 1.792721 0.677210 1.518595 0.963267 -0.186472 1.263794 1.595425 0.383743 0.443182 1.535243 0.669172 1.194047 0.802827 1.746269 0.569800 1.408025 1.796723 1.258639 0.620093 0.886554 0.863256 0.711462 1.456391 -0.186271 0.639923 1.414383 -0.059653 0.858601 0.618312 0.847274 0.301714 0.319909 0.359052 0.817062 -0.212571 0.558016 0.169995 1.152558 0.886044 1.332154 0.013242 0.369659 -0.032997 1.710630 1.029547 0.363359 -0.095703 0.197840 0.264645 1.078918 0.774045 1.172991 1.082380 0.650868 1.140749 0.194089 0.747056 0.734148 0.248352 1.094670 0.793873 -0.197763 1.665030 0.915389 0.675623 1.504323 1.585265 1.586133 1.087431)
- 8.574100 #(0.000000 0.381067 -0.272442 1.488465 1.142707 0.360320 0.746704 1.847055 0.740548 1.508045 0.951781 -0.163260 1.230184 1.623769 0.378228 0.442543 1.444666 0.627164 1.121499 0.747522 1.711575 0.455052 1.521242 1.941174 1.200574 0.592945 0.847791 0.979331 0.775371 1.568106 -0.195026 0.565512 1.483676 -0.004045 0.884949 0.722398 0.759194 0.390231 0.390425 0.259838 0.870917 -0.376787 0.551015 0.111447 1.304287 0.854661 1.506961 -0.032845 0.351362 0.031608 1.942972 1.061692 0.389298 -0.107628 -0.038521 0.239436 1.098754 0.925984 1.312533 1.079671 0.638668 1.047785 0.324774 0.836243 0.863976 0.266976 1.127471 0.871925 -0.192469 1.644992 0.941790 0.676374 1.373040 1.680505 1.659912 0.999514)
- 8.566643 #(0.000000 0.381106 -0.266391 1.483482 1.132005 0.371120 0.752013 1.832292 0.729074 1.486332 1.011195 -0.165598 1.221917 1.641575 0.360666 0.433077 1.404878 0.604388 1.104926 0.729165 1.669029 0.450931 1.499767 -0.080683 1.221002 0.625260 0.828962 0.972153 0.755738 1.545260 -0.154840 0.581108 1.513378 0.013021 0.891683 0.702677 0.747453 0.397193 0.417760 0.289893 0.885881 -0.366958 0.566657 0.149934 1.332346 0.845232 1.552276 -0.056636 0.409890 0.036503 -0.043099 1.055520 0.429840 -0.126953 0.004032 0.241993 1.122772 0.921410 1.349658 1.081742 0.615932 1.026733 0.322881 0.803706 0.857043 0.333651 1.097387 0.873399 -0.168242 1.662747 0.934611 0.695385 1.391924 1.697835 1.605684 0.993676)
+ 8.574100 #r(0.000000 0.381067 -0.272442 1.488465 1.142707 0.360320 0.746704 1.847055 0.740548 1.508045 0.951781 -0.163260 1.230184 1.623769 0.378228 0.442543 1.444666 0.627164 1.121499 0.747522 1.711575 0.455052 1.521242 1.941174 1.200574 0.592945 0.847791 0.979331 0.775371 1.568106 -0.195026 0.565512 1.483676 -0.004045 0.884949 0.722398 0.759194 0.390231 0.390425 0.259838 0.870917 -0.376787 0.551015 0.111447 1.304287 0.854661 1.506961 -0.032845 0.351362 0.031608 1.942972 1.061692 0.389298 -0.107628 -0.038521 0.239436 1.098754 0.925984 1.312533 1.079671 0.638668 1.047785 0.324774 0.836243 0.863976 0.266976 1.127471 0.871925 -0.192469 1.644992 0.941790 0.676374 1.373040 1.680505 1.659912 0.999514)
+ 8.566643 #r(0.000000 0.381106 -0.266391 1.483482 1.132005 0.371120 0.752013 1.832292 0.729074 1.486332 1.011195 -0.165598 1.221917 1.641575 0.360666 0.433077 1.404878 0.604388 1.104926 0.729165 1.669029 0.450931 1.499767 -0.080683 1.221002 0.625260 0.828962 0.972153 0.755738 1.545260 -0.154840 0.581108 1.513378 0.013021 0.891683 0.702677 0.747453 0.397193 0.417760 0.289893 0.885881 -0.366958 0.566657 0.149934 1.332346 0.845232 1.552276 -0.056636 0.409890 0.036503 -0.043099 1.055520 0.429840 -0.126953 0.004032 0.241993 1.122772 0.921410 1.349658 1.081742 0.615932 1.026733 0.322881 0.803706 0.857043 0.333651 1.097387 0.873399 -0.168242 1.662747 0.934611 0.695385 1.391924 1.697835 1.605684 0.993676)
)
;;; 77 all -------------------------------------------------------------------------------- ; 8.7750
-(vector 77 11.114716461811 #(0 1 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 1 0 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 0)
+(vector 77 11.114716461811 #r(0 1 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 1 0 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 0)
- 8.693626 #(0.000000 0.342470 0.518102 0.602103 1.407511 1.793531 0.096346 0.250378 0.943784 0.388159 0.656038 0.296223 1.141950 0.214103 0.212479 0.828756 1.402312 1.692057 0.511954 0.158583 -0.254149 0.373835 0.095344 -0.147316 0.784069 0.081610 -0.056393 0.798330 0.705534 1.696239 0.742515 1.236436 -0.107133 1.590407 0.658892 -0.033009 -0.161883 1.612218 1.476439 0.692575 -0.060023 1.224517 0.875204 0.501273 0.494798 0.327706 1.600469 0.607079 0.567961 0.917115 0.716199 1.138396 0.731691 -0.084350 0.371809 0.181536 0.739186 1.478965 0.762792 0.759384 1.499056 1.662862 1.474568 1.752637 0.981158 1.382311 0.543578 -0.609814 1.825975 0.848970 1.045950 0.310451 0.519502 0.003348 1.354017 -0.105098 1.298274)
+ 8.693626 #r(0.000000 0.342470 0.518102 0.602103 1.407511 1.793531 0.096346 0.250378 0.943784 0.388159 0.656038 0.296223 1.141950 0.214103 0.212479 0.828756 1.402312 1.692057 0.511954 0.158583 -0.254149 0.373835 0.095344 -0.147316 0.784069 0.081610 -0.056393 0.798330 0.705534 1.696239 0.742515 1.236436 -0.107133 1.590407 0.658892 -0.033009 -0.161883 1.612218 1.476439 0.692575 -0.060023 1.224517 0.875204 0.501273 0.494798 0.327706 1.600469 0.607079 0.567961 0.917115 0.716199 1.138396 0.731691 -0.084350 0.371809 0.181536 0.739186 1.478965 0.762792 0.759384 1.499056 1.662862 1.474568 1.752637 0.981158 1.382311 0.543578 -0.609814 1.825975 0.848970 1.045950 0.310451 0.519502 0.003348 1.354017 -0.105098 1.298274)
- 8.657403 #(0.000000 0.144503 0.521174 0.518787 1.193244 1.814457 -0.020944 0.363643 0.853723 0.860530 0.580514 0.078066 1.010161 0.221441 0.183044 0.759859 1.545184 -0.010635 0.635858 0.285802 -0.330206 0.372074 0.148651 -0.307361 0.733497 -0.192823 -0.013078 0.625648 0.850253 1.811781 0.605791 1.229804 0.065972 1.468728 0.623063 -0.230764 -0.019445 1.531051 1.297899 0.768834 -0.081130 1.071894 0.927752 0.511168 0.237065 0.316832 -0.004891 0.571763 0.647286 1.228392 0.493001 1.368827 0.671571 -0.234110 0.332624 0.387950 0.822479 1.176496 1.091221 0.738538 1.432063 1.421456 1.054724 -0.269734 0.700009 1.401715 0.397450 -0.246031 -0.115146 0.640052 0.961541 0.375597 0.318506 -0.237690 1.548563 -0.512722 1.445228)
- 8.655850 #(0.000000 0.144015 0.521787 0.519011 1.193985 1.813929 -0.020721 0.363063 0.853642 0.859887 0.580896 0.078449 1.009266 0.221508 0.182992 0.759898 1.544517 -0.010376 0.635651 0.285693 -0.330723 0.371939 0.149327 -0.307594 0.733085 -0.192814 -0.013453 0.625868 0.850147 1.811263 0.605103 1.230124 0.065834 1.468308 0.622956 -0.230654 -0.019787 1.531322 1.297364 0.769617 -0.081404 1.071828 0.928156 0.511154 0.237021 0.316908 -0.004413 0.571845 0.646678 1.228590 0.492699 1.369241 0.672452 -0.233665 0.332431 0.388115 0.821896 1.176234 1.091315 0.738910 1.432114 1.421319 1.054889 -0.269641 0.700596 1.402150 0.397349 -0.245474 -0.116062 0.640946 0.961580 0.375676 0.318553 -0.237609 1.548434 -0.512459 1.445327)
+ 8.657403 #r(0.000000 0.144503 0.521174 0.518787 1.193244 1.814457 -0.020944 0.363643 0.853723 0.860530 0.580514 0.078066 1.010161 0.221441 0.183044 0.759859 1.545184 -0.010635 0.635858 0.285802 -0.330206 0.372074 0.148651 -0.307361 0.733497 -0.192823 -0.013078 0.625648 0.850253 1.811781 0.605791 1.229804 0.065972 1.468728 0.623063 -0.230764 -0.019445 1.531051 1.297899 0.768834 -0.081130 1.071894 0.927752 0.511168 0.237065 0.316832 -0.004891 0.571763 0.647286 1.228392 0.493001 1.368827 0.671571 -0.234110 0.332624 0.387950 0.822479 1.176496 1.091221 0.738538 1.432063 1.421456 1.054724 -0.269734 0.700009 1.401715 0.397450 -0.246031 -0.115146 0.640052 0.961541 0.375597 0.318506 -0.237690 1.548563 -0.512722 1.445228)
+ 8.655850 #r(0.000000 0.144015 0.521787 0.519011 1.193985 1.813929 -0.020721 0.363063 0.853642 0.859887 0.580896 0.078449 1.009266 0.221508 0.182992 0.759898 1.544517 -0.010376 0.635651 0.285693 -0.330723 0.371939 0.149327 -0.307594 0.733085 -0.192814 -0.013453 0.625868 0.850147 1.811263 0.605103 1.230124 0.065834 1.468308 0.622956 -0.230654 -0.019787 1.531322 1.297364 0.769617 -0.081404 1.071828 0.928156 0.511154 0.237021 0.316908 -0.004413 0.571845 0.646678 1.228590 0.492699 1.369241 0.672452 -0.233665 0.332431 0.388115 0.821896 1.176234 1.091315 0.738910 1.432114 1.421319 1.054889 -0.269641 0.700596 1.402150 0.397349 -0.245474 -0.116062 0.640946 0.961580 0.375676 0.318553 -0.237609 1.548434 -0.512459 1.445327)
)
;;; 78 all -------------------------------------------------------------------------------- ; 8.8318
-(vector 78 11.471938943963 #(0 1 1 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1)
+(vector 78 11.471938943963 #r(0 1 1 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1)
- 8.721647 #(0.000000 1.249128 1.236819 0.086271 0.084870 1.618123 0.329492 1.828009 1.561909 0.021559 1.381905 1.787354 1.267428 0.679445 0.317703 1.068186 0.771332 1.720040 0.579492 0.551164 0.773425 1.834796 0.776430 1.432091 0.890602 0.586016 1.596666 0.290630 1.219329 1.491675 0.728639 1.708194 1.560487 1.434303 1.462488 0.635070 1.113941 1.563335 1.460331 0.701917 0.605822 1.400388 -0.075938 0.671582 0.475347 1.301044 1.799871 0.995216 1.609922 0.401184 0.764542 1.290171 0.978260 1.880400 0.986160 0.147021 0.340498 0.060183 -0.194639 1.442758 -0.089614 1.632445 0.465746 0.262863 0.032668 -0.154147 0.169869 0.985285 0.862469 0.985943 1.417781 1.577680 0.168817 -0.243252 1.808701 0.241312 1.826852 1.010182)
- 8.713157 #(0.000000 1.185175 1.397998 0.029507 -0.003150 1.681558 0.352287 -0.142980 1.503432 -0.031653 1.606742 1.761627 1.241378 0.692257 0.198504 1.080125 0.928512 1.682058 0.474050 0.647248 0.825797 1.866311 0.823439 1.412665 0.855734 0.627072 1.762849 0.273347 1.224795 1.527402 0.799841 1.826401 1.613076 1.464329 1.459644 0.659045 1.125726 1.685514 1.459290 0.692583 0.629938 1.416569 -0.101579 0.653448 0.364955 1.272692 1.662367 1.045389 1.620168 0.458585 0.835933 1.249466 0.947077 -0.133359 1.014573 0.250790 0.421139 -0.005825 -0.027874 1.307059 0.066093 1.637593 0.497687 0.345017 0.115925 -0.006858 0.311739 1.192497 0.790849 1.021741 1.387921 1.598464 0.189632 -0.083007 1.800753 0.182932 -0.105722 0.993536)
+ 8.721647 #r(0.000000 1.249128 1.236819 0.086271 0.084870 1.618123 0.329492 1.828009 1.561909 0.021559 1.381905 1.787354 1.267428 0.679445 0.317703 1.068186 0.771332 1.720040 0.579492 0.551164 0.773425 1.834796 0.776430 1.432091 0.890602 0.586016 1.596666 0.290630 1.219329 1.491675 0.728639 1.708194 1.560487 1.434303 1.462488 0.635070 1.113941 1.563335 1.460331 0.701917 0.605822 1.400388 -0.075938 0.671582 0.475347 1.301044 1.799871 0.995216 1.609922 0.401184 0.764542 1.290171 0.978260 1.880400 0.986160 0.147021 0.340498 0.060183 -0.194639 1.442758 -0.089614 1.632445 0.465746 0.262863 0.032668 -0.154147 0.169869 0.985285 0.862469 0.985943 1.417781 1.577680 0.168817 -0.243252 1.808701 0.241312 1.826852 1.010182)
+ 8.713157 #r(0.000000 1.185175 1.397998 0.029507 -0.003150 1.681558 0.352287 -0.142980 1.503432 -0.031653 1.606742 1.761627 1.241378 0.692257 0.198504 1.080125 0.928512 1.682058 0.474050 0.647248 0.825797 1.866311 0.823439 1.412665 0.855734 0.627072 1.762849 0.273347 1.224795 1.527402 0.799841 1.826401 1.613076 1.464329 1.459644 0.659045 1.125726 1.685514 1.459290 0.692583 0.629938 1.416569 -0.101579 0.653448 0.364955 1.272692 1.662367 1.045389 1.620168 0.458585 0.835933 1.249466 0.947077 -0.133359 1.014573 0.250790 0.421139 -0.005825 -0.027874 1.307059 0.066093 1.637593 0.497687 0.345017 0.115925 -0.006858 0.311739 1.192497 0.790849 1.021741 1.387921 1.598464 0.189632 -0.083007 1.800753 0.182932 -0.105722 0.993536)
)
;;; 79 all -------------------------------------------------------------------------------- ; 8.8882
-(vector 79 11.334476470947 #(0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 0 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 1 1 0 0 1 0 0 0 1 1 0 0 0 0 0 1 0)
+(vector 79 11.334476470947 #r(0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 0 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 1 1 0 0 1 0 0 0 1 1 0 0 0 0 0 1 0)
- 8.845367 #(0.000000 1.238318 1.165090 1.291700 0.803595 0.614248 1.388497 1.905092 0.146964 0.775475 0.093294 -0.057178 0.069260 0.967289 0.726888 1.927694 0.404014 -0.050125 1.170622 0.795731 0.415661 0.113117 0.949983 0.547877 0.937155 0.147536 1.182414 0.680260 0.043365 0.406697 0.191985 0.520170 0.649818 0.646884 0.567272 1.384599 1.089945 0.420022 1.776381 1.388186 1.481564 0.061642 1.806781 0.638535 0.038366 1.606509 1.826388 1.366478 1.328019 0.480776 1.683074 0.476259 0.537766 1.179629 1.609320 1.234604 0.090600 0.429089 1.028733 0.835166 0.689618 1.227466 0.068475 0.130750 1.461448 1.601183 1.627224 0.857096 1.862391 0.455364 1.260302 0.135047 1.550455 0.219288 0.922341 0.004761 0.651583 1.409352 1.642849)
+ 8.845367 #r(0.000000 1.238318 1.165090 1.291700 0.803595 0.614248 1.388497 1.905092 0.146964 0.775475 0.093294 -0.057178 0.069260 0.967289 0.726888 1.927694 0.404014 -0.050125 1.170622 0.795731 0.415661 0.113117 0.949983 0.547877 0.937155 0.147536 1.182414 0.680260 0.043365 0.406697 0.191985 0.520170 0.649818 0.646884 0.567272 1.384599 1.089945 0.420022 1.776381 1.388186 1.481564 0.061642 1.806781 0.638535 0.038366 1.606509 1.826388 1.366478 1.328019 0.480776 1.683074 0.476259 0.537766 1.179629 1.609320 1.234604 0.090600 0.429089 1.028733 0.835166 0.689618 1.227466 0.068475 0.130750 1.461448 1.601183 1.627224 0.857096 1.862391 0.455364 1.260302 0.135047 1.550455 0.219288 0.922341 0.004761 0.651583 1.409352 1.642849)
;; pp:
- 8.777582 #(0.000000 0.850012 1.278466 1.671652 0.485604 1.428681 1.798079 0.243483 0.926746 1.779185 0.395714 1.026729 -0.089658 1.070596 1.891094 0.483045 1.500429 0.189865 1.099066 0.205077 0.960527 0.060100 1.107914 0.183231 1.450310 0.468483 1.446982 0.685162 -0.081146 1.099289 0.484068 -0.117908 1.374114 0.639742 1.715595 0.816256 0.293012 1.668108 1.425294 0.747308 0.296172 1.780496 1.411915 0.770108 0.585162 0.343644 1.740454 0.115329 1.259755 1.673967 0.856085 0.577614 0.383167 0.304410 -0.049803 0.056826 -0.212368 1.721031 0.015177 1.660724 1.618929 1.612917 1.203620 1.624606 1.770412 0.046014 0.166329 0.333277 0.356575 0.671429 0.926511 1.256476 -0.022764 0.419017 0.748312 1.255568 1.486031 1.553904 0.445544)
- 8.767436 #(0.000000 0.718403 1.251314 1.486434 0.417739 1.537028 1.781280 0.371804 0.856023 1.697105 0.410324 1.015131 -0.119095 1.081250 -0.157946 0.436892 1.552209 0.310681 1.199628 0.374846 0.988915 0.054273 1.300951 0.365816 1.604177 0.398188 1.427075 0.723659 0.021475 1.135277 0.715183 -0.075549 1.555657 0.584681 1.776086 0.831855 0.296030 1.723871 1.434840 0.893843 0.399844 1.754534 1.625700 0.603594 0.563673 0.311786 1.758993 0.014755 1.458293 1.648023 0.983651 0.560806 0.171502 0.278061 0.103727 -0.090556 -0.256311 1.589447 0.057298 1.706317 1.625686 1.735520 1.218723 1.651189 1.784299 0.256509 0.287738 0.688962 0.644695 0.791051 0.753121 1.204382 -0.074638 0.485008 0.749887 1.461595 1.411150 1.659818 0.509864)
+ 8.777582 #r(0.000000 0.850012 1.278466 1.671652 0.485604 1.428681 1.798079 0.243483 0.926746 1.779185 0.395714 1.026729 -0.089658 1.070596 1.891094 0.483045 1.500429 0.189865 1.099066 0.205077 0.960527 0.060100 1.107914 0.183231 1.450310 0.468483 1.446982 0.685162 -0.081146 1.099289 0.484068 -0.117908 1.374114 0.639742 1.715595 0.816256 0.293012 1.668108 1.425294 0.747308 0.296172 1.780496 1.411915 0.770108 0.585162 0.343644 1.740454 0.115329 1.259755 1.673967 0.856085 0.577614 0.383167 0.304410 -0.049803 0.056826 -0.212368 1.721031 0.015177 1.660724 1.618929 1.612917 1.203620 1.624606 1.770412 0.046014 0.166329 0.333277 0.356575 0.671429 0.926511 1.256476 -0.022764 0.419017 0.748312 1.255568 1.486031 1.553904 0.445544)
+ 8.767436 #r(0.000000 0.718403 1.251314 1.486434 0.417739 1.537028 1.781280 0.371804 0.856023 1.697105 0.410324 1.015131 -0.119095 1.081250 -0.157946 0.436892 1.552209 0.310681 1.199628 0.374846 0.988915 0.054273 1.300951 0.365816 1.604177 0.398188 1.427075 0.723659 0.021475 1.135277 0.715183 -0.075549 1.555657 0.584681 1.776086 0.831855 0.296030 1.723871 1.434840 0.893843 0.399844 1.754534 1.625700 0.603594 0.563673 0.311786 1.758993 0.014755 1.458293 1.648023 0.983651 0.560806 0.171502 0.278061 0.103727 -0.090556 -0.256311 1.589447 0.057298 1.706317 1.625686 1.735520 1.218723 1.651189 1.784299 0.256509 0.287738 0.688962 0.644695 0.791051 0.753121 1.204382 -0.074638 0.485008 0.749887 1.461595 1.411150 1.659818 0.509864)
)
;;; 80 all -------------------------------------------------------------------------------- ; 8.9443
-(vector 80 11.30185508728 #(0 1 1 1 1 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 1 0 1 1 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0)
+(vector 80 11.30185508728 #r(0 1 1 1 1 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 1 0 1 1 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0)
- 8.831605 #(0.000000 0.718457 0.752874 0.707265 1.105140 1.556866 1.675971 1.743288 1.737050 1.402684 0.726424 0.001544 0.787560 0.610707 0.221912 0.548490 1.255462 0.532840 1.735795 1.159475 0.139393 0.566082 0.477708 1.186070 0.213588 1.697938 1.877210 -0.027617 0.446036 -0.097653 1.420626 0.288659 1.413894 1.358919 0.713009 -0.285435 0.875204 0.375292 0.708148 0.907015 0.596415 1.676708 -0.002236 0.617188 -0.254880 0.679354 1.396570 0.024604 0.491384 1.191175 0.583286 0.255907 0.583959 0.646881 1.743044 0.166682 0.513542 1.079013 0.694687 0.379588 0.528146 0.707196 1.408903 1.510794 1.151055 0.672700 0.297721 -0.154036 1.059849 1.480109 0.687072 0.133333 1.264870 -0.326181 0.342810 1.875130 1.918140 1.634313 0.782341 -0.170226)
+ 8.831605 #r(0.000000 0.718457 0.752874 0.707265 1.105140 1.556866 1.675971 1.743288 1.737050 1.402684 0.726424 0.001544 0.787560 0.610707 0.221912 0.548490 1.255462 0.532840 1.735795 1.159475 0.139393 0.566082 0.477708 1.186070 0.213588 1.697938 1.877210 -0.027617 0.446036 -0.097653 1.420626 0.288659 1.413894 1.358919 0.713009 -0.285435 0.875204 0.375292 0.708148 0.907015 0.596415 1.676708 -0.002236 0.617188 -0.254880 0.679354 1.396570 0.024604 0.491384 1.191175 0.583286 0.255907 0.583959 0.646881 1.743044 0.166682 0.513542 1.079013 0.694687 0.379588 0.528146 0.707196 1.408903 1.510794 1.151055 0.672700 0.297721 -0.154036 1.059849 1.480109 0.687072 0.133333 1.264870 -0.326181 0.342810 1.875130 1.918140 1.634313 0.782341 -0.170226)
;; 81 - 1
- 8.853012 #(0.000000 0.713664 0.751521 0.448581 1.078712 1.434332 -0.106130 1.560883 1.450760 1.498278 0.937332 -0.045737 0.468326 0.366103 0.320014 0.581407 1.184615 0.699951 1.696540 1.157496 0.135085 0.626551 0.420080 1.134483 0.350026 1.714983 1.594968 0.442820 0.488286 -0.156674 1.134813 0.168151 1.216425 0.905956 0.520243 -0.142318 0.437369 0.180759 0.624230 0.569840 0.172595 1.321073 -0.234574 0.786368 -0.490064 0.447127 1.640821 -0.178464 0.308828 0.997718 0.822718 -0.196077 0.281017 0.757467 1.401582 0.240219 0.552190 0.865559 0.311162 0.036903 0.553601 0.299180 1.009477 1.109391 0.804156 0.557491 0.291292 -0.278325 0.995535 -0.048564 0.514170 -0.227699 1.019707 -0.548622 -0.162405 1.658786 1.315882 1.435095 0.750976 -0.261917)
+ 8.853012 #r(0.000000 0.713664 0.751521 0.448581 1.078712 1.434332 -0.106130 1.560883 1.450760 1.498278 0.937332 -0.045737 0.468326 0.366103 0.320014 0.581407 1.184615 0.699951 1.696540 1.157496 0.135085 0.626551 0.420080 1.134483 0.350026 1.714983 1.594968 0.442820 0.488286 -0.156674 1.134813 0.168151 1.216425 0.905956 0.520243 -0.142318 0.437369 0.180759 0.624230 0.569840 0.172595 1.321073 -0.234574 0.786368 -0.490064 0.447127 1.640821 -0.178464 0.308828 0.997718 0.822718 -0.196077 0.281017 0.757467 1.401582 0.240219 0.552190 0.865559 0.311162 0.036903 0.553601 0.299180 1.009477 1.109391 0.804156 0.557491 0.291292 -0.278325 0.995535 -0.048564 0.514170 -0.227699 1.019707 -0.548622 -0.162405 1.658786 1.315882 1.435095 0.750976 -0.261917)
;; stopped due to heat wave
)
;;; 81 all -------------------------------------------------------------------------------- ; 9
-(vector 81 11.22668050284 #(0 0 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0 0 0 0 0 1 0 1)
+(vector 81 11.22668050284 #r(0 0 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0 0 0 0 0 1 0 1)
- 8.961491 #(0.000000 0.634711 0.914288 0.369120 0.489315 1.342522 0.647705 1.766421 1.148272 1.455934 0.450010 0.224566 1.110702 0.040996 1.346853 1.773154 1.255402 0.752437 1.110884 0.031625 1.597766 0.103816 1.912905 -0.011027 0.863686 0.820253 1.302167 1.352505 1.039370 0.116915 0.947518 1.168519 0.272351 1.514646 1.808891 0.551022 1.359986 0.703545 0.651408 1.697573 1.001093 1.819478 -0.153070 -0.020542 0.748602 1.669047 0.373021 0.491577 0.705265 0.740848 -0.189697 0.502215 0.348836 0.005306 -0.207198 0.930183 -0.631614 1.639932 1.773044 1.357496 1.130593 0.312825 1.896666 0.201668 1.169961 0.899991 0.382267 -0.065252 0.308097 0.095309 1.059630 -0.075945 1.147344 0.303812 -0.113244 -0.220507 0.240152 1.567520 0.130729 0.128142 -0.134246)
+ 8.961491 #r(0.000000 0.634711 0.914288 0.369120 0.489315 1.342522 0.647705 1.766421 1.148272 1.455934 0.450010 0.224566 1.110702 0.040996 1.346853 1.773154 1.255402 0.752437 1.110884 0.031625 1.597766 0.103816 1.912905 -0.011027 0.863686 0.820253 1.302167 1.352505 1.039370 0.116915 0.947518 1.168519 0.272351 1.514646 1.808891 0.551022 1.359986 0.703545 0.651408 1.697573 1.001093 1.819478 -0.153070 -0.020542 0.748602 1.669047 0.373021 0.491577 0.705265 0.740848 -0.189697 0.502215 0.348836 0.005306 -0.207198 0.930183 -0.631614 1.639932 1.773044 1.357496 1.130593 0.312825 1.896666 0.201668 1.169961 0.899991 0.382267 -0.065252 0.308097 0.095309 1.059630 -0.075945 1.147344 0.303812 -0.113244 -0.220507 0.240152 1.567520 0.130729 0.128142 -0.134246)
;; pp:
- 8.909320 #(0.000000 0.637783 1.093840 1.736075 0.229438 0.855956 1.363854 0.030260 0.521624 1.242121 0.051165 0.675419 1.614595 0.476873 1.278688 0.012785 0.817110 -0.304934 0.720383 -0.202920 0.733695 0.107439 1.315558 0.129614 1.122993 0.193244 1.234642 0.403581 1.725244 0.895732 0.205820 1.636536 0.593082 1.809528 1.260391 0.470119 -0.070091 1.399098 0.818162 0.271203 1.928340 1.562814 0.865292 0.051460 1.916623 1.232135 1.265689 0.734799 0.654116 0.188660 0.092307 1.641866 1.468875 0.817027 0.972897 0.621305 0.637924 0.617240 0.962249 0.473819 0.518139 0.286173 0.438785 0.267011 0.412016 0.426579 0.834941 1.189978 1.256888 1.096694 1.389245 1.442391 -0.226908 0.347927 0.458943 0.982038 1.505430 1.850054 0.061414 0.437908 0.768823)
+ 8.909320 #r(0.000000 0.637783 1.093840 1.736075 0.229438 0.855956 1.363854 0.030260 0.521624 1.242121 0.051165 0.675419 1.614595 0.476873 1.278688 0.012785 0.817110 -0.304934 0.720383 -0.202920 0.733695 0.107439 1.315558 0.129614 1.122993 0.193244 1.234642 0.403581 1.725244 0.895732 0.205820 1.636536 0.593082 1.809528 1.260391 0.470119 -0.070091 1.399098 0.818162 0.271203 1.928340 1.562814 0.865292 0.051460 1.916623 1.232135 1.265689 0.734799 0.654116 0.188660 0.092307 1.641866 1.468875 0.817027 0.972897 0.621305 0.637924 0.617240 0.962249 0.473819 0.518139 0.286173 0.438785 0.267011 0.412016 0.426579 0.834941 1.189978 1.256888 1.096694 1.389245 1.442391 -0.226908 0.347927 0.458943 0.982038 1.505430 1.850054 0.061414 0.437908 0.768823)
;; also 80+1 originally:
- 8.968686 #(0.000000 0.248430 0.863441 0.293416 0.756185 1.379289 -0.270431 1.263800 1.341315 1.557550 1.197384 0.213673 0.196685 0.062803 0.468673 0.734019 1.159371 0.832869 1.483006 0.904988 -0.128901 0.681963 0.619993 1.568168 0.324132 1.473951 1.629584 0.505398 0.500570 -0.070053 1.349935 -0.001861 1.159249 0.864343 0.801291 -0.786597 0.513558 0.362321 0.664120 0.282478 0.118044 1.145415 -0.296862 0.587955 -0.589352 0.600173 1.355457 -0.471847 0.396241 0.750727 1.123705 -0.583153 0.192765 0.272763 0.931980 0.776263 0.394773 0.897959 0.871419 0.420019 0.376219 -0.208891 0.894969 0.785338 0.828230 0.967371 0.361582 -0.266678 0.703981 -0.550373 0.421334 -0.253234 1.003690 -0.389957 -0.015548 -0.430183 -0.152241 1.200914 0.591632 -0.142675 -0.492441)
+ 8.968686 #r(0.000000 0.248430 0.863441 0.293416 0.756185 1.379289 -0.270431 1.263800 1.341315 1.557550 1.197384 0.213673 0.196685 0.062803 0.468673 0.734019 1.159371 0.832869 1.483006 0.904988 -0.128901 0.681963 0.619993 1.568168 0.324132 1.473951 1.629584 0.505398 0.500570 -0.070053 1.349935 -0.001861 1.159249 0.864343 0.801291 -0.786597 0.513558 0.362321 0.664120 0.282478 0.118044 1.145415 -0.296862 0.587955 -0.589352 0.600173 1.355457 -0.471847 0.396241 0.750727 1.123705 -0.583153 0.192765 0.272763 0.931980 0.776263 0.394773 0.897959 0.871419 0.420019 0.376219 -0.208891 0.894969 0.785338 0.828230 0.967371 0.361582 -0.266678 0.703981 -0.550373 0.421334 -0.253234 1.003690 -0.389957 -0.015548 -0.430183 -0.152241 1.200914 0.591632 -0.142675 -0.492441)
;; 80+1
- 8.798551 #(0.000000 0.591095 0.766372 0.489633 0.892830 1.470880 0.024266 1.553545 1.397381 1.549957 0.961480 0.030745 0.350509 0.480664 0.324535 0.532859 1.178437 0.600433 1.721653 1.190766 0.203234 0.634172 0.473637 1.167212 0.251931 1.758060 1.536282 0.415486 0.566371 -0.279352 1.143985 0.080086 1.312189 0.802180 0.476214 -0.170351 0.392370 0.054114 0.648162 0.604589 0.159911 1.129280 -0.198924 0.772307 -0.404913 0.496844 1.664189 -0.222495 0.397365 0.945586 0.907997 -0.249926 0.105251 0.650639 1.266007 0.197774 0.522775 0.879085 0.342046 0.049647 0.501455 0.132186 0.903401 1.133013 0.925314 0.555954 0.264446 -0.269660 0.922009 -0.001103 0.579617 -0.224098 1.014084 -0.530017 -0.206754 1.601599 1.281427 1.317681 0.768845 -0.280697 -0.570842)
- 8.797329 #(0.000000 0.593378 0.769030 0.482050 0.894789 1.469434 0.017291 1.548640 1.399875 1.547111 0.960600 0.029476 0.347173 0.479328 0.324764 0.535557 1.181648 0.603853 1.724567 1.184427 0.201520 0.621022 0.466053 1.172410 0.257155 1.744523 1.537620 0.413349 0.571480 -0.275441 1.147662 0.078171 1.318337 0.797128 0.465604 -0.167976 0.389127 0.046196 0.644876 0.600407 0.146824 1.140648 -0.196543 0.766952 -0.405128 0.495879 1.671836 -0.221864 0.393766 0.946119 0.917743 -0.256291 0.111525 0.645632 1.265055 0.181069 0.525294 0.880675 0.348447 0.049079 0.495123 0.135981 0.911089 1.141680 0.914015 0.556460 0.266976 -0.250402 0.919302 -0.007489 0.586097 -0.221631 1.012419 -0.545708 -0.213348 1.601484 1.279462 1.306339 0.757689 -0.274675 -0.570934)
+ 8.798551 #r(0.000000 0.591095 0.766372 0.489633 0.892830 1.470880 0.024266 1.553545 1.397381 1.549957 0.961480 0.030745 0.350509 0.480664 0.324535 0.532859 1.178437 0.600433 1.721653 1.190766 0.203234 0.634172 0.473637 1.167212 0.251931 1.758060 1.536282 0.415486 0.566371 -0.279352 1.143985 0.080086 1.312189 0.802180 0.476214 -0.170351 0.392370 0.054114 0.648162 0.604589 0.159911 1.129280 -0.198924 0.772307 -0.404913 0.496844 1.664189 -0.222495 0.397365 0.945586 0.907997 -0.249926 0.105251 0.650639 1.266007 0.197774 0.522775 0.879085 0.342046 0.049647 0.501455 0.132186 0.903401 1.133013 0.925314 0.555954 0.264446 -0.269660 0.922009 -0.001103 0.579617 -0.224098 1.014084 -0.530017 -0.206754 1.601599 1.281427 1.317681 0.768845 -0.280697 -0.570842)
+ 8.797329 #r(0.000000 0.593378 0.769030 0.482050 0.894789 1.469434 0.017291 1.548640 1.399875 1.547111 0.960600 0.029476 0.347173 0.479328 0.324764 0.535557 1.181648 0.603853 1.724567 1.184427 0.201520 0.621022 0.466053 1.172410 0.257155 1.744523 1.537620 0.413349 0.571480 -0.275441 1.147662 0.078171 1.318337 0.797128 0.465604 -0.167976 0.389127 0.046196 0.644876 0.600407 0.146824 1.140648 -0.196543 0.766952 -0.405128 0.495879 1.671836 -0.221864 0.393766 0.946119 0.917743 -0.256291 0.111525 0.645632 1.265055 0.181069 0.525294 0.880675 0.348447 0.049079 0.495123 0.135981 0.911089 1.141680 0.914015 0.556460 0.266976 -0.250402 0.919302 -0.007489 0.586097 -0.221631 1.012419 -0.545708 -0.213348 1.601484 1.279462 1.306339 0.757689 -0.274675 -0.570934)
)
;;; 82 all -------------------------------------------------------------------------------- ; 9.0554
-(vector 82 11.601468306037 #(0 0 0 1 0 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 0 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 0 1 1 1 0 0 1 0)
+(vector 82 11.601468306037 #r(0 0 0 1 0 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 0 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 0 1 1 1 0 0 1 0)
- 9.074372 #(0.000000 1.648602 0.113059 0.965847 0.614379 1.876939 0.598065 0.033495 1.128904 0.535962 0.404933 0.340847 -0.287176 1.664997 0.944124 0.484563 1.365390 -0.175780 1.135023 1.030858 0.610885 1.630994 0.348969 1.892603 0.337558 0.278067 1.048537 1.676406 0.392409 0.207975 0.887089 1.313518 1.800663 1.007393 0.181812 -0.074478 0.144619 1.511865 1.173214 0.664191 1.387698 1.632837 0.132108 0.353188 0.227412 1.024174 1.607289 0.662392 -0.023377 -0.428601 1.063517 1.407784 1.563623 0.788150 1.561202 0.023129 0.361493 1.608137 1.816713 0.962416 0.274252 0.900687 0.860331 0.458473 0.118859 0.572111 0.805640 1.846370 0.649018 0.713232 0.291663 -1.866918 0.486252 0.300849 0.355338 1.356604 0.996671 0.882787 1.511703 1.110696 1.774461 0.441695)
+ 9.074372 #r(0.000000 1.648602 0.113059 0.965847 0.614379 1.876939 0.598065 0.033495 1.128904 0.535962 0.404933 0.340847 -0.287176 1.664997 0.944124 0.484563 1.365390 -0.175780 1.135023 1.030858 0.610885 1.630994 0.348969 1.892603 0.337558 0.278067 1.048537 1.676406 0.392409 0.207975 0.887089 1.313518 1.800663 1.007393 0.181812 -0.074478 0.144619 1.511865 1.173214 0.664191 1.387698 1.632837 0.132108 0.353188 0.227412 1.024174 1.607289 0.662392 -0.023377 -0.428601 1.063517 1.407784 1.563623 0.788150 1.561202 0.023129 0.361493 1.608137 1.816713 0.962416 0.274252 0.900687 0.860331 0.458473 0.118859 0.572111 0.805640 1.846370 0.649018 0.713232 0.291663 -1.866918 0.486252 0.300849 0.355338 1.356604 0.996671 0.882787 1.511703 1.110696 1.774461 0.441695)
;; pp:
- 8.942054 #(0.000000 0.741190 1.211121 1.767480 0.098390 0.839201 1.102556 -0.209453 0.453250 1.122839 0.064920 0.959867 1.388767 0.263801 1.292900 0.219769 1.265994 0.422114 1.103821 -0.093210 0.755477 0.000245 0.969187 1.607339 1.053959 0.313625 1.046034 0.279348 1.465040 0.751688 0.022843 1.470315 0.592990 1.853486 1.118710 0.593243 1.855200 0.862858 0.945784 0.185739 1.601158 1.076300 0.669622 0.291600 1.841348 1.175765 0.663836 0.601642 0.369909 1.837262 -0.023948 1.335189 1.343186 0.755277 0.855544 0.293163 0.518573 0.368668 0.285100 0.386831 1.688397 0.163703 0.172910 0.313842 -0.159903 -0.137818 0.212922 0.539645 0.627827 0.897666 0.865830 1.159886 1.047275 1.360198 1.762925 0.204264 1.078567 0.797293 1.200018 1.357729 0.204458 0.441846)
+ 8.942054 #r(0.000000 0.741190 1.211121 1.767480 0.098390 0.839201 1.102556 -0.209453 0.453250 1.122839 0.064920 0.959867 1.388767 0.263801 1.292900 0.219769 1.265994 0.422114 1.103821 -0.093210 0.755477 0.000245 0.969187 1.607339 1.053959 0.313625 1.046034 0.279348 1.465040 0.751688 0.022843 1.470315 0.592990 1.853486 1.118710 0.593243 1.855200 0.862858 0.945784 0.185739 1.601158 1.076300 0.669622 0.291600 1.841348 1.175765 0.663836 0.601642 0.369909 1.837262 -0.023948 1.335189 1.343186 0.755277 0.855544 0.293163 0.518573 0.368668 0.285100 0.386831 1.688397 0.163703 0.172910 0.313842 -0.159903 -0.137818 0.212922 0.539645 0.627827 0.897666 0.865830 1.159886 1.047275 1.360198 1.762925 0.204264 1.078567 0.797293 1.200018 1.357729 0.204458 0.441846)
;; 81+1
- 8.851350 #(0.000000 0.560616 1.028384 0.602446 0.918314 1.370584 0.032799 1.596301 1.697405 1.496371 0.996676 0.029713 0.420383 0.826586 0.248203 0.575317 1.241662 0.486923 -0.146886 1.026281 0.207970 1.026508 0.554521 1.233144 0.124979 1.629837 1.740416 0.133168 0.934365 -0.707656 0.913598 0.062338 0.910383 1.041029 0.285851 -0.273453 0.668898 0.057418 0.546969 0.703739 0.642923 0.958752 -0.195671 0.682461 -0.471844 0.445399 1.669461 -0.200437 0.550525 0.885547 1.105654 -0.043073 0.307985 0.716590 1.018538 0.595943 0.488507 0.208799 0.077662 0.185943 0.759192 0.106129 0.934593 1.168071 1.038861 0.631960 0.173275 -0.022867 1.092552 -0.449400 0.726450 -0.020524 1.292546 -0.564480 -0.067237 1.491273 1.275468 1.239648 0.821121 -0.291412 -0.449925 0.390998)
- 8.850182 #(0.000000 0.518773 1.039139 0.586918 0.904434 1.417193 0.042683 1.631265 1.694438 1.514894 1.006690 0.003709 0.408784 0.798813 0.249575 0.591222 1.196003 0.490671 -0.162585 1.056459 0.214130 1.070048 0.595570 1.158267 0.152005 1.596646 1.763293 0.137802 1.031270 -0.729765 0.896998 0.017768 0.865646 1.014949 0.251509 -0.314516 0.635325 0.026002 0.490859 0.633543 0.639061 0.944000 -0.171048 0.686904 -0.554012 0.426662 1.660372 -0.276772 0.454353 0.868574 1.080144 0.004571 0.280163 0.786197 1.030805 0.611760 0.535564 0.235350 0.034299 0.186337 0.685227 0.115463 0.933270 1.148318 1.130052 0.634287 0.165289 -0.005574 1.017789 -0.425130 0.702068 -0.051211 1.238786 -0.554979 -0.075667 1.531212 1.295287 1.210341 0.841758 -0.323173 -0.539445 0.363396)
+ 8.851350 #r(0.000000 0.560616 1.028384 0.602446 0.918314 1.370584 0.032799 1.596301 1.697405 1.496371 0.996676 0.029713 0.420383 0.826586 0.248203 0.575317 1.241662 0.486923 -0.146886 1.026281 0.207970 1.026508 0.554521 1.233144 0.124979 1.629837 1.740416 0.133168 0.934365 -0.707656 0.913598 0.062338 0.910383 1.041029 0.285851 -0.273453 0.668898 0.057418 0.546969 0.703739 0.642923 0.958752 -0.195671 0.682461 -0.471844 0.445399 1.669461 -0.200437 0.550525 0.885547 1.105654 -0.043073 0.307985 0.716590 1.018538 0.595943 0.488507 0.208799 0.077662 0.185943 0.759192 0.106129 0.934593 1.168071 1.038861 0.631960 0.173275 -0.022867 1.092552 -0.449400 0.726450 -0.020524 1.292546 -0.564480 -0.067237 1.491273 1.275468 1.239648 0.821121 -0.291412 -0.449925 0.390998)
+ 8.850182 #r(0.000000 0.518773 1.039139 0.586918 0.904434 1.417193 0.042683 1.631265 1.694438 1.514894 1.006690 0.003709 0.408784 0.798813 0.249575 0.591222 1.196003 0.490671 -0.162585 1.056459 0.214130 1.070048 0.595570 1.158267 0.152005 1.596646 1.763293 0.137802 1.031270 -0.729765 0.896998 0.017768 0.865646 1.014949 0.251509 -0.314516 0.635325 0.026002 0.490859 0.633543 0.639061 0.944000 -0.171048 0.686904 -0.554012 0.426662 1.660372 -0.276772 0.454353 0.868574 1.080144 0.004571 0.280163 0.786197 1.030805 0.611760 0.535564 0.235350 0.034299 0.186337 0.685227 0.115463 0.933270 1.148318 1.130052 0.634287 0.165289 -0.005574 1.017789 -0.425130 0.702068 -0.051211 1.238786 -0.554979 -0.075667 1.531212 1.295287 1.210341 0.841758 -0.323173 -0.539445 0.363396)
)
;;; 83 all -------------------------------------------------------------------------------- ; 9.1104
-(vector 83 11.429935034332 #(0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 0)
+(vector 83 11.429935034332 #r(0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 0)
- 8.938600 #(0.000000 0.414028 0.125789 1.159865 0.086238 0.817482 0.340516 1.199339 -0.170286 1.744945 1.587696 1.158800 1.281058 0.190384 1.473320 0.235428 1.621261 0.225261 1.644931 -0.137023 1.525995 0.691219 0.557902 1.528647 -0.234276 -0.009740 0.044217 0.592778 0.909815 0.773874 0.836299 0.726340 0.981312 0.618405 0.408288 0.150201 0.908250 0.109103 0.413166 0.847395 0.541585 1.672450 1.474939 0.635397 0.153870 -0.014899 1.455728 0.983819 0.181154 0.726107 0.638924 1.106663 0.611788 0.238433 0.670956 1.522770 1.842401 0.939513 -0.051810 1.267322 0.323759 1.831419 1.004026 -0.159128 0.287041 0.349723 0.402841 0.045990 0.570998 1.374651 1.603295 0.760887 1.460939 -0.002747 0.693326 1.517648 0.987805 0.554027 0.029827 0.036863 0.188640 0.849464 1.347102)
- 8.936213 #(0.000000 0.408201 0.126040 1.158014 0.083410 0.822392 0.340155 1.194042 -0.172082 1.748578 1.586610 1.161056 1.277534 0.186364 1.476999 0.235823 1.627756 0.227972 1.641505 -0.140011 1.528346 0.692010 0.553694 1.528749 -0.231846 -0.009008 0.040533 0.588403 0.914079 0.778413 0.831073 0.723278 0.978128 0.624349 0.400433 0.146060 0.911725 0.111205 0.414216 0.850529 0.541662 1.663794 1.477328 0.641317 0.149613 -0.013692 1.454096 0.985241 0.185917 0.730787 0.637733 1.097840 0.604584 0.240638 0.678667 1.522252 1.845745 0.944051 -0.047786 1.256053 0.323123 1.836166 1.002122 -0.154558 0.287277 0.348279 0.400131 0.048348 0.573133 1.378950 1.603761 0.771384 1.465373 0.014397 0.693518 1.523180 0.987688 0.553385 0.023434 0.030358 0.189016 0.850384 1.349789)
- 8.934963 #(0.000000 0.388833 0.119269 1.159396 0.084041 0.831926 0.332635 1.176250 -0.176695 1.764815 1.577336 1.167712 1.277058 0.180565 1.483279 0.244455 1.639842 0.231019 1.628465 -0.143232 1.536821 0.704938 0.552153 1.530466 -0.224513 0.010496 0.034106 0.576377 0.939875 0.785468 0.829993 0.715502 0.968124 0.640032 0.396582 0.150458 0.935168 0.123648 0.408167 0.864017 0.545634 1.640474 1.473610 0.636166 0.133436 -0.003429 1.440429 0.982288 0.212836 0.743361 0.639874 1.101557 0.617385 0.271411 0.703361 1.525115 1.857795 0.954785 -0.022712 1.232732 0.327660 1.853705 1.028391 -0.134471 0.306948 0.357972 0.408006 0.063155 0.593195 1.406229 1.598252 0.790489 1.494874 0.055118 0.707198 1.527620 0.974145 0.561751 0.009624 0.051221 0.195975 0.865753 1.371065)
+ 8.938600 #r(0.000000 0.414028 0.125789 1.159865 0.086238 0.817482 0.340516 1.199339 -0.170286 1.744945 1.587696 1.158800 1.281058 0.190384 1.473320 0.235428 1.621261 0.225261 1.644931 -0.137023 1.525995 0.691219 0.557902 1.528647 -0.234276 -0.009740 0.044217 0.592778 0.909815 0.773874 0.836299 0.726340 0.981312 0.618405 0.408288 0.150201 0.908250 0.109103 0.413166 0.847395 0.541585 1.672450 1.474939 0.635397 0.153870 -0.014899 1.455728 0.983819 0.181154 0.726107 0.638924 1.106663 0.611788 0.238433 0.670956 1.522770 1.842401 0.939513 -0.051810 1.267322 0.323759 1.831419 1.004026 -0.159128 0.287041 0.349723 0.402841 0.045990 0.570998 1.374651 1.603295 0.760887 1.460939 -0.002747 0.693326 1.517648 0.987805 0.554027 0.029827 0.036863 0.188640 0.849464 1.347102)
+ 8.936213 #r(0.000000 0.408201 0.126040 1.158014 0.083410 0.822392 0.340155 1.194042 -0.172082 1.748578 1.586610 1.161056 1.277534 0.186364 1.476999 0.235823 1.627756 0.227972 1.641505 -0.140011 1.528346 0.692010 0.553694 1.528749 -0.231846 -0.009008 0.040533 0.588403 0.914079 0.778413 0.831073 0.723278 0.978128 0.624349 0.400433 0.146060 0.911725 0.111205 0.414216 0.850529 0.541662 1.663794 1.477328 0.641317 0.149613 -0.013692 1.454096 0.985241 0.185917 0.730787 0.637733 1.097840 0.604584 0.240638 0.678667 1.522252 1.845745 0.944051 -0.047786 1.256053 0.323123 1.836166 1.002122 -0.154558 0.287277 0.348279 0.400131 0.048348 0.573133 1.378950 1.603761 0.771384 1.465373 0.014397 0.693518 1.523180 0.987688 0.553385 0.023434 0.030358 0.189016 0.850384 1.349789)
+ 8.934963 #r(0.000000 0.388833 0.119269 1.159396 0.084041 0.831926 0.332635 1.176250 -0.176695 1.764815 1.577336 1.167712 1.277058 0.180565 1.483279 0.244455 1.639842 0.231019 1.628465 -0.143232 1.536821 0.704938 0.552153 1.530466 -0.224513 0.010496 0.034106 0.576377 0.939875 0.785468 0.829993 0.715502 0.968124 0.640032 0.396582 0.150458 0.935168 0.123648 0.408167 0.864017 0.545634 1.640474 1.473610 0.636166 0.133436 -0.003429 1.440429 0.982288 0.212836 0.743361 0.639874 1.101557 0.617385 0.271411 0.703361 1.525115 1.857795 0.954785 -0.022712 1.232732 0.327660 1.853705 1.028391 -0.134471 0.306948 0.357972 0.408006 0.063155 0.593195 1.406229 1.598252 0.790489 1.494874 0.055118 0.707198 1.527620 0.974145 0.561751 0.009624 0.051221 0.195975 0.865753 1.371065)
)
;;; 84 all -------------------------------------------------------------------------------- ; 9.1652
-(vector 84 11.774056434631 #(0 1 1 1 0 0 1 0 1 1 0 1 0 1 0 0 0 1 1 1 1 0 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1)
+(vector 84 11.774056434631 #r(0 1 1 1 0 0 1 0 1 1 0 1 0 1 0 0 0 1 1 1 1 0 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1)
- 9.023210 #(0.000000 0.159304 -0.208530 0.193874 1.193993 0.513874 0.193906 1.420202 1.601162 0.069662 0.596870 0.499106 1.879705 1.298791 1.380896 1.011752 1.567079 1.088823 0.586749 1.189212 0.187019 0.623891 0.443258 1.756821 0.221910 -0.166048 1.505325 1.956699 0.145006 0.858253 1.259810 1.292214 -0.292005 0.449812 -0.218977 -0.354252 1.219999 0.997645 1.646540 1.482430 0.239288 -0.155628 0.755326 1.705293 0.967714 0.360450 0.143064 1.152089 0.481087 0.972815 0.614833 1.330922 0.788019 0.726428 0.572863 1.454284 1.031818 0.764416 0.692179 1.019395 0.005944 0.083543 1.745841 0.713648 0.857380 1.260681 1.338561 0.608841 1.025699 1.518383 0.107569 1.492751 -0.040716 0.923284 0.288212 0.772164 -0.210851 0.728511 0.794985 1.593926 1.082153 1.208449 1.606070 0.581831)
+ 9.023210 #r(0.000000 0.159304 -0.208530 0.193874 1.193993 0.513874 0.193906 1.420202 1.601162 0.069662 0.596870 0.499106 1.879705 1.298791 1.380896 1.011752 1.567079 1.088823 0.586749 1.189212 0.187019 0.623891 0.443258 1.756821 0.221910 -0.166048 1.505325 1.956699 0.145006 0.858253 1.259810 1.292214 -0.292005 0.449812 -0.218977 -0.354252 1.219999 0.997645 1.646540 1.482430 0.239288 -0.155628 0.755326 1.705293 0.967714 0.360450 0.143064 1.152089 0.481087 0.972815 0.614833 1.330922 0.788019 0.726428 0.572863 1.454284 1.031818 0.764416 0.692179 1.019395 0.005944 0.083543 1.745841 0.713648 0.857380 1.260681 1.338561 0.608841 1.025699 1.518383 0.107569 1.492751 -0.040716 0.923284 0.288212 0.772164 -0.210851 0.728511 0.794985 1.593926 1.082153 1.208449 1.606070 0.581831)
)
;;; 85 all -------------------------------------------------------------------------------- ; 9.2195
-(vector 85 11.927130699158 #(0 0 0 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 1 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 1 0 1 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 1 1 1 0 1)
+(vector 85 11.927130699158 #r(0 0 0 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 1 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 1 0 1 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 1 1 1 0 1)
- 9.127702 #(0.000000 0.377539 0.047529 1.429700 0.417181 1.140688 0.738197 -0.138709 -0.448043 0.627123 1.392127 1.819604 0.611302 1.321770 0.758910 1.628764 1.577483 0.372253 0.761090 0.479480 0.236979 1.110344 0.805106 1.644437 0.008357 0.656171 0.991297 -0.054354 1.739257 1.797129 1.125137 0.066677 1.422676 0.455091 0.389601 0.812550 0.569451 1.358336 1.535806 0.395945 0.917012 1.261389 0.975555 0.676523 1.340562 0.262979 0.348691 0.300647 1.560755 0.036844 0.912709 1.718241 0.914499 1.035722 0.712055 1.556119 1.328161 1.240892 0.216373 0.897089 0.626805 0.862584 0.585791 1.306757 0.828290 1.426360 0.918009 1.215542 0.443071 1.531104 1.274055 0.636447 0.998872 0.647434 1.352131 -0.267987 0.709420 0.317461 -0.001614 0.037126 -0.160098 1.679742 0.637515 0.582751 0.080874)
+ 9.127702 #r(0.000000 0.377539 0.047529 1.429700 0.417181 1.140688 0.738197 -0.138709 -0.448043 0.627123 1.392127 1.819604 0.611302 1.321770 0.758910 1.628764 1.577483 0.372253 0.761090 0.479480 0.236979 1.110344 0.805106 1.644437 0.008357 0.656171 0.991297 -0.054354 1.739257 1.797129 1.125137 0.066677 1.422676 0.455091 0.389601 0.812550 0.569451 1.358336 1.535806 0.395945 0.917012 1.261389 0.975555 0.676523 1.340562 0.262979 0.348691 0.300647 1.560755 0.036844 0.912709 1.718241 0.914499 1.035722 0.712055 1.556119 1.328161 1.240892 0.216373 0.897089 0.626805 0.862584 0.585791 1.306757 0.828290 1.426360 0.918009 1.215542 0.443071 1.531104 1.274055 0.636447 0.998872 0.647434 1.352131 -0.267987 0.709420 0.317461 -0.001614 0.037126 -0.160098 1.679742 0.637515 0.582751 0.080874)
;; 84+1
- 9.178091 #(0.000000 0.092570 -0.328688 0.101879 1.164231 0.484791 0.263025 1.451681 1.371169 0.108316 0.583377 0.421708 0.063889 1.308369 1.554699 0.834440 1.382249 1.018775 0.556330 1.227389 0.358177 0.557221 0.316807 0.026851 0.347091 -0.193100 1.503856 1.682820 0.057602 0.906412 1.391283 1.172258 -0.306686 0.435069 -0.568978 -0.558083 1.240277 0.880388 1.809028 1.648747 0.142044 -0.051135 0.843030 1.589081 1.068210 0.522719 0.218341 1.007282 0.577304 0.998448 0.637448 1.458645 0.805087 0.732402 0.662530 1.436936 1.230072 0.780536 0.678657 1.336068 0.047814 0.297831 1.418569 0.786054 0.797109 1.410904 1.430707 0.466713 0.866817 1.332398 -0.186495 1.178146 -0.048740 1.088830 0.300282 0.620896 -0.201097 0.818687 0.773330 1.535207 1.274976 1.303891 1.667213 0.674931 -0.125079)
+ 9.178091 #r(0.000000 0.092570 -0.328688 0.101879 1.164231 0.484791 0.263025 1.451681 1.371169 0.108316 0.583377 0.421708 0.063889 1.308369 1.554699 0.834440 1.382249 1.018775 0.556330 1.227389 0.358177 0.557221 0.316807 0.026851 0.347091 -0.193100 1.503856 1.682820 0.057602 0.906412 1.391283 1.172258 -0.306686 0.435069 -0.568978 -0.558083 1.240277 0.880388 1.809028 1.648747 0.142044 -0.051135 0.843030 1.589081 1.068210 0.522719 0.218341 1.007282 0.577304 0.998448 0.637448 1.458645 0.805087 0.732402 0.662530 1.436936 1.230072 0.780536 0.678657 1.336068 0.047814 0.297831 1.418569 0.786054 0.797109 1.410904 1.430707 0.466713 0.866817 1.332398 -0.186495 1.178146 -0.048740 1.088830 0.300282 0.620896 -0.201097 0.818687 0.773330 1.535207 1.274976 1.303891 1.667213 0.674931 -0.125079)
;; 86-1
- 9.051726 #(0.000000 0.572406 1.179943 1.764356 0.253870 0.884356 1.651423 -0.098959 0.541959 1.442287 0.010669 0.741083 1.566729 0.635556 1.249696 -0.254695 0.981029 0.111846 1.237031 0.192536 0.720833 1.204618 0.449694 1.251669 0.627009 1.783356 0.920605 0.035741 0.509227 0.126246 1.562523 0.722635 -0.062975 0.946054 0.007605 -0.013358 1.547325 0.495733 1.888355 1.370030 0.430619 1.521378 1.364477 0.899348 0.311412 1.655627 1.393415 1.043374 0.693073 -0.261616 1.347717 1.190412 0.844199 0.765353 0.699908 0.229316 0.525856 -0.265344 1.545983 1.312840 1.172844 1.057530 0.916299 1.790793 0.869579 1.211374 0.681340 1.001931 0.654601 1.101973 1.110746 1.767977 1.334109 1.636297 -0.247626 -0.168731 0.099708 0.647019 1.050047 1.539415 0.008050 0.095956 0.583789 1.020757 1.124846)
- 9.049902 #(0.000000 0.563123 1.178518 1.758860 0.262272 0.883025 1.653154 -0.112442 0.544375 1.449563 0.003632 0.735232 1.565378 0.629399 1.249832 -0.245154 0.975371 0.104021 1.230308 0.204936 0.728896 1.200090 0.453859 1.254730 0.634907 1.785857 0.910526 0.028528 0.512985 0.118173 1.563688 0.727580 -0.060681 0.935698 0.002572 -0.009819 1.543537 0.502740 1.889883 1.378460 0.440088 1.520721 1.385983 0.911951 0.319540 1.661394 1.403090 1.043647 0.698513 -0.258428 1.361759 1.190670 0.827100 0.772203 0.674858 0.223364 0.526333 -0.284078 1.542639 1.309275 1.167224 1.067830 0.912739 1.795861 0.867588 1.204585 0.683869 0.992895 0.650909 1.108031 1.113927 1.766016 1.326795 1.627701 -0.242386 -0.176337 0.105000 0.657052 1.065424 1.542526 0.021830 0.089779 0.582222 1.031000 1.120243)
+ 9.051726 #r(0.000000 0.572406 1.179943 1.764356 0.253870 0.884356 1.651423 -0.098959 0.541959 1.442287 0.010669 0.741083 1.566729 0.635556 1.249696 -0.254695 0.981029 0.111846 1.237031 0.192536 0.720833 1.204618 0.449694 1.251669 0.627009 1.783356 0.920605 0.035741 0.509227 0.126246 1.562523 0.722635 -0.062975 0.946054 0.007605 -0.013358 1.547325 0.495733 1.888355 1.370030 0.430619 1.521378 1.364477 0.899348 0.311412 1.655627 1.393415 1.043374 0.693073 -0.261616 1.347717 1.190412 0.844199 0.765353 0.699908 0.229316 0.525856 -0.265344 1.545983 1.312840 1.172844 1.057530 0.916299 1.790793 0.869579 1.211374 0.681340 1.001931 0.654601 1.101973 1.110746 1.767977 1.334109 1.636297 -0.247626 -0.168731 0.099708 0.647019 1.050047 1.539415 0.008050 0.095956 0.583789 1.020757 1.124846)
+ 9.049902 #r(0.000000 0.563123 1.178518 1.758860 0.262272 0.883025 1.653154 -0.112442 0.544375 1.449563 0.003632 0.735232 1.565378 0.629399 1.249832 -0.245154 0.975371 0.104021 1.230308 0.204936 0.728896 1.200090 0.453859 1.254730 0.634907 1.785857 0.910526 0.028528 0.512985 0.118173 1.563688 0.727580 -0.060681 0.935698 0.002572 -0.009819 1.543537 0.502740 1.889883 1.378460 0.440088 1.520721 1.385983 0.911951 0.319540 1.661394 1.403090 1.043647 0.698513 -0.258428 1.361759 1.190670 0.827100 0.772203 0.674858 0.223364 0.526333 -0.284078 1.542639 1.309275 1.167224 1.067830 0.912739 1.795861 0.867588 1.204585 0.683869 0.992895 0.650909 1.108031 1.113927 1.766016 1.326795 1.627701 -0.242386 -0.176337 0.105000 0.657052 1.065424 1.542526 0.021830 0.089779 0.582222 1.031000 1.120243)
)
;;; 86 all -------------------------------------------------------------------------------- ; 9.27362
-(vector 86 11.780031204224 #(0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 1 0 0 1 0 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0)
+(vector 86 11.780031204224 #r(0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 1 0 0 1 0 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0)
- 9.206953 #(0.000000 -0.339088 0.933342 -0.128298 1.099279 0.084536 0.851599 -0.014992 1.465425 1.307317 0.418122 0.289943 1.668778 0.506500 1.696171 1.171193 0.792416 0.989400 0.972892 1.055909 1.790099 1.474165 1.862965 1.486120 1.916599 0.452792 1.686062 0.595804 0.951171 -0.158372 0.842834 1.045604 0.896962 0.721188 0.145646 1.627929 1.192540 1.524829 0.808536 1.173303 0.835497 0.870602 1.525244 1.506688 0.379810 0.397104 0.800652 0.803279 1.193873 1.751911 0.273257 0.582749 0.328287 1.542626 0.758388 0.690207 1.020504 0.688526 -0.031652 0.949811 0.197494 0.391786 1.605605 0.223632 0.906957 1.312801 1.428402 0.597149 1.497710 -0.659689 1.704635 0.962819 1.427359 1.450510 1.282944 1.167035 0.635413 0.328489 1.735204 0.771081 1.542497 0.207128 0.104268 1.136822 -0.363620 0.034704)
+ 9.206953 #r(0.000000 -0.339088 0.933342 -0.128298 1.099279 0.084536 0.851599 -0.014992 1.465425 1.307317 0.418122 0.289943 1.668778 0.506500 1.696171 1.171193 0.792416 0.989400 0.972892 1.055909 1.790099 1.474165 1.862965 1.486120 1.916599 0.452792 1.686062 0.595804 0.951171 -0.158372 0.842834 1.045604 0.896962 0.721188 0.145646 1.627929 1.192540 1.524829 0.808536 1.173303 0.835497 0.870602 1.525244 1.506688 0.379810 0.397104 0.800652 0.803279 1.193873 1.751911 0.273257 0.582749 0.328287 1.542626 0.758388 0.690207 1.020504 0.688526 -0.031652 0.949811 0.197494 0.391786 1.605605 0.223632 0.906957 1.312801 1.428402 0.597149 1.497710 -0.659689 1.704635 0.962819 1.427359 1.450510 1.282944 1.167035 0.635413 0.328489 1.735204 0.771081 1.542497 0.207128 0.104268 1.136822 -0.363620 0.034704)
;; 87-1
- 9.145844 #(0.000000 0.566683 1.107648 1.906025 0.221947 0.832929 1.646883 0.003598 0.594983 1.443215 0.059329 0.776514 1.650354 0.526476 1.163785 -0.073477 1.002422 -0.002389 1.070033 0.044031 0.784449 1.327277 0.487633 1.314288 0.580998 1.768047 0.897468 -0.079923 0.817793 0.129615 1.548420 0.755157 0.047436 0.933698 0.072836 1.838297 1.394453 0.409694 1.883124 1.411951 0.367286 1.559580 1.347795 0.901907 0.261118 1.614248 1.386396 1.030092 0.495139 -0.244679 1.429057 1.095949 0.954289 0.796818 0.700395 0.130060 0.311501 -0.283703 1.698927 1.200401 1.111917 0.896911 0.863583 1.501476 0.795659 1.065652 0.706914 0.954080 0.738520 1.047306 1.097502 1.582249 1.456216 1.733897 -0.138892 -0.037173 0.099865 0.586472 1.000632 1.405077 0.060430 -0.004754 0.633209 1.032431 1.436909 1.788117)
- 9.144898 #(0.000000 0.553220 1.114143 1.907542 0.232990 0.842372 1.638290 0.002415 0.600151 1.441766 0.072607 0.770701 1.630141 0.524050 1.166300 -0.060704 0.988063 -0.011935 1.056235 0.044313 0.796954 1.351344 0.491264 1.317927 0.594365 1.770310 0.908994 -0.083046 0.803658 0.111996 1.532402 0.759402 0.036170 0.943179 0.079272 1.830583 1.382504 0.397346 1.856130 1.407405 0.379257 1.552501 1.336822 0.894256 0.259512 1.640642 1.404950 1.043723 0.498578 -0.255562 1.439871 1.113214 0.957074 0.794912 0.690668 0.138597 0.312164 -0.286212 1.710429 1.181779 1.119942 0.882351 0.853742 1.507047 0.801407 1.064423 0.722928 0.946894 0.773817 1.034859 1.074112 1.587958 1.477366 1.754829 -0.141780 -0.019862 0.118652 0.596035 1.023862 1.396961 0.052731 -0.006814 0.649298 1.055665 1.431062 1.786776)
+ 9.145844 #r(0.000000 0.566683 1.107648 1.906025 0.221947 0.832929 1.646883 0.003598 0.594983 1.443215 0.059329 0.776514 1.650354 0.526476 1.163785 -0.073477 1.002422 -0.002389 1.070033 0.044031 0.784449 1.327277 0.487633 1.314288 0.580998 1.768047 0.897468 -0.079923 0.817793 0.129615 1.548420 0.755157 0.047436 0.933698 0.072836 1.838297 1.394453 0.409694 1.883124 1.411951 0.367286 1.559580 1.347795 0.901907 0.261118 1.614248 1.386396 1.030092 0.495139 -0.244679 1.429057 1.095949 0.954289 0.796818 0.700395 0.130060 0.311501 -0.283703 1.698927 1.200401 1.111917 0.896911 0.863583 1.501476 0.795659 1.065652 0.706914 0.954080 0.738520 1.047306 1.097502 1.582249 1.456216 1.733897 -0.138892 -0.037173 0.099865 0.586472 1.000632 1.405077 0.060430 -0.004754 0.633209 1.032431 1.436909 1.788117)
+ 9.144898 #r(0.000000 0.553220 1.114143 1.907542 0.232990 0.842372 1.638290 0.002415 0.600151 1.441766 0.072607 0.770701 1.630141 0.524050 1.166300 -0.060704 0.988063 -0.011935 1.056235 0.044313 0.796954 1.351344 0.491264 1.317927 0.594365 1.770310 0.908994 -0.083046 0.803658 0.111996 1.532402 0.759402 0.036170 0.943179 0.079272 1.830583 1.382504 0.397346 1.856130 1.407405 0.379257 1.552501 1.336822 0.894256 0.259512 1.640642 1.404950 1.043723 0.498578 -0.255562 1.439871 1.113214 0.957074 0.794912 0.690668 0.138597 0.312164 -0.286212 1.710429 1.181779 1.119942 0.882351 0.853742 1.507047 0.801407 1.064423 0.722928 0.946894 0.773817 1.034859 1.074112 1.587958 1.477366 1.754829 -0.141780 -0.019862 0.118652 0.596035 1.023862 1.396961 0.052731 -0.006814 0.649298 1.055665 1.431062 1.786776)
)
;;; 87 all -------------------------------------------------------------------------------- ; 9.3274
-(vector 87 11.76194265333 #(0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1)
+(vector 87 11.76194265333 #r(0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1)
- 9.336088 #(0.000000 0.935303 -0.305855 0.639666 -0.205066 0.575166 1.878633 -0.031633 0.332111 0.265245 0.447761 1.471005 0.466239 1.074654 0.243517 0.903095 0.071080 0.582837 0.986978 1.432105 0.143848 1.529993 0.888064 0.154620 1.746534 1.298224 1.092204 0.252914 1.241973 -0.114644 0.118634 1.005127 -0.195946 0.639640 0.754289 -0.065632 0.714364 1.300342 0.839106 1.256746 0.582262 1.885531 1.298010 0.384388 0.185574 1.168220 1.586291 1.242180 1.296083 0.391273 0.262871 0.811036 0.806565 0.431451 1.015342 1.630813 1.685662 -0.062763 0.311437 -0.322103 1.934808 -0.217239 0.478902 -0.218460 1.046362 0.603169 1.523851 1.302931 0.360083 0.678610 0.838126 1.626723 0.408089 0.150785 0.439104 0.575446 0.524826 1.662738 0.111387 1.179455 0.712858 0.531389 0.286195 0.456407 0.251572 1.398780 1.753711)
+ 9.336088 #r(0.000000 0.935303 -0.305855 0.639666 -0.205066 0.575166 1.878633 -0.031633 0.332111 0.265245 0.447761 1.471005 0.466239 1.074654 0.243517 0.903095 0.071080 0.582837 0.986978 1.432105 0.143848 1.529993 0.888064 0.154620 1.746534 1.298224 1.092204 0.252914 1.241973 -0.114644 0.118634 1.005127 -0.195946 0.639640 0.754289 -0.065632 0.714364 1.300342 0.839106 1.256746 0.582262 1.885531 1.298010 0.384388 0.185574 1.168220 1.586291 1.242180 1.296083 0.391273 0.262871 0.811036 0.806565 0.431451 1.015342 1.630813 1.685662 -0.062763 0.311437 -0.322103 1.934808 -0.217239 0.478902 -0.218460 1.046362 0.603169 1.523851 1.302931 0.360083 0.678610 0.838126 1.626723 0.408089 0.150785 0.439104 0.575446 0.524826 1.662738 0.111387 1.179455 0.712858 0.531389 0.286195 0.456407 0.251572 1.398780 1.753711)
;; pp:start point was (pp.scm, make-pp.scm): pi+pi/87 and -pi/2
- 9.188521 #(0.000000 0.577038 1.207261 1.628557 0.262146 0.801237 1.556050 0.056439 0.667335 1.368629 -0.005675 0.749653 1.604613 0.459413 1.321111 -0.031172 1.051217 -0.021196 1.026933 1.909174 0.730842 1.464699 0.478663 1.424779 0.531386 1.829514 1.099308 0.030309 1.091452 0.183625 1.427990 0.713707 0.072882 0.988307 0.050871 1.569876 1.182625 0.368506 1.869531 1.283013 0.367839 1.495424 1.258194 0.820412 0.120239 1.561194 1.309622 0.929536 0.337985 -0.260353 1.473059 1.175804 1.110077 0.673201 0.814863 -0.004594 0.327741 -0.246652 1.781940 1.248926 1.174864 1.075991 0.895836 1.403691 0.903960 0.895504 0.766042 1.020851 0.881318 1.007885 1.155350 1.590758 1.540581 1.812457 0.004350 -0.049652 0.077880 0.408393 0.883302 1.419937 1.752252 -0.010350 0.469666 0.737948 1.471230 1.731975 -0.094827)
- 9.187891 #(0.000000 0.562265 1.215132 1.639989 0.268408 0.803228 1.556396 0.052662 0.673897 1.370427 -0.013341 0.755625 1.613682 0.464097 1.303388 -0.037077 1.034992 -0.022117 1.014610 1.893157 0.718728 1.483506 0.494314 1.442488 0.545375 1.834445 1.096157 0.044881 1.127012 0.215102 1.425993 0.718653 0.082596 0.974151 0.052799 1.587090 1.187190 0.360476 1.852622 1.250947 0.372936 1.523300 1.264181 0.805702 0.081155 1.558372 1.276806 0.921107 0.347174 -0.241287 1.479655 1.180393 1.125004 0.659710 0.822627 -0.001295 0.310451 -0.262271 1.777140 1.247104 1.177750 1.114372 0.920013 1.374146 0.894221 0.877518 0.741864 1.020196 0.885904 1.001071 1.161793 1.551252 1.536508 1.802169 0.022015 -0.071435 0.050557 0.417817 0.866824 1.426867 1.751719 0.013618 0.498761 0.731015 1.470154 1.720066 -0.074032)
+ 9.188521 #r(0.000000 0.577038 1.207261 1.628557 0.262146 0.801237 1.556050 0.056439 0.667335 1.368629 -0.005675 0.749653 1.604613 0.459413 1.321111 -0.031172 1.051217 -0.021196 1.026933 1.909174 0.730842 1.464699 0.478663 1.424779 0.531386 1.829514 1.099308 0.030309 1.091452 0.183625 1.427990 0.713707 0.072882 0.988307 0.050871 1.569876 1.182625 0.368506 1.869531 1.283013 0.367839 1.495424 1.258194 0.820412 0.120239 1.561194 1.309622 0.929536 0.337985 -0.260353 1.473059 1.175804 1.110077 0.673201 0.814863 -0.004594 0.327741 -0.246652 1.781940 1.248926 1.174864 1.075991 0.895836 1.403691 0.903960 0.895504 0.766042 1.020851 0.881318 1.007885 1.155350 1.590758 1.540581 1.812457 0.004350 -0.049652 0.077880 0.408393 0.883302 1.419937 1.752252 -0.010350 0.469666 0.737948 1.471230 1.731975 -0.094827)
+ 9.187891 #r(0.000000 0.562265 1.215132 1.639989 0.268408 0.803228 1.556396 0.052662 0.673897 1.370427 -0.013341 0.755625 1.613682 0.464097 1.303388 -0.037077 1.034992 -0.022117 1.014610 1.893157 0.718728 1.483506 0.494314 1.442488 0.545375 1.834445 1.096157 0.044881 1.127012 0.215102 1.425993 0.718653 0.082596 0.974151 0.052799 1.587090 1.187190 0.360476 1.852622 1.250947 0.372936 1.523300 1.264181 0.805702 0.081155 1.558372 1.276806 0.921107 0.347174 -0.241287 1.479655 1.180393 1.125004 0.659710 0.822627 -0.001295 0.310451 -0.262271 1.777140 1.247104 1.177750 1.114372 0.920013 1.374146 0.894221 0.877518 0.741864 1.020196 0.885904 1.001071 1.161793 1.551252 1.536508 1.802169 0.022015 -0.071435 0.050557 0.417817 0.866824 1.426867 1.751719 0.013618 0.498761 0.731015 1.470154 1.720066 -0.074032)
)
;;; 88 all -------------------------------------------------------------------------------- ; 9.3808
-(vector 88 11.638312339783 #(0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 0 1 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 1)
+(vector 88 11.638312339783 #r(0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 0 1 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 1)
- 9.316523 #(0.000000 0.878486 0.456733 1.616494 0.833842 1.630288 0.213084 0.318066 0.387075 1.258199 0.888074 1.626323 1.385324 1.449641 1.788877 1.459694 0.074476 0.796586 0.333918 0.652336 0.086019 1.093159 0.327760 0.026729 0.468210 0.200167 0.537074 1.539924 -0.274885 1.353211 0.267108 0.236471 1.407050 0.990605 0.724714 0.464124 0.495860 1.314621 -0.030616 0.350065 0.839694 0.794947 -0.082046 0.540462 1.600245 0.715450 0.591095 1.608103 0.808561 1.476715 1.175725 0.089220 0.447550 -0.172825 1.173712 -0.287102 0.416439 1.195370 1.285929 1.007325 0.957271 -0.013128 1.194681 1.765216 1.741310 1.202198 1.235154 1.112410 1.116838 1.017962 0.227564 0.013993 0.930616 0.757675 -0.297628 0.560900 0.173387 0.493968 1.241443 0.533916 1.114281 1.119507 0.538020 0.529723 1.672789 1.594826 0.538626 1.278733)
+ 9.316523 #r(0.000000 0.878486 0.456733 1.616494 0.833842 1.630288 0.213084 0.318066 0.387075 1.258199 0.888074 1.626323 1.385324 1.449641 1.788877 1.459694 0.074476 0.796586 0.333918 0.652336 0.086019 1.093159 0.327760 0.026729 0.468210 0.200167 0.537074 1.539924 -0.274885 1.353211 0.267108 0.236471 1.407050 0.990605 0.724714 0.464124 0.495860 1.314621 -0.030616 0.350065 0.839694 0.794947 -0.082046 0.540462 1.600245 0.715450 0.591095 1.608103 0.808561 1.476715 1.175725 0.089220 0.447550 -0.172825 1.173712 -0.287102 0.416439 1.195370 1.285929 1.007325 0.957271 -0.013128 1.194681 1.765216 1.741310 1.202198 1.235154 1.112410 1.116838 1.017962 0.227564 0.013993 0.930616 0.757675 -0.297628 0.560900 0.173387 0.493968 1.241443 0.533916 1.114281 1.119507 0.538020 0.529723 1.672789 1.594826 0.538626 1.278733)
;; 87 + 1 (pp)
- 9.244078 #(0.000000 0.694018 1.165822 1.676512 0.096734 0.820300 1.468057 0.088341 0.655120 1.291453 -0.067834 0.750649 1.606715 0.366794 1.199710 0.067953 1.171063 0.125791 1.077914 1.904683 0.572953 1.438964 0.387785 1.361027 0.470626 1.798354 1.025608 -0.183300 0.935453 0.193835 1.423867 0.670497 0.056060 1.040746 0.102123 1.502090 1.195959 0.413063 1.791619 1.270627 0.359281 1.413426 1.078876 0.807816 0.227637 1.617604 1.316579 0.989646 0.288255 -0.228378 1.516380 1.207792 1.225064 0.737215 0.935014 0.031773 0.170020 -0.334787 1.865610 1.331909 1.164836 0.934833 0.925908 1.288654 0.798848 1.076323 0.722509 1.032823 0.879278 0.906937 0.934088 1.637290 1.478240 1.745733 -0.031866 -0.004141 0.054848 0.181925 0.776139 1.296456 1.577696 1.832552 0.546057 0.624987 1.395395 1.680089 -0.150964 0.305296)
- 9.243448 #(0.000000 0.697851 1.166665 1.665599 0.098169 0.813468 1.475112 0.101377 0.652595 1.273039 -0.081569 0.745524 1.591625 0.353099 1.188181 0.067828 1.161595 0.152496 1.082314 1.900802 0.588773 1.446857 0.379192 1.369274 0.475586 1.801340 1.037627 -0.178925 0.939324 0.188566 1.443075 0.665312 0.046982 1.052243 0.101080 1.498797 1.207289 0.409569 1.784327 1.271339 0.376759 1.422106 1.059422 0.802437 0.209481 1.613077 1.299497 0.983704 0.306573 -0.235197 1.532651 1.198072 1.226923 0.712611 0.934064 0.028480 0.165446 -0.347088 1.856068 1.322916 1.165417 0.930692 0.903535 1.267764 0.795402 1.061438 0.706954 1.032722 0.865689 0.907087 0.916387 1.610361 1.471937 1.742343 -0.052496 -0.040631 0.057803 0.155675 0.765103 1.291462 1.566099 1.820302 0.538939 0.627227 1.392483 1.674330 -0.144452 0.267627)
+ 9.244078 #r(0.000000 0.694018 1.165822 1.676512 0.096734 0.820300 1.468057 0.088341 0.655120 1.291453 -0.067834 0.750649 1.606715 0.366794 1.199710 0.067953 1.171063 0.125791 1.077914 1.904683 0.572953 1.438964 0.387785 1.361027 0.470626 1.798354 1.025608 -0.183300 0.935453 0.193835 1.423867 0.670497 0.056060 1.040746 0.102123 1.502090 1.195959 0.413063 1.791619 1.270627 0.359281 1.413426 1.078876 0.807816 0.227637 1.617604 1.316579 0.989646 0.288255 -0.228378 1.516380 1.207792 1.225064 0.737215 0.935014 0.031773 0.170020 -0.334787 1.865610 1.331909 1.164836 0.934833 0.925908 1.288654 0.798848 1.076323 0.722509 1.032823 0.879278 0.906937 0.934088 1.637290 1.478240 1.745733 -0.031866 -0.004141 0.054848 0.181925 0.776139 1.296456 1.577696 1.832552 0.546057 0.624987 1.395395 1.680089 -0.150964 0.305296)
+ 9.243448 #r(0.000000 0.697851 1.166665 1.665599 0.098169 0.813468 1.475112 0.101377 0.652595 1.273039 -0.081569 0.745524 1.591625 0.353099 1.188181 0.067828 1.161595 0.152496 1.082314 1.900802 0.588773 1.446857 0.379192 1.369274 0.475586 1.801340 1.037627 -0.178925 0.939324 0.188566 1.443075 0.665312 0.046982 1.052243 0.101080 1.498797 1.207289 0.409569 1.784327 1.271339 0.376759 1.422106 1.059422 0.802437 0.209481 1.613077 1.299497 0.983704 0.306573 -0.235197 1.532651 1.198072 1.226923 0.712611 0.934064 0.028480 0.165446 -0.347088 1.856068 1.322916 1.165417 0.930692 0.903535 1.267764 0.795402 1.061438 0.706954 1.032722 0.865689 0.907087 0.916387 1.610361 1.471937 1.742343 -0.052496 -0.040631 0.057803 0.155675 0.765103 1.291462 1.566099 1.820302 0.538939 0.627227 1.392483 1.674330 -0.144452 0.267627)
)
;;; 89 all -------------------------------------------------------------------------------- ; 9.4340
-(vector 89 12.148494905477 #(0 0 0 0 0 1 1 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 0 1 1 1 1 1 1 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 0 0 0 0 1)
+(vector 89 12.148494905477 #r(0 0 0 0 0 1 1 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 0 1 1 1 1 1 1 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 0 0 0 0 1)
- 9.351480 #(0.000000 0.115345 0.952969 1.130622 0.084058 0.254252 0.443202 0.470071 0.932794 0.466331 0.591979 0.457396 1.528107 0.715257 1.847307 0.403253 0.673874 1.456603 0.267262 0.304798 0.064020 -0.007350 0.259234 -0.287472 0.913317 0.595047 1.491194 0.951199 1.469407 0.524123 -0.304693 -0.076445 1.827209 1.059199 1.449793 1.495662 0.754984 0.852314 0.216817 0.724819 0.597427 1.273980 0.926620 0.643916 0.066061 0.625597 1.284699 0.657854 0.605911 1.653365 1.442076 1.033587 -0.542590 1.262635 1.257414 1.117301 0.126208 0.112501 1.272548 0.912632 0.005045 0.757226 0.049364 -0.033316 1.800311 -0.300949 0.310947 1.267820 0.529700 0.817110 -0.265053 1.152779 -0.048439 0.296709 1.270792 1.398568 -1.703554 0.050635 0.940556 0.440806 1.384526 0.885947 -0.609539 0.281434 0.391260 0.168064 1.027217 1.891400 0.923378)
+ 9.351480 #r(0.000000 0.115345 0.952969 1.130622 0.084058 0.254252 0.443202 0.470071 0.932794 0.466331 0.591979 0.457396 1.528107 0.715257 1.847307 0.403253 0.673874 1.456603 0.267262 0.304798 0.064020 -0.007350 0.259234 -0.287472 0.913317 0.595047 1.491194 0.951199 1.469407 0.524123 -0.304693 -0.076445 1.827209 1.059199 1.449793 1.495662 0.754984 0.852314 0.216817 0.724819 0.597427 1.273980 0.926620 0.643916 0.066061 0.625597 1.284699 0.657854 0.605911 1.653365 1.442076 1.033587 -0.542590 1.262635 1.257414 1.117301 0.126208 0.112501 1.272548 0.912632 0.005045 0.757226 0.049364 -0.033316 1.800311 -0.300949 0.310947 1.267820 0.529700 0.817110 -0.265053 1.152779 -0.048439 0.296709 1.270792 1.398568 -1.703554 0.050635 0.940556 0.440806 1.384526 0.885947 -0.609539 0.281434 0.391260 0.168064 1.027217 1.891400 0.923378)
;; 90-1:
- 9.316853 #(0.000000 0.085819 0.605350 0.616151 0.515100 0.192006 1.611678 1.272280 0.904547 0.453867 0.529558 0.437126 -0.275887 1.872898 1.598164 1.418346 1.396886 1.184855 1.082655 1.009362 1.135722 1.346642 1.144862 1.310841 1.530764 1.205966 1.069809 1.617371 1.901283 0.014975 0.548240 0.352080 0.621455 0.621066 1.140982 1.438527 1.367420 1.355216 0.470090 0.621128 1.153118 1.453426 1.808321 0.722632 1.010390 1.016431 1.780248 -0.019572 0.772427 1.493792 0.482571 0.820743 1.364914 -0.136038 0.461117 1.249099 0.311482 0.865776 -0.039503 0.219768 1.361786 0.194309 1.428040 0.130391 0.884203 1.244022 0.541300 1.606196 1.062028 0.148664 0.708408 0.000808 0.975685 0.011180 0.773834 -0.174375 1.225192 0.298080 1.628234 1.104559 -0.010457 1.317133 0.763549 0.343844 1.496091 1.494316 0.445462 0.157345 1.694775)
- 9.315509 #(0.000000 0.124567 0.583351 0.597843 0.508932 0.236340 1.629251 1.260618 0.886324 0.407100 0.532057 0.464552 -0.228622 1.874560 1.586831 1.454279 1.336216 1.166281 1.089863 0.976652 1.146549 1.384070 1.107271 1.259583 1.540352 1.231987 1.112399 1.654619 1.894205 0.035892 0.522606 0.318613 0.597511 0.620237 1.103293 1.435193 1.365285 1.347328 0.516939 0.607227 1.150990 1.407334 1.775681 0.771851 0.945166 0.989030 1.801909 0.000987 0.826555 1.547883 0.480169 0.802373 1.360513 -0.158813 0.514706 1.271439 0.393074 0.883929 -0.039924 0.249141 1.389995 0.169046 1.414692 0.200776 0.896962 1.236745 0.582426 1.647885 1.121990 0.246958 0.721303 0.009183 0.987717 0.027886 0.854020 -0.153681 1.227081 0.324522 1.691772 1.126527 -0.020392 1.310045 0.754076 0.386463 1.500700 1.504277 0.417697 0.239864 1.723507)
+ 9.316853 #r(0.000000 0.085819 0.605350 0.616151 0.515100 0.192006 1.611678 1.272280 0.904547 0.453867 0.529558 0.437126 -0.275887 1.872898 1.598164 1.418346 1.396886 1.184855 1.082655 1.009362 1.135722 1.346642 1.144862 1.310841 1.530764 1.205966 1.069809 1.617371 1.901283 0.014975 0.548240 0.352080 0.621455 0.621066 1.140982 1.438527 1.367420 1.355216 0.470090 0.621128 1.153118 1.453426 1.808321 0.722632 1.010390 1.016431 1.780248 -0.019572 0.772427 1.493792 0.482571 0.820743 1.364914 -0.136038 0.461117 1.249099 0.311482 0.865776 -0.039503 0.219768 1.361786 0.194309 1.428040 0.130391 0.884203 1.244022 0.541300 1.606196 1.062028 0.148664 0.708408 0.000808 0.975685 0.011180 0.773834 -0.174375 1.225192 0.298080 1.628234 1.104559 -0.010457 1.317133 0.763549 0.343844 1.496091 1.494316 0.445462 0.157345 1.694775)
+ 9.315509 #r(0.000000 0.124567 0.583351 0.597843 0.508932 0.236340 1.629251 1.260618 0.886324 0.407100 0.532057 0.464552 -0.228622 1.874560 1.586831 1.454279 1.336216 1.166281 1.089863 0.976652 1.146549 1.384070 1.107271 1.259583 1.540352 1.231987 1.112399 1.654619 1.894205 0.035892 0.522606 0.318613 0.597511 0.620237 1.103293 1.435193 1.365285 1.347328 0.516939 0.607227 1.150990 1.407334 1.775681 0.771851 0.945166 0.989030 1.801909 0.000987 0.826555 1.547883 0.480169 0.802373 1.360513 -0.158813 0.514706 1.271439 0.393074 0.883929 -0.039924 0.249141 1.389995 0.169046 1.414692 0.200776 0.896962 1.236745 0.582426 1.647885 1.121990 0.246958 0.721303 0.009183 0.987717 0.027886 0.854020 -0.153681 1.227081 0.324522 1.691772 1.126527 -0.020392 1.310045 0.754076 0.386463 1.500700 1.504277 0.417697 0.239864 1.723507)
)
;;; 90 all -------------------------------------------------------------------------------- ; 9.4868
-(vector 90 12.059710502625 #(0 0 1 0 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 0 0)
+(vector 90 12.059710502625 #r(0 0 1 0 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 0 0)
- 9.398614 #(0.000000 0.892706 1.062256 0.213835 0.203111 1.398668 1.054220 0.038528 1.142619 0.118583 0.457258 1.631677 1.573493 1.353053 0.245939 0.098142 1.245835 1.513894 0.025359 0.747716 0.843192 1.216875 0.015492 0.415459 0.312421 1.153905 1.780617 0.437612 -0.400304 -0.029367 1.378815 -0.215560 0.280582 1.233159 0.249478 0.201675 0.961263 0.048927 0.571980 0.265611 0.963409 1.336060 0.891681 1.142504 1.421083 1.162603 1.027272 0.851118 0.849549 0.034892 1.199036 0.308700 1.882141 0.734414 0.473371 1.758626 0.761172 0.952217 -0.108344 1.230664 0.088942 0.737287 0.280477 0.684695 1.865274 1.638095 0.534719 0.573717 0.414603 0.759210 0.580912 -0.293171 0.034364 1.872658 1.705405 0.725925 -0.286371 0.704217 0.268789 0.757724 0.268458 1.430890 1.325737 1.264595 0.335646 0.223092 0.572527 0.875084 0.723299 0.490792)
+ 9.398614 #r(0.000000 0.892706 1.062256 0.213835 0.203111 1.398668 1.054220 0.038528 1.142619 0.118583 0.457258 1.631677 1.573493 1.353053 0.245939 0.098142 1.245835 1.513894 0.025359 0.747716 0.843192 1.216875 0.015492 0.415459 0.312421 1.153905 1.780617 0.437612 -0.400304 -0.029367 1.378815 -0.215560 0.280582 1.233159 0.249478 0.201675 0.961263 0.048927 0.571980 0.265611 0.963409 1.336060 0.891681 1.142504 1.421083 1.162603 1.027272 0.851118 0.849549 0.034892 1.199036 0.308700 1.882141 0.734414 0.473371 1.758626 0.761172 0.952217 -0.108344 1.230664 0.088942 0.737287 0.280477 0.684695 1.865274 1.638095 0.534719 0.573717 0.414603 0.759210 0.580912 -0.293171 0.034364 1.872658 1.705405 0.725925 -0.286371 0.704217 0.268789 0.757724 0.268458 1.430890 1.325737 1.264595 0.335646 0.223092 0.572527 0.875084 0.723299 0.490792)
;; 91-1
- 9.369284 #(0.000000 0.030596 0.512977 0.726782 0.477829 0.081885 1.589694 1.322061 1.083902 0.559521 0.448753 0.385931 -0.189736 1.722513 1.513355 1.392162 1.333913 1.122941 1.145305 1.071310 1.267721 1.283537 1.282341 1.395603 1.460843 1.220013 1.214982 1.532704 1.680386 -0.041828 0.369697 0.425933 0.371638 0.589333 1.041407 1.225589 1.172832 1.376354 0.162279 0.498805 1.164883 1.416170 1.867958 0.505897 0.978762 1.054842 1.522372 -0.063766 0.952495 1.463756 0.521257 0.824505 1.179094 1.811681 0.447390 1.180931 0.235815 0.652944 -0.161883 -0.021774 1.283901 -0.087905 1.281512 -0.144202 0.579788 1.336977 0.409226 1.333107 0.963576 0.011530 0.529499 1.655761 0.578200 1.742908 0.613593 -0.239938 1.074047 0.302129 1.602392 0.926017 -0.218685 1.216630 0.428055 0.183727 1.506714 1.185120 0.296902 -0.071562 1.483831 0.585762)
+ 9.369284 #r(0.000000 0.030596 0.512977 0.726782 0.477829 0.081885 1.589694 1.322061 1.083902 0.559521 0.448753 0.385931 -0.189736 1.722513 1.513355 1.392162 1.333913 1.122941 1.145305 1.071310 1.267721 1.283537 1.282341 1.395603 1.460843 1.220013 1.214982 1.532704 1.680386 -0.041828 0.369697 0.425933 0.371638 0.589333 1.041407 1.225589 1.172832 1.376354 0.162279 0.498805 1.164883 1.416170 1.867958 0.505897 0.978762 1.054842 1.522372 -0.063766 0.952495 1.463756 0.521257 0.824505 1.179094 1.811681 0.447390 1.180931 0.235815 0.652944 -0.161883 -0.021774 1.283901 -0.087905 1.281512 -0.144202 0.579788 1.336977 0.409226 1.333107 0.963576 0.011530 0.529499 1.655761 0.578200 1.742908 0.613593 -0.239938 1.074047 0.302129 1.602392 0.926017 -0.218685 1.216630 0.428055 0.183727 1.506714 1.185120 0.296902 -0.071562 1.483831 0.585762)
)
;;; 91 all -------------------------------------------------------------------------------- ; 9.5394
-(vector 91 12.130150794983 #(0 1 1 0 0 0 1 0 0 0 0 1 0 1 1 1 1 0 0 1 0 1 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 1 1 0 0 0 1 1 0 0 0 1 0 0 1 0 1 1 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0)
+(vector 91 12.130150794983 #r(0 1 1 0 0 0 1 0 0 0 0 1 0 1 1 1 1 0 0 1 0 1 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 1 1 0 0 0 1 1 0 0 0 1 0 0 1 0 1 1 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0)
- 9.460641 #(0.000000 0.436117 1.518395 1.686873 0.685584 1.390220 1.721023 1.218901 0.617875 0.942031 0.798753 1.787198 0.914695 1.067725 0.500698 1.164934 1.198775 0.318349 0.110243 1.683123 1.771564 0.104141 0.404057 1.512291 -0.053002 0.635555 0.485286 0.639133 1.522433 0.362468 1.841483 -0.018649 1.636664 1.891231 -0.092223 0.000560 1.591693 0.345850 0.362361 0.150153 0.525106 1.675920 1.376159 0.544954 1.155066 0.115196 0.924275 -0.119311 1.123186 0.422131 1.628623 0.610317 0.891460 1.679635 0.315850 0.345138 -0.095637 1.712298 -0.241584 0.926203 1.708802 0.312769 0.179387 0.288518 0.999840 0.990421 1.415220 1.453610 0.512219 1.890115 0.694941 1.068928 1.023842 0.497685 1.095073 1.132736 1.716879 -0.012368 0.180422 1.245447 0.380145 -0.172552 1.441547 0.152524 1.430740 1.014319 0.944154 0.113921 1.674916 -0.025585 0.846123)
+ 9.460641 #r(0.000000 0.436117 1.518395 1.686873 0.685584 1.390220 1.721023 1.218901 0.617875 0.942031 0.798753 1.787198 0.914695 1.067725 0.500698 1.164934 1.198775 0.318349 0.110243 1.683123 1.771564 0.104141 0.404057 1.512291 -0.053002 0.635555 0.485286 0.639133 1.522433 0.362468 1.841483 -0.018649 1.636664 1.891231 -0.092223 0.000560 1.591693 0.345850 0.362361 0.150153 0.525106 1.675920 1.376159 0.544954 1.155066 0.115196 0.924275 -0.119311 1.123186 0.422131 1.628623 0.610317 0.891460 1.679635 0.315850 0.345138 -0.095637 1.712298 -0.241584 0.926203 1.708802 0.312769 0.179387 0.288518 0.999840 0.990421 1.415220 1.453610 0.512219 1.890115 0.694941 1.068928 1.023842 0.497685 1.095073 1.132736 1.716879 -0.012368 0.180422 1.245447 0.380145 -0.172552 1.441547 0.152524 1.430740 1.014319 0.944154 0.113921 1.674916 -0.025585 0.846123)
;; 92-1
- 9.406571 #(0.000000 0.070183 0.558945 0.616954 0.488264 0.097581 1.643944 1.396224 1.158953 0.725014 0.517196 0.327654 -0.169876 1.614114 1.687774 1.412838 1.174539 1.259505 1.130798 1.052361 1.015956 1.267208 1.254231 1.379495 1.394559 1.223329 1.348807 1.448672 1.402107 -0.114780 0.204211 0.407141 0.213819 0.557195 0.878563 1.293773 1.227658 1.440547 0.218508 0.668102 0.992197 1.450344 1.592835 0.514105 0.745631 1.232389 1.450929 -0.020833 0.958476 1.514641 0.316511 0.755172 1.221264 1.755846 0.507669 1.139584 0.110724 0.749907 0.055238 0.050342 1.322976 0.038212 1.303755 -0.169105 0.463456 1.427795 0.697605 1.381025 0.968559 0.022635 0.695622 1.792840 0.529902 1.903317 0.747931 -0.193306 0.982955 0.298689 1.702098 1.077145 -0.265151 1.140052 0.371003 -0.055705 1.235675 1.006638 0.294853 1.755510 1.459678 0.647624 -0.081756)
+ 9.406571 #r(0.000000 0.070183 0.558945 0.616954 0.488264 0.097581 1.643944 1.396224 1.158953 0.725014 0.517196 0.327654 -0.169876 1.614114 1.687774 1.412838 1.174539 1.259505 1.130798 1.052361 1.015956 1.267208 1.254231 1.379495 1.394559 1.223329 1.348807 1.448672 1.402107 -0.114780 0.204211 0.407141 0.213819 0.557195 0.878563 1.293773 1.227658 1.440547 0.218508 0.668102 0.992197 1.450344 1.592835 0.514105 0.745631 1.232389 1.450929 -0.020833 0.958476 1.514641 0.316511 0.755172 1.221264 1.755846 0.507669 1.139584 0.110724 0.749907 0.055238 0.050342 1.322976 0.038212 1.303755 -0.169105 0.463456 1.427795 0.697605 1.381025 0.968559 0.022635 0.695622 1.792840 0.529902 1.903317 0.747931 -0.193306 0.982955 0.298689 1.702098 1.077145 -0.265151 1.140052 0.371003 -0.055705 1.235675 1.006638 0.294853 1.755510 1.459678 0.647624 -0.081756)
)
;;; 92 all -------------------------------------------------------------------------------- ; 9.5917
-(vector 92 12.009957507951 #(0 0 0 1 0 1 0 0 0 1 1 0 0 1 1 0 1 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 0 0 0 0 1 1 1 1 0 1 0 0 0 0 1 0 0 1 0 1 0 0 0 1 1 1 0 0 1 1 1 1 1 1 1 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 1 0 1 0 1)
+(vector 92 12.009957507951 #r(0 0 0 1 0 1 0 0 0 1 1 0 0 1 1 0 1 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 0 0 0 0 1 1 1 1 0 1 0 0 0 0 1 0 0 1 0 1 0 0 0 1 1 1 0 0 1 1 1 1 1 1 1 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 1 0 1 0 1)
- 9.517966 #(0.000000 0.086823 0.747623 -0.085371 0.122456 -0.230268 0.119188 1.361402 1.167782 0.037384 1.047768 0.553092 0.649815 1.008382 0.794506 0.305054 1.023759 0.770450 1.886190 0.685208 0.379196 0.684576 0.589903 0.070635 1.842447 1.673609 -0.393612 0.098157 1.794112 0.846616 0.025307 0.910127 0.590170 1.608490 0.410052 1.692507 -0.369713 0.406231 1.469315 1.471065 0.951373 1.130104 0.531009 1.015991 1.488443 0.280351 0.460606 1.244663 1.053735 0.254819 0.300775 0.994290 1.059430 1.061070 1.049296 1.008564 -0.162768 1.637847 1.291833 1.037154 0.364051 0.144913 0.533100 1.075664 1.325409 -0.343880 0.931404 1.449787 0.745214 0.874779 -0.406152 1.757226 1.474675 0.453343 1.845066 0.544094 1.158828 0.100488 1.840683 0.221106 0.924537 1.893930 0.736114 1.402591 0.613840 0.057492 0.409601 -0.093628 1.271558 0.626825 0.949050 -0.217069)
+ 9.517966 #r(0.000000 0.086823 0.747623 -0.085371 0.122456 -0.230268 0.119188 1.361402 1.167782 0.037384 1.047768 0.553092 0.649815 1.008382 0.794506 0.305054 1.023759 0.770450 1.886190 0.685208 0.379196 0.684576 0.589903 0.070635 1.842447 1.673609 -0.393612 0.098157 1.794112 0.846616 0.025307 0.910127 0.590170 1.608490 0.410052 1.692507 -0.369713 0.406231 1.469315 1.471065 0.951373 1.130104 0.531009 1.015991 1.488443 0.280351 0.460606 1.244663 1.053735 0.254819 0.300775 0.994290 1.059430 1.061070 1.049296 1.008564 -0.162768 1.637847 1.291833 1.037154 0.364051 0.144913 0.533100 1.075664 1.325409 -0.343880 0.931404 1.449787 0.745214 0.874779 -0.406152 1.757226 1.474675 0.453343 1.845066 0.544094 1.158828 0.100488 1.840683 0.221106 0.924537 1.893930 0.736114 1.402591 0.613840 0.057492 0.409601 -0.093628 1.271558 0.626825 0.949050 -0.217069)
;; 93-1
- 9.419885 #(0.000000 0.069529 0.633901 0.633608 0.570434 0.157518 1.715794 1.321616 1.084449 0.794466 0.425008 0.283514 -0.131990 1.646881 1.533838 1.442714 1.177599 1.239726 1.207883 1.015321 0.976921 1.262383 1.278818 1.276322 1.338824 1.226865 1.318320 1.361295 1.375488 -0.072989 0.149612 0.367026 0.181636 0.504697 0.851522 1.286853 1.425655 1.395838 0.306909 0.627046 0.973004 1.385102 1.455309 0.477354 0.684776 1.138509 1.548279 -0.072451 0.798558 1.262715 0.056514 0.791921 1.056616 1.695546 0.434938 1.116470 0.025573 0.789168 -0.006184 0.138467 1.335319 0.002519 1.259750 -0.081984 0.549375 1.443475 0.683161 1.338585 0.966058 1.876977 0.624731 1.787187 0.503447 1.917935 0.840074 -0.187662 1.042424 0.183738 1.737882 1.038721 -0.194530 1.214452 0.488651 0.014114 1.273532 1.004556 0.303820 1.746128 1.409399 0.765865 0.191028 1.596552)
+ 9.419885 #r(0.000000 0.069529 0.633901 0.633608 0.570434 0.157518 1.715794 1.321616 1.084449 0.794466 0.425008 0.283514 -0.131990 1.646881 1.533838 1.442714 1.177599 1.239726 1.207883 1.015321 0.976921 1.262383 1.278818 1.276322 1.338824 1.226865 1.318320 1.361295 1.375488 -0.072989 0.149612 0.367026 0.181636 0.504697 0.851522 1.286853 1.425655 1.395838 0.306909 0.627046 0.973004 1.385102 1.455309 0.477354 0.684776 1.138509 1.548279 -0.072451 0.798558 1.262715 0.056514 0.791921 1.056616 1.695546 0.434938 1.116470 0.025573 0.789168 -0.006184 0.138467 1.335319 0.002519 1.259750 -0.081984 0.549375 1.443475 0.683161 1.338585 0.966058 1.876977 0.624731 1.787187 0.503447 1.917935 0.840074 -0.187662 1.042424 0.183738 1.737882 1.038721 -0.194530 1.214452 0.488651 0.014114 1.273532 1.004556 0.303820 1.746128 1.409399 0.765865 0.191028 1.596552)
)
;;; 93 all -------------------------------------------------------------------------------- ; 9.6437
-(vector 93 12.125471062226 #(0 1 0 0 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 0 1 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 1 1 1 0 1 0 1 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 1 1 1)
+(vector 93 12.125471062226 #r(0 1 0 0 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 0 1 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 1 1 1 0 1 0 1 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 1 1 1)
- 9.668780 #(0.000000 1.502492 1.735960 1.811396 -0.104957 0.482636 0.500559 -0.183071 -0.047836 1.299077 0.116243 0.998697 1.692766 0.951722 0.883989 1.357273 1.702880 0.882694 1.095034 1.397512 0.329332 0.527364 0.298917 0.655212 0.187816 0.424294 1.150209 0.114579 0.252718 -0.217705 0.508106 -0.043801 0.270810 1.167969 0.982839 0.517943 0.010809 1.845815 1.098777 0.567160 0.419087 1.030585 1.503183 1.837046 1.638737 1.381290 1.657079 1.137100 1.564675 -0.040237 0.809480 0.832346 1.587671 -0.164235 1.557353 -0.318789 1.412269 1.419735 0.213834 0.923183 0.158106 0.606199 0.283874 -0.361272 1.495430 1.475886 0.334771 1.534489 0.873427 -0.175602 1.422400 0.168157 0.667278 1.332909 0.520912 0.514379 1.506377 1.240021 1.795506 1.354822 0.149370 0.097693 1.231885 1.499794 1.191816 0.402471 1.807112 1.364329 0.383172 1.438070 0.658534 1.737005 0.518886)
+ 9.668780 #r(0.000000 1.502492 1.735960 1.811396 -0.104957 0.482636 0.500559 -0.183071 -0.047836 1.299077 0.116243 0.998697 1.692766 0.951722 0.883989 1.357273 1.702880 0.882694 1.095034 1.397512 0.329332 0.527364 0.298917 0.655212 0.187816 0.424294 1.150209 0.114579 0.252718 -0.217705 0.508106 -0.043801 0.270810 1.167969 0.982839 0.517943 0.010809 1.845815 1.098777 0.567160 0.419087 1.030585 1.503183 1.837046 1.638737 1.381290 1.657079 1.137100 1.564675 -0.040237 0.809480 0.832346 1.587671 -0.164235 1.557353 -0.318789 1.412269 1.419735 0.213834 0.923183 0.158106 0.606199 0.283874 -0.361272 1.495430 1.475886 0.334771 1.534489 0.873427 -0.175602 1.422400 0.168157 0.667278 1.332909 0.520912 0.514379 1.506377 1.240021 1.795506 1.354822 0.149370 0.097693 1.231885 1.499794 1.191816 0.402471 1.807112 1.364329 0.383172 1.438070 0.658534 1.737005 0.518886)
;; pp:
- 9.412639 #(0.000000 0.102641 0.679230 0.798388 0.598526 0.445036 1.682481 1.416478 1.010866 0.838753 0.518866 0.185140 -0.260801 1.643327 1.645133 1.587871 1.510095 1.367190 1.252764 1.075109 0.997402 1.226792 1.097666 1.109286 1.266675 1.142806 1.396415 1.366757 1.323435 -0.151657 0.110933 0.254314 0.125232 0.426419 0.874355 1.227943 1.386454 1.437438 0.183960 0.673205 0.896736 1.317085 1.421345 0.557215 0.650544 0.979705 1.599286 -0.027664 0.967924 1.389243 -0.027060 0.800953 1.098758 1.686133 0.493843 1.257456 0.105617 0.800125 0.006765 0.139250 1.353019 -0.059007 1.198209 0.066444 0.431719 1.470864 0.547882 1.294688 0.757592 1.690943 0.714913 1.735237 0.542409 1.804533 0.779629 -0.296056 1.090213 0.178123 1.832019 1.000948 -0.131923 1.161644 0.360890 0.065736 1.232224 0.792139 0.176636 1.688866 1.432871 0.734257 0.042563 1.592538 0.764029)
+ 9.412639 #r(0.000000 0.102641 0.679230 0.798388 0.598526 0.445036 1.682481 1.416478 1.010866 0.838753 0.518866 0.185140 -0.260801 1.643327 1.645133 1.587871 1.510095 1.367190 1.252764 1.075109 0.997402 1.226792 1.097666 1.109286 1.266675 1.142806 1.396415 1.366757 1.323435 -0.151657 0.110933 0.254314 0.125232 0.426419 0.874355 1.227943 1.386454 1.437438 0.183960 0.673205 0.896736 1.317085 1.421345 0.557215 0.650544 0.979705 1.599286 -0.027664 0.967924 1.389243 -0.027060 0.800953 1.098758 1.686133 0.493843 1.257456 0.105617 0.800125 0.006765 0.139250 1.353019 -0.059007 1.198209 0.066444 0.431719 1.470864 0.547882 1.294688 0.757592 1.690943 0.714913 1.735237 0.542409 1.804533 0.779629 -0.296056 1.090213 0.178123 1.832019 1.000948 -0.131923 1.161644 0.360890 0.065736 1.232224 0.792139 0.176636 1.688866 1.432871 0.734257 0.042563 1.592538 0.764029)
)
;;; 94 all -------------------------------------------------------------------------------- ; 9.6954
-(vector 94 12.510846178591 #(0 0 0 1 1 1 0 1 0 0 1 1 0 0 1 1 0 1 1 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 1 0 1 0 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0)
+(vector 94 12.510846178591 #r(0 0 0 1 1 1 0 1 0 0 1 1 0 0 1 1 0 1 1 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 1 0 1 0 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0)
- 9.614457 #(0.000000 0.354827 0.986082 0.678218 0.074619 1.069713 1.084979 -0.010872 1.376391 1.050934 0.019873 0.645649 0.930266 1.023286 -0.324271 0.129791 1.399266 0.790347 1.024795 0.364675 1.268057 0.467841 0.596106 0.634764 0.920301 0.577212 1.246648 0.805833 -0.021659 -0.091918 0.865047 0.408442 1.292571 1.382486 -0.396633 1.688655 0.645075 1.689205 0.543001 -0.020503 1.556121 1.527556 1.671083 1.274725 1.683665 1.385648 1.434218 0.579921 1.533529 0.946387 1.280342 1.067943 -0.140266 0.061709 0.145137 0.716787 0.346453 1.817745 0.110851 1.072741 1.054881 1.191219 0.552352 1.218769 1.077324 -0.052815 -0.201076 1.253349 1.375788 0.845621 0.366991 0.916267 0.628985 1.420824 1.381120 0.247768 0.913794 -0.038130 1.360273 -0.162096 1.251116 1.166185 0.322598 1.024569 1.763375 0.466730 1.066807 0.067495 0.545386 1.308131 1.358919 0.937638 0.693078 0.195493)
+ 9.614457 #r(0.000000 0.354827 0.986082 0.678218 0.074619 1.069713 1.084979 -0.010872 1.376391 1.050934 0.019873 0.645649 0.930266 1.023286 -0.324271 0.129791 1.399266 0.790347 1.024795 0.364675 1.268057 0.467841 0.596106 0.634764 0.920301 0.577212 1.246648 0.805833 -0.021659 -0.091918 0.865047 0.408442 1.292571 1.382486 -0.396633 1.688655 0.645075 1.689205 0.543001 -0.020503 1.556121 1.527556 1.671083 1.274725 1.683665 1.385648 1.434218 0.579921 1.533529 0.946387 1.280342 1.067943 -0.140266 0.061709 0.145137 0.716787 0.346453 1.817745 0.110851 1.072741 1.054881 1.191219 0.552352 1.218769 1.077324 -0.052815 -0.201076 1.253349 1.375788 0.845621 0.366991 0.916267 0.628985 1.420824 1.381120 0.247768 0.913794 -0.038130 1.360273 -0.162096 1.251116 1.166185 0.322598 1.024569 1.763375 0.466730 1.066807 0.067495 0.545386 1.308131 1.358919 0.937638 0.693078 0.195493)
;; 93+1
- 9.543681 #(0.000000 0.070784 0.635867 0.742637 0.475019 0.302813 1.825409 1.378229 1.077426 0.877718 0.610301 0.202771 -0.182277 1.673466 1.553357 1.494058 1.368050 1.336285 1.249015 1.094284 1.026782 1.245912 1.085605 1.018283 1.167850 1.013374 1.392524 1.418879 1.281568 -0.274841 -0.022454 0.129657 0.125509 0.504384 0.935744 1.276977 1.483975 1.477426 0.196761 0.675603 0.862408 1.192185 1.459380 0.549610 0.569998 1.001464 1.695499 0.066362 0.898853 1.281654 0.050116 0.806388 1.047653 1.730201 0.520253 1.351614 0.000078 1.010541 -0.167505 0.168460 1.307105 0.008313 1.198293 0.190292 0.394166 1.604739 0.575546 1.381303 0.832277 1.821709 0.813449 1.752392 0.618919 0.026374 0.880532 -0.283635 1.155422 0.216026 1.884068 1.144874 -0.171918 1.125849 0.302834 -0.082892 1.104687 0.762677 0.111766 1.593198 1.158618 0.738387 -0.017688 1.548369 0.670450 -0.209765)
+ 9.543681 #r(0.000000 0.070784 0.635867 0.742637 0.475019 0.302813 1.825409 1.378229 1.077426 0.877718 0.610301 0.202771 -0.182277 1.673466 1.553357 1.494058 1.368050 1.336285 1.249015 1.094284 1.026782 1.245912 1.085605 1.018283 1.167850 1.013374 1.392524 1.418879 1.281568 -0.274841 -0.022454 0.129657 0.125509 0.504384 0.935744 1.276977 1.483975 1.477426 0.196761 0.675603 0.862408 1.192185 1.459380 0.549610 0.569998 1.001464 1.695499 0.066362 0.898853 1.281654 0.050116 0.806388 1.047653 1.730201 0.520253 1.351614 0.000078 1.010541 -0.167505 0.168460 1.307105 0.008313 1.198293 0.190292 0.394166 1.604739 0.575546 1.381303 0.832277 1.821709 0.813449 1.752392 0.618919 0.026374 0.880532 -0.283635 1.155422 0.216026 1.884068 1.144874 -0.171918 1.125849 0.302834 -0.082892 1.104687 0.762677 0.111766 1.593198 1.158618 0.738387 -0.017688 1.548369 0.670450 -0.209765)
)
;;; 95 all -------------------------------------------------------------------------------- ; 9.7468
-(vector 95 12.431831359863 #(0 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 1)
+(vector 95 12.431831359863 #r(0 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 1)
- 9.594917 #(0.000000 1.389542 1.176101 1.128189 0.857825 0.606938 0.053944 1.193702 0.869053 0.060247 1.681618 -0.018030 0.093189 1.777775 1.314304 1.617940 0.848617 -0.108633 0.918764 1.157666 0.455570 1.631612 1.168101 0.785976 0.402697 1.470789 1.252874 0.702336 1.782377 1.673658 1.631189 1.349352 1.050241 0.712255 1.786745 0.232201 0.625268 1.043139 1.455512 1.195110 0.998337 0.283110 0.709026 0.841439 0.900171 1.560899 0.398341 0.605576 1.226269 0.101415 0.662630 -0.080073 0.123777 0.243381 0.746050 1.688701 0.805710 -0.417799 1.076341 1.138430 0.020724 1.738280 0.026371 0.359523 1.207908 0.092412 0.589896 1.141872 0.833369 1.211938 0.834700 0.366724 0.985159 0.093930 1.781990 0.844009 1.324575 1.222996 -0.119995 1.044915 0.191275 1.202233 0.891410 1.663012 1.114750 1.562345 -0.205599 1.605273 0.019367 1.356810 0.858474 1.006151 -0.416772 0.195895 1.774084)
+ 9.594917 #r(0.000000 1.389542 1.176101 1.128189 0.857825 0.606938 0.053944 1.193702 0.869053 0.060247 1.681618 -0.018030 0.093189 1.777775 1.314304 1.617940 0.848617 -0.108633 0.918764 1.157666 0.455570 1.631612 1.168101 0.785976 0.402697 1.470789 1.252874 0.702336 1.782377 1.673658 1.631189 1.349352 1.050241 0.712255 1.786745 0.232201 0.625268 1.043139 1.455512 1.195110 0.998337 0.283110 0.709026 0.841439 0.900171 1.560899 0.398341 0.605576 1.226269 0.101415 0.662630 -0.080073 0.123777 0.243381 0.746050 1.688701 0.805710 -0.417799 1.076341 1.138430 0.020724 1.738280 0.026371 0.359523 1.207908 0.092412 0.589896 1.141872 0.833369 1.211938 0.834700 0.366724 0.985159 0.093930 1.781990 0.844009 1.324575 1.222996 -0.119995 1.044915 0.191275 1.202233 0.891410 1.663012 1.114750 1.562345 -0.205599 1.605273 0.019367 1.356810 0.858474 1.006151 -0.416772 0.195895 1.774084)
)
;;; 96 all -------------------------------------------------------------------------------- ; 9.7980
-(vector 96 12.586637130548 #(0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 0 0 1 1 1)
+(vector 96 12.586637130548 #r(0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 0 0 1 1 1)
- 9.698754 #(0.000000 1.686945 0.467972 0.353719 0.039839 1.529803 1.113587 1.518769 0.069518 0.641616 0.744046 1.828910 0.013471 -0.229934 0.181085 -0.011815 0.130449 1.033538 1.435542 1.445735 1.524439 1.088117 0.632800 0.518998 -0.093855 1.447748 -0.258898 0.540666 0.708408 1.141240 0.388952 0.533151 0.107615 0.843908 1.797589 1.037747 1.105446 0.651000 0.775586 -0.512743 0.563193 0.707947 1.740714 1.753866 0.373300 1.459832 0.879332 1.133261 0.035182 1.481640 1.284446 0.744828 1.229402 -0.449568 1.081113 -0.235470 0.939023 1.698241 1.413068 -0.279150 0.681300 1.084041 -0.075079 0.087600 0.709157 -0.062761 0.870661 0.903931 0.019006 1.008038 -0.009901 1.442216 1.097881 0.558710 1.835109 1.151033 1.232982 1.137424 0.991349 -0.312466 0.156001 0.908045 0.922926 1.582365 1.057816 0.119723 1.368068 0.167350 -0.363438 0.279779 0.391520 0.751632 -0.048111 1.271729 1.046123 1.547668)
+ 9.698754 #r(0.000000 1.686945 0.467972 0.353719 0.039839 1.529803 1.113587 1.518769 0.069518 0.641616 0.744046 1.828910 0.013471 -0.229934 0.181085 -0.011815 0.130449 1.033538 1.435542 1.445735 1.524439 1.088117 0.632800 0.518998 -0.093855 1.447748 -0.258898 0.540666 0.708408 1.141240 0.388952 0.533151 0.107615 0.843908 1.797589 1.037747 1.105446 0.651000 0.775586 -0.512743 0.563193 0.707947 1.740714 1.753866 0.373300 1.459832 0.879332 1.133261 0.035182 1.481640 1.284446 0.744828 1.229402 -0.449568 1.081113 -0.235470 0.939023 1.698241 1.413068 -0.279150 0.681300 1.084041 -0.075079 0.087600 0.709157 -0.062761 0.870661 0.903931 0.019006 1.008038 -0.009901 1.442216 1.097881 0.558710 1.835109 1.151033 1.232982 1.137424 0.991349 -0.312466 0.156001 0.908045 0.922926 1.582365 1.057816 0.119723 1.368068 0.167350 -0.363438 0.279779 0.391520 0.751632 -0.048111 1.271729 1.046123 1.547668)
;; 95+1
- 9.726779 #(0.000000 1.272536 1.234689 1.036804 0.806804 0.685514 -0.233507 1.195648 0.974626 -0.133690 1.612184 -0.250031 0.153834 1.639158 1.448966 1.429020 0.841318 0.036800 0.809280 1.124317 0.410517 1.790247 0.947605 0.878411 0.284331 1.437808 1.242148 0.609187 1.691642 1.608067 1.542734 1.433245 1.048694 0.695483 1.770228 0.049652 0.565924 1.008807 1.378374 1.235802 0.944856 0.275648 0.688876 0.690791 0.947538 1.724048 0.507279 0.344409 1.011255 0.053102 0.655524 0.015954 -0.000803 0.135128 0.906712 1.703603 0.898426 -0.371698 1.225250 0.634585 -0.033241 1.655363 -0.118205 0.384853 1.242318 0.157876 0.169651 1.065989 0.596048 1.102812 0.663038 0.195163 0.860121 -0.157778 1.681909 0.740009 1.139644 0.978398 -0.218097 0.770242 0.520081 1.060101 0.721838 1.327594 1.028501 1.403966 -0.169752 1.470700 0.038544 1.145229 0.628698 0.803002 -0.539861 0.036303 1.343341 -0.219240)
+ 9.726779 #r(0.000000 1.272536 1.234689 1.036804 0.806804 0.685514 -0.233507 1.195648 0.974626 -0.133690 1.612184 -0.250031 0.153834 1.639158 1.448966 1.429020 0.841318 0.036800 0.809280 1.124317 0.410517 1.790247 0.947605 0.878411 0.284331 1.437808 1.242148 0.609187 1.691642 1.608067 1.542734 1.433245 1.048694 0.695483 1.770228 0.049652 0.565924 1.008807 1.378374 1.235802 0.944856 0.275648 0.688876 0.690791 0.947538 1.724048 0.507279 0.344409 1.011255 0.053102 0.655524 0.015954 -0.000803 0.135128 0.906712 1.703603 0.898426 -0.371698 1.225250 0.634585 -0.033241 1.655363 -0.118205 0.384853 1.242318 0.157876 0.169651 1.065989 0.596048 1.102812 0.663038 0.195163 0.860121 -0.157778 1.681909 0.740009 1.139644 0.978398 -0.218097 0.770242 0.520081 1.060101 0.721838 1.327594 1.028501 1.403966 -0.169752 1.470700 0.038544 1.145229 0.628698 0.803002 -0.539861 0.036303 1.343341 -0.219240)
)
;;; 97 all -------------------------------------------------------------------------------- ; 9.8489
-(vector 97 12.585 #(0 1 0 1 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 1 1 0 1)
+(vector 97 12.585 #r(0 1 0 1 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 1 1 0 1)
- 9.811290 #(0.000000 1.599348 0.923331 0.142353 1.275817 1.382624 1.510378 0.732924 0.806532 1.015499 0.620826 1.882699 1.212790 0.807183 -0.023255 1.516389 1.732605 -0.201884 -0.277404 -0.055883 0.240940 0.731931 1.673522 0.086425 1.587574 0.602365 1.160815 1.229056 1.456929 0.833735 0.852700 0.201630 1.357627 0.458255 0.370269 1.445354 0.215612 1.445930 1.140683 1.395090 0.893305 1.761792 0.069580 1.477150 1.261329 0.799176 -0.171506 -0.046281 0.037534 0.945505 0.457403 -0.446133 -0.016772 1.686139 0.929506 1.761163 1.283945 0.714187 0.030687 1.699690 1.935312 -0.149630 1.586492 0.783961 1.445990 1.058255 1.383027 0.027818 1.949317 0.450708 0.615659 0.863171 1.311974 0.506328 0.888408 1.633309 0.234089 1.362300 1.207491 0.660429 0.454914 0.801172 1.438508 0.392994 1.045451 0.178268 0.808166 0.169353 0.379391 0.545139 1.796419 0.579129 1.221213 0.829753 -0.091400 0.706540 1.245414)
+ 9.811290 #r(0.000000 1.599348 0.923331 0.142353 1.275817 1.382624 1.510378 0.732924 0.806532 1.015499 0.620826 1.882699 1.212790 0.807183 -0.023255 1.516389 1.732605 -0.201884 -0.277404 -0.055883 0.240940 0.731931 1.673522 0.086425 1.587574 0.602365 1.160815 1.229056 1.456929 0.833735 0.852700 0.201630 1.357627 0.458255 0.370269 1.445354 0.215612 1.445930 1.140683 1.395090 0.893305 1.761792 0.069580 1.477150 1.261329 0.799176 -0.171506 -0.046281 0.037534 0.945505 0.457403 -0.446133 -0.016772 1.686139 0.929506 1.761163 1.283945 0.714187 0.030687 1.699690 1.935312 -0.149630 1.586492 0.783961 1.445990 1.058255 1.383027 0.027818 1.949317 0.450708 0.615659 0.863171 1.311974 0.506328 0.888408 1.633309 0.234089 1.362300 1.207491 0.660429 0.454914 0.801172 1.438508 0.392994 1.045451 0.178268 0.808166 0.169353 0.379391 0.545139 1.796419 0.579129 1.221213 0.829753 -0.091400 0.706540 1.245414)
;; pp:
- 9.860243 #(0.000000 0.680977 0.966253 1.634215 0.365093 0.771173 1.259550 0.007495 0.693755 1.428280 0.352398 1.032784 1.549276 0.384182 1.088250 1.711305 0.715748 1.441436 0.402491 1.285065 0.056701 0.943326 1.812606 1.043581 -0.072780 0.808810 1.940683 1.225707 -0.029466 1.139541 0.383446 1.652614 0.799608 1.845091 0.834727 0.161218 1.415263 0.601512 1.879909 1.404443 0.587018 1.806810 1.169986 0.643827 -0.082912 1.345651 0.782502 0.239840 1.583476 1.376880 0.682406 0.262024 1.847899 1.521309 1.138292 0.467250 0.281908 -0.070976 1.718683 1.523340 1.285749 0.765922 0.681731 0.268165 0.290564 0.046020 0.082000 1.791305 1.766394 1.373062 1.769852 1.419717 1.707739 1.313906 1.401690 1.527792 1.718640 1.280023 1.582817 1.850590 0.103668 0.041251 0.363022 0.586729 0.741602 0.886403 0.989519 1.522393 1.709847 0.193187 0.406948 0.736802 1.329603 1.619101 -0.034816 0.612167 1.088037)
+ 9.860243 #r(0.000000 0.680977 0.966253 1.634215 0.365093 0.771173 1.259550 0.007495 0.693755 1.428280 0.352398 1.032784 1.549276 0.384182 1.088250 1.711305 0.715748 1.441436 0.402491 1.285065 0.056701 0.943326 1.812606 1.043581 -0.072780 0.808810 1.940683 1.225707 -0.029466 1.139541 0.383446 1.652614 0.799608 1.845091 0.834727 0.161218 1.415263 0.601512 1.879909 1.404443 0.587018 1.806810 1.169986 0.643827 -0.082912 1.345651 0.782502 0.239840 1.583476 1.376880 0.682406 0.262024 1.847899 1.521309 1.138292 0.467250 0.281908 -0.070976 1.718683 1.523340 1.285749 0.765922 0.681731 0.268165 0.290564 0.046020 0.082000 1.791305 1.766394 1.373062 1.769852 1.419717 1.707739 1.313906 1.401690 1.527792 1.718640 1.280023 1.582817 1.850590 0.103668 0.041251 0.363022 0.586729 0.741602 0.886403 0.989519 1.522393 1.709847 0.193187 0.406948 0.736802 1.329603 1.619101 -0.034816 0.612167 1.088037)
;; 98-1
- 9.733625 #(0.000000 -0.316389 0.763514 1.085136 -0.007054 1.613164 0.368355 0.497362 0.266819 0.792626 1.605095 0.379462 0.795808 0.617439 0.340832 1.408797 0.884588 0.777692 -0.061819 1.329857 1.611199 0.024913 1.778069 1.061965 1.317076 1.286538 -0.063928 0.439816 1.190286 1.720423 -0.281159 0.284236 1.261293 1.715607 1.258044 1.027201 0.992940 1.404704 0.918469 0.571955 0.670954 -0.578424 1.681045 1.759567 -0.365702 0.685884 0.480691 0.685380 0.103522 0.029224 1.512644 0.122325 0.600548 0.070986 0.493468 0.652824 -0.059890 1.290005 1.370566 0.135509 0.143591 -0.197126 0.478025 0.315521 0.839450 0.083388 0.553358 1.161959 0.770340 1.132488 0.641596 1.702281 0.277494 1.930557 0.772636 0.175945 1.352904 0.123527 1.448091 0.194310 0.330488 1.631688 1.302741 0.566332 1.521760 0.740046 0.257004 1.532435 0.681554 0.238673 0.612205 0.128510 1.851063 0.280067 1.237302 -0.034034 0.240185)
+ 9.733625 #r(0.000000 -0.316389 0.763514 1.085136 -0.007054 1.613164 0.368355 0.497362 0.266819 0.792626 1.605095 0.379462 0.795808 0.617439 0.340832 1.408797 0.884588 0.777692 -0.061819 1.329857 1.611199 0.024913 1.778069 1.061965 1.317076 1.286538 -0.063928 0.439816 1.190286 1.720423 -0.281159 0.284236 1.261293 1.715607 1.258044 1.027201 0.992940 1.404704 0.918469 0.571955 0.670954 -0.578424 1.681045 1.759567 -0.365702 0.685884 0.480691 0.685380 0.103522 0.029224 1.512644 0.122325 0.600548 0.070986 0.493468 0.652824 -0.059890 1.290005 1.370566 0.135509 0.143591 -0.197126 0.478025 0.315521 0.839450 0.083388 0.553358 1.161959 0.770340 1.132488 0.641596 1.702281 0.277494 1.930557 0.772636 0.175945 1.352904 0.123527 1.448091 0.194310 0.330488 1.631688 1.302741 0.566332 1.521760 0.740046 0.257004 1.532435 0.681554 0.238673 0.612205 0.128510 1.851063 0.280067 1.237302 -0.034034 0.240185)
)
;;; 98 all -------------------------------------------------------------------------------- ; 9.8995
-(vector 98 12.724907890996 #(0 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 0 0 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 1 1 1)
+(vector 98 12.724907890996 #r(0 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 0 0 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 1 1 1)
- 9.767029 #(0.000000 -0.188323 0.675144 1.162326 -0.152620 1.669640 0.370125 0.494628 0.190555 0.715197 1.719005 0.377693 1.013961 0.545798 0.345914 1.535759 0.968261 0.937780 -0.119329 1.630311 1.635898 0.029531 1.850111 1.208612 1.298337 1.226547 0.020306 0.388794 1.210462 1.649716 -0.158605 0.268380 1.285081 1.672163 1.145021 0.908520 1.140268 1.468740 0.844848 0.440912 0.760836 -0.415872 1.889804 1.724959 -0.229249 0.766901 0.564605 0.613211 0.221081 -0.012880 1.521722 -0.044019 0.593078 0.034669 0.491432 0.559669 -0.045684 1.255880 1.344088 0.070215 0.282883 -0.229690 0.625053 0.504422 0.811212 -0.012186 0.589513 1.241057 0.831526 1.215774 0.684110 1.651422 0.305036 1.891476 0.747710 0.040696 1.539490 0.154881 1.456564 0.357589 0.123799 1.523900 1.179657 0.504889 1.418226 0.850462 0.009923 1.481216 0.600938 0.216302 0.543002 0.255145 1.787452 0.279328 1.172852 -0.085076 0.199219 1.196556)
+ 9.767029 #r(0.000000 -0.188323 0.675144 1.162326 -0.152620 1.669640 0.370125 0.494628 0.190555 0.715197 1.719005 0.377693 1.013961 0.545798 0.345914 1.535759 0.968261 0.937780 -0.119329 1.630311 1.635898 0.029531 1.850111 1.208612 1.298337 1.226547 0.020306 0.388794 1.210462 1.649716 -0.158605 0.268380 1.285081 1.672163 1.145021 0.908520 1.140268 1.468740 0.844848 0.440912 0.760836 -0.415872 1.889804 1.724959 -0.229249 0.766901 0.564605 0.613211 0.221081 -0.012880 1.521722 -0.044019 0.593078 0.034669 0.491432 0.559669 -0.045684 1.255880 1.344088 0.070215 0.282883 -0.229690 0.625053 0.504422 0.811212 -0.012186 0.589513 1.241057 0.831526 1.215774 0.684110 1.651422 0.305036 1.891476 0.747710 0.040696 1.539490 0.154881 1.456564 0.357589 0.123799 1.523900 1.179657 0.504889 1.418226 0.850462 0.009923 1.481216 0.600938 0.216302 0.543002 0.255145 1.787452 0.279328 1.172852 -0.085076 0.199219 1.196556)
)
;;; 99 all -------------------------------------------------------------------------------- ; 9.9499
-(vector 99 13.002375571256 #(0 1 1 0 1 1 0 1 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 1 0 0 1 0 1 0 1 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 1 0 0 0 1 1 1 0 1 0 0 0)
+(vector 99 13.002375571256 #r(0 1 1 0 1 1 0 1 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 1 0 0 1 0 1 0 1 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 1 0 0 0 1 1 1 0 1 0 0 0)
- 9.856524 #(0.000000 0.532142 1.131528 0.051928 1.654946 0.271228 1.101349 1.560647 1.619023 1.108572 0.726033 0.727251 -0.132854 0.360041 0.670224 1.663602 -0.493942 -0.197685 1.604359 1.799803 1.040897 0.122580 0.382051 1.681979 0.430500 1.558581 0.044836 1.543992 1.439831 0.906809 1.334494 1.667502 1.130520 0.467062 1.310080 0.675817 0.797910 0.443927 1.274100 0.336343 0.146059 -0.192316 0.742563 0.471697 1.596436 -0.009686 1.651640 1.837904 0.406037 0.558091 -0.016989 1.479179 0.903735 1.116299 -0.060825 0.179513 -0.026846 1.811414 0.072416 -0.014783 0.060148 0.361427 1.207468 0.945662 0.068194 1.516887 0.004488 0.212016 0.737847 -0.343051 0.746533 0.527238 1.812564 0.462282 1.376985 0.882738 1.070840 1.718397 0.663551 0.922534 1.724192 -0.576637 1.416748 1.206588 0.385428 0.383601 1.504489 1.636715 0.253055 1.809058 0.862228 1.855156 1.029803 0.604391 1.515278 0.827373 1.237016 1.652558 1.330582)
+ 9.856524 #r(0.000000 0.532142 1.131528 0.051928 1.654946 0.271228 1.101349 1.560647 1.619023 1.108572 0.726033 0.727251 -0.132854 0.360041 0.670224 1.663602 -0.493942 -0.197685 1.604359 1.799803 1.040897 0.122580 0.382051 1.681979 0.430500 1.558581 0.044836 1.543992 1.439831 0.906809 1.334494 1.667502 1.130520 0.467062 1.310080 0.675817 0.797910 0.443927 1.274100 0.336343 0.146059 -0.192316 0.742563 0.471697 1.596436 -0.009686 1.651640 1.837904 0.406037 0.558091 -0.016989 1.479179 0.903735 1.116299 -0.060825 0.179513 -0.026846 1.811414 0.072416 -0.014783 0.060148 0.361427 1.207468 0.945662 0.068194 1.516887 0.004488 0.212016 0.737847 -0.343051 0.746533 0.527238 1.812564 0.462282 1.376985 0.882738 1.070840 1.718397 0.663551 0.922534 1.724192 -0.576637 1.416748 1.206588 0.385428 0.383601 1.504489 1.636715 0.253055 1.809058 0.862228 1.855156 1.029803 0.604391 1.515278 0.827373 1.237016 1.652558 1.330582)
;; 100-1
- 9.837088 #(0.000000 0.501632 0.934877 -0.406945 1.720666 0.060221 0.986624 1.296415 1.868188 0.930965 0.372307 0.709017 -0.252505 0.160880 0.812384 1.543611 -0.433820 -0.259337 1.687543 1.624404 0.816138 0.040401 0.111607 -0.236070 0.269290 1.314408 0.264913 1.524076 1.510591 0.672939 1.225301 1.486867 1.198432 0.684715 1.400436 0.809536 0.790904 0.226400 1.325157 0.378418 0.148020 -0.182631 0.691385 0.400855 1.875888 -0.034659 1.584706 0.098304 0.424031 0.680276 -0.260219 1.393931 1.457882 1.172138 0.294071 0.176446 -0.047801 -0.268365 -0.154114 0.172473 0.026218 0.381410 0.486670 0.694651 0.137283 1.339580 -0.408431 0.346779 0.297247 -0.681534 0.303276 0.742358 1.426415 0.456204 1.180942 0.678579 1.815369 1.742844 0.288364 0.833505 1.638509 -0.777919 1.367299 1.067232 -0.002137 0.375276 1.602540 1.654913 0.141825 1.294416 0.790392 1.752947 1.096531 0.330167 1.510639 0.495286 1.348117 1.506107 1.279426)
- 9.827383 #(0.000000 0.489851 0.987809 -0.394189 1.760605 0.036969 0.958351 1.266375 1.844806 0.928905 0.347370 0.708814 -0.213250 0.135838 0.840288 1.524164 -0.453078 -0.222429 1.664862 1.650792 0.843217 0.096982 0.106278 -0.254905 0.311964 1.356301 0.208474 1.484260 1.533307 0.693746 1.221284 1.494648 1.192154 0.704448 1.399404 0.773577 0.730819 0.230112 1.305343 0.384931 0.092126 -0.177018 0.678108 0.424573 1.876518 -0.110628 1.580149 0.105746 0.460598 0.667046 -0.301428 1.430147 1.462027 1.200592 0.294468 0.132684 -0.034510 -0.232945 -0.131872 0.235724 -0.003826 0.390220 0.478949 0.708773 0.158613 1.284193 -0.406418 0.372748 0.269091 -0.683069 0.298317 0.742905 1.467502 0.490499 1.200844 0.658586 1.777690 1.768714 0.250192 0.808599 1.653844 -0.705600 1.331238 1.087732 0.038158 0.351212 1.574369 1.702783 0.145504 1.240857 0.779939 1.689313 1.071204 0.299434 1.500921 0.518280 1.343637 1.492826 1.331082)
+ 9.837088 #r(0.000000 0.501632 0.934877 -0.406945 1.720666 0.060221 0.986624 1.296415 1.868188 0.930965 0.372307 0.709017 -0.252505 0.160880 0.812384 1.543611 -0.433820 -0.259337 1.687543 1.624404 0.816138 0.040401 0.111607 -0.236070 0.269290 1.314408 0.264913 1.524076 1.510591 0.672939 1.225301 1.486867 1.198432 0.684715 1.400436 0.809536 0.790904 0.226400 1.325157 0.378418 0.148020 -0.182631 0.691385 0.400855 1.875888 -0.034659 1.584706 0.098304 0.424031 0.680276 -0.260219 1.393931 1.457882 1.172138 0.294071 0.176446 -0.047801 -0.268365 -0.154114 0.172473 0.026218 0.381410 0.486670 0.694651 0.137283 1.339580 -0.408431 0.346779 0.297247 -0.681534 0.303276 0.742358 1.426415 0.456204 1.180942 0.678579 1.815369 1.742844 0.288364 0.833505 1.638509 -0.777919 1.367299 1.067232 -0.002137 0.375276 1.602540 1.654913 0.141825 1.294416 0.790392 1.752947 1.096531 0.330167 1.510639 0.495286 1.348117 1.506107 1.279426)
+ 9.827383 #r(0.000000 0.489851 0.987809 -0.394189 1.760605 0.036969 0.958351 1.266375 1.844806 0.928905 0.347370 0.708814 -0.213250 0.135838 0.840288 1.524164 -0.453078 -0.222429 1.664862 1.650792 0.843217 0.096982 0.106278 -0.254905 0.311964 1.356301 0.208474 1.484260 1.533307 0.693746 1.221284 1.494648 1.192154 0.704448 1.399404 0.773577 0.730819 0.230112 1.305343 0.384931 0.092126 -0.177018 0.678108 0.424573 1.876518 -0.110628 1.580149 0.105746 0.460598 0.667046 -0.301428 1.430147 1.462027 1.200592 0.294468 0.132684 -0.034510 -0.232945 -0.131872 0.235724 -0.003826 0.390220 0.478949 0.708773 0.158613 1.284193 -0.406418 0.372748 0.269091 -0.683069 0.298317 0.742905 1.467502 0.490499 1.200844 0.658586 1.777690 1.768714 0.250192 0.808599 1.653844 -0.705600 1.331238 1.087732 0.038158 0.351212 1.574369 1.702783 0.145504 1.240857 0.779939 1.689313 1.071204 0.299434 1.500921 0.518280 1.343637 1.492826 1.331082)
)
;;; 100 all -------------------------------------------------------------------------------- ; 10
-(vector 100 12.998435541498 #(0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 1 1 0 1 0 1 0 0 0 1 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 0 0 0 0)
+(vector 100 12.998435541498 #r(0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 1 1 0 1 0 1 0 0 0 1 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 0 0 0 0)
- 9.934540 #(0.000000 -0.003002 1.124858 1.923310 1.313585 0.903273 0.269057 1.550768 -0.053877 1.309350 0.259003 0.111356 1.649851 -0.475532 0.829676 0.358899 1.751244 0.579333 0.816025 0.729724 0.670859 0.992375 1.547721 -0.006147 1.191599 -0.084864 -0.001041 0.113001 0.580223 -0.405864 1.746923 1.268810 1.705215 1.056469 -0.197189 1.293674 0.934396 0.701720 0.582761 1.455750 1.232104 0.066182 1.464245 1.672004 0.239530 1.711330 -0.092878 0.399845 1.787310 0.046607 0.724822 1.735381 1.288901 0.460956 0.591963 0.996187 1.917259 0.311027 0.319804 1.898631 1.336795 0.632408 0.203462 1.031863 1.346167 0.931351 0.938341 -0.021240 0.003608 0.259606 1.507194 1.470684 0.324860 1.386425 0.298636 1.353945 1.922770 1.226486 0.467967 1.127400 0.946778 1.636808 0.285401 1.555027 1.572734 1.271086 1.042408 1.022431 1.651957 1.039348 0.338431 0.852870 0.945331 1.308135 1.631151 1.286426 0.091020 0.620928 0.894381 1.712980)
+ 9.934540 #r(0.000000 -0.003002 1.124858 1.923310 1.313585 0.903273 0.269057 1.550768 -0.053877 1.309350 0.259003 0.111356 1.649851 -0.475532 0.829676 0.358899 1.751244 0.579333 0.816025 0.729724 0.670859 0.992375 1.547721 -0.006147 1.191599 -0.084864 -0.001041 0.113001 0.580223 -0.405864 1.746923 1.268810 1.705215 1.056469 -0.197189 1.293674 0.934396 0.701720 0.582761 1.455750 1.232104 0.066182 1.464245 1.672004 0.239530 1.711330 -0.092878 0.399845 1.787310 0.046607 0.724822 1.735381 1.288901 0.460956 0.591963 0.996187 1.917259 0.311027 0.319804 1.898631 1.336795 0.632408 0.203462 1.031863 1.346167 0.931351 0.938341 -0.021240 0.003608 0.259606 1.507194 1.470684 0.324860 1.386425 0.298636 1.353945 1.922770 1.226486 0.467967 1.127400 0.946778 1.636808 0.285401 1.555027 1.572734 1.271086 1.042408 1.022431 1.651957 1.039348 0.338431 0.852870 0.945331 1.308135 1.631151 1.286426 0.091020 0.620928 0.894381 1.712980)
;; 99+1
- 9.840430 #(0.000000 0.622605 0.940347 -0.023879 1.823374 0.046101 0.987386 1.386868 1.714786 1.047746 0.546094 0.770951 -0.265661 0.292412 0.888118 1.675189 -0.427745 -0.167443 1.762203 1.576180 0.923298 0.110300 0.331275 1.952651 0.241655 1.589880 0.276846 1.519665 1.333705 0.834984 1.249804 1.700983 1.188281 0.627881 1.352135 0.781883 0.873102 0.286686 1.236704 0.305170 0.118608 -0.061299 0.746712 0.436256 1.850021 0.025967 1.523851 0.111789 0.590538 0.644667 -0.043430 1.449342 1.285442 1.251443 0.387240 0.168668 -0.008131 -0.077897 -0.090554 0.128941 0.292252 0.590066 0.910912 0.845002 0.114157 1.267409 -0.143231 0.405284 0.467262 -0.510143 0.597548 0.663042 1.615835 0.378343 1.456219 0.634771 1.512841 1.710315 0.498665 0.804929 1.545845 -0.422582 1.525481 1.254165 0.184553 0.563406 1.423281 1.785321 0.228158 1.573508 0.775481 1.683423 1.226447 0.381675 1.467512 0.862051 1.538318 1.641940 1.350297 0.135931)
+ 9.840430 #r(0.000000 0.622605 0.940347 -0.023879 1.823374 0.046101 0.987386 1.386868 1.714786 1.047746 0.546094 0.770951 -0.265661 0.292412 0.888118 1.675189 -0.427745 -0.167443 1.762203 1.576180 0.923298 0.110300 0.331275 1.952651 0.241655 1.589880 0.276846 1.519665 1.333705 0.834984 1.249804 1.700983 1.188281 0.627881 1.352135 0.781883 0.873102 0.286686 1.236704 0.305170 0.118608 -0.061299 0.746712 0.436256 1.850021 0.025967 1.523851 0.111789 0.590538 0.644667 -0.043430 1.449342 1.285442 1.251443 0.387240 0.168668 -0.008131 -0.077897 -0.090554 0.128941 0.292252 0.590066 0.910912 0.845002 0.114157 1.267409 -0.143231 0.405284 0.467262 -0.510143 0.597548 0.663042 1.615835 0.378343 1.456219 0.634771 1.512841 1.710315 0.498665 0.804929 1.545845 -0.422582 1.525481 1.254165 0.184553 0.563406 1.423281 1.785321 0.228158 1.573508 0.775481 1.683423 1.226447 0.381675 1.467512 0.862051 1.538318 1.641940 1.350297 0.135931)
- 9.835590 #(0.000000 0.570539 0.883467 -0.014746 1.809284 0.037164 0.942356 1.400420 1.689848 1.054845 0.548531 0.724602 -0.281675 0.241599 0.863477 1.691280 -0.386312 -0.167207 1.712242 1.554897 0.916947 0.154344 0.337144 -0.027896 0.191502 1.562234 0.293369 1.468239 1.368021 0.858183 1.215102 1.710412 1.168343 0.641872 1.384374 0.758703 0.847326 0.232955 1.203009 0.285135 0.164856 0.006319 0.731916 0.364606 1.825894 0.043345 1.457606 0.099304 0.693634 0.599315 -0.080515 1.358403 1.276512 1.306804 0.350411 0.153823 -0.066078 -0.056199 -0.130700 0.138204 0.313702 0.671650 0.858922 0.893029 0.081041 1.207722 -0.186661 0.401736 0.459231 -0.571478 0.607326 0.634928 1.590455 0.322847 1.466431 0.635387 1.523516 1.640986 0.518971 0.735455 1.517620 -0.440561 1.538277 1.209947 0.169421 0.568757 1.501995 1.704851 0.248785 1.539090 0.803108 1.622622 1.319362 0.357166 1.483707 0.858733 1.549787 1.667959 1.355314 0.166782)
- 9.828147 #(0.000000 0.606381 0.917097 -0.052963 1.840850 0.076195 1.000382 1.379573 1.713959 1.056049 0.567183 0.755185 -0.243029 0.240141 0.901208 1.696896 -0.401067 -0.172213 1.702278 1.572589 0.995369 0.092107 0.339155 -0.047255 0.209942 1.548195 0.250627 1.493833 1.397582 0.850788 1.234138 1.694866 1.205737 0.609514 1.413541 0.774375 0.843373 0.256747 1.182652 0.287452 0.151651 -0.040175 0.718613 0.370108 1.797287 0.037564 1.483372 0.063366 0.673221 0.647681 -0.130882 1.410330 1.289134 1.259368 0.378589 0.179096 -0.077706 -0.126123 -0.197835 0.087734 0.222460 0.660561 0.798643 0.833272 0.064575 1.260850 -0.205610 0.363184 0.404543 -0.579680 0.559469 0.652793 1.526709 0.333879 1.432283 0.642498 1.543163 1.637538 0.499172 0.795803 1.495177 -0.493071 1.544279 1.224387 0.125780 0.527014 1.451448 1.716932 0.232752 1.503302 0.799684 1.669661 1.257116 0.363202 1.442143 0.833946 1.525977 1.616490 1.388269 0.088027)
+ 9.835590 #r(0.000000 0.570539 0.883467 -0.014746 1.809284 0.037164 0.942356 1.400420 1.689848 1.054845 0.548531 0.724602 -0.281675 0.241599 0.863477 1.691280 -0.386312 -0.167207 1.712242 1.554897 0.916947 0.154344 0.337144 -0.027896 0.191502 1.562234 0.293369 1.468239 1.368021 0.858183 1.215102 1.710412 1.168343 0.641872 1.384374 0.758703 0.847326 0.232955 1.203009 0.285135 0.164856 0.006319 0.731916 0.364606 1.825894 0.043345 1.457606 0.099304 0.693634 0.599315 -0.080515 1.358403 1.276512 1.306804 0.350411 0.153823 -0.066078 -0.056199 -0.130700 0.138204 0.313702 0.671650 0.858922 0.893029 0.081041 1.207722 -0.186661 0.401736 0.459231 -0.571478 0.607326 0.634928 1.590455 0.322847 1.466431 0.635387 1.523516 1.640986 0.518971 0.735455 1.517620 -0.440561 1.538277 1.209947 0.169421 0.568757 1.501995 1.704851 0.248785 1.539090 0.803108 1.622622 1.319362 0.357166 1.483707 0.858733 1.549787 1.667959 1.355314 0.166782)
+ 9.828147 #r(0.000000 0.606381 0.917097 -0.052963 1.840850 0.076195 1.000382 1.379573 1.713959 1.056049 0.567183 0.755185 -0.243029 0.240141 0.901208 1.696896 -0.401067 -0.172213 1.702278 1.572589 0.995369 0.092107 0.339155 -0.047255 0.209942 1.548195 0.250627 1.493833 1.397582 0.850788 1.234138 1.694866 1.205737 0.609514 1.413541 0.774375 0.843373 0.256747 1.182652 0.287452 0.151651 -0.040175 0.718613 0.370108 1.797287 0.037564 1.483372 0.063366 0.673221 0.647681 -0.130882 1.410330 1.289134 1.259368 0.378589 0.179096 -0.077706 -0.126123 -0.197835 0.087734 0.222460 0.660561 0.798643 0.833272 0.064575 1.260850 -0.205610 0.363184 0.404543 -0.579680 0.559469 0.652793 1.526709 0.333879 1.432283 0.642498 1.543163 1.637538 0.499172 0.795803 1.495177 -0.493071 1.544279 1.224387 0.125780 0.527014 1.451448 1.716932 0.232752 1.503302 0.799684 1.669661 1.257116 0.363202 1.442143 0.833946 1.525977 1.616490 1.388269 0.088027)
)
;;; 101 all -------------------------------------------------------------------------------- ; 10.0499
-(vector 101 13.219774246216 #(0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 1 0 0 0 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 0 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 0 0 1 0 0 1 0 0)
+(vector 101 13.219774246216 #r(0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 1 0 0 0 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 0 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 0 0 1 0 0 1 0 0)
;; pp.scm:
- 9.969423 #(0.000000 0.594013 1.021081 1.737097 -0.040619 0.752674 1.481517 0.041655 0.616216 1.273976 -0.239494 0.706555 1.350693 0.121717 0.873486 1.615554 0.502899 0.859104 0.100209 1.240389 0.001564 0.940100 -0.110501 0.399212 1.639677 0.823186 1.849867 0.970964 1.815596 0.977295 1.876945 1.029064 0.250663 1.106062 0.440754 1.692440 0.937531 0.143047 1.343876 0.363444 1.897361 0.954251 0.489534 1.687124 1.352147 0.540407 -0.261830 1.349441 0.704373 0.447495 1.734922 1.090380 0.653989 0.307022 1.449780 1.794904 0.808626 0.497093 0.423383 -0.280469 1.640122 1.217125 1.143712 0.677390 0.472908 0.243924 0.123084 -0.178887 1.588534 1.317289 1.403860 1.454850 1.459048 1.165832 1.237401 1.000847 1.421104 1.051039 1.364625 1.447050 1.541757 1.176845 1.530906 1.723380 1.795645 0.095341 0.481918 0.307978 0.454615 1.009308 0.963604 1.200422 1.757436 -0.015019 0.420112 1.020994 1.127410 1.866034 -0.291409 0.497289 1.096855)
+ 9.969423 #r(0.000000 0.594013 1.021081 1.737097 -0.040619 0.752674 1.481517 0.041655 0.616216 1.273976 -0.239494 0.706555 1.350693 0.121717 0.873486 1.615554 0.502899 0.859104 0.100209 1.240389 0.001564 0.940100 -0.110501 0.399212 1.639677 0.823186 1.849867 0.970964 1.815596 0.977295 1.876945 1.029064 0.250663 1.106062 0.440754 1.692440 0.937531 0.143047 1.343876 0.363444 1.897361 0.954251 0.489534 1.687124 1.352147 0.540407 -0.261830 1.349441 0.704373 0.447495 1.734922 1.090380 0.653989 0.307022 1.449780 1.794904 0.808626 0.497093 0.423383 -0.280469 1.640122 1.217125 1.143712 0.677390 0.472908 0.243924 0.123084 -0.178887 1.588534 1.317289 1.403860 1.454850 1.459048 1.165832 1.237401 1.000847 1.421104 1.051039 1.364625 1.447050 1.541757 1.176845 1.530906 1.723380 1.795645 0.095341 0.481918 0.307978 0.454615 1.009308 0.963604 1.200422 1.757436 -0.015019 0.420112 1.020994 1.127410 1.866034 -0.291409 0.497289 1.096855)
;; 100+1
- 9.928334 #(0.000000 0.665967 0.808488 -0.299452 1.814455 0.103115 0.907176 1.394075 1.630101 0.900795 0.296519 0.962833 -0.433738 0.560295 0.666980 1.835154 -0.279839 -0.031634 1.784110 1.588290 1.067637 -0.084296 0.498781 -0.141826 0.313843 1.417194 0.278161 1.651147 1.555702 0.978173 1.181141 1.302529 1.194189 0.828430 1.413184 0.866774 0.480085 0.297646 1.211562 0.387667 0.067199 -0.347159 0.722985 0.483741 1.855309 -0.030363 1.226310 0.179911 0.429117 0.527809 -0.278101 1.140370 1.021869 1.189527 0.283868 0.208805 -0.049884 -0.127424 -0.115078 0.078040 0.263018 0.600699 1.081708 0.738634 0.138893 1.341511 -0.222681 0.831975 0.385157 -0.493602 0.352038 0.759227 1.590774 0.426044 1.540029 0.849237 1.363690 1.556222 0.415629 0.866591 1.752437 -0.973681 1.445077 1.553262 -0.064956 0.403839 1.648532 -0.192842 0.191551 1.416306 0.656144 1.672848 1.613529 0.059245 1.705726 0.684303 1.153859 1.402257 1.265878 0.157130 -0.103303)
+ 9.928334 #r(0.000000 0.665967 0.808488 -0.299452 1.814455 0.103115 0.907176 1.394075 1.630101 0.900795 0.296519 0.962833 -0.433738 0.560295 0.666980 1.835154 -0.279839 -0.031634 1.784110 1.588290 1.067637 -0.084296 0.498781 -0.141826 0.313843 1.417194 0.278161 1.651147 1.555702 0.978173 1.181141 1.302529 1.194189 0.828430 1.413184 0.866774 0.480085 0.297646 1.211562 0.387667 0.067199 -0.347159 0.722985 0.483741 1.855309 -0.030363 1.226310 0.179911 0.429117 0.527809 -0.278101 1.140370 1.021869 1.189527 0.283868 0.208805 -0.049884 -0.127424 -0.115078 0.078040 0.263018 0.600699 1.081708 0.738634 0.138893 1.341511 -0.222681 0.831975 0.385157 -0.493602 0.352038 0.759227 1.590774 0.426044 1.540029 0.849237 1.363690 1.556222 0.415629 0.866591 1.752437 -0.973681 1.445077 1.553262 -0.064956 0.403839 1.648532 -0.192842 0.191551 1.416306 0.656144 1.672848 1.613529 0.059245 1.705726 0.684303 1.153859 1.402257 1.265878 0.157130 -0.103303)
- 9.923211 #(0.000000 0.606742 0.854252 -0.177107 1.717126 0.126638 0.927513 1.476397 1.664457 0.956378 0.451133 0.780343 -0.425380 0.274120 0.819410 1.770573 -0.423863 -0.102054 1.673610 1.665172 0.958864 0.002206 0.371610 0.035190 0.215930 1.472185 0.267288 1.510818 1.485723 0.910446 1.171075 1.613295 1.124870 0.735294 1.425415 0.799763 0.800290 0.148538 1.137687 0.418827 0.153019 -0.025494 0.839196 0.398827 1.841432 -0.009078 1.453123 0.257094 0.733715 0.627138 -0.121791 1.284946 1.399290 1.158477 0.423864 0.225825 -0.032272 -0.147351 -0.167399 -0.074160 0.282590 0.763953 0.741827 0.899306 0.215637 1.297259 -0.216774 0.533894 0.471905 -0.440553 0.570270 0.815305 1.465352 0.243327 1.458778 0.617832 1.630736 1.654231 0.454113 0.835126 1.701784 -0.680319 1.360576 1.516060 0.138474 0.422235 1.535120 1.717955 0.034676 1.563572 0.571682 1.668014 1.359079 0.300267 1.569925 0.710452 1.497267 1.484788 1.467677 0.005121 0.068300)
- 9.921866 #(0.000000 0.609806 0.853415 -0.178376 1.715639 0.125045 0.929898 1.476379 1.662595 0.957740 0.451135 0.781655 -0.427268 0.272758 0.818830 1.769523 -0.423916 -0.099803 1.673197 1.666031 0.957481 0.001110 0.369464 0.033970 0.216228 1.474165 0.268320 1.512523 1.483804 0.905565 1.174848 1.613266 1.125148 0.735425 1.428468 0.800602 0.802242 0.149205 1.137841 0.417883 0.150486 -0.027202 0.838573 0.398456 1.843236 -0.009638 1.452756 0.256842 0.733285 0.629225 -0.121467 1.285077 1.401085 1.159273 0.424114 0.225501 -0.029926 -0.145884 -0.166779 -0.070962 0.279800 0.763832 0.738411 0.899842 0.214924 1.297806 -0.216209 0.533724 0.471481 -0.437480 0.570518 0.814214 1.466310 0.243161 1.457087 0.616447 1.631480 1.653547 0.454623 0.836976 1.700774 -0.681521 1.358712 1.514908 0.139939 0.422637 1.532737 1.719310 0.035224 1.562793 0.575545 1.665604 1.357164 0.300428 1.567753 0.710501 1.494752 1.484684 1.466794 0.007458 0.066101)
+ 9.923211 #r(0.000000 0.606742 0.854252 -0.177107 1.717126 0.126638 0.927513 1.476397 1.664457 0.956378 0.451133 0.780343 -0.425380 0.274120 0.819410 1.770573 -0.423863 -0.102054 1.673610 1.665172 0.958864 0.002206 0.371610 0.035190 0.215930 1.472185 0.267288 1.510818 1.485723 0.910446 1.171075 1.613295 1.124870 0.735294 1.425415 0.799763 0.800290 0.148538 1.137687 0.418827 0.153019 -0.025494 0.839196 0.398827 1.841432 -0.009078 1.453123 0.257094 0.733715 0.627138 -0.121791 1.284946 1.399290 1.158477 0.423864 0.225825 -0.032272 -0.147351 -0.167399 -0.074160 0.282590 0.763953 0.741827 0.899306 0.215637 1.297259 -0.216774 0.533894 0.471905 -0.440553 0.570270 0.815305 1.465352 0.243327 1.458778 0.617832 1.630736 1.654231 0.454113 0.835126 1.701784 -0.680319 1.360576 1.516060 0.138474 0.422235 1.535120 1.717955 0.034676 1.563572 0.571682 1.668014 1.359079 0.300267 1.569925 0.710452 1.497267 1.484788 1.467677 0.005121 0.068300)
+ 9.921866 #r(0.000000 0.609806 0.853415 -0.178376 1.715639 0.125045 0.929898 1.476379 1.662595 0.957740 0.451135 0.781655 -0.427268 0.272758 0.818830 1.769523 -0.423916 -0.099803 1.673197 1.666031 0.957481 0.001110 0.369464 0.033970 0.216228 1.474165 0.268320 1.512523 1.483804 0.905565 1.174848 1.613266 1.125148 0.735425 1.428468 0.800602 0.802242 0.149205 1.137841 0.417883 0.150486 -0.027202 0.838573 0.398456 1.843236 -0.009638 1.452756 0.256842 0.733285 0.629225 -0.121467 1.285077 1.401085 1.159273 0.424114 0.225501 -0.029926 -0.145884 -0.166779 -0.070962 0.279800 0.763832 0.738411 0.899842 0.214924 1.297806 -0.216209 0.533724 0.471481 -0.437480 0.570518 0.814214 1.466310 0.243161 1.457087 0.616447 1.631480 1.653547 0.454623 0.836976 1.700774 -0.681521 1.358712 1.514908 0.139939 0.422637 1.532737 1.719310 0.035224 1.562793 0.575545 1.665604 1.357164 0.300428 1.567753 0.710501 1.494752 1.484684 1.466794 0.007458 0.066101)
)
;;; 102 all -------------------------------------------------------------------------------- ; 10.0995
-(vector 102 13.194128990173 #(0 0 1 1 1 0 0 0 1 0 0 1 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 1 1 1 0 1 0 0 1 0 1 0 1 0 1 0 0 0)
+(vector 102 13.194128990173 #r(0 0 1 1 1 0 0 0 1 0 0 1 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 1 1 1 0 1 0 0 1 0 1 0 1 0 1 0 0 0)
- 10.088316 #(0.000000 0.095626 0.514266 0.420449 0.749499 0.992394 -0.193393 0.039052 0.057117 1.575374 1.352773 1.322452 0.794003 0.750383 0.756593 0.273089 1.675537 0.407815 0.550801 -0.538502 0.957909 1.336960 1.614983 0.508708 1.910222 1.874209 0.940387 0.222605 0.538045 1.356000 1.741919 0.598382 1.550605 1.131133 0.773140 -0.232481 0.055269 1.822145 0.659426 -0.100655 1.261624 0.557410 0.214081 0.588453 0.458097 0.577319 1.055339 1.792023 0.525700 0.097434 0.222735 0.356704 1.885210 0.037676 0.938171 0.984298 1.949046 1.455206 0.941409 1.068679 0.637889 0.330852 0.138031 1.619860 0.674126 -0.251106 1.183963 1.959835 0.213213 0.066073 0.132459 0.329261 0.847485 0.503486 0.122913 0.684764 1.979054 0.659531 0.231782 1.341252 0.124898 0.707447 -0.419234 0.913042 1.413830 0.741236 1.664719 1.833486 -0.410776 0.347702 1.045974 -0.368342 0.123701 1.012180 1.052039 1.226053 0.364036 1.015550 1.423284 1.022491 0.770674 1.877516)
+ 10.088316 #r(0.000000 0.095626 0.514266 0.420449 0.749499 0.992394 -0.193393 0.039052 0.057117 1.575374 1.352773 1.322452 0.794003 0.750383 0.756593 0.273089 1.675537 0.407815 0.550801 -0.538502 0.957909 1.336960 1.614983 0.508708 1.910222 1.874209 0.940387 0.222605 0.538045 1.356000 1.741919 0.598382 1.550605 1.131133 0.773140 -0.232481 0.055269 1.822145 0.659426 -0.100655 1.261624 0.557410 0.214081 0.588453 0.458097 0.577319 1.055339 1.792023 0.525700 0.097434 0.222735 0.356704 1.885210 0.037676 0.938171 0.984298 1.949046 1.455206 0.941409 1.068679 0.637889 0.330852 0.138031 1.619860 0.674126 -0.251106 1.183963 1.959835 0.213213 0.066073 0.132459 0.329261 0.847485 0.503486 0.122913 0.684764 1.979054 0.659531 0.231782 1.341252 0.124898 0.707447 -0.419234 0.913042 1.413830 0.741236 1.664719 1.833486 -0.410776 0.347702 1.045974 -0.368342 0.123701 1.012180 1.052039 1.226053 0.364036 1.015550 1.423284 1.022491 0.770674 1.877516)
;; pp:
- 10.025038 #(0.000000 0.605553 0.983049 1.667341 0.280594 0.813730 1.347579 0.067151 0.773566 1.170135 -0.000437 0.776577 1.339736 0.097477 0.851330 1.565309 0.392180 1.136191 -0.027326 0.943192 1.737718 0.813011 1.699444 0.599876 1.617440 0.776150 1.855177 0.961431 1.915827 0.882986 1.666203 0.596064 -0.104064 1.326950 0.560052 1.687567 0.667080 1.807593 1.118197 0.382149 1.651756 0.780071 0.152645 1.439416 0.767927 0.282152 1.693680 1.210781 0.759553 0.009785 1.134002 0.817236 0.333315 0.071267 1.596603 1.242164 0.957402 0.421360 -0.130961 1.394848 1.288611 0.865712 0.865151 0.398958 0.298422 -0.229411 1.889300 1.384404 1.672436 1.144983 1.294122 0.887806 0.874167 0.414036 1.058747 0.759420 0.922388 0.730377 0.900207 0.658168 0.691340 0.678324 0.551776 0.884009 1.344859 1.136367 1.415423 1.606731 1.827838 -0.020510 0.115669 0.332208 0.674134 1.028023 1.276947 1.696675 0.283199 0.564387 1.040113 1.365277 -0.292333 0.240887)
+ 10.025038 #r(0.000000 0.605553 0.983049 1.667341 0.280594 0.813730 1.347579 0.067151 0.773566 1.170135 -0.000437 0.776577 1.339736 0.097477 0.851330 1.565309 0.392180 1.136191 -0.027326 0.943192 1.737718 0.813011 1.699444 0.599876 1.617440 0.776150 1.855177 0.961431 1.915827 0.882986 1.666203 0.596064 -0.104064 1.326950 0.560052 1.687567 0.667080 1.807593 1.118197 0.382149 1.651756 0.780071 0.152645 1.439416 0.767927 0.282152 1.693680 1.210781 0.759553 0.009785 1.134002 0.817236 0.333315 0.071267 1.596603 1.242164 0.957402 0.421360 -0.130961 1.394848 1.288611 0.865712 0.865151 0.398958 0.298422 -0.229411 1.889300 1.384404 1.672436 1.144983 1.294122 0.887806 0.874167 0.414036 1.058747 0.759420 0.922388 0.730377 0.900207 0.658168 0.691340 0.678324 0.551776 0.884009 1.344859 1.136367 1.415423 1.606731 1.827838 -0.020510 0.115669 0.332208 0.674134 1.028023 1.276947 1.696675 0.283199 0.564387 1.040113 1.365277 -0.292333 0.240887)
;; 100+2
- 10.002736 #(0.000000 0.694136 0.884286 -0.019865 1.949416 0.045647 0.784966 1.485288 1.831237 1.096539 0.463002 1.083013 -0.121170 0.359435 0.652933 1.645807 -0.422716 -0.232256 1.626278 1.440555 0.958131 0.134457 0.490737 0.007571 0.357050 1.752163 0.151816 1.558855 1.454026 0.987545 1.222854 1.687668 1.100248 0.567262 1.370806 0.848200 0.795775 0.373350 1.291901 0.405117 0.336479 0.081039 0.805242 0.490027 1.710694 0.189571 1.425039 0.086172 0.763664 0.606525 0.069586 1.531524 1.275494 1.130168 0.349598 0.298878 -0.039090 -0.285912 -0.120615 0.138896 0.355171 0.409218 0.795399 0.792160 0.288768 1.170359 -0.260392 0.351573 0.565468 -0.250055 0.636086 0.568462 1.596076 0.355472 1.258735 0.969838 1.592115 1.783400 0.530721 0.636731 1.503600 -0.690920 1.599651 1.373458 0.089786 0.445422 1.295129 1.885568 0.290790 1.482001 0.849877 1.956561 1.126285 0.177909 1.515702 0.760935 1.535581 1.648591 1.330225 0.034311 0.125802 -0.263447)
+ 10.002736 #r(0.000000 0.694136 0.884286 -0.019865 1.949416 0.045647 0.784966 1.485288 1.831237 1.096539 0.463002 1.083013 -0.121170 0.359435 0.652933 1.645807 -0.422716 -0.232256 1.626278 1.440555 0.958131 0.134457 0.490737 0.007571 0.357050 1.752163 0.151816 1.558855 1.454026 0.987545 1.222854 1.687668 1.100248 0.567262 1.370806 0.848200 0.795775 0.373350 1.291901 0.405117 0.336479 0.081039 0.805242 0.490027 1.710694 0.189571 1.425039 0.086172 0.763664 0.606525 0.069586 1.531524 1.275494 1.130168 0.349598 0.298878 -0.039090 -0.285912 -0.120615 0.138896 0.355171 0.409218 0.795399 0.792160 0.288768 1.170359 -0.260392 0.351573 0.565468 -0.250055 0.636086 0.568462 1.596076 0.355472 1.258735 0.969838 1.592115 1.783400 0.530721 0.636731 1.503600 -0.690920 1.599651 1.373458 0.089786 0.445422 1.295129 1.885568 0.290790 1.482001 0.849877 1.956561 1.126285 0.177909 1.515702 0.760935 1.535581 1.648591 1.330225 0.034311 0.125802 -0.263447)
;; 103-1
- 10.005473 #(0.000000 0.838980 0.811821 0.292160 0.449079 -0.307282 0.933362 1.480374 0.208636 0.701613 0.433885 0.738788 -0.163196 0.069086 0.180351 0.129560 1.658816 0.937982 1.725598 -0.219727 -0.190210 1.475660 0.996768 1.327001 1.275781 -0.030914 0.689923 1.387993 1.194676 1.062303 0.447502 0.886918 1.035286 0.766146 0.099314 0.250142 -0.386195 1.501334 1.121681 1.274635 0.640345 -0.611023 0.450001 1.019627 1.440522 0.697300 -0.023140 1.283472 0.279581 1.393780 1.586139 0.993131 1.208457 1.548968 0.100477 1.174748 1.104071 0.743429 1.496343 0.272839 1.548385 0.798045 1.490342 1.777682 1.368501 0.822008 0.267053 0.794202 0.107460 1.499345 0.867964 1.491427 -0.097215 1.533169 0.402921 0.270250 -0.257992 0.733165 0.362933 1.318893 1.077996 -0.215798 0.338811 0.219994 0.763092 0.618092 0.499119 0.751451 1.206091 1.662182 0.980493 1.134808 0.914764 1.670832 0.950703 1.641772 -0.118915 0.240632 1.010529 0.168161 0.110520 0.996952)
+ 10.005473 #r(0.000000 0.838980 0.811821 0.292160 0.449079 -0.307282 0.933362 1.480374 0.208636 0.701613 0.433885 0.738788 -0.163196 0.069086 0.180351 0.129560 1.658816 0.937982 1.725598 -0.219727 -0.190210 1.475660 0.996768 1.327001 1.275781 -0.030914 0.689923 1.387993 1.194676 1.062303 0.447502 0.886918 1.035286 0.766146 0.099314 0.250142 -0.386195 1.501334 1.121681 1.274635 0.640345 -0.611023 0.450001 1.019627 1.440522 0.697300 -0.023140 1.283472 0.279581 1.393780 1.586139 0.993131 1.208457 1.548968 0.100477 1.174748 1.104071 0.743429 1.496343 0.272839 1.548385 0.798045 1.490342 1.777682 1.368501 0.822008 0.267053 0.794202 0.107460 1.499345 0.867964 1.491427 -0.097215 1.533169 0.402921 0.270250 -0.257992 0.733165 0.362933 1.318893 1.077996 -0.215798 0.338811 0.219994 0.763092 0.618092 0.499119 0.751451 1.206091 1.662182 0.980493 1.134808 0.914764 1.670832 0.950703 1.641772 -0.118915 0.240632 1.010529 0.168161 0.110520 0.996952)
- 9.999728 #(0.000000 0.816321 0.637377 0.345148 0.370938 -0.276054 0.911607 1.500056 0.306062 0.790557 0.435222 0.904894 -0.191779 0.048392 0.194431 0.115956 1.667616 0.992921 1.656976 -0.052697 -0.117059 1.375805 0.940264 1.270518 1.293832 0.011597 0.625970 1.355481 1.224093 1.039601 0.449887 0.805739 0.950859 0.738520 0.174875 0.191457 -0.433487 1.473827 1.049203 1.269233 0.624622 -0.685355 0.429236 0.942447 1.442405 0.657046 -0.121011 1.211024 0.340089 1.400597 1.568255 1.012470 1.153465 1.450019 0.074731 1.166228 1.006182 0.717416 1.410198 0.328986 1.433746 0.699736 1.482788 1.837097 1.328917 0.778439 0.165472 0.752659 0.035502 1.456631 0.791084 1.409037 -0.237446 1.429494 0.422722 0.146817 -0.260727 0.839136 0.358089 1.270740 1.006772 -0.235207 0.256828 0.253288 0.716702 0.519351 0.455918 0.685843 1.184617 1.591454 0.861383 1.138751 0.863117 1.629288 0.841736 1.491610 -0.065444 0.127160 0.950055 0.171078 0.161369 0.979305)
+ 9.999728 #r(0.000000 0.816321 0.637377 0.345148 0.370938 -0.276054 0.911607 1.500056 0.306062 0.790557 0.435222 0.904894 -0.191779 0.048392 0.194431 0.115956 1.667616 0.992921 1.656976 -0.052697 -0.117059 1.375805 0.940264 1.270518 1.293832 0.011597 0.625970 1.355481 1.224093 1.039601 0.449887 0.805739 0.950859 0.738520 0.174875 0.191457 -0.433487 1.473827 1.049203 1.269233 0.624622 -0.685355 0.429236 0.942447 1.442405 0.657046 -0.121011 1.211024 0.340089 1.400597 1.568255 1.012470 1.153465 1.450019 0.074731 1.166228 1.006182 0.717416 1.410198 0.328986 1.433746 0.699736 1.482788 1.837097 1.328917 0.778439 0.165472 0.752659 0.035502 1.456631 0.791084 1.409037 -0.237446 1.429494 0.422722 0.146817 -0.260727 0.839136 0.358089 1.270740 1.006772 -0.235207 0.256828 0.253288 0.716702 0.519351 0.455918 0.685843 1.184617 1.591454 0.861383 1.138751 0.863117 1.629288 0.841736 1.491610 -0.065444 0.127160 0.950055 0.171078 0.161369 0.979305)
)
;;; 103 all -------------------------------------------------------------------------------- ; 10.1489
-(vector 103 13.435972213745 #(0 1 1 0 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 1 0 1 0 0 0 0 1 0 0 0 1 1 0 0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 1 1 0 1 1 0 0 1 0 1)
+(vector 103 13.435972213745 #r(0 1 1 0 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 1 0 1 0 0 0 0 1 0 0 0 1 1 0 0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 1 1 0 1 1 0 0 1 0 1)
- 10.072606 #(0.000000 0.775992 0.789071 0.551328 0.298530 -0.168268 0.810417 1.541024 0.478641 0.826848 0.407673 0.769783 0.052469 0.071330 0.252339 -0.003477 1.565238 1.042251 1.681717 0.063581 0.058867 1.442741 0.917343 1.448313 1.294486 -0.061724 0.478951 1.132882 1.128620 1.082449 0.123678 0.578486 1.003285 0.918654 0.241363 0.278868 -0.414912 1.418211 0.927244 1.134797 0.489863 -0.664481 0.529310 0.940119 1.393533 0.416277 0.044802 1.197865 0.283028 1.514978 1.590639 1.159829 1.236485 1.237279 0.109313 1.090962 1.341243 0.602478 1.179629 0.285726 1.482652 0.648833 1.308230 1.743441 1.346535 0.727031 0.061582 0.907076 -0.185896 1.479865 0.775766 1.389852 -0.161651 1.518832 0.594834 0.022777 -0.099476 0.851631 0.289254 1.413652 0.958286 -0.309988 0.125895 0.222920 0.633318 0.584266 0.503924 0.660246 1.182087 1.319466 1.213616 1.220516 0.662413 1.589230 0.875855 1.466144 0.036061 0.139801 0.986962 0.226038 0.202950 0.978447 0.999923)
- 9.939365 #(0.000000 0.794367 0.781191 0.495064 0.495230 -0.388009 0.971616 1.347277 0.328242 0.741267 0.530537 1.078181 -0.237622 0.107581 0.258589 0.255024 1.565355 1.278328 1.789249 -0.140007 -0.199710 1.294397 0.953960 1.338212 1.138392 0.017529 0.484971 1.300470 1.202522 0.969811 0.455432 0.750845 0.761123 0.668283 0.289374 0.280222 -0.329630 1.253548 0.930314 1.087111 0.685593 -0.730896 0.513015 0.942289 1.448130 0.624245 -0.099966 1.306897 0.278573 1.322888 1.648294 0.849613 1.245918 1.545777 -0.106941 1.147216 0.903444 0.450981 1.376132 0.256174 1.368394 0.763297 1.355029 1.779789 1.255780 0.812388 0.170237 0.940509 -0.017353 1.623185 0.693251 1.320359 -0.226935 1.435723 0.278225 0.247083 -0.427620 0.856951 0.463721 1.355469 0.897870 -0.255243 0.194551 0.144239 0.768570 0.690462 0.453432 0.766815 1.332179 1.485970 0.855947 1.311144 0.868609 1.737822 0.574654 1.449286 -0.052990 0.247284 0.755917 0.347662 0.133411 0.978837 1.128108)
- 9.938814 #(0.000000 0.794369 0.781179 0.494978 0.495207 -0.387960 0.971662 1.347297 0.328234 0.741307 0.530523 1.078218 -0.237594 0.107602 0.258606 0.255021 1.565400 1.278380 1.789238 -0.140020 -0.199735 1.294381 0.953983 1.338265 1.138336 0.017495 0.485041 1.300450 1.202504 0.969724 0.455427 0.750931 0.761094 0.668250 0.289329 0.280179 -0.329611 1.253574 0.930366 1.087063 0.685627 -0.730833 0.513027 0.942251 1.448095 0.624348 -0.100009 1.306860 0.278533 1.322852 1.648329 0.849694 1.245891 1.545774 -0.106935 1.147152 0.903447 0.451005 1.376091 0.256221 1.368425 0.763333 1.355003 1.779765 1.255779 0.812329 0.170135 0.940480 -0.017373 1.623180 0.693238 1.320324 -0.226936 1.435741 0.278227 0.247217 -0.427735 0.856978 0.463701 1.355420 0.897766 -0.255204 0.194551 0.144265 0.768579 0.690419 0.453417 0.766802 1.332201 1.485955 0.855932 1.311069 0.868635 1.737826 0.574603 1.449298 -0.053025 0.247307 0.755792 0.347674 0.133379 0.978880 1.128060)
+ 10.072606 #r(0.000000 0.775992 0.789071 0.551328 0.298530 -0.168268 0.810417 1.541024 0.478641 0.826848 0.407673 0.769783 0.052469 0.071330 0.252339 -0.003477 1.565238 1.042251 1.681717 0.063581 0.058867 1.442741 0.917343 1.448313 1.294486 -0.061724 0.478951 1.132882 1.128620 1.082449 0.123678 0.578486 1.003285 0.918654 0.241363 0.278868 -0.414912 1.418211 0.927244 1.134797 0.489863 -0.664481 0.529310 0.940119 1.393533 0.416277 0.044802 1.197865 0.283028 1.514978 1.590639 1.159829 1.236485 1.237279 0.109313 1.090962 1.341243 0.602478 1.179629 0.285726 1.482652 0.648833 1.308230 1.743441 1.346535 0.727031 0.061582 0.907076 -0.185896 1.479865 0.775766 1.389852 -0.161651 1.518832 0.594834 0.022777 -0.099476 0.851631 0.289254 1.413652 0.958286 -0.309988 0.125895 0.222920 0.633318 0.584266 0.503924 0.660246 1.182087 1.319466 1.213616 1.220516 0.662413 1.589230 0.875855 1.466144 0.036061 0.139801 0.986962 0.226038 0.202950 0.978447 0.999923)
+ 9.939365 #r(0.000000 0.794367 0.781191 0.495064 0.495230 -0.388009 0.971616 1.347277 0.328242 0.741267 0.530537 1.078181 -0.237622 0.107581 0.258589 0.255024 1.565355 1.278328 1.789249 -0.140007 -0.199710 1.294397 0.953960 1.338212 1.138392 0.017529 0.484971 1.300470 1.202522 0.969811 0.455432 0.750845 0.761123 0.668283 0.289374 0.280222 -0.329630 1.253548 0.930314 1.087111 0.685593 -0.730896 0.513015 0.942289 1.448130 0.624245 -0.099966 1.306897 0.278573 1.322888 1.648294 0.849613 1.245918 1.545777 -0.106941 1.147216 0.903444 0.450981 1.376132 0.256174 1.368394 0.763297 1.355029 1.779789 1.255780 0.812388 0.170237 0.940509 -0.017353 1.623185 0.693251 1.320359 -0.226935 1.435723 0.278225 0.247083 -0.427620 0.856951 0.463721 1.355469 0.897870 -0.255243 0.194551 0.144239 0.768570 0.690462 0.453432 0.766815 1.332179 1.485970 0.855947 1.311144 0.868609 1.737822 0.574654 1.449286 -0.052990 0.247284 0.755917 0.347662 0.133411 0.978837 1.128108)
+ 9.938814 #r(0.000000 0.794369 0.781179 0.494978 0.495207 -0.387960 0.971662 1.347297 0.328234 0.741307 0.530523 1.078218 -0.237594 0.107602 0.258606 0.255021 1.565400 1.278380 1.789238 -0.140020 -0.199735 1.294381 0.953983 1.338265 1.138336 0.017495 0.485041 1.300450 1.202504 0.969724 0.455427 0.750931 0.761094 0.668250 0.289329 0.280179 -0.329611 1.253574 0.930366 1.087063 0.685627 -0.730833 0.513027 0.942251 1.448095 0.624348 -0.100009 1.306860 0.278533 1.322852 1.648329 0.849694 1.245891 1.545774 -0.106935 1.147152 0.903447 0.451005 1.376091 0.256221 1.368425 0.763333 1.355003 1.779765 1.255779 0.812329 0.170135 0.940480 -0.017373 1.623180 0.693238 1.320324 -0.226936 1.435741 0.278227 0.247217 -0.427735 0.856978 0.463701 1.355420 0.897766 -0.255204 0.194551 0.144265 0.768579 0.690419 0.453417 0.766802 1.332201 1.485955 0.855932 1.311069 0.868635 1.737826 0.574603 1.449298 -0.053025 0.247307 0.755792 0.347674 0.133379 0.978880 1.128060)
- 9.936450 #(0.000000 0.693644 0.706899 0.533961 0.430990 -0.357687 1.008502 1.374702 0.412678 0.741797 0.480081 1.019998 -0.130973 0.053049 0.311034 0.176361 1.575930 1.070088 1.721818 -0.094212 -0.064284 1.475356 0.919353 1.359786 1.249341 0.013083 0.514667 1.199770 1.229977 1.008921 0.437274 0.710316 0.870077 0.789348 0.187900 0.290913 -0.370061 1.358992 0.912977 1.233039 0.528258 -0.736479 0.451532 0.908453 1.426336 0.514161 0.001487 1.299314 0.308671 1.371317 1.605556 0.910902 1.236094 1.469478 -0.163740 1.081131 1.027298 0.436227 1.399959 0.293762 1.463416 0.759976 1.365407 1.783410 1.210381 0.856808 0.150643 0.958655 -0.052444 1.555663 0.803912 1.301037 -0.234888 1.489758 0.433564 0.214734 -0.174858 0.935477 0.468519 1.406960 1.062581 -0.199662 0.290782 0.285152 0.771353 0.684526 0.389441 0.762788 1.291542 1.444611 0.892838 1.229118 0.775000 1.690738 0.620913 1.533937 -0.049548 0.336829 0.889832 0.374353 0.184623 1.007735 1.061825)
+ 9.936450 #r(0.000000 0.693644 0.706899 0.533961 0.430990 -0.357687 1.008502 1.374702 0.412678 0.741797 0.480081 1.019998 -0.130973 0.053049 0.311034 0.176361 1.575930 1.070088 1.721818 -0.094212 -0.064284 1.475356 0.919353 1.359786 1.249341 0.013083 0.514667 1.199770 1.229977 1.008921 0.437274 0.710316 0.870077 0.789348 0.187900 0.290913 -0.370061 1.358992 0.912977 1.233039 0.528258 -0.736479 0.451532 0.908453 1.426336 0.514161 0.001487 1.299314 0.308671 1.371317 1.605556 0.910902 1.236094 1.469478 -0.163740 1.081131 1.027298 0.436227 1.399959 0.293762 1.463416 0.759976 1.365407 1.783410 1.210381 0.856808 0.150643 0.958655 -0.052444 1.555663 0.803912 1.301037 -0.234888 1.489758 0.433564 0.214734 -0.174858 0.935477 0.468519 1.406960 1.062581 -0.199662 0.290782 0.285152 0.771353 0.684526 0.389441 0.762788 1.291542 1.444611 0.892838 1.229118 0.775000 1.690738 0.620913 1.533937 -0.049548 0.336829 0.889832 0.374353 0.184623 1.007735 1.061825)
)
;;; 104 all -------------------------------------------------------------------------------- ; 10.1980
-(vector 104 13.330215043333 #(0 1 1 1 1 1 0 0 1 1 1 1 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 0 0 1 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 1 0 1 1 0 1 1 1 1 1 0)
+(vector 104 13.330215043333 #r(0 1 1 1 1 1 0 0 1 1 1 1 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 0 0 1 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 1 0 1 1 0 1 1 1 1 1 0)
- 10.124244 #(0.000000 1.622675 1.706946 0.969141 1.395974 1.097698 0.150298 1.207570 1.449278 0.836769 1.526696 -0.147627 1.089028 1.314193 0.833408 0.265551 0.958522 0.397626 0.447242 0.837858 1.676927 0.883730 1.604731 0.779720 0.388122 0.713835 1.704244 0.052983 0.837107 0.054588 0.549459 0.093126 1.768139 0.144405 0.937970 0.532416 -0.149569 1.622840 1.586484 0.686471 0.830291 0.095651 0.908595 0.259853 -0.301519 0.855324 -0.014912 0.748872 1.538644 -0.030037 0.020462 0.792578 0.531283 0.625746 0.346250 0.434570 0.703831 1.586850 1.489275 1.435865 0.300417 1.125540 0.355002 0.123270 0.728375 0.039493 1.718698 1.307117 0.118823 0.358408 0.405752 1.413026 1.454448 0.630369 0.900592 1.792896 1.090807 1.061221 1.814531 1.630768 0.510555 0.618481 1.214968 0.122072 0.455822 1.727623 0.073245 -0.177442 0.329678 1.542732 1.673278 -0.469931 -0.007785 0.142142 0.231493 0.623628 0.711468 0.673585 0.185009 1.333716 0.659875 0.472080 1.635059 0.745116)
+ 10.124244 #r(0.000000 1.622675 1.706946 0.969141 1.395974 1.097698 0.150298 1.207570 1.449278 0.836769 1.526696 -0.147627 1.089028 1.314193 0.833408 0.265551 0.958522 0.397626 0.447242 0.837858 1.676927 0.883730 1.604731 0.779720 0.388122 0.713835 1.704244 0.052983 0.837107 0.054588 0.549459 0.093126 1.768139 0.144405 0.937970 0.532416 -0.149569 1.622840 1.586484 0.686471 0.830291 0.095651 0.908595 0.259853 -0.301519 0.855324 -0.014912 0.748872 1.538644 -0.030037 0.020462 0.792578 0.531283 0.625746 0.346250 0.434570 0.703831 1.586850 1.489275 1.435865 0.300417 1.125540 0.355002 0.123270 0.728375 0.039493 1.718698 1.307117 0.118823 0.358408 0.405752 1.413026 1.454448 0.630369 0.900592 1.792896 1.090807 1.061221 1.814531 1.630768 0.510555 0.618481 1.214968 0.122072 0.455822 1.727623 0.073245 -0.177442 0.329678 1.542732 1.673278 -0.469931 -0.007785 0.142142 0.231493 0.623628 0.711468 0.673585 0.185009 1.333716 0.659875 0.472080 1.635059 0.745116)
;; 103+1
- 10.017665 #(0.000000 0.745584 0.754703 0.591172 0.316730 -0.304771 0.899483 1.291576 0.545676 0.772500 0.260173 0.994469 0.010841 -0.025249 0.470119 -0.206891 1.625251 1.051634 1.804633 -0.290226 0.044365 1.520714 1.169280 1.579603 1.507492 -0.098599 0.554837 1.115406 1.434064 1.033197 0.173666 0.501633 0.832630 0.961445 0.155427 0.671127 -0.251235 1.186810 0.870334 0.942028 0.540752 -0.482588 0.541485 1.032711 1.176554 0.575710 0.196807 1.247991 -0.309114 1.373943 1.309961 0.661994 1.095118 1.475934 -0.067967 1.122540 1.395244 0.408007 1.356964 0.251346 1.416704 0.875598 1.007338 1.720110 0.906456 0.746887 0.314809 1.255942 0.123637 1.421756 0.602684 1.336186 -0.397992 1.545369 0.942007 -0.105531 0.032651 0.903727 0.429977 1.262458 1.203957 -0.177847 0.186686 0.130438 0.458904 0.322547 0.256233 0.884282 1.238120 1.393593 1.126188 1.032025 0.626466 1.697238 0.820645 1.808108 -0.040709 0.161290 1.012239 0.476207 0.102979 0.908021 1.239960 0.369493)
- 10.017453 #(0.000000 0.745577 0.754726 0.591226 0.316735 -0.304732 0.899502 1.291541 0.545628 0.772480 0.260199 0.994494 0.010830 -0.025236 0.470134 -0.206891 1.625282 1.051660 1.804596 -0.290274 0.044351 1.520736 1.169238 1.579583 1.507532 -0.098601 0.554891 1.115436 1.434077 1.033226 0.173646 0.501686 0.832596 0.961466 0.155369 0.671140 -0.251224 1.186790 0.870343 0.942036 0.540730 -0.482603 0.541428 1.032737 1.176541 0.575710 0.196818 1.248017 -0.309128 1.373931 1.309926 0.661951 1.095129 1.475952 -0.067947 1.122542 1.395225 0.407986 1.356975 0.251359 1.416747 0.875553 1.007359 1.720145 0.906470 0.746959 0.314821 1.255928 0.123650 1.421810 0.602637 1.336189 -0.398002 1.545393 0.941942 -0.105497 0.032645 0.903719 0.429973 1.262454 1.203968 -0.177843 0.186621 0.130389 0.458896 0.322543 0.256192 0.884272 1.238132 1.393568 1.126227 1.031989 0.626539 1.697275 0.820678 1.808099 -0.040685 0.161330 1.012238 0.476235 0.102962 0.907998 1.239960 0.369514)
+ 10.017665 #r(0.000000 0.745584 0.754703 0.591172 0.316730 -0.304771 0.899483 1.291576 0.545676 0.772500 0.260173 0.994469 0.010841 -0.025249 0.470119 -0.206891 1.625251 1.051634 1.804633 -0.290226 0.044365 1.520714 1.169280 1.579603 1.507492 -0.098599 0.554837 1.115406 1.434064 1.033197 0.173666 0.501633 0.832630 0.961445 0.155427 0.671127 -0.251235 1.186810 0.870334 0.942028 0.540752 -0.482588 0.541485 1.032711 1.176554 0.575710 0.196807 1.247991 -0.309114 1.373943 1.309961 0.661994 1.095118 1.475934 -0.067967 1.122540 1.395244 0.408007 1.356964 0.251346 1.416704 0.875598 1.007338 1.720110 0.906456 0.746887 0.314809 1.255942 0.123637 1.421756 0.602684 1.336186 -0.397992 1.545369 0.942007 -0.105531 0.032651 0.903727 0.429977 1.262458 1.203957 -0.177847 0.186686 0.130438 0.458904 0.322547 0.256233 0.884282 1.238120 1.393593 1.126188 1.032025 0.626466 1.697238 0.820645 1.808108 -0.040709 0.161290 1.012239 0.476207 0.102979 0.908021 1.239960 0.369493)
+ 10.017453 #r(0.000000 0.745577 0.754726 0.591226 0.316735 -0.304732 0.899502 1.291541 0.545628 0.772480 0.260199 0.994494 0.010830 -0.025236 0.470134 -0.206891 1.625282 1.051660 1.804596 -0.290274 0.044351 1.520736 1.169238 1.579583 1.507532 -0.098601 0.554891 1.115436 1.434077 1.033226 0.173646 0.501686 0.832596 0.961466 0.155369 0.671140 -0.251224 1.186790 0.870343 0.942036 0.540730 -0.482603 0.541428 1.032737 1.176541 0.575710 0.196818 1.248017 -0.309128 1.373931 1.309926 0.661951 1.095129 1.475952 -0.067947 1.122542 1.395225 0.407986 1.356975 0.251359 1.416747 0.875553 1.007359 1.720145 0.906470 0.746959 0.314821 1.255928 0.123650 1.421810 0.602637 1.336189 -0.398002 1.545393 0.941942 -0.105497 0.032645 0.903719 0.429973 1.262454 1.203968 -0.177843 0.186621 0.130389 0.458896 0.322543 0.256192 0.884272 1.238132 1.393568 1.126227 1.031989 0.626539 1.697275 0.820678 1.808099 -0.040685 0.161330 1.012238 0.476235 0.102962 0.907998 1.239960 0.369514)
)
;;; 105 all -------------------------------------------------------------------------------- ; 10.2470
-(vector 105 13.595993876506 #(0 1 0 0 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 0 1 0 1 1 1 0 0 1 0 0 0 1 0 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 1 1 1 0 0 1 0)
+(vector 105 13.595993876506 #r(0 1 0 0 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 0 1 0 1 1 1 0 0 1 0 0 0 1 0 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 1 1 1 0 0 1 0)
- 10.169606 #(0.000000 0.591462 0.235800 1.321672 1.356594 -0.405542 0.538022 0.615762 0.326243 1.062550 -0.153260 -0.031444 1.233243 1.770308 1.085997 1.514420 0.095655 1.000755 -0.065552 -0.053493 1.481942 0.777394 0.483679 1.419470 0.159850 -0.259703 0.126983 0.478035 1.178492 1.111834 1.075738 1.268063 0.962249 1.943997 1.083333 1.538989 0.307093 1.387414 1.941208 1.284189 -0.012780 1.356158 1.317824 1.095171 0.472030 0.459214 1.096373 0.477967 0.565821 1.566421 0.590639 1.381435 1.150189 0.197776 0.315906 0.587160 0.629501 0.853485 0.797405 -0.187739 1.489470 1.296970 0.273664 0.102171 1.749652 1.601370 1.902817 1.658081 0.403983 0.138955 1.356476 1.693746 1.125750 0.916183 1.246086 0.386904 -0.248158 0.148664 0.070783 0.819794 -0.019914 0.547099 0.323707 -0.046514 1.635194 0.435105 0.156523 0.390396 -0.277746 0.665321 0.200546 1.082837 1.059380 -0.041536 0.592565 0.634526 1.116414 0.039718 0.575393 -0.178156 1.655927 0.370318 0.615340 1.693958 1.282592)
+ 10.169606 #r(0.000000 0.591462 0.235800 1.321672 1.356594 -0.405542 0.538022 0.615762 0.326243 1.062550 -0.153260 -0.031444 1.233243 1.770308 1.085997 1.514420 0.095655 1.000755 -0.065552 -0.053493 1.481942 0.777394 0.483679 1.419470 0.159850 -0.259703 0.126983 0.478035 1.178492 1.111834 1.075738 1.268063 0.962249 1.943997 1.083333 1.538989 0.307093 1.387414 1.941208 1.284189 -0.012780 1.356158 1.317824 1.095171 0.472030 0.459214 1.096373 0.477967 0.565821 1.566421 0.590639 1.381435 1.150189 0.197776 0.315906 0.587160 0.629501 0.853485 0.797405 -0.187739 1.489470 1.296970 0.273664 0.102171 1.749652 1.601370 1.902817 1.658081 0.403983 0.138955 1.356476 1.693746 1.125750 0.916183 1.246086 0.386904 -0.248158 0.148664 0.070783 0.819794 -0.019914 0.547099 0.323707 -0.046514 1.635194 0.435105 0.156523 0.390396 -0.277746 0.665321 0.200546 1.082837 1.059380 -0.041536 0.592565 0.634526 1.116414 0.039718 0.575393 -0.178156 1.655927 0.370318 0.615340 1.693958 1.282592)
;; 103+2
- 10.064945 #(0.000000 0.682652 0.800210 0.421652 0.554062 -0.360055 0.792317 1.465481 -0.019712 0.697608 0.554698 0.858084 0.164354 -0.019234 0.162952 0.345627 1.621651 0.956217 1.656476 -0.303453 -0.187651 1.271041 0.778998 1.434856 1.150013 -0.072967 0.339790 1.321211 1.320212 0.949083 0.543303 0.516765 0.879307 1.039360 0.093945 0.385943 -0.388725 1.561230 1.166808 1.287025 0.753324 -1.134186 0.285245 0.840389 1.554768 0.666549 -0.096352 0.924158 0.213888 1.502858 1.582784 0.980705 1.341049 1.650316 -0.198796 1.508087 1.243789 0.381493 1.651510 0.258432 1.593643 0.607159 1.330584 1.752940 1.190114 0.752124 0.301833 0.828769 -0.217850 1.553288 0.804465 1.268535 -0.132772 1.463816 0.052920 -0.009087 -0.356015 0.855416 0.196469 1.378625 1.182028 -0.269272 0.104746 0.083642 0.567469 0.929739 0.150765 0.641904 1.229939 1.430161 0.787585 1.158738 0.883860 1.662494 0.756218 1.382603 -0.075116 0.404544 1.158715 0.557851 -0.000464 1.098986 0.925246 -0.557344 -0.464571)
- 10.063561 #(0.000000 0.681917 0.800545 0.422200 0.553031 -0.358791 0.792275 1.464678 -0.019974 0.698355 0.554660 0.858955 0.164181 -0.019183 0.163011 0.345816 1.622067 0.956173 1.657341 -0.303259 -0.187543 1.270627 0.778435 1.434875 1.149544 -0.073515 0.340352 1.321088 1.319472 0.949179 0.543646 0.516189 0.877323 1.039058 0.094178 0.386382 -0.389059 1.561917 1.166614 1.288418 0.753780 -1.134975 0.286121 0.840573 1.554402 0.666717 -0.096764 0.924388 0.213118 1.501876 1.581562 0.980168 1.340301 1.650719 -0.197635 1.506340 1.243795 0.380830 1.653721 0.258877 1.593702 0.606867 1.330583 1.752876 1.189965 0.751133 0.302075 0.827786 -0.217646 1.553498 0.803802 1.267631 -0.133418 1.463956 0.053990 -0.008952 -0.356111 0.855322 0.196092 1.378596 1.181998 -0.269211 0.103217 0.082299 0.566694 0.929139 0.150334 0.640354 1.229212 1.430106 0.787460 1.158173 0.885012 1.662401 0.755054 1.382697 -0.076381 0.402460 1.158400 0.558679 0.000097 1.098492 0.924207 -0.557968 -0.463825)
+ 10.064945 #r(0.000000 0.682652 0.800210 0.421652 0.554062 -0.360055 0.792317 1.465481 -0.019712 0.697608 0.554698 0.858084 0.164354 -0.019234 0.162952 0.345627 1.621651 0.956217 1.656476 -0.303453 -0.187651 1.271041 0.778998 1.434856 1.150013 -0.072967 0.339790 1.321211 1.320212 0.949083 0.543303 0.516765 0.879307 1.039360 0.093945 0.385943 -0.388725 1.561230 1.166808 1.287025 0.753324 -1.134186 0.285245 0.840389 1.554768 0.666549 -0.096352 0.924158 0.213888 1.502858 1.582784 0.980705 1.341049 1.650316 -0.198796 1.508087 1.243789 0.381493 1.651510 0.258432 1.593643 0.607159 1.330584 1.752940 1.190114 0.752124 0.301833 0.828769 -0.217850 1.553288 0.804465 1.268535 -0.132772 1.463816 0.052920 -0.009087 -0.356015 0.855416 0.196469 1.378625 1.182028 -0.269272 0.104746 0.083642 0.567469 0.929739 0.150765 0.641904 1.229939 1.430161 0.787585 1.158738 0.883860 1.662494 0.756218 1.382603 -0.075116 0.404544 1.158715 0.557851 -0.000464 1.098986 0.925246 -0.557344 -0.464571)
+ 10.063561 #r(0.000000 0.681917 0.800545 0.422200 0.553031 -0.358791 0.792275 1.464678 -0.019974 0.698355 0.554660 0.858955 0.164181 -0.019183 0.163011 0.345816 1.622067 0.956173 1.657341 -0.303259 -0.187543 1.270627 0.778435 1.434875 1.149544 -0.073515 0.340352 1.321088 1.319472 0.949179 0.543646 0.516189 0.877323 1.039058 0.094178 0.386382 -0.389059 1.561917 1.166614 1.288418 0.753780 -1.134975 0.286121 0.840573 1.554402 0.666717 -0.096764 0.924388 0.213118 1.501876 1.581562 0.980168 1.340301 1.650719 -0.197635 1.506340 1.243795 0.380830 1.653721 0.258877 1.593702 0.606867 1.330583 1.752876 1.189965 0.751133 0.302075 0.827786 -0.217646 1.553498 0.803802 1.267631 -0.133418 1.463956 0.053990 -0.008952 -0.356111 0.855322 0.196092 1.378596 1.181998 -0.269211 0.103217 0.082299 0.566694 0.929139 0.150334 0.640354 1.229212 1.430106 0.787460 1.158173 0.885012 1.662401 0.755054 1.382697 -0.076381 0.402460 1.158400 0.558679 0.000097 1.098492 0.924207 -0.557968 -0.463825)
)
;;; 106 all -------------------------------------------------------------------------------- ; 10.2956
-(vector 106 13.200031373463 #(0 0 1 0 1 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1)
+(vector 106 13.200031373463 #r(0 0 1 0 1 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1)
- 10.233770 #(0.000000 0.055119 -0.050942 1.221658 1.069634 0.969833 -0.120088 0.537260 0.774846 1.097793 1.607343 1.125046 1.248849 0.110938 0.000911 -0.176700 1.224234 0.974172 0.258380 0.044520 0.328839 0.706861 1.491508 0.262253 0.850888 0.129635 0.528138 0.085967 1.206179 1.203105 -0.212392 0.552998 1.277370 0.069273 1.300991 0.395491 0.052184 1.017350 -0.139116 0.060719 1.223876 0.765705 1.643712 0.809882 1.480192 -0.160266 1.133315 0.396498 1.706614 0.389700 1.530945 1.033706 0.669577 0.953867 0.549025 0.735362 1.230749 1.732990 0.576594 1.599366 0.250495 1.206074 1.016404 1.623424 1.318513 0.223760 1.354914 1.140942 0.138240 0.414002 0.134404 1.756706 -0.015032 -0.196090 0.317193 0.119056 -0.492220 1.081019 0.025882 -0.092539 1.764132 1.357709 0.458311 1.060374 1.019483 -0.126097 0.259596 0.137076 0.020444 0.418031 0.040745 0.523959 1.133024 0.593829 1.429205 1.802013 0.365195 0.248492 1.498863 -0.344913 0.359725 1.657142 1.374238 1.289802 -0.217105 1.333949)
+ 10.233770 #r(0.000000 0.055119 -0.050942 1.221658 1.069634 0.969833 -0.120088 0.537260 0.774846 1.097793 1.607343 1.125046 1.248849 0.110938 0.000911 -0.176700 1.224234 0.974172 0.258380 0.044520 0.328839 0.706861 1.491508 0.262253 0.850888 0.129635 0.528138 0.085967 1.206179 1.203105 -0.212392 0.552998 1.277370 0.069273 1.300991 0.395491 0.052184 1.017350 -0.139116 0.060719 1.223876 0.765705 1.643712 0.809882 1.480192 -0.160266 1.133315 0.396498 1.706614 0.389700 1.530945 1.033706 0.669577 0.953867 0.549025 0.735362 1.230749 1.732990 0.576594 1.599366 0.250495 1.206074 1.016404 1.623424 1.318513 0.223760 1.354914 1.140942 0.138240 0.414002 0.134404 1.756706 -0.015032 -0.196090 0.317193 0.119056 -0.492220 1.081019 0.025882 -0.092539 1.764132 1.357709 0.458311 1.060374 1.019483 -0.126097 0.259596 0.137076 0.020444 0.418031 0.040745 0.523959 1.133024 0.593829 1.429205 1.802013 0.365195 0.248492 1.498863 -0.344913 0.359725 1.657142 1.374238 1.289802 -0.217105 1.333949)
;; 105+1 = 103+3
- 10.179981 #(0.000000 0.771266 0.798162 0.574106 0.509046 -0.454532 0.722646 1.382152 0.188134 0.639741 0.416137 0.934678 0.075406 0.041008 0.256970 0.360043 1.637722 1.021983 1.620165 -0.251506 -0.173651 1.345505 0.774331 1.358020 1.178455 0.048273 0.190944 1.354709 1.390135 0.925530 0.585598 0.586646 0.925457 0.930732 0.084979 0.308249 -0.510277 1.508378 1.202203 1.312776 0.712836 -1.217347 0.291576 1.028994 1.475323 0.702825 -0.072470 0.840094 0.187818 1.417625 1.468715 1.001276 1.223171 1.644290 -0.182504 1.499121 1.198948 0.364839 1.508784 0.234796 1.494133 0.521892 1.439752 1.612444 1.042789 0.871256 0.313132 0.872711 -0.384633 1.449440 0.726706 1.126102 -0.147870 1.347148 0.064771 0.128024 -0.342719 0.813697 0.226743 1.421921 1.020328 -0.362916 0.016145 0.192478 0.585608 0.784156 0.021533 0.652162 0.963185 1.437016 0.624122 1.232038 1.005325 1.412486 0.735986 1.181102 -0.186937 0.322568 1.015044 0.519059 0.114269 1.113254 0.730024 -0.587578 -0.573285 0.170710)
- 10.179541 #(0.000000 0.771216 0.798169 0.574042 0.509021 -0.454539 0.722595 1.382180 0.188162 0.639751 0.416025 0.934627 0.075422 0.041033 0.257004 0.360076 1.637659 1.021990 1.620175 -0.251486 -0.173697 1.345557 0.774305 1.358151 1.178428 0.048243 0.190927 1.354610 1.390083 0.925624 0.585662 0.586630 0.925417 0.930772 0.084986 0.308253 -0.510266 1.508313 1.202180 1.312826 0.712764 -1.217280 0.291519 1.029037 1.475318 0.702806 -0.072479 0.840059 0.187882 1.417657 1.468702 1.001289 1.223142 1.644299 -0.182528 1.499144 1.198899 0.364912 1.508768 0.234745 1.494112 0.521884 1.439753 1.612428 1.042749 0.871259 0.313122 0.872774 -0.384718 1.449386 0.726766 1.126118 -0.147831 1.347158 0.064750 0.128074 -0.342700 0.813748 0.226859 1.421859 1.020298 -0.363011 0.016155 0.192420 0.585619 0.784178 0.021472 0.652147 0.963182 1.437033 0.624162 1.231941 1.005289 1.412507 0.736078 1.181129 -0.186935 0.322466 1.015056 0.519117 0.114263 1.113370 0.730072 -0.587500 -0.573316 0.170672)
+ 10.179981 #r(0.000000 0.771266 0.798162 0.574106 0.509046 -0.454532 0.722646 1.382152 0.188134 0.639741 0.416137 0.934678 0.075406 0.041008 0.256970 0.360043 1.637722 1.021983 1.620165 -0.251506 -0.173651 1.345505 0.774331 1.358020 1.178455 0.048273 0.190944 1.354709 1.390135 0.925530 0.585598 0.586646 0.925457 0.930732 0.084979 0.308249 -0.510277 1.508378 1.202203 1.312776 0.712836 -1.217347 0.291576 1.028994 1.475323 0.702825 -0.072470 0.840094 0.187818 1.417625 1.468715 1.001276 1.223171 1.644290 -0.182504 1.499121 1.198948 0.364839 1.508784 0.234796 1.494133 0.521892 1.439752 1.612444 1.042789 0.871256 0.313132 0.872711 -0.384633 1.449440 0.726706 1.126102 -0.147870 1.347148 0.064771 0.128024 -0.342719 0.813697 0.226743 1.421921 1.020328 -0.362916 0.016145 0.192478 0.585608 0.784156 0.021533 0.652162 0.963185 1.437016 0.624122 1.232038 1.005325 1.412486 0.735986 1.181102 -0.186937 0.322568 1.015044 0.519059 0.114269 1.113254 0.730024 -0.587578 -0.573285 0.170710)
+ 10.179541 #r(0.000000 0.771216 0.798169 0.574042 0.509021 -0.454539 0.722595 1.382180 0.188162 0.639751 0.416025 0.934627 0.075422 0.041033 0.257004 0.360076 1.637659 1.021990 1.620175 -0.251486 -0.173697 1.345557 0.774305 1.358151 1.178428 0.048243 0.190927 1.354610 1.390083 0.925624 0.585662 0.586630 0.925417 0.930772 0.084986 0.308253 -0.510266 1.508313 1.202180 1.312826 0.712764 -1.217280 0.291519 1.029037 1.475318 0.702806 -0.072479 0.840059 0.187882 1.417657 1.468702 1.001289 1.223142 1.644299 -0.182528 1.499144 1.198899 0.364912 1.508768 0.234745 1.494112 0.521884 1.439753 1.612428 1.042749 0.871259 0.313122 0.872774 -0.384718 1.449386 0.726766 1.126118 -0.147831 1.347158 0.064750 0.128074 -0.342700 0.813748 0.226859 1.421859 1.020298 -0.363011 0.016155 0.192420 0.585619 0.784178 0.021472 0.652147 0.963182 1.437033 0.624162 1.231941 1.005289 1.412507 0.736078 1.181129 -0.186935 0.322466 1.015056 0.519117 0.114263 1.113370 0.730072 -0.587500 -0.573316 0.170672)
)
;;; 107 all -------------------------------------------------------------------------------- ; 10.3441
-(vector 107 13.224366750161 #(0 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1)
+(vector 107 13.224366750161 #r(0 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1)
- 10.273899 #(0.000000 1.285870 0.722685 1.695642 1.789973 0.495199 0.001511 0.648393 1.565696 0.756830 0.421656 -0.184836 0.187469 1.381401 1.501800 0.551266 1.079110 0.129360 0.283265 1.059394 -0.217105 1.758613 1.156467 0.305791 0.018881 1.709795 1.386465 1.716357 0.543922 -0.077767 0.376814 1.917356 1.703183 0.375846 1.314995 1.049255 -0.015490 1.182770 0.105614 1.125738 1.580574 0.196175 0.043631 0.176951 1.523484 1.504279 0.024743 0.233174 0.051990 0.885176 0.485127 0.978870 1.366279 1.841166 1.225239 0.599047 0.937430 1.422432 0.950869 1.195765 0.360876 1.187450 1.491233 0.274262 0.123358 1.276789 1.498182 1.151090 1.495794 1.385360 0.511524 1.320969 1.040843 1.323508 0.526850 1.486006 0.358172 -0.084804 0.784722 0.263761 0.033435 1.669885 0.179635 1.097636 0.771172 0.674320 0.095788 1.426496 1.763465 0.078301 1.972016 1.520526 1.431005 0.272982 0.550020 1.118797 -0.453975 1.686563 1.286924 1.481496 1.458102 0.550556 0.115818 1.002355 0.493193 0.718245 1.621218)
+ 10.273899 #r(0.000000 1.285870 0.722685 1.695642 1.789973 0.495199 0.001511 0.648393 1.565696 0.756830 0.421656 -0.184836 0.187469 1.381401 1.501800 0.551266 1.079110 0.129360 0.283265 1.059394 -0.217105 1.758613 1.156467 0.305791 0.018881 1.709795 1.386465 1.716357 0.543922 -0.077767 0.376814 1.917356 1.703183 0.375846 1.314995 1.049255 -0.015490 1.182770 0.105614 1.125738 1.580574 0.196175 0.043631 0.176951 1.523484 1.504279 0.024743 0.233174 0.051990 0.885176 0.485127 0.978870 1.366279 1.841166 1.225239 0.599047 0.937430 1.422432 0.950869 1.195765 0.360876 1.187450 1.491233 0.274262 0.123358 1.276789 1.498182 1.151090 1.495794 1.385360 0.511524 1.320969 1.040843 1.323508 0.526850 1.486006 0.358172 -0.084804 0.784722 0.263761 0.033435 1.669885 0.179635 1.097636 0.771172 0.674320 0.095788 1.426496 1.763465 0.078301 1.972016 1.520526 1.431005 0.272982 0.550020 1.118797 -0.453975 1.686563 1.286924 1.481496 1.458102 0.550556 0.115818 1.002355 0.493193 0.718245 1.621218)
;; 105+2 = 103+4
- 10.254504 #(0.000000 0.484824 0.645093 0.484448 0.357958 -0.306335 0.781266 1.722221 -0.020523 0.622664 0.475686 0.971485 -0.081828 -0.221731 0.023546 0.160724 1.699779 0.877022 1.571254 -0.219251 0.072417 1.464813 0.631200 1.379055 1.117758 -0.133773 0.232309 1.351525 1.269800 0.970127 0.241075 0.257607 1.000838 1.216076 0.053471 0.232020 -0.359907 1.509993 1.179694 1.054758 0.827030 -1.018435 0.149201 0.847612 1.252524 0.455297 0.005091 0.938550 0.112714 1.231427 1.569945 0.646140 1.306245 1.559100 -0.235326 1.424717 1.086220 0.226398 1.287381 0.237597 1.562146 0.408642 1.239694 1.521425 0.873908 0.443864 0.122845 0.794034 -0.670208 1.201438 0.763367 1.019610 -0.305283 0.938173 0.223614 0.151118 -0.405317 0.789769 0.185696 1.705170 1.080972 -0.394578 -0.084190 0.462333 0.451070 0.732074 -0.196625 0.882445 1.029212 1.285492 0.753537 1.256080 0.793604 1.367897 0.491589 1.208211 -0.307546 0.448608 0.892802 0.520730 -0.067668 1.081080 0.866532 -0.521852 -0.524522 -0.470753 -0.243216)
- 10.250733 #(0.000000 0.483912 0.644703 0.485457 0.358095 -0.305666 0.780949 1.722379 -0.020746 0.621961 0.474887 0.971799 -0.081593 -0.221790 0.024110 0.159431 1.699382 0.876421 1.571715 -0.219801 0.072621 1.464672 0.630752 1.380382 1.117163 -0.134137 0.232594 1.352288 1.269630 0.968806 0.240910 0.258155 1.001406 1.216432 0.053369 0.232245 -0.359904 1.509850 1.180087 1.054981 0.826371 -1.018830 0.149841 0.846847 1.251712 0.455512 0.004303 0.938417 0.112890 1.231211 1.569892 0.646448 1.305537 1.558830 -0.235146 1.425032 1.086297 0.226783 1.288076 0.237137 1.561589 0.408735 1.240009 1.521331 0.873481 0.444503 0.123500 0.794180 -0.670582 1.202161 0.762118 1.019326 -0.305420 0.938305 0.222385 0.150427 -0.405430 0.790658 0.185984 1.703676 1.080860 -0.394708 -0.083973 0.462509 0.451296 0.730919 -0.196866 0.882952 1.029031 1.285788 0.753984 1.256801 0.794497 1.368238 0.490612 1.208438 -0.307623 0.448339 0.892856 0.519789 -0.067328 1.081789 0.866642 -0.521116 -0.524606 -0.471314 -0.243671)
+ 10.254504 #r(0.000000 0.484824 0.645093 0.484448 0.357958 -0.306335 0.781266 1.722221 -0.020523 0.622664 0.475686 0.971485 -0.081828 -0.221731 0.023546 0.160724 1.699779 0.877022 1.571254 -0.219251 0.072417 1.464813 0.631200 1.379055 1.117758 -0.133773 0.232309 1.351525 1.269800 0.970127 0.241075 0.257607 1.000838 1.216076 0.053471 0.232020 -0.359907 1.509993 1.179694 1.054758 0.827030 -1.018435 0.149201 0.847612 1.252524 0.455297 0.005091 0.938550 0.112714 1.231427 1.569945 0.646140 1.306245 1.559100 -0.235326 1.424717 1.086220 0.226398 1.287381 0.237597 1.562146 0.408642 1.239694 1.521425 0.873908 0.443864 0.122845 0.794034 -0.670208 1.201438 0.763367 1.019610 -0.305283 0.938173 0.223614 0.151118 -0.405317 0.789769 0.185696 1.705170 1.080972 -0.394578 -0.084190 0.462333 0.451070 0.732074 -0.196625 0.882445 1.029212 1.285492 0.753537 1.256080 0.793604 1.367897 0.491589 1.208211 -0.307546 0.448608 0.892802 0.520730 -0.067668 1.081080 0.866532 -0.521852 -0.524522 -0.470753 -0.243216)
+ 10.250733 #r(0.000000 0.483912 0.644703 0.485457 0.358095 -0.305666 0.780949 1.722379 -0.020746 0.621961 0.474887 0.971799 -0.081593 -0.221790 0.024110 0.159431 1.699382 0.876421 1.571715 -0.219801 0.072621 1.464672 0.630752 1.380382 1.117163 -0.134137 0.232594 1.352288 1.269630 0.968806 0.240910 0.258155 1.001406 1.216432 0.053369 0.232245 -0.359904 1.509850 1.180087 1.054981 0.826371 -1.018830 0.149841 0.846847 1.251712 0.455512 0.004303 0.938417 0.112890 1.231211 1.569892 0.646448 1.305537 1.558830 -0.235146 1.425032 1.086297 0.226783 1.288076 0.237137 1.561589 0.408735 1.240009 1.521331 0.873481 0.444503 0.123500 0.794180 -0.670582 1.202161 0.762118 1.019326 -0.305420 0.938305 0.222385 0.150427 -0.405430 0.790658 0.185984 1.703676 1.080860 -0.394708 -0.083973 0.462509 0.451296 0.730919 -0.196866 0.882952 1.029031 1.285788 0.753984 1.256801 0.794497 1.368238 0.490612 1.208438 -0.307623 0.448339 0.892856 0.519789 -0.067328 1.081789 0.866642 -0.521116 -0.524606 -0.471314 -0.243671)
)
;;; 108 all -------------------------------------------------------------------------------- ; 10.3923
-(vector 108 13.534 #(0 1 1 0 0 0 0 1 0 1 0 0 1 1 0 1 1 1 0 1 1 0 0 0 0 1 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 0 1 0 1 1 1 0 0 0 0 1 1 1 1 1 1 0 0 1 0 1 1 0 1 0 1 0 0 0 0 1)
+(vector 108 13.534 #r(0 1 1 0 0 0 0 1 0 1 0 0 1 1 0 1 1 1 0 1 1 0 0 0 0 1 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 0 1 0 1 1 1 0 0 0 0 1 1 1 1 1 1 0 0 1 0 1 1 0 1 0 1 0 0 0 0 1)
- 10.312988 #(0.000000 1.293654 0.754043 1.806542 1.109001 0.766775 1.436021 1.627340 0.528605 1.806494 1.181378 0.013554 0.353388 0.092480 0.431618 0.200495 0.904126 0.741464 0.675051 -0.110957 1.146773 1.810641 0.552983 0.275055 0.835876 1.123930 -0.182193 -0.339155 0.645146 0.163632 0.868047 1.269556 0.830686 1.219557 1.665806 1.060039 1.944315 -0.011848 0.365415 0.718256 0.624511 1.571990 0.113371 0.572031 1.797961 0.876379 0.068642 0.072119 0.553161 0.329387 0.545574 0.337595 1.647194 1.034042 0.468339 1.774314 0.240404 1.846502 1.142528 1.223731 0.832499 0.428931 0.643890 1.257704 1.085969 0.643637 0.429070 0.971966 0.109095 0.689833 0.417898 1.804672 1.346983 0.150026 0.404292 0.575881 1.441149 0.533070 -0.177095 0.298641 0.921545 1.086883 0.410704 0.849120 1.518187 1.874571 0.517824 1.242109 -0.053714 0.834159 0.276990 1.956354 1.765190 1.537622 1.530954 -0.106766 1.325278 -0.071959 1.045056 0.533410 0.699958 0.068418 0.070057 1.204618 1.620552 1.072110 1.372120 0.848823)
+ 10.312988 #r(0.000000 1.293654 0.754043 1.806542 1.109001 0.766775 1.436021 1.627340 0.528605 1.806494 1.181378 0.013554 0.353388 0.092480 0.431618 0.200495 0.904126 0.741464 0.675051 -0.110957 1.146773 1.810641 0.552983 0.275055 0.835876 1.123930 -0.182193 -0.339155 0.645146 0.163632 0.868047 1.269556 0.830686 1.219557 1.665806 1.060039 1.944315 -0.011848 0.365415 0.718256 0.624511 1.571990 0.113371 0.572031 1.797961 0.876379 0.068642 0.072119 0.553161 0.329387 0.545574 0.337595 1.647194 1.034042 0.468339 1.774314 0.240404 1.846502 1.142528 1.223731 0.832499 0.428931 0.643890 1.257704 1.085969 0.643637 0.429070 0.971966 0.109095 0.689833 0.417898 1.804672 1.346983 0.150026 0.404292 0.575881 1.441149 0.533070 -0.177095 0.298641 0.921545 1.086883 0.410704 0.849120 1.518187 1.874571 0.517824 1.242109 -0.053714 0.834159 0.276990 1.956354 1.765190 1.537622 1.530954 -0.106766 1.325278 -0.071959 1.045056 0.533410 0.699958 0.068418 0.070057 1.204618 1.620552 1.072110 1.372120 0.848823)
;; 103+5
- 10.360302 #(0.000000 0.551674 0.684121 0.443843 0.328287 -0.382856 0.742347 1.553271 0.100438 0.588495 0.564972 0.863601 0.125393 0.057318 -0.071985 0.287901 1.600093 0.971407 1.645285 -0.209518 -0.381267 1.448278 0.742196 1.379192 1.304893 -0.172568 0.425075 1.236069 1.368334 0.874268 0.672828 0.415281 0.726658 0.862117 0.109198 0.219337 -0.244418 1.532842 1.163405 1.346937 0.978237 -0.950485 0.281930 0.924923 1.513033 0.583840 -0.415504 1.174086 0.188477 1.112313 1.589792 0.899949 1.271439 1.538926 -0.265428 1.460427 1.161403 0.396214 1.349937 0.135151 1.479429 0.399645 1.649047 -0.124860 1.280184 0.464971 0.347605 0.600275 -0.139067 1.236147 0.852840 0.641047 -0.107564 1.211289 -0.076869 0.330831 -0.638295 0.950296 0.142049 1.425529 1.211169 -0.161554 0.129139 0.243541 0.647760 0.753493 0.224072 0.686712 1.456555 1.430413 0.867180 1.349952 0.357062 1.696651 0.627351 1.338698 0.006006 0.515509 1.152554 0.609264 -0.153967 1.271052 0.732750 -0.451261 -0.621127 -0.054294 -0.063774 0.634645)
- 10.344504 #(0.000000 0.554177 0.686603 0.442963 0.330457 -0.383506 0.740825 1.555486 0.100826 0.588922 0.565702 0.862938 0.127067 0.056740 -0.069899 0.290177 1.602316 0.972504 1.644788 -0.208407 -0.383569 1.450051 0.741146 1.377401 1.305410 -0.168825 0.428117 1.236110 1.367696 0.873985 0.672701 0.413093 0.726218 0.861358 0.109862 0.215210 -0.240642 1.530834 1.163848 1.343976 0.980851 -0.948698 0.281660 0.923527 1.516228 0.584674 -0.414222 1.172500 0.191678 1.113538 1.586368 0.900806 1.270747 1.537958 -0.265025 1.461949 1.160460 0.395671 1.350152 0.136808 1.485285 0.401359 1.654233 -0.123106 1.280806 0.466879 0.345278 0.597993 -0.139606 1.239204 0.851600 0.644182 -0.102185 1.210948 -0.076698 0.332547 -0.640955 0.952129 0.142937 1.428164 1.214644 -0.163426 0.128350 0.239573 0.645480 0.752936 0.225706 0.687169 1.460909 1.432454 0.869137 1.348779 0.361743 1.699109 0.623957 1.337938 0.001013 0.515906 1.149085 0.609013 -0.152564 1.271041 0.737876 -0.454840 -0.623700 -0.054225 -0.061354 0.631795)
+ 10.360302 #r(0.000000 0.551674 0.684121 0.443843 0.328287 -0.382856 0.742347 1.553271 0.100438 0.588495 0.564972 0.863601 0.125393 0.057318 -0.071985 0.287901 1.600093 0.971407 1.645285 -0.209518 -0.381267 1.448278 0.742196 1.379192 1.304893 -0.172568 0.425075 1.236069 1.368334 0.874268 0.672828 0.415281 0.726658 0.862117 0.109198 0.219337 -0.244418 1.532842 1.163405 1.346937 0.978237 -0.950485 0.281930 0.924923 1.513033 0.583840 -0.415504 1.174086 0.188477 1.112313 1.589792 0.899949 1.271439 1.538926 -0.265428 1.460427 1.161403 0.396214 1.349937 0.135151 1.479429 0.399645 1.649047 -0.124860 1.280184 0.464971 0.347605 0.600275 -0.139067 1.236147 0.852840 0.641047 -0.107564 1.211289 -0.076869 0.330831 -0.638295 0.950296 0.142049 1.425529 1.211169 -0.161554 0.129139 0.243541 0.647760 0.753493 0.224072 0.686712 1.456555 1.430413 0.867180 1.349952 0.357062 1.696651 0.627351 1.338698 0.006006 0.515509 1.152554 0.609264 -0.153967 1.271052 0.732750 -0.451261 -0.621127 -0.054294 -0.063774 0.634645)
+ 10.344504 #r(0.000000 0.554177 0.686603 0.442963 0.330457 -0.383506 0.740825 1.555486 0.100826 0.588922 0.565702 0.862938 0.127067 0.056740 -0.069899 0.290177 1.602316 0.972504 1.644788 -0.208407 -0.383569 1.450051 0.741146 1.377401 1.305410 -0.168825 0.428117 1.236110 1.367696 0.873985 0.672701 0.413093 0.726218 0.861358 0.109862 0.215210 -0.240642 1.530834 1.163848 1.343976 0.980851 -0.948698 0.281660 0.923527 1.516228 0.584674 -0.414222 1.172500 0.191678 1.113538 1.586368 0.900806 1.270747 1.537958 -0.265025 1.461949 1.160460 0.395671 1.350152 0.136808 1.485285 0.401359 1.654233 -0.123106 1.280806 0.466879 0.345278 0.597993 -0.139606 1.239204 0.851600 0.644182 -0.102185 1.210948 -0.076698 0.332547 -0.640955 0.952129 0.142937 1.428164 1.214644 -0.163426 0.128350 0.239573 0.645480 0.752936 0.225706 0.687169 1.460909 1.432454 0.869137 1.348779 0.361743 1.699109 0.623957 1.337938 0.001013 0.515906 1.149085 0.609013 -0.152564 1.271041 0.737876 -0.454840 -0.623700 -0.054225 -0.061354 0.631795)
)
;;; 109 all -------------------------------------------------------------------------------- ; 10.440306508911
-(vector 109 13.496821304096 #(0 0 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0)
+(vector 109 13.496821304096 #r(0 0 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0)
- 10.432370 #(0.000000 0.222737 0.395964 0.267704 0.984627 0.196896 1.257313 -0.049947 0.063508 1.503629 1.207170 0.259470 1.634989 1.732463 0.102120 1.779072 -0.448069 1.030982 -0.170238 0.241134 1.050790 1.545206 1.217799 1.632326 -0.260618 1.981321 1.563052 0.646224 0.963725 1.195450 1.382468 0.912278 -0.055446 -0.043084 1.544497 1.444807 0.819657 0.741044 0.122396 1.518758 -0.047192 1.432176 0.150062 1.445372 1.689041 1.538858 1.607305 0.672865 0.037321 1.002894 0.706157 0.845104 0.402627 1.438914 1.038104 1.050343 0.380185 1.252881 -0.144926 -0.130041 -0.022885 1.740880 1.268140 -0.038596 0.221618 0.937959 1.603605 0.465293 -0.010315 0.708519 1.255289 0.623840 0.892628 0.632806 0.245713 1.831669 -0.020202 0.561348 0.735902 1.121505 0.850852 0.147905 1.162108 1.085140 0.352699 1.043580 0.226572 1.785966 0.379633 0.873437 1.384309 1.785370 1.080206 1.256403 1.169325 0.672865 1.444061 0.325194 0.278183 1.165719 -0.193709 1.182201 0.138301 0.079081 1.231522 0.798589 -0.014107 0.372822 1.050722)
+ 10.432370 #r(0.000000 0.222737 0.395964 0.267704 0.984627 0.196896 1.257313 -0.049947 0.063508 1.503629 1.207170 0.259470 1.634989 1.732463 0.102120 1.779072 -0.448069 1.030982 -0.170238 0.241134 1.050790 1.545206 1.217799 1.632326 -0.260618 1.981321 1.563052 0.646224 0.963725 1.195450 1.382468 0.912278 -0.055446 -0.043084 1.544497 1.444807 0.819657 0.741044 0.122396 1.518758 -0.047192 1.432176 0.150062 1.445372 1.689041 1.538858 1.607305 0.672865 0.037321 1.002894 0.706157 0.845104 0.402627 1.438914 1.038104 1.050343 0.380185 1.252881 -0.144926 -0.130041 -0.022885 1.740880 1.268140 -0.038596 0.221618 0.937959 1.603605 0.465293 -0.010315 0.708519 1.255289 0.623840 0.892628 0.632806 0.245713 1.831669 -0.020202 0.561348 0.735902 1.121505 0.850852 0.147905 1.162108 1.085140 0.352699 1.043580 0.226572 1.785966 0.379633 0.873437 1.384309 1.785370 1.080206 1.256403 1.169325 0.672865 1.444061 0.325194 0.278183 1.165719 -0.193709 1.182201 0.138301 0.079081 1.231522 0.798589 -0.014107 0.372822 1.050722)
;; [checked]
;; pp:
- 10.450104 #(0.000000 0.623079 1.000690 1.676565 0.329793 0.812365 1.369654 0.033036 0.636775 1.205357 1.818620 0.518482 1.271099 -0.006177 0.798686 1.518819 0.365150 1.120280 1.863547 0.825398 1.655423 0.561458 1.434421 0.357234 1.260951 0.112744 1.108421 0.195312 1.204468 0.187317 1.151003 0.344529 1.318670 0.493356 1.634474 0.713838 1.719668 0.894392 0.187447 1.393869 0.631586 1.857642 1.152308 0.558736 1.895158 0.937863 0.284606 1.593849 1.131320 0.496395 1.862604 1.450055 1.017002 0.269052 1.590119 1.223313 0.766679 0.191870 1.793336 1.442714 0.950223 0.613488 0.158729 1.978172 1.504759 1.404948 0.934115 0.506811 0.307861 0.053560 0.056210 1.784308 1.658677 1.460879 1.312182 1.175464 0.793270 0.871641 0.543638 0.736870 0.773799 0.716297 0.645633 0.912396 0.319672 0.772867 0.727345 0.920587 0.879052 1.066787 1.359741 1.428609 1.742928 0.019718 0.299864 0.439508 0.461036 0.748673 0.838321 1.439140 1.960382 0.367463 0.781933 1.129021 1.394803 1.904930 0.281191 0.715525 1.133222)
+ 10.450104 #r(0.000000 0.623079 1.000690 1.676565 0.329793 0.812365 1.369654 0.033036 0.636775 1.205357 1.818620 0.518482 1.271099 -0.006177 0.798686 1.518819 0.365150 1.120280 1.863547 0.825398 1.655423 0.561458 1.434421 0.357234 1.260951 0.112744 1.108421 0.195312 1.204468 0.187317 1.151003 0.344529 1.318670 0.493356 1.634474 0.713838 1.719668 0.894392 0.187447 1.393869 0.631586 1.857642 1.152308 0.558736 1.895158 0.937863 0.284606 1.593849 1.131320 0.496395 1.862604 1.450055 1.017002 0.269052 1.590119 1.223313 0.766679 0.191870 1.793336 1.442714 0.950223 0.613488 0.158729 1.978172 1.504759 1.404948 0.934115 0.506811 0.307861 0.053560 0.056210 1.784308 1.658677 1.460879 1.312182 1.175464 0.793270 0.871641 0.543638 0.736870 0.773799 0.716297 0.645633 0.912396 0.319672 0.772867 0.727345 0.920587 0.879052 1.066787 1.359741 1.428609 1.742928 0.019718 0.299864 0.439508 0.461036 0.748673 0.838321 1.439140 1.960382 0.367463 0.781933 1.129021 1.394803 1.904930 0.281191 0.715525 1.133222)
;; ppe:
- 10.470162 #(0.000000 0.451543 0.456061 0.147873 0.922547 -0.015839 1.326621 0.024116 -0.214919 1.809411 1.260411 -0.041222 1.497661 1.558073 1.813230 1.792964 -0.178738 0.909655 0.169254 0.063699 1.161084 1.372145 1.379335 1.141902 -0.228933 1.774907 1.529928 0.313058 1.032527 0.848013 1.268723 1.218902 1.606823 -0.185860 1.765043 1.039756 0.745126 0.269721 0.154169 1.685147 -0.249171 1.208381 0.488385 1.400686 1.729831 1.462720 1.767018 0.760244 0.226518 1.299640 0.590535 1.231728 0.337540 1.363389 1.096692 0.848743 0.528317 1.290759 1.823255 0.006608 0.050582 1.737871 1.377769 0.292561 0.372415 1.032383 1.772564 0.594274 1.989312 0.990074 1.229632 0.208396 0.695371 0.886409 0.070239 1.725783 -0.164935 0.277786 0.838920 1.005114 0.874184 0.343822 0.665942 0.650106 0.585298 0.979509 -0.150741 1.631833 0.286195 1.077553 1.249512 1.979846 1.138840 1.144065 1.361495 0.626673 1.081435 -0.100313 0.333711 1.298242 -0.025467 1.240351 0.507433 -0.065459 1.581161 0.747520 -0.025829 0.466153 1.514665)
+ 10.470162 #r(0.000000 0.451543 0.456061 0.147873 0.922547 -0.015839 1.326621 0.024116 -0.214919 1.809411 1.260411 -0.041222 1.497661 1.558073 1.813230 1.792964 -0.178738 0.909655 0.169254 0.063699 1.161084 1.372145 1.379335 1.141902 -0.228933 1.774907 1.529928 0.313058 1.032527 0.848013 1.268723 1.218902 1.606823 -0.185860 1.765043 1.039756 0.745126 0.269721 0.154169 1.685147 -0.249171 1.208381 0.488385 1.400686 1.729831 1.462720 1.767018 0.760244 0.226518 1.299640 0.590535 1.231728 0.337540 1.363389 1.096692 0.848743 0.528317 1.290759 1.823255 0.006608 0.050582 1.737871 1.377769 0.292561 0.372415 1.032383 1.772564 0.594274 1.989312 0.990074 1.229632 0.208396 0.695371 0.886409 0.070239 1.725783 -0.164935 0.277786 0.838920 1.005114 0.874184 0.343822 0.665942 0.650106 0.585298 0.979509 -0.150741 1.631833 0.286195 1.077553 1.249512 1.979846 1.138840 1.144065 1.361495 0.626673 1.081435 -0.100313 0.333711 1.298242 -0.025467 1.240351 0.507433 -0.065459 1.581161 0.747520 -0.025829 0.466153 1.514665)
;; 108+1
- 10.457243 #(0.000000 1.269530 0.760051 1.729694 1.122945 0.814880 1.466156 1.631086 0.616903 1.786832 1.344985 0.030797 0.418832 0.037877 0.373313 0.275814 0.977767 0.677872 0.673791 -0.065296 1.118192 1.826436 0.508528 0.285632 0.821565 1.103219 -0.267070 -0.330900 0.618539 0.170243 0.892990 1.223460 0.764058 1.162302 1.620423 0.957344 0.023461 -0.059770 0.381474 0.692706 0.660066 1.703495 0.098695 0.624314 1.751336 0.844891 0.120502 0.057294 0.621996 0.319901 0.586587 0.186646 1.685806 0.974557 0.474304 1.735548 0.234787 1.810600 1.138824 1.194376 0.872559 0.435412 0.677166 1.290849 1.011702 0.701077 0.322755 0.950082 0.024752 0.607227 0.415633 1.702576 1.323090 0.195261 0.365091 0.675664 1.408251 0.606997 -0.208324 0.308915 0.941088 1.034722 0.364193 0.967725 1.444390 1.941283 0.456248 1.293589 0.032476 0.805832 0.141117 1.965347 1.709815 1.528055 1.586120 -0.152788 1.361484 0.019126 1.044770 0.500796 0.670659 0.067435 -0.009310 1.226198 1.603811 1.046583 1.365223 0.883194 0.193296)
+ 10.457243 #r(0.000000 1.269530 0.760051 1.729694 1.122945 0.814880 1.466156 1.631086 0.616903 1.786832 1.344985 0.030797 0.418832 0.037877 0.373313 0.275814 0.977767 0.677872 0.673791 -0.065296 1.118192 1.826436 0.508528 0.285632 0.821565 1.103219 -0.267070 -0.330900 0.618539 0.170243 0.892990 1.223460 0.764058 1.162302 1.620423 0.957344 0.023461 -0.059770 0.381474 0.692706 0.660066 1.703495 0.098695 0.624314 1.751336 0.844891 0.120502 0.057294 0.621996 0.319901 0.586587 0.186646 1.685806 0.974557 0.474304 1.735548 0.234787 1.810600 1.138824 1.194376 0.872559 0.435412 0.677166 1.290849 1.011702 0.701077 0.322755 0.950082 0.024752 0.607227 0.415633 1.702576 1.323090 0.195261 0.365091 0.675664 1.408251 0.606997 -0.208324 0.308915 0.941088 1.034722 0.364193 0.967725 1.444390 1.941283 0.456248 1.293589 0.032476 0.805832 0.141117 1.965347 1.709815 1.528055 1.586120 -0.152788 1.361484 0.019126 1.044770 0.500796 0.670659 0.067435 -0.009310 1.226198 1.603811 1.046583 1.365223 0.883194 0.193296)
;; 110-1
- 10.317140 #(0.000000 0.466349 1.223037 -0.048547 0.323977 1.203657 1.367719 0.187630 0.657819 1.251362 0.086519 0.614105 1.466130 0.119399 0.944664 1.740988 0.506084 1.149516 -0.030954 0.628514 1.494005 0.524832 1.717562 0.517597 1.425941 0.137206 1.081399 0.061277 1.144121 0.221716 1.237433 0.317276 1.420766 0.500184 -0.036811 1.170497 0.081161 0.970515 -0.023715 1.079773 0.402574 -0.076358 0.951794 0.085641 1.507539 0.981921 0.150846 1.328708 0.618279 0.035311 1.211298 0.994117 0.364832 0.177592 1.691178 1.236486 0.735313 -0.167267 1.196100 0.966444 0.565143 0.158981 1.675120 1.645837 1.195019 1.267396 0.458918 -0.062222 -0.191658 1.389608 1.410277 1.396420 0.888634 1.096165 0.607965 1.202499 0.534216 0.611126 -0.033770 -0.109171 -0.080915 -0.138588 0.061623 0.262473 0.091042 -0.019937 0.028635 0.201372 0.434309 0.265176 0.227450 0.679082 0.941635 1.249687 1.479264 1.715302 -0.073877 -0.121298 0.329766 0.557230 1.127078 1.604542 1.610922 0.215699 0.843190 1.390034 1.611440 0.159691 0.162556)
- 10.316139 #(0.000000 0.467860 1.225582 -0.051091 0.323359 1.199983 1.366975 0.187719 0.660883 1.253225 0.082708 0.616737 1.474208 0.120695 0.946148 1.740641 0.509628 1.149625 -0.031684 0.627981 1.494201 0.523906 1.719545 0.517678 1.423044 0.134403 1.080799 0.058887 1.146126 0.223450 1.240782 0.320888 1.420488 0.499238 -0.036895 1.166877 0.079242 0.965835 -0.026305 1.082043 0.407016 -0.078901 0.951307 0.084236 1.509812 0.984128 0.155672 1.326788 0.624829 0.033701 1.214113 0.999905 0.359963 0.181048 1.698251 1.226178 0.741043 -0.169162 1.197122 0.969420 0.565193 0.157309 1.679759 1.648950 1.194633 1.269799 0.462660 -0.066040 -0.191739 1.394509 1.412861 1.398929 0.890176 1.092218 0.605306 1.201780 0.531418 0.616650 -0.032708 -0.104746 -0.085490 -0.136596 0.060249 0.261684 0.098136 -0.024191 0.030064 0.203361 0.438227 0.265314 0.225969 0.675420 0.938390 1.248614 1.479216 1.714123 -0.073635 -0.128780 0.326731 0.554524 1.126561 1.604426 1.604094 0.214665 0.842457 1.393251 1.611608 0.158085 0.161986)
+ 10.317140 #r(0.000000 0.466349 1.223037 -0.048547 0.323977 1.203657 1.367719 0.187630 0.657819 1.251362 0.086519 0.614105 1.466130 0.119399 0.944664 1.740988 0.506084 1.149516 -0.030954 0.628514 1.494005 0.524832 1.717562 0.517597 1.425941 0.137206 1.081399 0.061277 1.144121 0.221716 1.237433 0.317276 1.420766 0.500184 -0.036811 1.170497 0.081161 0.970515 -0.023715 1.079773 0.402574 -0.076358 0.951794 0.085641 1.507539 0.981921 0.150846 1.328708 0.618279 0.035311 1.211298 0.994117 0.364832 0.177592 1.691178 1.236486 0.735313 -0.167267 1.196100 0.966444 0.565143 0.158981 1.675120 1.645837 1.195019 1.267396 0.458918 -0.062222 -0.191658 1.389608 1.410277 1.396420 0.888634 1.096165 0.607965 1.202499 0.534216 0.611126 -0.033770 -0.109171 -0.080915 -0.138588 0.061623 0.262473 0.091042 -0.019937 0.028635 0.201372 0.434309 0.265176 0.227450 0.679082 0.941635 1.249687 1.479264 1.715302 -0.073877 -0.121298 0.329766 0.557230 1.127078 1.604542 1.610922 0.215699 0.843190 1.390034 1.611440 0.159691 0.162556)
+ 10.316139 #r(0.000000 0.467860 1.225582 -0.051091 0.323359 1.199983 1.366975 0.187719 0.660883 1.253225 0.082708 0.616737 1.474208 0.120695 0.946148 1.740641 0.509628 1.149625 -0.031684 0.627981 1.494201 0.523906 1.719545 0.517678 1.423044 0.134403 1.080799 0.058887 1.146126 0.223450 1.240782 0.320888 1.420488 0.499238 -0.036895 1.166877 0.079242 0.965835 -0.026305 1.082043 0.407016 -0.078901 0.951307 0.084236 1.509812 0.984128 0.155672 1.326788 0.624829 0.033701 1.214113 0.999905 0.359963 0.181048 1.698251 1.226178 0.741043 -0.169162 1.197122 0.969420 0.565193 0.157309 1.679759 1.648950 1.194633 1.269799 0.462660 -0.066040 -0.191739 1.394509 1.412861 1.398929 0.890176 1.092218 0.605306 1.201780 0.531418 0.616650 -0.032708 -0.104746 -0.085490 -0.136596 0.060249 0.261684 0.098136 -0.024191 0.030064 0.203361 0.438227 0.265314 0.225969 0.675420 0.938390 1.248614 1.479216 1.714123 -0.073635 -0.128780 0.326731 0.554524 1.126561 1.604426 1.604094 0.214665 0.842457 1.393251 1.611608 0.158085 0.161986)
)
;;; 110 all -------------------------------------------------------------------------------- ; 10.4881
-(vector 110 13.592092514038 #(0 0 1 0 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 0 1 0 0 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 0 1 0 1 0 1 0 1)
+(vector 110 13.592092514038 #r(0 0 1 0 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 0 1 0 0 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 0 1 0 1 0 1 0 1)
- 10.443826 #(0.000000 0.966857 -0.310939 0.754018 -0.215289 0.050408 1.345912 1.407669 0.917300 1.537339 0.464664 1.377382 -0.129707 1.562018 0.873176 0.378480 1.188634 1.002593 1.467403 -0.157591 0.611052 1.240086 1.200021 0.642960 0.011727 1.278266 0.757206 1.221576 1.173971 1.148607 0.352945 0.591698 0.569729 0.204560 1.805523 0.091751 0.494475 0.741755 1.173490 0.125853 1.836232 0.189233 1.047389 0.359034 0.299905 1.335669 1.331935 0.866342 1.429328 0.175988 0.321575 0.808716 0.418347 0.305766
+ 10.443826 #r(0.000000 0.966857 -0.310939 0.754018 -0.215289 0.050408 1.345912 1.407669 0.917300 1.537339 0.464664 1.377382 -0.129707 1.562018 0.873176 0.378480 1.188634 1.002593 1.467403 -0.157591 0.611052 1.240086 1.200021 0.642960 0.011727 1.278266 0.757206 1.221576 1.173971 1.148607 0.352945 0.591698 0.569729 0.204560 1.805523 0.091751 0.494475 0.741755 1.173490 0.125853 1.836232 0.189233 1.047389 0.359034 0.299905 1.335669 1.331935 0.866342 1.429328 0.175988 0.321575 0.808716 0.418347 0.305766
0.587213 0.859103 1.233827 1.612185 0.649515 1.232962 0.438531 1.088539 1.160206 1.276056 0.991705 0.605889 1.920272 1.294151 0.591700 0.477186 -0.114311 0.103729 0.053546 1.057780 1.113226 0.935069 0.869987 0.585069 1.193799 0.314064 1.564843 1.009796 1.434593 -0.061294 0.394207 1.540076 0.463315 1.070060 1.005570 -0.247697 1.209164 0.032912 1.882456 0.617912 -0.419949 0.119714 0.033254 -0.149035 1.146172 0.301556 1.043038 0.611637 1.119274 -0.185496 1.474180 0.910726 0.869288 0.008729 1.113223 0.605574)
;; pp:
- 10.416677 #(0.000000 0.636826 1.168776 1.802237 0.316567 0.986572 1.395425 0.009381 0.711647 1.264223 1.932392 0.627165 1.472185 0.196446 0.915303 1.747756 0.298057 1.087093 -0.098251 0.679800 1.474105 0.503701 1.516136 0.488851 1.222583 0.157308 1.093122 0.014882 1.111898 0.174280 1.267353 0.186944 1.319383 0.570938 1.741756 0.793533 -0.092041 0.821354 -0.104426 1.044239 0.485714 1.864668 0.984585 0.108795 1.386239 0.942801 0.150487 1.312495 0.693148 -0.057522 1.440466 0.911264 0.464590 -0.106316 1.425558 0.757031 0.414982 -0.197207 1.393462 0.845365 0.655558 0.173740 1.724477 1.622714 1.133952 1.113326 0.491749 0.027662 -0.081584 1.624363 1.523158 1.483424 1.009127 1.065663 0.489911 0.865535 0.429699 0.506066 0.168610 0.091635 -0.004728 0.101995 0.057231 0.244394 0.215629 0.140294 0.025423 0.249165 0.312773 0.491767 0.509301 0.585407 1.082514 1.193775 1.427418 1.634094 0.038165 -0.066305 0.261200 0.531951 1.008338 1.495805 1.630762 0.003123 0.564786 1.124822 1.373512 0.020469 0.093862 0.692170)
+ 10.416677 #r(0.000000 0.636826 1.168776 1.802237 0.316567 0.986572 1.395425 0.009381 0.711647 1.264223 1.932392 0.627165 1.472185 0.196446 0.915303 1.747756 0.298057 1.087093 -0.098251 0.679800 1.474105 0.503701 1.516136 0.488851 1.222583 0.157308 1.093122 0.014882 1.111898 0.174280 1.267353 0.186944 1.319383 0.570938 1.741756 0.793533 -0.092041 0.821354 -0.104426 1.044239 0.485714 1.864668 0.984585 0.108795 1.386239 0.942801 0.150487 1.312495 0.693148 -0.057522 1.440466 0.911264 0.464590 -0.106316 1.425558 0.757031 0.414982 -0.197207 1.393462 0.845365 0.655558 0.173740 1.724477 1.622714 1.133952 1.113326 0.491749 0.027662 -0.081584 1.624363 1.523158 1.483424 1.009127 1.065663 0.489911 0.865535 0.429699 0.506066 0.168610 0.091635 -0.004728 0.101995 0.057231 0.244394 0.215629 0.140294 0.025423 0.249165 0.312773 0.491767 0.509301 0.585407 1.082514 1.193775 1.427418 1.634094 0.038165 -0.066305 0.261200 0.531951 1.008338 1.495805 1.630762 0.003123 0.564786 1.124822 1.373512 0.020469 0.093862 0.692170)
;; 109+1
- 10.387950 #(0.000000 0.515686 1.264891 -0.055069 0.324088 1.179085 1.335788 0.136489 0.919154 1.188155 -0.141610 0.717958 1.358218 0.093185 0.896015 1.671807 0.471790 1.141052 0.051579 0.537490 1.459698 0.584651 1.830808 0.363032 1.369938 0.000274 0.907004 -0.093829 1.224177 0.475784 1.246547 0.352307 1.450525 0.675832 0.013928 1.051336 -0.056690 0.739815 -0.043085 0.988473 0.181872 -0.198536 1.207807 0.272700 1.535978 1.102951 0.131450 1.223792 0.690160 0.142129 1.227746 0.844209 0.420668 0.245746 1.521870 1.240517 0.759658 -0.189023 1.110249 0.975685 0.561038 0.208456 1.726728 1.762213 1.410558 1.390253 0.568141 0.009314 -0.066588 1.510186 1.490948 1.223995 0.684559 1.083791 0.423654 1.233083 0.433267 0.557294 -0.196449 -0.046355 -0.048752 0.047230 -0.047134 0.493004 0.400752 0.312416 0.075458 0.155296 0.421062 0.311827 0.162606 0.700352 0.907002 1.326783 1.485723 -0.152238 -0.031436 -0.145811 0.279371 0.397448 1.049233 1.455768 1.607980 0.104646 0.721954 1.211206 1.533891 0.073983 0.190426 0.414118)
- 10.384532 #(0.000000 0.497058 1.308854 -0.040087 0.317842 1.212991 1.348869 0.169218 0.937322 1.141868 -0.161541 0.702285 1.374915 0.105577 0.895118 1.715852 0.486357 1.126045 0.027516 0.506764 1.422714 0.578087 1.785847 0.360577 1.340809 0.040639 0.924986 -0.064845 1.218475 0.441481 1.282493 0.367747 1.417112 0.662713 0.020057 1.075916 -0.019298 0.721943 -0.067674 0.989188 0.221610 -0.166666 1.205634 0.245282 1.512389 1.116780 0.133433 1.209361 0.683941 0.136270 1.207963 0.840404 0.407464 0.237523 1.553628 1.290834 0.738111 -0.201487 1.118700 0.992136 0.530099 0.232821 1.709001 1.753916 1.400184 1.373110 0.591245 -0.001719 -0.097997 1.485341 1.510549 1.267389 0.699366 1.037211 0.446472 1.249648 0.436481 0.541104 -0.183563 -0.029851 -0.044651 0.058473 -0.046411 0.519596 0.324425 0.295881 0.020130 0.121258 0.421385 0.343422 0.175010 0.744278 0.928241 1.278265 1.460120 -0.158640 -0.046458 -0.164552 0.259068 0.355794 1.089478 1.431301 1.606926 0.103582 0.653958 1.133151 1.513113 0.087404 0.126034 0.426687)
+ 10.387950 #r(0.000000 0.515686 1.264891 -0.055069 0.324088 1.179085 1.335788 0.136489 0.919154 1.188155 -0.141610 0.717958 1.358218 0.093185 0.896015 1.671807 0.471790 1.141052 0.051579 0.537490 1.459698 0.584651 1.830808 0.363032 1.369938 0.000274 0.907004 -0.093829 1.224177 0.475784 1.246547 0.352307 1.450525 0.675832 0.013928 1.051336 -0.056690 0.739815 -0.043085 0.988473 0.181872 -0.198536 1.207807 0.272700 1.535978 1.102951 0.131450 1.223792 0.690160 0.142129 1.227746 0.844209 0.420668 0.245746 1.521870 1.240517 0.759658 -0.189023 1.110249 0.975685 0.561038 0.208456 1.726728 1.762213 1.410558 1.390253 0.568141 0.009314 -0.066588 1.510186 1.490948 1.223995 0.684559 1.083791 0.423654 1.233083 0.433267 0.557294 -0.196449 -0.046355 -0.048752 0.047230 -0.047134 0.493004 0.400752 0.312416 0.075458 0.155296 0.421062 0.311827 0.162606 0.700352 0.907002 1.326783 1.485723 -0.152238 -0.031436 -0.145811 0.279371 0.397448 1.049233 1.455768 1.607980 0.104646 0.721954 1.211206 1.533891 0.073983 0.190426 0.414118)
+ 10.384532 #r(0.000000 0.497058 1.308854 -0.040087 0.317842 1.212991 1.348869 0.169218 0.937322 1.141868 -0.161541 0.702285 1.374915 0.105577 0.895118 1.715852 0.486357 1.126045 0.027516 0.506764 1.422714 0.578087 1.785847 0.360577 1.340809 0.040639 0.924986 -0.064845 1.218475 0.441481 1.282493 0.367747 1.417112 0.662713 0.020057 1.075916 -0.019298 0.721943 -0.067674 0.989188 0.221610 -0.166666 1.205634 0.245282 1.512389 1.116780 0.133433 1.209361 0.683941 0.136270 1.207963 0.840404 0.407464 0.237523 1.553628 1.290834 0.738111 -0.201487 1.118700 0.992136 0.530099 0.232821 1.709001 1.753916 1.400184 1.373110 0.591245 -0.001719 -0.097997 1.485341 1.510549 1.267389 0.699366 1.037211 0.446472 1.249648 0.436481 0.541104 -0.183563 -0.029851 -0.044651 0.058473 -0.046411 0.519596 0.324425 0.295881 0.020130 0.121258 0.421385 0.343422 0.175010 0.744278 0.928241 1.278265 1.460120 -0.158640 -0.046458 -0.164552 0.259068 0.355794 1.089478 1.431301 1.606926 0.103582 0.653958 1.133151 1.513113 0.087404 0.126034 0.426687)
)
;;; 111 all -------------------------------------------------------------------------------- ; 10.5357
-(vector 111 13.80813938144 #(0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 0 1 0 0 0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 0 1 0 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1)
+(vector 111 13.80813938144 #r(0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 0 1 0 0 0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 0 1 0 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1)
- 10.489680 #(0.000000 1.276377 0.968620 -0.218445 1.901880 0.088071 1.832261 1.338375 0.312772 1.516596 -0.040044 1.173079 0.061551 1.259985 1.326413 -0.075796 1.430603 0.457729 0.555673 0.169939 0.778858 0.499517 1.015059 1.507495 0.252622 0.024778 0.982934 -0.060048 0.808349 1.306234 -0.213685 0.893109 1.680180 0.816232 1.412440 1.447865 1.309405 0.967681 0.468074 1.167299 -0.294730 0.516281 1.115680 1.346378 1.503302 1.329509 0.069846 0.507313 -0.050602 1.169163 1.172511 1.329654 1.283831 1.273536 0.082962 0.472668 1.944396 -0.083515 1.629124 1.133239 1.648857 0.792610 0.954204 1.052081 0.877455 0.393129 1.388896 0.794997 1.052606 1.611060 1.743638 -0.167971 0.888631 0.570983 1.576402 0.843125 0.114093 0.127173 -0.133155 0.386550 0.090826 -0.017777 0.548430 0.313331 0.380367 1.607846 1.086331 0.772909 1.643444 0.182619 1.863239 1.234660 1.568659 0.555853 0.450573 1.731233 0.287714 1.462361 1.635622 0.921500 0.450553 1.230974 -0.314374 1.516211 0.633822 0.309849 1.238687 0.080817 0.340326 0.819921 0.108053)
+ 10.489680 #r(0.000000 1.276377 0.968620 -0.218445 1.901880 0.088071 1.832261 1.338375 0.312772 1.516596 -0.040044 1.173079 0.061551 1.259985 1.326413 -0.075796 1.430603 0.457729 0.555673 0.169939 0.778858 0.499517 1.015059 1.507495 0.252622 0.024778 0.982934 -0.060048 0.808349 1.306234 -0.213685 0.893109 1.680180 0.816232 1.412440 1.447865 1.309405 0.967681 0.468074 1.167299 -0.294730 0.516281 1.115680 1.346378 1.503302 1.329509 0.069846 0.507313 -0.050602 1.169163 1.172511 1.329654 1.283831 1.273536 0.082962 0.472668 1.944396 -0.083515 1.629124 1.133239 1.648857 0.792610 0.954204 1.052081 0.877455 0.393129 1.388896 0.794997 1.052606 1.611060 1.743638 -0.167971 0.888631 0.570983 1.576402 0.843125 0.114093 0.127173 -0.133155 0.386550 0.090826 -0.017777 0.548430 0.313331 0.380367 1.607846 1.086331 0.772909 1.643444 0.182619 1.863239 1.234660 1.568659 0.555853 0.450573 1.731233 0.287714 1.462361 1.635622 0.921500 0.450553 1.230974 -0.314374 1.516211 0.633822 0.309849 1.238687 0.080817 0.340326 0.819921 0.108053)
;; pp:
- 10.643017 #(0.000000 0.596037 0.998452 1.643602 0.188094 0.782119 1.390123 1.810388 0.670975 1.236188 1.928555 0.736392 1.354483 0.006575 0.718278 1.554028 0.172799 1.022616 1.853097 0.691617 1.671397 0.482108 1.396206 0.302319 1.140585 0.111154 0.983122 0.056085 1.055691 0.244450 1.330135 0.199631 1.342393 0.616747 1.511753 0.573545 1.630931 0.744657 -0.127581 1.276167 0.582439 1.726242 0.856228 0.208204 1.620801 0.767397 -0.120308 1.331917 0.688933 0.171660 1.532348 0.908708 0.322624 0.027670 1.377420 0.714808 0.162920 1.602731 1.164131 0.775892 0.384718 0.044281 1.527000 1.328705 0.880737 0.584683 0.141627 1.752084 1.448907 1.433198 0.874054 1.138685 0.574512 0.605078 0.161111 0.252563 -0.040319 -0.061275 1.677664 1.534157 1.653785 1.516730 1.618593 1.597830 1.517008 1.764779 1.586607 1.708185 1.767619 1.608773 1.820236 0.130593 0.415076 0.510025 0.490569 0.957514 1.270290 1.288854 1.456687 1.689789 0.173097 0.338870 0.690795 1.081327 1.548637 1.886234 0.458387 0.722046 1.068087 1.577951 0.177921)
+ 10.643017 #r(0.000000 0.596037 0.998452 1.643602 0.188094 0.782119 1.390123 1.810388 0.670975 1.236188 1.928555 0.736392 1.354483 0.006575 0.718278 1.554028 0.172799 1.022616 1.853097 0.691617 1.671397 0.482108 1.396206 0.302319 1.140585 0.111154 0.983122 0.056085 1.055691 0.244450 1.330135 0.199631 1.342393 0.616747 1.511753 0.573545 1.630931 0.744657 -0.127581 1.276167 0.582439 1.726242 0.856228 0.208204 1.620801 0.767397 -0.120308 1.331917 0.688933 0.171660 1.532348 0.908708 0.322624 0.027670 1.377420 0.714808 0.162920 1.602731 1.164131 0.775892 0.384718 0.044281 1.527000 1.328705 0.880737 0.584683 0.141627 1.752084 1.448907 1.433198 0.874054 1.138685 0.574512 0.605078 0.161111 0.252563 -0.040319 -0.061275 1.677664 1.534157 1.653785 1.516730 1.618593 1.597830 1.517008 1.764779 1.586607 1.708185 1.767619 1.608773 1.820236 0.130593 0.415076 0.510025 0.490569 0.957514 1.270290 1.288854 1.456687 1.689789 0.173097 0.338870 0.690795 1.081327 1.548637 1.886234 0.458387 0.722046 1.068087 1.577951 0.177921)
;; 112-1
- 10.443480 #(0.000000 -0.037648 1.480547 0.898464 0.849030 0.715984 0.623417 1.093452 1.045921 0.246543 -0.344784 0.997605 0.429765 1.643868 1.074256 0.709084 1.236163 1.022832 0.593800 1.797589 1.639095 0.499474 0.451589 0.525734 0.819269 1.059245 1.215835 0.300337 0.312343 0.508727 1.809376 1.802285 0.733765 0.697253 0.213017 0.226942 0.966882 -0.054080 1.879864 1.400510 1.357810 0.290115 0.291026 1.461469 1.516948 0.034933 0.486567 0.403300 0.540306 0.175821 0.605359 0.053443 -0.120390 0.105172 0.600333 0.664197 1.296750 -0.152576 0.244035 0.980125 0.718707 -0.396109 0.441995 0.857389 0.411314 0.615877 0.959296 0.472542 0.178066 1.504140 1.379940 1.172606 -0.073019 1.778815 0.168644 0.842220 -0.533009 0.218109 1.118845 -0.068508 0.820652 0.991755 -0.019081 1.121993 1.252324 1.508966 1.128293 0.270315 0.609971 -0.037115 1.065942 0.157780 1.138199 0.066912 1.242092 -0.087703 0.391351 0.761091 0.405427 0.623899 1.599600 0.333353 -0.321760 0.806575 1.571941 1.193797 1.308207 1.479299 1.022704 -0.056211 1.366886)
+ 10.443480 #r(0.000000 -0.037648 1.480547 0.898464 0.849030 0.715984 0.623417 1.093452 1.045921 0.246543 -0.344784 0.997605 0.429765 1.643868 1.074256 0.709084 1.236163 1.022832 0.593800 1.797589 1.639095 0.499474 0.451589 0.525734 0.819269 1.059245 1.215835 0.300337 0.312343 0.508727 1.809376 1.802285 0.733765 0.697253 0.213017 0.226942 0.966882 -0.054080 1.879864 1.400510 1.357810 0.290115 0.291026 1.461469 1.516948 0.034933 0.486567 0.403300 0.540306 0.175821 0.605359 0.053443 -0.120390 0.105172 0.600333 0.664197 1.296750 -0.152576 0.244035 0.980125 0.718707 -0.396109 0.441995 0.857389 0.411314 0.615877 0.959296 0.472542 0.178066 1.504140 1.379940 1.172606 -0.073019 1.778815 0.168644 0.842220 -0.533009 0.218109 1.118845 -0.068508 0.820652 0.991755 -0.019081 1.121993 1.252324 1.508966 1.128293 0.270315 0.609971 -0.037115 1.065942 0.157780 1.138199 0.066912 1.242092 -0.087703 0.391351 0.761091 0.405427 0.623899 1.599600 0.333353 -0.321760 0.806575 1.571941 1.193797 1.308207 1.479299 1.022704 -0.056211 1.366886)
)
;;; 112 all -------------------------------------------------------------------------------- ; 10.5830
-(vector 112 13.719 #(0 1 1 0 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0)
+(vector 112 13.719 #r(0 1 1 0 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0)
- 10.459590 #(0.000000 -0.062913 1.592216 0.942127 0.779122 0.819196 0.718354 1.051311 1.122277 0.289276 -0.312849 0.932738 0.364926 1.651917 1.193754 0.735359 1.259741 0.983056 0.504666 1.898067 1.619072 0.449638 0.460210 0.529471 0.685535 0.885439 1.297728 0.246636 0.353836 0.474674 1.786116 1.844574 0.794031 0.522576 0.168364 0.225941 0.884728 0.029172 1.770209 1.576812 1.352123 0.112130 0.389134 1.458224 1.532633 -0.027079 0.404717 0.274263 0.478667 0.228414 0.618491 0.032636 -0.068031 -0.092335 0.583363 0.722295 1.283590 -0.207344 0.372473 0.858879 0.815320 -0.324439 0.478159 0.803167 0.466456 0.633813 0.914568 0.438946 0.113725 1.518872 1.409010 1.227714 -0.134104 1.718626 0.277412 0.813327 -0.439158 0.260660 1.183284 -0.118611 0.754421 1.157336 0.232930 1.195932 1.264381 1.427453 1.112389 0.316426 0.581550 -0.107354 0.998672 0.153435 1.101697 1.916684 1.183525 -0.016743 0.301725 0.815282 0.398182 0.676231 1.536900 0.451259 -0.254624 0.791021 1.692791 1.255094 1.233704 1.361151 1.046040 0.024905 1.319507 0.390306)
+ 10.459590 #r(0.000000 -0.062913 1.592216 0.942127 0.779122 0.819196 0.718354 1.051311 1.122277 0.289276 -0.312849 0.932738 0.364926 1.651917 1.193754 0.735359 1.259741 0.983056 0.504666 1.898067 1.619072 0.449638 0.460210 0.529471 0.685535 0.885439 1.297728 0.246636 0.353836 0.474674 1.786116 1.844574 0.794031 0.522576 0.168364 0.225941 0.884728 0.029172 1.770209 1.576812 1.352123 0.112130 0.389134 1.458224 1.532633 -0.027079 0.404717 0.274263 0.478667 0.228414 0.618491 0.032636 -0.068031 -0.092335 0.583363 0.722295 1.283590 -0.207344 0.372473 0.858879 0.815320 -0.324439 0.478159 0.803167 0.466456 0.633813 0.914568 0.438946 0.113725 1.518872 1.409010 1.227714 -0.134104 1.718626 0.277412 0.813327 -0.439158 0.260660 1.183284 -0.118611 0.754421 1.157336 0.232930 1.195932 1.264381 1.427453 1.112389 0.316426 0.581550 -0.107354 0.998672 0.153435 1.101697 1.916684 1.183525 -0.016743 0.301725 0.815282 0.398182 0.676231 1.536900 0.451259 -0.254624 0.791021 1.692791 1.255094 1.233704 1.361151 1.046040 0.024905 1.319507 0.390306)
)
;;; 113 all -------------------------------------------------------------------------------- ; 10.6301
-(vector 113 14.027848738379 #(0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 0 1 1 1 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 0 1 1 1 0 0 1 0 1 1 1 1 1 0 0 0 1 1 1)
+(vector 113 14.027848738379 #r(0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 0 1 1 1 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 0 1 1 1 0 0 1 0 1 1 1 1 1 0 0 0 1 1 1)
- 10.600374 #(0.000000 0.803646 1.150583 -0.063719 0.153874 1.101937 1.517661 1.839236 0.205434 0.503789 1.408027 1.282481 0.272193 0.581489 0.335632 0.191891 1.772311 1.188767 0.099798 1.108690 0.011443 -0.134966 0.851026 0.685097 0.180285 -0.598894 0.447561 0.453948 1.859577 0.373971 -0.017010 1.368747 0.811506 1.286383 1.607236 0.428535 0.456478 0.425986 0.560105 1.702212 1.615194 -0.029581 1.141022 0.404596 0.679875 1.483164 0.383858 0.334137 1.078889 1.358586 1.100321 0.206891 -0.260760 1.245372 1.320253 -0.104904 0.095400 0.153720 1.818561 0.632022 0.857521 -0.124243 1.123425 -0.152970 0.639127 0.101388 0.775543 0.547622 0.403455 1.168990 1.099889 1.089210 1.061140 1.095647 -0.008863 1.297497 0.125060 1.432503 0.841141 0.967915 1.177416 0.211122 0.724975 0.094432 1.035737 1.190949 0.605535 -0.311727 1.252767 0.699524 1.428815 0.329899 0.934047 0.582587 0.113129 0.668360 0.786133 0.103091 0.745732 1.809761 0.414589 0.231740 -0.023699 1.470163 1.649059 1.087085 1.691589 1.869557 0.611645 1.538351 0.985815 1.244743 0.786305)
+ 10.600374 #r(0.000000 0.803646 1.150583 -0.063719 0.153874 1.101937 1.517661 1.839236 0.205434 0.503789 1.408027 1.282481 0.272193 0.581489 0.335632 0.191891 1.772311 1.188767 0.099798 1.108690 0.011443 -0.134966 0.851026 0.685097 0.180285 -0.598894 0.447561 0.453948 1.859577 0.373971 -0.017010 1.368747 0.811506 1.286383 1.607236 0.428535 0.456478 0.425986 0.560105 1.702212 1.615194 -0.029581 1.141022 0.404596 0.679875 1.483164 0.383858 0.334137 1.078889 1.358586 1.100321 0.206891 -0.260760 1.245372 1.320253 -0.104904 0.095400 0.153720 1.818561 0.632022 0.857521 -0.124243 1.123425 -0.152970 0.639127 0.101388 0.775543 0.547622 0.403455 1.168990 1.099889 1.089210 1.061140 1.095647 -0.008863 1.297497 0.125060 1.432503 0.841141 0.967915 1.177416 0.211122 0.724975 0.094432 1.035737 1.190949 0.605535 -0.311727 1.252767 0.699524 1.428815 0.329899 0.934047 0.582587 0.113129 0.668360 0.786133 0.103091 0.745732 1.809761 0.414589 0.231740 -0.023699 1.470163 1.649059 1.087085 1.691589 1.869557 0.611645 1.538351 0.985815 1.244743 0.786305)
;; pp:
- 10.533209 #(0.000000 0.701701 1.023037 1.805117 0.325103 0.864669 1.301988 0.041817 0.605545 1.212149 1.794798 0.682259 1.361354 0.200642 1.040014 1.570001 0.413916 1.135956 1.836914 0.609510 1.482300 0.433561 1.396354 0.242061 1.189941 0.064290 0.924650 1.865499 0.844070 1.972890 1.045011 0.019512 1.010788 0.256118 1.454283 0.372006 1.414933 0.757156 1.833026 0.854510 0.058898 1.301933 0.794807 0.059810 1.092848 0.343912 1.857250 1.216439 0.367607 1.585969 1.093436 0.524265 1.847968 1.349059 0.839561 0.495981 1.801236 1.298227 0.638863 0.266374 1.658935 1.480658 0.907119 0.639357 0.037985 1.986216 1.525743 1.288722 0.717261 0.704091 0.182223 0.044649 1.629714 1.819647 1.366848 1.330078 1.172022 1.015716 0.897536 0.806098 0.193895 0.422839 0.374579 0.235069 0.423986 0.463374 0.446056 0.493571 0.177728 0.437229 0.621846 0.665477 0.619012 0.807147 1.289974 1.297164 1.517281 1.924928 0.144210 0.370826 0.244142 0.591610 0.749322 1.350513 1.818547 -0.017393 0.517731 1.113988 1.244052 1.823099 0.067707 0.517248 0.930474)
+ 10.533209 #r(0.000000 0.701701 1.023037 1.805117 0.325103 0.864669 1.301988 0.041817 0.605545 1.212149 1.794798 0.682259 1.361354 0.200642 1.040014 1.570001 0.413916 1.135956 1.836914 0.609510 1.482300 0.433561 1.396354 0.242061 1.189941 0.064290 0.924650 1.865499 0.844070 1.972890 1.045011 0.019512 1.010788 0.256118 1.454283 0.372006 1.414933 0.757156 1.833026 0.854510 0.058898 1.301933 0.794807 0.059810 1.092848 0.343912 1.857250 1.216439 0.367607 1.585969 1.093436 0.524265 1.847968 1.349059 0.839561 0.495981 1.801236 1.298227 0.638863 0.266374 1.658935 1.480658 0.907119 0.639357 0.037985 1.986216 1.525743 1.288722 0.717261 0.704091 0.182223 0.044649 1.629714 1.819647 1.366848 1.330078 1.172022 1.015716 0.897536 0.806098 0.193895 0.422839 0.374579 0.235069 0.423986 0.463374 0.446056 0.493571 0.177728 0.437229 0.621846 0.665477 0.619012 0.807147 1.289974 1.297164 1.517281 1.924928 0.144210 0.370826 0.244142 0.591610 0.749322 1.350513 1.818547 -0.017393 0.517731 1.113988 1.244052 1.823099 0.067707 0.517248 0.930474)
;; 112+1
- 10.576527 #(0.000000 -0.099725 1.731869 1.126572 0.894565 0.787291 0.763373 1.116837 1.193937 0.158815 -0.328224 1.005844 0.228474 1.576738 1.262088 0.726943 1.268236 1.028150 0.589551 1.934756 1.609372 0.549105 0.446947 0.675880 0.714883 0.715628 1.363097 0.197217 0.353490 0.498917 1.784841 1.858473 0.777450 0.430951 0.142623 0.145377 1.039521 0.058101 1.806559 1.621009 1.395572 0.126961 0.400552 1.407730 1.420143 0.113046 0.482937 0.384809 0.357336 0.283000 0.705514 -0.045003 0.046604 -0.167904 0.589381 0.672696 1.241252 -0.116645 0.444533 0.866902 0.717018 -0.308546 0.397419 0.905566 0.584026 0.513164 0.877715 0.340382 0.028422 1.468619 1.404513 1.266203 -0.129199 1.813800 0.484278 0.806396 -0.359344 0.323726 1.188865 -0.113226 0.736080 1.212752 0.152030 1.358239 1.256305 1.492197 1.073162 0.176415 0.460366 -0.046759 0.938493 0.111495 1.045740 -0.030211 1.265442 0.071430 0.331346 0.715146 0.333258 0.829360 1.647336 0.578653 -0.323225 0.799001 1.641979 1.340856 1.121452 1.538434 1.235479 0.162729 1.417493 0.473155 0.256349)
+ 10.576527 #r(0.000000 -0.099725 1.731869 1.126572 0.894565 0.787291 0.763373 1.116837 1.193937 0.158815 -0.328224 1.005844 0.228474 1.576738 1.262088 0.726943 1.268236 1.028150 0.589551 1.934756 1.609372 0.549105 0.446947 0.675880 0.714883 0.715628 1.363097 0.197217 0.353490 0.498917 1.784841 1.858473 0.777450 0.430951 0.142623 0.145377 1.039521 0.058101 1.806559 1.621009 1.395572 0.126961 0.400552 1.407730 1.420143 0.113046 0.482937 0.384809 0.357336 0.283000 0.705514 -0.045003 0.046604 -0.167904 0.589381 0.672696 1.241252 -0.116645 0.444533 0.866902 0.717018 -0.308546 0.397419 0.905566 0.584026 0.513164 0.877715 0.340382 0.028422 1.468619 1.404513 1.266203 -0.129199 1.813800 0.484278 0.806396 -0.359344 0.323726 1.188865 -0.113226 0.736080 1.212752 0.152030 1.358239 1.256305 1.492197 1.073162 0.176415 0.460366 -0.046759 0.938493 0.111495 1.045740 -0.030211 1.265442 0.071430 0.331346 0.715146 0.333258 0.829360 1.647336 0.578653 -0.323225 0.799001 1.641979 1.340856 1.121452 1.538434 1.235479 0.162729 1.417493 0.473155 0.256349)
)
;;; 114 all -------------------------------------------------------------------------------- ; 10.6771
-(vector 114 13.847382931726 #(0 1 1 1 1 1 0 0 1 1 1 0 1 0 0 0 1 1 0 1 0 1 1 1 1 0 1 0 1 1 1 0 0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 1 0 0 0 0 1)
+(vector 114 13.847382931726 #r(0 1 1 1 1 1 0 0 1 1 1 0 1 0 0 0 1 1 0 1 0 1 1 1 1 0 1 0 1 1 1 0 0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 1 0 0 0 0 1)
- 10.628224 #(0.000000 0.615672 0.948130 0.747004 0.833637 0.289537 1.854717 0.930205 1.803295 1.161499 -0.674663 0.075654 -0.069447 1.150337 -0.219431 0.096417 1.741068 -0.016217 1.826914 -0.308775 0.152833 0.789042 0.803929 0.462314 0.626523 1.267262 0.400780 0.962101 1.687986 0.905206 0.268457 0.651715 0.114771 1.475643 0.044755 0.228029 0.514674 0.188213 -0.185396 1.589097 0.877857 -0.230405 1.243228 1.194822 1.559225 1.498045 0.808593 -0.017518 1.442649 1.211002 1.811223 0.625459 1.384771 0.613911 0.308197 1.431371 1.357215 1.098185 0.214395 1.664025 1.740860 1.399478 0.567842 0.816563 1.298643 1.214440 0.204096 1.160510 1.171795 0.002888 0.712001 0.408799 0.129596 0.526919 1.018226 1.540087 1.326981 1.269312 0.284234 1.408491 0.614427 1.282597 0.201606 0.407636 1.049940 -0.424432 1.688488 0.609780 -0.014895 -0.443393 1.774217 1.192149 -0.353060 1.542744 1.597711 0.829765 0.335469 0.940418 1.687078 -0.157090 1.505994 0.110351 1.069331 0.286269 -0.198482 1.240708 -0.041616 1.268700 0.079424 0.525193 1.036769 0.352036 1.456021 -0.218427)
+ 10.628224 #r(0.000000 0.615672 0.948130 0.747004 0.833637 0.289537 1.854717 0.930205 1.803295 1.161499 -0.674663 0.075654 -0.069447 1.150337 -0.219431 0.096417 1.741068 -0.016217 1.826914 -0.308775 0.152833 0.789042 0.803929 0.462314 0.626523 1.267262 0.400780 0.962101 1.687986 0.905206 0.268457 0.651715 0.114771 1.475643 0.044755 0.228029 0.514674 0.188213 -0.185396 1.589097 0.877857 -0.230405 1.243228 1.194822 1.559225 1.498045 0.808593 -0.017518 1.442649 1.211002 1.811223 0.625459 1.384771 0.613911 0.308197 1.431371 1.357215 1.098185 0.214395 1.664025 1.740860 1.399478 0.567842 0.816563 1.298643 1.214440 0.204096 1.160510 1.171795 0.002888 0.712001 0.408799 0.129596 0.526919 1.018226 1.540087 1.326981 1.269312 0.284234 1.408491 0.614427 1.282597 0.201606 0.407636 1.049940 -0.424432 1.688488 0.609780 -0.014895 -0.443393 1.774217 1.192149 -0.353060 1.542744 1.597711 0.829765 0.335469 0.940418 1.687078 -0.157090 1.505994 0.110351 1.069331 0.286269 -0.198482 1.240708 -0.041616 1.268700 0.079424 0.525193 1.036769 0.352036 1.456021 -0.218427)
;; pp:
- 10.517948 #(0.000000 0.513150 0.874296 0.883964 0.730138 0.492200 1.910349 0.914831 -0.079055 1.078332 -0.626669 0.137543 -0.184379 1.218055 -0.394114 -0.038192 1.661163 0.020764 -0.078690 -0.096176 0.170832 0.906574 0.889519 0.505117 0.670269 1.228477 0.365822 0.917034 1.728829 0.934323 0.199610 0.715554 0.056223 1.583731 0.085811 0.136885 0.354627 0.123817 -0.315376 1.492556 0.991663 -0.233639 1.201411 1.218512 1.753756 1.719460 0.679044 -0.197393 1.570682 1.193787 1.873756 0.557014 1.432466 0.588568 0.309382 1.651394 1.357542 1.190693 0.264093 1.733513 1.676510 1.179474 0.616239 0.734925 1.107757 1.048586 0.066290 1.132123 1.205852 -0.090603 0.754355 0.838256 -0.013038 0.421890 0.968163 1.389079 1.284090 1.323690 0.432981 1.323326 0.730210 1.395732 0.109710 0.246664 1.169930 -0.449126 1.545991 0.365384 0.076032 -0.458822 1.876049 1.124853 -0.255218 1.423147 1.451143 0.955505 0.281503 0.928421 1.983790 -0.130994 1.684131 0.142847 1.010533 0.452692 -0.386536 1.218551 -0.132981 1.371320 0.120371 0.410528 1.083879 0.496636 1.350228 -0.127680)
+ 10.517948 #r(0.000000 0.513150 0.874296 0.883964 0.730138 0.492200 1.910349 0.914831 -0.079055 1.078332 -0.626669 0.137543 -0.184379 1.218055 -0.394114 -0.038192 1.661163 0.020764 -0.078690 -0.096176 0.170832 0.906574 0.889519 0.505117 0.670269 1.228477 0.365822 0.917034 1.728829 0.934323 0.199610 0.715554 0.056223 1.583731 0.085811 0.136885 0.354627 0.123817 -0.315376 1.492556 0.991663 -0.233639 1.201411 1.218512 1.753756 1.719460 0.679044 -0.197393 1.570682 1.193787 1.873756 0.557014 1.432466 0.588568 0.309382 1.651394 1.357542 1.190693 0.264093 1.733513 1.676510 1.179474 0.616239 0.734925 1.107757 1.048586 0.066290 1.132123 1.205852 -0.090603 0.754355 0.838256 -0.013038 0.421890 0.968163 1.389079 1.284090 1.323690 0.432981 1.323326 0.730210 1.395732 0.109710 0.246664 1.169930 -0.449126 1.545991 0.365384 0.076032 -0.458822 1.876049 1.124853 -0.255218 1.423147 1.451143 0.955505 0.281503 0.928421 1.983790 -0.130994 1.684131 0.142847 1.010533 0.452692 -0.386536 1.218551 -0.132981 1.371320 0.120371 0.410528 1.083879 0.496636 1.350228 -0.127680)
)
;;; 115 all -------------------------------------------------------------------------------- ; 10.7238
-(vector 115 14.359978160099 #(0 0 0 0 1 1 1 0 0 0 0 1 0 1 1 0 0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 0 1 1 0 1 1 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 1 1 1 1 0 0 1 1 0 1 0 1 0 1 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1 0)
+(vector 115 14.359978160099 #r(0 0 0 0 1 1 1 0 0 0 0 1 0 1 1 0 0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 0 1 1 0 1 1 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 1 1 1 1 0 0 1 1 0 1 0 1 0 1 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1 0)
- 10.651124 #(0.000000 0.205632 0.521043 1.123267 0.039976 1.837568 0.645276 0.444856 1.235953 1.614101 0.576705 -0.032817 0.913102 0.971540 0.123207 0.744147 0.392163 1.071292 -0.098894 1.183735 0.447902 1.029195 1.008083 1.241655 1.280374 0.851598 0.236819 1.816127 -0.109787 0.735910 1.359965 1.270732 -0.070459 0.794811 1.337404 0.069925 0.240715 0.381811 0.943512 0.073841 0.371201 0.917351 1.527618 1.440973 1.203354 1.349081 1.416186 1.496910 0.596478 1.312074 0.317957 1.177389 1.248077 0.233191 1.529687 -0.003737 0.662497 0.466830 0.261424 0.663736 1.797196 0.273538 -0.239584 0.345229 -0.159975 1.144743 1.462922 0.849868 0.439184 0.064973 -0.068494 1.400482 0.060773 0.986838 0.519130 0.531890 1.046288 1.063229 -0.449183 0.987082 0.473670 0.722114 1.227775 0.954889 0.100062 1.512033 0.697126 0.308149 0.914574 -0.044099 1.083776 1.037385 0.163494 1.178786 0.886753 1.659086 0.598578 0.720776 -0.009109 0.443556 -0.035564 0.124043 0.119757 0.888837 0.603645 0.075938 0.648026 1.218123 0.325603 0.011855 -0.390969 1.523387 0.517639 0.461045 0.382395)
+ 10.651124 #r(0.000000 0.205632 0.521043 1.123267 0.039976 1.837568 0.645276 0.444856 1.235953 1.614101 0.576705 -0.032817 0.913102 0.971540 0.123207 0.744147 0.392163 1.071292 -0.098894 1.183735 0.447902 1.029195 1.008083 1.241655 1.280374 0.851598 0.236819 1.816127 -0.109787 0.735910 1.359965 1.270732 -0.070459 0.794811 1.337404 0.069925 0.240715 0.381811 0.943512 0.073841 0.371201 0.917351 1.527618 1.440973 1.203354 1.349081 1.416186 1.496910 0.596478 1.312074 0.317957 1.177389 1.248077 0.233191 1.529687 -0.003737 0.662497 0.466830 0.261424 0.663736 1.797196 0.273538 -0.239584 0.345229 -0.159975 1.144743 1.462922 0.849868 0.439184 0.064973 -0.068494 1.400482 0.060773 0.986838 0.519130 0.531890 1.046288 1.063229 -0.449183 0.987082 0.473670 0.722114 1.227775 0.954889 0.100062 1.512033 0.697126 0.308149 0.914574 -0.044099 1.083776 1.037385 0.163494 1.178786 0.886753 1.659086 0.598578 0.720776 -0.009109 0.443556 -0.035564 0.124043 0.119757 0.888837 0.603645 0.075938 0.648026 1.218123 0.325603 0.011855 -0.390969 1.523387 0.517639 0.461045 0.382395)
;; pp:
- 10.692099 #(0.000000 0.682108 1.004779 1.652402 0.376256 0.931307 1.336301 -0.042653 0.588667 1.131321 1.748894 0.607835 1.177352 0.067431 0.978893 1.474587 0.304669 1.111594 1.772579 0.564007 1.383113 0.290881 1.312527 0.215649 0.998467 1.886147 0.914831 1.987244 0.837886 1.778286 0.954819 0.007952 0.956821 0.049735 1.234469 0.317950 1.546668 0.474841 1.665959 0.756708 1.898394 0.922825 0.371276 1.716491 0.889079 0.061723 1.582232 0.834088 0.114964 1.594440 0.728947 -0.028372 1.273062 0.885177 0.297790 1.790777 1.254681 1.031275 0.275613 1.607695 1.196021 0.692250 0.421770 -0.204945 1.512060 0.983139 0.944306 0.546267 0.135875 1.788546 1.584465 1.138761 1.024708 0.473784 0.573120 0.243555 0.106429 0.088753 1.821567 1.941212 1.609147 1.360828 1.169556 1.150415 1.008492 1.219522 1.057528 1.215083 1.411123 0.944912 1.124604 1.295606 1.527918 1.383902 1.570266 -0.108659 -0.107049 0.292041 0.547918 0.923643 1.165187 1.026903 1.427566 1.557678 -0.113193 0.455092 0.823626 1.321739 1.608732 1.934769 0.561130 0.698218 1.143434 1.648015 0.348542)
+ 10.692099 #r(0.000000 0.682108 1.004779 1.652402 0.376256 0.931307 1.336301 -0.042653 0.588667 1.131321 1.748894 0.607835 1.177352 0.067431 0.978893 1.474587 0.304669 1.111594 1.772579 0.564007 1.383113 0.290881 1.312527 0.215649 0.998467 1.886147 0.914831 1.987244 0.837886 1.778286 0.954819 0.007952 0.956821 0.049735 1.234469 0.317950 1.546668 0.474841 1.665959 0.756708 1.898394 0.922825 0.371276 1.716491 0.889079 0.061723 1.582232 0.834088 0.114964 1.594440 0.728947 -0.028372 1.273062 0.885177 0.297790 1.790777 1.254681 1.031275 0.275613 1.607695 1.196021 0.692250 0.421770 -0.204945 1.512060 0.983139 0.944306 0.546267 0.135875 1.788546 1.584465 1.138761 1.024708 0.473784 0.573120 0.243555 0.106429 0.088753 1.821567 1.941212 1.609147 1.360828 1.169556 1.150415 1.008492 1.219522 1.057528 1.215083 1.411123 0.944912 1.124604 1.295606 1.527918 1.383902 1.570266 -0.108659 -0.107049 0.292041 0.547918 0.923643 1.165187 1.026903 1.427566 1.557678 -0.113193 0.455092 0.823626 1.321739 1.608732 1.934769 0.561130 0.698218 1.143434 1.648015 0.348542)
;; 114+1
- 10.621744 #(0.000000 0.519128 0.786784 0.918158 0.650178 0.457293 1.964414 0.915637 -0.037992 1.187864 -0.612331 0.073197 0.008576 1.197804 -0.364310 0.047620 1.612311 0.098163 -0.054077 -0.087970 0.039413 0.986129 0.969342 0.451170 0.648283 1.253012 0.349815 0.949459 1.680558 0.960988 0.220312 0.666892 -0.069695 1.584459 0.070346 0.154295 0.414900 0.222762 -0.268103 1.413909 0.961497 -0.210113 1.203087 1.172411 1.792543 1.742069 0.706989 -0.208070 1.562128 1.211841 0.011662 0.482644 1.455971 0.642656 0.264522 1.637721 1.461442 1.154901 0.149110 1.871307 1.810194 1.307963 0.530941 0.678563 1.057540 1.204932 0.204765 1.173394 1.102820 -0.082769 0.639150 0.715081 -0.172130 0.444439 1.033638 1.431627 1.223005 1.352911 0.473564 1.345853 0.701386 1.441324 0.065510 0.263153 1.148218 -0.395379 1.422829 0.339640 0.186555 -0.374702 1.783978 1.192276 -0.175028 1.327174 1.534754 1.031453 0.306400 0.980338 0.017668 -0.122396 1.685264 0.121507 0.952038 0.457874 -0.310268 1.350976 -0.129566 1.387678 0.182170 0.404390 1.132228 0.552993 1.477216 -0.117535 0.087972)
+ 10.621744 #r(0.000000 0.519128 0.786784 0.918158 0.650178 0.457293 1.964414 0.915637 -0.037992 1.187864 -0.612331 0.073197 0.008576 1.197804 -0.364310 0.047620 1.612311 0.098163 -0.054077 -0.087970 0.039413 0.986129 0.969342 0.451170 0.648283 1.253012 0.349815 0.949459 1.680558 0.960988 0.220312 0.666892 -0.069695 1.584459 0.070346 0.154295 0.414900 0.222762 -0.268103 1.413909 0.961497 -0.210113 1.203087 1.172411 1.792543 1.742069 0.706989 -0.208070 1.562128 1.211841 0.011662 0.482644 1.455971 0.642656 0.264522 1.637721 1.461442 1.154901 0.149110 1.871307 1.810194 1.307963 0.530941 0.678563 1.057540 1.204932 0.204765 1.173394 1.102820 -0.082769 0.639150 0.715081 -0.172130 0.444439 1.033638 1.431627 1.223005 1.352911 0.473564 1.345853 0.701386 1.441324 0.065510 0.263153 1.148218 -0.395379 1.422829 0.339640 0.186555 -0.374702 1.783978 1.192276 -0.175028 1.327174 1.534754 1.031453 0.306400 0.980338 0.017668 -0.122396 1.685264 0.121507 0.952038 0.457874 -0.310268 1.350976 -0.129566 1.387678 0.182170 0.404390 1.132228 0.552993 1.477216 -0.117535 0.087972)
)
;;; 116 all -------------------------------------------------------------------------------- ; 10.7703
-(vector 116 14.175787507646 #(0 1 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 0 0 0 0 1 0 1 1 0)
+(vector 116 14.175787507646 #r(0 1 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 0 0 0 0 1 0 1 1 0)
- 10.666895 #(0.000000 0.794041 0.130396 1.155449 0.575356 1.670182 1.438030 0.802411 -0.073881 0.612189 1.011030 0.243247 1.424701 1.360754 0.519915 1.303274 0.114440 0.486440 1.248641 -0.062831 1.818237 1.003329 1.774020 0.995383 0.217514 0.236196 0.918414 0.251978 0.240543 1.203872 1.193015 1.546847 0.668684 0.276657 0.720261 0.041331 0.124685 1.052830 -0.470877 1.036338 0.454033 1.208580 1.059685 0.252464 0.910634 -0.469687 1.282886 1.260566 1.714177 0.148852 1.558794 0.117249 1.208112 1.206944 1.379709 1.280227 -0.397300 1.912745 1.609055 0.469506 1.102260 0.207876 1.456855 1.808614 1.436770 0.080959 1.197513 1.183739 1.574767 0.068412 1.162064 0.609158 0.566278 1.029997 1.123257 -0.210554 1.006729 1.012851 0.184672 1.531574 1.788773 1.233395 0.609493 0.767948 1.753741 1.423961 0.953617 0.300031 0.940377 0.324215 0.472402 0.042965 0.104811 0.217444 1.091263 1.136923 1.660947 0.519559 1.199475 -0.360436 1.523678 1.224456 -0.014998 1.278905 -0.475457 -0.462757 0.028990 0.974163 1.009397 0.422500 0.343570 0.466660 0.909671 0.746952 -0.297506 0.078048)
+ 10.666895 #r(0.000000 0.794041 0.130396 1.155449 0.575356 1.670182 1.438030 0.802411 -0.073881 0.612189 1.011030 0.243247 1.424701 1.360754 0.519915 1.303274 0.114440 0.486440 1.248641 -0.062831 1.818237 1.003329 1.774020 0.995383 0.217514 0.236196 0.918414 0.251978 0.240543 1.203872 1.193015 1.546847 0.668684 0.276657 0.720261 0.041331 0.124685 1.052830 -0.470877 1.036338 0.454033 1.208580 1.059685 0.252464 0.910634 -0.469687 1.282886 1.260566 1.714177 0.148852 1.558794 0.117249 1.208112 1.206944 1.379709 1.280227 -0.397300 1.912745 1.609055 0.469506 1.102260 0.207876 1.456855 1.808614 1.436770 0.080959 1.197513 1.183739 1.574767 0.068412 1.162064 0.609158 0.566278 1.029997 1.123257 -0.210554 1.006729 1.012851 0.184672 1.531574 1.788773 1.233395 0.609493 0.767948 1.753741 1.423961 0.953617 0.300031 0.940377 0.324215 0.472402 0.042965 0.104811 0.217444 1.091263 1.136923 1.660947 0.519559 1.199475 -0.360436 1.523678 1.224456 -0.014998 1.278905 -0.475457 -0.462757 0.028990 0.974163 1.009397 0.422500 0.343570 0.466660 0.909671 0.746952 -0.297506 0.078048)
)
;;; 117 all -------------------------------------------------------------------------------- ; 10.8167
-(vector 117 14.136 #(0 1 1 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 1 1 1 0 0 0 1 0 0 1 1 1 1 1 0 1 0 1 1 0 1 1 1 1 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1)
+(vector 117 14.136 #r(0 1 1 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 1 1 1 0 0 0 1 0 0 1 1 1 1 1 0 1 0 1 1 0 1 1 1 1 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1)
- 10.740323 #(0.000000 1.376267 1.204802 1.617264 0.013985 1.562933 1.297010 -0.381289 0.175690 0.812406 0.271907 -0.572032 0.505210 1.569967 0.483045 1.266493 1.587294 0.516881 0.600232 0.990644 0.302416 1.037870 1.417076 1.853643 -0.147420 0.890223 1.567662 0.981809 0.815941 1.608390 -0.281550 0.201337 1.556451 1.125175 -0.236163 1.445336 0.258466 0.600771 0.570165 0.048623 0.131732 0.130088 0.167451 1.924952 -0.030799 0.148010 1.615329 0.361965 0.025922 1.817684 1.449080 1.328054 1.692177 0.082231 0.922069 0.868297 0.602630 -0.302067 1.498947 0.796296 -0.211597 1.912831 0.263824 1.087462 0.264795 1.339326 0.746964 1.555264 0.991573 0.792728 0.572734 0.831900 1.561482 0.487864 1.625032 1.584684 1.155708 1.141107 1.673417 0.421621 -0.187613 1.264593 1.627549 0.823098 0.254093 0.097500 0.358549 1.789940 1.103526 1.081236 0.794597 1.136333 1.473853 1.388624 -0.112319 0.798455 -0.090384 -0.176678 0.782426 -0.241572 0.802635 1.296656 0.310053 1.464029 0.628323 1.034158 1.019782 -0.078897 0.005414 1.234988 0.557243 0.357637 -0.491315 0.727622 1.220297 0.073271 0.925087)
+ 10.740323 #r(0.000000 1.376267 1.204802 1.617264 0.013985 1.562933 1.297010 -0.381289 0.175690 0.812406 0.271907 -0.572032 0.505210 1.569967 0.483045 1.266493 1.587294 0.516881 0.600232 0.990644 0.302416 1.037870 1.417076 1.853643 -0.147420 0.890223 1.567662 0.981809 0.815941 1.608390 -0.281550 0.201337 1.556451 1.125175 -0.236163 1.445336 0.258466 0.600771 0.570165 0.048623 0.131732 0.130088 0.167451 1.924952 -0.030799 0.148010 1.615329 0.361965 0.025922 1.817684 1.449080 1.328054 1.692177 0.082231 0.922069 0.868297 0.602630 -0.302067 1.498947 0.796296 -0.211597 1.912831 0.263824 1.087462 0.264795 1.339326 0.746964 1.555264 0.991573 0.792728 0.572734 0.831900 1.561482 0.487864 1.625032 1.584684 1.155708 1.141107 1.673417 0.421621 -0.187613 1.264593 1.627549 0.823098 0.254093 0.097500 0.358549 1.789940 1.103526 1.081236 0.794597 1.136333 1.473853 1.388624 -0.112319 0.798455 -0.090384 -0.176678 0.782426 -0.241572 0.802635 1.296656 0.310053 1.464029 0.628323 1.034158 1.019782 -0.078897 0.005414 1.234988 0.557243 0.357637 -0.491315 0.727622 1.220297 0.073271 0.925087)
)
;;; 118 all -------------------------------------------------------------------------------- ; 10.8628
-(vector 118 14.207115029287 #(0 1 1 1 1 1 1 0 1 0 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 1 1 0 1 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0)
+(vector 118 14.207115029287 #r(0 1 1 1 1 1 1 0 1 0 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 1 1 0 1 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0)
- 10.789998 #(0.000000 -0.175913 -0.143823 0.018273 0.027771 0.767311 -0.171214 1.636246 0.351281 1.388337 0.882351 1.707573 0.469183 0.078893 1.085758 0.618150 0.277129 0.703491 1.759709 -0.452169 1.251866 0.357896 0.724274 0.269975 1.838904 1.530293 1.426834 1.312699 0.647676 1.426356 1.595332 0.060341 0.690735 0.318521 0.226388 0.557313 0.682546 0.405400 0.629229 1.956450 1.295086 1.263226 1.531833 -0.446064 1.088083 -0.430622 1.100111 0.930366 1.309892 0.353356 1.791502 1.255481 1.229378 1.253262 1.406532 0.024314 1.063085 1.088221 0.123383 1.238746 1.005923 0.642418 1.110925 0.453476 -0.290616 1.496832 1.287503 0.244996 1.530267 0.834163 0.976178 0.556214 0.154839 1.049337 1.096181 0.549254 -0.047077 0.951697 1.030491 0.147772 0.888048 0.978379 -0.017946 1.704759 1.894288 0.751630 1.629711 1.581497 1.015790 1.546094 0.769995 1.519488 -0.226811 0.116498 -0.232287 0.274508 1.259352 1.098443 1.128583 0.216589 1.343006 0.117206 0.662844 -0.110291 1.010752 0.251673 1.029907 -0.274450 1.835049 0.199877 0.646328 1.080725 0.210236 1.055491 1.898124 0.072310 0.796446 1.191135)
+ 10.789998 #r(0.000000 -0.175913 -0.143823 0.018273 0.027771 0.767311 -0.171214 1.636246 0.351281 1.388337 0.882351 1.707573 0.469183 0.078893 1.085758 0.618150 0.277129 0.703491 1.759709 -0.452169 1.251866 0.357896 0.724274 0.269975 1.838904 1.530293 1.426834 1.312699 0.647676 1.426356 1.595332 0.060341 0.690735 0.318521 0.226388 0.557313 0.682546 0.405400 0.629229 1.956450 1.295086 1.263226 1.531833 -0.446064 1.088083 -0.430622 1.100111 0.930366 1.309892 0.353356 1.791502 1.255481 1.229378 1.253262 1.406532 0.024314 1.063085 1.088221 0.123383 1.238746 1.005923 0.642418 1.110925 0.453476 -0.290616 1.496832 1.287503 0.244996 1.530267 0.834163 0.976178 0.556214 0.154839 1.049337 1.096181 0.549254 -0.047077 0.951697 1.030491 0.147772 0.888048 0.978379 -0.017946 1.704759 1.894288 0.751630 1.629711 1.581497 1.015790 1.546094 0.769995 1.519488 -0.226811 0.116498 -0.232287 0.274508 1.259352 1.098443 1.128583 0.216589 1.343006 0.117206 0.662844 -0.110291 1.010752 0.251673 1.029907 -0.274450 1.835049 0.199877 0.646328 1.080725 0.210236 1.055491 1.898124 0.072310 0.796446 1.191135)
)
;;; 119 all -------------------------------------------------------------------------------- ; 10.9087
-(vector 119 14.502624011553 #(0 1 0 0 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 1 0 0 1 0 1 0 1 0 0)
+(vector 119 14.502624011553 #r(0 1 0 0 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 1 0 0 1 0 1 0 1 0 0)
- 10.894037 #(0.000000 0.630386 0.843125 1.285949 0.340650 -0.017357 0.327019 1.384996 1.081793 1.397782 0.680727 0.599720 0.760758 1.651799 1.943215 0.601150 0.438753 0.220032 0.283706 0.321338 1.848806 -0.818805 1.279239 0.233383 -0.265065 0.149488 0.866113 1.211455 -0.153192 1.086507 -0.117739 0.108345 0.296077 0.924788 0.407609 0.257469 1.108157 0.337516 1.501434 -0.160734 0.937661 1.194914 0.677862 1.064411 -0.083066 0.280209 0.164734 0.604351 1.488726 0.546557 -0.173942 0.258452 -0.144704 1.931749 1.121694 0.070973 1.246077 0.433607 -0.015989 1.447158 1.307009 0.290513 1.032586 0.483509 0.866614 0.896091 0.118763 0.703456 1.160811 -0.272718 1.618947 0.922379 0.186934 0.444686 0.391527 -0.170445 0.686201 0.072390 -0.083273 0.261424 1.315326 1.343146 -0.078550 0.581799 0.100158 0.342044 0.531455 0.823995 0.311378 0.398507 -0.067564 1.021721 0.099971 0.375472 1.694822 -0.129069 0.760774 0.760279 0.907128 1.373425 1.265414 0.699858 -0.214864 -0.228584 1.101084 1.533737 1.209100 1.477560 0.508584 0.989498 0.862450 0.271802 1.549833 0.881136 1.017209 0.041014 1.240632 1.019564 1.718786)
+ 10.894037 #r(0.000000 0.630386 0.843125 1.285949 0.340650 -0.017357 0.327019 1.384996 1.081793 1.397782 0.680727 0.599720 0.760758 1.651799 1.943215 0.601150 0.438753 0.220032 0.283706 0.321338 1.848806 -0.818805 1.279239 0.233383 -0.265065 0.149488 0.866113 1.211455 -0.153192 1.086507 -0.117739 0.108345 0.296077 0.924788 0.407609 0.257469 1.108157 0.337516 1.501434 -0.160734 0.937661 1.194914 0.677862 1.064411 -0.083066 0.280209 0.164734 0.604351 1.488726 0.546557 -0.173942 0.258452 -0.144704 1.931749 1.121694 0.070973 1.246077 0.433607 -0.015989 1.447158 1.307009 0.290513 1.032586 0.483509 0.866614 0.896091 0.118763 0.703456 1.160811 -0.272718 1.618947 0.922379 0.186934 0.444686 0.391527 -0.170445 0.686201 0.072390 -0.083273 0.261424 1.315326 1.343146 -0.078550 0.581799 0.100158 0.342044 0.531455 0.823995 0.311378 0.398507 -0.067564 1.021721 0.099971 0.375472 1.694822 -0.129069 0.760774 0.760279 0.907128 1.373425 1.265414 0.699858 -0.214864 -0.228584 1.101084 1.533737 1.209100 1.477560 0.508584 0.989498 0.862450 0.271802 1.549833 0.881136 1.017209 0.041014 1.240632 1.019564 1.718786)
;; pp:
- 10.835933 #(0.000000 0.654099 1.035661 1.681354 0.271205 0.793039 1.296335 0.060400 0.653112 1.232942 1.881379 0.620355 1.199841 0.014260 0.823834 1.413032 0.189484 0.947478 1.588848 0.403300 1.280378 0.215388 1.137801 1.956237 0.732861 1.657436 0.792204 1.789188 0.703767 1.598762 0.539735 1.541253 0.421443 1.469357 0.779053 -0.021286 1.026341 0.083226 1.233425 0.357509 1.441485 0.752264 1.858411 1.012419 0.073105 1.341491 0.748507 0.322726 1.533912 0.715880 0.027861 1.454725 0.694006 -0.082536 1.358750 0.823835 0.158492 1.802363 1.289166 0.871603 0.288280 1.653699 1.258131 0.754564 0.197129 -0.135159 1.406727 1.305489 0.902560 0.505625 0.165621 1.980298 1.711088 1.181402 1.035732 0.515951 0.573196 0.077979 0.369360 -0.029664 0.027976 1.710591 1.639472 1.419449 1.489927 1.072898 1.080212 0.909135 0.903629 1.096948 0.947039 1.126463 1.358955 0.953854 1.137457 1.170488 1.431020 1.393091 1.493097 1.708464 0.028863 0.359918 0.447603 0.693507 1.013920 0.980939 1.193095 1.522944 -0.124582 0.421795 0.849849 1.081289 1.559178 0.036966 0.454552 0.747770 1.437228 1.496079 0.068555)
+ 10.835933 #r(0.000000 0.654099 1.035661 1.681354 0.271205 0.793039 1.296335 0.060400 0.653112 1.232942 1.881379 0.620355 1.199841 0.014260 0.823834 1.413032 0.189484 0.947478 1.588848 0.403300 1.280378 0.215388 1.137801 1.956237 0.732861 1.657436 0.792204 1.789188 0.703767 1.598762 0.539735 1.541253 0.421443 1.469357 0.779053 -0.021286 1.026341 0.083226 1.233425 0.357509 1.441485 0.752264 1.858411 1.012419 0.073105 1.341491 0.748507 0.322726 1.533912 0.715880 0.027861 1.454725 0.694006 -0.082536 1.358750 0.823835 0.158492 1.802363 1.289166 0.871603 0.288280 1.653699 1.258131 0.754564 0.197129 -0.135159 1.406727 1.305489 0.902560 0.505625 0.165621 1.980298 1.711088 1.181402 1.035732 0.515951 0.573196 0.077979 0.369360 -0.029664 0.027976 1.710591 1.639472 1.419449 1.489927 1.072898 1.080212 0.909135 0.903629 1.096948 0.947039 1.126463 1.358955 0.953854 1.137457 1.170488 1.431020 1.393091 1.493097 1.708464 0.028863 0.359918 0.447603 0.693507 1.013920 0.980939 1.193095 1.522944 -0.124582 0.421795 0.849849 1.081289 1.559178 0.036966 0.454552 0.747770 1.437228 1.496079 0.068555)
)
;;; 120 all -------------------------------------------------------------------------------- ; 10.9545
-(vector 120 14.534638752286 #(0 0 0 0 0 1 0 1 1 0 1 0 1 1 1 0 1 1 1 1 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 1 1 1 0 0 1 1 0 0 1 1 1 0 1 0 0 0 1 1 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 1 0 0 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0)
+(vector 120 14.534638752286 #r(0 0 0 0 0 1 0 1 1 0 1 0 1 1 1 0 1 1 1 1 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 1 1 1 0 0 1 1 0 0 1 1 1 0 1 0 0 0 1 1 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 1 0 0 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0)
- 10.877907 #(0.000000 1.760966 1.432317 0.661698 0.093764 0.677833 1.324379 0.560678 0.084000 1.893101 0.982568 0.231983 0.030976 1.869849 0.114160 0.803943 1.697252 0.187259 0.348967 1.325837 0.129934 0.628168 -0.292961 -0.172670 0.424548 1.491809 -0.230282 0.327899 -0.371234 1.709483 0.949653 0.922124 1.730156 1.323261 1.332457 0.313981 1.342414 0.100580 0.697678 0.026744 -0.054235 1.341652 -0.009876 1.698348 0.248931 -0.183551 1.470018 1.710913 1.251473 0.727247 1.872729 0.011341 0.025061 0.694946 1.531659 0.478715 1.097259 0.657341 1.219034 0.633776 0.382770 0.377028 0.092620 0.800796 0.434789 0.301288 0.942251 -0.118601 -0.116547 1.180657 1.270834 0.986907 0.237837 0.780073 1.628870 -0.280374 -0.194405 0.622013 0.090032 1.411166 0.490814 -0.298299 1.291149 1.730249 1.587675 1.193266 0.285035 0.236562 1.437795 0.582458 1.521211 0.605547 0.877830 1.441130 1.061898 0.936396 1.257893 0.016398 -0.126771 0.102714 1.392810 1.183106 1.832099 1.740994 0.232560 0.367779 0.656921 -0.130561 0.093991 0.079826 0.694300 1.076720 1.076648 -0.154506 1.074489 -0.219932 0.141670 -0.212932 0.458505 1.362796)
+ 10.877907 #r(0.000000 1.760966 1.432317 0.661698 0.093764 0.677833 1.324379 0.560678 0.084000 1.893101 0.982568 0.231983 0.030976 1.869849 0.114160 0.803943 1.697252 0.187259 0.348967 1.325837 0.129934 0.628168 -0.292961 -0.172670 0.424548 1.491809 -0.230282 0.327899 -0.371234 1.709483 0.949653 0.922124 1.730156 1.323261 1.332457 0.313981 1.342414 0.100580 0.697678 0.026744 -0.054235 1.341652 -0.009876 1.698348 0.248931 -0.183551 1.470018 1.710913 1.251473 0.727247 1.872729 0.011341 0.025061 0.694946 1.531659 0.478715 1.097259 0.657341 1.219034 0.633776 0.382770 0.377028 0.092620 0.800796 0.434789 0.301288 0.942251 -0.118601 -0.116547 1.180657 1.270834 0.986907 0.237837 0.780073 1.628870 -0.280374 -0.194405 0.622013 0.090032 1.411166 0.490814 -0.298299 1.291149 1.730249 1.587675 1.193266 0.285035 0.236562 1.437795 0.582458 1.521211 0.605547 0.877830 1.441130 1.061898 0.936396 1.257893 0.016398 -0.126771 0.102714 1.392810 1.183106 1.832099 1.740994 0.232560 0.367779 0.656921 -0.130561 0.093991 0.079826 0.694300 1.076720 1.076648 -0.154506 1.074489 -0.219932 0.141670 -0.212932 0.458505 1.362796)
)
;;; 121 all -------------------------------------------------------------------------------- ; 11
-(vector 121 14.184466362 #(0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 0 1 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1)
+(vector 121 14.184466362 #r(0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 0 1 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1)
- 10.924906 #(0.000000 1.021993 1.334449 0.689448 0.491891 0.317117 0.185100 1.316740 0.942417 -0.055518 1.467945 1.216575 0.460144 1.613483 1.346938 0.351666 1.534737 1.166463 0.663385 1.751743 0.887304 0.686057 0.353407 0.640903 0.247744 0.051185 1.683771 0.607042 -0.642997 1.586265 1.428130 1.293714 0.376348 1.687396 1.342115 1.114987 0.421788 0.173805 0.664896 0.744172 1.338635 0.611663 0.948619 1.727026 0.108093 1.757613 1.759583 0.684030 0.701845 0.897975 1.291554 1.678993 -0.010218 1.672340 1.419180 0.531998 1.055064 0.071044 -0.158722 1.660752 -0.273616 1.601063 0.212433 0.488138 0.674057 0.101023 0.258204 0.323292 0.370652 0.521650 1.206457 1.206236 0.768851 0.204856 0.771378 0.971274 -0.207666 0.711434 0.295654 1.831769 0.464965 1.896472 0.968538 0.024673 1.250922 1.351355 0.486851 0.833273 1.147617 1.669210 0.770997 -0.072413 0.463363 1.323688 1.050580 1.732192 0.819244 0.777660 1.040697 0.078135 0.787038 1.358361 0.700196 0.074501 0.587042 0.515371 1.216302 0.852496 0.581485 0.849691 1.814480 1.077357 0.162962 0.766524 -0.151640 0.240975 0.296067 0.314628 1.286198 0.210485 0.583580)
+ 10.924906 #r(0.000000 1.021993 1.334449 0.689448 0.491891 0.317117 0.185100 1.316740 0.942417 -0.055518 1.467945 1.216575 0.460144 1.613483 1.346938 0.351666 1.534737 1.166463 0.663385 1.751743 0.887304 0.686057 0.353407 0.640903 0.247744 0.051185 1.683771 0.607042 -0.642997 1.586265 1.428130 1.293714 0.376348 1.687396 1.342115 1.114987 0.421788 0.173805 0.664896 0.744172 1.338635 0.611663 0.948619 1.727026 0.108093 1.757613 1.759583 0.684030 0.701845 0.897975 1.291554 1.678993 -0.010218 1.672340 1.419180 0.531998 1.055064 0.071044 -0.158722 1.660752 -0.273616 1.601063 0.212433 0.488138 0.674057 0.101023 0.258204 0.323292 0.370652 0.521650 1.206457 1.206236 0.768851 0.204856 0.771378 0.971274 -0.207666 0.711434 0.295654 1.831769 0.464965 1.896472 0.968538 0.024673 1.250922 1.351355 0.486851 0.833273 1.147617 1.669210 0.770997 -0.072413 0.463363 1.323688 1.050580 1.732192 0.819244 0.777660 1.040697 0.078135 0.787038 1.358361 0.700196 0.074501 0.587042 0.515371 1.216302 0.852496 0.581485 0.849691 1.814480 1.077357 0.162962 0.766524 -0.151640 0.240975 0.296067 0.314628 1.286198 0.210485 0.583580)
)
;;; 122 all -------------------------------------------------------------------------------- ; 11.0454
-(vector 122 14.536 #(0 1 1 0 0 0 1 1 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 1 0 0 1 1 1 1 0 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 0 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 0 1 0 1 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 0)
+(vector 122 14.536 #r(0 1 1 0 0 0 1 1 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 1 0 0 1 1 1 1 0 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 0 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 0 1 0 1 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 0)
- 10.949841 #(0.000000 1.704153 0.121290 0.688837 1.244030 1.262068 -0.197896 0.413249 1.197451 1.272156 0.642587 1.292432 1.783982 0.043702 1.158291 1.164647 1.692639 1.493672 1.007369 1.436042 1.725774 0.880017 0.375925 1.616969 0.128447 1.149978 1.084930 0.463608 1.105848 1.530070 1.424718 0.719589 0.763768 0.288678 1.156946 0.691396 0.064365 0.469636 1.091974 0.426323 1.090313 0.491849 0.938048 1.656418 0.459182 0.976494 0.376276 1.451323 1.601769 -0.407170 0.538990 1.732338 0.050678 1.192103 0.536699 0.739148 1.592439 -0.026377 0.032581 0.995911 0.348311 -0.030558 1.293098 0.192261 0.610689 1.016189 0.912642 1.102218 1.291663 0.930392 1.417016 1.312774 1.826696 0.250091 0.993926 0.681381 0.628174 0.441959 1.489842 0.532045 1.179384 0.517873 0.125155 1.064841 1.980073 0.744857 1.235778 1.280286 1.634199 -0.058763 1.206383 1.265460 1.054717 0.853628 1.196638 0.872935 -0.314369 0.468836 0.081998 0.420778 1.325508 1.934649 1.587718 1.251054 -0.176641 -0.893762 0.381112 0.198904 0.283702 1.674181 1.521739 0.754893 1.659031 0.756575 0.235790 -0.129516 1.697508 -0.350053 0.868125 -0.095111 1.099831 0.951722)
+ 10.949841 #r(0.000000 1.704153 0.121290 0.688837 1.244030 1.262068 -0.197896 0.413249 1.197451 1.272156 0.642587 1.292432 1.783982 0.043702 1.158291 1.164647 1.692639 1.493672 1.007369 1.436042 1.725774 0.880017 0.375925 1.616969 0.128447 1.149978 1.084930 0.463608 1.105848 1.530070 1.424718 0.719589 0.763768 0.288678 1.156946 0.691396 0.064365 0.469636 1.091974 0.426323 1.090313 0.491849 0.938048 1.656418 0.459182 0.976494 0.376276 1.451323 1.601769 -0.407170 0.538990 1.732338 0.050678 1.192103 0.536699 0.739148 1.592439 -0.026377 0.032581 0.995911 0.348311 -0.030558 1.293098 0.192261 0.610689 1.016189 0.912642 1.102218 1.291663 0.930392 1.417016 1.312774 1.826696 0.250091 0.993926 0.681381 0.628174 0.441959 1.489842 0.532045 1.179384 0.517873 0.125155 1.064841 1.980073 0.744857 1.235778 1.280286 1.634199 -0.058763 1.206383 1.265460 1.054717 0.853628 1.196638 0.872935 -0.314369 0.468836 0.081998 0.420778 1.325508 1.934649 1.587718 1.251054 -0.176641 -0.893762 0.381112 0.198904 0.283702 1.674181 1.521739 0.754893 1.659031 0.756575 0.235790 -0.129516 1.697508 -0.350053 0.868125 -0.095111 1.099831 0.951722)
)
;;; 123 all -------------------------------------------------------------------------------- ; 11.0905
-(vector 123 14.67458183944 #(0 0 1 1 1 0 0 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 0 0 1 1 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 0 0 1 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 0 1 0 0 1 0 0 0 0 0 1 0 1 0 0 0 1 0 1)
+(vector 123 14.67458183944 #r(0 0 1 1 1 0 0 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 0 0 1 1 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 0 0 1 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 0 1 0 0 1 0 0 0 0 0 1 0 1 0 0 0 1 0 1)
- 11.089811 #(0.000000 -0.095705 0.502046 0.843201 1.262416 0.051297 -0.136069 1.229943 0.769550 -0.394544 1.202311 0.030935 0.212789 0.180234 1.202646 1.847334 1.298798 1.298567 0.826116 1.899995 0.130966 0.229988 0.849236 1.354957 0.175337 -0.090289 1.376955 0.986456 0.858952 -0.348674 -0.073167 -0.218495 1.696358 1.036669 1.130688 0.308330 0.510630 1.786938 -0.105214 0.654929 1.564764 1.314058 0.677163 -0.213165 1.538085 0.616182 0.862650 0.165337 -0.034200 1.035704 0.813627 1.106006 1.740931 0.014126 1.052235 0.657556 1.858826 0.165758 0.630519 0.409633 -0.040211 1.543795 1.391268 -0.071463 1.608090 0.360070 -0.066709 0.298864 0.437480 -0.144723 -0.061475 0.229100 1.150525 0.049068 -0.178297 1.796933 1.253507 1.460767 1.254789 1.053122 -0.014640 1.158719 1.833281 -0.100606 1.043660 0.125118 1.383020 0.234098 0.814218 -0.263454 1.710640 0.541462 0.096383 0.540963 -0.022417 0.505975 1.860187 1.286017 0.269581 0.338845 0.988364 0.065927 0.952682 1.381585 1.156408 1.384314 0.622434 1.536785 0.876899 0.457680 0.787662 1.764741 0.741434 -0.166817 0.104157 0.779344 1.374068 1.055092 1.250202 1.254085 1.185506 -0.050283 -0.314919)
+ 11.089811 #r(0.000000 -0.095705 0.502046 0.843201 1.262416 0.051297 -0.136069 1.229943 0.769550 -0.394544 1.202311 0.030935 0.212789 0.180234 1.202646 1.847334 1.298798 1.298567 0.826116 1.899995 0.130966 0.229988 0.849236 1.354957 0.175337 -0.090289 1.376955 0.986456 0.858952 -0.348674 -0.073167 -0.218495 1.696358 1.036669 1.130688 0.308330 0.510630 1.786938 -0.105214 0.654929 1.564764 1.314058 0.677163 -0.213165 1.538085 0.616182 0.862650 0.165337 -0.034200 1.035704 0.813627 1.106006 1.740931 0.014126 1.052235 0.657556 1.858826 0.165758 0.630519 0.409633 -0.040211 1.543795 1.391268 -0.071463 1.608090 0.360070 -0.066709 0.298864 0.437480 -0.144723 -0.061475 0.229100 1.150525 0.049068 -0.178297 1.796933 1.253507 1.460767 1.254789 1.053122 -0.014640 1.158719 1.833281 -0.100606 1.043660 0.125118 1.383020 0.234098 0.814218 -0.263454 1.710640 0.541462 0.096383 0.540963 -0.022417 0.505975 1.860187 1.286017 0.269581 0.338845 0.988364 0.065927 0.952682 1.381585 1.156408 1.384314 0.622434 1.536785 0.876899 0.457680 0.787662 1.764741 0.741434 -0.166817 0.104157 0.779344 1.374068 1.055092 1.250202 1.254085 1.185506 -0.050283 -0.314919)
;; pp:
- 11.016135 #(0.000000 0.647630 1.074276 1.756268 0.251422 0.804135 1.421127 0.040524 0.665959 1.111755 1.848209 0.635476 1.226811 0.078653 0.744267 1.473903 0.238865 0.830996 1.602610 0.483888 1.291535 0.032720 0.918740 1.769630 0.682055 1.658606 0.644590 1.383351 0.360438 1.331009 0.396705 1.499558 0.394585 1.332297 0.284286 1.367163 0.697156 1.873754 1.072911 0.259822 1.429562 0.401628 1.434105 0.713387 0.052744 1.073687 0.172805 1.418890 0.502359 0.008598 1.451186 0.715950 -0.032063 1.332938 0.645483 -0.170523 1.375389 0.799087 0.277881 1.623936 1.051516 0.728226 0.326139 1.759949 1.287776 0.814001 0.247394 -0.079677 1.277221 1.247278 0.815434 0.548501 0.120625 1.806890 1.668828 1.491775 0.975860 0.670802 0.343501 0.107101 -0.116370 1.739084 1.782173 1.584916 1.517015 1.084964 1.270093 0.937194 1.142225 0.603049 0.902612 0.582213 0.697513 0.723238 0.854795 0.946568 1.173389 0.894182 1.104017 0.982296 1.332899 1.077929 1.505566 1.771677 1.766832 0.125556 0.284805 0.740017 0.785432 0.946551 1.254134 1.343675 1.825955 0.281285 0.688963 0.928919 1.510642 0.002528 0.243797 0.692027 1.356775 1.422418 -0.003671)
+ 11.016135 #r(0.000000 0.647630 1.074276 1.756268 0.251422 0.804135 1.421127 0.040524 0.665959 1.111755 1.848209 0.635476 1.226811 0.078653 0.744267 1.473903 0.238865 0.830996 1.602610 0.483888 1.291535 0.032720 0.918740 1.769630 0.682055 1.658606 0.644590 1.383351 0.360438 1.331009 0.396705 1.499558 0.394585 1.332297 0.284286 1.367163 0.697156 1.873754 1.072911 0.259822 1.429562 0.401628 1.434105 0.713387 0.052744 1.073687 0.172805 1.418890 0.502359 0.008598 1.451186 0.715950 -0.032063 1.332938 0.645483 -0.170523 1.375389 0.799087 0.277881 1.623936 1.051516 0.728226 0.326139 1.759949 1.287776 0.814001 0.247394 -0.079677 1.277221 1.247278 0.815434 0.548501 0.120625 1.806890 1.668828 1.491775 0.975860 0.670802 0.343501 0.107101 -0.116370 1.739084 1.782173 1.584916 1.517015 1.084964 1.270093 0.937194 1.142225 0.603049 0.902612 0.582213 0.697513 0.723238 0.854795 0.946568 1.173389 0.894182 1.104017 0.982296 1.332899 1.077929 1.505566 1.771677 1.766832 0.125556 0.284805 0.740017 0.785432 0.946551 1.254134 1.343675 1.825955 0.281285 0.688963 0.928919 1.510642 0.002528 0.243797 0.692027 1.356775 1.422418 -0.003671)
)
;;; 124 all -------------------------------------------------------------------------------- ; 11.1355
-(vector 124 14.607 #(0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 1 1 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 1 1 1 0 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1)
+(vector 124 14.607 #r(0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 1 1 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 1 1 1 0 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1)
- 11.060270 #(0.000000 0.155441 1.710148 0.675606 0.991885 0.930398 0.521431 0.244313 1.630742 0.168790 0.137270 0.000305 -0.043062 0.897696 0.964832 0.045064 0.425268 0.964217 1.290413 0.929170 0.235812 1.335949 0.057667 0.001006 1.068524 0.446791 1.393120 0.549817 1.466180 -0.642251 1.637204 0.595543 0.457077 0.355722 0.196249 1.437718 -0.302241 1.024336 1.392207 1.340742 0.398137 0.737820 0.315317 0.261053 0.730496 0.895111 0.489074 0.360451 1.441085 0.496392 1.486058 1.322042 1.007323 -0.126599 0.931744 1.784266 0.161232 0.306266 0.415406 0.681040 1.790701 0.980642 -0.005904 1.343074 0.136975 0.027551 -0.124807 1.525812 0.151673 1.852354 0.924568 1.280951 0.029602 0.736180 1.201925 0.667470 1.226105 0.326690 0.609507 -0.393588 1.467285 1.671123 1.358186 0.541731 1.122604 1.867616 -0.473631 -0.417534 0.660754 1.837680 1.546497 0.596764 1.110785 0.215660 0.434300 0.180279 1.110604 0.505631 1.274765 1.668673 0.193680 0.673308 0.543007 1.365849 -0.310522 0.237117 0.174423 1.731063 0.766964 0.281277 -0.402143 0.989963 0.637238 0.526844 0.787012 1.257855 0.717061 0.758671 0.882050 1.342356 0.626910 1.083549 0.608055 0.472324)
+ 11.060270 #r(0.000000 0.155441 1.710148 0.675606 0.991885 0.930398 0.521431 0.244313 1.630742 0.168790 0.137270 0.000305 -0.043062 0.897696 0.964832 0.045064 0.425268 0.964217 1.290413 0.929170 0.235812 1.335949 0.057667 0.001006 1.068524 0.446791 1.393120 0.549817 1.466180 -0.642251 1.637204 0.595543 0.457077 0.355722 0.196249 1.437718 -0.302241 1.024336 1.392207 1.340742 0.398137 0.737820 0.315317 0.261053 0.730496 0.895111 0.489074 0.360451 1.441085 0.496392 1.486058 1.322042 1.007323 -0.126599 0.931744 1.784266 0.161232 0.306266 0.415406 0.681040 1.790701 0.980642 -0.005904 1.343074 0.136975 0.027551 -0.124807 1.525812 0.151673 1.852354 0.924568 1.280951 0.029602 0.736180 1.201925 0.667470 1.226105 0.326690 0.609507 -0.393588 1.467285 1.671123 1.358186 0.541731 1.122604 1.867616 -0.473631 -0.417534 0.660754 1.837680 1.546497 0.596764 1.110785 0.215660 0.434300 0.180279 1.110604 0.505631 1.274765 1.668673 0.193680 0.673308 0.543007 1.365849 -0.310522 0.237117 0.174423 1.731063 0.766964 0.281277 -0.402143 0.989963 0.637238 0.526844 0.787012 1.257855 0.717061 0.758671 0.882050 1.342356 0.626910 1.083549 0.608055 0.472324)
)
;;; 125 all -------------------------------------------------------------------------------- ; 11.1803
-(vector 125 14.985 #(0 0 0 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 1 1 1 0 0 1 0 0 0 1 1 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 0 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0)
+(vector 125 14.985 #r(0 0 0 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 1 1 1 0 0 1 0 0 0 1 1 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 0 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0)
;; 11.16794
- 11.160786 #(0.000000 1.015332 1.208067 1.409127 0.622612 0.043137 0.789070 0.545823 0.370412 0.925346 1.157620 0.165772 1.424901 0.898702 1.656211 0.988303 1.801194 1.470568 1.745983 0.609307 -0.597689 0.731241 -0.142723 0.984230 0.073162 1.875752 0.335696 1.602183 0.142368 0.017160 0.448032 0.120103 0.041279 0.523055 0.073650 1.053879 -0.306921 1.513911 1.101021 1.602539 -0.121119 0.641316 -0.004631 1.595461 1.743817 0.418939 0.589672 1.179156 0.811957 1.197450 1.342788 1.287174 1.574681 1.241671 0.609625 0.929510 0.079585 0.612922 1.100363 0.431650 -0.459913 0.120058 0.264463 0.028955 1.140993 0.787792 1.007154 0.514281 1.114045 1.286846 1.241625 0.916235 0.449091 1.255016 0.869776 0.016192 1.421914 1.225032 1.302610 0.650162 0.956126 0.761196 -0.213826 0.222275 -0.426223 1.123082 0.506980 1.405113 0.081703 0.828457 1.262806 1.843366 0.399948 0.473729 -0.529905 1.215838 1.003418 1.687511 0.432881 1.055890 1.071502 1.087648 0.147867 -0.002533 0.317269 1.612891 -0.180768 1.003458 1.820527 0.761821 1.137143 0.352919 -0.090034 1.456553 0.819912 0.115658 0.246973 0.936701 1.319554 0.851128 1.479387 0.046130 1.488656 0.854373 0.867709)
+ 11.160786 #r(0.000000 1.015332 1.208067 1.409127 0.622612 0.043137 0.789070 0.545823 0.370412 0.925346 1.157620 0.165772 1.424901 0.898702 1.656211 0.988303 1.801194 1.470568 1.745983 0.609307 -0.597689 0.731241 -0.142723 0.984230 0.073162 1.875752 0.335696 1.602183 0.142368 0.017160 0.448032 0.120103 0.041279 0.523055 0.073650 1.053879 -0.306921 1.513911 1.101021 1.602539 -0.121119 0.641316 -0.004631 1.595461 1.743817 0.418939 0.589672 1.179156 0.811957 1.197450 1.342788 1.287174 1.574681 1.241671 0.609625 0.929510 0.079585 0.612922 1.100363 0.431650 -0.459913 0.120058 0.264463 0.028955 1.140993 0.787792 1.007154 0.514281 1.114045 1.286846 1.241625 0.916235 0.449091 1.255016 0.869776 0.016192 1.421914 1.225032 1.302610 0.650162 0.956126 0.761196 -0.213826 0.222275 -0.426223 1.123082 0.506980 1.405113 0.081703 0.828457 1.262806 1.843366 0.399948 0.473729 -0.529905 1.215838 1.003418 1.687511 0.432881 1.055890 1.071502 1.087648 0.147867 -0.002533 0.317269 1.612891 -0.180768 1.003458 1.820527 0.761821 1.137143 0.352919 -0.090034 1.456553 0.819912 0.115658 0.246973 0.936701 1.319554 0.851128 1.479387 0.046130 1.488656 0.854373 0.867709)
;; pp.scm:
- 11.105486 #(0.000000 0.668250 1.004851 1.665604 0.270207 0.823031 1.317389 1.895775 0.442735 1.092420 1.706335 0.316469 1.053513 1.851731 0.426377 1.214568 0.111950 0.768130 1.567897 0.318224 1.096474 0.028789 0.851033 1.730934 0.518266 1.394840 0.485490 1.534760 0.346603 1.302654 0.195595 1.075240 0.149474 1.131730 0.186045 1.296000 0.352391 1.439364 0.663850 1.837274 0.958873 0.121068 1.316333 0.242865 1.517748 0.747235 1.882566 1.040766 0.534079 1.729417 0.993163 0.496721 1.811700 1.002981 0.317419 1.678987 0.959753 0.256596 1.817235 1.299690 0.756280 0.292629 1.822282 1.254136 0.905795 0.232927 1.675869 1.252625 0.924210 0.377830 0.081344 1.650592 1.565111 1.210398 0.823930 0.495597 0.170992 -0.097351 1.629713 1.238397 1.141529 0.804262 0.860680 0.603481 0.666502 0.428034 0.395443 0.132689 1.849680 0.035737 1.395931 1.824957 1.358060 1.651982 1.606952 1.718179 1.670215 1.887548 1.688422 1.844666 -0.292284 0.050366 -0.101906 0.075572 0.305815 0.606639 0.913420 1.030088 1.512470 1.549064 1.827384 0.007726 0.106419 0.461039 0.753337 1.221334 1.792974 0.097112 0.617097 1.170484 1.176316 1.664541 0.165974 0.635539 1.022624)
+ 11.105486 #r(0.000000 0.668250 1.004851 1.665604 0.270207 0.823031 1.317389 1.895775 0.442735 1.092420 1.706335 0.316469 1.053513 1.851731 0.426377 1.214568 0.111950 0.768130 1.567897 0.318224 1.096474 0.028789 0.851033 1.730934 0.518266 1.394840 0.485490 1.534760 0.346603 1.302654 0.195595 1.075240 0.149474 1.131730 0.186045 1.296000 0.352391 1.439364 0.663850 1.837274 0.958873 0.121068 1.316333 0.242865 1.517748 0.747235 1.882566 1.040766 0.534079 1.729417 0.993163 0.496721 1.811700 1.002981 0.317419 1.678987 0.959753 0.256596 1.817235 1.299690 0.756280 0.292629 1.822282 1.254136 0.905795 0.232927 1.675869 1.252625 0.924210 0.377830 0.081344 1.650592 1.565111 1.210398 0.823930 0.495597 0.170992 -0.097351 1.629713 1.238397 1.141529 0.804262 0.860680 0.603481 0.666502 0.428034 0.395443 0.132689 1.849680 0.035737 1.395931 1.824957 1.358060 1.651982 1.606952 1.718179 1.670215 1.887548 1.688422 1.844666 -0.292284 0.050366 -0.101906 0.075572 0.305815 0.606639 0.913420 1.030088 1.512470 1.549064 1.827384 0.007726 0.106419 0.461039 0.753337 1.221334 1.792974 0.097112 0.617097 1.170484 1.176316 1.664541 0.165974 0.635539 1.022624)
;; pp1:
- 11.114689 #(0.000000 0.681978 1.028261 1.706912 0.292133 0.848775 1.343922 1.911777 0.451105 1.069054 1.693074 0.301918 1.035579 1.825832 0.435611 1.230581 0.111624 0.750696 1.574421 0.321180 1.071098 -0.013053 0.852483 1.783026 0.524168 1.371392 0.475241 1.562570 0.337915 1.270461 0.221125 1.100498 0.123076 1.107894 0.160645 1.270692 0.306224 1.479440 0.658107 1.838424 0.945824 0.091726 1.332313 0.238983 1.552958 0.749521 1.839061 1.045392 0.486297 1.712081 0.982243 0.539957 1.767541 0.934362 0.293124 1.675620 0.993763 0.206674 1.792070 1.270778 0.729123 0.284390 1.801314 1.282266 0.918468 0.252050 1.650401 1.232066 0.903570 0.313672 0.087588 1.657912 1.543341 1.232872 0.839991 0.464849 0.196039 -0.147366 1.653544 1.258396 1.123045 0.770121 0.900031 0.618800 0.692026 0.397188 0.475351 0.152075 1.894219 0.030184 1.418582 1.854056 1.299662 1.631587 1.652019 1.730754 1.687797 1.916199 1.730490 1.823361 -0.277080 0.063403 -0.121338 0.021902 0.284828 0.586626 0.860176 0.999715 1.490642 1.510249 1.792225 0.008814 0.113621 0.391836 0.733891 1.237143 1.809005 0.128227 0.638952 1.175937 1.156619 1.663599 0.187027 0.654280 1.021025)
+ 11.114689 #r(0.000000 0.681978 1.028261 1.706912 0.292133 0.848775 1.343922 1.911777 0.451105 1.069054 1.693074 0.301918 1.035579 1.825832 0.435611 1.230581 0.111624 0.750696 1.574421 0.321180 1.071098 -0.013053 0.852483 1.783026 0.524168 1.371392 0.475241 1.562570 0.337915 1.270461 0.221125 1.100498 0.123076 1.107894 0.160645 1.270692 0.306224 1.479440 0.658107 1.838424 0.945824 0.091726 1.332313 0.238983 1.552958 0.749521 1.839061 1.045392 0.486297 1.712081 0.982243 0.539957 1.767541 0.934362 0.293124 1.675620 0.993763 0.206674 1.792070 1.270778 0.729123 0.284390 1.801314 1.282266 0.918468 0.252050 1.650401 1.232066 0.903570 0.313672 0.087588 1.657912 1.543341 1.232872 0.839991 0.464849 0.196039 -0.147366 1.653544 1.258396 1.123045 0.770121 0.900031 0.618800 0.692026 0.397188 0.475351 0.152075 1.894219 0.030184 1.418582 1.854056 1.299662 1.631587 1.652019 1.730754 1.687797 1.916199 1.730490 1.823361 -0.277080 0.063403 -0.121338 0.021902 0.284828 0.586626 0.860176 0.999715 1.490642 1.510249 1.792225 0.008814 0.113621 0.391836 0.733891 1.237143 1.809005 0.128227 0.638952 1.175937 1.156619 1.663599 0.187027 0.654280 1.021025)
)
;;; 126 all -------------------------------------------------------------------------------- ; 11.224972
-(vector 126 14.67419786533 #(0 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0)
+(vector 126 14.67419786533 #r(0 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0)
- 11.145483 #(0.000000 0.899293 0.378495 1.289186 0.777288 0.858338 1.619831 1.737202 1.951674 0.835017 -0.087625 1.707725 0.328507 0.828194 -0.110415 0.084984 1.000160 0.933659 1.329981 0.403112 1.465299 0.867776 0.736209 0.286670 0.614444 0.936369 0.873213 0.123325 0.103437 0.033532 0.337773 1.704277 1.195946 1.204920 1.015411 0.867778 0.772767 0.521662 1.281071 0.987342 0.207100 0.684428 0.579999 1.230109 0.833339 0.874869 1.325709 1.214223 -0.039340 1.273384 0.554903 0.324879 0.897065 0.122734 0.357179 1.405113 1.382262 1.052698 1.093027 0.696151 1.256101 1.113094 1.329670 0.549960 1.774690 1.419208 1.188823 1.415491 0.266597 0.476692 0.360990 0.613975 1.834829 -0.016278 0.893804 0.177235 -0.162182 0.465943 0.846924 0.105182 0.478317 0.762411 0.169998 0.509253 1.306498 1.829812 0.517679 0.137251 1.279904 1.030500 -0.049960 1.650399 1.720514 0.164442 0.994973 1.525343 0.937775 1.609285 1.534911 -0.677300 0.133781 0.129445 0.518965 -0.144758 1.037002 1.052666 0.841376 0.157786 1.034141 0.219735 1.379782 0.222272 1.298276 0.072801 0.604052 1.220954 0.022881 1.817683 0.809301 0.789103 1.114921 0.656136 -0.111384 0.132814 1.271527 0.712891)
+ 11.145483 #r(0.000000 0.899293 0.378495 1.289186 0.777288 0.858338 1.619831 1.737202 1.951674 0.835017 -0.087625 1.707725 0.328507 0.828194 -0.110415 0.084984 1.000160 0.933659 1.329981 0.403112 1.465299 0.867776 0.736209 0.286670 0.614444 0.936369 0.873213 0.123325 0.103437 0.033532 0.337773 1.704277 1.195946 1.204920 1.015411 0.867778 0.772767 0.521662 1.281071 0.987342 0.207100 0.684428 0.579999 1.230109 0.833339 0.874869 1.325709 1.214223 -0.039340 1.273384 0.554903 0.324879 0.897065 0.122734 0.357179 1.405113 1.382262 1.052698 1.093027 0.696151 1.256101 1.113094 1.329670 0.549960 1.774690 1.419208 1.188823 1.415491 0.266597 0.476692 0.360990 0.613975 1.834829 -0.016278 0.893804 0.177235 -0.162182 0.465943 0.846924 0.105182 0.478317 0.762411 0.169998 0.509253 1.306498 1.829812 0.517679 0.137251 1.279904 1.030500 -0.049960 1.650399 1.720514 0.164442 0.994973 1.525343 0.937775 1.609285 1.534911 -0.677300 0.133781 0.129445 0.518965 -0.144758 1.037002 1.052666 0.841376 0.157786 1.034141 0.219735 1.379782 0.222272 1.298276 0.072801 0.604052 1.220954 0.022881 1.817683 0.809301 0.789103 1.114921 0.656136 -0.111384 0.132814 1.271527 0.712891)
)
;;; 127 all -------------------------------------------------------------------------------- ; 11.269427
-(vector 127 14.851 #(0 0 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0)
+(vector 127 14.851 #r(0 0 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0)
- 11.176112 #(0.000000 1.071888 1.248428 0.289874 1.246619 0.289572 1.760445 0.245569 1.154033 1.309416 0.081159 1.849794 1.710269 1.368867 1.052576 -0.398246 -0.001522 1.370275 0.292491 1.626710 1.166078 1.755696 1.227481 0.377631 0.354241 0.127104 0.305667 -0.167076 0.018149 1.234977 0.220914 0.373111 0.199191 1.136953 0.209502 1.631334 0.736118 -0.280026 0.637855 0.997502 0.069226 0.738973 1.836372 1.422035 0.641751 0.717645 0.227787 1.627490 0.896625 1.164185 1.181473 0.283052 0.793654 1.893617 0.958053 1.877395 0.211241 0.448741 0.465207 1.415492 1.261864 1.182640 0.217781 0.211053 1.936678 0.848219 1.690040 -0.183682 -0.275325 0.916325 0.426519 1.353568 0.171309 0.590049 0.503441 0.438773 0.014163 -0.062159 0.869887 -0.128424 0.144319 1.756020 1.717018 -0.046012 0.125572 0.279523 0.175456 1.083651 1.091291 1.212635 1.168385 1.392580 -0.189037 0.240170 0.866374 1.580620 1.749254 1.502399 1.243019 0.251600 -0.018231 1.414780 0.773115 0.067214 1.323483 0.617886 1.663914 0.351482 0.571589 1.123483 1.679985 0.501109 1.035832 1.346170 1.289512 1.663306 0.584848 0.500505 -0.031006 0.055228 0.131713 1.510949 0.309811 1.293736 1.414224 0.248635 1.517857)
+ 11.176112 #r(0.000000 1.071888 1.248428 0.289874 1.246619 0.289572 1.760445 0.245569 1.154033 1.309416 0.081159 1.849794 1.710269 1.368867 1.052576 -0.398246 -0.001522 1.370275 0.292491 1.626710 1.166078 1.755696 1.227481 0.377631 0.354241 0.127104 0.305667 -0.167076 0.018149 1.234977 0.220914 0.373111 0.199191 1.136953 0.209502 1.631334 0.736118 -0.280026 0.637855 0.997502 0.069226 0.738973 1.836372 1.422035 0.641751 0.717645 0.227787 1.627490 0.896625 1.164185 1.181473 0.283052 0.793654 1.893617 0.958053 1.877395 0.211241 0.448741 0.465207 1.415492 1.261864 1.182640 0.217781 0.211053 1.936678 0.848219 1.690040 -0.183682 -0.275325 0.916325 0.426519 1.353568 0.171309 0.590049 0.503441 0.438773 0.014163 -0.062159 0.869887 -0.128424 0.144319 1.756020 1.717018 -0.046012 0.125572 0.279523 0.175456 1.083651 1.091291 1.212635 1.168385 1.392580 -0.189037 0.240170 0.866374 1.580620 1.749254 1.502399 1.243019 0.251600 -0.018231 1.414780 0.773115 0.067214 1.323483 0.617886 1.663914 0.351482 0.571589 1.123483 1.679985 0.501109 1.035832 1.346170 1.289512 1.663306 0.584848 0.500505 -0.031006 0.055228 0.131713 1.510949 0.309811 1.293736 1.414224 0.248635 1.517857)
)
;;; 128 all -------------------------------------------------------------------------------- ; 11.313708498985
-(vector 128 15.138 #(0 1 1 0 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 1 0 0 1 0 0 1 1)
+(vector 128 15.138 #r(0 1 1 0 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 1 0 0 1 0 0 1 1)
- 11.309209 #(0.000000 1.243323 0.073338 1.687189 1.124666 1.389841 0.847573 1.018728 0.290645 0.447958 0.152825 0.408946 1.554733 1.027824 0.742595 1.417320 1.174719 0.230635 0.137711 0.205770 -0.223930 -0.484352 0.868175 0.460794 0.073208 1.470166 -0.048840 -0.141098 1.057707 1.534980 0.337573 1.200647 1.372018 -0.041548 0.602859 1.849030 -0.103678 0.815675 0.107720 0.796671 0.027496 0.761821 1.113332 0.855622 0.650295 0.713381 0.490023 1.179238 -0.088446 0.282357 -0.437849 1.210715 1.321994 0.443637 1.300839 1.352381 -0.001933 0.442309 -0.088426 0.287664 0.126405 -0.108646 0.637631 0.580452 1.256195 1.182134 1.382836 1.180662 1.171900 0.353945 1.569554 0.076717 1.316852 1.092094 0.641656 0.578236 1.268290 1.296116 0.291194 1.287832 1.351802 0.877933 0.046043 0.135350 0.952936 1.137202 0.623256 -0.396801 0.327118 0.077316 0.800999 0.673083 1.387941 0.952139 1.436716 0.326423 0.697455 0.564179 1.047968 0.663414 0.327317 0.386236 0.415974 0.266450 1.112215 0.646830 0.208505 1.019398 -0.208967 0.964650 0.120229 1.347295 1.011374 1.053660 1.549663 0.688863 1.745386 0.772703 1.031951 0.182902 0.350269 0.873751 1.129081 1.610214 -0.035633 1.365829 0.190640 1.177284)
+ 11.309209 #r(0.000000 1.243323 0.073338 1.687189 1.124666 1.389841 0.847573 1.018728 0.290645 0.447958 0.152825 0.408946 1.554733 1.027824 0.742595 1.417320 1.174719 0.230635 0.137711 0.205770 -0.223930 -0.484352 0.868175 0.460794 0.073208 1.470166 -0.048840 -0.141098 1.057707 1.534980 0.337573 1.200647 1.372018 -0.041548 0.602859 1.849030 -0.103678 0.815675 0.107720 0.796671 0.027496 0.761821 1.113332 0.855622 0.650295 0.713381 0.490023 1.179238 -0.088446 0.282357 -0.437849 1.210715 1.321994 0.443637 1.300839 1.352381 -0.001933 0.442309 -0.088426 0.287664 0.126405 -0.108646 0.637631 0.580452 1.256195 1.182134 1.382836 1.180662 1.171900 0.353945 1.569554 0.076717 1.316852 1.092094 0.641656 0.578236 1.268290 1.296116 0.291194 1.287832 1.351802 0.877933 0.046043 0.135350 0.952936 1.137202 0.623256 -0.396801 0.327118 0.077316 0.800999 0.673083 1.387941 0.952139 1.436716 0.326423 0.697455 0.564179 1.047968 0.663414 0.327317 0.386236 0.415974 0.266450 1.112215 0.646830 0.208505 1.019398 -0.208967 0.964650 0.120229 1.347295 1.011374 1.053660 1.549663 0.688863 1.745386 0.772703 1.031951 0.182902 0.350269 0.873751 1.129081 1.610214 -0.035633 1.365829 0.190640 1.177284)
;; pp:
- 11.210356 #(0.000000 0.529477 1.092204 1.655320 0.240176 0.840083 1.290316 0.036113 0.414482 1.184815 1.733487 0.475904 1.226699 -0.054687 0.544000 1.373024 0.096261 0.605273 1.510542 0.229851 0.972933 -0.008717 0.768966 1.800241 0.536684 1.336088 0.309226 1.164728 0.254148 1.069819 0.021808 0.945032 -0.039508 0.972460 -0.067607 1.002895 0.197048 1.366967 0.351763 1.540663 0.648980 1.698360 0.730857 0.118485 1.274417 0.283223 1.327398 0.691807 0.012365 1.128647 0.533746 1.871605 1.252479 0.321809 1.476722 1.286815 0.557929 1.863054 1.365020 0.715719 -0.012609 1.699347 1.092581 0.354365 -0.098429 1.602411 1.106114 0.622866 0.186170 1.647857 1.109362 0.904818 0.566992 0.283406 1.734276 1.302248 1.135583 0.996099 0.637141 0.319233 -0.334659 -0.051454 1.363705 1.553533 1.027907 1.065457 0.795998 0.486251 0.704843 0.431262 0.496789 0.160271 0.268391 -0.277422 -0.064873 -0.149375 -0.202682 0.078495 -0.086833 -0.064332 0.234996 -0.109719 0.180200 0.196396 0.559877 0.436602 0.563596 0.942230 1.157161 1.450532 1.353287 1.969232 0.307428 0.330752 0.455679 0.656549 1.076389 1.439415 1.817226 0.185723 0.623808 1.021760 1.554273 1.872894 0.258818 0.595831 0.908779 1.816125)
+ 11.210356 #r(0.000000 0.529477 1.092204 1.655320 0.240176 0.840083 1.290316 0.036113 0.414482 1.184815 1.733487 0.475904 1.226699 -0.054687 0.544000 1.373024 0.096261 0.605273 1.510542 0.229851 0.972933 -0.008717 0.768966 1.800241 0.536684 1.336088 0.309226 1.164728 0.254148 1.069819 0.021808 0.945032 -0.039508 0.972460 -0.067607 1.002895 0.197048 1.366967 0.351763 1.540663 0.648980 1.698360 0.730857 0.118485 1.274417 0.283223 1.327398 0.691807 0.012365 1.128647 0.533746 1.871605 1.252479 0.321809 1.476722 1.286815 0.557929 1.863054 1.365020 0.715719 -0.012609 1.699347 1.092581 0.354365 -0.098429 1.602411 1.106114 0.622866 0.186170 1.647857 1.109362 0.904818 0.566992 0.283406 1.734276 1.302248 1.135583 0.996099 0.637141 0.319233 -0.334659 -0.051454 1.363705 1.553533 1.027907 1.065457 0.795998 0.486251 0.704843 0.431262 0.496789 0.160271 0.268391 -0.277422 -0.064873 -0.149375 -0.202682 0.078495 -0.086833 -0.064332 0.234996 -0.109719 0.180200 0.196396 0.559877 0.436602 0.563596 0.942230 1.157161 1.450532 1.353287 1.969232 0.307428 0.330752 0.455679 0.656549 1.076389 1.439415 1.817226 0.185723 0.623808 1.021760 1.554273 1.872894 0.258818 0.595831 0.908779 1.816125)
)
;;; 256 all -------------------------------------------------------------------------------- (16)
-(vector 256 23.353 #(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)
+(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.061041 #(0.000000 0.925796 0.374630 -0.108513 -0.821698 -0.025087 -0.506195 0.298783 0.035173 0.012160 0.459017 0.128871 0.955347 -0.719489 0.827601 0.829509 -0.132131 0.534593 0.213472 -0.471818 -0.764121 0.240055 -0.480081 0.847706 -0.032870 -0.481128 0.761455 -0.211601 0.010004 0.568923 -0.059172 -0.017957 0.170478 -0.613989 -0.042068 -0.938552 -1.012251 0.796792 -0.038645 -0.426760 -0.192132 -0.528083 -0.017037 -0.489368 0.355556 0.515110 0.821955 -0.244212 -0.238511 -0.789603 0.734511 0.783320 0.368778 -0.600810 0.581954 0.316603 0.874508 -1.013265 0.262565 0.824972 0.323390 -0.162260 -0.116223 -0.866816 -0.634726 0.764949 -0.318122 0.145813 0.067938 0.841588 -0.127386 -0.237218 -0.267186 -0.539198 0.835759 -0.143418 0.496218 0.887615 0.191628 0.011726 -0.612239 0.722732 -0.991602 0.938142 -0.612137 -0.577649 0.191369 -0.198359 0.337475 0.755205 0.683654 -0.318641 -0.814741 -0.354751 0.276257 0.469693 0.801805 -0.420187 0.880092 -0.544351 -0.948063 -0.889987 0.198598 -0.517903 -0.352606 -0.663604 -0.191808 -0.767415 -0.712906 0.924699 -0.850674 -0.237297 -0.047403 0.885741 -0.631553 0.768862 -0.094846 0.448006 -0.666459 -0.850386 0.514580 0.225037 0.511035 0.964534 -0.769372 0.838413 0.741093 0.377443 0.167837 0.877026 -0.054752 0.586836 -0.861511 1.030824 -0.288593 -0.124961 0.009157 -0.927185 0.163383 0.645894 -0.013717 -0.492535 -0.082090 0.437620 0.389280 -0.586666 0.905444 -0.102217 0.591427 -0.168941 0.306715 0.219495 -0.472513 -0.146685 0.752590 0.629396 0.714907 -0.507356 -0.442117 0.799056 0.422576 0.662410 -0.341174 -0.732367 0.014039 -0.183894 0.905125 -0.870456 -0.053268 -0.141515 -0.799646 0.336566 -0.304144 0.389935 0.399830 0.307027 -0.871155 0.107846 0.738408 -0.473227 0.903561 -0.708458 0.732745 -0.039953 -0.750947 0.595806 0.272676 0.007716 0.005802 0.007590 0.079344 0.221588 -0.936127 -0.035027 0.033764 -0.726372 -0.868892 0.770707 -0.383408 -0.651714 0.527250 -0.719737 0.519993 0.226575 0.223677 -0.873550 0.461070 0.964642 -0.617656 -0.035337 -0.800003 -0.139782 0.456176 0.867699 -0.523192 0.078855 0.641942 -0.831683 0.649701 -0.186292 0.569982 -0.772489 -0.286347 -0.113877 -0.219001 0.574600 0.095286 0.790223 0.375659 0.208137 0.644267 -0.013565 0.348413 -0.089854 0.753366 0.482545 0.088959 0.879933 -0.175976 0.137202 0.015772 0.222959 -0.016971 -0.184196 0.277924 0.739236 -0.669637 -0.868483 0.795679 0.675602 0.826275 0.073079 0.690996 0.894373 0.004910 0.425706)
- 16.044153 #(0.000000 0.920273 0.372564 -0.110230 -0.831590 -0.024493 -0.500647 0.302414 0.022299 0.027725 0.472756 0.140070 0.970606 -0.720895 0.836413 0.842679 -0.132305 0.536773 0.207003 -0.453332 -0.760638 0.245658 -0.478597 0.863171 -0.032157 -0.472647 0.754290 -0.227621 0.013477 0.558845 -0.052640 -0.023098 0.158297 -0.624249 -0.048618 -0.940043 -1.020247 0.794399 -0.031021 -0.424338 -0.204679 -0.515779 -0.017456 -0.475877 0.353693 0.516685 0.806475 -0.250392 -0.227531 -0.785929 0.733466 0.798407 0.367542 -0.607522 0.581618 0.327653 0.856891 -1.011670 0.267375 0.839237 0.331716 -0.145363 -0.122042 -0.882512 -0.634878 0.775683 -0.323189 0.145408 0.063600 0.848143 -0.135265 -0.241278 -0.266073 -0.535152 0.832873 -0.164344 0.500550 0.892768 0.185494 0.015340 -0.611092 0.710648 -0.990643 0.931898 -0.610912 -0.574064 0.180950 -0.202489 0.332309 0.748756 0.688645 -0.325379 -0.816615 -0.357931 0.291209 0.460980 0.809207 -0.430975 0.887167 -0.544293 -0.943804 -0.895199 0.207285 -0.510901 -0.352280 -0.662475 -0.180907 -0.780331 -0.706171 0.941201 -0.839923 -0.236315 -0.022054 0.904697 -0.621687 0.763326 -0.090808 0.454914 -0.672838 -0.855961 0.495677 0.237277 0.516261 0.964336 -0.770899 0.831300 0.736774 0.383807 0.161706 0.864999 -0.061006 0.598480 -0.862859 1.053665 -0.299977 -0.119858 0.014040 -0.936317 0.164958 0.639664 -0.010499 -0.508373 -0.088284 0.449299 0.396590 -0.586803 0.908076 -0.101599 0.608887 -0.160574 0.312039 0.211307 -0.479845 -0.163211 0.752480 0.623720 0.733139 -0.479717 -0.447833 0.782823 0.430371 0.669298 -0.342027 -0.712432 0.019356 -0.180154 0.917212 -0.876692 -0.061232 -0.141641 -0.801056 0.334565 -0.299946 0.403023 0.395127 0.301894 -0.876026 0.109216 0.741759 -0.480057 0.889791 -0.717215 0.733343 -0.038372 -0.761312 0.605019 0.270714 -0.000944 -0.012562 0.008512 0.094257 0.198043 -0.921035 -0.020418 0.038092 -0.725394 -0.870178 0.779926 -0.372111 -0.642683 0.509321 -0.733621 0.516590 0.243657 0.220496 -0.873794 0.457645 0.964308 -0.609127 -0.035693 -0.813675 -0.134637 0.457401 0.854005 -0.517044 0.086209 0.652862 -0.836396 0.637372 -0.178842 0.564463 -0.784476 -0.280084 -0.109193 -0.204258 0.589046 0.080042 0.802298 0.374592 0.198900 0.641142 -0.011934 0.340298 -0.073371 0.764097 0.484564 0.081902 0.862418 -0.182284 0.138089 0.011703 0.214362 -0.016592 -0.179817 0.279535 0.744994 -0.656373 -0.873050 0.792631 0.664964 0.831520 0.042737 0.685475 0.883386 -0.001297 0.431574)
-
- ;; pp:
- 16.350377 #(0.000000 0.552796 0.999754 1.596338 0.126332 0.673759 1.143594 1.786231 0.239358 0.837076 1.376094 -0.027483 0.557207 1.197707 1.840730 0.374019 1.046415 1.758004 0.340195 0.989599 1.620624 0.260723 0.941286 1.573013 0.271552 0.902927 1.633570 0.349820 1.063867 1.825055 0.557595 1.306577 0.088807 0.790267 1.529892 0.294932 1.020408 1.744984 0.604757 1.412603 0.281886 1.100728 1.889905 0.686280 1.553865 0.453907 1.302529 0.100750 0.984465 -0.035558 0.826606 1.720865 0.586422 1.445731 0.436162 1.366180 0.314278 1.261198 0.174270 1.139476 0.076878 0.981955 0.014752 1.001254 0.023464 1.025553 0.021016 1.003733 0.047800 1.070120 0.227544 1.225662 0.275497 1.290238 0.339903 1.445648 0.643098 1.696622 0.736906 1.856892 0.946479 0.080466 1.251303 0.348155 1.578331 0.792557 1.845915 0.951067 0.268564 1.510384 0.657787 1.813775 1.031959 0.320499 1.463662 0.701523 0.024031 1.255492 0.480762 1.684919 1.051974 0.424109 1.601000 0.892871 0.243024 1.614521 1.010751 0.221241 1.491807 0.862210 0.215650 1.557126 0.968758 0.385009 1.808699 1.162553 0.511515 1.916283 1.311004 0.789593 0.295563 1.706075 1.087230 0.543068 0.069395 1.561470 0.989040 0.453388 -0.108044 1.480909 1.040634 0.572985 0.051211 1.625308 1.183041 0.686760 0.302383 1.860622 1.529645 0.987474 0.557505 0.084969 1.853756 1.336365 0.952019 0.595441 0.210294 1.971086 1.605010 1.282084 1.025620 0.569157 0.327228 1.866582 1.606594 1.434632 1.017654 0.911350 0.391676 0.232063 0.001884 1.730059 1.574735 1.286832 1.121780 0.801569 0.646973 0.508234 0.242177 0.255472 1.901657 1.795256 1.544468 1.353518 1.252299 1.049061 0.957214 0.842369 0.785364 0.631556 0.708280 0.450967 0.377024 0.408728 0.166649 0.302099 0.202780 0.096226 0.047151 -0.060241 -0.054511 -0.141528 0.011242 -0.035439 -0.105943 -0.008495 0.261657 -0.027784 0.212454 0.144202 0.244055 0.276291 0.439789 0.497793 0.528548 0.655999 0.693233 0.786857 0.888896 1.103132 1.128106 1.412355 1.557348 1.790407 1.883313 0.127747 0.354527 0.531053 0.664039 0.693143 1.026705 1.248860 1.533013 1.656903 -0.153410 0.211226 0.477106 0.861202 1.107385 1.382365 1.702920 1.856715 0.292313 0.666914 1.015054 1.228045 1.584336 1.886548 0.103276 0.465850 0.933761 1.404258 1.699106 0.163965 0.511514 0.978218 1.466876 1.813824 0.330510 0.850353 1.126689 1.666255 0.008649 0.560148 1.018515 1.617664)
+ 16.015648 #(0.000000 0.913073 0.365032 -0.108482 -0.850779 -0.029112 -0.478221 0.299853 0.005930 0.028684 0.489375 0.147659 0.996302 -0.711773 0.844258 0.842025 -0.127152 0.541536 0.197810 -0.436340 -0.768131 0.238796 -0.466158 0.863007 -0.035212 -0.456714 0.735955 -0.230524 -0.009416 0.553478 -0.052779 -0.042468 0.170073 -0.634690 -0.059697 -0.948449 -1.045458 0.789684 -0.057400 -0.414983 -0.212938 -0.507440 -0.007591 -0.442717 0.339164 0.509734 0.793943 -0.256492 -0.231808 -0.778192 0.734232 0.783518 0.363369 -0.620669 0.577317 0.339118 0.845065 -1.026930 0.267559 0.850069 0.330602 -0.130805 -0.131595 -0.899177 -0.612868 0.777144 -0.313041 0.155890 0.057943 0.873482 -0.147270 -0.230789 -0.264303 -0.544562 0.830094 -0.198370 0.527237 0.888849 0.176321 0.036834 -0.606699 0.721034 -0.998615 0.929187 -0.601311 -0.559511 0.175522 -0.212560 0.335615 0.741117 0.713881 -0.342068 -0.786092 -0.355971 0.316302 0.458583 0.831922 -0.438701 0.902759 -0.520319 -0.943992 -0.918858 0.236362 -0.525398 -0.355285 -0.657017 -0.171348 -0.775711 -0.706238 0.935550 -0.857506 -0.255804 -0.015911 0.908310 -0.620626 0.749200 -0.090957 0.449328 -0.692035 -0.879768 0.488921 0.242083 0.526063 0.977469 -0.769561 0.798088 0.732466 0.379621 0.165711 0.845386 -0.051576 0.621025 -0.850421 1.079254 -0.294265 -0.113623 0.019082 -0.915633 0.175555 0.655223 0.003180 -0.501018 -0.072745 0.430361 0.405286 -0.568091 0.914362 -0.108464 0.623625 -0.134945 0.312963 0.199622 -0.473122 -0.159637 0.742702 0.640041 0.728192 -0.454474 -0.454159 0.769919 0.420837 0.674995 -0.347142 -0.691204 0.048761 -0.186020 0.921972 -0.865601 -0.060675 -0.139337 -0.814725 0.330667 -0.294249 0.397138 0.372289 0.290428 -0.887223 0.111373 0.754623 -0.480381 0.874753 -0.710905 0.732459 -0.022383 -0.769465 0.599679 0.273603 0.014636 -0.012073 -0.008582 0.121652 0.181281 -0.921287 -0.016414 0.034842 -0.700966 -0.893100 0.800484 -0.344865 -0.641014 0.507181 -0.742638 0.533441 0.230072 0.218915 -0.859405 0.461077 0.940883 -0.596799 -0.035117 -0.825297 -0.128261 0.459343 0.859514 -0.512344 0.079703 0.668236 -0.859257 0.621100 -0.194240 0.546942 -0.771748 -0.285659 -0.118406 -0.179653 0.607923 0.056770 0.787692 0.368958 0.194256 0.637505 -0.036460 0.316367 -0.064912 0.784004 0.497108 0.067884 0.856156 -0.185759 0.126991 -0.003872 0.229782 -0.016427 -0.164906 0.302017 0.785790 -0.631477 -0.851702 0.785147 0.653827 0.856436 0.022692 0.693752 0.899424 0.001443 0.429665) 16.010386 #(0.000000 0.920945 0.363394 -0.111459 -0.852961 -0.030743 -0.486427 0.303296 0.010874 0.025631 0.486771 0.146546 0.994416 -0.718811 0.828960 0.840913 -0.131882 0.543317 0.204985 -0.439493 -0.763137 0.245247 -0.475554 0.866796 -0.041025 -0.461673 0.740755 -0.226719 0.001506 0.552697 -0.059966 -0.035327 0.173366 -0.628245 -0.054838 -0.934551 -1.031441 0.793233 -0.043124 -0.412676 -0.208047 -0.513793 -0.006876 -0.455348 0.342378 0.516301 0.791942 -0.257287 -0.226499 -0.779985 0.732619 0.786192 0.363409 -0.619448 0.578093 0.339825 0.847881 -1.025827 0.259379 0.843283 0.334363 -0.127324 -0.127579 -0.903361 -0.620509 0.785133 -0.312323 0.153398 0.055471 0.866327 -0.142491 -0.229933 -0.269705 -0.547332 0.834680 -0.192895 0.531124 0.904440 0.173178 0.030764 -0.606946 0.721023 -0.994614 0.933155 -0.603090 -0.567732 0.177246 -0.206163 0.314884 0.733548 0.702209 -0.341642 -0.790663 -0.358956 0.314517 0.460531 0.827952 -0.426749 0.886351 -0.525470 -0.948488 -0.914665 0.232069 -0.530778 -0.361820 -0.652252 -0.173056 -0.775244 -0.707798 0.944444 -0.853094 -0.252134 -0.004542 0.918692 -0.618838 0.749411 -0.096229 0.446266 -0.693117 -0.882196 0.495495 0.243764 0.526690 0.971870 -0.769433 0.799709 0.728152 0.378075 0.171064 0.836718 -0.059131 0.609743 -0.860513 1.066200 -0.297224 -0.113848 0.009565 -0.919496 0.163385 0.657120 -0.007832 -0.503984 -0.072991 0.430986 0.397326 -0.574038 0.916295 -0.106489 0.622703 -0.141369 0.297377 0.207168 -0.476795 -0.160183 0.738329 0.640718 0.737546 -0.452103 -0.465273 0.778970 0.427298 0.674878 -0.339954 -0.691811 0.050490 -0.187869 0.914497 -0.875986 -0.064207 -0.145638 -0.815661 0.323974 -0.295041 0.389771 0.374451 0.289464 -0.891822 0.110356 0.749603 -0.486262 0.877252 -0.708311 0.727538 -0.029129 -0.768613 0.599336 0.273696 0.009013 -0.014981 -0.018066 0.115337 0.181872 -0.918064 -0.020664 0.032568 -0.717156 -0.885234 0.789019 -0.363390 -0.638226 0.506111 -0.747084 0.513174 0.227388 0.223304 -0.868865 0.451813 0.936259 -0.593299 -0.029106 -0.826842 -0.123816 0.463175 0.854642 -0.509021 0.082861 0.662066 -0.846887 0.626221 -0.184798 0.557138 -0.776207 -0.285287 -0.116068 -0.189148 0.597111 0.058719 0.802492 0.367358 0.191462 0.632917 -0.047441 0.319907 -0.068892 0.783354 0.495351 0.072287 0.851620 -0.191477 0.138573 -0.011049 0.217910 -0.014525 -0.163969 0.288573 0.772557 -0.642325 -0.867993 0.783974 0.657342 0.848756 0.031694 0.695222 0.896605 -0.007103 0.420073)
+ 16.008340 #(0.000000 0.924276 0.362291 -0.110441 -0.855698 -0.030196 -0.480404 0.303965 0.009025 0.027019 0.487751 0.146987 0.992342 -0.715809 0.832216 0.842695 -0.128929 0.541176 0.204364 -0.437798 -0.765322 0.242761 -0.476383 0.866350 -0.040142 -0.461897 0.740014 -0.226437 0.001280 0.552675 -0.060305 -0.034943 0.171195 -0.626477 -0.054275 -0.933557 -1.029874 0.790379 -0.040028 -0.415691 -0.211695 -0.511211 -0.005858 -0.454729 0.340940 0.516909 0.790921 -0.254671 -0.228556 -0.779360 0.734348 0.784373 0.366944 -0.617800 0.579129 0.340372 0.850813 -1.024999 0.259101 0.845491 0.332824 -0.127386 -0.128393 -0.902198 -0.617002 0.785840 -0.310320 0.156978 0.056183 0.866094 -0.144000 -0.229666 -0.270074 -0.544365 0.834774 -0.189187 0.529494 0.900861 0.175206 0.028280 -0.606895 0.722759 -0.995982 0.928632 -0.603148 -0.565317 0.180632 -0.209974 0.316840 0.735409 0.703715 -0.342118 -0.787262 -0.357579 0.314391 0.459878 0.826358 -0.427718 0.888529 -0.525271 -0.945443 -0.913228 0.231775 -0.528581 -0.362681 -0.652446 -0.170681 -0.778933 -0.706870 0.944000 -0.851084 -0.250037 -0.007916 0.914800 -0.618253 0.752824 -0.095797 0.448364 -0.688784 -0.882018 0.494289 0.244800 0.527326 0.972752 -0.770390 0.801900 0.727890 0.377259 0.168397 0.839259 -0.056173 0.610729 -0.859386 1.065435 -0.296285 -0.116304 0.012386 -0.917455 0.163423 0.658308 -0.004289 -0.504726 -0.072443 0.431079 0.400162 -0.571656 0.916254 -0.106918 0.624416 -0.139453 0.301252 0.208891 -0.473136 -0.159529 0.739641 0.641158 0.737619 -0.453693 -0.459609 0.780666 0.427044 0.673810 -0.339936 -0.692550 0.051402 -0.186142 0.916940 -0.874831 -0.063472 -0.146540 -0.815123 0.328135 -0.296042 0.387539 0.376603 0.291908 -0.888391 0.110594 0.751903 -0.484544 0.877623 -0.709582 0.729244 -0.026531 -0.769098 0.603634 0.275819 0.005088 -0.013515 -0.016447 0.117067 0.179057 -0.919285 -0.020847 0.034627 -0.715244 -0.885330 0.790864 -0.357208 -0.639673 0.512003 -0.743397 0.516329 0.229113 0.220081 -0.867161 0.457431 0.938171 -0.592499 -0.026197 -0.827691 -0.126675 0.463427 0.854982 -0.511275 0.083456 0.664033 -0.844142 0.624587 -0.182221 0.558181 -0.775220 -0.285024 -0.114116 -0.189160 0.602407 0.058002 0.799801 0.366190 0.194199 0.633876 -0.040563 0.320907 -0.068732 0.783604 0.496750 0.073752 0.852116 -0.188642 0.135755 -0.011019 0.220204 -0.013472 -0.162668 0.293284 0.774369 -0.643319 -0.865194 0.784214 0.657100 0.852895 0.029268 0.692648 0.897181 -0.004533 0.420500)
+ 16.007884 #(0.000000 0.922928 0.360969 -0.107860 -0.853470 -0.029739 -0.481669 0.303315 0.009338 0.028396 0.486499 0.146132 0.993098 -0.716983 0.833516 0.842808 -0.130854 0.540155 0.204117 -0.438506 -0.764609 0.243640 -0.476256 0.866245 -0.040566 -0.462329 0.739042 -0.226174 0.001845 0.553660 -0.059003 -0.035708 0.170583 -0.628149 -0.054651 -0.932927 -1.031061 0.789629 -0.040309 -0.414361 -0.211066 -0.509611 -0.006959 -0.454572 0.341645 0.518519 0.790868 -0.253675 -0.226460 -0.778751 0.732678 0.787220 0.367578 -0.616591 0.579809 0.338997 0.847944 -1.024413 0.259470 0.846524 0.331885 -0.127206 -0.127246 -0.900458 -0.618112 0.787082 -0.308785 0.155238 0.054669 0.867046 -0.145996 -0.230082 -0.268529 -0.546788 0.835157 -0.189054 0.529309 0.899414 0.175300 0.028857 -0.606131 0.722991 -0.995706 0.929667 -0.603038 -0.566383 0.181600 -0.209369 0.315795 0.736615 0.704221 -0.339987 -0.786786 -0.359640 0.313838 0.459500 0.827383 -0.428267 0.890546 -0.523938 -0.946755 -0.913641 0.231607 -0.529405 -0.360728 -0.651910 -0.172578 -0.778899 -0.708198 0.943254 -0.853690 -0.250004 -0.007860 0.915151 -0.619600 0.752955 -0.095360 0.447052 -0.689433 -0.882237 0.495592 0.240815 0.527219 0.972414 -0.770145 0.803371 0.728537 0.377205 0.169425 0.838329 -0.055361 0.611409 -0.859388 1.064945 -0.296072 -0.114375 0.011844 -0.918381 0.162905 0.656933 -0.003591 -0.504715 -0.072526 0.430703 0.400543 -0.572452 0.914945 -0.107438 0.624510 -0.139283 0.298753 0.207864 -0.473764 -0.159103 0.738807 0.640564 0.740226 -0.453558 -0.462283 0.780075 0.427464 0.673736 -0.340464 -0.694277 0.049740 -0.185832 0.916192 -0.874941 -0.066498 -0.145479 -0.815161 0.327644 -0.296274 0.390966 0.375097 0.293318 -0.888195 0.108966 0.752273 -0.485707 0.877930 -0.708223 0.730314 -0.026034 -0.769704 0.603525 0.276135 0.007717 -0.015521 -0.015223 0.118342 0.180381 -0.920163 -0.021297 0.033412 -0.714448 -0.885904 0.790856 -0.358137 -0.637432 0.511650 -0.745980 0.516306 0.227315 0.221380 -0.869170 0.456938 0.935313 -0.593138 -0.028218 -0.830358 -0.129244 0.461693 0.855245 -0.510744 0.082243 0.663409 -0.845153 0.622076 -0.183948 0.558112 -0.778556 -0.282504 -0.113851 -0.187331 0.602125 0.057597 0.799289 0.363875 0.192187 0.633453 -0.040616 0.319802 -0.069003 0.783592 0.497842 0.073819 0.850815 -0.189639 0.136903 -0.011177 0.220479 -0.014447 -0.163761 0.292892 0.773917 -0.643620 -0.865036 0.783924 0.659841 0.852895 0.029278 0.694166 0.895461 -0.005968 0.422337)
+ 16.007758 #(0.000000 0.922886 0.360972 -0.107941 -0.853286 -0.029890 -0.481728 0.303305 0.009234 0.028475 0.486321 0.146367 0.993034 -0.716937 0.833360 0.842940 -0.130941 0.540450 0.204063 -0.438608 -0.764665 0.243847 -0.476092 0.866251 -0.040608 -0.462102 0.739126 -0.226105 0.002005 0.553838 -0.059157 -0.035773 0.170554 -0.628122 -0.054794 -0.932916 -1.031067 0.789801 -0.040195 -0.414609 -0.211239 -0.509500 -0.006824 -0.454468 0.341669 0.518587 0.790785 -0.253519 -0.226399 -0.778499 0.732573 0.786981 0.367583 -0.616850 0.579690 0.339133 0.848152 -1.024614 0.259249 0.846135 0.331943 -0.127295 -0.127362 -0.900595 -0.617953 0.786896 -0.308783 0.154980 0.054689 0.866856 -0.146078 -0.229852 -0.268444 -0.546735 0.835185 -0.189037 0.529339 0.899346 0.175520 0.028886 -0.606288 0.722972 -0.995810 0.929794 -0.602789 -0.566459 0.181481 -0.209331 0.315729 0.736580 0.703962 -0.340033 -0.786608 -0.359731 0.313840 0.459240 0.827505 -0.428109 0.890672 -0.523798 -0.946754 -0.913444 0.231652 -0.529509 -0.360469 -0.651956 -0.172550 -0.778471 -0.708248 0.942972 -0.853473 -0.249961 -0.007683 0.915085 -0.619588 0.752807 -0.095290 0.447074 -0.689339 -0.882361 0.495622 0.240903 0.527291 0.972486 -0.770253 0.803157 0.728557 0.377081 0.169677 0.838362 -0.055433 0.611167 -0.859496 1.065141 -0.296195 -0.114442 0.011772 -0.918417 0.162830 0.656868 -0.003818 -0.504586 -0.072366 0.430687 0.400829 -0.572606 0.914943 -0.107354 0.624501 -0.139104 0.298717 0.208083 -0.473638 -0.159211 0.739078 0.640327 0.740293 -0.453613 -0.462248 0.780093 0.427735 0.673800 -0.340510 -0.694481 0.049758 -0.185965 0.916405 -0.874891 -0.066553 -0.145490 -0.814908 0.327680 -0.296467 0.390858 0.375037 0.293421 -0.888420 0.109092 0.752148 -0.485721 0.877755 -0.708292 0.730678 -0.026088 -0.769863 0.603666 0.276298 0.007787 -0.015304 -0.015000 0.118489 0.180365 -0.920315 -0.021100 0.033412 -0.714561 -0.885991 0.790966 -0.357847 -0.637530 0.511863 -0.745813 0.516168 0.227595 0.221419 -0.869477 0.457242 0.935302 -0.593242 -0.028100 -0.830395 -0.129369 0.461682 0.855401 -0.510650 0.082356 0.663400 -0.844931 0.621875 -0.183856 0.558303 -0.778542 -0.282640 -0.114035 -0.187343 0.602102 0.057635 0.799108 0.363734 0.192206 0.633422 -0.040728 0.319629 -0.068935 0.783582 0.497982 0.073772 0.851108 -0.189632 0.136765 -0.011310 0.220494 -0.014269 -0.163713 0.292846 0.773802 -0.643651 -0.864921 0.783857 0.659743 0.852615 0.029067 0.694103 0.895444 -0.006212 0.422310)
)
;;; 512 all -------------------------------------------------------------------------------- (22.627)
-(vector 512 34.212551772691 #(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)
+(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.664022 #(0.000000 0.427568 1.639326 1.360155 1.811218 1.092160 0.747868 1.186461 0.447302 0.141557 0.619324 1.833463 1.544347 0.007451 1.194940 0.942391 1.467079 0.598818 0.341862 0.856599 -0.009623 1.790305 0.303605 1.433809 1.210097 1.744422 0.850431 0.701542 1.184133 0.353157 0.158700 0.631775 1.816582 1.649038 0.151955 1.319099 1.140756 1.686037 0.836885 0.603284 1.210040 0.328240 0.128897 0.747775 1.857031 1.647146 0.229954 1.360640 1.181891 1.738203 0.916825 0.772560 1.263892 0.487557 0.357369 0.837989 0.072479 1.952904 0.462538 1.655604 1.530780 0.044826 1.188380 1.093422 1.643465 0.760457 0.671146 1.165553 0.382517 0.270309 0.819071 0.053545 1.937012 0.495125 1.742677 1.542501 0.125650 1.325748 1.210027 1.732088 0.935701 0.824564 1.323484 0.585708 0.506420 1.029721 0.338323 0.187075 0.760806 0.050676 1.850037 0.464992 1.677973 1.565113 0.144103 1.317521 1.321113 1.874238 1.016306 1.069091 1.608386 0.796518 0.769622 1.333499 0.614032 0.483343 1.064146 0.380172 0.255809 0.868411 0.110092 0.019745 0.602426 1.831203 1.791424 0.362161 1.643680 1.595486 0.149263 1.495555 1.407870 1.984422 1.287342 1.186467 1.794990 1.091502 0.997302 1.627715 0.925839 0.869778 1.436400 0.757469 0.721612 1.297170 0.565566 0.560684 1.139226 0.428000 0.421240 0.966706 0.319226 0.330813 0.889093 0.219241 0.195335 0.812296 0.094799 0.052902 0.683712 0.010896 1.971130 0.608327 1.935753 1.931121 0.569627 1.867175 1.867249 0.441783 1.801138 1.790921 0.371408 1.777986 1.738617 0.401066 1.733047 1.661490 0.354101 1.627871 1.606589 0.288724 1.577834 1.666020 0.321728 1.651393 1.656482 0.323319 1.730257 1.617220 0.293458 1.714829 1.659553 0.344931 1.670147 1.687943 0.352602 1.662557 1.707106 0.369928 1.772978 1.748463 0.482487 1.829720 1.820057 0.586300 1.834899 1.928514 0.630781 1.937126 0.006886 0.678213 0.089703 0.093158 0.772429 0.211946 0.205897 0.907314 0.295511 0.339317 1.025320 0.390289 0.436223 1.172670 0.563140 0.575421 1.326146 0.743539 0.740636 1.478962 0.859750 0.923341 1.622809 0.996123 1.103566 1.788348 1.176067 1.280213 -0.047092 1.383754 1.395483 0.152500 1.517048 1.632989 0.388897 1.741484 1.847120 0.652366 0.024054 0.131465 0.878250 0.336434 0.307596 1.072008 0.542503 0.578597 1.334996 0.751250 0.821777 1.656098 1.025574 1.190055 1.955170 1.316203 1.418474 0.154347 1.615247 1.696950 0.413353 1.897018 -0.040080 0.750302 0.194941 0.311683 1.127700 0.508014 0.639251 1.420913 0.883930 0.954476 1.736379 1.219406 1.363982 0.067216 1.594026 1.696195 0.520754 1.968937 0.073197 0.846293 0.295874 0.412637 1.264631 0.683696 0.770777 1.578119 1.049706 1.256677 0.075650 1.516235 1.661663 0.486701 1.923042 0.102476 0.897895 0.421239 0.520799 1.398872 0.764863 0.918394 1.741709 1.285842 1.432958 0.285406 1.740186 1.875561 0.693279 0.189999 0.363512 1.130608 0.742662 0.877597 1.690466 1.167157 1.260179 0.095687 1.647656 1.862836 0.750171 0.242633 0.398738 1.269810 0.693295 0.943617 1.819562 1.329456 1.523078 0.289946 1.903623 0.046720 0.919252 0.382106 0.589683 1.382685 1.026289 1.195161 0.073095 1.610391 1.738812 0.696675 0.192997 0.388398 1.259408 0.742094 1.024183 1.864212 1.458122 1.534179 0.402744 -0.061224 0.271156 1.098904 0.634032 0.812991 1.726192 1.349800 1.524054 0.405111 1.914339 0.225666 1.134052 0.737598 0.871970 1.836536 1.374934 1.616164 0.466416 0.050312 0.256071 1.130926 0.806016 0.967517 1.857501 1.430024 1.677286 0.624674 0.171527 0.493105 1.331230 0.893429 1.180472 0.103949 1.752760 1.965087 0.889376 0.401019 0.670116 1.685650 1.210490 1.475318 0.371575 0.023405 0.308232 1.175094 0.785590 1.015636 -0.029618 1.589597 1.841867 0.744953 0.423044 0.654663 1.649721 1.235327 1.552140 0.505770 0.153285 0.430626 1.295928 0.916060 1.261458 0.277022 1.879571 0.086016 1.069989 0.709985 0.993888 -0.020550 1.578106 1.903961 0.873960 0.405819 0.766821 1.720050 1.395240 1.689328 0.591580 0.237019 0.518171 1.489451 1.175876 1.436552 0.419316 0.110972 0.456395 1.431851 1.135703 1.433153 0.412157 0.047498 0.368496 1.359894 0.994487 1.371051 0.374236 -0.007165 0.356413 1.341081 0.997966 1.348371 0.388959 0.042648 0.317800 1.336452 1.006864 1.349497 0.415416 0.057830 0.422080 1.335388 1.091374 1.397964 0.381417 0.219147 0.454116 1.473546 1.128064 1.458934 0.561157 0.201897 0.582036 1.638190 1.188476 1.678318 0.658219 0.380328 0.735596 1.749438 1.526079 1.911184 0.877724 0.628235 0.991698 0.058067 1.723282 0.138422 1.198701 0.866452 1.210404 0.321220 0.058540 0.420700 1.466851 1.211297 1.555352 0.603793 0.342675 0.773740 1.815254 1.579109 1.942762 1.000717 0.737614 1.114407 0.230063 0.006013 0.382590 1.515868 1.246214 1.651494 0.773676 0.514207 0.940214 0.045277)
- 23.628248 #(0.000000 0.433789 1.650140 1.356278 1.831399 1.108856 0.766648 1.198672 0.485117 0.143286 0.647350 1.840587 1.544134 0.014730 1.211569 0.933841 1.484920 0.608675 0.337594 0.863947 0.000248 1.765847 0.306935 1.414844 1.212745 1.724621 0.852299 0.706499 1.174462 0.316624 0.164444 0.636620 1.783774 1.646406 0.140799 1.314478 1.151043 1.702277 0.853415 0.604845 1.245320 0.356275 0.121101 0.779580 1.885476 1.650749 0.253387 1.371467 1.212839 1.723102 0.924390 0.790701 1.250665 0.492768 0.377157 0.849111 0.066075 1.955487 0.475342 1.677345 1.530359 0.065931 1.174309 1.099121 1.617749 0.762256 0.657893 1.155617 0.367599 0.262109 0.827619 0.053376 1.919966 0.521185 1.746469 1.542493 0.154795 1.322421 1.218942 1.748982 0.931427 0.830859 1.338988 0.584128 0.492172 1.018033 0.357529 0.169245 0.757309 0.063170 1.854299 0.443815 1.687824 1.587130 0.160431 1.347694 1.327814 1.859461 1.024046 1.066304 1.583935 0.796521 0.773996 1.333871 0.603020 0.477792 1.091558 0.380565 0.262694 0.863017 0.128360 0.034645 0.615178 1.830971 1.803647 0.376774 1.647957 1.614671 0.148052 1.509018 1.400187 1.950080 1.285798 1.163572 1.786980 1.070935 0.988362 1.637546 0.923315 0.883432 1.449985 0.753399 0.738317 1.292798 0.553797 0.577649 1.154218 0.423305 0.426824 0.972085 0.299014 0.338789 0.869223 0.190136 0.189933 0.830202 0.102950 0.042959 0.685066 0.017082 1.956594 0.584256 1.932735 1.935712 0.572855 1.837326 1.874993 0.452714 1.817383 1.798879 0.362929 1.815778 1.744084 0.394489 1.750583 1.655633 0.355956 1.600495 1.600450 0.306618 1.556129 1.667282 0.319224 1.658945 1.667459 0.308086 1.745435 1.638576 0.289250 1.733202 1.663915 0.342630 1.678542 1.685907 0.351758 1.649467 1.722333 0.366073 1.744941 1.732389 0.470998 1.822610 1.801151 0.588169 1.827375 1.933331 0.632795 1.916487 -0.006146 0.659051 0.090698 0.111936 0.800317 0.243610 0.205169 0.916894 0.317163 0.320932 0.994630 0.376197 0.410645 1.158356 0.554828 0.588084 1.354735 0.744869 0.744546 1.496818 0.874054 0.936513 1.634821 0.992756 1.101420 1.787811 1.203776 1.298934 -0.053576 1.375980 1.375813 0.103301 1.527425 1.630624 0.403509 1.711079 1.841938 0.641809 0.039285 0.135832 0.881243 0.317736 0.292477 1.038960 0.583069 0.595340 1.338147 0.753063 0.815893 1.660574 1.020051 1.211872 1.965451 1.308624 1.380890 0.131195 1.617481 1.685773 0.402749 1.902063 -0.066558 0.744867 0.187164 0.309573 1.139714 0.499643 0.629346 1.431594 0.863313 0.944234 1.726662 1.208319 1.345989 0.077779 1.600250 1.691656 0.533177 1.959975 0.074360 0.854898 0.296256 0.417204 1.267390 0.667023 0.766644 1.510305 1.032702 1.281666 0.087962 1.514846 1.652246 0.461938 1.898643 0.124623 0.918717 0.468340 0.511756 1.407468 0.766222 0.919344 1.720710 1.288059 1.469994 0.304834 1.741539 1.860828 0.676508 0.154352 0.357020 1.108740 0.773960 0.863538 1.733036 1.168042 1.256160 0.069944 1.624162 1.859740 0.777571 0.256694 0.395793 1.307465 0.666571 0.958276 1.811129 1.328827 1.533516 0.319555 1.919290 0.037746 0.899749 0.370160 0.596560 1.395999 1.078162 1.205377 0.057656 1.602278 1.726590 0.711922 0.207961 0.413944 1.226941 0.716453 1.036942 1.900398 1.495739 1.528886 0.396366 -0.066854 0.264968 1.074225 0.662521 0.828671 1.725458 1.354772 1.501781 0.394462 1.869016 0.215673 1.156548 0.755855 0.908703 1.833326 1.392807 1.631102 0.477016 0.028455 0.263999 1.188849 0.803922 0.954792 1.833187 1.436493 1.684482 0.628615 0.200022 0.508467 1.333657 0.872725 1.174036 0.123960 1.764491 1.962295 0.887674 0.415000 0.666579 1.634137 1.241216 1.481310 0.428554 0.021959 0.343004 1.161016 0.773299 0.997772 -0.043880 1.582286 1.822314 0.731515 0.454352 0.631211 1.643705 1.207547 1.551219 0.512554 0.162481 0.416434 1.280062 0.885380 1.255490 0.264961 1.885362 0.051847 1.039283 0.688293 0.977158 -0.025341 1.578628 1.913032 0.881970 0.360922 0.778944 1.750545 1.408540 1.680970 0.590361 0.224349 0.502373 1.466016 1.157692 1.443901 0.406016 0.102547 0.456165 1.411829 1.159416 1.427232 0.387943 0.029546 0.327539 1.356699 0.984632 1.351328 0.355553 -0.024628 0.308275 1.305380 0.984793 1.339709 0.338523 0.054446 0.313102 1.337886 0.969193 1.329583 0.417777 0.052897 0.425700 1.337013 1.073564 1.385810 0.385648 0.244259 0.470220 1.484303 1.099702 1.402734 0.528127 0.206758 0.558859 1.632181 1.153273 1.681906 0.669401 0.374368 0.765459 1.742663 1.558066 1.902930 0.880568 0.603560 0.973583 0.032652 1.736055 0.126858 1.196899 0.840002 1.212309 0.311167 0.070940 0.418934 1.453690 1.199700 1.573348 0.608746 0.342397 0.782909 1.839116 1.587019 1.958396 1.012436 0.759831 1.134446 0.249244 0.026374 0.402957 1.554461 1.241885 1.724562 0.794654 0.521599 0.963308 0.075698)
+ 23.447706 #(0.000000 0.426044 1.633708 1.350280 1.822804 1.117244 0.760667 1.218703 0.489220 0.131095 0.659797 1.857797 1.521853 0.046587 1.243767 0.934650 1.505713 0.634431 0.335362 0.893106 0.022076 1.771168 0.330129 1.445347 1.190395 1.726813 0.869471 0.682662 1.150720 0.343682 0.173189 0.588032 1.804217 1.684164 0.134104 1.329663 1.163731 1.734444 0.858967 0.631329 1.295909 0.342596 0.140608 0.794655 1.883382 1.642551 0.224842 1.367308 1.190153 1.704002 0.940016 0.794558 1.221228 0.506176 0.402140 0.834237 0.087808 -0.009349 0.494554 1.668651 1.555556 0.081367 1.193806 1.090241 1.622457 0.742170 0.633009 1.125571 0.327065 0.236311 0.784555 0.007026 1.905943 0.547056 1.721396 1.563357 0.199584 1.333207 1.227299 1.761129 0.923965 0.841615 1.352322 0.582481 0.472318 1.017351 0.355842 0.155957 0.741816 0.069387 1.865137 0.443149 1.678605 1.613225 0.140270 1.330017 1.377157 1.842142 1.016389 1.092737 1.598833 0.786375 0.783263 1.366084 0.596813 0.485778 1.108325 0.377669 0.289753 0.849219 0.105980 0.065089 0.612684 1.826755 1.810107 0.367420 1.631370 1.589749 0.161057 1.494507 1.386008 1.954198 1.308234 1.154144 1.812520 1.102079 0.991639 1.657984 0.947500 0.885765 1.444371 0.775990 0.774779 1.289425 0.549674 0.613062 1.134416 0.434937 0.421164 0.932422 0.317139 0.326873 0.888730 0.170155 0.216384 0.828818 0.045292 0.040392 0.641832 -0.002957 1.970586 0.581934 1.955967 1.971180 0.582291 1.831131 1.890082 0.453685 1.764758 1.809030 0.361473 1.808543 1.748037 0.376510 1.770108 1.635840 0.354278 1.584837 1.604942 0.332568 1.545624 1.688980 0.365504 1.682292 1.703299 0.329125 1.769500 1.613525 0.302659 1.742362 1.621835 0.356730 1.654219 1.680293 0.368667 1.670213 1.698169 0.359738 1.763391 1.757939 0.465090 1.805690 1.827093 0.604956 1.812925 1.903367 0.604764 1.922467 -0.025294 0.628482 0.089594 0.137527 0.798028 0.262512 0.258877 0.911337 0.287514 0.324127 0.998558 0.332378 0.380843 1.151589 0.535232 0.553092 1.371022 0.747359 0.744895 1.502854 0.865718 0.976266 1.650643 1.006169 1.106970 1.791773 1.242225 1.260090 -0.015493 1.406560 1.331339 0.096575 1.527099 1.636535 0.388321 1.680395 1.842931 0.617303 0.037514 0.206026 0.897517 0.308552 0.271648 1.031024 0.575724 0.609930 1.349235 0.734419 0.775137 1.618315 1.020351 1.284385 1.970785 1.300002 1.371580 0.127374 1.659861 1.733801 0.422372 1.877971 -0.124654 0.713050 0.209833 0.346893 1.127179 0.437124 0.588854 1.432995 0.900023 0.972522 1.733352 1.196377 1.323783 0.085855 1.616691 1.687760 0.520248 1.958862 0.045964 0.842704 0.272784 0.385563 1.254777 0.646529 0.726764 1.482577 1.020683 1.267843 0.057572 1.547226 1.616003 0.452522 1.870078 0.145163 0.875749 0.485546 0.508608 1.429635 0.748624 0.886073 1.688243 1.255738 1.472471 0.306561 1.765612 1.834766 0.642197 0.080630 0.375039 1.102978 0.833759 0.850343 1.767238 1.162381 1.224801 0.095208 1.586855 1.861578 0.755155 0.319961 0.353038 1.320731 0.620095 0.945907 1.774571 1.298278 1.517656 0.297706 1.952642 -0.038337 0.893178 0.328516 0.613616 1.363053 1.057818 1.211503 0.087536 1.604365 1.714531 0.728904 0.210695 0.460405 1.225001 0.710004 1.062252 1.876178 1.520212 1.510480 0.425053 -0.097606 0.255753 1.023751 0.690356 0.805742 1.690677 1.335670 1.483385 0.408341 1.893159 0.192442 1.161411 0.739588 0.925135 1.829951 1.365567 1.594797 0.509658 0.005143 0.242997 1.168938 0.817902 0.963916 1.857104 1.417510 1.653626 0.585496 0.202138 0.478316 1.384828 0.843333 1.158230 0.077613 1.760367 1.991495 0.880832 0.424302 0.668646 1.640237 1.279509 1.492224 0.438109 0.019040 0.359527 1.181372 0.777284 1.020087 -0.068629 1.601067 1.864491 0.711315 0.477258 0.630936 1.650085 1.163207 1.512004 0.565624 0.176851 0.401308 1.257747 0.848965 1.298253 0.235808 1.902518 0.017403 1.028387 0.666377 0.971703 0.006144 1.616350 1.921496 0.930440 0.386963 0.792916 1.753615 1.450589 1.722065 0.588282 0.189495 0.476219 1.468100 1.193455 1.470365 0.436381 0.079359 0.420904 1.447660 1.202499 1.449364 0.374602 0.038089 0.356451 1.332338 0.985146 1.364219 0.312539 -0.086805 0.271062 1.287916 0.990171 1.307320 0.328617 0.080264 0.298457 1.327271 0.964737 1.372802 0.416893 0.055261 0.471272 1.365200 1.078259 1.380118 0.386065 0.246323 0.422893 1.483916 1.070257 1.397825 0.560586 0.187349 0.566295 1.630632 1.149236 1.685105 0.667157 0.378525 0.731550 1.737848 1.577519 1.900618 0.865671 0.626718 0.985350 0.051991 1.713168 0.133614 1.176445 0.840279 1.212169 0.308045 0.044807 0.412756 1.430012 1.183088 1.552370 0.555032 0.334828 0.813003 1.836345 1.610299 1.988363 1.015828 0.766021 1.137781 0.269403 0.014111 0.441778 1.556738 1.304115 1.781815 0.811303 0.509380 1.001982 0.101347)
+ 23.440634 #(0.000000 0.426030 1.633705 1.350244 1.822699 1.117406 0.760360 1.218705 0.489063 0.130982 0.660045 1.857954 1.522020 0.046221 1.243722 0.934404 1.505808 0.634520 0.335568 0.893023 0.022202 1.770959 0.330133 1.445279 1.190570 1.726817 0.869688 0.682732 1.150875 0.343543 0.173129 0.588037 1.804434 1.684302 0.134268 1.329600 1.163625 1.734196 0.858998 0.631488 1.295997 0.342522 0.140446 0.794731 1.883601 1.642749 0.224765 1.367524 1.190082 1.703985 0.940140 0.794510 1.221050 0.506326 0.401990 0.834102 0.087660 -0.009348 0.494606 1.668822 1.555834 0.081180 1.193765 1.090147 1.622352 0.742254 0.632981 1.125333 0.327431 0.236167 0.784711 0.007146 1.906126 0.547040 1.721445 1.563510 0.199627 1.333384 1.227168 1.761235 0.923991 0.841192 1.351807 0.582425 0.472422 1.017208 0.356082 0.156052 0.741955 0.069415 1.865228 0.443182 1.678386 1.612970 0.140383 1.329706 1.377378 1.842230 1.016703 1.092840 1.598984 0.786321 0.783290 1.366382 0.596830 0.485853 1.108224 0.377773 0.289559 0.849099 0.105928 0.064781 0.612391 1.826534 1.809917 0.367089 1.631365 1.589731 0.161087 1.494515 1.386116 1.954189 1.308690 1.154519 1.812516 1.102100 0.991677 1.658122 0.947519 0.885543 1.444418 0.776188 0.774879 1.289586 0.549665 0.613017 1.134252 0.434792 0.421243 0.932319 0.317022 0.327169 0.888461 0.170057 0.216105 0.828813 0.045389 0.040689 0.641854 -0.002848 1.970444 0.582196 1.956226 1.971250 0.582269 1.831066 1.890158 0.453559 1.764288 1.808788 0.361533 1.808649 1.748165 0.376653 1.770438 1.636191 0.354208 1.584889 1.605114 0.332398 1.545608 1.688883 0.365394 1.682257 1.703243 0.329182 1.769538 1.613411 0.302562 1.742414 1.621620 0.356580 1.654026 1.680618 0.368698 1.670281 1.697881 0.359656 1.763776 1.758111 0.465066 1.805483 1.827186 0.605021 1.812596 1.903274 0.604865 1.922230 -0.025387 0.628349 0.089731 0.137752 0.798263 0.262482 0.259156 0.911079 0.287722 0.324018 0.998763 0.332415 0.380752 1.151737 0.535342 0.552776 1.370792 0.747285 0.745091 1.502875 0.865891 0.976216 1.650874 1.006357 1.107105 1.792005 1.242340 1.260107 -0.015443 1.406656 1.331304 0.096460 1.527143 1.636433 0.388059 1.680297 1.842977 0.617185 0.037555 0.206008 0.897751 0.308693 0.271454 1.030932 0.575683 0.609956 1.349186 0.734334 0.774877 1.617986 1.020318 1.284176 1.971094 1.299830 1.371580 0.127063 1.659891 1.733883 0.422404 1.877916 -0.124472 0.713110 0.209948 0.346821 1.126577 0.437048 0.588743 1.433036 0.899986 0.972766 1.733429 1.196252 1.323740 0.085920 1.616637 1.687489 0.520302 1.959177 0.046095 0.842588 0.272625 0.385751 1.254850 0.646533 0.726440 1.482746 1.020734 1.267838 0.057603 1.547154 1.615861 0.452541 1.870137 0.145167 0.875598 0.485371 0.508869 1.429584 0.748534 0.886224 1.688084 1.255595 1.472540 0.306419 1.766192 1.835107 0.642280 0.080214 0.375180 1.102720 0.833892 0.850373 1.766980 1.162157 1.224930 0.095082 1.586950 1.861328 0.755297 0.319553 0.352910 1.320696 0.619979 0.946006 1.774647 1.298293 1.517836 0.297710 1.952038 -0.038078 0.892992 0.328197 0.613535 1.363108 1.057662 1.211565 0.087446 1.604243 1.714707 0.729059 0.210757 0.460524 1.224990 0.710062 1.062423 1.876120 1.520283 1.510479 0.425166 -0.097643 0.255955 1.023768 0.690540 0.805852 1.690752 1.335687 1.483416 0.408233 1.893221 0.192221 1.161360 0.739517 0.925202 1.829775 1.365788 1.594776 0.509348 0.005048 0.242905 1.169014 0.817863 0.963813 1.857359 1.417487 1.653556 0.585583 0.202291 0.478261 1.384817 0.843148 1.158244 0.077605 1.760528 1.991459 0.880960 0.424295 0.668758 1.640376 1.279409 1.492356 0.437776 0.018676 0.359543 1.181398 0.777400 1.020046 -0.068615 1.601281 1.864426 0.711509 0.477287 0.630886 1.649929 1.163365 1.511936 0.565541 0.176581 0.401518 1.257992 0.849031 1.298324 0.235601 1.902596 0.017213 1.028733 0.666161 0.971699 0.006334 1.616499 1.921574 0.930376 0.386830 0.792955 1.753467 1.450876 1.722096 0.588511 0.189432 0.476076 1.468203 1.193520 1.470282 0.436184 0.079560 0.420631 1.447840 1.202654 1.449101 0.374792 0.038042 0.356591 1.332522 0.985149 1.364328 0.312406 -0.086898 0.270918 1.287974 0.989872 1.307478 0.328851 0.080347 0.298469 1.327442 0.964765 1.372970 0.416732 0.055396 0.471213 1.365312 1.077953 1.380339 0.386377 0.246182 0.422737 1.483895 1.070541 1.397778 0.560578 0.187438 0.566528 1.630790 1.149300 1.685334 0.666982 0.378533 0.731666 1.737806 1.577416 1.900835 0.865782 0.626581 0.985429 0.051655 1.713139 0.133657 1.176134 0.840423 1.212183 0.308483 0.044946 0.412679 1.430233 1.183002 1.552533 0.554928 0.335051 0.812955 1.836391 1.610505 1.988382 1.015880 0.765978 1.137783 0.269272 0.013962 0.441694 1.556548 1.304151 1.781860 0.811228 0.509326 1.001994 0.101493)
)
;;; 1024 all -------------------------------------------------------------------------------- (32)
-(vector 1024 54.490282136658 #(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)
+(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.410875 #(0.000000 0.258148 0.589168 0.994411 1.357701 1.683025 0.069074 0.453421 0.797628 1.185816 1.582436 1.938092 0.307108 0.753155 1.054506 1.465084 1.815186 0.241264 0.539120 0.935358 1.344730 1.757342 0.087826 0.560243 0.909870 1.313450 1.644065 0.104593 0.476633 0.874522 1.288326 1.742330 0.203193 0.590704 1.014919 1.387211 1.858546 0.251755 0.613119 1.088831 1.500246 1.956678 0.355205 0.836294 1.268025 1.705878 0.108690 0.586645 1.046489 1.430729 1.904826 0.322624 0.787698 1.277011 1.718145 0.125412 0.585092 1.047194 1.448174 1.936035 0.420374 0.902587 1.333104 1.856924 0.327896 0.858579 1.268399 1.749900 0.253263 0.677442 1.219161 1.714857 0.177166 0.633557 1.169787 1.640415 0.140512 0.621582 1.091651 1.607728 0.104564 0.583756 1.118053 1.652294 0.153513 0.714859 1.194251 1.697620 0.276971 0.782347 1.313258 1.816056 0.294830 0.852045 1.367731 1.912889 0.443181 0.976528 1.489519 0.048647 0.602555 1.171111 1.696946 0.267367 0.808494 1.328988 1.847036 0.429147 0.989539 1.554476 0.119989 0.631320 1.259112 1.823414 0.393440 0.968836 1.504033 0.126560 0.727472 1.269985 1.846490 0.405486 1.041942 1.582030 0.184859 0.803907 1.384064 0.001185 0.565238 1.185485 1.799966 0.388364 0.991281 1.615016 0.210322 0.777733 1.381829 -0.001858 0.601802 1.237656 1.865352 0.533475 1.133402 1.742192 0.420236 1.017900 1.625681 0.265207 0.907047 1.531875 0.165179 0.869961 1.486073 0.135412 0.775460 1.391805 0.032701 0.662061 1.355447 -0.029896 0.673845 1.349264 0.011611 0.729065 1.361114 0.013249 0.666596 1.353522 -0.007100 0.647754 1.363243 0.014621 0.674314 1.412588 0.079158 0.792604 1.491853 0.154571 0.839031 1.536947 0.216086 0.941461 1.657001 0.337150 1.060668 1.746479 0.482706 1.226119 1.946733 0.643851 1.336905 0.013042 0.754294 1.496162 0.232890 0.988475 1.681309 0.448137 1.146402 1.881464 0.552981 1.297819 0.098645 0.832913 1.606715 0.332666 1.035466 1.818940 0.554955 1.343968 0.085509 0.792214 1.558162 0.368596 1.106235 1.895172 0.644633 1.405521 0.165480 0.925201 1.747451 0.473692 1.324609 0.053177 0.850917 1.628773 0.424746 1.258663 0.036370 0.797966 1.564071 0.352485 1.148447 -0.002783 0.797088 1.561969 0.392501 1.189092 -0.019088 0.843646 1.634513 0.453206 1.275296 0.054828 0.916548 1.733451 0.558960 1.389762 0.203638 1.054862 1.897500 0.708809 1.574733 0.423071 1.215266 0.027342 0.899322 1.791858 0.620622 1.492274 0.320845 1.174701 0.051833 0.913009 1.796449 0.665146 1.471491 0.328743 1.193965 0.076732 0.978576 1.811604 0.666355 1.562427 0.437112 1.309285 0.223487 1.113773 0.007247 0.849622 1.753745 0.664875 1.576770 0.455394 1.360922 0.282060 1.150668 0.049047 0.927118 1.816088 0.739465 1.705374 0.642039 1.518132 0.405444 1.340122 0.312878 1.226245 0.139772 1.077510 -0.018816 0.936435 1.857875 0.823248 1.722658 0.669787 1.630579 0.550282 1.483551 0.473002 1.439850 0.374042 1.322563 0.264157 1.241756 0.176119 1.137549 0.127690 1.073354 0.045113 0.987362 -0.009728 0.938618 1.894769 0.930534 1.889094 0.819648 1.834591 0.887814 1.825305 0.751612 1.788639 0.781856 1.799187 0.761171 1.765995 0.797679 1.787953 0.747401 1.771597 0.793400 1.786941 0.805798 1.801885 0.838640 1.863755 0.878598 1.883687 0.921909 -0.012600 0.953576 0.028661 1.053164 0.071002 1.090274 0.114661 1.146587 0.180317 1.267377 0.271949 1.348847 0.373158 1.422115 0.472335 1.601819 0.584885 1.638612 0.781047 1.776789 0.821569 1.888293 0.973656 0.059587 1.102322 0.189225 1.264548 0.323677 1.429081 0.526711 1.594088 0.678108 1.711258 0.856227 1.948913 1.030332 0.171134 1.248971 0.337083 1.456252 0.496413 1.599787 0.743435 1.845411 0.979199 0.069456 1.191262 0.312034 1.362623 0.533174 1.673105 0.803847 1.903793 1.042569 0.150816 1.299359 0.434192 1.602414 0.715947 1.838326 1.018218 0.157768 1.253948 0.407857 1.573899 0.779851 1.904361 1.060636 0.223176 1.356991 0.495392 1.680203 0.833630 0.009780 1.167530 0.315957 1.492554 0.654024 1.856891 1.023069 0.220534 1.440206 0.582264 1.748500 0.970294 0.123193 1.307613 0.556564 1.730012 0.926711 0.113171 1.343735 0.556253 1.746273 0.934223 0.123997 1.384091 0.614003 1.782610 1.015379 0.224947 1.465548 0.684093 1.908440 1.124583 0.358057 1.642940 0.875505 0.064339 1.292308 0.557537 1.782713 1.008802 0.272821 1.511713 0.764842 0.030194 1.274549 0.483182 1.727237 1.016792 0.261776 1.522862 0.796446 0.042895 1.304520 0.619998 1.876690 1.148478 0.428322 1.679455 1.004325 0.300377 1.550416 0.835254 0.173352 1.448704 0.698650 -0.033801 1.272024 0.597214 1.859218 1.200705 0.517289 1.763401 1.106977 0.387334 1.700638 1.066989 0.326662 1.604820 0.962763 0.281408 1.585892 0.935892 0.271981 1.571275 0.916662 0.291788 1.570649 0.930716 0.269192 1.579444 0.969565 0.290012 1.615565 0.990795 0.311402 1.657094 0.994116 0.432873 1.757318 1.056873 0.417532 1.795268 1.185595 0.580763 1.918349 1.267276 0.656331 0.049168 1.401813 0.749992 0.176783 1.556953 0.966950 0.314017 1.682209 1.095751 0.473881 1.821750 1.291249 0.673330 0.057423 1.460592 0.890407 0.273536 1.708953 1.094797 0.541733 1.932285 1.354523 0.747235 0.170227 1.592085 1.015544 0.439882 1.847343 1.288875 0.701630 0.111506 1.621007 1.032815 0.491968 1.882621 1.348432 0.738302 0.277658 1.682524 1.144243 0.582029 0.024994 1.499949 0.920010 0.401061 1.889106 1.372403 0.804920 0.264480 1.729722 1.190624 0.695948 0.173617 1.607894 1.119209 0.625052 0.097713 1.558780 1.044363 0.564907 0.006836 1.535288 0.979484 0.498306 0.016897 1.518916 1.048287 0.505482 0.034846 1.537224 1.038826 0.583381 0.066441 1.582671 1.095360 0.652592 0.165653 1.666405 1.195978 0.749638 0.244931 1.794728 1.302261 0.855517 0.402763 1.919243 1.506054 0.990141 0.529140 0.090161 1.628924 1.232711 0.756188 0.320069 1.866574 1.434290 1.010093 0.586649 0.125842 1.632778 1.248832 0.786217 0.395146 1.983594 1.522744 1.184214 0.725738 0.283806 1.853291 1.411973 1.029503 0.623510 0.190003 1.817951 1.405723 0.998692 0.625566 0.196526 1.824631 1.367636 1.002432 0.638505 0.270362 1.867749 1.456887 1.107903 0.666557 0.365450 1.943932 1.534564 1.164468 0.812181 0.417778 0.109315 1.746468 1.348757 1.018766 0.607455 0.251719 1.902085 1.522432 1.168361 0.826689 0.501772 0.186624 1.829613 1.504989 1.149945 0.826038 0.430311 0.156773 1.805915 1.442117 1.129384 0.789359 0.448838 0.128070 1.860262 1.509251 1.221965 0.897472 0.558148 0.251257 1.927642 1.640546 1.338781 1.036792 0.710068 0.403207 0.109563 1.811625 1.572455 1.213598 0.939472 0.623448 0.409350 0.066783 1.811153 1.483733 1.240294 0.962497 0.677702 0.428980 0.151873 1.860959 1.600097 1.372939 1.073698 0.858833 0.549541 0.358709 0.048040 1.780703 1.499339 1.321408 1.026078 0.811519 0.563815 0.272950 0.101217 1.778901 1.584563 1.357171 1.096114 0.901285 0.691896 0.423414 0.187540 0.012408 1.741503 1.538220 1.375071 1.132353 0.924933 0.712966 0.501385 0.301492 0.064052 1.847152 1.740905 1.454340 1.287762 1.094301 0.900958 0.693746 0.504913 0.275695 0.137705 -0.008305 1.750189 1.585524 1.414196 1.262553 1.013251 0.925388 0.715978 0.553457 0.407454 0.213702 0.088434 1.972600 1.762556 1.622037 1.422263 1.305690 1.086572 0.965745 0.818250 0.679809 0.548833 0.434281 0.274574 0.162711 -0.016721 1.874108 1.711171 1.634760 1.470116 1.433824 1.198309 1.122645 0.994884 0.863715 0.716974 0.651737 0.505774 0.376030 0.305317 0.172395 0.043840 1.956668 1.879928 1.790226 1.657792 1.628858 1.503591 1.453387 1.399691 1.283663 1.175444 1.093586 1.015878 0.867180 0.833771 0.733456 0.751208 0.644973 0.524402 0.519350 0.448915 0.402270 0.223991 0.272710 0.178576 0.121816 0.014901 -0.008456 0.000722 1.948116 1.864026 1.799285 1.772492 1.761973 1.729645 1.648114 1.613644 1.601091 1.593669 1.506616 1.533589 1.464454 1.452519 1.424863 1.443072 1.448035 1.385776 1.402879 1.416069 1.400653 1.366739 1.389222 1.353373 1.316055 1.338545 1.366489 1.376447 1.387658 1.386874 1.383521 1.414816 1.478876 1.431144 1.443821 1.476250 1.453501 1.470783 1.513891 1.537062 1.574083 1.565440 1.667183 1.688265 1.726029 1.812251 1.818225 1.909534 1.893859 1.960853 -1.792261 0.049720 0.115471 0.168584 0.227816 0.312337 0.320765 0.432479 0.460834 0.497553 0.618812 0.667533 0.714551 0.786901 0.873018 0.948666 1.026741 1.049685 1.177075 1.308478 1.411491 1.456896 1.608694 1.673563 1.762266 1.858920 1.974208 0.033942 0.165671 0.243992 0.350794 0.473925 0.585735 0.737599 0.804002 0.963652 1.066959 1.216838 1.312134 1.446813 1.594176 1.676806 1.816313 1.965577 0.113977 0.201793 0.324796 0.449133 0.633633 0.769013 0.895692 1.061461 1.163832 1.372251 1.483231 1.640906 1.802011 -0.030958 0.155600 0.377255 0.507459 0.640650 0.847956 1.016719 1.214303 1.427027 1.567855 1.764212 1.940432 0.043642 0.292095 0.470854 0.648508 0.820657 1.060906 1.222563 1.354202 1.598601 1.737516 -0.028100 0.202713 0.374375 0.584831 0.817057 1.020703 1.253416 1.457146 1.644498 1.875195 0.140343 0.371551 0.579412 0.847798 1.090746 1.313318 1.565314 1.779179 -1.706782 0.198770 0.511497 0.711566 0.950424 1.152889 1.372135 1.700365 1.869801 0.181432 0.440942 0.691235 0.983921 1.186243 1.477055 1.750551 0.035866 0.314930 0.558441 0.801324 1.080423 1.361289 1.616783 1.906440 0.211190 0.450778 0.806041 1.119162 1.408538 1.703492 0.007343 0.317836 0.612325 0.935395 1.211907 1.545362 1.855618 0.133582 0.501303 0.746887 1.072480 1.396132 1.651845 -0.008716 0.328392 0.710493 1.027135 1.346260 1.695106 0.085660)
+ 33.374473 #(0.000000 0.252466 0.588951 0.993527 1.357313 1.683734 0.069809 0.450439 0.797448 1.186593 1.578272 1.940345 0.307053 0.750457 1.055380 1.462831 1.817883 0.237479 0.537067 0.937575 1.345387 1.754717 0.087929 0.559072 0.909744 1.309407 1.642019 0.101091 0.475619 0.872339 1.284410 1.742673 0.203121 0.590834 1.015458 1.386384 1.861592 0.250991 0.617588 1.087952 1.502288 1.958251 0.358349 0.833894 1.266192 1.707184 0.106355 0.586042 1.044908 1.429192 1.903768 0.324280 0.784739 1.272123 1.718895 0.124307 0.583814 1.047738 1.449153 1.935335 0.423671 0.902671 1.334661 1.850264 0.329540 0.856853 1.269574 1.748920 0.252528 0.680725 1.219132 1.716699 0.175050 0.633885 1.168238 1.644609 0.139639 0.621115 1.085185 1.605137 0.102611 0.579483 1.120346 1.650249 0.154949 0.714900 1.195205 1.701851 0.280014 0.782977 1.313733 1.813976 0.293596 0.850057 1.368487 1.911546 0.442371 0.978381 1.488296 0.047014 0.605437 1.168355 1.699786 0.264864 0.808435 1.331553 1.849562 0.431369 0.985127 1.556109 0.117837 0.630352 1.255885 1.824281 0.392991 0.967598 1.500456 0.124772 0.729848 1.269485 1.843754 0.407420 1.046501 1.579408 0.181940 0.806117 1.386254 0.001009 0.563805 1.190016 1.801496 0.390948 0.992792 1.614455 0.210258 0.781394 1.383257 0.000666 0.602470 1.235233 1.863100 0.531303 1.131585 1.743010 0.420996 1.020656 1.623868 0.265165 0.904942 1.532392 0.166093 0.866254 1.489209 0.133622 0.775195 1.393642 0.035938 0.663395 1.358225 -0.031248 0.674767 1.345484 0.011038 0.726890 1.359966 0.012592 0.666536 1.355458 -0.004366 0.648071 1.362053 0.015012 0.678133 1.414541 0.079788 0.791559 1.487446 0.156449 0.840897 1.538269 0.215586 0.944875 1.656501 0.337296 1.056987 1.748917 0.481011 1.222798 1.949397 0.643598 1.334666 0.012773 0.756898 1.495281 0.233846 0.987847 1.681320 0.445510 1.147284 1.880454 0.550973 1.299839 0.096454 0.834160 1.602645 0.329204 1.033491 1.822199 0.555160 1.342200 0.084319 0.791481 1.559457 0.369205 1.109797 1.897967 0.644861 1.408557 0.166439 0.927185 1.747959 0.474274 1.322629 0.055063 0.852456 1.629387 0.426864 1.256914 0.032615 0.797766 1.564512 0.350911 1.149497 -0.000040 0.798696 1.562186 0.396375 1.189875 -0.018096 0.838570 1.632349 0.458136 1.274671 0.059254 0.914741 1.734535 0.560451 1.391448 0.203824 1.054809 1.896371 0.705797 1.574147 0.418484 1.214141 0.028485 0.895706 1.790344 0.623050 1.493771 0.320252 1.176177 0.050029 0.913211 1.795700 0.666014 1.474707 0.328339 1.193655 0.074210 0.979728 1.814943 0.670174 1.557795 0.436269 1.308677 0.222750 1.112829 0.008125 0.850193 1.752643 0.663492 1.575371 0.455015 1.361742 0.280736 1.149516 0.049087 0.929854 1.815964 0.737606 1.707892 0.641655 1.518614 0.405387 1.338935 0.314296 1.225580 0.140607 1.081337 -0.017239 0.936324 1.857449 0.822615 1.721300 0.673418 1.628566 0.549339 1.480517 0.473833 1.439096 0.368510 1.320631 0.264193 1.239814 0.177843 1.137112 0.130531 1.073537 0.042883 0.987981 -0.004279 0.936009 1.888189 0.930189 1.891869 0.820811 1.834827 0.887039 1.824376 0.747815 1.790439 0.780503 1.796779 0.759219 1.766971 0.797655 1.784554 0.745936 1.771373 0.792407 1.786375 0.804589 1.803550 0.837418 1.866094 0.878964 1.883068 0.919516 -0.015185 0.950852 0.031346 1.056039 0.072641 1.095935 0.112880 1.148861 0.179066 1.266345 0.274163 1.349332 0.375026 1.420407 0.470055 1.600747 0.585724 1.641289 0.778546 1.782299 0.821719 1.891814 0.973740 0.056436 1.100293 0.188196 1.266716 0.326930 1.426317 0.523355 1.597494 0.675246 1.710775 0.855617 1.948453 1.034108 0.171254 1.253350 0.339035 1.456884 0.495692 1.601468 0.741390 1.844124 0.978634 0.069362 1.190306 0.312916 1.359275 0.532374 1.674891 0.805593 1.907279 1.045394 0.152007 1.297408 0.432266 1.599082 0.714594 1.832747 1.012497 0.155234 1.247584 0.410225 1.574039 0.780688 1.902527 1.062189 0.220275 1.355578 0.497978 1.677196 0.830984 0.009602 1.165929 0.314143 1.493130 0.653284 1.857571 1.020668 0.222423 1.438209 0.581964 1.752997 0.967293 0.121829 1.301778 0.555368 1.729424 0.920178 0.112029 1.344983 0.552127 1.746200 0.932133 0.121046 1.387103 0.613592 1.782747 1.017822 0.226370 1.467755 0.683561 1.907207 1.122982 0.357556 1.639460 0.871552 0.063413 1.293194 0.553668 1.778829 1.007632 0.273725 1.513322 0.761325 0.030734 1.275232 0.487423 1.728311 1.015629 0.263344 1.522299 0.799410 0.044265 1.304514 0.617183 1.877877 1.149672 0.431853 1.677004 1.007028 0.302211 1.550471 0.830712 0.171703 1.448480 0.698486 -0.031127 1.271404 0.597706 1.861766 1.199953 0.516029 1.763915 1.104156 0.388173 1.701901 1.066694 0.321839 1.603390 0.959621 0.283658 1.584712 0.934566 0.271985 1.573608 0.915269 0.290696 1.570692 0.929882 0.269333 1.578798 0.968633 0.290489 1.619305 0.991513 0.312359 1.657482 0.998956 0.429983 1.756634 1.057784 0.418664 1.800624 1.183798 0.580987 1.922612 1.270752 0.656543 0.049978 1.402642 0.747715 0.172924 1.558081 0.969294 0.317219 1.680723 1.101146 0.471812 1.822804 1.290460 0.673288 0.054597 1.459594 0.889985 0.272866 1.707599 1.099319 0.539813 1.933112 1.350417 0.746491 0.168901 1.587604 1.012663 0.439717 1.848855 1.289046 0.699225 0.110900 1.617704 1.032004 0.486471 1.883481 1.347450 0.740815 0.273665 1.683814 1.143137 0.582919 0.025433 1.497822 0.920817 0.405635 1.885698 1.374658 0.807406 0.264005 1.731265 1.191426 0.696988 0.175518 1.604013 1.118868 0.624645 0.099225 1.558445 1.043940 0.564134 0.010522 1.534509 0.977597 0.494357 0.019653 1.520055 1.045952 0.505344 0.035488 1.536251 1.041325 0.583702 0.067507 1.579160 1.096009 0.648153 0.167694 1.664323 1.196255 0.745939 0.243575 1.794373 1.302872 0.854116 0.402215 1.917600 1.507649 0.988437 0.530059 0.093891 1.632161 1.231648 0.751898 0.319666 1.867074 1.434799 1.008544 0.585827 0.127128 1.632587 1.248019 0.782886 0.394903 1.983386 1.521085 1.181230 0.723256 0.284301 1.855881 1.414227 1.028625 0.624603 0.192084 1.817801 1.405052 0.998220 0.624346 0.196694 1.823334 1.364186 1.002850 0.636156 0.271164 1.867655 1.456035 1.107502 0.666593 0.368326 1.946509 1.537766 1.165530 0.809896 0.419009 0.110115 1.746698 1.350928 1.018055 0.608571 0.251616 1.901427 1.522807 1.168888 0.829662 0.505211 0.184783 1.828526 1.503308 1.150698 0.826375 0.428165 0.158649 1.807468 1.440860 1.131643 0.785520 0.447898 0.128873 1.860682 1.510820 1.223548 0.896640 0.557184 0.253717 1.926870 1.641384 1.338683 1.035590 0.712004 0.404139 0.112150 1.812688 1.574586 1.216207 0.941513 0.625042 0.408198 0.062380 1.810869 1.482062 1.240688 0.957365 0.680320 0.429796 0.154764 1.860026 1.599693 1.376641 1.071073 0.859627 0.552489 0.358909 0.051522 1.779345 1.502678 1.321934 1.021840 0.809020 0.564858 0.271454 0.099141 1.782086 1.583810 1.359029 1.096557 0.902358 0.692594 0.423964 0.183482 0.010493 1.741888 1.541983 1.375015 1.129819 0.921131 0.712282 0.503309 0.299387 0.066672 1.846788 1.740922 1.453873 1.287077 1.096208 0.901776 0.696344 0.505740 0.279658 0.141218 -0.009868 1.749203 1.586308 1.414178 1.263965 1.012233 0.925940 0.712089 0.554819 0.406768 0.214210 0.089079 1.971321 1.760810 1.619247 1.423122 1.307100 1.088608 0.965427 0.819180 0.676003 0.546765 0.433232 0.274525 0.162885 -0.018342 1.869887 1.712968 1.635401 1.471330 1.433087 1.199704 1.121027 0.996776 0.865997 0.721985 0.649519 0.503572 0.378030 0.306063 0.167812 0.043117 1.955954 1.877053 1.790219 1.660027 1.629588 1.503196 1.451102 1.397998 1.283286 1.173782 1.089892 1.019019 0.869773 0.834761 0.732093 0.747994 0.643643 0.523427 0.515735 0.445955 0.405429 0.221137 0.271772 0.178970 0.122432 0.013828 -0.003132 -0.001158 1.950035 1.860450 1.798152 1.772591 1.763536 1.729625 1.643982 1.610256 1.606010 1.590205 1.508785 1.532490 1.462457 1.451053 1.422444 1.446066 1.447988 1.386261 1.404128 1.414727 1.398914 1.364119 1.389560 1.352679 1.319320 1.338376 1.366863 1.375496 1.385684 1.385446 1.384425 1.413777 1.477028 1.430636 1.444983 1.474705 1.453343 1.468425 1.512139 1.536733 1.569253 1.569297 1.665250 1.689514 1.720655 1.816152 1.816532 1.910481 1.890678 1.959987 -1.792426 0.053715 0.115329 0.166763 0.231814 0.310808 0.324074 0.430373 0.462911 0.495915 0.617237 0.670044 0.713502 0.786959 0.873729 0.946470 1.028984 1.046472 1.174623 1.308868 1.411019 1.454609 1.611193 1.668848 1.765214 1.860585 1.976181 0.035788 0.164142 0.247894 0.350093 0.473449 0.588072 0.735194 0.803520 0.961783 1.067895 1.217363 1.313938 1.443209 1.597599 1.675037 1.816330 1.965102 0.116284 0.203328 0.322221 0.450260 0.632704 0.767955 0.897425 1.061506 1.164967 1.371694 1.484400 1.640468 1.798663 -0.032025 0.162330 0.379793 0.505773 0.642450 0.845431 1.017724 1.216278 1.429899 1.565994 1.768428 1.940934 0.042255 0.296837 0.472048 0.648674 0.816029 1.058523 1.225825 1.353792 1.601152 1.737085 -0.028473 0.197707 0.373692 0.582653 0.817097 1.021485 1.251988 1.456630 1.644133 1.876522 0.142009 0.374211 0.577570 0.848737 1.089787 1.313869 1.567866 1.781059 -1.711473 0.200912 0.510980 0.713060 0.951010 1.155259 1.371244 1.698759 1.871132 0.184166 0.440877 0.692757 0.984187 1.190414 1.477138 1.754476 0.035944 0.316410 0.556995 0.803845 1.078376 1.363995 1.614641 1.912582 0.211128 0.450712 0.806827 1.121281 1.408410 1.704293 0.008976 0.318343 0.616467 0.933106 1.209105 1.543596 1.851741 0.136561 0.499220 0.746641 1.072967 1.396431 1.652410 -0.009945 0.328852 0.712515 1.027614 1.349165 1.697419 0.088151)
)
;;; 2048 all -------------------------------------------------------------------------------- (45.254)
-(vector 2048 89.570060996356 #(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)
+(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
- 50.205430 #(0.000000 0.435841 1.590025 1.333909 1.800782 0.936896 0.640772 1.054371 0.276465 0.022204 0.420173 1.637156 1.317845 1.822696 0.936038 0.684182 1.165979 0.256451 0.034146 0.530882 1.581638 1.361041 1.855482 0.981545 0.775560 1.219427 0.308786 0.074234 0.592840 1.697019 1.456943 1.894603 1.053571 0.870395 1.260578 0.415941 0.216750 0.664998 1.768556 1.530284 0.017758 1.155044 0.880167 1.399032 0.522236 0.296590 0.788933 1.883168 1.702734 0.130840 1.241124 1.015672 1.506862 0.618786 0.413989 0.882191 0.040812 1.770208 0.266965 1.415350 1.179212 1.617452 0.837073 0.560382 1.039153 0.189709 0.008982 0.428192 1.582302 1.375969 1.775847 1.001684 0.722251 1.221935 0.371046 0.124429 0.658497 1.801753 1.557144 0.055429 1.167445 0.965998 1.463160 0.590632 0.421360 0.870506 1.979716 1.785918 0.217687 1.423155 1.229053 1.677639 0.820116 0.622279 1.118801 0.227079 0.047207 0.530002 1.646116 1.495215 1.938348 1.092314 0.858748 1.368355 0.507435 0.300967 0.831830 1.945902 1.701826 0.241789 1.346179 1.176339 1.698123 0.782522 0.593683 1.099893 0.220752 0.071121 0.492713 1.698729 1.537108 0.003593 1.112312 0.923924 1.420945 0.591862 0.368816 0.876237 0.024325 1.841665 0.349974 1.496560 1.313963 1.781383 0.909134 0.778966 1.228602 0.360482 0.169252 0.720535 1.827819 1.642014 0.151850 1.298858 1.132119 1.583582 0.775812 0.613883 1.034899 0.197663 0.038469 0.550873 1.681101 1.473296 0.002756 1.168244 0.976999 1.468806 0.641511 0.472463 0.917530 0.115543 1.932746 0.461045 1.615860 1.421110 1.916591 1.100326 0.915266 1.450442 0.570898 0.409829 0.895347 0.064350 1.886870 0.368337 1.508665 1.402167 1.875808 1.089074 0.915502 1.348721 0.569668 0.334905 0.845366 0.062665 1.931036 0.423161 1.570481 1.376249 1.892683 1.058012 0.892579 1.382946 0.530863 0.389584 0.911546 0.066065 1.944943 0.431750 1.524837 1.397825 1.916894 1.103011 0.925384 1.421598 0.609580 0.450668 0.957299 0.103861 0.017005 0.489835 1.632099 1.491083 0.040341 1.187478 1.048136 1.580660 0.750188 0.526672 1.095701 0.287178 0.103106 0.633176 1.805673 1.635672 0.181746 1.340109 1.155467 1.751104 0.863186 0.725371 1.256183 0.417821 0.247907 0.731305 1.971687 1.812887 0.362885 1.544484 1.346445 1.843347 1.064098 0.903511 1.425141 0.615217 0.470411 0.992301 0.186866 0.055090 0.515270 1.737073 1.613907 0.129315 1.316755 1.145516 1.689159 0.887610 0.688556 1.250192 0.483418 0.277491 0.831631 -0.015312 1.878418 0.427015 1.584482 1.443552 1.963597 1.131045 1.053018 1.569404 0.748022 0.602632 1.105250 0.310334 0.191836 0.693611 1.868001 1.741296 0.244951 1.472171 1.322184 1.879876 1.046328 0.929137 1.487162 0.690252 0.536393 1.028834 0.241099 0.137310 0.681359 1.872418 1.703102 0.276974 1.417116 1.322284 1.892467 1.055982 0.931972 1.453120 0.680784 0.569223 1.072473 0.292525 0.179779 0.702639 1.907779 1.763892 0.296945 1.502504 1.403596 1.895642 1.078898 1.020313 1.582828 0.728374 0.631181 1.177822 0.386973 0.229679 0.763366 -0.020603 1.884762 0.449056 1.615978 1.445670 0.076665 1.319406 1.139316 1.687368 0.868342 0.754364 1.316715 0.562902 0.373746 0.962616 0.143265 0.060537 0.597136 1.794156 1.674512 0.244828 1.423610 1.307469 1.861513 1.128650 1.011922 1.509496 0.793005 0.646450 1.183857 0.401441 0.274501 0.848007 0.152648 1.938838 0.515464 1.751327 1.585203 0.128719 1.344067 1.257980 1.813937 1.034672 0.961830 1.482792 0.710147 0.627952 1.158173 0.396545 0.308224 0.839308 0.084640 1.949979 0.467374 1.766014 1.652675 0.156038 1.404099 1.323696 1.916673 1.129204 1.007203 1.565692 0.792625 0.676519 1.246538 0.476588 0.355046 0.897504 0.154095 0.032713 0.616322 1.822050 1.713319 0.339487 1.549436 1.415806 -0.029700 1.251496 1.105739 1.706293 0.927616 0.827632 1.429701 0.652859 0.511881 1.153658 0.364245 0.227734 0.828965 0.039610 1.955264 0.489121 1.779904 1.680272 0.264792 1.492297 1.379563 1.958496 1.182126 1.073866 1.647475 0.887025 0.759908 1.352711 0.598690 0.504193 1.064292 0.364855 0.256068 0.821048 0.072182 1.978457 0.553596 1.801077 1.686861 0.245374 1.501095 1.463244 0.048757 1.270724 1.195638 1.795159 0.991907 0.929823 1.498115 0.775504 0.635637 1.221022 0.502033 0.392861 1.015769 0.238715 0.139376 0.772010 -0.001203 1.966386 0.502478 1.754699 1.653913 0.238134 1.455433 1.421962 0.005716 1.237219 1.195953 1.785244 1.034444 0.946973 1.522226 0.772000 0.724085 1.279219 0.566698 0.471639 1.081117 0.318698 0.216243 0.869842 0.093780 0.035928 0.580682 1.866189 1.774688 0.335441 1.640447 1.567092 0.150911 1.385331 1.332318 1.956070 1.197687 1.107245 1.722318 0.935373 0.939612 1.481560 0.775194 0.705562 1.294862 0.556921 0.470799 1.085453 0.374791 0.241371 0.872640 0.127624 0.032808 0.648015 1.958410 1.857207 0.450764 1.687826 1.673077 0.276455 1.524057 1.465118 0.092578 1.331259 1.262485 1.865029 1.129716 1.070468 1.691226 0.954621 0.907368 1.547298 0.800536 0.754442 1.318798 0.655491 0.523948 1.167921 0.458202 0.394916 0.974268 0.209530 0.172260 0.769859 0.045732 -0.027787 0.639418 1.895968 1.831369 0.455565 1.755348 1.702164 0.323430 1.549605 1.507505 0.099809 1.366067 1.343189 1.936579 1.213931 1.207459 1.780054 1.037769 1.005956 1.688129 0.918293 0.876995 1.491983 0.755576 0.731170 1.306379 0.613008 0.560202 1.151819 0.453386 0.401075 1.052899 0.336562 0.307092 0.918155 0.200321 0.133534 0.755336 0.041372 -0.036174 0.643495 1.904976 1.892087 0.486352 1.795593 1.721679 0.369291 1.607795 1.576284 0.213583 1.494045 1.463382 0.080370 1.381980 1.326067 1.977786 1.247994 1.213791 1.878128 1.145632 1.125599 1.744040 1.003768 0.975298 1.655044 0.946812 0.902005 1.481429 0.838355 0.806420 1.384034 0.676425 0.687951 1.289459 0.584933 0.544028 1.143652 0.530696 0.446531 1.060469 0.381371 0.383221 0.985636 0.284345 0.259040 0.894751 0.181035 0.155719 0.802236 0.121624 0.058494 0.696055 -0.033257 -0.009001 0.631717 1.933686 1.907503 0.526027 1.815256 1.827541 0.422361 1.751874 1.770954 0.332622 1.681580 1.649270 0.311710 1.607800 1.583524 0.245744 1.540534 1.499654 0.148625 1.457370 1.373290 0.075021 1.394843 1.347459 -0.005752 1.303682 1.317955 1.926281 1.233373 1.253750 1.868046 1.183593 1.200479 1.828734 1.154318 1.138091 1.739705 1.063036 1.026015 1.760005 1.052209 0.997647 1.670582 1.013683 0.946378 1.618597 0.957911 0.901792 1.567409 0.889999 0.912144 1.559979 0.891151 0.880294 1.500532 0.874896 0.781828 1.470208 0.813331 0.808539 1.418100 0.746813 0.751008 1.419231 0.717221 0.726739 1.410727 0.731944 0.676864 1.409264 0.642315 0.664365 1.364908 0.686123 0.651596 1.257741 0.652814 0.617542 1.306260 0.604389 0.592953 1.273395 0.605575 0.615524 1.252456 0.600454 0.596734 1.273260 0.596265 0.607909 1.252575 0.565927 0.570637 1.242139 0.541616 0.579959 1.248588 0.553529 0.579117 1.248565 0.574621 0.589047 1.309100 0.589822 0.602557 1.287938 0.578939 0.630286 1.280033 0.567074 0.622654 1.240139 0.594827 0.651875 1.291451 0.614140 0.689991 1.288405 0.659401 0.658369 1.319440 0.687094 0.674513 1.346708 0.688976 0.753907 1.375336 0.762674 0.739012 1.414601 0.787609 0.775338 1.420075 0.806180 0.800733 1.486208 0.845147 0.821967 1.516891 0.910404 0.867286 1.542889 0.887043 0.903213 1.634817 0.952223 0.964661 1.682581 0.979874 1.017143 1.672617 0.994877 1.107400 1.788990 1.110961 1.073654 1.789664 1.138909 1.162757 1.815050 1.225817 1.210897 1.926791 1.302244 1.265372 -0.026931 1.330408 1.387907 0.023026 1.451566 1.422994 0.130173 1.484590 1.521586 0.183712 1.551561 1.583662 0.282642 1.591114 1.655077 0.304500 1.684251 1.694195 0.429792 1.769650 1.808357 0.487540 1.818396 1.853851 0.530630 1.955039 -0.119812 0.676604 0.023437 0.063422 0.780580 0.147218 0.198738 0.872448 0.220227 0.252425 0.986952 0.295255 0.393016 1.036257 0.448018 0.427099 1.156162 0.552881 0.530707 1.267911 0.635862 0.680452 1.365591 0.735775 0.797614 1.468054 0.829271 0.858249 1.597356 0.963427 0.979328 1.664777 1.072381 1.131497 1.848461 1.213953 1.199832 1.960555 1.304633 1.318228 0.076788 1.452570 1.479484 0.164500 1.572776 1.636533 0.356533 1.684649 1.726841 0.451773 1.812513 1.874046 0.543934 1.930798 1.972699 0.744026 0.063643 0.159361 0.823095 0.219497 0.299864 0.954777 0.358746 0.414413 1.115727 0.519760 0.542990 1.311137 0.651203 0.710761 1.454950 0.772652 0.872236 1.543810 0.968311 1.006341 1.723434 1.088664 1.231621 1.884135 1.281249 1.347331 0.036078 1.419412 1.446527 0.204240 1.613579 1.679100 0.340114 1.736107 1.840278 0.571743 1.943781 0.023224 0.697394 0.138951 0.151958 0.882054 0.266019 0.342269 1.098555 0.488882 0.520277 1.270261 0.682615 0.682051 1.423350 0.809398 0.923761 1.649263 1.068684 1.091760 1.803833 1.223733 1.263221 0.017517 1.421547 1.466248 0.224731 1.593966 1.649396 0.409457 1.781845 1.845835 0.622136 -0.009609 0.077538 0.792485 0.188358 0.288489 1.013605 0.431185 0.495730 1.211960 0.604816 0.676648 1.456905 0.844139 0.905285 1.630909 1.032426 1.128266 1.853145 1.262038 1.300211 0.056675 1.467598 1.530064 0.291293 1.687552 1.755257 0.468236 1.938565 -0.011915 0.736090 0.173114 0.213450 0.994156 0.364997 0.457458 1.187825 0.639595 0.686838 1.462796 0.854330 0.903639 1.704943 1.071752 1.179798 1.898999 1.338040 1.405342 0.147449 1.639838 1.676028 0.379818 1.815921 1.886234 0.634529 0.079207 0.176862 0.921077 0.270512 0.406031 1.127890 0.593242 0.648029 1.403498 0.841450 0.919674 1.687653 1.135150 1.209027 1.975682 1.393578 1.449497 0.153208 1.639075 1.709636 0.452445 1.874711 0.022432 0.714196 0.206678 0.205405 0.997873 0.413099 0.533511 1.297878 0.703835 0.801048 1.536439 0.962427 1.059551 1.860285 1.319040 1.383017 0.135002 1.534723 1.648532 0.422108 1.844915 1.956976 0.704238 0.117947 0.249102 1.002403 0.473197 0.500625 1.262507 0.728698 0.830758 1.550450 1.042097 1.137051 1.913071 1.319323 1.401617 0.205540 1.634001 1.717675 0.487628 1.929708 0.032724 0.779967 0.225924 0.383724 1.109069 0.562827 0.649848 1.460986 0.840877 0.966680 1.747337 1.203625 1.315331 0.088823 1.496248 1.629011 0.431806 1.822514 1.942005 0.728686 0.158211 0.297041 1.029719 0.522309 0.626677 1.357536 0.800226 0.986575 1.730215 1.163174 1.231016 0.034610 1.521930 1.589379 0.414306 1.841215 1.927232 0.696438 0.186996 0.290301 1.088563 0.519977 0.648216 1.417722 0.845987 1.012127 1.780754 1.219818 1.368384 0.133468 1.552692 1.697685 0.489975 1.948146 0.025352 0.835325 0.308902 0.425789 1.189446 0.647629 0.780553 1.534982 0.953650 1.144994 1.982784 1.383491 1.490496 0.239036 1.733469 1.907366 0.658487 0.109199 0.230682 1.052834 0.517391 0.608626 1.405419 0.866368 0.974067 1.812201 1.250521 1.390848 0.148194 1.623658 1.769017 0.559808 0.019981 0.093630 0.962157 0.385643 0.557254 1.332258 0.775494 0.936936 1.712764 1.224080 1.333572 0.130012 1.553976 1.733749 0.509265 0.048320 0.120671 0.899273 0.371543 0.562577 1.333084 0.820342 0.953357 1.769820 1.220433 1.358228 0.127107 1.579894 1.763318 0.586085 0.056061 0.168973 0.987419 0.437016 0.613035 1.379444 0.892129 1.014623 1.821313 1.267297 1.418105 0.246254 1.755013 1.842641 0.624100 0.156213 0.268757 1.103436 0.559665 0.758240 1.532549 1.036259 1.153852 1.946220 1.432069 1.593807 0.418226 1.855454 0.035725 0.832622 0.314591 0.476792 1.257265 0.773297 0.905003 1.712302 1.200651 1.350735 0.149477 1.642212 1.802991 0.603766 0.109674 0.272495 1.104655 0.552848 0.662208 1.508113 0.969884 1.222187 1.957345 1.483565 1.659081 0.418223 1.951257 0.147291 0.901050 0.444550 0.555960 1.394491 0.833321 1.009746 1.850858 1.330172 1.483655 0.313675 1.811415 -0.000236 0.794841 0.301262 0.490013 1.322742 0.745660 0.925074 1.784514 1.271636 1.375387 0.219194 1.716991 1.919514 0.731082 0.283071 0.394652 1.209183 0.703971 0.883949 1.723347 1.226581 1.417977 0.169502 1.728678 1.897967 0.751809 0.206641 0.351287 1.193966 0.679687 0.833001 1.679398 1.202836 1.369136 0.221180 1.698828 1.890944 0.736466 0.259414 0.428156 1.246968 0.715069 0.887462 1.766067 1.234005 1.366933 0.267319 1.785542 1.921115 0.782951 0.288312 0.432145 1.324227 0.812529 0.987537 1.849387 1.334204 1.550652 0.384742 1.887557 0.032221 0.888154 0.427508 0.583364 1.373198 0.935366 1.078859 1.962687 1.425781 1.648177 0.492137 0.010583 0.174236 1.065860 0.556317 0.711714 1.613293 1.102246 1.261519 0.161159 1.621868 1.845116 0.621649 0.151344 0.408750 1.266111 0.733611 0.981402 1.781143 1.313677 1.478251 0.389746 1.864238 0.058118 0.877935 0.412750 0.590919 1.454967 0.995341 1.160158 0.052979 1.551988 1.735067 0.575701 0.113408 0.309369 1.203349 0.691004 0.901203 1.755113 1.285355 1.469400 0.316179 1.835734 0.063761 0.937353 0.419020 0.615917 1.461648 1.030447 1.209615 0.096211 1.589011 1.815774 0.626322 0.175182 0.402805 1.254295 0.809294 0.981937 1.881195 1.349170 1.565323 0.444505 1.905301 0.141863 1.013394 0.599160 0.768860 1.639481 1.173121 1.378015 0.207298 1.781004 -0.005481 0.841053 0.359648 0.584036 1.466213 1.014043 1.198019 0.047150 1.611088 1.803839 0.693503 0.251733 0.378659 1.292988 0.846097 1.025550 1.895967 1.457063 1.643561 0.544671 0.078331 0.286831 1.144981 0.701288 0.911563 1.800290 1.360060 1.533921 0.464563 1.970167 0.187072 1.028247 0.574824 0.822213 1.719286 1.250441 1.465682 0.304625 1.883042 0.150589 0.966248 0.508969 0.740351 1.592154 1.164985 1.396695 0.251798 1.797977 0.055983 0.893992 0.460716 0.676688 1.575389 1.096148 1.354511 0.224581 1.739098 0.014063 0.882137 0.432033 0.697360 1.575477 1.060614 1.342466 0.184638 1.767539 1.986710 0.880248 0.447116 0.686853 1.534981 1.149302 1.322036 0.217110 1.750455 -0.028293 0.927727 0.463276 0.699948 1.574079 1.122276 1.344937 0.239499 1.798792 0.041111 0.901108 0.502016 0.734564 1.619516 1.235793 1.392027 0.313428 1.875178 0.114986 0.986008 0.554567 0.774672 1.670995 1.277666 1.490688 0.422851 1.938664 0.192686 1.081363 0.636062 0.878896 1.801674 1.320125 1.610705 0.510337 0.119965 0.288198 1.229365 0.736391 0.974652 1.921844 1.522756 1.760341 0.627784 0.195364 0.424026 1.350173 0.914137 1.149417 0.055182 1.641041 1.885754 0.774177 0.341638 0.609082 1.476268 1.075234 1.336728 0.232957 1.816024 0.059891 0.977615 0.583895 0.818725 1.691585 1.233407 1.522719 0.426347 -0.011898 0.222340 1.211913 0.738174 1.037566 1.889523 1.491590 1.769255 0.654387 0.200388 0.477881 1.388587 0.995612 1.263033 0.151400 1.737244 1.994853 0.888393 0.448480 0.715631 1.639779 1.266990 1.475739 0.402022 0.001228 0.277508 1.193996 0.717293 1.022382 1.945731 1.528880 1.769925 0.676796 0.308016 0.544866 1.452245 1.056044 1.374139 0.251435 1.839100 0.082677 1.030130 0.593594 0.869317 1.751919 1.380599 1.660743 0.544875 0.134766 0.419262 1.359116 0.926374 1.200425 0.154745 1.776244 0.028854 0.907934 0.517864 0.744877 1.733023 1.291145 1.589046 0.524515 0.143068 0.380331 1.270800 0.877957 1.158416 0.095496 1.721531 1.962074 0.894065 0.487382 0.748783 1.673707 1.270037 1.572661 0.487139 0.118310 0.353424 1.330880 0.967912 1.217091 0.192030 1.746726 -0.008521 0.972139 0.569214 0.836629 1.792874 1.387645 1.624565 0.632818 0.169837 0.496488 1.391429 1.038248 1.276246 0.204951 1.839860 0.124740 1.060001 0.657481 0.979959 1.891365 1.498561 1.801028 0.717400 0.315222 0.620564 1.593479 1.178952 1.451115 0.404598 -0.005528 0.313885 1.242306 0.875831 1.127959 0.103028 1.705375 0.012699 0.926034 0.577294 0.846113 1.771401 1.375194 1.686187 0.652973 0.275173 0.528957 1.475197 1.099695 1.450803 0.394864 0.006041 0.319714 1.201074 0.888068 1.130526 0.060555 1.730127 0.003973 0.970567 0.557199 0.876983 1.840537 1.453875 1.730436 0.638584 0.293627 0.612145 1.531639 1.167803 1.518469 0.454591 0.106958 0.368985 1.332865 0.982631 1.260304 0.220211 1.799722 0.130226 1.090090 0.701451 1.045234 1.992618 1.626535 1.912666 0.832021 0.542880 0.767909 1.778263 1.387748 1.677161 0.622205 0.269109 0.574635 1.558243 1.182994 1.450696 0.491452 0.103672 0.400119 1.344518 0.981223 1.258072 0.251476 1.912489 0.232691 1.206418 0.805953 1.119358 0.155055 1.751168 0.097851 1.025890 0.706010 0.960410 1.942316 1.626433 1.884328 0.851879 0.504554 0.821261 1.761778 1.407905 1.711340 0.647584 0.347790 0.647152 1.648746 1.244924 1.563845 0.588763 0.158974 0.503437 1.536265 1.121954 1.454121 0.423763 0.114434 0.400278 1.338609 0.993706 1.358821 0.328396 1.956735 0.261393 1.267373 0.955613 1.253328 0.224608 1.856628 0.199058 1.200999 0.819656 1.137486 0.135404 1.793163 0.131100 1.078350 0.741351 1.039393 0.045261 1.699515 0.034737 0.942610 0.684756 0.956308 1.947394 1.633657 1.953278 0.904052 0.580961 0.913879 1.941411 1.519052 1.840622 0.910119 0.527420 0.861293 1.849422 1.475381 1.830601 0.799091 0.501857 0.787766 1.823294 1.467731 1.806424 0.805269 0.474582 0.781946 1.776540 1.418537 1.762883 0.746070 0.408613 0.726389 1.745127 1.428283 1.754540 0.728069 0.441878 0.746600 1.796204 1.449997 1.776429 0.722670 0.436401 0.744719 1.778994 1.480572 1.763916 0.815336 0.489032 0.764749 1.811814 1.487438 1.838366 0.811299 0.501320 0.823771 1.854833 1.502868 1.856794 0.827719 0.514633 0.852477 1.882215 1.488580 1.848649 0.877645 0.587786 0.926814 1.877153 1.575992 1.906019 0.886676 0.595984 0.881146 1.940054 1.606287 1.971408 0.988642 0.638192 0.966941 -0.034374 1.681077 0.038373 1.056408 0.657252 1.076689 0.087476 1.760605 0.121715 1.145163 0.789531 1.173448 0.151127 1.823534 0.220276 1.230586 0.960040 1.285670 0.295263 1.934113 0.314088 1.332202 1.053238 1.375323 0.392866 0.077220 0.422213 1.491168 1.127803 1.497376 0.554172 0.257811 0.586449 1.609325 1.351152 1.703027 0.627074 0.353088 0.709213 1.720064 1.442884 1.782680 0.814896 0.553387 0.852715 1.895941 1.554321 1.962098 1.013833 0.655921 0.994618 0.054934 1.764435 0.062870 1.163046 0.871528 1.257156 0.223435 1.905372 0.338569 1.306277 0.999931 1.337253 0.417104 0.138892 0.412245 1.511698 1.256056 1.543124 0.590173 0.339601 0.650455 1.683826 1.408811 1.811474 0.828456 0.526423 0.859787 1.896452 1.608591 1.948197 0.987654 0.706760 1.085696 0.133347 1.825976 0.258446 1.274079 0.944752 1.296320 0.326958 0.024339 0.456524 1.468787 1.203458 1.509480 0.615416 0.269963 0.688191 1.723537 1.390152 1.854907 0.886894 0.581734 0.936911 -0.009509 1.698888 0.060556 1.142012 0.859242 1.247280 0.274968 1.947669 0.305504 1.435482 1.121364 1.480498 0.522708 0.241328 0.603319 1.705040 1.426237 1.816412 0.844853 0.559458 0.950007 -0.864208 1.718587 0.075844 1.114880 0.838172 1.221123 0.266618 0.058618 0.363782 1.417961 1.157081 1.554190 0.607338 0.348635 0.729484 1.765027 1.524808 1.887413 0.942863 0.666378 1.035608 0.084672 1.857745 0.236807 1.282523 1.041036 1.443839 0.463754 0.200441 0.623163 1.679375 1.373487 1.771844 0.850867 0.606126 0.995693 0.033893 1.821449 0.146087 1.202112 0.961147 1.370514 0.434572 0.169771 0.556607 1.637108 1.396269 1.729452 0.842038 0.609721 0.932603 0.015326)
+ 49.845955 #(0.000000 0.433943 1.591413 1.328420 1.791489 0.936749 0.643138 1.049692 0.275950 0.021793 0.425411 1.634140 1.319628 1.822009 0.940566 0.686410 1.165533 0.265780 0.033852 0.534212 1.585346 1.366796 1.848004 0.983818 0.772703 1.211578 0.308132 0.080027 0.590798 1.696510 1.455348 1.893141 1.053975 0.856911 1.266833 0.408998 0.218886 0.667797 1.769849 1.530204 0.019725 1.152880 0.893639 1.397718 0.523733 0.291895 0.796715 1.876169 1.693213 0.121507 1.243697 1.023498 1.507644 0.626087 0.408060 0.873404 0.043118 1.769718 0.262856 1.420354 1.171453 1.613317 0.831154 0.563037 1.040910 0.192328 -0.001932 0.429109 1.585467 1.375267 1.781372 1.002093 0.719912 1.226963 0.367097 0.110275 0.653639 1.802519 1.550869 0.055224 1.168404 0.970047 1.462693 0.586034 0.422003 0.868134 1.976605 1.791789 0.218289 1.421996 1.232261 1.685119 0.825128 0.626512 1.109710 0.222335 0.051025 0.532628 1.652417 1.492192 1.937838 1.090858 0.855285 1.367406 0.506117 0.309542 0.834452 1.952235 1.704632 0.243508 1.354369 1.176803 1.689577 0.786638 0.597284 1.105136 0.224504 0.068648 0.498707 1.692745 1.535662 0.004418 1.120167 0.926036 1.420613 0.582657 0.371012 0.883298 0.023591 1.850236 0.349119 1.493885 1.314402 1.781064 0.901699 0.775096 1.231896 0.352688 0.160642 0.725219 1.837676 1.644772 0.154288 1.295051 1.134298 1.588065 0.776742 0.609763 1.034969 0.201615 0.037266 0.548326 1.689380 1.473271 0.010231 1.166774 0.976998 1.475231 0.635715 0.468379 0.918536 0.119521 1.940496 0.469122 1.615730 1.416451 1.913197 1.104141 0.911530 1.446039 0.570379 0.415203 0.907324 0.066253 1.884890 0.359940 1.520358 1.400884 1.870321 1.087506 0.907013 1.343194 0.570201 0.333761 0.839797 0.053271 1.923579 0.423048 1.571906 1.380418 1.894924 1.053721 0.899660 1.384164 0.531885 0.389474 0.913948 0.054650 1.946334 0.431797 1.526332 1.395376 1.924035 1.103087 0.930884 1.421455 0.615219 0.444917 0.956627 0.096326 0.022641 0.491119 1.636894 1.492642 0.033903 1.187676 1.058891 1.573502 0.741052 0.524795 1.092969 0.284275 0.104762 0.631479 1.816039 1.631225 0.177392 1.332923 1.152467 1.743942 0.870941 0.721667 1.253960 0.407908 0.254123 0.726375 1.964760 1.807940 0.357551 1.543067 1.337885 1.843868 1.061739 0.911016 1.416403 0.609319 0.476368 0.992444 0.181599 0.053062 0.514178 1.739451 1.606894 0.128668 1.312114 1.154407 1.692441 0.886016 0.689659 1.249618 0.486106 0.278339 0.838839 -0.014708 1.877284 0.419739 1.583560 1.438816 1.965447 1.127816 1.047538 1.568060 0.742919 0.594065 1.104127 0.309001 0.184872 0.693892 1.867778 1.749395 0.239796 1.468212 1.320797 1.885663 1.041806 0.932286 1.486878 0.686533 0.534036 1.021821 0.248000 0.134179 0.675503 1.869376 1.707416 0.278975 1.421413 1.324147 1.885314 1.053326 0.926634 1.460661 0.682124 0.569039 1.067043 0.292618 0.178870 0.702748 1.906590 1.761916 0.296651 1.503830 1.407361 1.895900 1.082498 1.017078 1.576302 0.723155 0.625656 1.181042 0.387617 0.226194 0.770397 -0.012033 1.888648 0.443023 1.611994 1.447231 0.077332 1.317109 1.138733 1.694962 0.876175 0.758614 1.305937 0.554243 0.380452 0.958264 0.150053 0.052312 0.591617 1.786010 1.679240 0.243598 1.420964 1.313390 1.863905 1.124682 1.002478 1.513335 0.790255 0.644763 1.184425 0.408081 0.277719 0.847744 0.140868 1.942588 0.511237 1.750552 1.585662 0.128942 1.339768 1.259931 1.816421 1.041111 0.961602 1.489993 0.713970 0.633568 1.155315 0.395777 0.308204 0.837416 0.085121 1.959978 0.464093 1.772955 1.653130 0.148711 1.405125 1.316239 1.913004 1.136339 1.005236 1.561250 0.786348 0.684578 1.248043 0.476790 0.346798 0.896202 0.157805 0.035876 0.613535 1.830832 1.715281 0.342194 1.547028 1.416832 -0.027146 1.247560 1.110646 1.704788 0.927596 0.825272 1.430797 0.655702 0.511799 1.149659 0.369805 0.233963 0.836010 0.037457 1.954065 0.494695 1.779785 1.675590 0.267270 1.489948 1.374886 1.956445 1.177469 1.069995 1.644942 0.885856 0.761694 1.357608 0.609293 0.511180 1.067704 0.369158 0.256824 0.815480 0.078002 1.982435 0.555312 1.803958 1.686277 0.240372 1.498144 1.464126 0.036185 1.270701 1.200568 1.791289 0.997173 0.933746 1.499861 0.782739 0.634310 1.222943 0.504243 0.390877 1.018275 0.252842 0.138228 0.771016 -0.001193 1.962971 0.508814 1.744860 1.654285 0.238486 1.452934 1.422950 0.003954 1.242942 1.190937 1.781747 1.034270 0.954469 1.521207 0.768872 0.725770 1.279738 0.568210 0.470207 1.075848 0.320356 0.216249 0.879461 0.093907 0.035668 0.578144 1.859087 1.779154 0.336822 1.630592 1.562204 0.153304 1.390761 1.339652 1.955535 1.195129 1.107155 1.724850 0.932461 0.942187 1.477571 0.774598 0.700500 1.294624 0.556494 0.469850 1.080390 0.369449 0.238781 0.870797 0.121774 0.035477 0.650118 1.951557 1.851579 0.455191 1.690204 1.681933 0.268637 1.528191 1.471115 0.088559 1.328216 1.265994 1.862013 1.127052 1.070655 1.691693 0.946519 0.916307 1.545452 0.799481 0.753181 1.312713 0.655091 0.527866 1.175646 0.457381 0.394597 0.975693 0.212402 0.165295 0.773126 0.037472 -0.022339 0.638796 1.890960 1.831325 0.461489 1.753342 1.695699 0.322399 1.546550 1.505716 0.102077 1.365659 1.345283 1.942836 1.219861 1.209639 1.781994 1.033361 1.009987 1.679006 0.906416 0.881687 1.488315 0.753960 0.733364 1.306282 0.615668 0.555710 1.146399 0.437872 0.397664 1.055050 0.334334 0.305548 0.917467 0.194708 0.143923 0.756063 0.044803 -0.028943 0.653418 1.907732 1.881595 0.485435 1.790450 1.721252 0.367828 1.611696 1.574004 0.219961 1.489456 1.460118 0.079107 1.379453 1.318730 1.977600 1.251564 1.217355 1.883159 1.140937 1.126255 1.747085 1.005545 0.975839 1.650876 0.938866 0.896621 1.483603 0.840386 0.807872 1.382574 0.671026 0.691594 1.291629 0.591519 0.548567 1.145133 0.531959 0.444979 1.053663 0.380626 0.379906 0.980893 0.286229 0.258164 0.890834 0.178866 0.155936 0.802136 0.120026 0.056962 0.703274 -0.029356 0.000838 0.631113 1.929704 1.907420 0.526791 1.821589 1.824460 0.416683 1.742786 1.769814 0.333855 1.680182 1.646164 0.304090 1.608955 1.584989 0.244353 1.534363 1.493168 0.147814 1.452756 1.370865 0.080380 1.396389 1.343875 -0.007053 1.310718 1.309595 1.927482 1.226577 1.249681 1.869423 1.183060 1.201383 1.821585 1.155591 1.133724 1.743161 1.061627 1.023040 1.757087 1.048112 1.008008 1.663881 1.020954 0.950947 1.611647 0.950677 0.899177 1.565610 0.883348 0.912380 1.557519 0.885068 0.878167 1.499708 0.883098 0.786969 1.463682 0.816998 0.808453 1.419212 0.744878 0.760205 1.420988 0.721474 0.725549 1.404474 0.734035 0.674657 1.410031 0.644705 0.657686 1.359538 0.685487 0.655005 1.258610 0.660499 0.620179 1.303407 0.607517 0.597099 1.271849 0.609939 0.610896 1.253814 0.598268 0.598920 1.272853 0.587979 0.605127 1.241074 0.565630 0.574783 1.248848 0.543704 0.577848 1.249082 0.550181 0.575879 1.245498 0.567937 0.592256 1.303925 0.590572 0.601364 1.284135 0.574235 0.621163 1.269543 0.557140 0.622646 1.242819 0.595759 0.644162 1.290368 0.615293 0.678142 1.282172 0.663954 0.658120 1.324804 0.691399 0.670854 1.346991 0.690601 0.751730 1.375226 0.766524 0.741600 1.417565 0.787073 0.771837 1.422613 0.799950 0.794934 1.492575 0.840888 0.828325 1.512529 0.910769 0.872013 1.539911 0.886707 0.904451 1.636408 0.956158 0.959277 1.677218 0.982061 1.017844 1.679034 0.995318 1.099462 1.785019 1.104379 1.071977 1.794082 1.143598 1.162963 1.814707 1.227208 1.204386 1.926662 1.299691 1.256663 -0.027676 1.330128 1.378369 0.024846 1.454138 1.419532 0.132734 1.489251 1.513822 0.181317 1.554978 1.575708 0.270439 1.592450 1.651923 0.302695 1.683207 1.702332 0.425443 1.764996 1.809779 0.487989 1.818894 1.860776 0.534072 1.948048 -0.117917 0.669125 0.029366 0.067641 0.777359 0.131597 0.195439 0.871666 0.218800 0.252950 0.986733 0.300319 0.392738 1.030174 0.444918 0.430168 1.154900 0.558231 0.539841 1.272010 0.636085 0.679350 1.364453 0.745483 0.792344 1.468902 0.822859 0.853577 1.596538 0.966430 0.971422 1.666372 1.077389 1.133677 1.846043 1.213316 1.205250 1.961891 1.302934 1.314148 0.084551 1.444925 1.474682 0.167418 1.571874 1.636296 0.361002 1.684980 1.728795 0.453062 1.814808 1.871399 0.543816 1.935529 1.982077 0.752029 0.070159 0.161303 0.826745 0.220893 0.302945 0.952063 0.361893 0.414055 1.123705 0.517831 0.536749 1.306544 0.653725 0.714329 1.457649 0.769320 0.872870 1.546032 0.968780 1.003128 1.727954 1.090038 1.222214 1.896447 1.282197 1.349396 0.034982 1.424008 1.441688 0.207836 1.625143 1.676511 0.341464 1.735419 1.841571 0.570764 1.947416 0.018364 0.695705 0.134421 0.147851 0.876009 0.268577 0.343019 1.097550 0.485090 0.520670 1.266650 0.678101 0.683595 1.424919 0.814090 0.929196 1.654440 1.066518 1.099020 1.808689 1.225464 1.260849 0.018099 1.420492 1.470799 0.225824 1.591234 1.648950 0.404022 1.779166 1.845819 0.625286 -0.011169 0.077241 0.792216 0.190241 0.286772 1.008904 0.436840 0.491348 1.219303 0.602451 0.675190 1.461006 0.847923 0.910586 1.631951 1.030369 1.128140 1.851857 1.267797 1.304394 0.058740 1.466025 1.529688 0.290485 1.686719 1.760421 0.467920 1.937753 -0.011020 0.737815 0.167568 0.210906 0.993525 0.365593 0.461007 1.180489 0.638743 0.680474 1.458743 0.846730 0.910685 1.698418 1.069878 1.181163 1.894946 1.333424 1.404153 0.150864 1.642397 1.679657 0.378888 1.813084 1.889625 0.640106 0.075024 0.173516 0.921176 0.270550 0.419972 1.130055 0.587194 0.641915 1.395081 0.837090 0.916836 1.687803 1.138876 1.205697 1.978702 1.393631 1.449613 0.150624 1.638460 1.714821 0.455533 1.878037 0.016796 0.707092 0.196561 0.199289 1.007468 0.417233 0.530584 1.301377 0.705720 0.801319 1.533908 0.954810 1.060213 1.861205 1.307107 1.375045 0.133317 1.533880 1.648075 0.422290 1.840853 1.958901 0.705923 0.116478 0.241457 1.001587 0.481975 0.498168 1.265432 0.734447 0.830060 1.562378 1.038893 1.136469 1.914847 1.325178 1.407312 0.209959 1.636418 1.725632 0.491108 1.935719 0.027189 0.782300 0.223307 0.383645 1.112364 0.565052 0.649041 1.459878 0.840324 0.971924 1.749944 1.212126 1.315123 0.088589 1.500436 1.626324 0.430430 1.824551 1.937039 0.731756 0.151958 0.287467 1.027510 0.528740 0.618823 1.354424 0.793343 0.982821 1.734834 1.163194 1.233193 0.033978 1.518205 1.589935 0.421456 1.835612 1.930263 0.693296 0.193430 0.292131 1.089579 0.524497 0.648057 1.417291 0.851210 1.004292 1.786407 1.219791 1.371189 0.136214 1.558605 1.702332 0.492149 1.944241 0.027162 0.828689 0.311839 0.432307 1.192312 0.646253 0.775670 1.534867 0.952424 1.148860 1.982022 1.386219 1.493904 0.235696 1.732718 1.908743 0.658997 0.104864 0.236481 1.059030 0.511306 0.605168 1.413570 0.866578 0.974298 1.804649 1.256063 1.390682 0.154987 1.625372 1.771765 0.556184 0.017397 0.097954 0.959813 0.385592 0.556110 1.327986 0.782477 0.933088 1.715658 1.225641 1.337378 0.126404 1.548644 1.736252 0.509805 0.048207 0.123175 0.899012 0.371714 0.572509 1.340281 0.819709 0.959604 1.769135 1.225210 1.354686 0.125022 1.578838 1.761863 0.591179 0.057323 0.173612 0.987171 0.433367 0.620214 1.386571 0.888296 1.023051 1.822141 1.274932 1.416642 0.246870 1.751719 1.843601 0.629438 0.152208 0.270767 1.102264 0.561661 0.759828 1.527600 1.028915 1.150707 1.945310 1.436155 1.588253 0.428426 1.861361 0.038032 0.834351 0.317212 0.471899 1.259204 0.771274 0.904850 1.707790 1.194584 1.356562 0.155522 1.643284 1.799242 0.592407 0.102070 0.277924 1.103657 0.552895 0.664708 1.509555 0.974428 1.217123 1.955055 1.476790 1.652740 0.414118 1.948583 0.145612 0.904620 0.434213 0.552852 1.403262 0.833130 1.004738 1.852052 1.331338 1.486748 0.312930 1.813173 0.001831 0.799230 0.290929 0.486184 1.322060 0.753425 0.936240 1.791387 1.270405 1.375053 0.216469 1.723820 1.919063 0.723099 0.282262 0.399543 1.214829 0.700407 0.887842 1.732858 1.230834 1.416811 0.185197 1.734205 1.897142 0.751130 0.213091 0.354978 1.195201 0.682483 0.827568 1.675872 1.205398 1.372960 0.222248 1.702899 1.891407 0.728329 0.261490 0.420686 1.252279 0.721408 0.895437 1.773310 1.241515 1.376861 0.269781 1.792848 1.926916 0.786743 0.285292 0.425899 1.332441 0.806760 0.988991 1.840783 1.333550 1.546589 0.374088 1.891372 0.030138 0.877057 0.425767 0.583997 1.375949 0.938571 1.073215 1.960878 1.424762 1.642947 0.490870 0.009505 0.173021 1.063786 0.552569 0.713979 1.609077 1.104316 1.265076 0.159704 1.626657 1.846264 0.624192 0.159742 0.403104 1.260554 0.731579 0.976922 1.782711 1.321943 1.480378 0.384956 1.860922 0.064216 0.877109 0.420108 0.592588 1.462552 0.998547 1.165001 0.050314 1.555285 1.736668 0.583066 0.116042 0.309668 1.207164 0.686950 0.903769 1.752613 1.287264 1.471408 0.313799 1.834097 0.069613 0.936359 0.413552 0.615365 1.465782 1.036690 1.211960 0.090150 1.578544 1.817884 0.624797 0.182004 0.398918 1.255118 0.802954 0.975569 1.877077 1.346197 1.565424 0.444467 1.911507 0.145446 1.014448 0.595215 0.765473 1.638360 1.164425 1.375808 0.202751 1.784777 -0.012906 0.838941 0.365267 0.585274 1.468987 1.018504 1.206943 0.041664 1.603890 1.804233 0.696883 0.248304 0.384080 1.306169 0.846967 1.023480 1.894991 1.460788 1.638474 0.535097 0.081660 0.285209 1.146934 0.706264 0.915860 1.800259 1.362304 1.532227 0.461449 1.958540 0.186429 1.029249 0.572024 0.826307 1.713557 1.245915 1.468385 0.306813 1.882260 0.139040 0.965888 0.509584 0.741054 1.595954 1.168612 1.396553 0.251514 1.802067 0.058842 0.901546 0.464406 0.671681 1.574543 1.103037 1.362172 0.225639 1.740025 0.010321 0.886176 0.436768 0.698309 1.578463 1.058024 1.333928 0.190892 1.767292 1.985010 0.884721 0.444105 0.692566 1.536775 1.146254 1.324204 0.209100 1.752774 -0.026092 0.928306 0.465835 0.693888 1.575969 1.113511 1.342865 0.238925 1.804263 0.042912 0.903335 0.511019 0.739556 1.624080 1.229305 1.392349 0.316989 1.872312 0.113636 0.982864 0.550319 0.771003 1.670385 1.282606 1.486766 0.422624 1.938255 0.195033 1.079951 0.634350 0.880409 1.802397 1.326166 1.608421 0.505591 0.126410 0.288022 1.233279 0.734983 0.978214 1.917650 1.529128 1.760668 0.628692 0.195637 0.428461 1.351882 0.917782 1.150312 0.058233 1.641199 1.887607 0.777198 0.339699 0.610260 1.480222 1.081458 1.335482 0.238294 1.813298 0.054699 0.977693 0.579695 0.811776 1.702175 1.231128 1.517417 0.426812 -0.011837 0.227902 1.209862 0.736547 1.041230 1.897149 1.493751 1.768281 0.653994 0.199048 0.483676 1.391699 0.991311 1.255625 0.152452 1.737372 1.993017 0.882934 0.444566 0.711791 1.630917 1.260419 1.477423 0.406792 -0.001262 0.270137 1.198892 0.720944 1.022024 1.954229 1.532459 1.775400 0.679332 0.312995 0.548599 1.448615 1.053061 1.383630 0.243904 1.839929 0.077058 1.028594 0.595772 0.872355 1.746025 1.382826 1.654545 0.547977 0.139699 0.415210 1.350167 0.917655 1.195919 0.157376 1.776434 0.029946 0.915915 0.521044 0.748317 1.735470 1.293741 1.581802 0.522793 0.147249 0.378886 1.269595 0.880160 1.160555 0.096115 1.722751 1.963789 0.903873 0.496938 0.747896 1.674394 1.269820 1.577457 0.490093 0.115630 0.358327 1.331620 0.967711 1.210098 0.196478 1.748578 -0.008118 0.975251 0.563282 0.831741 1.792242 1.388090 1.626968 0.640917 0.173380 0.496491 1.383244 1.028079 1.278249 0.200310 1.842727 0.117148 1.067699 0.655137 0.977189 1.891116 1.496512 1.800213 0.716310 0.313444 0.614299 1.596050 1.178017 1.448771 0.411035 -0.007864 0.314025 1.250761 0.872187 1.132979 0.112063 1.703696 0.015227 0.928450 0.579700 0.842983 1.779446 1.377597 1.679190 0.661287 0.276868 0.530019 1.478057 1.097154 1.452199 0.391837 0.004121 0.319689 1.204245 0.889767 1.131034 0.062507 1.731008 0.011613 0.965730 0.558406 0.872384 1.839449 1.453663 1.739285 0.633419 0.292926 0.609121 1.533242 1.166740 1.521408 0.455919 0.111761 0.375636 1.330666 0.980258 1.263314 0.218368 1.793898 0.131302 1.089003 0.699335 1.041259 1.994585 1.628723 1.912993 0.832370 0.539580 0.767514 1.769278 1.382315 1.665782 0.617608 0.263928 0.570577 1.556110 1.185546 1.452308 0.486631 0.106886 0.397980 1.344314 0.987257 1.262163 0.257284 1.913879 0.229482 1.209030 0.808943 1.119187 0.155118 1.751366 0.096906 1.030390 0.707621 0.961539 1.939727 1.624587 1.884052 0.858349 0.510674 0.828402 1.766413 1.410150 1.709911 0.653624 0.349063 0.644480 1.649581 1.245315 1.563235 0.592781 0.167581 0.502225 1.532309 1.115803 1.450753 0.426158 0.112785 0.397158 1.341986 0.998136 1.359927 0.326614 1.953237 0.255125 1.269134 0.954473 1.248911 0.228524 1.851109 0.198774 1.199193 0.822703 1.143597 0.139647 1.798001 0.135111 1.075196 0.738509 1.039459 0.043005 1.695473 0.039278 0.940397 0.687169 0.955892 1.945195 1.637385 1.959830 0.901513 0.591436 0.916690 1.946367 1.511113 1.841924 0.914735 0.519103 0.871169 1.853623 1.476616 1.831779 0.794119 0.501496 0.786489 1.823119 1.465319 1.813871 0.799549 0.473434 0.778703 1.772303 1.423191 1.765814 0.746512 0.402084 0.723228 1.731227 1.437201 1.752746 0.729080 0.435572 0.748619 1.797620 1.448442 1.778977 0.722708 0.433233 0.745465 1.782786 1.482461 1.763974 0.804180 0.487357 0.771934 1.821426 1.488095 1.835669 0.815665 0.503919 0.831723 1.856721 1.502256 1.855043 0.816966 0.516621 0.854045 1.891945 1.495038 1.853580 0.872201 0.582240 0.931525 1.880728 1.580438 1.908097 0.894383 0.601328 0.871902 1.945481 1.611764 1.975538 0.986978 0.650096 0.963999 -0.032490 1.683125 0.032047 1.062372 0.663516 1.074100 0.088995 1.772416 0.118155 1.151844 0.782506 1.170812 0.145856 1.824973 0.220085 1.231138 0.962185 1.299812 0.294149 1.936129 0.313734 1.333419 1.055294 1.371781 0.396021 0.068687 0.426799 1.490404 1.128883 1.501606 0.554044 0.262705 0.579954 1.607218 1.349037 1.702723 0.626972 0.355059 0.708682 1.722687 1.445063 1.778556 0.809974 0.563933 0.858893 1.890157 1.554541 1.962560 1.015889 0.655265 0.995058 0.058445 1.766560 0.066580 1.164447 0.874606 1.250821 0.221521 1.907661 0.337034 1.302485 0.996939 1.334000 0.415109 0.143021 0.409278 1.504570 1.254169 1.540803 0.590908 0.336649 0.650261 1.671983 1.404338 1.811372 0.828487 0.523375 0.858702 1.890794 1.611908 1.952387 0.983966 0.707120 1.081893 0.130105 1.822640 0.253333 1.262864 0.941722 1.295374 0.327657 0.014962 0.454338 1.468747 1.197525 1.508879 0.612828 0.267231 0.688296 1.725905 1.384216 1.853699 0.885810 0.585987 0.933071 -0.006819 1.694029 0.065091 1.146482 0.855494 1.246888 0.278187 1.938799 0.300864 1.433337 1.123095 1.475117 0.517418 0.244495 0.608732 1.705696 1.414510 1.822499 0.844800 0.559571 0.947233 -0.856216 1.713193 0.077674 1.108949 0.840365 1.223335 0.259879 0.055702 0.362327 1.417424 1.153693 1.558143 0.610765 0.353786 0.723554 1.762002 1.526477 1.891633 0.940841 0.664258 1.033806 0.086715 1.848396 0.229523 1.278690 1.043074 1.438168 0.459983 0.187214 0.627643 1.684006 1.378174 1.769356 0.854071 0.600466 1.000326 0.030342 1.827280 0.142082 1.201898 0.961915 1.369073 0.429230 0.168228 0.557414 1.638718 1.393686 1.737160 0.845841 0.615853 0.941048 0.022648)
)
@@ -1514,934 +1513,934 @@
(define nodd-min-peak-phases (vector
-(vector 1 1.0 #(0)
+(vector 1 1.0 #r(0)
)
-(vector 2 1.539 #(0 0)
+(vector 2 1.539 #r(0 0)
)
;;; 3 odd --------------------------------------------------------------------------------
-(vector 3 1.7548747062683 #(0 1 1)
+(vector 3 1.7548747062683 #r(0 1 1)
- 1.7393749801561 #(0.0 1.205686890924528215096600547440175432712E0 1.297035953235478072942399307976302225143E0)
- 1.7387926578522 #(0.0 1.2094986438751 1.3025436401367)
- 1.7387455701828 #(0.0 0.79018270969391 0.69699490070343)
+ 1.7393749801561 #r(0.0 1.205686890924528215096600547440175432712E0 1.297035953235478072942399307976302225143E0)
+ 1.7387926578522 #r(0.0 1.2094986438751 1.3025436401367)
+ 1.7387455701828 #r(0.0 0.79018270969391 0.69699490070343)
- 1.738745 #(0.000000 1.209826 1.303017)
- 1.738744 #(0.000000 0.790172 0.696980)
+ 1.738745 #r(0.000000 1.209826 1.303017)
+ 1.738744 #r(0.000000 0.790172 0.696980)
)
;;; 4 odd --------------------------------------------------------------------------------
-(vector 4 2.19460272789 #(0 1 0 0)
+(vector 4 2.19460272789 #r(0 1 0 0)
- 2.050 #(0 39/25 26/29 27/22)
- 2.048743724823 #(0 111/256 281/256 195/256)
- 2.0466175079346 #(0 223/512 563/512 49/64)
+ 2.050 #r(0 39/25 26/29 27/22)
+ 2.048743724823 #r(0 111/256 281/256 195/256)
+ 2.0466175079346 #r(0 223/512 563/512 49/64)
- 2.045218 #(0.000000 1.563819 0.899661 1.233860)
- 2.045217 #(0.000000 0.436172 1.100327 0.766122)
+ 2.045218 #r(0.000000 1.563819 0.899661 1.233860)
+ 2.045217 #r(0.000000 0.436172 1.100327 0.766122)
)
;;; 5 odd -------------------------------------------------------------------------------- ; 2.2360679
-(vector 5 2.7317879199982 #(0 1 1 0 0)
+(vector 5 2.7317879199982 #r(0 1 1 0 0)
- 2.3731805734023 #(0 7/16 7/4 5/8 7/16)
+ 2.3731805734023 #r(0 7/16 7/4 5/8 7/16)
- 2.307252 #(0.000000 0.393369 1.754476 0.596108 0.424804)
- 2.307253 #(0.000000 1.606636 0.245540 1.403918 1.575230)
+ 2.307252 #r(0.000000 0.393369 1.754476 0.596108 0.424804)
+ 2.307253 #r(0.000000 1.606636 0.245540 1.403918 1.575230)
)
;;; 6 odd -------------------------------------------------------------------------------- ; 2.44948
-(vector 6 2.8638670444489 #(0 0 0 0 1 0)
+(vector 6 2.8638670444489 #r(0 0 0 0 1 0)
- 2.522759 #(0.000000 1.360421 1.129847 1.035439 1.320248 0.102465)
- 2.522749 #(0.000000 0.639403 0.869779 0.964074 0.679243 -0.103102)
+ 2.522759 #r(0.000000 1.360421 1.129847 1.035439 1.320248 0.102465)
+ 2.522749 #r(0.000000 0.639403 0.869779 0.964074 0.679243 -0.103102)
)
;;; 7 odd -------------------------------------------------------------------------------- ; 2.64575
-(vector 7 2.9204399585724 #(0 0 0 1 1 0 1)
+(vector 7 2.9204399585724 #r(0 0 0 1 1 0 1)
- 2.618497 #(0.000000 1.527527 0.524623 0.177241 0.453108 1.577456 1.970355)
- 2.618376 #(0.000000 0.474123 1.477585 1.824644 1.552691 0.429533 0.035303)
- 2.618302 #(0.000000 0.474154 1.477730 1.824846 1.552894 0.429720 0.035636)
+ 2.618497 #r(0.000000 1.527527 0.524623 0.177241 0.453108 1.577456 1.970355)
+ 2.618376 #r(0.000000 0.474123 1.477585 1.824644 1.552691 0.429533 0.035303)
+ 2.618302 #r(0.000000 0.474154 1.477730 1.824846 1.552894 0.429720 0.035636)
)
;;; 8 odd -------------------------------------------------------------------------------- ; 2.828427
-(vector 8 3.2507002353668 #(0 1 1 0 1 1 1 0)
+(vector 8 3.2507002353668 #r(0 1 1 0 1 1 1 0)
- 2.8071956634521 #(0 109/128 7/4 1 13/16 123/64 21/128 43/128)
+ 2.8071956634521 #r(0 109/128 7/4 1 13/16 123/64 21/128 43/128)
- 2.790858 #(0.000000 0.802399 1.672681 0.887888 0.680265 1.767889 0.004580 0.126233)
- 2.790799 #(0.000000 1.197514 0.327251 1.112061 1.319778 0.232086 -0.004810 -0.126263)
- 2.790663 #(0.000000 1.196617 0.325818 1.109894 1.316877 0.229200 -0.008217 -0.130363)
+ 2.790858 #r(0.000000 0.802399 1.672681 0.887888 0.680265 1.767889 0.004580 0.126233)
+ 2.790799 #r(0.000000 1.197514 0.327251 1.112061 1.319778 0.232086 -0.004810 -0.126263)
+ 2.790663 #r(0.000000 1.196617 0.325818 1.109894 1.316877 0.229200 -0.008217 -0.130363)
)
;;; 9 odd -------------------------------------------------------------------------------- ; 3
-(vector 9 3.4140722751617 #(0 0 1 1 1 1 0 1 0)
+(vector 9 3.4140722751617 #r(0 0 1 1 1 1 0 1 0)
- 2.886575 #(0.000000 0.394663 0.625974 1.648922 0.070810 1.803585 1.908749 0.903752 0.378081)
- 2.886464 #(0.000000 1.605518 1.374012 0.351118 1.929257 0.196622 0.091381 1.096286 1.622082)
- 2.886241 #(0.000000 1.605727 1.374318 0.351747 1.930232 0.197770 0.092557 1.097753 1.623786)
+ 2.886575 #r(0.000000 0.394663 0.625974 1.648922 0.070810 1.803585 1.908749 0.903752 0.378081)
+ 2.886464 #r(0.000000 1.605518 1.374012 0.351118 1.929257 0.196622 0.091381 1.096286 1.622082)
+ 2.886241 #r(0.000000 1.605727 1.374318 0.351747 1.930232 0.197770 0.092557 1.097753 1.623786)
)
;;; 10 odd -------------------------------------------------------------------------------- ; 3.162277
-(vector 10 3.5391488075256 #(0 0 1 1 0 1 0 0 0 0)
+(vector 10 3.5391488075256 #r(0 0 1 1 0 1 0 0 0 0)
- 3.054055 #(0.000000 0.508058 0.119325 0.663858 1.627094 1.847660 0.043999 1.283121 0.512586 0.295891)
- 3.054035 #(0.000000 0.528914 0.163543 0.741593 1.737455 -0.019531 0.179460 1.441592 0.691200 0.513749)
- 3.054019 #(0.000000 1.467927 1.828996 1.243932 0.242207 -0.005741 1.795358 0.528965 1.275954 1.445527)
+ 3.054055 #r(0.000000 0.508058 0.119325 0.663858 1.627094 1.847660 0.043999 1.283121 0.512586 0.295891)
+ 3.054035 #r(0.000000 0.528914 0.163543 0.741593 1.737455 -0.019531 0.179460 1.441592 0.691200 0.513749)
+ 3.054019 #r(0.000000 1.467927 1.828996 1.243932 0.242207 -0.005741 1.795358 0.528965 1.275954 1.445527)
- 3.053923 #(0.000000 0.530606 0.167556 0.749983 1.748996 -0.005015 0.193787 1.458258 0.709754 0.536958)
- 3.053807 #(0.000000 0.524885 0.155185 0.727764 -0.282439 -0.043214 0.155190 1.412864 0.658810 0.474600)
- 3.053435 #(0.000000 0.525383 0.155614 0.727601 -0.282536 -0.043650 0.155330 1.412909 0.659050 0.474369)
+ 3.053923 #r(0.000000 0.530606 0.167556 0.749983 1.748996 -0.005015 0.193787 1.458258 0.709754 0.536958)
+ 3.053807 #r(0.000000 0.524885 0.155185 0.727764 -0.282439 -0.043214 0.155190 1.412864 0.658810 0.474600)
+ 3.053435 #r(0.000000 0.525383 0.155614 0.727601 -0.282536 -0.043650 0.155330 1.412909 0.659050 0.474369)
)
;;; 11 odd -------------------------------------------------------------------------------- ; 3.31662
-(vector 11 3.6182308197021 #(0 0 0 1 1 1 0 1 1 0 1) ; 3.31662
+(vector 11 3.6182308197021 #r(0 0 0 1 1 1 0 1 1 0 1) ; 3.31662
- 3.177383 #(0.000000 1.758655 0.386236 -0.008172 1.159122 0.785208 0.739625 0.606297 1.367332 0.311355 0.827147)
- 3.177220 #(0.000000 0.232935 1.599549 -0.005436 0.822576 1.185453 1.230375 1.357659 0.594255 1.644007 1.122113)
- 3.177201 #(0.000000 1.748294 0.370273 -0.021500 1.141958 0.751903 0.709536 0.566072 1.323348 0.262962 0.769859)
+ 3.177383 #r(0.000000 1.758655 0.386236 -0.008172 1.159122 0.785208 0.739625 0.606297 1.367332 0.311355 0.827147)
+ 3.177220 #r(0.000000 0.232935 1.599549 -0.005436 0.822576 1.185453 1.230375 1.357659 0.594255 1.644007 1.122113)
+ 3.177201 #r(0.000000 1.748294 0.370273 -0.021500 1.141958 0.751903 0.709536 0.566072 1.323348 0.262962 0.769859)
- 3.177182 #(0.000000 1.764972 0.396592 0.001274 1.171590 0.806702 0.760785 0.632485 1.395663 0.343598 0.864498)
- 3.177098 #(0.000000 1.745038 0.362715 -0.030740 1.128748 0.736155 0.690326 0.545405 1.303285 0.236832 0.743503)
- 3.176608 #(0.000000 1.744464 0.362417 -0.030039 1.129933 0.735652 0.691339 0.545454 1.302582 0.237082 0.742494)
+ 3.177182 #r(0.000000 1.764972 0.396592 0.001274 1.171590 0.806702 0.760785 0.632485 1.395663 0.343598 0.864498)
+ 3.177098 #r(0.000000 1.745038 0.362715 -0.030740 1.128748 0.736155 0.690326 0.545405 1.303285 0.236832 0.743503)
+ 3.176608 #r(0.000000 1.744464 0.362417 -0.030039 1.129933 0.735652 0.691339 0.545454 1.302582 0.237082 0.742494)
)
;;; 12 odd -------------------------------------------------------------------------------- ; 3.464101
-(vector 12 4.0 #(0 0 1 1 0 0 0 0 0 1 0 1)
+(vector 12 4.0 #r(0 0 1 1 0 0 0 0 0 1 0 1)
- 3.363698 #(0.000000 0.073271 0.585961 0.960666 0.978302 0.113696 1.500041 1.186734 1.772452 0.944338 1.321484 0.602060)
- 3.362737 #(0.000000 -0.077029 1.405769 1.027930 1.006574 1.870564 0.481680 0.791450 0.202834 1.026360 0.648485 1.363973)
- 3.361884 #(0.000000 -0.077168 1.405944 1.028559 1.007566 1.871331 0.482574 0.792122 0.203932 1.027727 0.649507 1.365630)
+ 3.363698 #r(0.000000 0.073271 0.585961 0.960666 0.978302 0.113696 1.500041 1.186734 1.772452 0.944338 1.321484 0.602060)
+ 3.362737 #r(0.000000 -0.077029 1.405769 1.027930 1.006574 1.870564 0.481680 0.791450 0.202834 1.026360 0.648485 1.363973)
+ 3.361884 #r(0.000000 -0.077168 1.405944 1.028559 1.007566 1.871331 0.482574 0.792122 0.203932 1.027727 0.649507 1.365630)
)
;;; 13 odd -------------------------------------------------------------------------------- ; 3.60555
-(vector 13 3.8778836727142 #(0 0 1 1 0 0 1 0 1 0 0 0 0)
+(vector 13 3.8778836727142 #r(0 0 1 1 0 0 1 0 1 0 0 0 0)
- 3.476053 #(0.000000 0.380793 0.961293 0.353157 0.446308 0.965358 0.539394 0.172183 -0.067910 0.976833 -0.486927 1.072643 -0.036066)
- 3.475486 #(0.000000 1.620375 1.040657 1.650169 1.557159 1.039441 1.466014 -0.165746 0.075570 1.032228 0.496820 0.937529 0.047188)
- 3.475452 #(0.000000 1.620672 1.042066 1.652912 1.561748 1.044454 1.472771 -0.159565 0.082334 1.041828 0.507070 0.948164 0.058404)
- 3.474532 #(0.000000 1.621213 1.042646 1.653413 1.561849 1.044891 1.473168 -0.158623 0.083544 1.042513 0.507800 0.949479 0.059341)
+ 3.476053 #r(0.000000 0.380793 0.961293 0.353157 0.446308 0.965358 0.539394 0.172183 -0.067910 0.976833 -0.486927 1.072643 -0.036066)
+ 3.475486 #r(0.000000 1.620375 1.040657 1.650169 1.557159 1.039441 1.466014 -0.165746 0.075570 1.032228 0.496820 0.937529 0.047188)
+ 3.475452 #r(0.000000 1.620672 1.042066 1.652912 1.561748 1.044454 1.472771 -0.159565 0.082334 1.041828 0.507070 0.948164 0.058404)
+ 3.474532 #r(0.000000 1.621213 1.042646 1.653413 1.561849 1.044891 1.473168 -0.158623 0.083544 1.042513 0.507800 0.949479 0.059341)
)
;;; 14 odd -------------------------------------------------------------------------------- ; 3.741657
-(vector 14 4.2842662512094 #(0 1 1 0 0 1 1 1 0 1 0 0 0 0)
+(vector 14 4.2842662512094 #r(0 1 1 0 0 1 1 1 0 1 0 0 0 0)
- 3.606512 #(0.000000 0.785150 1.482463 -0.077041 0.773052 0.357080 1.202237 -0.069790 1.584889 0.769902 0.652503 0.409520 0.740393 0.675317)
- 3.600425 #(0.000000 1.139545 0.351170 -0.114733 0.966482 1.234831 0.292454 1.539190 0.009726 0.589539 0.769919 0.798632 0.417679 0.467195)
- 3.599409 #(0.000000 0.851134 1.636505 0.091221 1.006010 0.744090 1.678264 0.418648 -0.048848 1.351639 1.174737 1.143087 1.519418 1.448182)
- 3.598494 #(0.000000 0.850577 1.637081 0.089423 1.006545 0.749551 1.681409 0.420517 -0.044040 1.351533 1.177890 1.148728 1.524043 1.447267)
+ 3.606512 #r(0.000000 0.785150 1.482463 -0.077041 0.773052 0.357080 1.202237 -0.069790 1.584889 0.769902 0.652503 0.409520 0.740393 0.675317)
+ 3.600425 #r(0.000000 1.139545 0.351170 -0.114733 0.966482 1.234831 0.292454 1.539190 0.009726 0.589539 0.769919 0.798632 0.417679 0.467195)
+ 3.599409 #r(0.000000 0.851134 1.636505 0.091221 1.006010 0.744090 1.678264 0.418648 -0.048848 1.351639 1.174737 1.143087 1.519418 1.448182)
+ 3.598494 #r(0.000000 0.850577 1.637081 0.089423 1.006545 0.749551 1.681409 0.420517 -0.044040 1.351533 1.177890 1.148728 1.524043 1.447267)
)
;;; 15 odd -------------------------------------------------------------------------------- ; 3.872983
-(vector 15 4.4701427567987 #(0 1 0 0 1 0 1 1 1 1 1 0 0 1 1)
+(vector 15 4.4701427567987 #r(0 1 0 0 1 0 1 1 1 1 1 0 0 1 1)
- 3.739752 #(0.000000 1.191367 0.176518 1.591145 1.710423 1.309889 1.422724 0.785426 1.754948 1.707551 1.122738 1.744847 0.127913 0.663567 0.776627)
- 3.738430 #(0.000000 1.190239 0.174514 1.589466 1.706591 1.305812 1.416225 0.779885 1.746839 1.699566 1.113488 1.734421 0.117674 0.652032 0.763074)
+ 3.739752 #r(0.000000 1.191367 0.176518 1.591145 1.710423 1.309889 1.422724 0.785426 1.754948 1.707551 1.122738 1.744847 0.127913 0.663567 0.776627)
+ 3.738430 #r(0.000000 1.190239 0.174514 1.589466 1.706591 1.305812 1.416225 0.779885 1.746839 1.699566 1.113488 1.734421 0.117674 0.652032 0.763074)
)
;;; 16 odd -------------------------------------------------------------------------------- ; 4
-(vector 16 4.5778832343715 #(0 1 1 0 0 0 0 1 0 0 1 1 1 0 1 0)
+(vector 16 4.5778832343715 #r(0 1 1 0 0 0 0 1 0 0 1 1 1 0 1 0)
- 3.858242 #(0.000000 0.144652 0.676444 0.017002 0.269119 1.012194 1.772841 1.585260 1.809100 0.289620 1.399960 0.670537 0.175237 0.296937 -0.017357 1.108803)
- 3.857020 #(0.000000 0.144607 0.675956 0.016527 0.269112 1.012147 1.772535 1.584482 1.808783 0.289484 1.400085 0.669674 0.174650 0.295492 -0.017769 1.108482)
+ 3.858242 #r(0.000000 0.144652 0.676444 0.017002 0.269119 1.012194 1.772841 1.585260 1.809100 0.289620 1.399960 0.670537 0.175237 0.296937 -0.017357 1.108803)
+ 3.857020 #r(0.000000 0.144607 0.675956 0.016527 0.269112 1.012147 1.772535 1.584482 1.808783 0.289484 1.400085 0.669674 0.174650 0.295492 -0.017769 1.108482)
)
;;; 17 odd -------------------------------------------------------------------------------- ; 4.12310
-(vector 17 4.5790815353394 #(0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 0 0)
+(vector 17 4.5790815353394 #r(0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 0 0)
- 3.927805 #(0.000000 0.618908 0.864629 1.180783 1.677629 1.929621 0.580975 1.820904 0.468136 1.289907 0.485211 0.029658 1.160895 0.856998 0.644358 0.814931 0.296558)
- 3.926355 #(0.000000 0.619515 0.864447 1.181990 1.677700 1.930862 0.582927 1.823955 0.470265 1.290931 0.488790 0.031736 1.163146 0.861017 0.648828 0.818286 0.301049)
+ 3.927805 #r(0.000000 0.618908 0.864629 1.180783 1.677629 1.929621 0.580975 1.820904 0.468136 1.289907 0.485211 0.029658 1.160895 0.856998 0.644358 0.814931 0.296558)
+ 3.926355 #r(0.000000 0.619515 0.864447 1.181990 1.677700 1.930862 0.582927 1.823955 0.470265 1.290931 0.488790 0.031736 1.163146 0.861017 0.648828 0.818286 0.301049)
)
;;; 18 odd -------------------------------------------------------------------------------- ; 4.2426406
-(vector 18 4.801501750946 #(0 1 0 1 0 0 0 1 1 0 1 0 0 1 0 0 0 0)
+(vector 18 4.801501750946 #r(0 1 0 1 0 0 0 1 1 0 1 0 0 1 0 0 0 0)
- 4.071185 #(0.000000 0.956640 1.083713 0.493342 0.797185 0.138960 0.613585 0.388904 -0.007616 0.968034 0.616152 1.753096 0.351362 1.174080 1.220111 1.511627 0.186455 1.775153)
- 4.069528 #(0.000000 0.956814 1.082990 0.493213 0.796608 0.137780 0.611831 0.387091 -0.011186 0.965014 0.614046 1.752338 0.348807 1.169857 1.216059 1.508238 0.182073 1.770765)
+ 4.071185 #r(0.000000 0.956640 1.083713 0.493342 0.797185 0.138960 0.613585 0.388904 -0.007616 0.968034 0.616152 1.753096 0.351362 1.174080 1.220111 1.511627 0.186455 1.775153)
+ 4.069528 #r(0.000000 0.956814 1.082990 0.493213 0.796608 0.137780 0.611831 0.387091 -0.011186 0.965014 0.614046 1.752338 0.348807 1.169857 1.216059 1.508238 0.182073 1.770765)
)
;;; 19 odd -------------------------------------------------------------------------------- ; 4.358898
-(vector 19 4.8924918279945 #(0 1 1 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1)
+(vector 19 4.8924918279945 #r(0 1 1 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1)
- 4.173923 #(0.000000 0.329738 1.407540 1.252167 0.448297 0.551162 1.341659 1.859617 1.357020 0.222879 0.553639 1.254187 0.641694 -0.208417 1.489583 1.646436 1.391179 1.758274 1.299312)
- 4.171858 #(0.000000 0.330499 1.406874 1.250304 0.450026 0.551790 1.342413 1.858827 1.359366 0.223792 0.553485 1.256415 0.641759 -0.208630 1.490602 1.646088 1.388713 1.758053 1.297635)
+ 4.173923 #r(0.000000 0.329738 1.407540 1.252167 0.448297 0.551162 1.341659 1.859617 1.357020 0.222879 0.553639 1.254187 0.641694 -0.208417 1.489583 1.646436 1.391179 1.758274 1.299312)
+ 4.171858 #r(0.000000 0.330499 1.406874 1.250304 0.450026 0.551790 1.342413 1.858827 1.359366 0.223792 0.553485 1.256415 0.641759 -0.208630 1.490602 1.646088 1.388713 1.758053 1.297635)
)
;;; 20 odd -------------------------------------------------------------------------------- ; 4.472135
-(vector 20 5.043 #(0 1 0 1 0 0 0 0 0 0 1 0 1 1 0 0 0 1 1 0)
+(vector 20 5.043 #r(0 1 0 1 0 0 0 0 0 0 1 0 1 1 0 0 0 1 1 0)
- 4.357980 #(0.000000 0.074668 -0.007236 0.182274 -0.090904 0.683075 1.087950 1.620610 1.402047 0.349796 1.096502 -0.498958 0.949574 -0.321894 1.411823 0.831379 -0.654670 0.294879 -0.284984 1.407225)
- 4.300525 #(0.000000 1.454922 0.306846 1.245703 0.207273 -0.248151 0.165464 0.618585 -0.103207 0.155791 -0.136302 0.476852 0.390970 -0.309608 1.166284 1.108669 -0.452208 0.338277 0.424300 -0.136694)
- 4.300411 #(0.000000 1.455414 0.307661 1.246638 0.208834 -0.246349 0.167594 0.620918 -0.100474 0.159208 -0.133203 0.480470 0.395357 -0.304743 1.170590 1.114440 -0.446663 0.344322 0.430311 -0.130164)
+ 4.357980 #r(0.000000 0.074668 -0.007236 0.182274 -0.090904 0.683075 1.087950 1.620610 1.402047 0.349796 1.096502 -0.498958 0.949574 -0.321894 1.411823 0.831379 -0.654670 0.294879 -0.284984 1.407225)
+ 4.300525 #r(0.000000 1.454922 0.306846 1.245703 0.207273 -0.248151 0.165464 0.618585 -0.103207 0.155791 -0.136302 0.476852 0.390970 -0.309608 1.166284 1.108669 -0.452208 0.338277 0.424300 -0.136694)
+ 4.300411 #r(0.000000 1.455414 0.307661 1.246638 0.208834 -0.246349 0.167594 0.620918 -0.100474 0.159208 -0.133203 0.480470 0.395357 -0.304743 1.170590 1.114440 -0.446663 0.344322 0.430311 -0.130164)
)
;;; 21 odd -------------------------------------------------------------------------------- ; 4.5825756
-(vector 21 5.1372244578347 #(0 1 1 1 0 0 0 0 1 1 1 0 1 1 1 1 0 1 1 0 1)
+(vector 21 5.1372244578347 #r(0 1 1 1 0 0 0 0 1 1 1 0 1 1 1 1 0 1 1 0 1)
- 4.448460 #(0.000000 1.232455 0.090847 0.908719 0.292484 1.788804 -0.065161 1.337389 1.076226 0.741452 1.053336 1.212537 1.463874 0.812811 1.503269 1.665124 0.651549 0.032446 1.058206 1.235365 -0.036822)
- 4.400133 #(0.000000 1.421969 0.432928 1.323306 0.852962 0.504322 0.760610 0.255553 0.174738 -0.050501 0.443901 0.710959 1.135718 0.433735 1.396810 -0.270794 0.666555 0.133068 1.539972 -0.289562 0.510759)
- 4.398753 #(0.000000 1.496452 0.530521 1.466840 1.037430 0.768041 1.062178 0.568630 0.521390 0.318401 0.839156 1.187950 1.614960 0.975948 -0.029541 0.335933 1.354945 0.841788 0.263047 0.509077 1.300143)
+ 4.448460 #r(0.000000 1.232455 0.090847 0.908719 0.292484 1.788804 -0.065161 1.337389 1.076226 0.741452 1.053336 1.212537 1.463874 0.812811 1.503269 1.665124 0.651549 0.032446 1.058206 1.235365 -0.036822)
+ 4.400133 #r(0.000000 1.421969 0.432928 1.323306 0.852962 0.504322 0.760610 0.255553 0.174738 -0.050501 0.443901 0.710959 1.135718 0.433735 1.396810 -0.270794 0.666555 0.133068 1.539972 -0.289562 0.510759)
+ 4.398753 #r(0.000000 1.496452 0.530521 1.466840 1.037430 0.768041 1.062178 0.568630 0.521390 0.318401 0.839156 1.187950 1.614960 0.975948 -0.029541 0.335933 1.354945 0.841788 0.263047 0.509077 1.300143)
)
;;; 22 odd -------------------------------------------------------------------------------- ; 4.6904157
-(vector 22 5.1805551751198 #(0 1 0 1 0 1 0 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0)
+(vector 22 5.1805551751198 #r(0 1 0 1 0 1 0 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0)
- 4.581017 #(0.000000 0.180996 0.414015 1.937535 0.354831 0.584078 1.521008 1.778595 1.533807 1.338106 -0.034930 1.700610 0.808153 0.348626 1.850606 -0.102689 0.038967 0.664253 1.395687 0.513457 1.627689 0.472162)
- 4.559399 #(0.000000 0.818164 -0.192940 0.348191 -0.389846 0.508891 0.493197 0.093591 -0.504577 -0.897041 -0.065084 0.067843 -0.236861 0.107466 -0.207423 -0.742951 0.106255 0.956224 0.876829 -0.230549 0.370673 0.390286)
- 4.519002 #(0.000000 -0.221397 1.057824 1.492981 -0.263486 0.870091 -0.528249 -0.376750 0.756810 0.176851 -0.090091 1.600251 -0.084632 0.635148 0.821442 1.002126 0.978361 0.034872 -0.759728 0.321190 0.972421 0.245173)
+ 4.581017 #r(0.000000 0.180996 0.414015 1.937535 0.354831 0.584078 1.521008 1.778595 1.533807 1.338106 -0.034930 1.700610 0.808153 0.348626 1.850606 -0.102689 0.038967 0.664253 1.395687 0.513457 1.627689 0.472162)
+ 4.559399 #r(0.000000 0.818164 -0.192940 0.348191 -0.389846 0.508891 0.493197 0.093591 -0.504577 -0.897041 -0.065084 0.067843 -0.236861 0.107466 -0.207423 -0.742951 0.106255 0.956224 0.876829 -0.230549 0.370673 0.390286)
+ 4.519002 #r(0.000000 -0.221397 1.057824 1.492981 -0.263486 0.870091 -0.528249 -0.376750 0.756810 0.176851 -0.090091 1.600251 -0.084632 0.635148 0.821442 1.002126 0.978361 0.034872 -0.759728 0.321190 0.972421 0.245173)
)
;;; 23 odd -------------------------------------------------------------------------------- ; 4.7958315
-(vector 23 5.4125407453101 #(0 0 0 1 1 1 1 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1)
+(vector 23 5.4125407453101 #r(0 0 0 1 1 1 1 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1)
- 4.661614 #(0.000000 0.402662 0.143299 -0.307618 -0.213995 0.796949 1.006633 1.285380 1.569840 0.564104 0.342477 0.293161 1.200899 0.723618 0.539973 0.518746 0.907665 0.184015 1.163786 0.995418 -1.860771 1.039418 -0.124574)
- 4.634825 #(0.000000 0.336809 0.806144 -0.062567 0.702047 1.353357 1.333544 1.711363 1.335973 0.156420 1.259722 0.268353 0.775391 0.709193 0.489222 -0.013866 0.215803 1.155224 0.942400 0.393893 0.015582 0.693933 0.411664)
- 4.634407 #(0.000000 0.337913 0.805462 -0.065533 0.702753 1.354327 1.334664 1.709523 1.331667 0.152462 1.257186 0.263947 0.769802 0.707842 0.485157 -0.009174 0.212207 1.154954 0.942106 0.386101 0.011788 0.687978 0.407297)
+ 4.661614 #r(0.000000 0.402662 0.143299 -0.307618 -0.213995 0.796949 1.006633 1.285380 1.569840 0.564104 0.342477 0.293161 1.200899 0.723618 0.539973 0.518746 0.907665 0.184015 1.163786 0.995418 -1.860771 1.039418 -0.124574)
+ 4.634825 #r(0.000000 0.336809 0.806144 -0.062567 0.702047 1.353357 1.333544 1.711363 1.335973 0.156420 1.259722 0.268353 0.775391 0.709193 0.489222 -0.013866 0.215803 1.155224 0.942400 0.393893 0.015582 0.693933 0.411664)
+ 4.634407 #r(0.000000 0.337913 0.805462 -0.065533 0.702753 1.354327 1.334664 1.709523 1.331667 0.152462 1.257186 0.263947 0.769802 0.707842 0.485157 -0.009174 0.212207 1.154954 0.942106 0.386101 0.011788 0.687978 0.407297)
)
;;; 24 odd -------------------------------------------------------------------------------- ; 4.89897948
-(vector 24 5.6193280144865 #(0 1 0 0 1 0 1 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1)
+(vector 24 5.6193280144865 #r(0 1 0 0 1 0 1 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1)
- 4.786434 #(0.000000 0.498846 1.191572 1.399155 0.479838 1.497230 -0.058887 0.823598 0.010384 0.864577 0.051220 1.057330 0.998513 1.799328 -0.041050 0.199658 0.646825 0.272218 0.034139 0.159133 0.043804 -0.115906 1.177655 0.690674)
- 4.783029 #(0.000000 0.726248 0.856709 1.665477 0.271147 1.375734 -0.206610 0.592121 -0.087409 0.530646 -0.360424 0.901293 1.188841 1.262301 0.080781 0.071714 0.339949 -0.286037 -0.360911 0.038946 0.015798 -0.483821 0.695754 0.114401)
- 4.782962 #(0.000000 0.726238 0.856679 1.665577 0.271280 1.375871 -0.206382 0.592175 -0.087179 0.530852 -0.360257 0.901705 1.189234 1.262764 0.081277 0.072171 0.340463 -0.285522 -0.360411 0.039578 0.016656 -0.483158 0.696443 0.115110)
+ 4.786434 #r(0.000000 0.498846 1.191572 1.399155 0.479838 1.497230 -0.058887 0.823598 0.010384 0.864577 0.051220 1.057330 0.998513 1.799328 -0.041050 0.199658 0.646825 0.272218 0.034139 0.159133 0.043804 -0.115906 1.177655 0.690674)
+ 4.783029 #r(0.000000 0.726248 0.856709 1.665477 0.271147 1.375734 -0.206610 0.592121 -0.087409 0.530646 -0.360424 0.901293 1.188841 1.262301 0.080781 0.071714 0.339949 -0.286037 -0.360911 0.038946 0.015798 -0.483821 0.695754 0.114401)
+ 4.782962 #r(0.000000 0.726238 0.856679 1.665577 0.271280 1.375871 -0.206382 0.592175 -0.087179 0.530852 -0.360257 0.901705 1.189234 1.262764 0.081277 0.072171 0.340463 -0.285522 -0.360411 0.039578 0.016656 -0.483158 0.696443 0.115110)
)
;;; 25 odd -------------------------------------------------------------------------------- ; 5
-(vector 25 5.7220960914079 #(0 1 0 0 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 1 0 0 0 1 1)
+(vector 25 5.7220960914079 #r(0 1 0 0 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 1 0 0 0 1 1)
- 4.886819 #(0.000000 -0.128793 0.647898 0.792536 -0.285146 0.144218 1.160103 1.183437 -0.004858 -0.239530 1.215352 0.277973 0.699697 1.110172 0.616181 1.458993 0.406636 0.121039 0.182656 -0.085662 1.058149 0.147121 0.546131 0.378165 0.309175)
- 4.833870 #(0.000000 0.682487 0.229329 1.065182 1.133347 0.718396 -0.534947 0.962349 0.109795 -0.506458 1.066135 -0.520472 -0.571394 0.037503 0.493262 0.263583 -0.535314 -0.444645 1.130989 -0.865083 -0.231904 -0.824110 -0.626051 0.420930 0.748241)
- 4.833585 #(0.000000 0.684418 0.231543 1.068448 1.131681 0.716084 -0.543413 0.960963 0.108056 -0.510271 1.064008 -0.527153 -0.574236 0.032340 0.486849 0.263393 -0.542768 -0.456188 1.134973 -0.877871 -0.236595 -0.839653 -0.635589 0.413586 0.738028)
+ 4.886819 #r(0.000000 -0.128793 0.647898 0.792536 -0.285146 0.144218 1.160103 1.183437 -0.004858 -0.239530 1.215352 0.277973 0.699697 1.110172 0.616181 1.458993 0.406636 0.121039 0.182656 -0.085662 1.058149 0.147121 0.546131 0.378165 0.309175)
+ 4.833870 #r(0.000000 0.682487 0.229329 1.065182 1.133347 0.718396 -0.534947 0.962349 0.109795 -0.506458 1.066135 -0.520472 -0.571394 0.037503 0.493262 0.263583 -0.535314 -0.444645 1.130989 -0.865083 -0.231904 -0.824110 -0.626051 0.420930 0.748241)
+ 4.833585 #r(0.000000 0.684418 0.231543 1.068448 1.131681 0.716084 -0.543413 0.960963 0.108056 -0.510271 1.064008 -0.527153 -0.574236 0.032340 0.486849 0.263393 -0.542768 -0.456188 1.134973 -0.877871 -0.236595 -0.839653 -0.635589 0.413586 0.738028)
)
;;; 26 odd -------------------------------------------------------------------------------- ; 5.0990
-(vector 26 5.8537594936002 #(0 0 0 0 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1)
+(vector 26 5.8537594936002 #r(0 0 0 0 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1)
- 5.006443 #(0.000000 1.694135 1.368613 1.372881 0.625230 0.749494 1.218456 1.691757 1.088538 0.652397 -0.134215 1.088115 0.314540 0.197061 0.715518 1.230349 1.542812 -0.159343 1.427261 1.767442 0.867761 1.850745 0.671024 -0.112496 0.172562 0.147817)
- 4.996915 #(0.000000 1.742755 1.471776 1.501254 0.794548 0.943595 1.463682 -0.050384 1.394006 0.990276 0.231933 1.492372 0.767814 0.678653 1.249512 1.790068 0.139370 0.475758 0.085016 0.469457 1.614468 0.612558 1.488941 0.735631 1.061318 1.072925)
- 4.996683 #(0.000000 1.740815 1.471360 1.504333 0.793966 0.944959 1.469851 -0.050031 1.395444 0.990928 0.238054 1.493878 0.769155 0.680547 1.256014 1.792102 0.136976 0.478247 0.085153 0.474291 1.616841 0.617611 1.491514 0.741599 1.059794 1.082318)
+ 5.006443 #r(0.000000 1.694135 1.368613 1.372881 0.625230 0.749494 1.218456 1.691757 1.088538 0.652397 -0.134215 1.088115 0.314540 0.197061 0.715518 1.230349 1.542812 -0.159343 1.427261 1.767442 0.867761 1.850745 0.671024 -0.112496 0.172562 0.147817)
+ 4.996915 #r(0.000000 1.742755 1.471776 1.501254 0.794548 0.943595 1.463682 -0.050384 1.394006 0.990276 0.231933 1.492372 0.767814 0.678653 1.249512 1.790068 0.139370 0.475758 0.085016 0.469457 1.614468 0.612558 1.488941 0.735631 1.061318 1.072925)
+ 4.996683 #r(0.000000 1.740815 1.471360 1.504333 0.793966 0.944959 1.469851 -0.050031 1.395444 0.990928 0.238054 1.493878 0.769155 0.680547 1.256014 1.792102 0.136976 0.478247 0.085153 0.474291 1.616841 0.617611 1.491514 0.741599 1.059794 1.082318)
)
;;; 27 odd -------------------------------------------------------------------------------- ; 5.196152
-(vector 27 5.8637111082051 #(0 0 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 1 1 1)
+(vector 27 5.8637111082051 #r(0 0 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 1 1 1)
- 5.088823 #(0.000000 0.108028 1.216984 1.164689 0.975005 -0.022884 0.035464 -0.148996 0.575654 1.005987 1.378471 0.117457 0.956928 1.741009 0.131397 -0.243584 0.873140 0.514628 1.810242 0.918281 0.161062 1.222969 1.595595 1.233298 1.211975 1.332117 1.297417)
- 5.085571 #(0.000000 0.134554 1.259859 1.228144 1.060230 0.079084 0.158344 0.004220 0.734810 1.196702 1.588244 0.348524 1.210515 0.009117 0.409728 0.061105 1.186771 0.849208 0.158894 1.297636 0.556923 1.631224 0.049754 1.687106 1.701477 1.830544 1.814985)
- 5.085376 #(0.000000 0.134436 1.259874 1.228201 1.060157 0.078706 0.158097 0.004323 0.734629 1.196644 1.588020 0.348173 1.210355 0.008907 0.409496 0.060743 1.186070 0.848591 0.158658 1.296780 0.556238 1.631048 0.049386 1.686839 1.701113 1.829904 1.814076)
+ 5.088823 #r(0.000000 0.108028 1.216984 1.164689 0.975005 -0.022884 0.035464 -0.148996 0.575654 1.005987 1.378471 0.117457 0.956928 1.741009 0.131397 -0.243584 0.873140 0.514628 1.810242 0.918281 0.161062 1.222969 1.595595 1.233298 1.211975 1.332117 1.297417)
+ 5.085571 #r(0.000000 0.134554 1.259859 1.228144 1.060230 0.079084 0.158344 0.004220 0.734810 1.196702 1.588244 0.348524 1.210515 0.009117 0.409728 0.061105 1.186771 0.849208 0.158894 1.297636 0.556923 1.631224 0.049754 1.687106 1.701477 1.830544 1.814985)
+ 5.085376 #r(0.000000 0.134436 1.259874 1.228201 1.060157 0.078706 0.158097 0.004323 0.734629 1.196644 1.588020 0.348173 1.210355 0.008907 0.409496 0.060743 1.186070 0.848591 0.158658 1.296780 0.556238 1.631048 0.049386 1.686839 1.701113 1.829904 1.814076)
)
;;; 28 odd -------------------------------------------------------------------------------- ; 5.291502
-(vector 28 6.0276107788086 #(0 0 1 1 1 0 0 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 0 1 0 1)
+(vector 28 6.0276107788086 #r(0 0 1 1 1 0 0 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 0 1 0 1)
- 5.088899 #(0.000000 1.695594 -0.042323 0.221585 0.121059 0.906440 0.747864 0.144725 -0.170880 0.198031 0.623261 -0.016920 1.187997 1.805776 0.526952 0.257290 0.181436 1.671568 1.634262 0.482276 1.385748 1.687591 0.368532 1.304502 0.925524 0.205838 0.775793 0.352193)
+ 5.088899 #r(0.000000 1.695594 -0.042323 0.221585 0.121059 0.906440 0.747864 0.144725 -0.170880 0.198031 0.623261 -0.016920 1.187997 1.805776 0.526952 0.257290 0.181436 1.671568 1.634262 0.482276 1.385748 1.687591 0.368532 1.304502 0.925524 0.205838 0.775793 0.352193)
)
;;; 29 odd -------------------------------------------------------------------------------- ; 5.385164
-(vector 29 6.0348020511367 #(0 1 1 1 1 0 0 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 1 1 1 1 1)
+(vector 29 6.0348020511367 #r(0 1 1 1 1 0 0 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 1 1 1 1 1)
- 5.263365 #(0.000000 0.151064 0.558177 0.735081 1.367806 -0.011277 1.649265 0.435302 1.718318 1.203162 0.977127 1.010028 0.703023 1.591655 0.710208 0.371369 0.285721 1.400549 0.654738 0.961707 0.849244 0.833954 0.047113 1.107680 1.103136 1.834278 0.611441 1.521356 0.107658)
- 5.257572 #(0.000000 0.173145 0.594158 0.795369 1.446698 0.086774 1.773903 0.563415 1.870889 1.380641 1.174997 1.216907 0.933657 1.828478 0.975502 0.657848 0.586415 1.721400 0.987820 1.313934 1.233706 1.234202 0.445482 1.535953 1.550258 0.283390 1.091724 0.021764 0.624654)
- 5.257294 #(0.000000 0.173417 0.594854 0.796262 1.448087 0.088760 1.776024 0.565819 1.873894 1.383720 1.178388 1.220868 0.937816 1.832318 0.979592 0.662513 0.591751 1.726716 0.993575 1.320249 1.240786 1.241192 0.451577 1.543498 1.557502 0.291356 1.099404 0.030228 0.632911)
+ 5.263365 #r(0.000000 0.151064 0.558177 0.735081 1.367806 -0.011277 1.649265 0.435302 1.718318 1.203162 0.977127 1.010028 0.703023 1.591655 0.710208 0.371369 0.285721 1.400549 0.654738 0.961707 0.849244 0.833954 0.047113 1.107680 1.103136 1.834278 0.611441 1.521356 0.107658)
+ 5.257572 #r(0.000000 0.173145 0.594158 0.795369 1.446698 0.086774 1.773903 0.563415 1.870889 1.380641 1.174997 1.216907 0.933657 1.828478 0.975502 0.657848 0.586415 1.721400 0.987820 1.313934 1.233706 1.234202 0.445482 1.535953 1.550258 0.283390 1.091724 0.021764 0.624654)
+ 5.257294 #r(0.000000 0.173417 0.594854 0.796262 1.448087 0.088760 1.776024 0.565819 1.873894 1.383720 1.178388 1.220868 0.937816 1.832318 0.979592 0.662513 0.591751 1.726716 0.993575 1.320249 1.240786 1.241192 0.451577 1.543498 1.557502 0.291356 1.099404 0.030228 0.632911)
)
;;; 30 odd -------------------------------------------------------------------------------- ; 5.4772255
-(vector 30 6.2357559204102 #(0 1 0 1 0 1 1 0 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 1 1 1 1 0 1 1)
+(vector 30 6.2357559204102 #r(0 1 0 1 0 1 1 0 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 1 1 1 1 0 1 1)
- 5.353062 #(0.000000 -0.273797 0.780589 0.428126 1.742006 0.813705 1.826779 0.243133 0.799231 0.444552 0.600071 1.280010 -0.037027 0.801371 0.587721 1.132556 0.784854 1.819749 1.361833 1.646165 1.057885 0.274456 0.188906 0.072120 0.645190 1.511097 1.900389 1.698668 1.288971 1.535352)
- 5.352588 #(0.000000 -0.273931 0.766389 0.417785 1.759969 0.852970 1.831793 0.250419 0.820927 0.459290 0.634623 1.258292 -0.010367 0.819856 0.603568 1.142686 0.772733 1.853850 1.422248 1.684383 1.092051 0.281817 0.215433 0.103401 0.692837 1.549368 1.938793 1.739493 1.350311 1.578167)
+ 5.353062 #r(0.000000 -0.273797 0.780589 0.428126 1.742006 0.813705 1.826779 0.243133 0.799231 0.444552 0.600071 1.280010 -0.037027 0.801371 0.587721 1.132556 0.784854 1.819749 1.361833 1.646165 1.057885 0.274456 0.188906 0.072120 0.645190 1.511097 1.900389 1.698668 1.288971 1.535352)
+ 5.352588 #r(0.000000 -0.273931 0.766389 0.417785 1.759969 0.852970 1.831793 0.250419 0.820927 0.459290 0.634623 1.258292 -0.010367 0.819856 0.603568 1.142686 0.772733 1.853850 1.422248 1.684383 1.092051 0.281817 0.215433 0.103401 0.692837 1.549368 1.938793 1.739493 1.350311 1.578167)
)
;;; 31 odd -------------------------------------------------------------------------------- ; 5.56776
-(vector 31 6.1342258453369 #(0 0 1 0 0 0 0 0 1 0 1 1 1 0 1 1 1 0 1 1 0 1 0 1 1 1 1 0 0 1 1)
+(vector 31 6.1342258453369 #r(0 0 1 0 0 0 0 0 1 0 1 1 1 0 1 1 1 0 1 1 0 1 0 1 1 1 1 0 0 1 1)
- 5.418933 #(0.000000 1.386056 -0.055103 1.470738 1.133338 0.301486 1.278842 0.118113 0.785586 0.164711 0.277129 1.264947 0.805303 0.592921 0.251470 0.348783 0.666372 0.600263 0.392807 1.237206 -0.185182 1.790868 1.684032 0.764715 0.385641 1.091814 0.146242 0.339596 0.884327 1.106807 0.158763)
+ 5.418933 #r(0.000000 1.386056 -0.055103 1.470738 1.133338 0.301486 1.278842 0.118113 0.785586 0.164711 0.277129 1.264947 0.805303 0.592921 0.251470 0.348783 0.666372 0.600263 0.392807 1.237206 -0.185182 1.790868 1.684032 0.764715 0.385641 1.091814 0.146242 0.339596 0.884327 1.106807 0.158763)
)
;;; 32 odd -------------------------------------------------------------------------------- ; 5.65685
-(vector 32 6.3532226957365 #(0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1)
+(vector 32 6.3532226957365 #r(0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1)
- 5.563263 #(0.000000 0.861343 1.208721 0.520795 1.054113 1.500902 0.176395 1.932292 0.475897 1.249746 1.078677 0.960255 1.432432 1.363500 0.301492 1.951062 1.402695 1.767079 1.762968 0.052405 1.191435 0.031852 1.950934 1.508841 1.124488 1.063642 0.897258 1.672866 0.358501 1.273522 0.844792 1.935288)
- 5.554944 #(0.000000 0.821925 1.149412 0.436869 0.935301 1.352676 0.015414 1.734986 0.256637 1.005075 0.807193 0.669815 1.109111 1.009353 -0.080026 1.547110 0.960552 1.325068 1.277626 -0.461257 0.639054 -0.523486 1.366433 0.893040 0.492473 0.397673 0.220314 0.941114 -0.385517 0.492662 0.047909 1.104691)
- 5.554282 #(0.000000 0.816259 1.135795 0.419505 0.912392 1.329202 -0.011674 1.699095 0.214307 0.958468 0.757524 0.614160 1.049094 0.938482 -0.150346 1.472378 0.880973 1.239494 1.186161 -0.560917 0.537372 -0.630416 1.261165 0.779340 0.375126 0.275636 0.093262 0.807297 -0.527117 0.344669 -0.098528 0.951269)
+ 5.563263 #r(0.000000 0.861343 1.208721 0.520795 1.054113 1.500902 0.176395 1.932292 0.475897 1.249746 1.078677 0.960255 1.432432 1.363500 0.301492 1.951062 1.402695 1.767079 1.762968 0.052405 1.191435 0.031852 1.950934 1.508841 1.124488 1.063642 0.897258 1.672866 0.358501 1.273522 0.844792 1.935288)
+ 5.554944 #r(0.000000 0.821925 1.149412 0.436869 0.935301 1.352676 0.015414 1.734986 0.256637 1.005075 0.807193 0.669815 1.109111 1.009353 -0.080026 1.547110 0.960552 1.325068 1.277626 -0.461257 0.639054 -0.523486 1.366433 0.893040 0.492473 0.397673 0.220314 0.941114 -0.385517 0.492662 0.047909 1.104691)
+ 5.554282 #r(0.000000 0.816259 1.135795 0.419505 0.912392 1.329202 -0.011674 1.699095 0.214307 0.958468 0.757524 0.614160 1.049094 0.938482 -0.150346 1.472378 0.880973 1.239494 1.186161 -0.560917 0.537372 -0.630416 1.261165 0.779340 0.375126 0.275636 0.093262 0.807297 -0.527117 0.344669 -0.098528 0.951269)
)
;;; 33 odd -------------------------------------------------------------------------------- ; 5.74456
-(vector 33 6.4944429397583 #(0 1 0 0 1 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 1 1 1 0)
+(vector 33 6.4944429397583 #r(0 1 0 0 1 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 1 1 1 0)
- 5.602961 #(0.000000 1.602314 1.153414 1.251950 1.483737 0.842898 0.331110 1.775787 1.322292 1.204304 1.308143 0.894156 0.779513 0.992393 1.543652 0.196767 0.377438 0.791269 1.809959 1.067569 0.948715 1.605054 1.761811 1.528262 1.622887 0.603858 1.560497 -0.275070 0.725193 1.894504 0.570411 -0.063928 0.717166)
- 5.597136 #(0.000000 1.557449 1.088288 1.150465 1.337871 0.662053 0.113020 1.530031 1.050090 0.909972 0.971771 0.522071 0.385177 0.561017 1.072763 -0.306711 -0.153565 0.216767 1.206455 0.419699 0.268764 0.907465 1.030833 0.764615 0.842050 -0.267857 0.704934 -1.182847 -0.198387 -1.081887 -0.424937 -1.088630 -0.351619)
- 5.596725 #(0.000000 1.566022 1.098312 1.164250 1.358443 0.666170 0.123772 1.539713 1.080327 0.949887 1.000744 0.558327 0.425174 0.601125 1.113026 -0.252224 -0.088541 0.265061 1.258875 0.446564 0.313471 0.950131 1.109618 0.844385 0.897432 -0.212241 0.780013 -1.109704 -0.115786 -1.020678 -0.360032 -1.011400 -0.261343)
+ 5.602961 #r(0.000000 1.602314 1.153414 1.251950 1.483737 0.842898 0.331110 1.775787 1.322292 1.204304 1.308143 0.894156 0.779513 0.992393 1.543652 0.196767 0.377438 0.791269 1.809959 1.067569 0.948715 1.605054 1.761811 1.528262 1.622887 0.603858 1.560497 -0.275070 0.725193 1.894504 0.570411 -0.063928 0.717166)
+ 5.597136 #r(0.000000 1.557449 1.088288 1.150465 1.337871 0.662053 0.113020 1.530031 1.050090 0.909972 0.971771 0.522071 0.385177 0.561017 1.072763 -0.306711 -0.153565 0.216767 1.206455 0.419699 0.268764 0.907465 1.030833 0.764615 0.842050 -0.267857 0.704934 -1.182847 -0.198387 -1.081887 -0.424937 -1.088630 -0.351619)
+ 5.596725 #r(0.000000 1.566022 1.098312 1.164250 1.358443 0.666170 0.123772 1.539713 1.080327 0.949887 1.000744 0.558327 0.425174 0.601125 1.113026 -0.252224 -0.088541 0.265061 1.258875 0.446564 0.313471 0.950131 1.109618 0.844385 0.897432 -0.212241 0.780013 -1.109704 -0.115786 -1.020678 -0.360032 -1.011400 -0.261343)
)
;;; 34 odd -------------------------------------------------------------------------------- ; 5.8309518
-(vector 34 6.5771403312683 #(0 0 1 1 0 1 0 1 0 1 1 1 0 0 1 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0)
+(vector 34 6.5771403312683 #r(0 0 1 1 0 1 0 1 0 1 1 1 0 0 1 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0)
- 5.736524 #(0.000000 1.147547 0.291150 -0.006695 0.331715 0.598656 0.377280 0.313054 0.385030 0.054407 1.121795 0.464840 1.643084 0.588724 1.379213 1.083268 0.685423 0.507435 1.364150 0.564530 0.787739 0.046245 1.602176 0.800707 1.479490 1.714846 0.475118 0.321271 0.414765 1.347014 1.695461 1.159002 1.635795 0.467652)
- 5.735124 #(0.000000 1.151079 0.303275 0.009213 0.352648 0.621401 0.398500 0.340493 0.415657 0.089181 1.158671 0.503098 1.689244 0.630365 1.437198 1.139624 0.747050 0.574490 1.429562 0.636715 0.861565 0.124539 1.677944 0.886280 1.563928 1.805767 0.564016 0.418044 0.516828 1.455556 1.805244 1.274392 1.750370 0.585946)
+ 5.736524 #r(0.000000 1.147547 0.291150 -0.006695 0.331715 0.598656 0.377280 0.313054 0.385030 0.054407 1.121795 0.464840 1.643084 0.588724 1.379213 1.083268 0.685423 0.507435 1.364150 0.564530 0.787739 0.046245 1.602176 0.800707 1.479490 1.714846 0.475118 0.321271 0.414765 1.347014 1.695461 1.159002 1.635795 0.467652)
+ 5.735124 #r(0.000000 1.151079 0.303275 0.009213 0.352648 0.621401 0.398500 0.340493 0.415657 0.089181 1.158671 0.503098 1.689244 0.630365 1.437198 1.139624 0.747050 0.574490 1.429562 0.636715 0.861565 0.124539 1.677944 0.886280 1.563928 1.805767 0.564016 0.418044 0.516828 1.455556 1.805244 1.274392 1.750370 0.585946)
- 5.726128 #(0.000000 0.519262 0.843138 -0.272736 0.110364 0.591254 0.911401 0.339314 0.071814 -0.106840 1.749427 0.267319 -0.401502 1.147737 1.215276 1.316991 0.274119 0.224585 0.821139 0.266527 1.091525 0.636427 0.946267 0.942533 1.378305 -0.065901 1.245114 1.081747 0.487545 1.575194 -0.165766 0.869153 -0.260145 0.981852)
- 5.725987 #(0.000000 0.519367 0.839823 -0.270825 0.109454 0.590467 0.913562 0.338240 0.071129 -0.105723 1.750935 0.267748 -0.404466 1.149320 1.216044 1.315944 0.273465 0.224953 0.819588 0.266322 1.090176 0.636294 0.946461 0.941057 1.379249 -0.063333 1.242866 1.083182 0.490025 1.577337 -0.166600 0.867461 -0.258069 0.984239)
+ 5.726128 #r(0.000000 0.519262 0.843138 -0.272736 0.110364 0.591254 0.911401 0.339314 0.071814 -0.106840 1.749427 0.267319 -0.401502 1.147737 1.215276 1.316991 0.274119 0.224585 0.821139 0.266527 1.091525 0.636427 0.946267 0.942533 1.378305 -0.065901 1.245114 1.081747 0.487545 1.575194 -0.165766 0.869153 -0.260145 0.981852)
+ 5.725987 #r(0.000000 0.519367 0.839823 -0.270825 0.109454 0.590467 0.913562 0.338240 0.071129 -0.105723 1.750935 0.267748 -0.404466 1.149320 1.216044 1.315944 0.273465 0.224953 0.819588 0.266322 1.090176 0.636294 0.946461 0.941057 1.379249 -0.063333 1.242866 1.083182 0.490025 1.577337 -0.166600 0.867461 -0.258069 0.984239)
)
;;; 35 odd -------------------------------------------------------------------------------- ; 5.9160
-(vector 35 6.7392678260803 #(0 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 0 1 0 1 0 0)
+(vector 35 6.7392678260803 #r(0 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 0 1 0 1 0 0)
- 5.833275 #(0.000000 0.446552 1.591598 1.665970 0.393066 0.930519 1.356028 1.466278 0.225797 1.216894 0.009583 0.233020 1.866671 1.148796 1.079614 1.602870 0.201424 1.366765 -0.045388 1.214248 0.402056 0.196949 1.726073 1.538289 -0.146596 -0.105825 1.452686 0.350527 1.133547 0.212285 1.683225 0.967867 0.587559 1.049939 0.968758)
- 5.829080 #(0.000000 0.497100 1.491890 1.596922 0.345822 0.905314 1.289198 1.408451 0.175537 1.253647 0.017296 0.308648 1.866063 1.066612 1.036810 1.601555 0.120109 1.362578 -0.137194 1.172758 0.396767 0.181785 1.659182 1.493825 -0.172588 -0.136985 1.413668 0.161393 1.212058 0.116371 1.561298 0.937104 0.534780 0.940796 0.811381)
- 5.801532 #(0.000000 0.927725 1.438033 1.774007 -0.034765 1.171294 1.852476 0.032758 0.171011 1.057321 0.072523 0.411003 0.226068 0.608849 1.088831 1.232775 0.200272 1.575286 -0.349548 0.605647 0.182255 -0.103231 1.616568 1.743988 -0.717919 -0.725884 1.098676 0.041994 0.836925 -0.062098 1.045714 0.845090 -0.268575 1.174773 0.082224)
- 5.800689 #(0.000000 0.926939 1.434899 1.770213 -0.032113 1.166817 1.853226 0.033896 0.174661 1.059390 0.075778 0.414951 0.221172 0.607934 1.085944 1.232679 0.199374 1.572200 -0.354520 0.604613 0.181334 -0.101308 1.619435 1.744803 -0.721948 -0.722569 1.107370 0.041999 0.835091 -0.057731 1.047643 0.849970 -0.264010 1.176630 0.079939)
+ 5.833275 #r(0.000000 0.446552 1.591598 1.665970 0.393066 0.930519 1.356028 1.466278 0.225797 1.216894 0.009583 0.233020 1.866671 1.148796 1.079614 1.602870 0.201424 1.366765 -0.045388 1.214248 0.402056 0.196949 1.726073 1.538289 -0.146596 -0.105825 1.452686 0.350527 1.133547 0.212285 1.683225 0.967867 0.587559 1.049939 0.968758)
+ 5.829080 #r(0.000000 0.497100 1.491890 1.596922 0.345822 0.905314 1.289198 1.408451 0.175537 1.253647 0.017296 0.308648 1.866063 1.066612 1.036810 1.601555 0.120109 1.362578 -0.137194 1.172758 0.396767 0.181785 1.659182 1.493825 -0.172588 -0.136985 1.413668 0.161393 1.212058 0.116371 1.561298 0.937104 0.534780 0.940796 0.811381)
+ 5.801532 #r(0.000000 0.927725 1.438033 1.774007 -0.034765 1.171294 1.852476 0.032758 0.171011 1.057321 0.072523 0.411003 0.226068 0.608849 1.088831 1.232775 0.200272 1.575286 -0.349548 0.605647 0.182255 -0.103231 1.616568 1.743988 -0.717919 -0.725884 1.098676 0.041994 0.836925 -0.062098 1.045714 0.845090 -0.268575 1.174773 0.082224)
+ 5.800689 #r(0.000000 0.926939 1.434899 1.770213 -0.032113 1.166817 1.853226 0.033896 0.174661 1.059390 0.075778 0.414951 0.221172 0.607934 1.085944 1.232679 0.199374 1.572200 -0.354520 0.604613 0.181334 -0.101308 1.619435 1.744803 -0.721948 -0.722569 1.107370 0.041999 0.835091 -0.057731 1.047643 0.849970 -0.264010 1.176630 0.079939)
)
;;; 36 odd -------------------------------------------------------------------------------- ; 6
-(vector 36 6.8277182579041 #(0 1 1 0 1 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 0 0)
+(vector 36 6.8277182579041 #r(0 1 1 0 1 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 0 0)
- 5.976745 #(0.000000 -0.073257 1.533876 0.975969 0.478187 1.010858 1.535830 1.689302 1.568605 0.651527 -0.024395 0.862716 1.478779 -0.214334 0.406925 1.426003 0.719408 0.448022 1.710025 0.750736 0.773696 1.092187 1.101088 1.282764 0.068797 1.243309 1.489191 1.468200 0.785508 0.637704 1.113799 0.348302 0.603604 -0.148385 1.352941 -0.104705)
+ 5.976745 #r(0.000000 -0.073257 1.533876 0.975969 0.478187 1.010858 1.535830 1.689302 1.568605 0.651527 -0.024395 0.862716 1.478779 -0.214334 0.406925 1.426003 0.719408 0.448022 1.710025 0.750736 0.773696 1.092187 1.101088 1.282764 0.068797 1.243309 1.489191 1.468200 0.785508 0.637704 1.113799 0.348302 0.603604 -0.148385 1.352941 -0.104705)
- 5.956329 #(0.000000 0.042967 1.563281 0.854602 0.627582 1.339171 0.177574 -0.252844 1.689298 0.657857 0.519548 1.113253 1.833323 0.244152 0.704834 1.614850 0.831222 0.909626 0.121497 1.172463 1.129980 1.502200 1.729294 1.614280 0.561677 1.710852 0.238342 -0.114120 1.453896 1.330709 1.559571 1.318964 1.396357 0.806978 -0.250327 0.682275)
- 5.955517 #(0.000000 0.055570 1.549922 0.853737 0.624076 1.334199 0.184749 -0.259730 1.683917 0.658119 0.518031 1.114143 1.834748 0.240135 0.686226 1.594355 0.818362 0.911264 0.125798 1.176687 1.122947 1.481670 1.730422 1.606173 0.555515 1.695824 0.234706 -0.125347 1.452732 1.327862 1.547467 1.305954 1.401386 0.797969 -0.255922 0.677864)
+ 5.956329 #r(0.000000 0.042967 1.563281 0.854602 0.627582 1.339171 0.177574 -0.252844 1.689298 0.657857 0.519548 1.113253 1.833323 0.244152 0.704834 1.614850 0.831222 0.909626 0.121497 1.172463 1.129980 1.502200 1.729294 1.614280 0.561677 1.710852 0.238342 -0.114120 1.453896 1.330709 1.559571 1.318964 1.396357 0.806978 -0.250327 0.682275)
+ 5.955517 #r(0.000000 0.055570 1.549922 0.853737 0.624076 1.334199 0.184749 -0.259730 1.683917 0.658119 0.518031 1.114143 1.834748 0.240135 0.686226 1.594355 0.818362 0.911264 0.125798 1.176687 1.122947 1.481670 1.730422 1.606173 0.555515 1.695824 0.234706 -0.125347 1.452732 1.327862 1.547467 1.305954 1.401386 0.797969 -0.255922 0.677864)
)
;;; 37 odd -------------------------------------------------------------------------------- ; 6.0827
-(vector 37 7.0 #(0 1 0 0 0 1 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 0 0)
+(vector 37 7.0 #r(0 1 0 0 0 1 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 0 0)
- 6.019116 #(0.000000 1.198867 1.849092 0.935330 1.781957 0.496846 0.026335 0.303736 1.089299 1.074310 1.006658 1.377317 0.271438 1.654659 0.071833 0.494433 1.198697 -0.081156 0.936704 0.883271 1.529398 0.425484 0.218240 1.480439 1.569267 1.446099 0.465358 0.265303 1.385278 0.810099 0.212275 0.106695 0.522036 0.380536 0.175723 0.325421 -0.016008)
- 5.959431 #(0.000000 0.917251 1.846780 0.915358 -0.021856 0.521783 -0.142997 0.591405 1.163982 0.976796 0.745905 1.382648 0.071937 1.553077 0.022305 0.451986 0.865411 -0.136619 0.852363 0.871696 1.449655 0.285076 0.325361 1.247695 1.415225 1.246701 0.373242 0.070772 1.174626 0.661467 -0.036150 -0.075470 0.390142 0.182855 0.213495 0.048530 -0.173825)
- 5.958733 #(0.000000 0.917663 1.844637 0.917064 -0.023000 0.522084 -0.140968 0.590202 1.162918 0.977399 0.746122 1.380937 0.072636 1.554351 0.021676 0.452021 0.866436 -0.137694 0.850594 0.868352 1.449562 0.284332 0.323347 1.249529 1.414413 1.248087 0.371239 0.070568 1.173801 0.662841 -0.037509 -0.074833 0.387956 0.180917 0.212366 0.047055 -0.176085)
+ 6.019116 #r(0.000000 1.198867 1.849092 0.935330 1.781957 0.496846 0.026335 0.303736 1.089299 1.074310 1.006658 1.377317 0.271438 1.654659 0.071833 0.494433 1.198697 -0.081156 0.936704 0.883271 1.529398 0.425484 0.218240 1.480439 1.569267 1.446099 0.465358 0.265303 1.385278 0.810099 0.212275 0.106695 0.522036 0.380536 0.175723 0.325421 -0.016008)
+ 5.959431 #r(0.000000 0.917251 1.846780 0.915358 -0.021856 0.521783 -0.142997 0.591405 1.163982 0.976796 0.745905 1.382648 0.071937 1.553077 0.022305 0.451986 0.865411 -0.136619 0.852363 0.871696 1.449655 0.285076 0.325361 1.247695 1.415225 1.246701 0.373242 0.070772 1.174626 0.661467 -0.036150 -0.075470 0.390142 0.182855 0.213495 0.048530 -0.173825)
+ 5.958733 #r(0.000000 0.917663 1.844637 0.917064 -0.023000 0.522084 -0.140968 0.590202 1.162918 0.977399 0.746122 1.380937 0.072636 1.554351 0.021676 0.452021 0.866436 -0.137694 0.850594 0.868352 1.449562 0.284332 0.323347 1.249529 1.414413 1.248087 0.371239 0.070568 1.173801 0.662841 -0.037509 -0.074833 0.387956 0.180917 0.212366 0.047055 -0.176085)
)
;;; 38 odd -------------------------------------------------------------------------------- ; 6.1644
-(vector 38 7.027690410614 #(0 0 1 1 0 0 1 1 0 1 0 1 0 1 0 1 1 1 0 0 0 0 1 1 1 0 1 1 0 1 0 0 1 0 0 0 0 0)
+(vector 38 7.027690410614 #r(0 0 1 1 0 0 1 1 0 1 0 1 0 1 0 1 1 1 0 0 0 0 1 1 1 0 1 1 0 1 0 0 1 0 0 0 0 0)
- 6.144266 #(0.000000 0.459111 0.978423 1.181967 1.503059 1.306778 0.862780 1.146756 1.405445 1.059554 0.793798 1.421482 1.624819 0.940808 1.764974 -0.199270 0.756440 1.330911 0.861332 0.933256 0.734269 -0.017456 1.393657 0.220679 1.806219 0.259427 -0.110057 1.180170 1.136238 0.286941 1.541821 0.220515 1.089015 1.358525 1.068195 1.590398 0.413700 0.247552)
+ 6.144266 #r(0.000000 0.459111 0.978423 1.181967 1.503059 1.306778 0.862780 1.146756 1.405445 1.059554 0.793798 1.421482 1.624819 0.940808 1.764974 -0.199270 0.756440 1.330911 0.861332 0.933256 0.734269 -0.017456 1.393657 0.220679 1.806219 0.259427 -0.110057 1.180170 1.136238 0.286941 1.541821 0.220515 1.089015 1.358525 1.068195 1.590398 0.413700 0.247552)
;; 37+1
- 6.138688 #(0.000000 1.046261 1.784835 0.956057 1.812170 0.474533 0.170721 0.206638 1.084578 1.210612 0.877325 1.304868 0.216526 1.666615 0.017582 0.377950 1.122637 -0.152317 0.759942 0.908307 1.610556 0.619180 0.252252 1.289240 1.682699 1.456452 0.437125 0.204631 1.313659 1.057657 0.251390 0.015459 0.426277 0.374256 0.211841 0.291412 0.083784 0.055093)
- 6.071192 #(0.000000 0.940257 1.605649 0.794643 1.716848 0.415861 -0.070422 0.262049 1.139575 0.918835 0.812529 1.191545 -0.001925 -0.235160 -0.407750 0.430854 1.210825 0.197239 0.282594 0.966031 1.603055 0.618511 0.387609 1.148863 1.547245 1.342558 0.329760 -0.175102 1.122736 0.874532 0.093959 -0.102716 0.220424 -0.141270 -0.115620 -0.175392 -0.276776 -0.104039)
- 6.070762 #(0.000000 0.941112 1.606275 0.795569 1.716377 0.414621 -0.069599 0.261380 1.139598 0.918794 0.811587 1.190473 -0.001751 -0.235083 -0.407937 0.429904 1.210405 0.197484 0.283645 0.965951 1.603201 0.617843 0.387138 1.148979 1.545047 1.341130 0.328130 -0.176365 1.121055 0.874462 0.091608 -0.104011 0.218759 -0.142526 -0.118310 -0.176000 -0.278677 -0.106141)
+ 6.138688 #r(0.000000 1.046261 1.784835 0.956057 1.812170 0.474533 0.170721 0.206638 1.084578 1.210612 0.877325 1.304868 0.216526 1.666615 0.017582 0.377950 1.122637 -0.152317 0.759942 0.908307 1.610556 0.619180 0.252252 1.289240 1.682699 1.456452 0.437125 0.204631 1.313659 1.057657 0.251390 0.015459 0.426277 0.374256 0.211841 0.291412 0.083784 0.055093)
+ 6.071192 #r(0.000000 0.940257 1.605649 0.794643 1.716848 0.415861 -0.070422 0.262049 1.139575 0.918835 0.812529 1.191545 -0.001925 -0.235160 -0.407750 0.430854 1.210825 0.197239 0.282594 0.966031 1.603055 0.618511 0.387609 1.148863 1.547245 1.342558 0.329760 -0.175102 1.122736 0.874532 0.093959 -0.102716 0.220424 -0.141270 -0.115620 -0.175392 -0.276776 -0.104039)
+ 6.070762 #r(0.000000 0.941112 1.606275 0.795569 1.716377 0.414621 -0.069599 0.261380 1.139598 0.918794 0.811587 1.190473 -0.001751 -0.235083 -0.407937 0.429904 1.210405 0.197484 0.283645 0.965951 1.603201 0.617843 0.387138 1.148979 1.545047 1.341130 0.328130 -0.176365 1.121055 0.874462 0.091608 -0.104011 0.218759 -0.142526 -0.118310 -0.176000 -0.278677 -0.106141)
)
;;; 39 odd -------------------------------------------------------------------------------- ; 6.2449
-(vector 39 7.2362656593323 #(0 1 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 0 0 0 0 1 0 1 1 0 1 1 1 0 0 0 1 0 0 0 0 0 0)
+(vector 39 7.2362656593323 #r(0 1 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 0 0 0 0 1 0 1 1 0 1 1 1 0 0 0 1 0 0 0 0 0 0)
- 6.181539 #(0.000000 0.390214 1.432668 1.784856 0.372658 0.651343 0.590730 1.420862 1.232876 1.274776 1.031604 0.648830 1.314325 1.550338 0.798266 0.829350 0.920173 0.286182 1.175424 0.776791 1.481341 -0.170207 1.810272 0.591377 1.604472 0.287027 1.660006 1.308050 0.895442 0.027306 0.915319 0.337380 0.586293 1.687170 1.285611 1.205943 1.760871 1.039296 0.923977)
- 6.168200 #(0.000000 0.381775 1.454935 1.814403 0.398564 0.697479 0.558864 1.481835 1.237160 1.266386 1.075040 0.611438 1.386693 1.563073 0.754834 0.848982 0.969933 0.242588 1.250658 0.716314 1.559259 -0.161914 1.840309 0.618465 1.616822 0.275923 1.613382 1.346746 0.955815 0.024617 0.939581 0.484552 0.627049 1.599410 1.353605 1.268412 1.756052 1.090300 0.972610)
- 6.167830 #(0.000000 0.381682 1.454889 1.813827 0.398778 0.697480 0.558162 1.483181 1.237051 1.265786 1.074761 0.610761 1.386966 1.563268 0.753925 0.849282 0.970201 0.241940 1.250845 0.715139 1.559620 -0.163681 1.839963 0.617302 1.618908 0.275318 1.613093 1.347193 0.955958 0.023995 0.940280 0.483611 0.627383 1.598354 1.353819 1.269307 1.755190 1.092076 0.973923)
+ 6.181539 #r(0.000000 0.390214 1.432668 1.784856 0.372658 0.651343 0.590730 1.420862 1.232876 1.274776 1.031604 0.648830 1.314325 1.550338 0.798266 0.829350 0.920173 0.286182 1.175424 0.776791 1.481341 -0.170207 1.810272 0.591377 1.604472 0.287027 1.660006 1.308050 0.895442 0.027306 0.915319 0.337380 0.586293 1.687170 1.285611 1.205943 1.760871 1.039296 0.923977)
+ 6.168200 #r(0.000000 0.381775 1.454935 1.814403 0.398564 0.697479 0.558864 1.481835 1.237160 1.266386 1.075040 0.611438 1.386693 1.563073 0.754834 0.848982 0.969933 0.242588 1.250658 0.716314 1.559259 -0.161914 1.840309 0.618465 1.616822 0.275923 1.613382 1.346746 0.955815 0.024617 0.939581 0.484552 0.627049 1.599410 1.353605 1.268412 1.756052 1.090300 0.972610)
+ 6.167830 #r(0.000000 0.381682 1.454889 1.813827 0.398778 0.697480 0.558162 1.483181 1.237051 1.265786 1.074761 0.610761 1.386966 1.563268 0.753925 0.849282 0.970201 0.241940 1.250845 0.715139 1.559620 -0.163681 1.839963 0.617302 1.618908 0.275318 1.613093 1.347193 0.955958 0.023995 0.940280 0.483611 0.627383 1.598354 1.353819 1.269307 1.755190 1.092076 0.973923)
)
;;; 40 odd -------------------------------------------------------------------------------- ; 6.3245
-(vector 40 7.5038495063782 #(0 0 0 1 1 1 1 1 1 1 1 1 0 0 0 1 1 0 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 0 1 1 1)
+(vector 40 7.5038495063782 #r(0 0 0 1 1 1 1 1 1 1 1 1 0 0 0 1 1 0 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 0 1 1 1)
- 6.272478 #(0.000000 1.284197 1.055354 1.062168 0.387815 0.825054 0.121504 1.716073 1.070732 1.544312 0.376494 1.037163 0.380448 0.304545 1.428265 0.150454 0.740589 -1.906896 0.496136 -0.130727 1.453974 1.546206 0.424585 1.220704 1.332527 1.409234 0.400583 1.072058 1.397035 -0.550500 0.327899 1.771283 0.928925 0.550551 1.392166 1.184654 1.462753 1.291611 1.910777 1.578007)
- 6.269331 #(0.000000 1.294861 1.141313 1.106097 0.405055 0.791716 0.150416 1.755897 1.078717 1.540848 0.420537 1.081697 0.464806 0.321274 1.347064 0.195720 0.731658 -0.009086 0.519341 -0.124695 1.424567 1.540630 0.338763 1.279036 1.364830 1.454130 0.302572 1.113714 1.404052 -0.565630 0.324138 1.812694 0.904341 0.525469 1.406208 1.209965 1.471676 1.353706 1.903755 1.597218)
- 6.265198 #(0.000000 1.305916 1.193211 1.131633 0.400580 0.759598 0.164070 1.799072 1.091771 1.559662 0.436556 1.108470 0.518624 0.349203 1.311455 0.208409 0.728546 -0.009336 0.551231 -0.062893 1.432448 1.592165 0.332763 1.326264 1.383816 1.474947 0.298106 1.148715 1.434554 -0.546890 0.369301 1.865917 0.945786 0.522218 1.444025 1.269985 1.507602 1.425880 1.940882 1.667877)
+ 6.272478 #r(0.000000 1.284197 1.055354 1.062168 0.387815 0.825054 0.121504 1.716073 1.070732 1.544312 0.376494 1.037163 0.380448 0.304545 1.428265 0.150454 0.740589 -1.906896 0.496136 -0.130727 1.453974 1.546206 0.424585 1.220704 1.332527 1.409234 0.400583 1.072058 1.397035 -0.550500 0.327899 1.771283 0.928925 0.550551 1.392166 1.184654 1.462753 1.291611 1.910777 1.578007)
+ 6.269331 #r(0.000000 1.294861 1.141313 1.106097 0.405055 0.791716 0.150416 1.755897 1.078717 1.540848 0.420537 1.081697 0.464806 0.321274 1.347064 0.195720 0.731658 -0.009086 0.519341 -0.124695 1.424567 1.540630 0.338763 1.279036 1.364830 1.454130 0.302572 1.113714 1.404052 -0.565630 0.324138 1.812694 0.904341 0.525469 1.406208 1.209965 1.471676 1.353706 1.903755 1.597218)
+ 6.265198 #r(0.000000 1.305916 1.193211 1.131633 0.400580 0.759598 0.164070 1.799072 1.091771 1.559662 0.436556 1.108470 0.518624 0.349203 1.311455 0.208409 0.728546 -0.009336 0.551231 -0.062893 1.432448 1.592165 0.332763 1.326264 1.383816 1.474947 0.298106 1.148715 1.434554 -0.546890 0.369301 1.865917 0.945786 0.522218 1.444025 1.269985 1.507602 1.425880 1.940882 1.667877)
)
;;; 41 odd -------------------------------------------------------------------------------- ; 6.4031
-(vector 41 7.7093445316966 #(0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 0 1)
+(vector 41 7.7093445316966 #r(0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 0 1)
- 6.321636 #(0.000000 0.581881 1.284007 1.435590 0.968036 0.414485 0.203921 -0.085398 1.011694 1.215509 0.697775 0.907045 0.006237 0.289299 0.751565 0.182523 1.917428 0.830815 0.908047 0.267572 -0.061197 0.319855 0.591342 1.699511 1.912692 1.683447 0.192711 0.461781 0.828435 1.122559 0.524721 1.057548 0.753199 0.901168 -0.077807 0.957092 -0.092721 1.453709 0.349112 1.539336 1.035529)
+ 6.321636 #r(0.000000 0.581881 1.284007 1.435590 0.968036 0.414485 0.203921 -0.085398 1.011694 1.215509 0.697775 0.907045 0.006237 0.289299 0.751565 0.182523 1.917428 0.830815 0.908047 0.267572 -0.061197 0.319855 0.591342 1.699511 1.912692 1.683447 0.192711 0.461781 0.828435 1.122559 0.524721 1.057548 0.753199 0.901168 -0.077807 0.957092 -0.092721 1.453709 0.349112 1.539336 1.035529)
)
;;; 42 odd -------------------------------------------------------------------------------- ; 6.4807
-(vector 42 7.77445936203 #(0 1 1 0 0 0 0 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 1 0 1 0 1 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1)
+(vector 42 7.77445936203 #r(0 1 1 0 0 0 0 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 1 0 1 0 1 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1)
- 6.403222 #(0.000000 0.615457 1.471291 0.696790 0.198813 1.064683 0.257669 1.499443 1.009189 1.331704 -0.126692 0.668087 -0.151536 1.235993 1.351147 1.834812 1.622001 1.575606 0.387431 1.123625 1.738720 0.186291 -0.093048 -0.362694 1.268339 0.808624 0.147243 0.174237 0.939940 0.098301 1.557405 1.899768 1.063327 1.398074 1.503515 -0.309876 1.592871 1.047295 0.347548 0.500256 0.502585 1.050388)
+ 6.403222 #r(0.000000 0.615457 1.471291 0.696790 0.198813 1.064683 0.257669 1.499443 1.009189 1.331704 -0.126692 0.668087 -0.151536 1.235993 1.351147 1.834812 1.622001 1.575606 0.387431 1.123625 1.738720 0.186291 -0.093048 -0.362694 1.268339 0.808624 0.147243 0.174237 0.939940 0.098301 1.557405 1.899768 1.063327 1.398074 1.503515 -0.309876 1.592871 1.047295 0.347548 0.500256 0.502585 1.050388)
)
;;; 43 odd -------------------------------------------------------------------------------- ; 6.5574
-(vector 43 7.7573688953539 #(0 1 0 0 0 1 0 0 1 0 1 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 1 0 1 1 0 1)
+(vector 43 7.7573688953539 #r(0 1 0 0 0 1 0 0 1 0 1 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 1 0 1 1 0 1)
- 6.474181 #(0.000000 0.163031 0.868018 0.644438 0.499955 0.314476 0.501651 0.136276 0.115801 1.311189 1.257885 1.003167 1.668510 0.653556 0.900535 0.185303 1.792109 1.097281 0.880040 0.351492 0.533331 1.402396 1.722630 -0.341451 0.699659 1.677594 1.684893 1.301554 -0.032447 0.458521 1.242927 0.587312 1.726991 0.987710 0.168427 1.112409 0.233710 0.476465 1.063291 1.023410 1.387257 1.104431 1.814614)
+ 6.474181 #r(0.000000 0.163031 0.868018 0.644438 0.499955 0.314476 0.501651 0.136276 0.115801 1.311189 1.257885 1.003167 1.668510 0.653556 0.900535 0.185303 1.792109 1.097281 0.880040 0.351492 0.533331 1.402396 1.722630 -0.341451 0.699659 1.677594 1.684893 1.301554 -0.032447 0.458521 1.242927 0.587312 1.726991 0.987710 0.168427 1.112409 0.233710 0.476465 1.063291 1.023410 1.387257 1.104431 1.814614)
)
;;; 44 odd -------------------------------------------------------------------------------- ; 6.6332
-(vector 44 7.9338580613871 #(0 1 0 0 0 1 0 1 1 1 1 0 1 1 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 0 1 0 0 1 0 0 0 1 0 0 1 0 0 0)
+(vector 44 7.9338580613871 #r(0 1 0 0 0 1 0 1 1 1 1 0 1 1 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 0 1 0 0 1 0 0 0 1 0 0 1 0 0 0)
- 6.599250 #(0.000000 0.351178 1.306835 1.466283 1.319851 0.565360 0.401323 -0.237018 1.055625 0.418518 0.685726 1.681541 1.845435 1.019294 1.472175 1.617323 0.599443 0.202024 1.548869 0.896807 1.498980 -0.449736 0.958935 0.672395 0.465421 0.363298 0.745996 0.800573 1.320237 0.704768 1.103042 1.233693 0.653096 1.449790 0.411870 1.110453 0.556583 1.736823 0.345497 0.024788 0.937504 1.224464 1.559019 1.346766)
+ 6.599250 #r(0.000000 0.351178 1.306835 1.466283 1.319851 0.565360 0.401323 -0.237018 1.055625 0.418518 0.685726 1.681541 1.845435 1.019294 1.472175 1.617323 0.599443 0.202024 1.548869 0.896807 1.498980 -0.449736 0.958935 0.672395 0.465421 0.363298 0.745996 0.800573 1.320237 0.704768 1.103042 1.233693 0.653096 1.449790 0.411870 1.110453 0.556583 1.736823 0.345497 0.024788 0.937504 1.224464 1.559019 1.346766)
)
;;; 45 odd -------------------------------------------------------------------------------- ; 6.7082
-(vector 45 8.1351366043091 #(0 0 1 0 1 0 1 1 0 0 1 0 1 1 1 0 0 0 1 1 0 1 1 0 0 1 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0)
+(vector 45 8.1351366043091 #r(0 0 1 0 1 0 1 1 0 0 1 0 1 1 1 0 0 0 1 1 0 1 1 0 0 1 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0)
- 6.624897 #(0.000000 1.004365 0.475962 1.144412 0.404466 0.708852 0.590380 0.024072 1.172296 1.113281 1.630362 1.256665 1.314082 0.342438 0.579726 1.460036 0.838934 0.298273 1.354989 1.643563 1.558056 1.967600 0.749164 1.349815 0.523705 0.276619 1.145711 1.733713 1.155806 1.020242 0.468578 1.677226 1.799379 1.623813 1.799356 0.670303 1.547676 1.429802 1.095547 0.114545 0.743241 1.141259 0.963105 1.247487 0.978965)
+ 6.624897 #r(0.000000 1.004365 0.475962 1.144412 0.404466 0.708852 0.590380 0.024072 1.172296 1.113281 1.630362 1.256665 1.314082 0.342438 0.579726 1.460036 0.838934 0.298273 1.354989 1.643563 1.558056 1.967600 0.749164 1.349815 0.523705 0.276619 1.145711 1.733713 1.155806 1.020242 0.468578 1.677226 1.799379 1.623813 1.799356 0.670303 1.547676 1.429802 1.095547 0.114545 0.743241 1.141259 0.963105 1.247487 0.978965)
)
;;; 46 odd -------------------------------------------------------------------------------- ; 6.7823
-(vector 46 8.1455316543579 #(0 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 0 1 0 0 0 0 1)
+(vector 46 8.1455316543579 #r(0 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 0 1 0 0 0 0 1)
- 6.709237 #(0.000000 0.588728 0.764172 0.948247 0.778447 1.268756 0.080491 -0.381973 0.448541 1.688302 0.583900 0.609230 0.913000 1.244782 0.098190 0.458033 0.787717 0.012905 0.854674 1.035325 1.255759 0.507374 1.208176 0.514489 0.741105 1.441899 0.585374 1.583344 0.643511 1.525932 1.201616 0.846916 0.319659 0.030560 0.895113 0.341984 -0.007305 1.588064 0.007988 0.334683 0.349739 -0.215667 -0.068989 1.488454 0.988215 0.867211)
+ 6.709237 #r(0.000000 0.588728 0.764172 0.948247 0.778447 1.268756 0.080491 -0.381973 0.448541 1.688302 0.583900 0.609230 0.913000 1.244782 0.098190 0.458033 0.787717 0.012905 0.854674 1.035325 1.255759 0.507374 1.208176 0.514489 0.741105 1.441899 0.585374 1.583344 0.643511 1.525932 1.201616 0.846916 0.319659 0.030560 0.895113 0.341984 -0.007305 1.588064 0.007988 0.334683 0.349739 -0.215667 -0.068989 1.488454 0.988215 0.867211)
)
;;; 47 odd -------------------------------------------------------------------------------- ; 6.8556
-(vector 47 8.336971282959 #(0 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 0 0 0 1 1 0)
+(vector 47 8.336971282959 #r(0 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 0 0 0 1 1 0)
- 6.785244 #(0.000000 0.898263 0.698671 0.821497 0.370262 0.536725 0.016930 1.555315 1.553643 1.249848 -0.203480 1.765177 0.026588 0.111231 -0.039332 0.662791 0.096267 1.286138 1.353013 0.226230 0.057438 1.648120 -0.088502 0.524016 1.306955 -0.084552 0.350695 1.753518 1.303444 0.678968 0.693452 0.498589 1.005882 1.660165 0.430707 0.068634 0.587061 1.130543 1.939600 0.152146 1.459634 0.723147 1.428638 0.763075 1.800028 1.481715 0.488673)
+ 6.785244 #r(0.000000 0.898263 0.698671 0.821497 0.370262 0.536725 0.016930 1.555315 1.553643 1.249848 -0.203480 1.765177 0.026588 0.111231 -0.039332 0.662791 0.096267 1.286138 1.353013 0.226230 0.057438 1.648120 -0.088502 0.524016 1.306955 -0.084552 0.350695 1.753518 1.303444 0.678968 0.693452 0.498589 1.005882 1.660165 0.430707 0.068634 0.587061 1.130543 1.939600 0.152146 1.459634 0.723147 1.428638 0.763075 1.800028 1.481715 0.488673)
)
;;; 48 odd -------------------------------------------------------------------------------- ; 6.9282
-(vector 48 8.35563071219336 #(0 1 0 0 1 0 1 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 1 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 1 0 1 0 0 0 1)
+(vector 48 8.35563071219336 #r(0 1 0 0 1 0 1 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 1 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 1 0 1 0 0 0 1)
- 6.828028 #(0.000000 0.998004 1.077433 0.148071 1.527370 -0.144913 1.645316 1.723923 0.412024 1.174877 0.494923 1.411660 0.605628 1.628272 1.064698 1.228914 0.098971 0.692407 0.395792 1.297327 -0.001580 1.140646 1.342219 1.577941 0.241000 1.510351 1.184692 1.697190 1.378912 1.591005 -0.082196 0.468455 0.883072 0.625939 0.755107 0.095773 0.293743 0.637279 1.770381 1.345208 0.924216 0.393583 0.137327 1.278382 0.157871 0.442417 0.371701 -0.029442)
+ 6.828028 #r(0.000000 0.998004 1.077433 0.148071 1.527370 -0.144913 1.645316 1.723923 0.412024 1.174877 0.494923 1.411660 0.605628 1.628272 1.064698 1.228914 0.098971 0.692407 0.395792 1.297327 -0.001580 1.140646 1.342219 1.577941 0.241000 1.510351 1.184692 1.697190 1.378912 1.591005 -0.082196 0.468455 0.883072 0.625939 0.755107 0.095773 0.293743 0.637279 1.770381 1.345208 0.924216 0.393583 0.137327 1.278382 0.157871 0.442417 0.371701 -0.029442)
)
;;; 49 odd -------------------------------------------------------------------------------- ; 7
-(vector 49 8.57458718352971 #(0 0 0 1 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0)
+(vector 49 8.57458718352971 #r(0 0 0 1 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0)
- 6.988750 #(0.000000 -0.166791 0.066489 1.162315 1.337152 0.223301 0.045811 -0.093825 1.332601 1.728915 0.870363 0.493056 0.773831 1.546388 0.179602 0.790122 1.699394 1.317163 1.725149 1.408847 1.015662 0.639057 1.163324 0.986617 1.318547 -0.170292 0.080070 1.239083 1.484292 1.779081 0.940479 0.037560 -0.006305 1.151063 0.903661 1.767180 1.162011 1.427957 0.814000 1.843040 0.477534 1.459006 0.756363 0.414970 1.321498 0.061120 0.265825 0.092137 0.202930)
+ 6.988750 #r(0.000000 -0.166791 0.066489 1.162315 1.337152 0.223301 0.045811 -0.093825 1.332601 1.728915 0.870363 0.493056 0.773831 1.546388 0.179602 0.790122 1.699394 1.317163 1.725149 1.408847 1.015662 0.639057 1.163324 0.986617 1.318547 -0.170292 0.080070 1.239083 1.484292 1.779081 0.940479 0.037560 -0.006305 1.151063 0.903661 1.767180 1.162011 1.427957 0.814000 1.843040 0.477534 1.459006 0.756363 0.414970 1.321498 0.061120 0.265825 0.092137 0.202930)
)
;;; 50 odd -------------------------------------------------------------------------------- ; 7.07
-(vector 50 8.711 #(0 0 0 0 1 1 1 1 0 1 0 0 1 0 1 1 0 1 0 1 0 1 0 1 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1)
+(vector 50 8.711 #r(0 0 0 0 1 1 1 1 0 1 0 0 1 0 1 1 0 1 0 1 0 1 0 1 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1)
- 6.947137 #(0.000000 1.361221 1.058873 0.255818 1.371652 1.848584 -0.002271 1.052656 0.139885 0.680884 0.885258 1.006144 1.663943 1.665052 1.470510 1.693036 0.091983 0.825894 1.755289 1.033123 0.055566 1.508725 0.691199 1.233170 0.641006 1.442066 1.557992 1.909688 0.175284 1.577225 1.678517 1.358807 1.558359 1.883371 1.133931 1.053187 0.137949 1.901321 0.058023 0.971798 1.378739 0.843519 0.357409 0.498187 1.235125 0.734586 0.653589 0.242791 1.085625 -0.043484)
+ 6.947137 #r(0.000000 1.361221 1.058873 0.255818 1.371652 1.848584 -0.002271 1.052656 0.139885 0.680884 0.885258 1.006144 1.663943 1.665052 1.470510 1.693036 0.091983 0.825894 1.755289 1.033123 0.055566 1.508725 0.691199 1.233170 0.641006 1.442066 1.557992 1.909688 0.175284 1.577225 1.678517 1.358807 1.558359 1.883371 1.133931 1.053187 0.137949 1.901321 0.058023 0.971798 1.378739 0.843519 0.357409 0.498187 1.235125 0.734586 0.653589 0.242791 1.085625 -0.043484)
)
;;; 51 odd -------------------------------------------------------------------------------- ; 7.141
-(vector 51 8.5829010009766 #(0 1 0 0 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 0 1 0)
+(vector 51 8.5829010009766 #r(0 1 0 0 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 0 1 0)
- 7.087726 #(0.000000 0.875029 0.865937 0.367918 1.900818 0.762934 0.081270 0.353365 0.070375 -0.037477 1.275772 -0.100171 1.088567 1.481918 0.798713 1.260047 0.731048 1.035501 1.384103 0.728234 0.608922 1.769831 1.228331 0.727930 1.038826 -0.062865 0.731133 1.490525 1.564219 0.530975 0.845759 -0.127106 1.209031 0.537607 1.042200 0.906452 -0.105250 0.353212 0.368083 1.395843 1.206034 1.694293 0.348968 0.222228 0.523051 0.375570 0.283017 1.406111 0.934909 0.587260 0.940073)
+ 7.087726 #r(0.000000 0.875029 0.865937 0.367918 1.900818 0.762934 0.081270 0.353365 0.070375 -0.037477 1.275772 -0.100171 1.088567 1.481918 0.798713 1.260047 0.731048 1.035501 1.384103 0.728234 0.608922 1.769831 1.228331 0.727930 1.038826 -0.062865 0.731133 1.490525 1.564219 0.530975 0.845759 -0.127106 1.209031 0.537607 1.042200 0.906452 -0.105250 0.353212 0.368083 1.395843 1.206034 1.694293 0.348968 0.222228 0.523051 0.375570 0.283017 1.406111 0.934909 0.587260 0.940073)
)
;;; 52 odd -------------------------------------------------------------------------------- ; 7.211
-(vector 52 8.8599758148193 #(0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 1 0 1 0 1 1 0 1 0 0 0 1)
+(vector 52 8.8599758148193 #r(0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 1 0 1 0 1 1 0 1 0 0 0 1)
- 7.080087 #(0.000000 0.216994 0.815073 0.651401 0.471967 0.035007 -0.067747 0.660856 0.580235 0.052345 1.785696 0.529423 0.205578 -0.247148 1.238971 0.096672 0.952857 0.166426 0.759284 1.719458 0.161518 1.592928 0.883009 0.245604 1.208605 0.995562 0.029395 0.487673 1.152615 0.362903 0.721410 0.862934 0.090743 0.014994 0.082182 0.993529 1.056537 1.708353 0.746025 -0.333233 1.155949 0.740213 0.619117 1.020646 1.502770 1.347142 1.371490 1.480724 0.363059 1.828476 0.147552 0.424061)
+ 7.080087 #r(0.000000 0.216994 0.815073 0.651401 0.471967 0.035007 -0.067747 0.660856 0.580235 0.052345 1.785696 0.529423 0.205578 -0.247148 1.238971 0.096672 0.952857 0.166426 0.759284 1.719458 0.161518 1.592928 0.883009 0.245604 1.208605 0.995562 0.029395 0.487673 1.152615 0.362903 0.721410 0.862934 0.090743 0.014994 0.082182 0.993529 1.056537 1.708353 0.746025 -0.333233 1.155949 0.740213 0.619117 1.020646 1.502770 1.347142 1.371490 1.480724 0.363059 1.828476 0.147552 0.424061)
)
;;; 53 odd -------------------------------------------------------------------------------- ; 7.280
-(vector 53 9.037 #(0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 1 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0)
+(vector 53 9.037 #r(0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 1 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0)
- 7.252601 #(0.000000 1.316368 0.101159 0.287376 -0.120486 -0.146148 -0.293575 0.279566 1.566833 0.692861 -0.116203 1.111486 1.592177 1.082742 0.010661 0.754630 0.400780 0.795713 1.670109 1.185717 1.226796 -0.120012 0.262637 0.206364 0.738299 0.157263 0.604374 0.683095 1.946305 -0.043066 0.580881 1.320138 -0.043078 1.307240 1.171743 0.356072 0.398418 -0.096678 0.059824 1.235855 0.057573 -0.031810 1.322088 0.600804 1.405030 -0.237620 -0.007423 -0.083489 1.021491 1.628805 -0.222749 0.516076 0.301362)
+ 7.252601 #r(0.000000 1.316368 0.101159 0.287376 -0.120486 -0.146148 -0.293575 0.279566 1.566833 0.692861 -0.116203 1.111486 1.592177 1.082742 0.010661 0.754630 0.400780 0.795713 1.670109 1.185717 1.226796 -0.120012 0.262637 0.206364 0.738299 0.157263 0.604374 0.683095 1.946305 -0.043066 0.580881 1.320138 -0.043078 1.307240 1.171743 0.356072 0.398418 -0.096678 0.059824 1.235855 0.057573 -0.031810 1.322088 0.600804 1.405030 -0.237620 -0.007423 -0.083489 1.021491 1.628805 -0.222749 0.516076 0.301362)
)
;;; 54 odd -------------------------------------------------------------------------------- ; 7.348
-(vector 54 9.025 #(0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 0 1 1 0 0)
+(vector 54 9.025 #r(0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 0 1 1 0 0)
- 7.328138 #(0.000000 0.352535 1.363504 0.096670 1.597330 -0.030072 1.222144 1.243528 0.696875 0.968663 0.162138 1.056566 0.539804 0.008667 0.316670 -0.098837 1.225380 -0.112322 0.244903 0.436331 1.746403 0.122260 0.091220 1.558109 1.217585 1.412994 0.339182 0.690620 1.846588 1.658518 0.529876 1.420789 0.398352 0.612668 1.926173 0.676632 0.529358 1.076039 0.628593 -0.021834 1.281928 0.607717 0.819453 1.795488 1.260788 0.439390 0.834961 1.345636 1.190831 1.783406 -0.135996 0.097131 0.579836 0.358027)
+ 7.328138 #r(0.000000 0.352535 1.363504 0.096670 1.597330 -0.030072 1.222144 1.243528 0.696875 0.968663 0.162138 1.056566 0.539804 0.008667 0.316670 -0.098837 1.225380 -0.112322 0.244903 0.436331 1.746403 0.122260 0.091220 1.558109 1.217585 1.412994 0.339182 0.690620 1.846588 1.658518 0.529876 1.420789 0.398352 0.612668 1.926173 0.676632 0.529358 1.076039 0.628593 -0.021834 1.281928 0.607717 0.819453 1.795488 1.260788 0.439390 0.834961 1.345636 1.190831 1.783406 -0.135996 0.097131 0.579836 0.358027)
)
;;; 55 odd -------------------------------------------------------------------------------- ; 7.416
-(vector 55 9.2039985656738 #(0 0 1 1 1 0 1 0 0 1 1 1 0 1 0 0 1 1 0 1 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1)
+(vector 55 9.2039985656738 #r(0 0 1 1 1 0 1 0 0 1 1 1 0 1 0 0 1 1 0 1 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1)
- 7.364233 #(0.000000 0.395190 -0.153867 1.307052 0.778840 1.201427 1.584425 -0.091689 1.563398 0.221226 1.485388 0.595790 -0.041635 0.380534 0.103234 0.445988 1.706774 1.178799 1.315522 1.096083 0.260274 -0.072891 0.228062 0.239593 1.575799 0.203611 0.427975 1.251992 1.620128 0.666682 0.636489 0.025180 0.388251 0.546392 1.107252 0.996609 1.708598 0.607806 -0.354744 1.114522 1.187212 0.060556 1.020751 1.136440 0.719385 1.579705 0.166783 0.736570 0.421572 0.534881 0.141987 1.649951 0.500500 0.386302 -0.074892)
+ 7.364233 #r(0.000000 0.395190 -0.153867 1.307052 0.778840 1.201427 1.584425 -0.091689 1.563398 0.221226 1.485388 0.595790 -0.041635 0.380534 0.103234 0.445988 1.706774 1.178799 1.315522 1.096083 0.260274 -0.072891 0.228062 0.239593 1.575799 0.203611 0.427975 1.251992 1.620128 0.666682 0.636489 0.025180 0.388251 0.546392 1.107252 0.996609 1.708598 0.607806 -0.354744 1.114522 1.187212 0.060556 1.020751 1.136440 0.719385 1.579705 0.166783 0.736570 0.421572 0.534881 0.141987 1.649951 0.500500 0.386302 -0.074892)
)
;;; 56 odd -------------------------------------------------------------------------------- ; 7.483
-(vector 56 9.3816785812378 #(0 0 1 1 1 0 1 0 1 1 1 1 1 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1 1 1 0)
+(vector 56 9.3816785812378 #r(0 0 1 1 1 0 1 0 1 1 1 1 1 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1 1 1 0)
- 7.419120 #(0.000000 0.417128 1.082491 1.276854 0.765982 1.295111 1.835030 1.786443 0.675192 1.020185 0.394420 0.359608 0.697463 1.166247 0.564899 1.087103 0.889865 0.844186 1.419287 1.562675 0.248998 1.869468 1.111986 1.294693 1.863255 0.052934 0.338636 1.626312 1.601681 -0.021561 1.462490 1.791020 0.409025 1.675990 1.011444 1.359048 1.605820 1.247285 1.024241 0.457113 0.153603 0.242127 1.175155 0.206257 1.412766 1.496703 -0.140135 1.270904 0.393803 1.315634 0.897708 1.585792 0.563930 1.722379 1.612675 1.047507)
+ 7.419120 #r(0.000000 0.417128 1.082491 1.276854 0.765982 1.295111 1.835030 1.786443 0.675192 1.020185 0.394420 0.359608 0.697463 1.166247 0.564899 1.087103 0.889865 0.844186 1.419287 1.562675 0.248998 1.869468 1.111986 1.294693 1.863255 0.052934 0.338636 1.626312 1.601681 -0.021561 1.462490 1.791020 0.409025 1.675990 1.011444 1.359048 1.605820 1.247285 1.024241 0.457113 0.153603 0.242127 1.175155 0.206257 1.412766 1.496703 -0.140135 1.270904 0.393803 1.315634 0.897708 1.585792 0.563930 1.722379 1.612675 1.047507)
)
;;; 57 odd -------------------------------------------------------------------------------- ; 7.549
-(vector 57 9.3903837203979 #(0 1 0 1 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 1 0 1 1 1 1 1 1 0 1 0 0 0 0 1 1 0)
+(vector 57 9.3903837203979 #r(0 1 0 1 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 1 0 1 1 1 1 1 1 0 1 0 0 0 0 1 1 0)
- 7.488896 #(0.000000 -0.127939 1.380652 0.701541 0.779535 0.090662 1.662797 0.879717 1.570316 1.307786 1.211090 0.971455 0.738042 1.474139 1.501173 1.322773 -0.333947 0.651999 1.407414 0.559437 0.970911 0.613447 1.441437 0.387240 1.769723 0.695953 -0.175580 0.102181 0.180022 1.529463 0.468743 0.084931 0.062956 0.298511 0.524008 0.924744 1.286647 1.428978 0.334028 1.302926 0.807711 0.283976 0.097723 1.284073 0.038191 0.329167 1.275797 0.351298 1.518403 1.571791 0.227818 0.842734 0.707030 0.435243 0.618490 0.867851 1.852691)
+ 7.488896 #r(0.000000 -0.127939 1.380652 0.701541 0.779535 0.090662 1.662797 0.879717 1.570316 1.307786 1.211090 0.971455 0.738042 1.474139 1.501173 1.322773 -0.333947 0.651999 1.407414 0.559437 0.970911 0.613447 1.441437 0.387240 1.769723 0.695953 -0.175580 0.102181 0.180022 1.529463 0.468743 0.084931 0.062956 0.298511 0.524008 0.924744 1.286647 1.428978 0.334028 1.302926 0.807711 0.283976 0.097723 1.284073 0.038191 0.329167 1.275797 0.351298 1.518403 1.571791 0.227818 0.842734 0.707030 0.435243 0.618490 0.867851 1.852691)
)
;;; 58 odd -------------------------------------------------------------------------------- ; 7.6157
-(vector 58 9.5893135070801 #(0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 1 0 1 1 1 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 1 0 0)
+(vector 58 9.5893135070801 #r(0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 1 0 1 1 1 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 1 0 0)
- 7.585947 #(0.000000 0.517595 -0.138781 1.328351 0.394157 0.908218 0.526218 1.063012 1.239066 1.277916 1.783309 1.590363 0.539572 1.425376 1.601385 0.376842 0.888852 1.358950 1.916790 1.468314 0.490842 0.036065 1.359391 1.047397 0.699655 1.225098 0.065253 0.350008 0.483077 1.188989 1.002860 0.893562 0.202836 0.208109 1.801392 1.050084 -0.102454 1.813439 1.482474 -0.166271 1.426695 0.563055 -0.225427 0.436837 1.102639 0.467507 0.283291 1.511898 0.400494 1.606371 -0.049354 1.495330 -0.267319 0.336083 0.925094 0.220186 1.902233 -0.035784)
+ 7.585947 #r(0.000000 0.517595 -0.138781 1.328351 0.394157 0.908218 0.526218 1.063012 1.239066 1.277916 1.783309 1.590363 0.539572 1.425376 1.601385 0.376842 0.888852 1.358950 1.916790 1.468314 0.490842 0.036065 1.359391 1.047397 0.699655 1.225098 0.065253 0.350008 0.483077 1.188989 1.002860 0.893562 0.202836 0.208109 1.801392 1.050084 -0.102454 1.813439 1.482474 -0.166271 1.426695 0.563055 -0.225427 0.436837 1.102639 0.467507 0.283291 1.511898 0.400494 1.606371 -0.049354 1.495330 -0.267319 0.336083 0.925094 0.220186 1.902233 -0.035784)
)
;;; 59 odd -------------------------------------------------------------------------------- ; 7.681
-(vector 59 9.5173864364624 #(0 1 1 1 0 0 0 0 0 1 1 0 1 0 0 1 0 0 1 0 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 1 0 1 1 0)
+(vector 59 9.5173864364624 #r(0 1 1 1 0 0 0 0 0 1 1 0 1 0 0 1 0 0 1 0 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 1 0 1 1 0)
- 7.617785 #(0.000000 1.762340 0.513621 1.350480 0.395272 0.369068 0.305583 0.831518 1.232517 0.676844 0.014044 1.888953 1.633364 1.298874 0.424500 1.402106 0.715815 1.275937 1.488547 1.873193 1.738228 0.570388 0.057875 1.975863 0.297300 1.563912 0.772704 0.090655 0.241787 1.145030 0.785784 1.432008 1.006607 1.408581 0.812224 0.224382 0.926131 0.944185 -0.064326 0.205583 1.060366 0.673429 1.237483 1.421583 0.464247 1.651757 1.984268 1.030220 1.489122 1.350599 0.646010 1.371095 0.262034 0.720620 1.557135 1.181053 0.745491 0.926931 1.443337)
+ 7.617785 #r(0.000000 1.762340 0.513621 1.350480 0.395272 0.369068 0.305583 0.831518 1.232517 0.676844 0.014044 1.888953 1.633364 1.298874 0.424500 1.402106 0.715815 1.275937 1.488547 1.873193 1.738228 0.570388 0.057875 1.975863 0.297300 1.563912 0.772704 0.090655 0.241787 1.145030 0.785784 1.432008 1.006607 1.408581 0.812224 0.224382 0.926131 0.944185 -0.064326 0.205583 1.060366 0.673429 1.237483 1.421583 0.464247 1.651757 1.984268 1.030220 1.489122 1.350599 0.646010 1.371095 0.262034 0.720620 1.557135 1.181053 0.745491 0.926931 1.443337)
)
;;; 60 odd -------------------------------------------------------------------------------- ; 7.7459
-(vector 60 9.6560277938843 #(0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 1 1 1 1 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 0 1 0 1 1 1 0 0 1 0 0)
+(vector 60 9.6560277938843 #r(0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 1 1 1 1 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 0 1 0 1 1 1 0 0 1 0 0)
- 7.699628 #(0.000000 -0.021305 0.599580 1.675097 0.724803 0.358532 0.890770 0.765518 0.237166 0.821603 0.185949 0.996346 -0.076908 1.733595 1.718331 -0.080896 1.631867 0.229557 1.219113 -0.444442 1.509828 0.286787 0.741904 1.151478 1.816287 -0.008152 -0.169986 1.514652 0.248473 1.296089 1.211441 0.399013 0.342384 1.801962 0.377537 0.181714 1.809056 1.599925 0.494049 0.298590 0.110648 0.855221 1.804868 0.666943 1.224265 1.636192 1.425598 0.559152 0.087897 0.972335 -0.105600 1.103327 1.345409 0.428767 -0.084957 1.609410 0.060258 0.846549 0.678506 0.580784)
+ 7.699628 #r(0.000000 -0.021305 0.599580 1.675097 0.724803 0.358532 0.890770 0.765518 0.237166 0.821603 0.185949 0.996346 -0.076908 1.733595 1.718331 -0.080896 1.631867 0.229557 1.219113 -0.444442 1.509828 0.286787 0.741904 1.151478 1.816287 -0.008152 -0.169986 1.514652 0.248473 1.296089 1.211441 0.399013 0.342384 1.801962 0.377537 0.181714 1.809056 1.599925 0.494049 0.298590 0.110648 0.855221 1.804868 0.666943 1.224265 1.636192 1.425598 0.559152 0.087897 0.972335 -0.105600 1.103327 1.345409 0.428767 -0.084957 1.609410 0.060258 0.846549 0.678506 0.580784)
)
;;; 61 odd -------------------------------------------------------------------------------- ; 7.8102
-(vector 61 9.6689287776524 #(0 0 0 0 1 0 1 1 0 0 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 0 1 1 0 1 0 0 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 1 1 1)
+(vector 61 9.6689287776524 #r(0 0 0 0 1 0 1 1 0 0 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 0 1 1 0 1 0 0 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 1 1 1)
- 7.775467 #(0.000000 -0.343145 0.781525 1.809127 0.251480 0.512435 0.079273 1.157280 0.819596 0.391398 -0.518556 1.678636 0.560600 0.125318 0.035700 1.744672 1.824327 1.087291 1.692006 0.706036 0.269610 1.403225 1.233897 0.487088 1.476172 -0.284871 0.794501 1.368364 0.656660 0.974817 1.000338 0.175726 1.024682 0.865508 0.404847 0.718158 0.071740 1.457732 -0.480756 0.735357 1.217441 0.811494 1.022056 0.829877 1.509011 1.174960 1.639594 0.781475 -0.011943 1.221853 -0.208689 0.133149 0.650142 1.217107 -0.446658 0.092120 -0.062880 0.676055 0.910707 0.946198 0.780527)
+ 7.775467 #r(0.000000 -0.343145 0.781525 1.809127 0.251480 0.512435 0.079273 1.157280 0.819596 0.391398 -0.518556 1.678636 0.560600 0.125318 0.035700 1.744672 1.824327 1.087291 1.692006 0.706036 0.269610 1.403225 1.233897 0.487088 1.476172 -0.284871 0.794501 1.368364 0.656660 0.974817 1.000338 0.175726 1.024682 0.865508 0.404847 0.718158 0.071740 1.457732 -0.480756 0.735357 1.217441 0.811494 1.022056 0.829877 1.509011 1.174960 1.639594 0.781475 -0.011943 1.221853 -0.208689 0.133149 0.650142 1.217107 -0.446658 0.092120 -0.062880 0.676055 0.910707 0.946198 0.780527)
)
;;; 62 odd -------------------------------------------------------------------------------- ; 7.8740
-(vector 62 9.7982149124146 #(0 0 1 1 0 1 0 0 1 0 0 0 0 1 1 0 1 1 1 0 1 0 0 1 1 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 1 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 1 1 1 0 0 0)
+(vector 62 9.7982149124146 #r(0 0 1 1 0 1 0 0 1 0 0 0 0 1 1 0 1 1 1 0 1 0 0 1 1 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 1 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 1 1 1 0 0 0)
- 7.816985 #(0.000000 0.185485 -0.254761 0.263400 0.632430 0.127767 1.483161 1.282005 1.556675 0.709224 0.293439 0.049467 -0.087443 1.425471 0.595679 0.678957 0.447779 0.382124 0.717681 0.082649 -1.563917 -0.140691 0.229960 0.339346 0.083428 0.640485 0.923623 -0.076532 1.385224 0.166806 1.518517 1.222370 1.575074 0.899045 0.324075 1.508603 -0.064272 0.115115 0.407781 0.298344 1.252368 1.084082 0.264721 0.922346 1.331199 0.689780 0.795795 1.526817 0.163429 0.888100 0.510259 1.478381 0.318687 1.341508 1.785614 0.798865 0.525568 1.053899 1.308203 0.410567 -0.026960 1.103176)
+ 7.816985 #r(0.000000 0.185485 -0.254761 0.263400 0.632430 0.127767 1.483161 1.282005 1.556675 0.709224 0.293439 0.049467 -0.087443 1.425471 0.595679 0.678957 0.447779 0.382124 0.717681 0.082649 -1.563917 -0.140691 0.229960 0.339346 0.083428 0.640485 0.923623 -0.076532 1.385224 0.166806 1.518517 1.222370 1.575074 0.899045 0.324075 1.508603 -0.064272 0.115115 0.407781 0.298344 1.252368 1.084082 0.264721 0.922346 1.331199 0.689780 0.795795 1.526817 0.163429 0.888100 0.510259 1.478381 0.318687 1.341508 1.785614 0.798865 0.525568 1.053899 1.308203 0.410567 -0.026960 1.103176)
)
;;; 63 odd -------------------------------------------------------------------------------- ; 7.9372
-(vector 63 9.8550319671631 #(0 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 0 1 0 0 0 1 0 1 0 0 1 0 0 0 0 1 1 0 0 0 1 0 1 1 0 0 0 1 1 0)
+(vector 63 9.8550319671631 #r(0 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 0 1 0 0 0 1 0 1 0 0 1 0 0 0 0 1 1 0 0 0 1 0 1 1 0 0 0 1 1 0)
- 7.904133 #(0.000000 1.545501 0.155683 0.898914 0.625696 0.564119 0.345790 0.703891 0.981672 1.014462 1.740323 0.008567 -0.039871 0.470077 1.202746 0.366398 0.367999 1.293490 0.310624 1.016687 1.843528 0.474437 1.864085 0.859066 0.880435 1.525047 0.949229 0.065485 0.658928 0.625456 0.890422 0.157110 0.668174 1.537633 -0.133525 1.887056 1.094821 1.580831 1.506736 1.621226 1.791740 1.492769 0.830911 0.166732 1.797834 0.044991 1.834240 1.000450 1.479368 0.610232 0.816463 1.240492 0.107919 -0.111385 1.348751 1.167090 0.907202 0.154866 1.422414 0.720983 0.430601 -0.041659 0.656229)
+ 7.904133 #r(0.000000 1.545501 0.155683 0.898914 0.625696 0.564119 0.345790 0.703891 0.981672 1.014462 1.740323 0.008567 -0.039871 0.470077 1.202746 0.366398 0.367999 1.293490 0.310624 1.016687 1.843528 0.474437 1.864085 0.859066 0.880435 1.525047 0.949229 0.065485 0.658928 0.625456 0.890422 0.157110 0.668174 1.537633 -0.133525 1.887056 1.094821 1.580831 1.506736 1.621226 1.791740 1.492769 0.830911 0.166732 1.797834 0.044991 1.834240 1.000450 1.479368 0.610232 0.816463 1.240492 0.107919 -0.111385 1.348751 1.167090 0.907202 0.154866 1.422414 0.720983 0.430601 -0.041659 0.656229)
)
;;; 64 odd -------------------------------------------------------------------------------- ; 8
-(vector 64 10.0 #(0 1 1 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0)
+(vector 64 10.0 #r(0 1 1 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0)
- 7.957414 #(0.000000 0.941670 0.218463 1.054436 0.821282 0.779097 1.084317 0.220811 0.530574 -0.001214 1.277468 1.056444 1.434429 0.244804 0.635637 0.374642 1.294283 0.051882 1.563945 0.856817 0.659797 0.848723 0.789207 0.004337 0.642492 -0.752744 0.794434 0.546992 1.340010 0.716341 1.722360 1.081100 1.009399 0.345867 1.393328 1.377443 1.264631 0.487017 1.142544 0.031648 0.469271 -0.098334 -0.019627 0.567023 1.791954 0.511740 0.421519 0.992945 1.133377 1.668348 -0.054246 0.158608 -0.042808 1.772093 0.331126 0.762153 1.499580 1.813299 1.079657 1.088576 0.368377 1.519001 0.864479 0.914946)
+ 7.957414 #r(0.000000 0.941670 0.218463 1.054436 0.821282 0.779097 1.084317 0.220811 0.530574 -0.001214 1.277468 1.056444 1.434429 0.244804 0.635637 0.374642 1.294283 0.051882 1.563945 0.856817 0.659797 0.848723 0.789207 0.004337 0.642492 -0.752744 0.794434 0.546992 1.340010 0.716341 1.722360 1.081100 1.009399 0.345867 1.393328 1.377443 1.264631 0.487017 1.142544 0.031648 0.469271 -0.098334 -0.019627 0.567023 1.791954 0.511740 0.421519 0.992945 1.133377 1.668348 -0.054246 0.158608 -0.042808 1.772093 0.331126 0.762153 1.499580 1.813299 1.079657 1.088576 0.368377 1.519001 0.864479 0.914946)
)
;;; 65 odd -------------------------------------------------------------------------------- ; 8.0622
-(vector 65 10.169842720032 #(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)
+(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 #(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.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)
)
;;; 66 odd -------------------------------------------------------------------------------- ; 8.1240
-(vector 66 10.212840820553 #(0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 0 0 0 0 0 0 1 0)
+(vector 66 10.212840820553 #r(0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 0 0 0 0 0 0 1 0)
- 8.137089 #(0.000000 0.867002 -0.091284 0.941017 0.985813 1.124822 -0.061065 0.794288 1.395872 1.715915 0.180754 1.493753 0.091406 -0.059796 0.775109 -0.175925 1.503403 0.926368 0.549523 0.719653 -0.225722 0.805496 0.016786 1.138759 0.185499 1.460462 1.586490 0.459741 1.668207 1.371214 0.709682 0.824263 0.306383 0.060221 1.519433 1.454263 1.678352 0.268698 0.281303 0.104475 0.990641 -0.061422 1.164978 0.345674 0.648924 1.140977 0.632657 0.963358 1.933250 0.002500 1.501010 0.074909 0.787595 1.107851 1.157288 1.691148 1.812947 1.291647 1.327838 1.731755 1.607111 1.129367 0.868934 1.256116 1.509418 0.963219)
+ 8.137089 #r(0.000000 0.867002 -0.091284 0.941017 0.985813 1.124822 -0.061065 0.794288 1.395872 1.715915 0.180754 1.493753 0.091406 -0.059796 0.775109 -0.175925 1.503403 0.926368 0.549523 0.719653 -0.225722 0.805496 0.016786 1.138759 0.185499 1.460462 1.586490 0.459741 1.668207 1.371214 0.709682 0.824263 0.306383 0.060221 1.519433 1.454263 1.678352 0.268698 0.281303 0.104475 0.990641 -0.061422 1.164978 0.345674 0.648924 1.140977 0.632657 0.963358 1.933250 0.002500 1.501010 0.074909 0.787595 1.107851 1.157288 1.691148 1.812947 1.291647 1.327838 1.731755 1.607111 1.129367 0.868934 1.256116 1.509418 0.963219)
- 8.095195 #(0.000000 0.946051 -0.069946 0.931149 1.114323 1.098389 -0.039332 0.877524 1.318916 1.775911 0.245290 1.539842 0.131201 -0.108794 0.748602 -0.153383 1.475925 0.851225 0.482687 0.831474 -0.195116 0.598903 -0.150418 1.241002 0.075671 1.415619 1.425349 0.401276 1.645496 1.378829 0.717955 0.820749 0.280776 0.102463 1.505118 1.466659 1.804612 0.370381 0.198640 0.039917 0.927835 0.130993 1.362388 0.264055 0.657827 1.168088 0.670275 0.998910 -0.080695 -0.000494 1.446059 0.092607 0.764024 1.120077 1.135001 1.626300 -0.038234 1.325677 1.373468 1.689492 1.591066 1.008988 0.840459 1.246657 1.459948 0.945345)
+ 8.095195 #r(0.000000 0.946051 -0.069946 0.931149 1.114323 1.098389 -0.039332 0.877524 1.318916 1.775911 0.245290 1.539842 0.131201 -0.108794 0.748602 -0.153383 1.475925 0.851225 0.482687 0.831474 -0.195116 0.598903 -0.150418 1.241002 0.075671 1.415619 1.425349 0.401276 1.645496 1.378829 0.717955 0.820749 0.280776 0.102463 1.505118 1.466659 1.804612 0.370381 0.198640 0.039917 0.927835 0.130993 1.362388 0.264055 0.657827 1.168088 0.670275 0.998910 -0.080695 -0.000494 1.446059 0.092607 0.764024 1.120077 1.135001 1.626300 -0.038234 1.325677 1.373468 1.689492 1.591066 1.008988 0.840459 1.246657 1.459948 0.945345)
)
;;; 67 odd -------------------------------------------------------------------------------- ; 8.1853
-(vector 67 10.209677696228 #(0 1 0 1 1 1 0 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 1 0 1 1 1 1 0 0 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 1 0 1)
+(vector 67 10.209677696228 #r(0 1 0 1 1 1 0 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 1 0 1 1 1 1 0 0 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 1 0 1)
- 8.127999 #(0.000000 0.156189 0.759312 0.316632 1.612933 0.605013 0.952530 0.423099 -0.112233 1.447269 0.863131 0.200670 1.538179 0.172873 0.737196 0.916694 1.524894 1.423218 1.337268 0.799228 0.023760 0.359774 1.033535 1.252717 0.399347 1.736421 0.199827 0.358145 1.847858 -0.157369 -0.118965 -0.296280 1.764663 0.918422 0.547247 0.781682 -0.101912 1.939111 1.078792 1.928250 0.777073 0.358591 1.566766 0.658960 0.895914 1.285541 1.636763 -0.098157 1.684110 0.891684 1.386081 0.068089 0.497477 0.528377 0.140207 0.953073 0.655659 0.018618 0.774991 0.503967 1.384065 0.100041 0.959741 0.153740 0.654728 0.200720 0.384936)
+ 8.127999 #r(0.000000 0.156189 0.759312 0.316632 1.612933 0.605013 0.952530 0.423099 -0.112233 1.447269 0.863131 0.200670 1.538179 0.172873 0.737196 0.916694 1.524894 1.423218 1.337268 0.799228 0.023760 0.359774 1.033535 1.252717 0.399347 1.736421 0.199827 0.358145 1.847858 -0.157369 -0.118965 -0.296280 1.764663 0.918422 0.547247 0.781682 -0.101912 1.939111 1.078792 1.928250 0.777073 0.358591 1.566766 0.658960 0.895914 1.285541 1.636763 -0.098157 1.684110 0.891684 1.386081 0.068089 0.497477 0.528377 0.140207 0.953073 0.655659 0.018618 0.774991 0.503967 1.384065 0.100041 0.959741 0.153740 0.654728 0.200720 0.384936)
)
;;; 68 odd -------------------------------------------------------------------------------- ; 8.24621
-(vector 68 10.359804316765 #(0 0 1 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 0 1 0 0 1 1 0 1 1 1 0 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 0 0 0 1 0 0 0 1 0)
+(vector 68 10.359804316765 #r(0 0 1 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 0 1 0 0 1 1 0 1 1 1 0 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 0 0 0 1 0 0 0 1 0)
- 8.204414 #(0.000000 0.279095 1.647677 0.913913 0.663406 0.323080 0.240930 0.148599 0.780719 0.015227 1.335435 0.919514 1.070941 0.877126 0.293550 1.686752 0.481693 0.755701 0.785320 0.815615 1.595420 1.293383 0.426688 0.494705 1.026142 0.549725 1.259770 -0.007824 0.278489 0.224750 0.082547 0.719555 0.355973 0.908801 0.541094 0.432336 1.241602 1.708744 0.772870 1.505613 -0.137480 0.654507 1.657469 0.849573 0.009380 1.611286 1.676352 1.046709 1.432096 0.979028 1.747525 0.522938 0.318568 1.148496 -0.245690 0.703484 0.171945 1.485079 1.659272 -0.006233 0.283657 1.852744 1.398727 0.371514 0.974831 1.325922 0.719933 0.483798)
+ 8.204414 #r(0.000000 0.279095 1.647677 0.913913 0.663406 0.323080 0.240930 0.148599 0.780719 0.015227 1.335435 0.919514 1.070941 0.877126 0.293550 1.686752 0.481693 0.755701 0.785320 0.815615 1.595420 1.293383 0.426688 0.494705 1.026142 0.549725 1.259770 -0.007824 0.278489 0.224750 0.082547 0.719555 0.355973 0.908801 0.541094 0.432336 1.241602 1.708744 0.772870 1.505613 -0.137480 0.654507 1.657469 0.849573 0.009380 1.611286 1.676352 1.046709 1.432096 0.979028 1.747525 0.522938 0.318568 1.148496 -0.245690 0.703484 0.171945 1.485079 1.659272 -0.006233 0.283657 1.852744 1.398727 0.371514 0.974831 1.325922 0.719933 0.483798)
)
;;; 69 odd -------------------------------------------------------------------------------- ; 8.3066
-(vector 69 10.452348709106 #(0 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1)
+(vector 69 10.452348709106 #r(0 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1)
- 8.274908 #(0.000000 1.788801 1.283513 -0.242756 0.145250 0.146755 0.584479 1.353542 0.821070 0.189803 1.413669 0.749926 1.058442 1.185407 1.095039 1.015258 0.161858 0.034929 0.498704 0.198138 1.711445 0.157768 0.616185 1.421248 1.168404 0.254474 1.519482 -0.175837 0.581687 0.194579 0.931780 -0.336100 0.287461 1.495068 0.039168 1.507647 0.993152 1.382317 1.231363 0.721890 1.622206 1.080570 0.186638 0.155662 0.909604 1.203958 1.050254 1.890059 0.428940 0.701250 -0.160137 0.279994 1.502298 0.567568 0.585424 0.686015 -0.246566 0.662061 0.986133 1.103373 0.572438 0.607162 -0.159332 0.926622 1.112278 0.937694 0.624990 1.345312 0.670451)
+ 8.274908 #r(0.000000 1.788801 1.283513 -0.242756 0.145250 0.146755 0.584479 1.353542 0.821070 0.189803 1.413669 0.749926 1.058442 1.185407 1.095039 1.015258 0.161858 0.034929 0.498704 0.198138 1.711445 0.157768 0.616185 1.421248 1.168404 0.254474 1.519482 -0.175837 0.581687 0.194579 0.931780 -0.336100 0.287461 1.495068 0.039168 1.507647 0.993152 1.382317 1.231363 0.721890 1.622206 1.080570 0.186638 0.155662 0.909604 1.203958 1.050254 1.890059 0.428940 0.701250 -0.160137 0.279994 1.502298 0.567568 0.585424 0.686015 -0.246566 0.662061 0.986133 1.103373 0.572438 0.607162 -0.159332 0.926622 1.112278 0.937694 0.624990 1.345312 0.670451)
)
;;; 70 odd -------------------------------------------------------------------------------- ; 8.3666
-(vector 70 10.431521047498 #(0 1 0 0 0 0 1 1 1 1 0 0 1 0 1 0 0 1 1 0 1 0 1 1 0 1 0 0 0 1 1 1 1 0 1 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 1 1 1 1 1 1 1)
+(vector 70 10.431521047498 #r(0 1 0 0 0 0 1 1 1 1 0 0 1 0 1 0 0 1 1 0 1 0 1 1 0 1 0 0 0 1 1 1 1 0 1 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 1 1 1 1 1 1 1)
- 8.328488 #(0.000000 1.209391 0.655351 -0.224668 0.270551 0.912782 1.006468 0.115362 1.639506 1.394128 1.775544 -0.158964 -0.191285 0.916307 -0.148807 -0.343643 0.171981 0.447415 0.684977 -0.187759 0.122627 0.642332 0.846737 0.920787 0.824105 -0.455822 1.004331 0.650453 0.327784 -0.378239 0.335174 0.883411 0.475111 1.924029 1.429019 1.351303 -0.183533 1.395982 0.599233 0.896200 1.135652 0.575692 1.213789 1.853140 0.377792 1.790714 0.835251 1.493542 0.305236 1.538414 0.647163 0.263422 1.348466 1.037276 0.893701 1.108073 -0.492190 -0.249170 1.081128 0.973414 0.593299 0.786885 0.003725 0.855855 1.605169 1.050037 0.831705 1.193285 0.128148 0.709803)
+ 8.328488 #r(0.000000 1.209391 0.655351 -0.224668 0.270551 0.912782 1.006468 0.115362 1.639506 1.394128 1.775544 -0.158964 -0.191285 0.916307 -0.148807 -0.343643 0.171981 0.447415 0.684977 -0.187759 0.122627 0.642332 0.846737 0.920787 0.824105 -0.455822 1.004331 0.650453 0.327784 -0.378239 0.335174 0.883411 0.475111 1.924029 1.429019 1.351303 -0.183533 1.395982 0.599233 0.896200 1.135652 0.575692 1.213789 1.853140 0.377792 1.790714 0.835251 1.493542 0.305236 1.538414 0.647163 0.263422 1.348466 1.037276 0.893701 1.108073 -0.492190 -0.249170 1.081128 0.973414 0.593299 0.786885 0.003725 0.855855 1.605169 1.050037 0.831705 1.193285 0.128148 0.709803)
)
;;; 71 odd -------------------------------------------------------------------------------- ; 8.4261
-(vector 71 10.642364501953 #(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)
+(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 #(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)
+ 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 #(9.9351872829636 -0.2379167494546 3.1853837584999)??
- ;; 9.9437 #(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 )
+ ;; 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 #(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.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 #(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.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)
)
;;; 72 odd -------------------------------------------------------------------------------- ; 8.4853
-(vector 72 10.880306243896 #(0 0 1 0 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 1 0 1 0 1 1 1 1 0 0 1 1 0 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 0 0 0 1)
+(vector 72 10.880306243896 #r(0 0 1 0 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 1 0 1 0 1 1 1 1 0 0 1 1 0 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 0 0 0 1)
- 8.366430 #(0.000000 1.529157 0.709835 0.191619 0.777505 1.673931 1.052039 1.157229 0.197845 1.188203 0.205209 0.808312 1.907251 0.734102 1.471024 1.752009 0.976735 0.215092 1.669497 0.039070 0.308185 0.805661 0.414650 0.685942 0.933087 1.104471 0.869537 0.010581 1.431457 1.039490 0.654718 0.051163 1.637896 0.041328 0.434461 1.596916 0.630066 0.513683 1.126090 1.472280 0.029687 0.729904 0.900726 0.364456 0.829387 0.775767 0.087943 1.122617 0.054278 0.980310 0.814649 1.331669 0.404897 1.438813 0.751132 1.069103 1.033498 0.950755 0.588560 0.206118 0.697556 1.364322 0.007771 0.225318 -0.029948 1.266843 1.008881 -0.515131 0.251545 0.235634 0.009431 1.881826)
+ 8.366430 #r(0.000000 1.529157 0.709835 0.191619 0.777505 1.673931 1.052039 1.157229 0.197845 1.188203 0.205209 0.808312 1.907251 0.734102 1.471024 1.752009 0.976735 0.215092 1.669497 0.039070 0.308185 0.805661 0.414650 0.685942 0.933087 1.104471 0.869537 0.010581 1.431457 1.039490 0.654718 0.051163 1.637896 0.041328 0.434461 1.596916 0.630066 0.513683 1.126090 1.472280 0.029687 0.729904 0.900726 0.364456 0.829387 0.775767 0.087943 1.122617 0.054278 0.980310 0.814649 1.331669 0.404897 1.438813 0.751132 1.069103 1.033498 0.950755 0.588560 0.206118 0.697556 1.364322 0.007771 0.225318 -0.029948 1.266843 1.008881 -0.515131 0.251545 0.235634 0.009431 1.881826)
)
;;; 73 odd -------------------------------------------------------------------------------- ; 8.5440
-(vector 73 10.907942771912 #(0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 0 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1)
+(vector 73 10.907942771912 #r(0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 0 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1)
- 8.514653 #(0.000000 1.403201 0.376583 -0.053235 1.209136 1.524715 0.146380 -0.261365 0.834173 1.272975 1.772227 0.023615 0.314599 1.515420 0.115615 0.532763 0.813612 1.148749 0.624829 1.610666 0.428301 0.533410 1.364035 0.688805 -0.345103 -0.033075 0.031988 1.294508 1.610808 0.200563 1.512417 1.458407 0.018985 0.336604 -0.051222 0.346655 1.033154 0.703796 1.103730 1.139661 0.592095 0.478459 0.370549 0.620498 -0.386452 0.468708 0.040902 1.488975 0.539537 0.999795 0.347372 0.354446 0.387241 1.176009 1.306213 0.778993 0.280166 0.010910 0.034863 0.320352 1.620759 0.391262 0.863014 -0.075789 1.338588 1.092040 0.260638 1.463660 0.169121 0.826134 0.241084 1.728130 -0.116721)
+ 8.514653 #r(0.000000 1.403201 0.376583 -0.053235 1.209136 1.524715 0.146380 -0.261365 0.834173 1.272975 1.772227 0.023615 0.314599 1.515420 0.115615 0.532763 0.813612 1.148749 0.624829 1.610666 0.428301 0.533410 1.364035 0.688805 -0.345103 -0.033075 0.031988 1.294508 1.610808 0.200563 1.512417 1.458407 0.018985 0.336604 -0.051222 0.346655 1.033154 0.703796 1.103730 1.139661 0.592095 0.478459 0.370549 0.620498 -0.386452 0.468708 0.040902 1.488975 0.539537 0.999795 0.347372 0.354446 0.387241 1.176009 1.306213 0.778993 0.280166 0.010910 0.034863 0.320352 1.620759 0.391262 0.863014 -0.075789 1.338588 1.092040 0.260638 1.463660 0.169121 0.826134 0.241084 1.728130 -0.116721)
)
;;; 74 odd -------------------------------------------------------------------------------- ; 8.6023
-(vector 74 11.262331896 #(0 0 1 1 1 0 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 1 1 0 0 0 0 0 0 1 0 0 1 1 1 0 0 1 1 1 0 0 0 0 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 0 1 1 1 1 0 1 0 0 1 1 0)
+(vector 74 11.262331896 #r(0 0 1 1 1 0 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 1 1 0 0 0 0 0 0 1 0 0 1 1 1 0 0 1 1 1 0 0 0 0 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 0 1 1 1 1 0 1 0 0 1 1 0)
- 8.487915 #(0.000000 0.229202 0.328610 0.886519 0.913243 -0.092303 1.469261 1.392280 0.102684 0.875868 1.119399 -0.375546 1.138609 1.792722 0.270873 0.158504 1.300583 0.337402 0.457798 0.994721 0.720190 1.266403 1.157785 0.204200 0.832717 1.368187 -0.207911 0.551921 0.143469 0.767289 -0.041673 0.248888 0.686134 1.808117 1.719833 1.634354 -0.372228 1.923379 1.132948 1.667043 0.857041 1.387145 0.637791 -0.326159 0.280564 1.478231 0.572776 0.063470 1.115045 1.234238 1.093760 0.166042 1.189669 0.933614 0.159392 1.594960 1.079073 1.251388 1.747471 1.137640 1.343339 1.096317 0.655141 0.037576 1.286106 -0.396608 1.310863 1.072774 0.013655 0.220749 -0.215382 0.087335 1.489739 0.952386)
+ 8.487915 #r(0.000000 0.229202 0.328610 0.886519 0.913243 -0.092303 1.469261 1.392280 0.102684 0.875868 1.119399 -0.375546 1.138609 1.792722 0.270873 0.158504 1.300583 0.337402 0.457798 0.994721 0.720190 1.266403 1.157785 0.204200 0.832717 1.368187 -0.207911 0.551921 0.143469 0.767289 -0.041673 0.248888 0.686134 1.808117 1.719833 1.634354 -0.372228 1.923379 1.132948 1.667043 0.857041 1.387145 0.637791 -0.326159 0.280564 1.478231 0.572776 0.063470 1.115045 1.234238 1.093760 0.166042 1.189669 0.933614 0.159392 1.594960 1.079073 1.251388 1.747471 1.137640 1.343339 1.096317 0.655141 0.037576 1.286106 -0.396608 1.310863 1.072774 0.013655 0.220749 -0.215382 0.087335 1.489739 0.952386)
)
;;; 75 odd -------------------------------------------------------------------------------- ; 8.6603
-(vector 75 10.942812919617 #(0 0 0 1 0 1 0 0 0 1 1 0 1 1 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 1 1 0 1 0 0 1 1 0 0 1 0 1 1)
+(vector 75 10.942812919617 #r(0 0 0 1 0 1 0 0 0 1 1 0 1 1 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 1 1 0 1 0 0 1 1 0 0 1 0 1 1)
- 8.649507 #(0.000000 1.109688 1.876179 -0.024908 0.874394 0.094974 0.967726 0.182001 1.798004 0.764080 1.705983 0.246581 0.919892 -0.031641 0.074543 1.466120 -0.542452 1.308866 1.354893 0.937217 0.141091 0.972731 1.649929 0.076730 0.306081 1.082330 -0.056612 -0.033267 0.417204 0.002975 0.510299 0.334065 0.921554 0.578842 0.861949 0.516829 0.507298 0.089901 1.846522 0.266232 1.636125 0.773196 1.708397 0.143239 0.982116 1.755516 1.504659 0.043743 0.095624 0.325057 0.879744 1.064185 1.252657 0.311473 1.870059 0.309527 1.581011 1.908962 0.734045 1.785988 0.038323 0.023116 0.922283 0.858183 0.320752 1.741469 1.289108 0.871189 -0.238214 1.531119 1.355752 0.609175 0.669122 0.984951 0.033177)
+ 8.649507 #r(0.000000 1.109688 1.876179 -0.024908 0.874394 0.094974 0.967726 0.182001 1.798004 0.764080 1.705983 0.246581 0.919892 -0.031641 0.074543 1.466120 -0.542452 1.308866 1.354893 0.937217 0.141091 0.972731 1.649929 0.076730 0.306081 1.082330 -0.056612 -0.033267 0.417204 0.002975 0.510299 0.334065 0.921554 0.578842 0.861949 0.516829 0.507298 0.089901 1.846522 0.266232 1.636125 0.773196 1.708397 0.143239 0.982116 1.755516 1.504659 0.043743 0.095624 0.325057 0.879744 1.064185 1.252657 0.311473 1.870059 0.309527 1.581011 1.908962 0.734045 1.785988 0.038323 0.023116 0.922283 0.858183 0.320752 1.741469 1.289108 0.871189 -0.238214 1.531119 1.355752 0.609175 0.669122 0.984951 0.033177)
)
;;; 76 odd -------------------------------------------------------------------------------- ; 8.7178
-(vector 76 11.21743106842 #(0 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 1 1 1 0 0 0 0 0 0 0)
+(vector 76 11.21743106842 #r(0 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 1 1 1 0 0 0 0 0 0 0)
- 8.651279 #(0.000000 0.173353 0.839453 0.789458 1.213196 0.485342 1.020793 1.079117 1.510944 0.872759 1.658963 0.469539 1.282086 0.224500 1.187595 1.001928 0.601189 0.457802 1.523606 0.013310 0.486526 1.038767 0.887428 0.818932 0.429987 0.518887 0.949464 1.376735 0.275451 0.805159 0.132159 1.431344 0.575428 0.009721 1.711880 1.360202 0.416637 0.859810 0.491831 0.882963 0.253397 0.012929 1.530000 0.177927 1.883242 1.959160 0.357646 1.604277 0.939839 1.031583 0.502599 0.924357 -0.060587 1.148550 0.762073 0.585290 1.515308 1.022656 0.505967 0.958132 1.937796 0.289650 0.388753 1.349929 0.430727 1.688517 1.350532 0.156971 0.890960 0.708951 1.606885 1.582622 1.628222 1.565608 0.127771 0.825769)
+ 8.651279 #r(0.000000 0.173353 0.839453 0.789458 1.213196 0.485342 1.020793 1.079117 1.510944 0.872759 1.658963 0.469539 1.282086 0.224500 1.187595 1.001928 0.601189 0.457802 1.523606 0.013310 0.486526 1.038767 0.887428 0.818932 0.429987 0.518887 0.949464 1.376735 0.275451 0.805159 0.132159 1.431344 0.575428 0.009721 1.711880 1.360202 0.416637 0.859810 0.491831 0.882963 0.253397 0.012929 1.530000 0.177927 1.883242 1.959160 0.357646 1.604277 0.939839 1.031583 0.502599 0.924357 -0.060587 1.148550 0.762073 0.585290 1.515308 1.022656 0.505967 0.958132 1.937796 0.289650 0.388753 1.349929 0.430727 1.688517 1.350532 0.156971 0.890960 0.708951 1.606885 1.582622 1.628222 1.565608 0.127771 0.825769)
)
;;; 77 odd -------------------------------------------------------------------------------- ; 8.7750
-(vector 77 11.192246437073 #(0 1 0 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 1 0 1 0 0 0 1 1 0 1 1 0 1 0 0 0 1 1 1 1 0 0 1 1 0 1 1 1 0 0 1 1 1 0 1 1 0 0 0 0 0 0)
+(vector 77 11.192246437073 #r(0 1 0 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 1 0 1 0 0 0 1 1 0 1 1 0 1 0 0 0 1 1 1 1 0 0 1 1 0 1 1 1 0 0 1 1 1 0 1 1 0 0 0 0 0 0)
- 8.707019 #(0.000000 1.733898 1.602888 1.700625 0.951967 1.205480 0.494785 0.079322 1.861432 1.411332 0.615577 0.456043 0.176616 0.522662 0.530871 0.948923 1.312747 1.035434 -0.217439 1.260792 0.366350 -0.233439 0.849314 1.174459 -0.193276 1.451248 0.290403 1.453670 0.668542 0.644436 1.306523 1.198202 0.657361 0.888118 1.964614 0.824349 -1.765380 0.784141 0.143386 -0.053030 0.033585 0.726269 -0.055055 0.121221 1.064245 1.578078 0.715470 -0.211778 1.194974 -0.095151 0.313319 0.914111 -0.007802 0.154723 0.086177 1.895682 1.191957 -0.344176 -0.285803 0.072705 0.944928 0.649978 0.107843 0.251480 -0.267013 1.016287 0.107966 1.055797 1.067984 1.857635 0.230948 0.492625 0.104053 0.572353 1.732176 0.353482 0.821975)
+ 8.707019 #r(0.000000 1.733898 1.602888 1.700625 0.951967 1.205480 0.494785 0.079322 1.861432 1.411332 0.615577 0.456043 0.176616 0.522662 0.530871 0.948923 1.312747 1.035434 -0.217439 1.260792 0.366350 -0.233439 0.849314 1.174459 -0.193276 1.451248 0.290403 1.453670 0.668542 0.644436 1.306523 1.198202 0.657361 0.888118 1.964614 0.824349 -1.765380 0.784141 0.143386 -0.053030 0.033585 0.726269 -0.055055 0.121221 1.064245 1.578078 0.715470 -0.211778 1.194974 -0.095151 0.313319 0.914111 -0.007802 0.154723 0.086177 1.895682 1.191957 -0.344176 -0.285803 0.072705 0.944928 0.649978 0.107843 0.251480 -0.267013 1.016287 0.107966 1.055797 1.067984 1.857635 0.230948 0.492625 0.104053 0.572353 1.732176 0.353482 0.821975)
)
;;; 78 odd -------------------------------------------------------------------------------- ; 8.8318
-(vector 78 11.455265310659 #(0 0 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 1 1 0 1 1 1 1 0 1 0 1 1 1 0 1 0 1 1 0 0 1 1 0 0 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 0 0)
+(vector 78 11.455265310659 #r(0 0 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 1 1 0 1 1 1 1 0 1 0 1 1 1 0 1 0 1 1 0 0 1 1 0 0 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 0 0)
- 8.715270 #(0.000000 1.669247 0.757594 0.165819 0.288294 0.684770 0.557521 0.680526 1.097350 0.470057 1.849497 1.090608 0.922922 1.129049 0.104794 -0.129005 0.326960 -0.051784 1.142568 0.483331 0.896117 0.813482 0.302867 0.073158 -0.168821 0.656167 0.700004 1.004810 -0.007423 -0.189996 0.560929 0.412734 0.830296 1.110767 -0.043008 0.613326 0.576197 0.610404 1.233787 0.583712 0.887457 1.853983 1.162911 1.497407 0.204463 1.117898 1.731543 1.711291 0.816677 1.207698 1.691953 0.214296 -0.046452 0.692536 0.108168 0.208702 0.459557 1.630550 -0.229002 1.446147 1.208030 -0.028606 1.708585 1.336818 1.004606 0.393864 1.182948 -0.208442 1.255124 0.056920 1.572769 0.643674 1.170025 0.291140 1.025254 0.562266 0.633856 0.124004)
+ 8.715270 #r(0.000000 1.669247 0.757594 0.165819 0.288294 0.684770 0.557521 0.680526 1.097350 0.470057 1.849497 1.090608 0.922922 1.129049 0.104794 -0.129005 0.326960 -0.051784 1.142568 0.483331 0.896117 0.813482 0.302867 0.073158 -0.168821 0.656167 0.700004 1.004810 -0.007423 -0.189996 0.560929 0.412734 0.830296 1.110767 -0.043008 0.613326 0.576197 0.610404 1.233787 0.583712 0.887457 1.853983 1.162911 1.497407 0.204463 1.117898 1.731543 1.711291 0.816677 1.207698 1.691953 0.214296 -0.046452 0.692536 0.108168 0.208702 0.459557 1.630550 -0.229002 1.446147 1.208030 -0.028606 1.708585 1.336818 1.004606 0.393864 1.182948 -0.208442 1.255124 0.056920 1.572769 0.643674 1.170025 0.291140 1.025254 0.562266 0.633856 0.124004)
)
;;; 79 odd -------------------------------------------------------------------------------- ; 8.8882
-(vector 79 11.54291004024 #(0 0 1 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 1 0 1 0 0 1 0 0 0 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 1 0 1 0 1 0)
+(vector 79 11.54291004024 #r(0 0 1 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 1 0 1 0 0 1 0 0 0 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 1 0 1 0 1 0)
- 8.864559 #(0.000000 0.357256 0.036759 1.292339 -1.618603 1.176406 0.544736 0.398074 0.109043 0.617241 0.697903 1.118083 1.422870 1.215951 0.004362 1.621202 0.264308 0.010496 1.213090 1.597753 -0.054911 1.223572 0.202448 0.615339 0.757193 0.130847 1.245098 1.256256 1.117774 0.701640 1.170787 1.057213 -0.087146 1.024522 1.105914 1.493238 0.672326 0.950638 -0.158430 0.266150 1.329043 0.773121 1.527296 -0.078973 1.669452 1.490229 0.141063 1.057903 0.727028 1.146281 0.010335 0.602841 1.428986 1.325796 1.320411 -0.094534 0.491229 0.443206 1.223761 0.317919 0.333487 -0.004296 1.074159 1.511918 1.245758 0.213171 1.140531 1.245789 0.552067 1.083032 0.600490 0.777304 0.106919 1.336123 1.060329 1.059212 0.289692 1.668881 1.086200)
+ 8.864559 #r(0.000000 0.357256 0.036759 1.292339 -1.618603 1.176406 0.544736 0.398074 0.109043 0.617241 0.697903 1.118083 1.422870 1.215951 0.004362 1.621202 0.264308 0.010496 1.213090 1.597753 -0.054911 1.223572 0.202448 0.615339 0.757193 0.130847 1.245098 1.256256 1.117774 0.701640 1.170787 1.057213 -0.087146 1.024522 1.105914 1.493238 0.672326 0.950638 -0.158430 0.266150 1.329043 0.773121 1.527296 -0.078973 1.669452 1.490229 0.141063 1.057903 0.727028 1.146281 0.010335 0.602841 1.428986 1.325796 1.320411 -0.094534 0.491229 0.443206 1.223761 0.317919 0.333487 -0.004296 1.074159 1.511918 1.245758 0.213171 1.140531 1.245789 0.552067 1.083032 0.600490 0.777304 0.106919 1.336123 1.060329 1.059212 0.289692 1.668881 1.086200)
)
;;; 80 odd -------------------------------------------------------------------------------- ; 8.9443
-(vector 80 11.122416496277 #(0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 1 1 0 1 1 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 0 1 1)
+(vector 80 11.122416496277 #r(0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 1 1 0 1 1 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 0 1 1)
- 8.870144 #(0.000000 0.655710 0.591720 1.625031 0.418269 1.346736 0.349691 1.735905 1.181438 1.185938 0.537355 1.048431 0.310338 0.725392 0.138830 -0.162626 -0.012235 1.033480 1.181949 0.616925 1.912794 0.918753 0.626238 0.223870 0.664522 -0.078088 0.256973 1.394811 0.721353 1.350998 0.870615 0.111718 1.175636 1.041732 -0.087582 0.658928 1.024480 -0.106481 0.957206 0.153547 0.343423 1.369668 0.634606 0.765343 -0.148776 0.328436 0.827668 1.133483 1.461950 0.929478 0.348570 1.212214 0.446866 0.848436 0.219387 1.773456 1.168998 0.793903 0.614230 1.089360 1.446367 1.640320 0.120507 0.926616 0.816912 0.468029 0.525200 0.868913 1.510302 1.541893 -0.030330 0.055242 0.070867 0.042035 1.687456 0.144651 -0.241563 0.096801 -0.095086 0.917714)
+ 8.870144 #r(0.000000 0.655710 0.591720 1.625031 0.418269 1.346736 0.349691 1.735905 1.181438 1.185938 0.537355 1.048431 0.310338 0.725392 0.138830 -0.162626 -0.012235 1.033480 1.181949 0.616925 1.912794 0.918753 0.626238 0.223870 0.664522 -0.078088 0.256973 1.394811 0.721353 1.350998 0.870615 0.111718 1.175636 1.041732 -0.087582 0.658928 1.024480 -0.106481 0.957206 0.153547 0.343423 1.369668 0.634606 0.765343 -0.148776 0.328436 0.827668 1.133483 1.461950 0.929478 0.348570 1.212214 0.446866 0.848436 0.219387 1.773456 1.168998 0.793903 0.614230 1.089360 1.446367 1.640320 0.120507 0.926616 0.816912 0.468029 0.525200 0.868913 1.510302 1.541893 -0.030330 0.055242 0.070867 0.042035 1.687456 0.144651 -0.241563 0.096801 -0.095086 0.917714)
)
;;; 81 odd -------------------------------------------------------------------------------- ; 9
-(vector 81 11.372210502625 #(0 0 1 0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1)
+(vector 81 11.372210502625 #r(0 0 1 0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1)
- 8.926326 #(0.000000 0.164735 -0.380225 0.081555 1.097918 1.524480 0.077656 0.977304 0.407700 0.831319 0.533822 0.615403 1.642513 -0.058036 0.444751 1.446330 0.995710 0.841112 0.528746 0.832226 0.248085 0.502898 1.190162 0.745146 -0.208212 0.492995 1.110378 0.980131 0.817203 1.338834 1.000001 1.336192 1.804389 0.900670 0.555661 1.748659 0.603816 0.728857 -0.167279 1.058563 1.176033 1.277029 1.122180 1.127499 -0.224172 0.316000 1.080199 0.508511 0.252234 0.338999 0.400496 1.857653 0.607017 0.245631 0.807136 -0.037588 -0.063570 1.552479 1.126540 0.180335 0.976685 0.410774 1.244176 1.541645 1.450598 0.050542 0.208414 1.102430 0.959489 0.189328 0.354550 1.724776 1.384943 0.545643 1.965929 0.479461 0.756949 1.038515 -0.004640 1.477899 0.906680)
+ 8.926326 #r(0.000000 0.164735 -0.380225 0.081555 1.097918 1.524480 0.077656 0.977304 0.407700 0.831319 0.533822 0.615403 1.642513 -0.058036 0.444751 1.446330 0.995710 0.841112 0.528746 0.832226 0.248085 0.502898 1.190162 0.745146 -0.208212 0.492995 1.110378 0.980131 0.817203 1.338834 1.000001 1.336192 1.804389 0.900670 0.555661 1.748659 0.603816 0.728857 -0.167279 1.058563 1.176033 1.277029 1.122180 1.127499 -0.224172 0.316000 1.080199 0.508511 0.252234 0.338999 0.400496 1.857653 0.607017 0.245631 0.807136 -0.037588 -0.063570 1.552479 1.126540 0.180335 0.976685 0.410774 1.244176 1.541645 1.450598 0.050542 0.208414 1.102430 0.959489 0.189328 0.354550 1.724776 1.384943 0.545643 1.965929 0.479461 0.756949 1.038515 -0.004640 1.477899 0.906680)
)
;;; 82 odd -------------------------------------------------------------------------------- ; 9.0554
-(vector 82 11.662058134504 #(0 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 0 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 1 1 0 1 1 1 0 0 0 0 1 0 1 1 0 0)
+(vector 82 11.662058134504 #r(0 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 0 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 1 1 0 1 1 1 0 0 0 0 1 0 1 1 0 0)
- 8.895498 #(0.000000 1.650756 0.929235 0.669074 0.458613 1.575883 1.406092 1.106790 0.596730 0.021347 1.134970 0.616933 1.701827 0.504785 1.614982 1.519418 0.470952 1.289129 0.059550 0.427695 0.231422 1.559220 0.383709 0.161407 0.068209 -0.031038 1.865998 -0.109083 1.124535 0.249567 0.520329 0.463755 1.759816 0.122747 -0.063135 1.879507 0.089457 0.845717 1.061947 -0.248630 -0.240924 0.207853 1.548893 0.621489 0.599673 1.031885 -0.104736 1.726398 0.898686 0.128558 0.928155 1.723232 0.730130 1.329452 0.779285 1.207734 0.370523 1.269134 1.812531 0.562255 0.696469 1.440871 0.214062 1.838981 0.082605 1.605017 1.504365 0.122097 0.273097 0.895327 0.555120 -0.358045 0.959494 0.864915 1.049696 1.458692 1.063317 -0.105762 0.240946 0.516137 0.295184 -0.035654)
+ 8.895498 #r(0.000000 1.650756 0.929235 0.669074 0.458613 1.575883 1.406092 1.106790 0.596730 0.021347 1.134970 0.616933 1.701827 0.504785 1.614982 1.519418 0.470952 1.289129 0.059550 0.427695 0.231422 1.559220 0.383709 0.161407 0.068209 -0.031038 1.865998 -0.109083 1.124535 0.249567 0.520329 0.463755 1.759816 0.122747 -0.063135 1.879507 0.089457 0.845717 1.061947 -0.248630 -0.240924 0.207853 1.548893 0.621489 0.599673 1.031885 -0.104736 1.726398 0.898686 0.128558 0.928155 1.723232 0.730130 1.329452 0.779285 1.207734 0.370523 1.269134 1.812531 0.562255 0.696469 1.440871 0.214062 1.838981 0.082605 1.605017 1.504365 0.122097 0.273097 0.895327 0.555120 -0.358045 0.959494 0.864915 1.049696 1.458692 1.063317 -0.105762 0.240946 0.516137 0.295184 -0.035654)
)
;;; 83 odd -------------------------------------------------------------------------------- ; 9.1104
-(vector 83 11.732900669843 #(0 0 0 1 1 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 1 1 1 1 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1)
+(vector 83 11.732900669843 #r(0 0 0 1 1 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 1 1 1 1 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1)
- 9.060733 #(0.000000 0.847614 1.074595 0.345210 0.202371 1.511917 1.112425 0.572830 1.582187 0.218687 0.979697 0.829284 0.504832 0.409321 1.581223 1.031036 0.666780 1.347208 1.680503 1.486577 0.618089 -0.256946 0.905019 0.230952 0.059969 -0.145434 0.545921 0.384376 1.384380 0.665205 1.583895 0.055621 1.669433 1.386960 1.917214 0.552314 1.477586 0.229404 -0.049820 0.210015 -0.192839 1.819422 0.656731 1.258726 0.062676 0.649682 -0.033937 1.076469 0.763030 0.654748 1.032680 0.850557 0.101236 1.303860 1.683735 0.917766 1.133625 0.788918 0.091033 0.752267 0.650807 0.661591 0.956487 -0.151184 1.699725 0.067039 0.562858 0.669739 1.945082 0.507537 0.168655 1.291963 1.367257 0.073343 1.018407 0.584241 1.284655 0.733315 0.794277 0.838058 0.819351 1.776021 0.236189)
+ 9.060733 #r(0.000000 0.847614 1.074595 0.345210 0.202371 1.511917 1.112425 0.572830 1.582187 0.218687 0.979697 0.829284 0.504832 0.409321 1.581223 1.031036 0.666780 1.347208 1.680503 1.486577 0.618089 -0.256946 0.905019 0.230952 0.059969 -0.145434 0.545921 0.384376 1.384380 0.665205 1.583895 0.055621 1.669433 1.386960 1.917214 0.552314 1.477586 0.229404 -0.049820 0.210015 -0.192839 1.819422 0.656731 1.258726 0.062676 0.649682 -0.033937 1.076469 0.763030 0.654748 1.032680 0.850557 0.101236 1.303860 1.683735 0.917766 1.133625 0.788918 0.091033 0.752267 0.650807 0.661591 0.956487 -0.151184 1.699725 0.067039 0.562858 0.669739 1.945082 0.507537 0.168655 1.291963 1.367257 0.073343 1.018407 0.584241 1.284655 0.733315 0.794277 0.838058 0.819351 1.776021 0.236189)
)
;;; 84 odd -------------------------------------------------------------------------------- ; 9.1652
-(vector 84 11.626023292542 #(0 0 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 1 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 1)
+(vector 84 11.626023292542 #r(0 0 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 1 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 1)
- 9.185550 #(0.000000 -0.021653 -0.040601 1.163796 1.903509 0.943755 0.646624 1.866284 1.925515 0.123826 0.553199 0.965947 -0.075756 1.082744 1.817561 1.285536 1.050220 0.807240 0.605743 0.429498 0.508235 1.302559 1.611197 -0.514061 0.753992 1.700832 1.582166 0.521137 0.493019 0.834823 1.698189 0.272829 1.846496 1.874128 0.834101 0.281869 1.080560 1.438521 0.953941 1.280344 1.022208 1.661905 1.607595 1.126422 0.777808 0.689451 0.023149 0.691721 0.542242 0.838865 0.011483 1.098563 0.333470 0.611697 0.199907 -0.091248 0.912993 0.515958 1.079940 1.005613 0.731323 0.930947 0.301128 0.363360 0.978049 -0.000124 -0.516420 0.523117 0.574889 0.270432 1.275532 0.818251 1.531964 1.322842 0.207974 1.087144 1.315578 0.094014 1.345898 1.884730 0.414183 1.230212 1.440972 0.367718)
+ 9.185550 #r(0.000000 -0.021653 -0.040601 1.163796 1.903509 0.943755 0.646624 1.866284 1.925515 0.123826 0.553199 0.965947 -0.075756 1.082744 1.817561 1.285536 1.050220 0.807240 0.605743 0.429498 0.508235 1.302559 1.611197 -0.514061 0.753992 1.700832 1.582166 0.521137 0.493019 0.834823 1.698189 0.272829 1.846496 1.874128 0.834101 0.281869 1.080560 1.438521 0.953941 1.280344 1.022208 1.661905 1.607595 1.126422 0.777808 0.689451 0.023149 0.691721 0.542242 0.838865 0.011483 1.098563 0.333470 0.611697 0.199907 -0.091248 0.912993 0.515958 1.079940 1.005613 0.731323 0.930947 0.301128 0.363360 0.978049 -0.000124 -0.516420 0.523117 0.574889 0.270432 1.275532 0.818251 1.531964 1.322842 0.207974 1.087144 1.315578 0.094014 1.345898 1.884730 0.414183 1.230212 1.440972 0.367718)
- ;; #(10.778808034738 -0.227659005925 3.1786048937356)
- ;; 10.7788 #(0.0000 0.9393 1.9022 0.8886 1.8986 0.9322 1.9893 1.0700 0.1743 1.3021 0.4535 1.6284 0.8269 0.0490 1.2946 0.5638 1.8566 1.1729 0.5128 1.8762 1.2632 0.6738 0.1079 1.5656 1.0469 0.5517 0.0801 1.6320 1.2075 0.8066 0.4292 0.0754 1.7452 1.4385 1.1554 0.8959 0.6599 0.4474 0.2586 0.0933 1.9515 1.8334 1.7387 1.6677 1.6202 1.5963 1.5959 1.6191 1.6659 1.7362 1.8301 1.9476 0.0886 0.2531 0.4413 0.6530 0.8882 1.1471 1.4295 1.7354 0.0649 0.4180 0.7947 1.1949 1.6186 0.0660 0.5368 1.0313 1.5493 0.0909 0.6560 1.2448 1.8570 0.4929 1.1522 1.8352 0.5417 1.2718 0.0254 0.8027 1.6034 0.4278 1.2757 0.1471 )
+ ;; #r(10.778808034738 -0.227659005925 3.1786048937356)
+ ;; 10.7788 #r(0.0000 0.9393 1.9022 0.8886 1.8986 0.9322 1.9893 1.0700 0.1743 1.3021 0.4535 1.6284 0.8269 0.0490 1.2946 0.5638 1.8566 1.1729 0.5128 1.8762 1.2632 0.6738 0.1079 1.5656 1.0469 0.5517 0.0801 1.6320 1.2075 0.8066 0.4292 0.0754 1.7452 1.4385 1.1554 0.8959 0.6599 0.4474 0.2586 0.0933 1.9515 1.8334 1.7387 1.6677 1.6202 1.5963 1.5959 1.6191 1.6659 1.7362 1.8301 1.9476 0.0886 0.2531 0.4413 0.6530 0.8882 1.1471 1.4295 1.7354 0.0649 0.4180 0.7947 1.1949 1.6186 0.0660 0.5368 1.0313 1.5493 0.0909 0.6560 1.2448 1.8570 0.4929 1.1522 1.8352 0.5417 1.2718 0.0254 0.8027 1.6034 0.4278 1.2757 0.1471 )
- 9.165706 #(0.000000 0.934656 0.009740 0.892912 1.914788 0.817407 -0.047164 1.003969 0.164884 1.249319 0.380071 1.616476 0.954376 0.202231 1.312292 0.604557 -0.077459 1.312472 0.754364 -0.003767 1.276135 0.650523 0.170854 1.618591 1.053160 0.577476 -0.205916 1.453889 1.286143 0.889924 0.243897 -0.239706 1.833300 1.444468 1.151374 0.857183 0.586020 0.323924 0.036983 0.119493 -0.037558 1.940953 1.593882 -0.092635 1.798428 1.555339 1.399215 1.467642 1.835150 1.833867 -0.004678 -0.067916 0.264183 0.072836 0.826599 0.656778 1.089237 1.011513 1.337524 1.652586 0.118011 0.621082 0.947811 1.150679 1.538842 -0.108726 0.395215 0.886557 1.570811 -0.049501 0.809380 1.348209 1.743527 0.295071 1.055258 1.946886 0.463731 1.299054 0.188329 0.827519 0.037317 0.845744 1.341936 0.257273)
+ 9.165706 #r(0.000000 0.934656 0.009740 0.892912 1.914788 0.817407 -0.047164 1.003969 0.164884 1.249319 0.380071 1.616476 0.954376 0.202231 1.312292 0.604557 -0.077459 1.312472 0.754364 -0.003767 1.276135 0.650523 0.170854 1.618591 1.053160 0.577476 -0.205916 1.453889 1.286143 0.889924 0.243897 -0.239706 1.833300 1.444468 1.151374 0.857183 0.586020 0.323924 0.036983 0.119493 -0.037558 1.940953 1.593882 -0.092635 1.798428 1.555339 1.399215 1.467642 1.835150 1.833867 -0.004678 -0.067916 0.264183 0.072836 0.826599 0.656778 1.089237 1.011513 1.337524 1.652586 0.118011 0.621082 0.947811 1.150679 1.538842 -0.108726 0.395215 0.886557 1.570811 -0.049501 0.809380 1.348209 1.743527 0.295071 1.055258 1.946886 0.463731 1.299054 0.188329 0.827519 0.037317 0.845744 1.341936 0.257273)
- 9.138477 #(0.000000 1.077136 0.063003 0.974335 0.001930 0.872203 0.017246 1.080670 0.235219 1.252888 0.378851 1.612382 0.956324 0.200975 1.336006 0.666511 -0.109401 1.250621 0.645704 -0.034379 1.373066 0.621844 0.153419 1.662637 1.014313 0.564772 -0.158790 1.458303 1.312400 0.935605 0.228083 -0.303405 1.933909 1.508310 1.203183 0.851210 0.700949 0.260045 0.137593 0.186330 -0.029149 0.093187 1.669321 -0.022893 1.804433 1.569916 1.547568 1.535838 1.866608 1.883016 0.163191 -0.079249 0.336381 0.043460 0.741963 0.718443 1.177177 1.028118 1.387506 1.729902 0.144100 0.716901 1.003307 1.132902 1.504355 -0.063217 0.409728 0.962060 1.632348 0.020339 0.842809 1.386919 1.688164 0.250155 0.883600 1.992873 0.466027 1.340844 0.278519 0.955099 -0.020386 0.926876 1.398431 0.248264)
+ 9.138477 #r(0.000000 1.077136 0.063003 0.974335 0.001930 0.872203 0.017246 1.080670 0.235219 1.252888 0.378851 1.612382 0.956324 0.200975 1.336006 0.666511 -0.109401 1.250621 0.645704 -0.034379 1.373066 0.621844 0.153419 1.662637 1.014313 0.564772 -0.158790 1.458303 1.312400 0.935605 0.228083 -0.303405 1.933909 1.508310 1.203183 0.851210 0.700949 0.260045 0.137593 0.186330 -0.029149 0.093187 1.669321 -0.022893 1.804433 1.569916 1.547568 1.535838 1.866608 1.883016 0.163191 -0.079249 0.336381 0.043460 0.741963 0.718443 1.177177 1.028118 1.387506 1.729902 0.144100 0.716901 1.003307 1.132902 1.504355 -0.063217 0.409728 0.962060 1.632348 0.020339 0.842809 1.386919 1.688164 0.250155 0.883600 1.992873 0.466027 1.340844 0.278519 0.955099 -0.020386 0.926876 1.398431 0.248264)
- 9.133456 #(0.000000 1.059401 0.031287 0.939386 -0.017860 0.901644 0.001799 1.027990 0.230681 1.311963 0.341928 1.644077 0.966811 0.236475 1.300649 0.692497 -0.027953 1.347389 0.723063 -0.003313 1.322772 0.582050 0.159545 1.703814 1.026586 0.555590 -0.158337 1.444034 1.321735 1.003900 0.274358 -0.325622 1.927342 1.457207 1.230507 0.919830 0.720469 0.244803 0.085297 0.173845 -0.048361 0.080359 1.671325 0.039907 1.736091 1.631912 1.486133 1.471880 1.784848 1.922823 0.107240 -0.103436 0.280519 -0.025774 0.700275 0.720167 1.157653 1.036798 1.295565 1.717341 0.156191 0.724169 1.042098 1.172208 1.529978 -0.089227 0.426393 0.952547 1.692201 0.117254 0.809203 1.354853 1.694705 0.278490 0.926144 0.035100 0.434956 1.402186 0.356337 0.912787 0.017302 1.021860 1.401595 0.333844)
+ 9.133456 #r(0.000000 1.059401 0.031287 0.939386 -0.017860 0.901644 0.001799 1.027990 0.230681 1.311963 0.341928 1.644077 0.966811 0.236475 1.300649 0.692497 -0.027953 1.347389 0.723063 -0.003313 1.322772 0.582050 0.159545 1.703814 1.026586 0.555590 -0.158337 1.444034 1.321735 1.003900 0.274358 -0.325622 1.927342 1.457207 1.230507 0.919830 0.720469 0.244803 0.085297 0.173845 -0.048361 0.080359 1.671325 0.039907 1.736091 1.631912 1.486133 1.471880 1.784848 1.922823 0.107240 -0.103436 0.280519 -0.025774 0.700275 0.720167 1.157653 1.036798 1.295565 1.717341 0.156191 0.724169 1.042098 1.172208 1.529978 -0.089227 0.426393 0.952547 1.692201 0.117254 0.809203 1.354853 1.694705 0.278490 0.926144 0.035100 0.434956 1.402186 0.356337 0.912787 0.017302 1.021860 1.401595 0.333844)
)
;;; 85 odd -------------------------------------------------------------------------------- ; 9.2195
-(vector 85 11.829360154975 #(0 0 0 1 0 0 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 1 0 1 1 1 1 1 0 0 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 0 1 1 0 1)
+(vector 85 11.829360154975 #r(0 0 0 1 0 0 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 1 0 1 1 1 1 1 0 0 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 0 1 1 0 1)
- 9.172932 #(0.000000 1.198268 -0.046093 0.496651 0.155499 0.438914 1.717129 -0.153996 0.255959 0.942459 -0.112043 1.664994 1.597976 1.071752 0.293731 1.489898 -0.088206 1.402767 1.814932 1.099748 -0.400724 1.351064 1.265640 1.075629 0.060651 -0.371046 0.814537 0.326687 0.633977 1.654428 1.582553 0.618025 1.054016 1.391986 1.098803 0.284271 1.476963 1.042434 1.922088 0.305413 -0.626240 1.791879 1.777727 0.678099 1.505684 1.182071 0.629820 1.357783 0.665420 0.341784 0.926591 0.193623 1.006880 1.192651 -0.116178 0.080172 1.591790 1.522361 0.438822 1.766471 0.395503 1.446548 -0.046614 0.961931 0.316539 0.616763 1.087859 0.290761 0.142685 0.155135 0.508154 0.686168 1.471184 1.165229 0.372220 0.294409 0.404832 -1.767095 1.243980 0.993281 1.007462 0.784244 1.104711 1.671816 0.086342)
+ 9.172932 #r(0.000000 1.198268 -0.046093 0.496651 0.155499 0.438914 1.717129 -0.153996 0.255959 0.942459 -0.112043 1.664994 1.597976 1.071752 0.293731 1.489898 -0.088206 1.402767 1.814932 1.099748 -0.400724 1.351064 1.265640 1.075629 0.060651 -0.371046 0.814537 0.326687 0.633977 1.654428 1.582553 0.618025 1.054016 1.391986 1.098803 0.284271 1.476963 1.042434 1.922088 0.305413 -0.626240 1.791879 1.777727 0.678099 1.505684 1.182071 0.629820 1.357783 0.665420 0.341784 0.926591 0.193623 1.006880 1.192651 -0.116178 0.080172 1.591790 1.522361 0.438822 1.766471 0.395503 1.446548 -0.046614 0.961931 0.316539 0.616763 1.087859 0.290761 0.142685 0.155135 0.508154 0.686168 1.471184 1.165229 0.372220 0.294409 0.404832 -1.767095 1.243980 0.993281 1.007462 0.784244 1.104711 1.671816 0.086342)
)
;;; 86 odd -------------------------------------------------------------------------------- ; 9.2736
-(vector 86 12.140432277993 #(0 0 0 1 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 1)
+(vector 86 12.140432277993 #r(0 0 0 1 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 1)
- 9.213343 #(0.000000 0.676268 0.369198 1.486263 -0.026625 0.678855 0.928889 1.200870 0.763422 0.131815 -0.064018 0.334478 0.754549 0.549209 0.781916 -0.164085 1.831169 -0.359871 0.452632 0.395640 1.217523 1.666783 1.263104 0.462675 0.487261 1.713262 0.419400 0.982422 0.818648 0.009279 0.749148 0.986045 1.410580 0.251205 1.543152 0.685375 0.249458 0.699138 0.175620 0.312944 1.884362 1.099441 1.640835 1.728596 -0.397229 1.509431 0.364317 1.073248 1.571193 0.690550 1.201949 -0.104903 0.984182 0.850373 -0.106842 1.582861 -0.052279 0.837387 1.423896 1.118738 -0.077783 0.539913 1.394923 -0.009295 1.541216 0.438460 0.217352 0.527395 0.855264 0.357004 0.424674 0.870332 0.435096 0.770273 0.096843 1.702425 0.991351 1.315154 1.133850 0.440564 0.044541 0.788769 0.138246 -0.080948 1.096067 0.575869)
+ 9.213343 #r(0.000000 0.676268 0.369198 1.486263 -0.026625 0.678855 0.928889 1.200870 0.763422 0.131815 -0.064018 0.334478 0.754549 0.549209 0.781916 -0.164085 1.831169 -0.359871 0.452632 0.395640 1.217523 1.666783 1.263104 0.462675 0.487261 1.713262 0.419400 0.982422 0.818648 0.009279 0.749148 0.986045 1.410580 0.251205 1.543152 0.685375 0.249458 0.699138 0.175620 0.312944 1.884362 1.099441 1.640835 1.728596 -0.397229 1.509431 0.364317 1.073248 1.571193 0.690550 1.201949 -0.104903 0.984182 0.850373 -0.106842 1.582861 -0.052279 0.837387 1.423896 1.118738 -0.077783 0.539913 1.394923 -0.009295 1.541216 0.438460 0.217352 0.527395 0.855264 0.357004 0.424674 0.870332 0.435096 0.770273 0.096843 1.702425 0.991351 1.315154 1.133850 0.440564 0.044541 0.788769 0.138246 -0.080948 1.096067 0.575869)
)
;;; 87 odd -------------------------------------------------------------------------------- ; 9.32737905
-(vector 87 11.937030388359 #(0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 1 0 1 0 0 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 1 1 1 1)
+(vector 87 11.937030388359 #r(0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 1 0 1 0 0 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 1 1 1 1)
- 9.317037 #(0.000000 1.269780 0.764198 1.382169 0.560101 1.397366 0.619615 1.110127 1.074742 0.786154 0.097129 0.187903 1.280480 1.001234 0.625991 -0.253578 0.524611 0.642531 0.754319 1.395067 1.865340 0.173765 1.213561 0.413784 0.704706 0.640451 1.483492 1.299442 0.783307 0.912207 0.977809 1.588075 -0.173310 1.063721 0.534821 0.450809 0.251070 0.792950 1.489833 1.745329 1.098607 0.960633 0.682333 0.343541 0.677820 0.343804 -0.007548 0.114569 1.083276 0.044826 0.931689 1.109596 -0.582840 1.287598 0.295851 -0.261696 1.183896 0.581304 -0.088958 1.623439 0.434479 0.025514 0.230711 1.672013 0.717129 1.395826 0.682208 -0.299168 -0.096350 -0.604219 1.679467 0.411395 0.711815 1.234251 0.324421 0.995113 0.167630 0.383406 0.968742 0.310771 0.425004 0.820195 0.922682 1.343873 0.606017 -0.248788 1.112139)
+ 9.317037 #r(0.000000 1.269780 0.764198 1.382169 0.560101 1.397366 0.619615 1.110127 1.074742 0.786154 0.097129 0.187903 1.280480 1.001234 0.625991 -0.253578 0.524611 0.642531 0.754319 1.395067 1.865340 0.173765 1.213561 0.413784 0.704706 0.640451 1.483492 1.299442 0.783307 0.912207 0.977809 1.588075 -0.173310 1.063721 0.534821 0.450809 0.251070 0.792950 1.489833 1.745329 1.098607 0.960633 0.682333 0.343541 0.677820 0.343804 -0.007548 0.114569 1.083276 0.044826 0.931689 1.109596 -0.582840 1.287598 0.295851 -0.261696 1.183896 0.581304 -0.088958 1.623439 0.434479 0.025514 0.230711 1.672013 0.717129 1.395826 0.682208 -0.299168 -0.096350 -0.604219 1.679467 0.411395 0.711815 1.234251 0.324421 0.995113 0.167630 0.383406 0.968742 0.310771 0.425004 0.820195 0.922682 1.343873 0.606017 -0.248788 1.112139)
)
;;; 88 odd -------------------------------------------------------------------------------- ; 9.3808
-(vector 88 12.128922775356 #(0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 1 1 0 0 0 1)
+(vector 88 12.128922775356 #r(0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 1 1 0 0 0 1)
- 9.324023 #(0.000000 0.720070 1.146170 1.623229 0.919914 1.475051 1.669418 0.417706 1.222880 1.077800 0.636671 0.109954 0.709268 0.401961 1.342317 0.470950 1.038199 -0.014165 -0.223115 1.401527 0.255061 -0.053613 1.038430 1.524899 0.900064 0.540757 0.958685 1.268571 0.665381 1.798791 1.658869 0.625852 0.519615 0.589311 -0.003435 1.345809 -0.056260 0.616788 0.290786 1.478184 0.854964 0.750706 1.853143 1.837616 0.068009 0.196260 1.496079 0.820255 1.744388 0.146057 0.230788 1.434358 -0.205448 1.616936 0.981163 0.921532 1.591565 1.188825 -0.476209 1.518808 0.443241 0.115647 0.334751 1.367563 0.160132 1.179927 1.012776 0.498582 1.276116 0.704338 1.396987 -0.001804 0.959954 1.167324 1.287070 1.914346 1.400505 1.413492 1.484414 -0.463663 0.122173 0.488918 -0.038072 1.041389 -0.101511 -0.067115 1.661217 1.643428)
+ 9.324023 #r(0.000000 0.720070 1.146170 1.623229 0.919914 1.475051 1.669418 0.417706 1.222880 1.077800 0.636671 0.109954 0.709268 0.401961 1.342317 0.470950 1.038199 -0.014165 -0.223115 1.401527 0.255061 -0.053613 1.038430 1.524899 0.900064 0.540757 0.958685 1.268571 0.665381 1.798791 1.658869 0.625852 0.519615 0.589311 -0.003435 1.345809 -0.056260 0.616788 0.290786 1.478184 0.854964 0.750706 1.853143 1.837616 0.068009 0.196260 1.496079 0.820255 1.744388 0.146057 0.230788 1.434358 -0.205448 1.616936 0.981163 0.921532 1.591565 1.188825 -0.476209 1.518808 0.443241 0.115647 0.334751 1.367563 0.160132 1.179927 1.012776 0.498582 1.276116 0.704338 1.396987 -0.001804 0.959954 1.167324 1.287070 1.914346 1.400505 1.413492 1.484414 -0.463663 0.122173 0.488918 -0.038072 1.041389 -0.101511 -0.067115 1.661217 1.643428)
)
;;; 89 odd -------------------------------------------------------------------------------- ; 9.4340
-(vector 89 12.362 #(0 1 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 1 0 1 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 0 0 0 1 0 1 1 1 0)
+(vector 89 12.362 #r(0 1 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 1 0 1 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 0 0 0 1 0 1 1 1 0)
- 9.331615 #(0.000000 0.049094 0.763150 0.136548 0.483778 0.759076 0.333224 1.220929 0.134557 0.764345 0.615745 -0.054859 0.470862 1.549452 1.042755 0.304443 0.281140 1.178803 1.496311 1.304814 1.254180 1.214938 -0.188361 1.642263 1.456263 1.200682 1.159330 0.518402 1.259168 1.450349 0.156876 1.423052 0.526144 0.557187 0.211944 1.876505 0.927439 -0.029530 0.421763 1.206664 0.690297 1.789526 1.067082 0.003086 0.897179 1.065326 1.434687 0.576391 -0.150316 1.287422 1.126966 1.259277 1.431443 0.305104 0.343134 0.824875 1.068860 1.722713 1.668311 0.909968 1.314221 0.346498 0.614998 0.306500 1.059400 1.495807 -0.733779 1.277563 0.627585 1.184462 -0.276841 0.360604 0.535684 -0.101891 0.124422 1.197248 0.778353 1.945787 1.307086 0.922575 0.921600 0.870062 1.105219 1.606237 0.868032 -0.120196 0.316193 -0.191814 0.432808)
+ 9.331615 #r(0.000000 0.049094 0.763150 0.136548 0.483778 0.759076 0.333224 1.220929 0.134557 0.764345 0.615745 -0.054859 0.470862 1.549452 1.042755 0.304443 0.281140 1.178803 1.496311 1.304814 1.254180 1.214938 -0.188361 1.642263 1.456263 1.200682 1.159330 0.518402 1.259168 1.450349 0.156876 1.423052 0.526144 0.557187 0.211944 1.876505 0.927439 -0.029530 0.421763 1.206664 0.690297 1.789526 1.067082 0.003086 0.897179 1.065326 1.434687 0.576391 -0.150316 1.287422 1.126966 1.259277 1.431443 0.305104 0.343134 0.824875 1.068860 1.722713 1.668311 0.909968 1.314221 0.346498 0.614998 0.306500 1.059400 1.495807 -0.733779 1.277563 0.627585 1.184462 -0.276841 0.360604 0.535684 -0.101891 0.124422 1.197248 0.778353 1.945787 1.307086 0.922575 0.921600 0.870062 1.105219 1.606237 0.868032 -0.120196 0.316193 -0.191814 0.432808)
)
;;; 90 odd -------------------------------------------------------------------------------- ; 9.4868
-(vector 90 12.309 #(0 0 0 0 1 1 0 1 1 0 1 1 0 0 1 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 1 1 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 0 1 0 1 0 0 0 1)
+(vector 90 12.309 #r(0 0 0 0 1 1 0 1 1 0 1 1 0 0 1 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 1 1 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 0 1 0 1 0 0 0 1)
- 9.421684 #(0.000000 0.773463 -0.034237 0.815187 0.818292 -0.048506 -0.025177 1.145716 1.124687 -0.087471 0.982715 1.911529 0.885016 -0.169554 0.478422 0.410159 1.012688 0.169228 0.764485 0.758910 1.289872 0.618276 -0.229660 1.549110 0.758331 0.279930 1.553579 0.672439 0.162166 0.690601 0.847281 1.562839 1.023152 1.146052 1.063766 0.943600 -0.316637 0.816595 1.430319 0.223152 0.862408 0.935019 0.764642 0.942440 1.888157 1.614273 1.641359 1.139335 1.700104 1.516977 1.001915 0.698936 0.890613 1.412580 1.482707 0.374132 0.486389 0.409585 0.664613 0.728056 0.135717 1.017586 1.427256 0.114262 0.459920 0.985474 0.828118 0.029864 1.115880 0.182529 0.074455 0.121011 1.384155 1.498024 1.812648 0.488592 0.254186 1.880026 1.059948 0.152702 0.760476 0.236696 1.396118 1.492214 0.743805 1.035917 1.060796 0.484826 0.509085 -0.305704)
+ 9.421684 #r(0.000000 0.773463 -0.034237 0.815187 0.818292 -0.048506 -0.025177 1.145716 1.124687 -0.087471 0.982715 1.911529 0.885016 -0.169554 0.478422 0.410159 1.012688 0.169228 0.764485 0.758910 1.289872 0.618276 -0.229660 1.549110 0.758331 0.279930 1.553579 0.672439 0.162166 0.690601 0.847281 1.562839 1.023152 1.146052 1.063766 0.943600 -0.316637 0.816595 1.430319 0.223152 0.862408 0.935019 0.764642 0.942440 1.888157 1.614273 1.641359 1.139335 1.700104 1.516977 1.001915 0.698936 0.890613 1.412580 1.482707 0.374132 0.486389 0.409585 0.664613 0.728056 0.135717 1.017586 1.427256 0.114262 0.459920 0.985474 0.828118 0.029864 1.115880 0.182529 0.074455 0.121011 1.384155 1.498024 1.812648 0.488592 0.254186 1.880026 1.059948 0.152702 0.760476 0.236696 1.396118 1.492214 0.743805 1.035917 1.060796 0.484826 0.509085 -0.305704)
)
;;; 91 odd -------------------------------------------------------------------------------- ; 9.5394
-(vector 91 12.351367950439 #(0 1 0 1 1 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 0 0 1 0 0 1 1 1 1 1 0)
+(vector 91 12.351367950439 #r(0 1 0 1 1 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 0 0 1 0 0 1 1 1 1 1 0)
- 9.456608 #(0.000000 0.103422 0.965610 0.946880 1.775735 -0.122619 1.034051 0.168472 0.730448 0.272671 0.778481 0.021689 0.033093 0.984786 1.059637 0.145824 1.327186 1.317989 0.064861 1.738590 0.743092 0.115729 -0.009073 0.235258 1.253963 0.597261 1.473274 1.451939 1.654969 1.556762 -0.031925 0.584248 1.188923 1.752060 0.699420 0.272619 1.021928 1.546707 1.001394 0.687724 1.015815 0.834084 -0.085438 1.600278 0.991105 1.336531 1.547902 0.640465 0.462581 1.062100 1.213310 0.321259 0.291622 0.063730 0.566090 0.852786 0.847201 -0.174185 1.395263 1.222072 0.870150 0.708746 0.513822 0.978903 0.739358 1.760219 0.991895 1.423353 0.493188 0.952658 -0.084183 1.857020 1.060335 -0.192588 0.702407 1.144217 1.162221 1.656319 1.357097 0.810997 -0.196628 1.185541 1.692605 1.048778 1.191279 0.597890 1.575870 0.403387 0.283378 0.378021 0.172627)
+ 9.456608 #r(0.000000 0.103422 0.965610 0.946880 1.775735 -0.122619 1.034051 0.168472 0.730448 0.272671 0.778481 0.021689 0.033093 0.984786 1.059637 0.145824 1.327186 1.317989 0.064861 1.738590 0.743092 0.115729 -0.009073 0.235258 1.253963 0.597261 1.473274 1.451939 1.654969 1.556762 -0.031925 0.584248 1.188923 1.752060 0.699420 0.272619 1.021928 1.546707 1.001394 0.687724 1.015815 0.834084 -0.085438 1.600278 0.991105 1.336531 1.547902 0.640465 0.462581 1.062100 1.213310 0.321259 0.291622 0.063730 0.566090 0.852786 0.847201 -0.174185 1.395263 1.222072 0.870150 0.708746 0.513822 0.978903 0.739358 1.760219 0.991895 1.423353 0.493188 0.952658 -0.084183 1.857020 1.060335 -0.192588 0.702407 1.144217 1.162221 1.656319 1.357097 0.810997 -0.196628 1.185541 1.692605 1.048778 1.191279 0.597890 1.575870 0.403387 0.283378 0.378021 0.172627)
)
;;; 92 odd -------------------------------------------------------------------------------- ; 9.5916630
-(vector 92 12.280749613899 #(0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 0 0 0 1 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 1 1 0 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 1 0 1)
+(vector 92 12.280749613899 #r(0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 0 0 0 1 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 1 1 0 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 1 0 1)
- 9.552661 #(0.000000 1.217977 1.385618 0.939614 0.500483 1.851006 0.319542 1.708679 0.556310 0.891376 0.674923 0.365733 -0.175465 0.892985 1.540146 0.973262 0.317469 1.925159 0.685389 1.371188 0.200154 1.709968 0.177693 -0.300538 0.695154 0.829261 0.826887 0.518213 1.033752 1.220316 0.472703 1.153927 1.069740 0.054639 0.285291 1.692400 0.723359 -0.010143 1.422901 0.759732 0.421539 1.178988 0.292771 1.282542 0.969261 0.723210 1.587532 1.451565 0.985309 0.576854 0.032105 1.279589 0.637040 0.836814 1.053214 1.607968 0.083343 0.618958 1.664826 -0.072056 0.366474 1.110340 1.463534 0.789016 1.455017 1.061490 0.999534 0.659448 0.541265 1.191626 1.594463 0.899514 1.279707 0.844186 0.855539 -0.116804 0.909316 1.750334 1.598414 1.853269 0.368452 0.535158 0.818452 1.438032 0.503813 0.301666 0.154109 0.506999 0.079492 -0.057406 1.894913 0.600742)
+ 9.552661 #r(0.000000 1.217977 1.385618 0.939614 0.500483 1.851006 0.319542 1.708679 0.556310 0.891376 0.674923 0.365733 -0.175465 0.892985 1.540146 0.973262 0.317469 1.925159 0.685389 1.371188 0.200154 1.709968 0.177693 -0.300538 0.695154 0.829261 0.826887 0.518213 1.033752 1.220316 0.472703 1.153927 1.069740 0.054639 0.285291 1.692400 0.723359 -0.010143 1.422901 0.759732 0.421539 1.178988 0.292771 1.282542 0.969261 0.723210 1.587532 1.451565 0.985309 0.576854 0.032105 1.279589 0.637040 0.836814 1.053214 1.607968 0.083343 0.618958 1.664826 -0.072056 0.366474 1.110340 1.463534 0.789016 1.455017 1.061490 0.999534 0.659448 0.541265 1.191626 1.594463 0.899514 1.279707 0.844186 0.855539 -0.116804 0.909316 1.750334 1.598414 1.853269 0.368452 0.535158 0.818452 1.438032 0.503813 0.301666 0.154109 0.506999 0.079492 -0.057406 1.894913 0.600742)
)
;;; 93 odd -------------------------------------------------------------------------------- ; 9.6437
-(vector 93 12.403578299298 #(0 1 1 1 1 0 1 1 1 0 0 0 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 0 0 1 0 1 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 1 1 0 0 1 0 1 1 1)
+(vector 93 12.403578299298 #r(0 1 1 1 1 0 1 1 1 0 0 0 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 0 0 1 0 1 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 1 1 0 0 1 0 1 1 1)
- 9.628761 #(0.000000 1.192712 1.317592 0.793671 0.099933 -0.070495 0.916675 1.443504 0.876536 1.333886 0.502339 0.879490 0.963974 1.813405 1.616449 1.406560 0.249623 1.099165 1.684130 0.971324 1.504790 0.210004 -0.334645 1.442259 0.574758 1.021850 0.284510 0.399479 0.184247 1.487488 1.612401 -0.235561 -0.129797 0.178650 -0.371978 0.920412 -0.107159 0.561074 0.178586 0.184745 -0.019738 0.790773 0.250122 1.738768 1.375989 -0.216295 -0.331946 0.885688 1.988915 0.048056 0.095104 0.757409 -0.209034 0.574534 0.777126 1.337323 -0.015675 1.471677 1.723082 0.373584 0.844517 1.228790 1.358490 1.817661 1.097143 1.261125 0.949204 1.719884 0.720744 1.257519 0.078221 -0.091904 0.999562 0.486340 0.282135 0.639284 -0.163690 1.618168 0.349231 0.088441 0.985965 0.932832 1.613134 0.712978 1.300533 1.211114 1.605834 1.719815 0.768198 -0.076989 1.468170 1.231822 0.852206)
+ 9.628761 #r(0.000000 1.192712 1.317592 0.793671 0.099933 -0.070495 0.916675 1.443504 0.876536 1.333886 0.502339 0.879490 0.963974 1.813405 1.616449 1.406560 0.249623 1.099165 1.684130 0.971324 1.504790 0.210004 -0.334645 1.442259 0.574758 1.021850 0.284510 0.399479 0.184247 1.487488 1.612401 -0.235561 -0.129797 0.178650 -0.371978 0.920412 -0.107159 0.561074 0.178586 0.184745 -0.019738 0.790773 0.250122 1.738768 1.375989 -0.216295 -0.331946 0.885688 1.988915 0.048056 0.095104 0.757409 -0.209034 0.574534 0.777126 1.337323 -0.015675 1.471677 1.723082 0.373584 0.844517 1.228790 1.358490 1.817661 1.097143 1.261125 0.949204 1.719884 0.720744 1.257519 0.078221 -0.091904 0.999562 0.486340 0.282135 0.639284 -0.163690 1.618168 0.349231 0.088441 0.985965 0.932832 1.613134 0.712978 1.300533 1.211114 1.605834 1.719815 0.768198 -0.076989 1.468170 1.231822 0.852206)
)
;;; 94 odd -------------------------------------------------------------------------------- ; 9.6954
-(vector 94 12.789479876738 #(0 1 0 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 1 0 1 0 1 1)
+(vector 94 12.789479876738 #r(0 1 0 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 1 0 1 0 1 1)
- 9.653914 #(0.000000 1.588712 0.970594 0.765681 0.768893 0.708013 1.088997 0.348116 1.304828 0.302466 0.484457 0.598101 1.195823 1.750495 0.723696 -0.394564 1.399290 0.440079 0.957225 0.110914 1.178680 -1.746723 0.306178 1.424281 0.083938 -0.026412 0.531864 1.282735 0.186630 0.411663 1.537740 0.224065 -0.422374 0.338118 1.366092 0.348038 0.469097 0.358167 1.178154 1.072296 0.953715 0.778556 0.718707 0.831159 0.966980 0.639988 0.294231 -0.156503 1.325326 0.192979 0.424804 0.332961 0.198719 0.405180 1.172779 0.251315 0.565156 0.903572 0.754645 0.195819 1.584153 1.274227 0.370217 1.346701 0.041617 1.218979 0.515044 1.085194 0.964032 1.907141 0.492814 1.684100 -0.290159 1.467461 0.104316 0.280575 0.761449 1.432721 1.137691 0.132533 1.823280 1.230711 -0.052109 1.493267 1.265211 0.071008 1.206644 0.630379 0.639830 0.932228 -0.085525 1.738146 1.623323 0.751204)
+ 9.653914 #r(0.000000 1.588712 0.970594 0.765681 0.768893 0.708013 1.088997 0.348116 1.304828 0.302466 0.484457 0.598101 1.195823 1.750495 0.723696 -0.394564 1.399290 0.440079 0.957225 0.110914 1.178680 -1.746723 0.306178 1.424281 0.083938 -0.026412 0.531864 1.282735 0.186630 0.411663 1.537740 0.224065 -0.422374 0.338118 1.366092 0.348038 0.469097 0.358167 1.178154 1.072296 0.953715 0.778556 0.718707 0.831159 0.966980 0.639988 0.294231 -0.156503 1.325326 0.192979 0.424804 0.332961 0.198719 0.405180 1.172779 0.251315 0.565156 0.903572 0.754645 0.195819 1.584153 1.274227 0.370217 1.346701 0.041617 1.218979 0.515044 1.085194 0.964032 1.907141 0.492814 1.684100 -0.290159 1.467461 0.104316 0.280575 0.761449 1.432721 1.137691 0.132533 1.823280 1.230711 -0.052109 1.493267 1.265211 0.071008 1.206644 0.630379 0.639830 0.932228 -0.085525 1.738146 1.623323 0.751204)
)
;;; 95 odd -------------------------------------------------------------------------------- ; 9.7468
-(vector 95 12.575266058635 #(0 1 1 0 1 0 1 0 1 1 1 0 0 0 1 0 1 0 0 0 1 0 0 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 1 0 1 1 1 1 1 0 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 1 1 0 0 0 0 1 0 0 0)
+(vector 95 12.575266058635 #r(0 1 1 0 1 0 1 0 1 1 1 0 0 0 1 0 1 0 0 0 1 0 0 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 1 0 1 1 1 1 1 0 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 1 1 0 0 0 0 1 0 0 0)
- 9.716924 #(0.000000 1.295576 0.051583 -0.370221 1.659103 1.560139 0.883258 1.136184 1.446082 0.336165 0.984827 1.426922 1.840974 1.223315 0.635432 0.990680 0.332450 0.247993 0.361771 1.193162 0.200656 1.699397 1.071493 0.299430 0.743325 0.167398 0.140913 0.844624 1.382714 1.375685 0.647006 0.229451 0.386840 1.780080 0.889230 1.061105 0.116922 0.567648 1.435830 1.255231 0.833620 1.820993 1.158323 0.868650 0.833531 0.419654 1.734245 1.273400 1.062531 1.460253 0.175543 0.639252 0.712611 1.085237 0.872288 1.639660 -0.093743 0.087045 -0.323684 1.687923 1.002234 -0.168363 1.044853 -0.114093 1.195353 -0.026012 0.883764 1.512322 0.102179 0.114077 1.256119 1.084835 0.251990 0.992344 0.663746 0.903707 0.809231 1.141845 1.353235 1.559958 0.119755 1.444404 1.912417 1.220976 -0.164602 -0.295612 1.393445 0.425402 1.426929 1.201811 0.614353 -0.027563 1.025805 1.054465 0.134046)
+ 9.716924 #r(0.000000 1.295576 0.051583 -0.370221 1.659103 1.560139 0.883258 1.136184 1.446082 0.336165 0.984827 1.426922 1.840974 1.223315 0.635432 0.990680 0.332450 0.247993 0.361771 1.193162 0.200656 1.699397 1.071493 0.299430 0.743325 0.167398 0.140913 0.844624 1.382714 1.375685 0.647006 0.229451 0.386840 1.780080 0.889230 1.061105 0.116922 0.567648 1.435830 1.255231 0.833620 1.820993 1.158323 0.868650 0.833531 0.419654 1.734245 1.273400 1.062531 1.460253 0.175543 0.639252 0.712611 1.085237 0.872288 1.639660 -0.093743 0.087045 -0.323684 1.687923 1.002234 -0.168363 1.044853 -0.114093 1.195353 -0.026012 0.883764 1.512322 0.102179 0.114077 1.256119 1.084835 0.251990 0.992344 0.663746 0.903707 0.809231 1.141845 1.353235 1.559958 0.119755 1.444404 1.912417 1.220976 -0.164602 -0.295612 1.393445 0.425402 1.426929 1.201811 0.614353 -0.027563 1.025805 1.054465 0.134046)
)
;;; 96 odd -------------------------------------------------------------------------------- ; 9.7980
-(vector 96 12.803173065186 #(0 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 1 1 0)
+(vector 96 12.803173065186 #r(0 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 1 1 0)
- 9.759447 #(0.000000 0.435576 1.538976 0.230825 0.102821 0.263319 0.997316 0.091618 0.472323 -0.103132 0.585027 1.906149 0.670612 1.002137 1.281685 0.083578 0.271396 0.433634 0.733402 0.099534 0.807149 -0.070119 0.575530 -0.103613 0.335070 1.262648 1.473382 0.330894 0.589593 0.216256 0.350636 1.350446 1.836442 1.560161 1.205882 0.649393 0.812682 0.141066 1.111869 -0.141497 1.693969 1.777393 0.080165 0.375196 0.449681 -0.067423 0.754077 0.868345 1.797143 0.793576 0.568117 0.646818 1.350309 1.187659 1.791215 0.862642 1.742949 1.213798 0.583814 0.650546 0.965237 1.015772 0.605956 0.144297 0.285298 -0.351085 1.282066 0.474001 0.642725 0.511289 1.457452 0.929763 1.241810 0.227521 0.228779 1.199150 1.811444 -0.006366 0.744946 0.179491 1.361847 -0.378016 1.423650 1.452225 1.393417 1.335482 0.037183 1.548694 0.890495 0.461455 1.744132 0.896894 0.307836 1.812808 0.221251 0.928513)
+ 9.759447 #r(0.000000 0.435576 1.538976 0.230825 0.102821 0.263319 0.997316 0.091618 0.472323 -0.103132 0.585027 1.906149 0.670612 1.002137 1.281685 0.083578 0.271396 0.433634 0.733402 0.099534 0.807149 -0.070119 0.575530 -0.103613 0.335070 1.262648 1.473382 0.330894 0.589593 0.216256 0.350636 1.350446 1.836442 1.560161 1.205882 0.649393 0.812682 0.141066 1.111869 -0.141497 1.693969 1.777393 0.080165 0.375196 0.449681 -0.067423 0.754077 0.868345 1.797143 0.793576 0.568117 0.646818 1.350309 1.187659 1.791215 0.862642 1.742949 1.213798 0.583814 0.650546 0.965237 1.015772 0.605956 0.144297 0.285298 -0.351085 1.282066 0.474001 0.642725 0.511289 1.457452 0.929763 1.241810 0.227521 0.228779 1.199150 1.811444 -0.006366 0.744946 0.179491 1.361847 -0.378016 1.423650 1.452225 1.393417 1.335482 0.037183 1.548694 0.890495 0.461455 1.744132 0.896894 0.307836 1.812808 0.221251 0.928513)
)
;;; 97 odd -------------------------------------------------------------------------------- ; 9.8489
-(vector 97 12.837450993031 #(0 0 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 1 0 0 1 1 0 0 1 1 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 1 0 0 0 1 0 1 0 0 1 1 0 1 1)
+(vector 97 12.837450993031 #r(0 0 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 1 0 0 1 1 0 0 1 1 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 1 0 0 0 1 0 1 0 0 1 1 0 1 1)
- 9.832277 #(0.000000 0.379259 1.470054 0.135241 -0.137798 1.476571 0.223942 1.269139 1.617761 0.578479 1.659896 0.192321 0.628723 1.030748 0.068332 0.935772 0.702035 -0.308246 0.093619 0.687832 0.312122 0.952725 0.646784 0.815901 0.600402 0.700649 0.257079 0.728929 1.512814 0.133748 -0.161439 1.667289 1.756964 0.419090 1.460039 1.221568 0.216587 0.357346 0.560096 0.621329 1.423958 -0.140419 -0.285305 1.752977 0.296245 1.796763 0.502171 1.837539 -0.068388 -0.176521 1.655407 0.652714 1.571976 1.231728 0.781936 1.899698 1.696905 1.070324 0.093931 0.071079 0.376824 0.772939 1.099059 0.004831 0.221806 1.727680 0.800189 0.011067 0.690398 0.512420 0.475317 0.941280 1.720146 1.587206 0.923080 0.792083 0.180477 -0.133205 1.214230 1.814657 0.679279 0.282075 1.334889 1.751170 1.536951 0.882536 0.418450 0.834681 -0.026902 0.654794 0.680161 1.077779 1.525535 0.824205 1.102618 0.673911 -0.106249)
+ 9.832277 #r(0.000000 0.379259 1.470054 0.135241 -0.137798 1.476571 0.223942 1.269139 1.617761 0.578479 1.659896 0.192321 0.628723 1.030748 0.068332 0.935772 0.702035 -0.308246 0.093619 0.687832 0.312122 0.952725 0.646784 0.815901 0.600402 0.700649 0.257079 0.728929 1.512814 0.133748 -0.161439 1.667289 1.756964 0.419090 1.460039 1.221568 0.216587 0.357346 0.560096 0.621329 1.423958 -0.140419 -0.285305 1.752977 0.296245 1.796763 0.502171 1.837539 -0.068388 -0.176521 1.655407 0.652714 1.571976 1.231728 0.781936 1.899698 1.696905 1.070324 0.093931 0.071079 0.376824 0.772939 1.099059 0.004831 0.221806 1.727680 0.800189 0.011067 0.690398 0.512420 0.475317 0.941280 1.720146 1.587206 0.923080 0.792083 0.180477 -0.133205 1.214230 1.814657 0.679279 0.282075 1.334889 1.751170 1.536951 0.882536 0.418450 0.834681 -0.026902 0.654794 0.680161 1.077779 1.525535 0.824205 1.102618 0.673911 -0.106249)
)
;;; 98 odd -------------------------------------------------------------------------------- ; 9.8995
-(vector 98 12.972 #(0 0 1 1 1 0 1 1 0 1 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 1 1 1 0 0 0 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 1 0)
+(vector 98 12.972 #r(0 0 1 1 1 0 1 1 0 1 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 1 1 1 0 0 0 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 1 0)
- 9.918320 #(0.000000 1.126272 0.810135 -0.157043 -0.284411 1.014546 1.656515 0.886620 0.589412 -0.165849 0.041656 1.689870 -0.133502 1.386309 0.753684 1.607028 0.455527 0.729530 1.603812 -0.176801 0.980471 1.557823 1.120428 0.608500 -0.040856 1.654422 1.694414 1.546900 1.545046 0.721205 0.133219 1.189224 1.204719 1.195353 1.299299 -0.156627 0.826681 -0.088693 0.692437 1.036020 0.358333 1.488711 1.027717 0.069063 1.141577 0.328360 0.719016 0.851669 0.356065 0.712122 1.039551 1.236061 1.577925 0.317909 -0.158255 0.050224 -0.509790 1.519264 0.203085 -0.063235 0.037529 0.962155 1.059331 0.698574 0.810336 0.743673 1.683751 0.457113 0.419520 0.759860 1.462788 1.502247 0.636526 0.416346 0.963144 1.154048 0.694553 0.104918 -0.349860 1.108892 1.631062 0.589884 1.392769 1.258082 0.568391 0.753256 1.211016 0.009043 0.817095 0.265385 1.455548 1.585953 1.547698 1.855964 1.737942 0.229735 1.055700 1.696455)
+ 9.918320 #r(0.000000 1.126272 0.810135 -0.157043 -0.284411 1.014546 1.656515 0.886620 0.589412 -0.165849 0.041656 1.689870 -0.133502 1.386309 0.753684 1.607028 0.455527 0.729530 1.603812 -0.176801 0.980471 1.557823 1.120428 0.608500 -0.040856 1.654422 1.694414 1.546900 1.545046 0.721205 0.133219 1.189224 1.204719 1.195353 1.299299 -0.156627 0.826681 -0.088693 0.692437 1.036020 0.358333 1.488711 1.027717 0.069063 1.141577 0.328360 0.719016 0.851669 0.356065 0.712122 1.039551 1.236061 1.577925 0.317909 -0.158255 0.050224 -0.509790 1.519264 0.203085 -0.063235 0.037529 0.962155 1.059331 0.698574 0.810336 0.743673 1.683751 0.457113 0.419520 0.759860 1.462788 1.502247 0.636526 0.416346 0.963144 1.154048 0.694553 0.104918 -0.349860 1.108892 1.631062 0.589884 1.392769 1.258082 0.568391 0.753256 1.211016 0.009043 0.817095 0.265385 1.455548 1.585953 1.547698 1.855964 1.737942 0.229735 1.055700 1.696455)
;; pp:
- 9.852643 #(0.000000 0.515219 1.262972 1.697020 0.335436 0.889905 1.519089 0.044736 0.650497 1.270750 -0.178917 0.674989 1.450432 0.254900 1.097572 -0.107043 0.651195 1.335130 0.272796 1.297874 0.224159 0.962708 0.053062 1.193382 0.101327 0.836439 -0.105754 1.215012 0.128574 1.109391 0.442046 1.523411 0.553345 1.725474 0.541762 -0.127793 1.417975 0.631717 1.576620 0.767281 0.059112 1.609436 1.033347 0.556109 1.727081 1.010442 0.702568 -0.141336 1.349027 0.669399 0.583528 0.147350 1.497924 0.934945 0.610721 0.101044 -0.019997 1.772284 1.165297 0.883648 0.540756 0.695909 0.051843 0.036770 1.823953 1.940217 1.253231 1.381574 1.135330 0.962885 1.084109 1.188033 1.135270 0.827723 0.748628 1.126276 1.272339 0.770370 1.246808 1.223016 1.570254 1.399310 1.628085 1.829166 -0.154940 0.353005 0.721669 0.726808 0.892330 1.197955 1.533013 0.212675 0.669097 1.140181 1.156217 1.790457 0.422623 0.510791)
+ 9.852643 #r(0.000000 0.515219 1.262972 1.697020 0.335436 0.889905 1.519089 0.044736 0.650497 1.270750 -0.178917 0.674989 1.450432 0.254900 1.097572 -0.107043 0.651195 1.335130 0.272796 1.297874 0.224159 0.962708 0.053062 1.193382 0.101327 0.836439 -0.105754 1.215012 0.128574 1.109391 0.442046 1.523411 0.553345 1.725474 0.541762 -0.127793 1.417975 0.631717 1.576620 0.767281 0.059112 1.609436 1.033347 0.556109 1.727081 1.010442 0.702568 -0.141336 1.349027 0.669399 0.583528 0.147350 1.497924 0.934945 0.610721 0.101044 -0.019997 1.772284 1.165297 0.883648 0.540756 0.695909 0.051843 0.036770 1.823953 1.940217 1.253231 1.381574 1.135330 0.962885 1.084109 1.188033 1.135270 0.827723 0.748628 1.126276 1.272339 0.770370 1.246808 1.223016 1.570254 1.399310 1.628085 1.829166 -0.154940 0.353005 0.721669 0.726808 0.892330 1.197955 1.533013 0.212675 0.669097 1.140181 1.156217 1.790457 0.422623 0.510791)
)
;;; 99 odd -------------------------------------------------------------------------------- ; 9.9499
-(vector 99 13.000000000002 #(0 1 0 1 1 0 1 0 0 1 1 1 1 0 1 0 0 1 0 1 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 0 0 0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 1 1 0)
+(vector 99 13.000000000002 #r(0 1 0 1 1 0 1 0 0 1 1 1 1 0 1 0 0 1 0 1 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 0 0 0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 1 1 0)
- 9.927757 #(0.000000 0.612324 0.079141 1.434202 1.000660 0.891242 1.012263 -0.017562 0.996629 0.611063 1.321217 1.621637 1.504948 1.624898 0.001412 0.412734 0.326019 1.366721 1.072960 0.116515 0.715979 -0.740444 1.161301 1.297736 1.041757 0.027020 1.458453 1.107119 0.363908 1.415543 1.763457 0.255777 0.686434 -0.085735 0.651473 1.217063 -0.047283 1.151992 0.790695 -0.152103 1.647917 0.508714 0.628648 1.408143 1.292464 0.474000 1.003650 0.520847 0.629804 0.218082 0.785490 -0.232867 0.391411 1.172299 0.273141 1.313231 0.427739 0.013232 0.516032 0.610598 1.282766 1.029342 0.967918 1.073490 0.454858 0.915907 0.522595 0.274119 0.827376 0.861574 -0.158909 -0.432703 1.871750 1.122982 0.647824 -0.195710 0.262542 1.053968 0.565099 0.024117 0.401586 0.264805 1.587960 -0.370184 1.152346 1.774247 0.242656 0.316777 1.195086 1.067518 1.112347 0.688842 1.446613 0.608318 1.321142 -0.167020 0.907334 1.022140 1.062351)
+ 9.927757 #r(0.000000 0.612324 0.079141 1.434202 1.000660 0.891242 1.012263 -0.017562 0.996629 0.611063 1.321217 1.621637 1.504948 1.624898 0.001412 0.412734 0.326019 1.366721 1.072960 0.116515 0.715979 -0.740444 1.161301 1.297736 1.041757 0.027020 1.458453 1.107119 0.363908 1.415543 1.763457 0.255777 0.686434 -0.085735 0.651473 1.217063 -0.047283 1.151992 0.790695 -0.152103 1.647917 0.508714 0.628648 1.408143 1.292464 0.474000 1.003650 0.520847 0.629804 0.218082 0.785490 -0.232867 0.391411 1.172299 0.273141 1.313231 0.427739 0.013232 0.516032 0.610598 1.282766 1.029342 0.967918 1.073490 0.454858 0.915907 0.522595 0.274119 0.827376 0.861574 -0.158909 -0.432703 1.871750 1.122982 0.647824 -0.195710 0.262542 1.053968 0.565099 0.024117 0.401586 0.264805 1.587960 -0.370184 1.152346 1.774247 0.242656 0.316777 1.195086 1.067518 1.112347 0.688842 1.446613 0.608318 1.321142 -0.167020 0.907334 1.022140 1.062351)
)
;;; 100 odd -------------------------------------------------------------------------------- ; 10
-(vector 100 13.117680368039 #(0 1 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 1 1 1 0 0 0 0 0 0)
+(vector 100 13.117680368039 #r(0 1 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 1 1 1 0 0 0 0 0 0)
- 9.967820 #(0.000000 1.016486 1.075466 0.675161 0.574401 1.527303 0.369311 1.093743 1.758162 0.649535 1.329616 0.683289 -0.464743 0.488528 0.846167 1.093202 0.188464 -0.009742 1.328398 -0.092736 0.866724 1.306141 0.236206 -0.048398 0.065984 1.250377 0.880265 0.529903 1.908284 0.909975 0.870318 1.170730 0.401807 0.051428 1.546047 -0.084383 1.553645 1.723234 -0.192262 -0.005451 0.846559 1.396413 0.793410 1.734419 0.268618 0.782362 0.300041 0.085963 0.406528 -0.058412 0.759019 0.311738 0.688186 1.163736 0.207596 0.957152 0.518038 -0.238894 1.966069 0.254028 0.497859 0.406362 0.948142 0.108565 0.809242 0.618274 0.008503 1.224166 0.619792 -0.063172 1.170177 1.631095 0.360399 0.496092 1.173684 1.571576 1.461266 0.250954 0.485376 0.293914 0.241987 0.266855 1.299097 1.747740 -0.157940 1.025403 0.055859 0.443647 -0.030039 1.366811 0.369467 1.523632 1.262832 1.148761 0.265795 -0.397124 0.678718 0.978216 1.111928 1.121642)
+ 9.967820 #r(0.000000 1.016486 1.075466 0.675161 0.574401 1.527303 0.369311 1.093743 1.758162 0.649535 1.329616 0.683289 -0.464743 0.488528 0.846167 1.093202 0.188464 -0.009742 1.328398 -0.092736 0.866724 1.306141 0.236206 -0.048398 0.065984 1.250377 0.880265 0.529903 1.908284 0.909975 0.870318 1.170730 0.401807 0.051428 1.546047 -0.084383 1.553645 1.723234 -0.192262 -0.005451 0.846559 1.396413 0.793410 1.734419 0.268618 0.782362 0.300041 0.085963 0.406528 -0.058412 0.759019 0.311738 0.688186 1.163736 0.207596 0.957152 0.518038 -0.238894 1.966069 0.254028 0.497859 0.406362 0.948142 0.108565 0.809242 0.618274 0.008503 1.224166 0.619792 -0.063172 1.170177 1.631095 0.360399 0.496092 1.173684 1.571576 1.461266 0.250954 0.485376 0.293914 0.241987 0.266855 1.299097 1.747740 -0.157940 1.025403 0.055859 0.443647 -0.030039 1.366811 0.369467 1.523632 1.262832 1.148761 0.265795 -0.397124 0.678718 0.978216 1.111928 1.121642)
)
;;; 101 odd -------------------------------------------------------------------------------- ; 10.0499
-(vector 101 13.28250751675 #(0 1 1 1 0 0 1 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 0 1 1 0 1 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 1)
+(vector 101 13.28250751675 #r(0 1 1 1 0 0 1 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 0 1 1 0 1 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 1)
- 9.964634 #(0.000000 -0.073111 1.535769 -0.102555 0.949824 0.661791 1.376397 0.389320 1.429271 1.382915 0.702074 0.190023 0.165010 0.880936 1.053717 0.381858 1.515003 1.204543 0.504035 0.920455 0.391206 0.949414 1.113429 0.554900 1.897469 1.768789 1.766679 1.550589 0.402518 0.254763 0.394916 1.625563 0.833640 0.744524 0.452145 -0.082936 0.892795 1.873582 1.781184 -0.418454 1.636196 -0.022737 0.903335 -0.412208 1.924024 0.194797 -0.087158 0.651748 1.188278 0.341571 0.583987 1.814760 1.207941 1.789448 0.551284 0.991618 0.259118 0.282624 1.011184 1.611901 1.372798 1.012968 0.839711 1.331909 1.264042 0.325794 0.343316 -0.075857 -0.460634 0.488689 1.512646 1.806638 1.012723 -0.303497 1.575625 0.027198 0.002241 1.290806 1.657896 1.438044 0.654010 1.150362 0.652919 1.476118 -0.053999 -0.024155 0.726437 0.454484 1.497660 0.765182 0.287065 1.425963 0.079052 0.750136 1.836142 1.337567 -0.185862 1.924720 -0.153672 0.400041 1.450120)
+ 9.964634 #r(0.000000 -0.073111 1.535769 -0.102555 0.949824 0.661791 1.376397 0.389320 1.429271 1.382915 0.702074 0.190023 0.165010 0.880936 1.053717 0.381858 1.515003 1.204543 0.504035 0.920455 0.391206 0.949414 1.113429 0.554900 1.897469 1.768789 1.766679 1.550589 0.402518 0.254763 0.394916 1.625563 0.833640 0.744524 0.452145 -0.082936 0.892795 1.873582 1.781184 -0.418454 1.636196 -0.022737 0.903335 -0.412208 1.924024 0.194797 -0.087158 0.651748 1.188278 0.341571 0.583987 1.814760 1.207941 1.789448 0.551284 0.991618 0.259118 0.282624 1.011184 1.611901 1.372798 1.012968 0.839711 1.331909 1.264042 0.325794 0.343316 -0.075857 -0.460634 0.488689 1.512646 1.806638 1.012723 -0.303497 1.575625 0.027198 0.002241 1.290806 1.657896 1.438044 0.654010 1.150362 0.652919 1.476118 -0.053999 -0.024155 0.726437 0.454484 1.497660 0.765182 0.287065 1.425963 0.079052 0.750136 1.836142 1.337567 -0.185862 1.924720 -0.153672 0.400041 1.450120)
)
;;; 102 odd -------------------------------------------------------------------------------- ; 10.0995
-(vector 102 13.159336831147 #(0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0)
+(vector 102 13.159336831147 #r(0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0)
- 10.045766 #(0.000000 -0.279070 0.173878 0.081403 1.768938 1.607495 0.603256 0.555897 0.375867 1.098499 0.557935 1.658062 0.679353 0.435605 1.704584 0.882188 0.675710 1.226519 -0.017413 0.221732 -0.211376 1.307302 0.689909 0.655783 0.993058 0.615004 1.764502 1.131327 0.119482 0.185094 1.035751 1.439320 1.373211 1.418236 0.503946 0.310742 0.195150 1.345393 1.645648 0.392993 0.050135 0.685592 0.243679 0.754096 0.965418 1.162001 1.767714 0.912263 1.540226 0.989163 0.153496 1.180193 0.495181 0.826820 -0.194339 1.268780 1.482827 -0.154668 1.003093 0.057371 1.563631 1.606126 0.908893 1.017810 0.439667 -0.174146 0.280275 0.399111 1.342959 -0.098826 1.087834 1.050762 0.557805 0.752893 -0.400427 0.095731 0.689016 0.552247 0.778927 0.058727 0.428406 0.269116 0.480708 0.192361 0.563638 0.686642 0.128600 1.864221 -0.045520 1.018032 1.780635 -0.005046 0.881801 1.021244 0.513775 1.482476 0.956890 0.518235 1.186738 -0.018819 1.609204 0.515712)
+ 10.045766 #r(0.000000 -0.279070 0.173878 0.081403 1.768938 1.607495 0.603256 0.555897 0.375867 1.098499 0.557935 1.658062 0.679353 0.435605 1.704584 0.882188 0.675710 1.226519 -0.017413 0.221732 -0.211376 1.307302 0.689909 0.655783 0.993058 0.615004 1.764502 1.131327 0.119482 0.185094 1.035751 1.439320 1.373211 1.418236 0.503946 0.310742 0.195150 1.345393 1.645648 0.392993 0.050135 0.685592 0.243679 0.754096 0.965418 1.162001 1.767714 0.912263 1.540226 0.989163 0.153496 1.180193 0.495181 0.826820 -0.194339 1.268780 1.482827 -0.154668 1.003093 0.057371 1.563631 1.606126 0.908893 1.017810 0.439667 -0.174146 0.280275 0.399111 1.342959 -0.098826 1.087834 1.050762 0.557805 0.752893 -0.400427 0.095731 0.689016 0.552247 0.778927 0.058727 0.428406 0.269116 0.480708 0.192361 0.563638 0.686642 0.128600 1.864221 -0.045520 1.018032 1.780635 -0.005046 0.881801 1.021244 0.513775 1.482476 0.956890 0.518235 1.186738 -0.018819 1.609204 0.515712)
)
;;; 103 odd -------------------------------------------------------------------------------- ; 10.1489
-(vector 103 13.142812158651 #(0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 1 0 0 1 1 0 1 1 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 1 0 1 0 1)
+(vector 103 13.142812158651 #r(0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 1 0 0 1 1 0 1 1 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 1 0 1 0 1)
- 10.102476 #(0.000000 1.369258 0.406430 1.487363 1.300312 1.174178 0.725871 1.118946 0.567934 1.507074 1.421940 0.060397 1.553534 0.366960 0.264364 -0.027869 1.681923 0.350717 1.364154 0.204515 -0.180262 0.842363 0.287472 1.198426 1.756374 1.259211 0.898266 0.187309 0.401610 0.535873 0.048012 0.851696 1.323060 0.925186 0.678890 0.097118 1.570744 0.545725 0.858166 1.853728 0.291531 1.096726 1.166849 -0.045402 1.179837 -0.111020 0.643454 0.486562 1.084325 0.673411 1.808268 0.331853 0.761303 0.506929 0.948787 0.125433 1.093138 1.172704 1.300823 -0.087765 1.061422 -0.231489 1.345595 1.007175 0.463207 0.567128 0.417701 0.867458 1.827132 1.618306 -0.235698 1.268358 1.413906 0.291274 -0.510359 1.287040 0.555326 0.694591 1.555786 1.225983 1.844314 0.908000 0.867329 0.232081 1.454227 0.972019 1.069240 0.133107 0.915878 0.821231 0.471133 1.434428 0.215881 0.667043 0.772841 0.944850 1.153588 0.551253 0.882554 1.134378 0.032596 -0.042233 1.758816)
+ 10.102476 #r(0.000000 1.369258 0.406430 1.487363 1.300312 1.174178 0.725871 1.118946 0.567934 1.507074 1.421940 0.060397 1.553534 0.366960 0.264364 -0.027869 1.681923 0.350717 1.364154 0.204515 -0.180262 0.842363 0.287472 1.198426 1.756374 1.259211 0.898266 0.187309 0.401610 0.535873 0.048012 0.851696 1.323060 0.925186 0.678890 0.097118 1.570744 0.545725 0.858166 1.853728 0.291531 1.096726 1.166849 -0.045402 1.179837 -0.111020 0.643454 0.486562 1.084325 0.673411 1.808268 0.331853 0.761303 0.506929 0.948787 0.125433 1.093138 1.172704 1.300823 -0.087765 1.061422 -0.231489 1.345595 1.007175 0.463207 0.567128 0.417701 0.867458 1.827132 1.618306 -0.235698 1.268358 1.413906 0.291274 -0.510359 1.287040 0.555326 0.694591 1.555786 1.225983 1.844314 0.908000 0.867329 0.232081 1.454227 0.972019 1.069240 0.133107 0.915878 0.821231 0.471133 1.434428 0.215881 0.667043 0.772841 0.944850 1.153588 0.551253 0.882554 1.134378 0.032596 -0.042233 1.758816)
)
;;; 104 odd -------------------------------------------------------------------------------- ; 10.1980
-(vector 104 13.176067352295 #(0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 0 1 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1 0 0 1 1 1 1 0)
+(vector 104 13.176067352295 #r(0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 0 1 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1 0 0 1 1 1 1 0)
- 10.168550 #(0.000000 0.863337 -0.113966 0.952335 1.179324 1.344589 0.086001 1.784568 0.040939 -0.278342 0.492392 1.373041 1.589416 0.305140 1.040154 0.306852 0.639739 1.605433 -0.082316 1.171614 0.018705 0.877480 0.742834 1.013469 -0.394587 0.679538 1.685340 1.015860 0.451982 1.273683 0.656961 1.380347 0.930414 0.629931 0.875751 1.106458 0.854029 1.097615 0.942886 1.634232 -0.087153 1.214976 0.912099 1.026106 0.377766 0.938615 0.980356 0.179306 0.223817 1.145177 1.622990 0.100820 0.989970 1.826246 0.934306 0.310115 -0.012658 0.179983 -0.026220 0.755024 0.027968 0.662514 0.819461 1.633236 1.403644 1.156857 1.356308 1.542286 1.253871 1.012715 0.852908 0.924116 0.022097 0.368327 -0.090612 1.052696 -0.034185 0.655336 -0.097080 -0.157717 1.261805 0.337757 0.457703 1.158886 1.296591 0.128958 1.630443 0.809473 0.920747 1.393423 0.696288 0.328360 1.336354 1.510499 1.486152 1.947494 0.779240 0.349685 0.612445 1.433252 1.461547 0.826387 0.679858 -0.337976)
+ 10.168550 #r(0.000000 0.863337 -0.113966 0.952335 1.179324 1.344589 0.086001 1.784568 0.040939 -0.278342 0.492392 1.373041 1.589416 0.305140 1.040154 0.306852 0.639739 1.605433 -0.082316 1.171614 0.018705 0.877480 0.742834 1.013469 -0.394587 0.679538 1.685340 1.015860 0.451982 1.273683 0.656961 1.380347 0.930414 0.629931 0.875751 1.106458 0.854029 1.097615 0.942886 1.634232 -0.087153 1.214976 0.912099 1.026106 0.377766 0.938615 0.980356 0.179306 0.223817 1.145177 1.622990 0.100820 0.989970 1.826246 0.934306 0.310115 -0.012658 0.179983 -0.026220 0.755024 0.027968 0.662514 0.819461 1.633236 1.403644 1.156857 1.356308 1.542286 1.253871 1.012715 0.852908 0.924116 0.022097 0.368327 -0.090612 1.052696 -0.034185 0.655336 -0.097080 -0.157717 1.261805 0.337757 0.457703 1.158886 1.296591 0.128958 1.630443 0.809473 0.920747 1.393423 0.696288 0.328360 1.336354 1.510499 1.486152 1.947494 0.779240 0.349685 0.612445 1.433252 1.461547 0.826387 0.679858 -0.337976)
)
;;; 105 odd -------------------------------------------------------------------------------- ; 10.2470
-(vector 105 13.491228801467 #(0 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 0 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 0 1 0 0 1 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 1 1 0 0 1 1 0 0 0)
+(vector 105 13.491228801467 #r(0 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 0 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 0 1 0 0 1 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 1 1 0 0 1 1 0 0 0)
- 10.115828 #(0.000000 0.049019 1.344835 1.091641 0.665700 0.968893 0.648602 0.707898 1.514354 1.538919 0.526334 1.493761 1.624995 0.707437 0.593803 0.874212 1.543010 1.853745 0.426397 0.026573 1.615940 1.506593 0.465693 1.159200 -0.404908 1.664358 0.782410 1.352302 -0.234654 1.360029 1.390064 0.562127 0.900595 -0.305834 1.198378 1.369945 1.005775 0.397773 0.628843 1.626964 0.837449 1.061154 1.446306 1.380391 1.599960 0.270806 1.328543 -0.187842 -0.215850 0.275407 1.674813 1.481684 0.685411 -0.076514 1.172112 0.021028 -0.282040 0.805083 0.169438 0.519532 1.238467 0.912197 -0.108203 0.770912 1.223603 1.260598 0.243317 1.416653 -0.085803 1.793597 1.018898 0.209596 0.637018 0.680644 1.218601 -0.251927 1.342315 0.794662 0.530948 1.151958 0.965018 0.768542 0.003792 0.487969 1.528116 0.185132 1.582165 0.376426 0.269883 0.979543 1.678175 1.757906 1.492507 0.386900 1.219606 0.328787 1.292795 -0.100060 0.401454 0.164930 0.339091 0.226350 0.418706 -0.115549 1.296351)
+ 10.115828 #r(0.000000 0.049019 1.344835 1.091641 0.665700 0.968893 0.648602 0.707898 1.514354 1.538919 0.526334 1.493761 1.624995 0.707437 0.593803 0.874212 1.543010 1.853745 0.426397 0.026573 1.615940 1.506593 0.465693 1.159200 -0.404908 1.664358 0.782410 1.352302 -0.234654 1.360029 1.390064 0.562127 0.900595 -0.305834 1.198378 1.369945 1.005775 0.397773 0.628843 1.626964 0.837449 1.061154 1.446306 1.380391 1.599960 0.270806 1.328543 -0.187842 -0.215850 0.275407 1.674813 1.481684 0.685411 -0.076514 1.172112 0.021028 -0.282040 0.805083 0.169438 0.519532 1.238467 0.912197 -0.108203 0.770912 1.223603 1.260598 0.243317 1.416653 -0.085803 1.793597 1.018898 0.209596 0.637018 0.680644 1.218601 -0.251927 1.342315 0.794662 0.530948 1.151958 0.965018 0.768542 0.003792 0.487969 1.528116 0.185132 1.582165 0.376426 0.269883 0.979543 1.678175 1.757906 1.492507 0.386900 1.219606 0.328787 1.292795 -0.100060 0.401454 0.164930 0.339091 0.226350 0.418706 -0.115549 1.296351)
)
;;; 106 odd -------------------------------------------------------------------------------- ; 10.2956
-(vector 106 13.091135978699 #(0 0 0 0 1 0 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 0 1 1 1 0 1 1 1 1 1 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 0 0 1 0 0 0 1 0 1 1 0 0 0 0 0 1 1 1 0 1 1 1 0)
+(vector 106 13.091135978699 #r(0 0 0 0 1 0 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 0 1 1 1 0 1 1 1 1 1 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 0 0 1 0 0 0 1 0 1 1 0 0 0 0 0 1 1 1 0 1 1 1 0)
- 10.198335 #(0.000000 0.831679 1.059524 0.595983 0.203261 1.202829 1.655547 1.163399 0.731912 1.050991 -0.085268 1.049064 0.669107 0.707558 1.587356 0.103456 0.095032 1.177165 1.677580 0.458849 0.488238 1.294418 -0.328225 1.742764 0.960376 0.232688 1.221102 1.139466 1.165521 0.274312 -0.217213 1.769983 -0.106435 0.980799 0.424668 1.120797 1.738923 1.408831 0.326124 1.349134 0.307375 0.275240 0.392410 1.221176 0.352509 0.866366 0.344959 0.656333 0.909394 0.940268 0.976614 0.141881 0.684412 0.786921 -0.062121 -0.010568 1.690036 -0.088688 1.427313 -0.052874 1.785355 0.109989 0.958795 1.179624 0.324837 1.229886 1.616903 1.768092 1.318950 1.675999 1.563712 0.225381 0.575251 0.774252 -0.022742 1.783220 1.405786 0.332796 1.613495 1.352845 1.308309 0.373980 1.918112 1.162561 0.910064 1.737277 1.152808 -0.033675 0.058425 1.406045 -0.253836 0.991335 1.479963 0.005130 1.832773 0.614974 0.073456 1.352269 1.161897 0.192184 0.857686 0.091488 0.263380 1.392944 0.202339 1.603064)
+ 10.198335 #r(0.000000 0.831679 1.059524 0.595983 0.203261 1.202829 1.655547 1.163399 0.731912 1.050991 -0.085268 1.049064 0.669107 0.707558 1.587356 0.103456 0.095032 1.177165 1.677580 0.458849 0.488238 1.294418 -0.328225 1.742764 0.960376 0.232688 1.221102 1.139466 1.165521 0.274312 -0.217213 1.769983 -0.106435 0.980799 0.424668 1.120797 1.738923 1.408831 0.326124 1.349134 0.307375 0.275240 0.392410 1.221176 0.352509 0.866366 0.344959 0.656333 0.909394 0.940268 0.976614 0.141881 0.684412 0.786921 -0.062121 -0.010568 1.690036 -0.088688 1.427313 -0.052874 1.785355 0.109989 0.958795 1.179624 0.324837 1.229886 1.616903 1.768092 1.318950 1.675999 1.563712 0.225381 0.575251 0.774252 -0.022742 1.783220 1.405786 0.332796 1.613495 1.352845 1.308309 0.373980 1.918112 1.162561 0.910064 1.737277 1.152808 -0.033675 0.058425 1.406045 -0.253836 0.991335 1.479963 0.005130 1.832773 0.614974 0.073456 1.352269 1.161897 0.192184 0.857686 0.091488 0.263380 1.392944 0.202339 1.603064)
)
;;; 107 odd -------------------------------------------------------------------------------- ; 10.3441
-(vector 107 13.537808159641 #(0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 1 1 1 0 1)
+(vector 107 13.537808159641 #r(0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 1 1 1 0 1)
- 10.295953 #(0.000000 1.453513 1.655211 0.102988 0.785431 1.249929 -0.025066 1.750838 0.347673 1.604380 1.551092 0.115495 1.639861 1.667898 0.228709 1.701673 0.201321 1.045139 -0.312647 0.175688 0.855996 0.160415 1.472612 0.763114 0.800624 0.361142 1.295288 0.490786 -0.039842 -0.032740 0.339591 1.592008 0.669279 0.117545 -0.109117 1.018536 0.901071 0.716433 0.346971 1.020475 -0.173945 0.889314 0.077058 1.765220 1.318363 1.591641 1.626283 0.012132 1.508938 0.471426 0.670071 1.171727 0.339306 0.138717 0.336161 0.439088 1.260263 -0.187548 0.396198 0.258209 0.100455 1.039650 0.818140 1.958400 1.117502 0.697124 1.567939 -0.332396 0.783424 1.205431 0.709006 -0.344647 0.483889 0.499549 -0.063258 0.695169 0.972581 0.387305 1.779513 -0.022586 1.856190 0.369348 0.297097 0.538965 0.115827 0.894957 1.816307 1.006210 1.611567 -0.212466 -0.136556 0.733243 0.881259 0.131239 1.843996 -0.064517 1.632049 0.217595 1.203085 0.867259 0.064249 0.691138 1.782204 1.811114 1.580857 1.070340 1.558270)
+ 10.295953 #r(0.000000 1.453513 1.655211 0.102988 0.785431 1.249929 -0.025066 1.750838 0.347673 1.604380 1.551092 0.115495 1.639861 1.667898 0.228709 1.701673 0.201321 1.045139 -0.312647 0.175688 0.855996 0.160415 1.472612 0.763114 0.800624 0.361142 1.295288 0.490786 -0.039842 -0.032740 0.339591 1.592008 0.669279 0.117545 -0.109117 1.018536 0.901071 0.716433 0.346971 1.020475 -0.173945 0.889314 0.077058 1.765220 1.318363 1.591641 1.626283 0.012132 1.508938 0.471426 0.670071 1.171727 0.339306 0.138717 0.336161 0.439088 1.260263 -0.187548 0.396198 0.258209 0.100455 1.039650 0.818140 1.958400 1.117502 0.697124 1.567939 -0.332396 0.783424 1.205431 0.709006 -0.344647 0.483889 0.499549 -0.063258 0.695169 0.972581 0.387305 1.779513 -0.022586 1.856190 0.369348 0.297097 0.538965 0.115827 0.894957 1.816307 1.006210 1.611567 -0.212466 -0.136556 0.733243 0.881259 0.131239 1.843996 -0.064517 1.632049 0.217595 1.203085 0.867259 0.064249 0.691138 1.782204 1.811114 1.580857 1.070340 1.558270)
)
;;; 108 odd -------------------------------------------------------------------------------- ; 10.3923
-(vector 108 13.472808406168 #(0 1 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 1 1 0 1 0 0 0 1 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 0 0 1 0 0 0 1 0 1 1 0 0 0 1 0 1 0 0 1 0)
+(vector 108 13.472808406168 #r(0 1 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 1 1 0 1 0 0 0 1 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 0 0 1 0 0 0 1 0 1 1 0 0 0 1 0 1 0 0 1 0)
- 10.325467 #(0.000000 1.823999 0.121670 1.358801 0.589768 1.029967 -0.433790 1.041582 -1.274122 0.780646 -0.169734 1.604597 1.010159 1.810789 0.632723 -0.206688 0.463178 1.073646 1.521165 -0.178712 1.523791 0.423100 0.144424 0.899019 -0.452142 0.547962 0.895764 1.662227 0.346193 1.471302 -0.164671 -1.901696 0.406602 0.262326 0.474119 -0.030228 1.801622 1.325384 1.588387 0.343116 0.445611 0.273212 0.831258 1.871029 -0.312461 1.896993 1.025139 0.721577 0.726171 0.338346 0.861017 1.378901 0.847116 0.469202 -0.383235 0.452023 -0.496006 1.102062 1.102044 1.646809 0.311243 -0.456688 0.949926 0.520943 0.921326 0.643117 0.781598 1.182150 0.966506 0.456713 0.498859 1.075971 1.927079 0.160322 0.159648 0.419881 0.925743 0.446322 0.326978 1.459788 0.903977 -0.021458 1.063237 1.175806 1.223175 0.258595 0.623246 1.572004 0.621332 1.978290 1.546402 1.672410 0.423727 1.205710 1.436589 0.182917 0.251425 0.718333 -1.375705 0.497395 0.186440 0.550196 0.272118 1.380692 1.012574 0.305814 1.433937 0.098087)
+ 10.325467 #r(0.000000 1.823999 0.121670 1.358801 0.589768 1.029967 -0.433790 1.041582 -1.274122 0.780646 -0.169734 1.604597 1.010159 1.810789 0.632723 -0.206688 0.463178 1.073646 1.521165 -0.178712 1.523791 0.423100 0.144424 0.899019 -0.452142 0.547962 0.895764 1.662227 0.346193 1.471302 -0.164671 -1.901696 0.406602 0.262326 0.474119 -0.030228 1.801622 1.325384 1.588387 0.343116 0.445611 0.273212 0.831258 1.871029 -0.312461 1.896993 1.025139 0.721577 0.726171 0.338346 0.861017 1.378901 0.847116 0.469202 -0.383235 0.452023 -0.496006 1.102062 1.102044 1.646809 0.311243 -0.456688 0.949926 0.520943 0.921326 0.643117 0.781598 1.182150 0.966506 0.456713 0.498859 1.075971 1.927079 0.160322 0.159648 0.419881 0.925743 0.446322 0.326978 1.459788 0.903977 -0.021458 1.063237 1.175806 1.223175 0.258595 0.623246 1.572004 0.621332 1.978290 1.546402 1.672410 0.423727 1.205710 1.436589 0.182917 0.251425 0.718333 -1.375705 0.497395 0.186440 0.550196 0.272118 1.380692 1.012574 0.305814 1.433937 0.098087)
)
;;; 109 odd -------------------------------------------------------------------------------- ; 10.4403
-(vector 109 13.798 #(0 0 1 0 1 0 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 1 0 1 0 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 0 1 0 1 1 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 0 1 0 0 0 1 0 1 0 0 1 1 0 0)
+(vector 109 13.798 #r(0 0 1 0 1 0 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 1 0 1 0 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 0 1 0 1 1 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 0 1 0 0 0 1 0 1 0 0 1 1 0 0)
- 10.413972 #(0.000000 -0.329332 1.852441 0.301192 0.479205 1.938689 1.086891 1.271023 0.729396 1.367900 1.483662 1.203078 1.940935 0.158023 0.999249 1.513297 0.973974 0.871966 0.600005 0.917499 0.064963 1.625056 1.204390 0.450307 0.459827 1.379619 0.277893 0.390957 1.292297 1.095127 0.941246 0.509853 0.476400 1.479425 1.214972 0.999425 1.144172 0.402758 1.277806 -1.541834 1.224224 0.408937 -0.140267 1.012505 1.167342 0.593542 1.500901 0.801861 0.428256 0.363108 1.278773 0.897271 1.754344 0.238279 0.787476 1.405582 1.439989 1.293816 1.237720 0.491493 1.514000 1.092355 0.055457 1.477338 0.699004 0.040279 0.957508 1.786210 0.481649 0.726028 0.215740 0.216870 1.343437 -0.395385 1.669265 -0.047054 1.724398 0.984510 0.441756 -0.012720 0.257871 1.485641 -0.121426 0.687863 0.835502 1.004805 1.663485 0.780698 1.042433 1.097029 1.089236 1.689246 1.096756 0.293532 0.899560 -0.005695 0.471699 1.241990 1.396400 -0.542444 0.294633 1.091314 0.356171 0.908370 0.648337 1.936350 -0.128643 0.053871 0.188853)
+ 10.413972 #r(0.000000 -0.329332 1.852441 0.301192 0.479205 1.938689 1.086891 1.271023 0.729396 1.367900 1.483662 1.203078 1.940935 0.158023 0.999249 1.513297 0.973974 0.871966 0.600005 0.917499 0.064963 1.625056 1.204390 0.450307 0.459827 1.379619 0.277893 0.390957 1.292297 1.095127 0.941246 0.509853 0.476400 1.479425 1.214972 0.999425 1.144172 0.402758 1.277806 -1.541834 1.224224 0.408937 -0.140267 1.012505 1.167342 0.593542 1.500901 0.801861 0.428256 0.363108 1.278773 0.897271 1.754344 0.238279 0.787476 1.405582 1.439989 1.293816 1.237720 0.491493 1.514000 1.092355 0.055457 1.477338 0.699004 0.040279 0.957508 1.786210 0.481649 0.726028 0.215740 0.216870 1.343437 -0.395385 1.669265 -0.047054 1.724398 0.984510 0.441756 -0.012720 0.257871 1.485641 -0.121426 0.687863 0.835502 1.004805 1.663485 0.780698 1.042433 1.097029 1.089236 1.689246 1.096756 0.293532 0.899560 -0.005695 0.471699 1.241990 1.396400 -0.542444 0.294633 1.091314 0.356171 0.908370 0.648337 1.936350 -0.128643 0.053871 0.188853)
)
;;; 110 odd -------------------------------------------------------------------------------- ; 10.4881
-(vector 110 13.576010454591 #(0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 0)
+(vector 110 13.576010454591 #r(0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 0)
- 10.408073 #(0.000000 1.583299 1.129147 0.924363 0.405386 0.106463 0.654471 1.235816 1.676675 1.424024 -0.320821 -0.106137 1.651584 1.223458 1.376470 0.070578 0.035561 0.618393 1.591071 1.247092 1.420738 1.407145 1.068993 1.180774 1.368120 -0.309458 -0.227815 -0.257077 0.341569 0.189699 1.898096 1.209271 -0.362341 0.480813 1.176223 1.497789 1.567432 0.970389 -0.047452 0.764481 1.364232 1.546603 0.838685 0.519999 0.785088 1.840526 0.201375 0.694162 0.995107 0.138310 0.417265 -0.004223 1.430441 0.548174 0.456155 0.879102 0.021026 0.612402 1.448544 1.143273 1.475463 0.804075 0.821149 0.175404 1.164546 0.079156 1.149637 1.448505 1.656091 1.757415 0.521205 0.257194 1.707629 0.482292 1.377093 0.507438 0.991226 -0.612661 0.868064 0.306724 0.414844 0.138628 0.061298 1.129023 1.487975 0.706799 -0.099480 1.383589 0.290834 1.123787 -0.072238 0.982011 0.038233 1.760058 0.405531 0.016972 -0.604791 1.005236 1.670267 -0.215358 1.779967 0.879139 0.413047 1.290874 0.860692 0.804540 1.190191 0.135277 0.110128 0.732322)
+ 10.408073 #r(0.000000 1.583299 1.129147 0.924363 0.405386 0.106463 0.654471 1.235816 1.676675 1.424024 -0.320821 -0.106137 1.651584 1.223458 1.376470 0.070578 0.035561 0.618393 1.591071 1.247092 1.420738 1.407145 1.068993 1.180774 1.368120 -0.309458 -0.227815 -0.257077 0.341569 0.189699 1.898096 1.209271 -0.362341 0.480813 1.176223 1.497789 1.567432 0.970389 -0.047452 0.764481 1.364232 1.546603 0.838685 0.519999 0.785088 1.840526 0.201375 0.694162 0.995107 0.138310 0.417265 -0.004223 1.430441 0.548174 0.456155 0.879102 0.021026 0.612402 1.448544 1.143273 1.475463 0.804075 0.821149 0.175404 1.164546 0.079156 1.149637 1.448505 1.656091 1.757415 0.521205 0.257194 1.707629 0.482292 1.377093 0.507438 0.991226 -0.612661 0.868064 0.306724 0.414844 0.138628 0.061298 1.129023 1.487975 0.706799 -0.099480 1.383589 0.290834 1.123787 -0.072238 0.982011 0.038233 1.760058 0.405531 0.016972 -0.604791 1.005236 1.670267 -0.215358 1.779967 0.879139 0.413047 1.290874 0.860692 0.804540 1.190191 0.135277 0.110128 0.732322)
)
;;; 111 odd -------------------------------------------------------------------------------- ; 10.5357
-(vector 111 13.709900383304 #(0 0 0 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 1 1 1 0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0)
+(vector 111 13.709900383304 #r(0 0 0 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 1 1 1 0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0)
- 10.588903 #(0.000000 0.083293 0.444830 -0.213766 0.524915 -0.005956 1.175907 0.783294 -0.343790 -0.015069 1.676924 0.021997 -0.012805 1.023472 0.864450 1.922773 1.431731 1.374839 1.561767 1.633583 0.198147 0.245727 1.910466 0.995751 0.091514 1.666123 0.750477 1.953152 1.512135 0.025831 0.969938 0.804619 0.507564 0.688555 -0.027332 1.433090 0.812479 0.893934 1.245019 0.835304 0.404414 0.839838 0.338429 -0.112731 0.636982 0.099621 1.080987 1.292673 0.177317 1.292327 1.284755 0.253860 0.748555 1.591323 1.605479 0.445460 1.332537 -0.181589 1.668331 0.627699 0.074537 0.208177 0.135644 0.846946 0.614940 0.479986 0.443281 0.299879 1.767930 1.411021 -0.391645 0.057816 1.376551 1.471560 -0.203049 0.453124 0.061036 0.704839 1.379390 1.848624 0.771131 -0.036797 0.007834 1.611881 1.733830 0.412751 1.415257 0.544650 1.539165 0.414455 1.242586 0.195280 0.522916 0.859907 1.238816 -0.090313 -0.027707 -0.025034 0.375248 1.748950 1.440534 1.222909 0.018270 -0.118073 0.275708 1.112569 0.089742 1.167857 1.617530 0.755934 0.450427)
+ 10.588903 #r(0.000000 0.083293 0.444830 -0.213766 0.524915 -0.005956 1.175907 0.783294 -0.343790 -0.015069 1.676924 0.021997 -0.012805 1.023472 0.864450 1.922773 1.431731 1.374839 1.561767 1.633583 0.198147 0.245727 1.910466 0.995751 0.091514 1.666123 0.750477 1.953152 1.512135 0.025831 0.969938 0.804619 0.507564 0.688555 -0.027332 1.433090 0.812479 0.893934 1.245019 0.835304 0.404414 0.839838 0.338429 -0.112731 0.636982 0.099621 1.080987 1.292673 0.177317 1.292327 1.284755 0.253860 0.748555 1.591323 1.605479 0.445460 1.332537 -0.181589 1.668331 0.627699 0.074537 0.208177 0.135644 0.846946 0.614940 0.479986 0.443281 0.299879 1.767930 1.411021 -0.391645 0.057816 1.376551 1.471560 -0.203049 0.453124 0.061036 0.704839 1.379390 1.848624 0.771131 -0.036797 0.007834 1.611881 1.733830 0.412751 1.415257 0.544650 1.539165 0.414455 1.242586 0.195280 0.522916 0.859907 1.238816 -0.090313 -0.027707 -0.025034 0.375248 1.748950 1.440534 1.222909 0.018270 -0.118073 0.275708 1.112569 0.089742 1.167857 1.617530 0.755934 0.450427)
;; pp:
- 10.417134 #(0.000000 0.334233 1.073081 1.649039 0.219597 0.888802 1.379829 0.088335 0.555458 1.328032 1.801862 0.615319 1.429043 0.326004 0.993452 1.804613 0.545160 1.317910 1.885616 0.678140 1.509274 0.323491 1.236504 0.282786 1.199970 0.195704 1.232493 0.160017 0.897560 -0.082586 1.086392 0.182366 1.277299 0.339072 1.485948 0.630905 1.802953 0.832621 -0.132126 1.110982 0.486291 1.681037 0.774846 -0.032051 1.638442 0.870514 -0.093334 1.333411 0.747525 0.167590 1.347374 0.845491 0.233833 1.720211 1.112373 0.655737 0.273424 1.815808 1.225426 0.609827 0.164644 -0.241753 1.556306 1.087036 0.843899 0.560878 -0.058558 1.838311 1.465620 1.239758 1.091378 0.528065 0.791149 0.332440 0.584210 0.055836 0.449981 1.753070 0.093654 1.657239 1.503059 1.399887 1.433488 1.544146 1.513188 1.637379 1.822882 1.796041 1.687813 1.720729 1.754274 -0.098151 -0.072877 0.197474 0.504171 0.827563 1.033490 1.323144 1.356797 1.748728 -0.150347 0.352269 0.632744 0.932570 1.684081 0.187586 0.495859 1.035344 1.327590 1.648341 0.358056)
+ 10.417134 #r(0.000000 0.334233 1.073081 1.649039 0.219597 0.888802 1.379829 0.088335 0.555458 1.328032 1.801862 0.615319 1.429043 0.326004 0.993452 1.804613 0.545160 1.317910 1.885616 0.678140 1.509274 0.323491 1.236504 0.282786 1.199970 0.195704 1.232493 0.160017 0.897560 -0.082586 1.086392 0.182366 1.277299 0.339072 1.485948 0.630905 1.802953 0.832621 -0.132126 1.110982 0.486291 1.681037 0.774846 -0.032051 1.638442 0.870514 -0.093334 1.333411 0.747525 0.167590 1.347374 0.845491 0.233833 1.720211 1.112373 0.655737 0.273424 1.815808 1.225426 0.609827 0.164644 -0.241753 1.556306 1.087036 0.843899 0.560878 -0.058558 1.838311 1.465620 1.239758 1.091378 0.528065 0.791149 0.332440 0.584210 0.055836 0.449981 1.753070 0.093654 1.657239 1.503059 1.399887 1.433488 1.544146 1.513188 1.637379 1.822882 1.796041 1.687813 1.720729 1.754274 -0.098151 -0.072877 0.197474 0.504171 0.827563 1.033490 1.323144 1.356797 1.748728 -0.150347 0.352269 0.632744 0.932570 1.684081 0.187586 0.495859 1.035344 1.327590 1.648341 0.358056)
)
;;; 112 odd -------------------------------------------------------------------------------- ; 10.5830
-(vector 112 13.92684841156 #(0 0 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 1 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 0 0 1 1 0 0 1)
+(vector 112 13.92684841156 #r(0 0 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 1 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 0 0 1 1 0 0 1)
;; 10.58293147
- 10.582025 #(0.000000 0.311823 0.137469 0.765085 0.247252 0.880370 1.452735 0.240993 1.506478 0.780197 1.183194 1.086565 0.032933 1.780577 0.281098 0.764676 0.712557 1.579682 1.277796 1.238223 1.014207 -0.140323 1.716730 1.644672 1.253593 0.578221 0.527661 0.367318 1.131386 1.012757 0.285059 0.010509 0.097401 1.699590 0.802620 1.600737 0.550167 1.026747 0.562219 0.378187 0.150437 0.522055 0.022316 1.717789 0.186746 1.186644 0.914782 0.563095 1.653911 0.869696 0.117700 1.053735 0.935756 -0.055221 0.653101 1.059195 -0.397205 1.469022 0.238158 0.393902 0.410251 0.955768 1.001018 1.337003 0.602349 0.798689 0.307413 -0.479763 0.463243 1.296128 0.608105 0.417995 0.073111 0.291455 0.483686 0.231728 0.630836 1.131231 -0.228753 0.669521 1.185569 -0.089761 1.130815 0.778132 1.502582 1.555252 1.149912 0.577946 0.284522 1.467470 0.172271 0.275044 1.633737 1.228854 0.152388 0.342365 1.574177 0.099351 0.042391 1.025180 1.146998 1.437785 0.647927 1.566576 1.091754 1.532311 1.602420 0.887895 1.387294 0.660060 1.356768 -0.056782)
+ 10.582025 #r(0.000000 0.311823 0.137469 0.765085 0.247252 0.880370 1.452735 0.240993 1.506478 0.780197 1.183194 1.086565 0.032933 1.780577 0.281098 0.764676 0.712557 1.579682 1.277796 1.238223 1.014207 -0.140323 1.716730 1.644672 1.253593 0.578221 0.527661 0.367318 1.131386 1.012757 0.285059 0.010509 0.097401 1.699590 0.802620 1.600737 0.550167 1.026747 0.562219 0.378187 0.150437 0.522055 0.022316 1.717789 0.186746 1.186644 0.914782 0.563095 1.653911 0.869696 0.117700 1.053735 0.935756 -0.055221 0.653101 1.059195 -0.397205 1.469022 0.238158 0.393902 0.410251 0.955768 1.001018 1.337003 0.602349 0.798689 0.307413 -0.479763 0.463243 1.296128 0.608105 0.417995 0.073111 0.291455 0.483686 0.231728 0.630836 1.131231 -0.228753 0.669521 1.185569 -0.089761 1.130815 0.778132 1.502582 1.555252 1.149912 0.577946 0.284522 1.467470 0.172271 0.275044 1.633737 1.228854 0.152388 0.342365 1.574177 0.099351 0.042391 1.025180 1.146998 1.437785 0.647927 1.566576 1.091754 1.532311 1.602420 0.887895 1.387294 0.660060 1.356768 -0.056782)
)
;;; 113 odd -------------------------------------------------------------------------------- ; 10.6301
-(vector 113 13.825498858186 #(0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 0 1 0 0)
+(vector 113 13.825498858186 #r(0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 0 1 0 0)
- 10.586426 #(0.000000 0.880973 0.176609 1.175777 0.325354 1.332354 0.320489 -0.071032 0.810398 1.764286 1.047524 1.891121 1.274870 -0.462450 -0.016593 1.802245 -0.046896 0.623724 0.697636 1.104725 0.928560 1.531658 1.767776 1.410783 1.560300 0.841358 1.754992 0.695860 1.109332 0.811865 0.787805 0.897767 0.126996 1.290009 1.439543 1.231735 0.428818 0.217484 1.274411 0.676699 0.491905 0.907831 0.251383 0.502017 0.436195 1.271188 0.390987 0.252204 1.423164 1.333446 1.284283 0.685749 0.387192 1.752967 0.379905 1.873082 0.147356 1.600693 0.620101 0.533661 0.873916 1.687058 0.856213 0.905702 0.279125 1.651302 0.425155 1.158445 0.384556 1.685623 1.738609 0.620191 0.166765 0.760816 0.887704 1.876641 1.612703 0.207434 0.310898 1.383166 0.834523 0.489910 -0.069256 0.030910 0.047326 1.374933 1.678060 0.495762 1.058376 0.337747 0.859288 0.994496 0.384200 0.735993 0.843904 0.381801 0.488130 0.839325 0.731059 1.159772 1.973051 0.569688 1.423018 1.561321 1.485614 0.834971 1.215611 1.015531 -0.080496 -0.203441 0.704520 0.652007 1.385821)
+ 10.586426 #r(0.000000 0.880973 0.176609 1.175777 0.325354 1.332354 0.320489 -0.071032 0.810398 1.764286 1.047524 1.891121 1.274870 -0.462450 -0.016593 1.802245 -0.046896 0.623724 0.697636 1.104725 0.928560 1.531658 1.767776 1.410783 1.560300 0.841358 1.754992 0.695860 1.109332 0.811865 0.787805 0.897767 0.126996 1.290009 1.439543 1.231735 0.428818 0.217484 1.274411 0.676699 0.491905 0.907831 0.251383 0.502017 0.436195 1.271188 0.390987 0.252204 1.423164 1.333446 1.284283 0.685749 0.387192 1.752967 0.379905 1.873082 0.147356 1.600693 0.620101 0.533661 0.873916 1.687058 0.856213 0.905702 0.279125 1.651302 0.425155 1.158445 0.384556 1.685623 1.738609 0.620191 0.166765 0.760816 0.887704 1.876641 1.612703 0.207434 0.310898 1.383166 0.834523 0.489910 -0.069256 0.030910 0.047326 1.374933 1.678060 0.495762 1.058376 0.337747 0.859288 0.994496 0.384200 0.735993 0.843904 0.381801 0.488130 0.839325 0.731059 1.159772 1.973051 0.569688 1.423018 1.561321 1.485614 0.834971 1.215611 1.015531 -0.080496 -0.203441 0.704520 0.652007 1.385821)
)
;;; 114 odd -------------------------------------------------------------------------------- ; 10.6771
-(vector 114 13.920305720092 #(0 0 1 0 1 1 0 0 1 0 1 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 0 0 0)
+(vector 114 13.920305720092 #r(0 0 1 0 1 1 0 0 1 0 1 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 0 0 0)
- 10.620769 #(0.000000 -0.265733 0.572658 0.316585 0.923883 1.614948 0.728669 0.692865 0.985653 1.596503 0.291068 0.153708 1.761462 0.140269 1.183433 -0.379854 1.503387 1.143776 0.747711 1.619251 0.404594 1.157009 0.378840 0.537946 0.751007 0.739900 0.914353 1.624008 0.450778 0.962869 0.588872 1.869278 0.721483 1.557011 0.902276 0.776013 1.285044 0.345048 1.685952 1.091106 0.263288 1.107778 -0.009439 0.420734 1.806464 1.410193 1.769595 1.251788 0.691963 1.604897 1.666646 1.531003 0.963757 -0.680527 1.705352 1.126307 -0.203837 0.277321 0.178995 1.809866 0.763029 0.031476 0.539819 0.755127 0.685061 1.837935 0.717076 1.848829 1.364997 0.950055 -0.061791 1.853324 0.123916 -0.136693 1.146568 0.362176 0.781284 1.598429 1.120688 1.139170 0.560329 -0.015310 0.331374 1.472918 0.199430 0.303861 1.321918 1.569172 1.548780 -0.090459 1.912266 0.810039 -0.152547 1.372081 1.425080 0.264711 1.614349 0.175290 0.789472 1.260114 1.370945 1.918464 1.489942 1.397616 0.963993 0.516634 0.516943 1.244942 0.283787 1.709141 1.616073 0.810759 1.316742 1.696489)
+ 10.620769 #r(0.000000 -0.265733 0.572658 0.316585 0.923883 1.614948 0.728669 0.692865 0.985653 1.596503 0.291068 0.153708 1.761462 0.140269 1.183433 -0.379854 1.503387 1.143776 0.747711 1.619251 0.404594 1.157009 0.378840 0.537946 0.751007 0.739900 0.914353 1.624008 0.450778 0.962869 0.588872 1.869278 0.721483 1.557011 0.902276 0.776013 1.285044 0.345048 1.685952 1.091106 0.263288 1.107778 -0.009439 0.420734 1.806464 1.410193 1.769595 1.251788 0.691963 1.604897 1.666646 1.531003 0.963757 -0.680527 1.705352 1.126307 -0.203837 0.277321 0.178995 1.809866 0.763029 0.031476 0.539819 0.755127 0.685061 1.837935 0.717076 1.848829 1.364997 0.950055 -0.061791 1.853324 0.123916 -0.136693 1.146568 0.362176 0.781284 1.598429 1.120688 1.139170 0.560329 -0.015310 0.331374 1.472918 0.199430 0.303861 1.321918 1.569172 1.548780 -0.090459 1.912266 0.810039 -0.152547 1.372081 1.425080 0.264711 1.614349 0.175290 0.789472 1.260114 1.370945 1.918464 1.489942 1.397616 0.963993 0.516634 0.516943 1.244942 0.283787 1.709141 1.616073 0.810759 1.316742 1.696489)
)
;;; 115 odd -------------------------------------------------------------------------------- ; 10.7238
-(vector 115 14.20306968689 #(0 1 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 0 1 1 1 0 0 1 1 0 1 0 1 1 1 0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 1 0 0 1 0 0 1 1 1 0 1 1 1)
+(vector 115 14.20306968689 #r(0 1 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 0 1 1 1 0 0 1 1 0 1 0 1 1 1 0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 1 0 0 1 0 0 1 1 1 0 1 1 1)
- 10.674304 #(0.000000 0.789887 -0.303859 -0.033056 0.759195 0.636525 0.248364 0.847489 1.259597 0.571635 0.950311 0.503307 0.311625 1.283873 0.845368 0.051963 1.567172 1.288876 0.243542 0.283164 1.566596 0.754789 1.490536 0.039434 0.168217 0.197813 0.961175 1.000724 0.173724 1.453836 -0.299975 0.087165 1.672267 1.098120 1.146505 0.379755 1.328375 0.651767 1.173825 0.650295 0.441141 0.865349 1.257754 -0.111945 0.068441 1.538745 0.068967 1.734610 1.208209 0.079563 -0.236732 0.216584 0.140036 0.340430 0.008574 0.036605 0.315028 0.890542 0.307266 0.065201 -0.267238 -0.016662 1.283003 0.528002 -0.402562 1.186323 0.829551 0.025932 0.882753 0.264357 1.091661 1.076730 -0.001406 0.040934 0.042083 1.567774 0.906679 0.687134 0.720339 0.063372 0.406664 1.457338 1.400253 1.359707 1.217492 0.090043 -0.918052 0.816288 1.443080 -0.046946 0.555663 0.622694 1.800570 0.513267 0.655836 0.746318 1.849833 1.129389 1.637640 0.403829 -0.005965 0.883415 0.100025 0.540813 0.541888 0.996530 1.501665 1.855318 1.257420 0.578586 0.925447 0.264080 0.596871 0.828008 0.353618)
+ 10.674304 #r(0.000000 0.789887 -0.303859 -0.033056 0.759195 0.636525 0.248364 0.847489 1.259597 0.571635 0.950311 0.503307 0.311625 1.283873 0.845368 0.051963 1.567172 1.288876 0.243542 0.283164 1.566596 0.754789 1.490536 0.039434 0.168217 0.197813 0.961175 1.000724 0.173724 1.453836 -0.299975 0.087165 1.672267 1.098120 1.146505 0.379755 1.328375 0.651767 1.173825 0.650295 0.441141 0.865349 1.257754 -0.111945 0.068441 1.538745 0.068967 1.734610 1.208209 0.079563 -0.236732 0.216584 0.140036 0.340430 0.008574 0.036605 0.315028 0.890542 0.307266 0.065201 -0.267238 -0.016662 1.283003 0.528002 -0.402562 1.186323 0.829551 0.025932 0.882753 0.264357 1.091661 1.076730 -0.001406 0.040934 0.042083 1.567774 0.906679 0.687134 0.720339 0.063372 0.406664 1.457338 1.400253 1.359707 1.217492 0.090043 -0.918052 0.816288 1.443080 -0.046946 0.555663 0.622694 1.800570 0.513267 0.655836 0.746318 1.849833 1.129389 1.637640 0.403829 -0.005965 0.883415 0.100025 0.540813 0.541888 0.996530 1.501665 1.855318 1.257420 0.578586 0.925447 0.264080 0.596871 0.828008 0.353618)
)
;;; 116 odd -------------------------------------------------------------------------------- ; 10.7703
-(vector 116 13.887789451571 #(0 0 1 0 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 0 1 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 1 0)
+(vector 116 13.887789451571 #r(0 0 1 0 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 0 1 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 1 0)
- 10.733274 #(0.000000 0.476000 1.878001 1.180059 0.831300 1.453614 0.786219 1.052031 1.218138 0.179523 0.743868 1.265853 0.031570 1.636184 -0.152324 0.778296 0.271634 1.469546 0.565495 1.807809 0.217280 0.159382 1.049221 0.170285 0.221763 0.774648 0.398259 0.637279 -0.107284 0.312805 1.776901 0.160502 1.717634 1.119938 1.391025 0.105351 1.023277 1.530674 1.548380 -0.251006 0.488559 1.544222 0.177807 0.661206 0.257716 1.053732 0.893027 1.445098 1.722088 0.002770 1.151812 1.061439 0.110999 0.865286 0.781438 1.277991 0.502793 0.943734 0.798521 1.333645 1.654972 1.679619 0.259243 0.886975 0.069664 1.517348 1.237826 1.551946 0.514540 1.258563 1.258071 1.027685 1.355844 1.909459 1.281504 1.171068 0.250655 1.622642 0.211675 1.522349 -0.092396 0.705855 1.861520 0.183629 0.746566 0.759808 0.250024 -0.159043 1.664858 0.237853 -0.217693 1.217376 1.459590 1.517349 1.206266 0.478670 -0.380779 0.210779 0.338305 1.433407 1.043804 0.854323 0.392836 1.702198 1.439694 -0.141576 1.283279 0.715495 0.734335 1.585749 1.775978 1.654290 -0.315773 0.174327 1.442380 0.993240)
+ 10.733274 #r(0.000000 0.476000 1.878001 1.180059 0.831300 1.453614 0.786219 1.052031 1.218138 0.179523 0.743868 1.265853 0.031570 1.636184 -0.152324 0.778296 0.271634 1.469546 0.565495 1.807809 0.217280 0.159382 1.049221 0.170285 0.221763 0.774648 0.398259 0.637279 -0.107284 0.312805 1.776901 0.160502 1.717634 1.119938 1.391025 0.105351 1.023277 1.530674 1.548380 -0.251006 0.488559 1.544222 0.177807 0.661206 0.257716 1.053732 0.893027 1.445098 1.722088 0.002770 1.151812 1.061439 0.110999 0.865286 0.781438 1.277991 0.502793 0.943734 0.798521 1.333645 1.654972 1.679619 0.259243 0.886975 0.069664 1.517348 1.237826 1.551946 0.514540 1.258563 1.258071 1.027685 1.355844 1.909459 1.281504 1.171068 0.250655 1.622642 0.211675 1.522349 -0.092396 0.705855 1.861520 0.183629 0.746566 0.759808 0.250024 -0.159043 1.664858 0.237853 -0.217693 1.217376 1.459590 1.517349 1.206266 0.478670 -0.380779 0.210779 0.338305 1.433407 1.043804 0.854323 0.392836 1.702198 1.439694 -0.141576 1.283279 0.715495 0.734335 1.585749 1.775978 1.654290 -0.315773 0.174327 1.442380 0.993240)
)
;;; 117 odd -------------------------------------------------------------------------------- ; 10.8167
-(vector 117 14.427604264985 #(0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 1 0 1 1)
+(vector 117 14.427604264985 #r(0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 1 0 1 1)
- 10.783290 #(0.000000 0.108967 0.680440 -0.039849 1.073915 0.982905 0.909467 1.470260 1.730853 0.840580 1.309090 0.612716 1.548112 -0.231227 1.489945 0.841297 1.245447 0.244987 0.849971 -0.022279 0.452974 0.810744 1.489407 1.567278 1.188237 0.772892 0.113419 0.906478 1.169175 -0.156676 0.507744 1.684543 1.686412 1.219650 1.843836 0.541605 0.346082 0.043904 -0.079283 1.469849 1.567795 0.179241 -0.068928 0.912255 0.602511 1.574715 0.695060 1.133392 -0.425958 0.610886 1.496396 0.865636 0.895412 1.362633 1.653811 1.404165 0.041681 1.692317 1.094403 0.739550 1.239428 0.479228 1.439160 0.986149 0.801910 1.514113 0.963332 0.281851 0.106127 1.599308 -0.004925 1.893302 1.411671 1.244923 0.383170 0.517813 0.421067 1.058052 0.153400 0.778671 0.754438 1.880309 0.023746 1.476647 0.081600 1.798573 0.432245 0.735923 0.440628 -0.064421 1.249491 0.136405 1.735439 1.868665 1.565831 0.435031 0.537457 0.904590 1.634892 1.124196 0.408216 0.769901 0.281419 1.398400 0.260352 0.021213 0.275268 0.681889 -0.074136 0.502025 0.237163 1.241676 1.638668 0.242962 0.026823 1.133262 1.452416)
+ 10.783290 #r(0.000000 0.108967 0.680440 -0.039849 1.073915 0.982905 0.909467 1.470260 1.730853 0.840580 1.309090 0.612716 1.548112 -0.231227 1.489945 0.841297 1.245447 0.244987 0.849971 -0.022279 0.452974 0.810744 1.489407 1.567278 1.188237 0.772892 0.113419 0.906478 1.169175 -0.156676 0.507744 1.684543 1.686412 1.219650 1.843836 0.541605 0.346082 0.043904 -0.079283 1.469849 1.567795 0.179241 -0.068928 0.912255 0.602511 1.574715 0.695060 1.133392 -0.425958 0.610886 1.496396 0.865636 0.895412 1.362633 1.653811 1.404165 0.041681 1.692317 1.094403 0.739550 1.239428 0.479228 1.439160 0.986149 0.801910 1.514113 0.963332 0.281851 0.106127 1.599308 -0.004925 1.893302 1.411671 1.244923 0.383170 0.517813 0.421067 1.058052 0.153400 0.778671 0.754438 1.880309 0.023746 1.476647 0.081600 1.798573 0.432245 0.735923 0.440628 -0.064421 1.249491 0.136405 1.735439 1.868665 1.565831 0.435031 0.537457 0.904590 1.634892 1.124196 0.408216 0.769901 0.281419 1.398400 0.260352 0.021213 0.275268 0.681889 -0.074136 0.502025 0.237163 1.241676 1.638668 0.242962 0.026823 1.133262 1.452416)
)
;;; 118 odd -------------------------------------------------------------------------------- ; 10.8628
-(vector 118 14.399567650824 #(0 1 0 0 0 1 0 0 1 0 0 1 1 0 0 0 1 1 1 1 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 0 0 0 1 1 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 1 1 0 1)
+(vector 118 14.399567650824 #r(0 1 0 0 0 1 0 0 1 0 0 1 1 0 0 0 1 1 1 1 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 0 0 0 1 1 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 1 1 0 1)
- 10.812235 #(0.000000 1.507972 1.809575 1.323971 0.671235 0.977919 0.397118 0.294709 0.400614 1.800046 0.492728 1.565979 -0.363038 1.100463 1.075231 0.502016 0.457037 0.406728 0.228418 0.756367 1.513939 0.347068 1.450936 0.868009 1.501709 0.352220 -0.413052 -0.148923 0.240400 1.115439 0.653043 -0.505473 -0.021974 1.853042 0.586305 0.428092 0.050201 0.752546 1.451411 1.228490 1.754283 1.881544 0.485306 1.754300 0.007006 0.163634 0.582385 0.998129 -0.090614 0.952205 1.425714 1.513296 1.570494 -0.259048 0.529336 1.498547 1.326491 -0.594238 1.538496 0.728657 0.444244 1.055319 1.385207 0.874327 0.074427 1.100816 1.734905 0.605814 1.533043 1.017063 0.482871 0.438583 1.108829 1.808956 0.029357 0.297016 -0.063569 0.780909 1.283400 0.359665 -0.032425 1.363808 0.687851 1.190450 1.438414 1.141910 1.126025 1.239471 0.136191 1.489911 1.026641 0.526687 0.890040 -0.022700 0.140687 -0.353757 1.164330 1.005641 0.099661 1.220163 1.081145 1.773078 1.376716 1.458019 0.703593 0.987305 1.493840 1.628605 0.957392 -0.054994 1.652856 0.431213 1.736293 -0.162073 0.279632 -0.110283 1.166212 1.877544)
+ 10.812235 #r(0.000000 1.507972 1.809575 1.323971 0.671235 0.977919 0.397118 0.294709 0.400614 1.800046 0.492728 1.565979 -0.363038 1.100463 1.075231 0.502016 0.457037 0.406728 0.228418 0.756367 1.513939 0.347068 1.450936 0.868009 1.501709 0.352220 -0.413052 -0.148923 0.240400 1.115439 0.653043 -0.505473 -0.021974 1.853042 0.586305 0.428092 0.050201 0.752546 1.451411 1.228490 1.754283 1.881544 0.485306 1.754300 0.007006 0.163634 0.582385 0.998129 -0.090614 0.952205 1.425714 1.513296 1.570494 -0.259048 0.529336 1.498547 1.326491 -0.594238 1.538496 0.728657 0.444244 1.055319 1.385207 0.874327 0.074427 1.100816 1.734905 0.605814 1.533043 1.017063 0.482871 0.438583 1.108829 1.808956 0.029357 0.297016 -0.063569 0.780909 1.283400 0.359665 -0.032425 1.363808 0.687851 1.190450 1.438414 1.141910 1.126025 1.239471 0.136191 1.489911 1.026641 0.526687 0.890040 -0.022700 0.140687 -0.353757 1.164330 1.005641 0.099661 1.220163 1.081145 1.773078 1.376716 1.458019 0.703593 0.987305 1.493840 1.628605 0.957392 -0.054994 1.652856 0.431213 1.736293 -0.162073 0.279632 -0.110283 1.166212 1.877544)
)
;;; 119 odd -------------------------------------------------------------------------------- ; 10.9087
-(vector 119 14.464 #(0 0 1 1 0 0 0 0 1 0 1 0 1 1 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 0 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 0 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1)
+(vector 119 14.464 #r(0 0 1 1 0 0 0 0 1 0 1 0 1 1 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 0 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 0 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1)
- 10.915923 #(0.000000 1.468971 -0.070109 0.743471 0.865207 0.740713 1.375563 1.856253 1.493876 0.001446 1.555119 1.873527 0.486379 1.616655 0.160602 1.367247 0.912321 0.764636 0.328487 -0.313335 0.385982 0.645370 0.408989 -0.210208 1.638205 0.329206 1.585495 1.658528 -0.015737 0.563000 0.062305 -0.007952 1.615694 0.120849 0.556636 1.351804 1.028805 0.044823 -0.249641 0.450875 -0.188130 1.054822 1.658005 0.732611 1.051144 0.181032 -0.061461 0.014104 0.174656 1.497989 1.287601 1.362445 0.209461 0.902894 1.389971 0.577406 1.285084 1.677882 0.836076 1.093131 -0.061912 0.754157 0.925122 0.984483 0.745399 1.783690 0.907228 0.093044 0.001514 0.775385 1.257954 1.480444 1.312457 1.195686 1.427916 1.726017 1.291212 1.845006 1.072451 0.380596 -0.077482 -0.030557 0.660125 1.346002 0.823989 0.235481 1.377946 1.450150 0.552324 0.398627 1.336527 0.073526 0.466630 0.590308 0.928946 0.828743 -0.154986 1.149963 0.492935 1.772069 0.204388 1.490853 -0.315475 0.097407 1.157089 0.698006 1.513716 1.488764 0.923673 0.108745 1.168110 0.729608 1.392132 1.740139 1.454066 0.757828 1.227068 0.584339 1.581610)
+ 10.915923 #r(0.000000 1.468971 -0.070109 0.743471 0.865207 0.740713 1.375563 1.856253 1.493876 0.001446 1.555119 1.873527 0.486379 1.616655 0.160602 1.367247 0.912321 0.764636 0.328487 -0.313335 0.385982 0.645370 0.408989 -0.210208 1.638205 0.329206 1.585495 1.658528 -0.015737 0.563000 0.062305 -0.007952 1.615694 0.120849 0.556636 1.351804 1.028805 0.044823 -0.249641 0.450875 -0.188130 1.054822 1.658005 0.732611 1.051144 0.181032 -0.061461 0.014104 0.174656 1.497989 1.287601 1.362445 0.209461 0.902894 1.389971 0.577406 1.285084 1.677882 0.836076 1.093131 -0.061912 0.754157 0.925122 0.984483 0.745399 1.783690 0.907228 0.093044 0.001514 0.775385 1.257954 1.480444 1.312457 1.195686 1.427916 1.726017 1.291212 1.845006 1.072451 0.380596 -0.077482 -0.030557 0.660125 1.346002 0.823989 0.235481 1.377946 1.450150 0.552324 0.398627 1.336527 0.073526 0.466630 0.590308 0.928946 0.828743 -0.154986 1.149963 0.492935 1.772069 0.204388 1.490853 -0.315475 0.097407 1.157089 0.698006 1.513716 1.488764 0.923673 0.108745 1.168110 0.729608 1.392132 1.740139 1.454066 0.757828 1.227068 0.584339 1.581610)
;; pp:
- 11.037707 #(0.000000 0.330663 0.977506 1.486310 0.146671 0.619852 1.212563 1.835260 0.429131 1.137767 1.722966 0.554725 1.336956 0.080712 0.852554 1.473118 0.165981 0.811544 1.502696 0.343077 1.371306 0.205531 0.905257 1.934366 1.020467 1.933150 0.730878 1.550089 0.565733 1.543669 0.452622 1.507940 0.734165 1.641237 0.799367 0.020448 1.044223 0.039537 1.305538 0.570880 1.458969 0.622353 1.797356 0.986890 0.251789 1.442933 0.753665 0.270337 1.533653 0.647011 -0.011278 1.435253 0.493723 -0.176024 1.395851 0.880365 0.222324 1.709439 1.376910 0.824516 0.330942 1.733291 1.350769 0.852276 0.247847 -0.101792 1.361637 1.450559 0.694333 0.792939 0.273393 1.916534 1.612649 1.136729 1.027650 0.745376 0.479123 0.468161 -0.088607 0.141257 1.721063 1.745485 1.474071 1.547129 1.195469 1.231545 0.976850 0.989136 1.181833 0.899203 1.200899 1.168317 1.143250 1.360858 1.307442 1.171633 1.402153 1.656644 1.531180 1.874515 0.028657 0.416186 0.465448 0.590264 1.056005 1.152867 1.387578 1.553815 0.076236 0.350372 0.561320 1.007917 1.385094 1.972832 0.449173 0.459147 1.193699 1.594244 0.056947)
+ 11.037707 #r(0.000000 0.330663 0.977506 1.486310 0.146671 0.619852 1.212563 1.835260 0.429131 1.137767 1.722966 0.554725 1.336956 0.080712 0.852554 1.473118 0.165981 0.811544 1.502696 0.343077 1.371306 0.205531 0.905257 1.934366 1.020467 1.933150 0.730878 1.550089 0.565733 1.543669 0.452622 1.507940 0.734165 1.641237 0.799367 0.020448 1.044223 0.039537 1.305538 0.570880 1.458969 0.622353 1.797356 0.986890 0.251789 1.442933 0.753665 0.270337 1.533653 0.647011 -0.011278 1.435253 0.493723 -0.176024 1.395851 0.880365 0.222324 1.709439 1.376910 0.824516 0.330942 1.733291 1.350769 0.852276 0.247847 -0.101792 1.361637 1.450559 0.694333 0.792939 0.273393 1.916534 1.612649 1.136729 1.027650 0.745376 0.479123 0.468161 -0.088607 0.141257 1.721063 1.745485 1.474071 1.547129 1.195469 1.231545 0.976850 0.989136 1.181833 0.899203 1.200899 1.168317 1.143250 1.360858 1.307442 1.171633 1.402153 1.656644 1.531180 1.874515 0.028657 0.416186 0.465448 0.590264 1.056005 1.152867 1.387578 1.553815 0.076236 0.350372 0.561320 1.007917 1.385094 1.972832 0.449173 0.459147 1.193699 1.594244 0.056947)
;; 118+1
- 10.815476 #(0.000000 1.511627 1.860509 1.251771 0.680390 0.954029 0.497464 0.422082 0.549359 1.789096 0.627036 1.559684 -0.285316 1.102920 1.110972 0.497639 0.358913 0.339963 0.170351 0.820368 1.613321 0.311453 1.667587 0.845824 1.477518 0.323382 -0.462336 -0.121701 0.278431 1.251253 0.730313 -0.512813 0.050332 1.905719 0.581701 0.491221 0.037053 0.850077 1.454447 1.218666 1.827857 1.931466 0.444700 1.716033 0.031317 0.208955 0.719947 1.025308 -0.162952 0.941579 1.416409 1.490055 1.661028 -0.177347 0.601149 1.427738 1.318738 -0.598055 1.513344 0.818145 0.331744 0.938565 1.416971 0.755203 0.134509 1.154206 1.729909 0.622158 1.596632 1.050190 0.348364 0.402844 1.083937 1.814009 0.098380 0.333506 -0.078532 0.814360 1.186888 0.456002 0.118529 1.475204 0.706833 1.153688 1.398936 1.202344 1.140027 1.452557 0.124581 1.538313 1.096684 0.449897 0.816791 -0.073645 0.157032 -0.377184 1.176926 0.948380 0.061745 1.231800 0.991632 1.829471 1.268286 1.394920 0.669763 0.966107 1.360959 1.524586 1.033990 0.094975 1.707832 0.468762 1.695289 -0.249729 0.213611 -0.109788 1.260368 1.791243 -0.325923)
+ 10.815476 #r(0.000000 1.511627 1.860509 1.251771 0.680390 0.954029 0.497464 0.422082 0.549359 1.789096 0.627036 1.559684 -0.285316 1.102920 1.110972 0.497639 0.358913 0.339963 0.170351 0.820368 1.613321 0.311453 1.667587 0.845824 1.477518 0.323382 -0.462336 -0.121701 0.278431 1.251253 0.730313 -0.512813 0.050332 1.905719 0.581701 0.491221 0.037053 0.850077 1.454447 1.218666 1.827857 1.931466 0.444700 1.716033 0.031317 0.208955 0.719947 1.025308 -0.162952 0.941579 1.416409 1.490055 1.661028 -0.177347 0.601149 1.427738 1.318738 -0.598055 1.513344 0.818145 0.331744 0.938565 1.416971 0.755203 0.134509 1.154206 1.729909 0.622158 1.596632 1.050190 0.348364 0.402844 1.083937 1.814009 0.098380 0.333506 -0.078532 0.814360 1.186888 0.456002 0.118529 1.475204 0.706833 1.153688 1.398936 1.202344 1.140027 1.452557 0.124581 1.538313 1.096684 0.449897 0.816791 -0.073645 0.157032 -0.377184 1.176926 0.948380 0.061745 1.231800 0.991632 1.829471 1.268286 1.394920 0.669763 0.966107 1.360959 1.524586 1.033990 0.094975 1.707832 0.468762 1.695289 -0.249729 0.213611 -0.109788 1.260368 1.791243 -0.325923)
)
;;; 120 odd -------------------------------------------------------------------------------- ; 10.9545
-(vector 120 14.530112637252 #(0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 1 1 1 1 1 1 0 0 1 0 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1 0 0 0 0 0 1 1 1 0 0 0 0 1 1 1 1 0 1 1 1 1 1 1 0 0 0 0 0 0 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 1 0 1 0 0 0 0 0 1 0 0 0 1 1 0 1 1 0)
+(vector 120 14.530112637252 #r(0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 1 1 1 1 1 1 0 0 1 0 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1 0 0 0 0 0 1 1 1 0 0 0 0 1 1 1 1 0 1 1 1 1 1 1 0 0 0 0 0 0 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 1 0 1 0 0 0 0 0 1 0 0 0 1 1 0 1 1 0)
- 10.908578 #(0.000000 1.631022 1.381443 1.212465 0.280876 1.393291 0.111686 0.270527 0.978937 1.227425 0.890939 1.651369 1.764648 0.695615 1.236913 0.727116 0.698874 1.130809 0.997193 1.306023 0.313921 0.604505 1.499034 1.434773 -0.031959 0.721966 0.805711 1.401787 1.847562 -0.006201 0.484669 -0.092885 0.221199 -0.183123 0.140129 0.993753 0.357992 0.281932 0.966898 0.230227 1.509169 0.180321 0.405315 1.445457 0.491155 0.993111 -0.061813 1.514617 0.638001 0.451798 1.136956 1.109239 0.762301 -0.132886 1.231861 1.405253 0.200172 0.005626 1.367415 0.727395 0.860721 1.277905 0.564602 1.311600 0.590071 0.237783 1.173320 1.731939 0.366179 -0.147635 0.520386 1.741652 0.218116 1.635795 0.602629 0.928717 0.628620 0.437182 1.782199 0.939080 1.479011 0.992710 1.705346 0.225711 0.000961 0.770434 1.683323 1.555459 0.976408 0.318440 0.438208 0.262452 1.689840 0.975712 0.209291 0.727490 0.382719 1.065032 0.672130 0.702874 0.107185 1.755713 1.841965 0.283698 0.562788 -0.058140 0.525625 0.471391 -0.086606 1.741760 0.455380 1.248256 1.359448 0.404279 1.132787 1.054875 0.443335 0.808907 0.713857 0.102341)
+ 10.908578 #r(0.000000 1.631022 1.381443 1.212465 0.280876 1.393291 0.111686 0.270527 0.978937 1.227425 0.890939 1.651369 1.764648 0.695615 1.236913 0.727116 0.698874 1.130809 0.997193 1.306023 0.313921 0.604505 1.499034 1.434773 -0.031959 0.721966 0.805711 1.401787 1.847562 -0.006201 0.484669 -0.092885 0.221199 -0.183123 0.140129 0.993753 0.357992 0.281932 0.966898 0.230227 1.509169 0.180321 0.405315 1.445457 0.491155 0.993111 -0.061813 1.514617 0.638001 0.451798 1.136956 1.109239 0.762301 -0.132886 1.231861 1.405253 0.200172 0.005626 1.367415 0.727395 0.860721 1.277905 0.564602 1.311600 0.590071 0.237783 1.173320 1.731939 0.366179 -0.147635 0.520386 1.741652 0.218116 1.635795 0.602629 0.928717 0.628620 0.437182 1.782199 0.939080 1.479011 0.992710 1.705346 0.225711 0.000961 0.770434 1.683323 1.555459 0.976408 0.318440 0.438208 0.262452 1.689840 0.975712 0.209291 0.727490 0.382719 1.065032 0.672130 0.702874 0.107185 1.755713 1.841965 0.283698 0.562788 -0.058140 0.525625 0.471391 -0.086606 1.741760 0.455380 1.248256 1.359448 0.404279 1.132787 1.054875 0.443335 0.808907 0.713857 0.102341)
)
;;; 121 odd -------------------------------------------------------------------------------- ; 11
-(vector 121 14.355115628334 #(0 0 1 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 1 0 0 0 0 1 1 1 0 0 1 0 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0)
+(vector 121 14.355115628334 #r(0 0 1 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 1 0 0 0 0 1 1 1 0 0 1 0 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0)
- 10.999150 #(0.000000 0.719860 0.938641 0.400955 1.830792 0.217487 1.930089 0.909842 0.382707 1.104036 1.362552 1.609877 0.538869 1.202159 1.228082 0.918074 0.761902 0.900279 1.079854 0.387994 0.099489 0.100875 1.443224 0.976872 1.189188 0.334621 0.186401 1.007773 1.759908 1.802561 0.304789 0.800487 0.421388 1.531470 0.342409 1.763739 0.609609 0.238091 0.387711 0.077698 1.394770 1.550045 1.073770 -0.012632 0.461456 0.365441 0.558370 -0.144510 0.377065 -0.136065 0.495723 0.024372 0.599268 0.707454 1.784582 0.849322 0.801737 -0.000698 0.370684 -0.319990 0.047344 1.411089 -0.180064 1.795978 1.184028 0.211991 0.750419 1.558447 0.936061 0.770891 0.210380 0.477885 0.773230 1.314821 1.776398 0.360518 0.353595 1.763194 0.626584 0.453820 1.817369 0.757593 0.448588 0.747723 1.349523 0.084314 0.839331 0.432101 1.175829 -0.480593 1.521898 1.472118 0.461937 -0.352155 0.231781 1.128258 1.179502 -0.264358 1.594681 1.130852 1.819287 1.407276 0.357399 0.261689 0.296975 1.241018 0.528908 0.936623 1.018062 1.507272 1.409703 0.904346 -0.089508 0.657699 0.797276 1.771059 0.906319 0.794023 0.195827 -0.015182 1.382236)
+ 10.999150 #r(0.000000 0.719860 0.938641 0.400955 1.830792 0.217487 1.930089 0.909842 0.382707 1.104036 1.362552 1.609877 0.538869 1.202159 1.228082 0.918074 0.761902 0.900279 1.079854 0.387994 0.099489 0.100875 1.443224 0.976872 1.189188 0.334621 0.186401 1.007773 1.759908 1.802561 0.304789 0.800487 0.421388 1.531470 0.342409 1.763739 0.609609 0.238091 0.387711 0.077698 1.394770 1.550045 1.073770 -0.012632 0.461456 0.365441 0.558370 -0.144510 0.377065 -0.136065 0.495723 0.024372 0.599268 0.707454 1.784582 0.849322 0.801737 -0.000698 0.370684 -0.319990 0.047344 1.411089 -0.180064 1.795978 1.184028 0.211991 0.750419 1.558447 0.936061 0.770891 0.210380 0.477885 0.773230 1.314821 1.776398 0.360518 0.353595 1.763194 0.626584 0.453820 1.817369 0.757593 0.448588 0.747723 1.349523 0.084314 0.839331 0.432101 1.175829 -0.480593 1.521898 1.472118 0.461937 -0.352155 0.231781 1.128258 1.179502 -0.264358 1.594681 1.130852 1.819287 1.407276 0.357399 0.261689 0.296975 1.241018 0.528908 0.936623 1.018062 1.507272 1.409703 0.904346 -0.089508 0.657699 0.797276 1.771059 0.906319 0.794023 0.195827 -0.015182 1.382236)
;; pp:
- 10.964853 #(0.000000 0.398403 0.789366 1.639224 0.095384 0.603386 1.413253 -0.024715 0.418890 1.292082 1.611148 0.340631 1.108765 1.695063 0.580930 1.343797 0.280670 0.901558 1.616611 0.471137 1.087682 0.133909 0.906863 1.859279 0.568482 1.631317 0.654611 1.507476 0.361682 1.510922 0.499281 1.470975 0.300411 1.347262 0.617157 1.704177 0.828780 1.880799 1.043180 0.289911 1.416774 0.542005 1.546439 0.900363 0.167177 1.249035 0.407571 1.759267 1.085148 0.584948 1.716513 0.882082 0.508912 1.827501 0.986992 0.387974 1.888925 1.337010 0.836823 0.307293 1.641585 1.441301 0.767423 0.352201 1.694822 1.489433 0.858014 0.699679 0.213088 1.881335 1.746103 0.996170 1.013175 0.481879 0.378821 0.145113 1.583267 1.647206 1.099338 0.993610 1.018212 0.718965 0.851336 0.334482 0.624100 0.047757 0.264635 -0.323610 -0.302771 0.007865 1.748671 1.715799 0.102814 0.097582 0.089500 0.089824 -0.047495 0.097783 0.230671 0.371131 0.395035 0.485871 1.031900 1.248794 1.442726 1.594017 1.850116 0.167236 0.339312 0.429488 0.766566 1.120859 1.686086 0.133797 0.674257 1.033037 1.205258 1.718874 0.166520 0.534447 1.081831)
+ 10.964853 #r(0.000000 0.398403 0.789366 1.639224 0.095384 0.603386 1.413253 -0.024715 0.418890 1.292082 1.611148 0.340631 1.108765 1.695063 0.580930 1.343797 0.280670 0.901558 1.616611 0.471137 1.087682 0.133909 0.906863 1.859279 0.568482 1.631317 0.654611 1.507476 0.361682 1.510922 0.499281 1.470975 0.300411 1.347262 0.617157 1.704177 0.828780 1.880799 1.043180 0.289911 1.416774 0.542005 1.546439 0.900363 0.167177 1.249035 0.407571 1.759267 1.085148 0.584948 1.716513 0.882082 0.508912 1.827501 0.986992 0.387974 1.888925 1.337010 0.836823 0.307293 1.641585 1.441301 0.767423 0.352201 1.694822 1.489433 0.858014 0.699679 0.213088 1.881335 1.746103 0.996170 1.013175 0.481879 0.378821 0.145113 1.583267 1.647206 1.099338 0.993610 1.018212 0.718965 0.851336 0.334482 0.624100 0.047757 0.264635 -0.323610 -0.302771 0.007865 1.748671 1.715799 0.102814 0.097582 0.089500 0.089824 -0.047495 0.097783 0.230671 0.371131 0.395035 0.485871 1.031900 1.248794 1.442726 1.594017 1.850116 0.167236 0.339312 0.429488 0.766566 1.120859 1.686086 0.133797 0.674257 1.033037 1.205258 1.718874 0.166520 0.534447 1.081831)
)
;;; 122 odd -------------------------------------------------------------------------------- ; 11.0454
-(vector 122 14.266534958875 #(0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 0 0 1 0 1 0 1 0 0 1 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 1 0 1)
+(vector 122 14.266534958875 #r(0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 0 0 1 0 1 0 1 0 0 1 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 1 0 1)
- 11.010771 #(0.000000 1.285362 1.109765 1.769522 1.118511 0.025809 1.380894 -0.023810 -0.040154 0.477589 1.538986 0.261754 1.175104 0.132069 1.284014 1.937597 1.377797 1.405930 1.758393 1.282889 1.486625 -0.056321 1.528467 0.214498 1.235960 0.342086 0.501436 1.266150 1.154766 0.072612 1.295064 1.657622 1.389498 0.272462 0.259989 -0.421623 0.539671 -0.109400 1.457518 0.782406 0.238503 1.568707 0.742855 0.582523 1.544996 0.568221 1.469856 -0.013151 1.702120 1.738232 0.495569 1.623452 0.280213 1.398587 0.655444 -0.357815 -0.175614 -0.641353 0.853648 0.913786 0.039735 0.805399 0.987536 1.353101 0.200447 1.531233 0.925738 1.853509 -0.339223 0.575217 0.991404 0.868567 0.980697 0.661437 0.825668 0.642114 1.923343 0.222086 1.058889 0.329972 0.424129 1.343097 -0.325621 0.616372 0.777895 1.290746 0.563995 1.114886 -0.032692 0.303925 0.022515 1.568213 1.005956 0.993523 0.945016 1.316628 1.600265 0.004312 0.404044 0.508968 1.509703 1.266589 -0.292614 0.449335 0.327309 -0.027947 0.095691 -0.305771 -0.038174 1.851423 0.567671 0.373102 0.032065 1.664572 1.263320 0.558380 0.899406 0.824927 1.437277 1.639347 0.806318 0.739271)
+ 11.010771 #r(0.000000 1.285362 1.109765 1.769522 1.118511 0.025809 1.380894 -0.023810 -0.040154 0.477589 1.538986 0.261754 1.175104 0.132069 1.284014 1.937597 1.377797 1.405930 1.758393 1.282889 1.486625 -0.056321 1.528467 0.214498 1.235960 0.342086 0.501436 1.266150 1.154766 0.072612 1.295064 1.657622 1.389498 0.272462 0.259989 -0.421623 0.539671 -0.109400 1.457518 0.782406 0.238503 1.568707 0.742855 0.582523 1.544996 0.568221 1.469856 -0.013151 1.702120 1.738232 0.495569 1.623452 0.280213 1.398587 0.655444 -0.357815 -0.175614 -0.641353 0.853648 0.913786 0.039735 0.805399 0.987536 1.353101 0.200447 1.531233 0.925738 1.853509 -0.339223 0.575217 0.991404 0.868567 0.980697 0.661437 0.825668 0.642114 1.923343 0.222086 1.058889 0.329972 0.424129 1.343097 -0.325621 0.616372 0.777895 1.290746 0.563995 1.114886 -0.032692 0.303925 0.022515 1.568213 1.005956 0.993523 0.945016 1.316628 1.600265 0.004312 0.404044 0.508968 1.509703 1.266589 -0.292614 0.449335 0.327309 -0.027947 0.095691 -0.305771 -0.038174 1.851423 0.567671 0.373102 0.032065 1.664572 1.263320 0.558380 0.899406 0.824927 1.437277 1.639347 0.806318 0.739271)
)
;;; 123 odd -------------------------------------------------------------------------------- ; 11.0905
-(vector 123 14.795100232697 #(0 1 0 1 0 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 1 0 1 1 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 0 1 1 1 0 0 1 0 1 0)
+(vector 123 14.795100232697 #r(0 1 0 1 0 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 1 0 1 1 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 0 1 1 1 0 0 1 0 1 0)
- 11.117974 #(0.000000 1.262698 1.743243 1.074484 0.862475 0.785191 0.510312 0.582728 0.572628 -0.088059 1.664778 1.092330 -0.084164 1.734977 0.143912 0.402913 0.514775 1.115307 1.630947 0.922571 1.361065 0.426472 0.818315 0.052105 0.105138 1.201879 0.422607 1.251988 1.202423 -0.257950 0.069201 -0.064548 0.721964 0.891435 1.163338 0.489652 0.800922 1.113478 0.729679 1.592733 0.127179 0.300890 1.709393 0.172666 1.452078 -0.215073 0.642218 0.228379 0.403691 1.149702 0.347815 1.145024 0.203450 1.473310 1.349864 0.832166 1.109084 1.584188 0.087952 0.610084 0.356770 0.605944 1.021694 0.463739 1.799512 1.527466 0.330450 0.923701 1.275830 1.440075 0.070553 0.931440 1.867718 1.401219 0.527205 0.524478 1.943022 1.358574 1.765573 0.269987 0.599212 0.397347 0.099304 -0.004043 0.750837 0.311340 0.977644 0.259270 0.829971 0.677623 1.491913 0.411691 1.356052 1.394632 0.542733 1.451416 1.005068 0.285973 0.960285 1.132877 -0.136129 0.201370 1.788028 -0.448022 -0.229434 1.007668 -0.665334 0.552776 -0.103552 1.183857 -0.521659 1.255730 0.912247 1.532970 1.479294 1.441480 1.200164 0.598200 1.369457 1.661067 0.851812 0.484837 1.318223)
+ 11.117974 #r(0.000000 1.262698 1.743243 1.074484 0.862475 0.785191 0.510312 0.582728 0.572628 -0.088059 1.664778 1.092330 -0.084164 1.734977 0.143912 0.402913 0.514775 1.115307 1.630947 0.922571 1.361065 0.426472 0.818315 0.052105 0.105138 1.201879 0.422607 1.251988 1.202423 -0.257950 0.069201 -0.064548 0.721964 0.891435 1.163338 0.489652 0.800922 1.113478 0.729679 1.592733 0.127179 0.300890 1.709393 0.172666 1.452078 -0.215073 0.642218 0.228379 0.403691 1.149702 0.347815 1.145024 0.203450 1.473310 1.349864 0.832166 1.109084 1.584188 0.087952 0.610084 0.356770 0.605944 1.021694 0.463739 1.799512 1.527466 0.330450 0.923701 1.275830 1.440075 0.070553 0.931440 1.867718 1.401219 0.527205 0.524478 1.943022 1.358574 1.765573 0.269987 0.599212 0.397347 0.099304 -0.004043 0.750837 0.311340 0.977644 0.259270 0.829971 0.677623 1.491913 0.411691 1.356052 1.394632 0.542733 1.451416 1.005068 0.285973 0.960285 1.132877 -0.136129 0.201370 1.788028 -0.448022 -0.229434 1.007668 -0.665334 0.552776 -0.103552 1.183857 -0.521659 1.255730 0.912247 1.532970 1.479294 1.441480 1.200164 0.598200 1.369457 1.661067 0.851812 0.484837 1.318223)
;; pp:
- 11.220425 #(0.000000 0.365848 1.054393 1.548722 0.083290 0.846622 1.243796 1.975082 0.530118 1.107798 1.698368 0.394906 1.261238 1.932773 0.709817 1.516065 0.289612 0.915816 1.713378 0.516514 1.369027 0.084750 0.935528 1.825369 0.700695 1.570817 0.581567 1.522187 0.450938 1.444224 0.424228 1.427039 0.366241 1.246498 0.294330 1.489859 0.444710 1.600045 0.769131 1.818819 0.882796 0.180405 1.318163 0.438713 1.518577 0.911091 0.311354 1.423178 0.560415 -0.093959 1.444287 0.598087 1.777270 1.408474 0.711081 0.112383 1.490437 0.904666 0.286560 1.771712 1.145544 0.724678 0.267468 1.796311 1.311228 0.841811 0.365537 1.880834 1.503328 1.287234 0.819314 0.526370 -0.077772 1.787440 1.491417 1.044589 1.141961 0.479419 0.379101 0.330996 -0.143470 1.807816 1.736856 1.461325 1.278241 1.506158 1.106149 1.221780 0.919096 1.122923 0.682195 0.948573 0.684101 0.822257 0.900682 0.969747 0.998896 1.031330 0.981000 1.116626 1.207464 1.514496 1.484110 1.685927 -0.131788 0.102608 0.256377 0.543811 0.846258 1.358549 1.270751 1.590115 -0.239901 0.243476 0.677754 0.899634 1.476294 1.901976 0.254194 0.661350 1.294177 1.496684 0.048409)
+ 11.220425 #r(0.000000 0.365848 1.054393 1.548722 0.083290 0.846622 1.243796 1.975082 0.530118 1.107798 1.698368 0.394906 1.261238 1.932773 0.709817 1.516065 0.289612 0.915816 1.713378 0.516514 1.369027 0.084750 0.935528 1.825369 0.700695 1.570817 0.581567 1.522187 0.450938 1.444224 0.424228 1.427039 0.366241 1.246498 0.294330 1.489859 0.444710 1.600045 0.769131 1.818819 0.882796 0.180405 1.318163 0.438713 1.518577 0.911091 0.311354 1.423178 0.560415 -0.093959 1.444287 0.598087 1.777270 1.408474 0.711081 0.112383 1.490437 0.904666 0.286560 1.771712 1.145544 0.724678 0.267468 1.796311 1.311228 0.841811 0.365537 1.880834 1.503328 1.287234 0.819314 0.526370 -0.077772 1.787440 1.491417 1.044589 1.141961 0.479419 0.379101 0.330996 -0.143470 1.807816 1.736856 1.461325 1.278241 1.506158 1.106149 1.221780 0.919096 1.122923 0.682195 0.948573 0.684101 0.822257 0.900682 0.969747 0.998896 1.031330 0.981000 1.116626 1.207464 1.514496 1.484110 1.685927 -0.131788 0.102608 0.256377 0.543811 0.846258 1.358549 1.270751 1.590115 -0.239901 0.243476 0.677754 0.899634 1.476294 1.901976 0.254194 0.661350 1.294177 1.496684 0.048409)
;; 122 + 1
- 11.250448 #(0.000000 1.302757 1.104016 1.882979 1.077650 0.053765 1.380440 0.003809 -0.046007 0.495357 1.519889 0.149797 1.197260 0.142817 1.219075 1.962202 1.461975 1.397810 1.755477 1.312034 1.459888 0.010987 1.489492 0.259453 1.259472 0.317472 0.521518 1.299213 1.226523 0.026938 1.296841 1.668722 1.337105 0.314301 0.330300 -0.438601 0.526089 -0.123698 1.469579 0.756219 0.172470 1.621261 0.778923 0.588722 1.542018 0.631414 1.527628 -0.038678 1.791364 1.687889 0.422304 1.584058 0.300597 1.413330 0.639674 -0.328087 -0.133739 -0.644241 0.881718 0.903075 -0.003259 0.764074 1.053115 1.364090 0.158374 1.544589 0.996921 1.813142 -0.279028 0.566236 1.039397 0.862143 0.979166 0.609771 0.860576 0.627137 1.959235 0.243884 1.018838 0.390319 0.475059 1.332423 -0.275526 0.611933 0.766476 1.331409 0.615945 1.094395 -0.004564 0.363420 -0.045135 1.527572 1.077299 0.997558 1.035936 1.286389 1.540261 0.059435 0.352601 0.552519 1.479640 1.199179 -0.317815 0.440438 0.336153 -0.013127 0.157566 -0.304297 -0.069647 1.901289 0.528335 0.359084 -0.007292 1.702466 1.215578 0.562997 0.913601 0.801948 1.409876 1.632172 0.750795 0.670695 -0.003034)
+ 11.250448 #r(0.000000 1.302757 1.104016 1.882979 1.077650 0.053765 1.380440 0.003809 -0.046007 0.495357 1.519889 0.149797 1.197260 0.142817 1.219075 1.962202 1.461975 1.397810 1.755477 1.312034 1.459888 0.010987 1.489492 0.259453 1.259472 0.317472 0.521518 1.299213 1.226523 0.026938 1.296841 1.668722 1.337105 0.314301 0.330300 -0.438601 0.526089 -0.123698 1.469579 0.756219 0.172470 1.621261 0.778923 0.588722 1.542018 0.631414 1.527628 -0.038678 1.791364 1.687889 0.422304 1.584058 0.300597 1.413330 0.639674 -0.328087 -0.133739 -0.644241 0.881718 0.903075 -0.003259 0.764074 1.053115 1.364090 0.158374 1.544589 0.996921 1.813142 -0.279028 0.566236 1.039397 0.862143 0.979166 0.609771 0.860576 0.627137 1.959235 0.243884 1.018838 0.390319 0.475059 1.332423 -0.275526 0.611933 0.766476 1.331409 0.615945 1.094395 -0.004564 0.363420 -0.045135 1.527572 1.077299 0.997558 1.035936 1.286389 1.540261 0.059435 0.352601 0.552519 1.479640 1.199179 -0.317815 0.440438 0.336153 -0.013127 0.157566 -0.304297 -0.069647 1.901289 0.528335 0.359084 -0.007292 1.702466 1.215578 0.562997 0.913601 0.801948 1.409876 1.632172 0.750795 0.670695 -0.003034)
;; 124 - 1
- 11.087851 #(0.000000 0.624121 0.261315 1.181018 0.329816 0.723473 -0.058557 1.121126 0.418750 -0.560184 0.201221 -0.009188 0.964547 0.675383 0.540517 1.692402 0.238659 0.271713 0.649234 1.358679 -0.523949 0.096515 1.070752 0.415974 1.194076 0.398537 0.119705 1.390687 1.865110 0.657711 0.628353 0.094042 -0.039698 0.818092 0.264925 1.627819 0.564214 1.707948 1.323380 0.532853 1.528599 0.040464 0.169356 1.020624 1.633435 0.566927 0.135046 0.139973 1.154314 0.011466 -0.490861 0.640253 0.477507 1.036610 0.601286 0.864853 1.673244 0.103614 0.490773 0.239735 1.004984 0.751604 0.598287 0.049449 -0.383209 0.952738 0.587827 1.358167 1.134886 0.996730 1.062079 1.715631 0.870675 -0.669782 1.719322 1.286177 0.181430 1.375280 1.727572 0.723568 0.180864 0.793875 1.229108 1.479462 0.352987 0.476172 0.647844 0.506675 0.826807 0.037970 0.147029 -0.376170 -0.079080 -0.448861 -0.361893 0.784673 0.253239 1.081508 0.018537 1.194702 1.598635 -0.278698 1.403864 0.071060 0.431595 1.221066 1.608714 0.689332 0.715718 0.497216 1.832187 1.548074 1.325487 -0.697479 1.412701 -0.064789 1.545460 1.865863 0.574246 1.018052 0.826593 0.850894 0.538141)
+ 11.087851 #r(0.000000 0.624121 0.261315 1.181018 0.329816 0.723473 -0.058557 1.121126 0.418750 -0.560184 0.201221 -0.009188 0.964547 0.675383 0.540517 1.692402 0.238659 0.271713 0.649234 1.358679 -0.523949 0.096515 1.070752 0.415974 1.194076 0.398537 0.119705 1.390687 1.865110 0.657711 0.628353 0.094042 -0.039698 0.818092 0.264925 1.627819 0.564214 1.707948 1.323380 0.532853 1.528599 0.040464 0.169356 1.020624 1.633435 0.566927 0.135046 0.139973 1.154314 0.011466 -0.490861 0.640253 0.477507 1.036610 0.601286 0.864853 1.673244 0.103614 0.490773 0.239735 1.004984 0.751604 0.598287 0.049449 -0.383209 0.952738 0.587827 1.358167 1.134886 0.996730 1.062079 1.715631 0.870675 -0.669782 1.719322 1.286177 0.181430 1.375280 1.727572 0.723568 0.180864 0.793875 1.229108 1.479462 0.352987 0.476172 0.647844 0.506675 0.826807 0.037970 0.147029 -0.376170 -0.079080 -0.448861 -0.361893 0.784673 0.253239 1.081508 0.018537 1.194702 1.598635 -0.278698 1.403864 0.071060 0.431595 1.221066 1.608714 0.689332 0.715718 0.497216 1.832187 1.548074 1.325487 -0.697479 1.412701 -0.064789 1.545460 1.865863 0.574246 1.018052 0.826593 0.850894 0.538141)
)
;;; 124 odd -------------------------------------------------------------------------------- ; 11.1355
-(vector 124 14.82254124518 #(0 0 0 0 1 0 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 1 1 0 1 0 0 0 0 0 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 1 1 0 0 0 1 0 0 0 0 0)
+(vector 124 14.82254124518 #r(0 0 0 0 1 0 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 1 1 0 1 0 0 0 0 0 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 1 1 0 0 0 1 0 0 0 0 0)
- 11.133385 #(0.000000 0.737767 0.242894 1.222279 0.471270 0.719745 -0.111581 1.125372 0.519029 -0.602995 0.207831 -0.019375 0.977253 0.730038 0.549277 1.736357 0.178856 0.378067 0.703036 1.285405 -0.440424 0.022976 1.081105 0.394590 1.176445 0.423028 0.024758 1.348044 1.875622 0.693243 0.631295 0.154785 -0.072026 0.840426 0.310333 1.680668 0.596016 1.796624 1.329261 0.552169 1.550621 -0.029191 0.120286 1.042346 1.643782 0.557105 0.100245 0.192082 1.115887 -0.044021 -0.568040 0.660295 0.446779 0.996296 0.543383 0.887166 1.696504 0.164237 0.565638 0.240616 0.980219 0.676086 0.528834 0.128308 -0.348116 0.973101 0.673237 1.259063 1.135685 0.928208 1.088345 1.731248 0.837036 -0.669991 1.701824 1.338691 0.198045 1.382482 1.748178 0.598583 0.174133 0.840707 1.239171 1.490991 0.324491 0.560298 0.680939 0.488255 0.866976 0.067351 0.114746 -0.374109 -0.011129 -0.482864 -0.335823 0.770685 0.238886 1.104919 -0.086380 1.175827 1.697828 -0.309033 1.420456 0.050528 0.410791 1.224188 1.576124 0.696620 0.749167 0.492507 1.752832 1.565235 1.317346 -0.708509 1.533585 -0.144615 1.567818 1.921771 0.617703 1.048643 0.900156 0.810098 0.470909 -0.287077)
+ 11.133385 #r(0.000000 0.737767 0.242894 1.222279 0.471270 0.719745 -0.111581 1.125372 0.519029 -0.602995 0.207831 -0.019375 0.977253 0.730038 0.549277 1.736357 0.178856 0.378067 0.703036 1.285405 -0.440424 0.022976 1.081105 0.394590 1.176445 0.423028 0.024758 1.348044 1.875622 0.693243 0.631295 0.154785 -0.072026 0.840426 0.310333 1.680668 0.596016 1.796624 1.329261 0.552169 1.550621 -0.029191 0.120286 1.042346 1.643782 0.557105 0.100245 0.192082 1.115887 -0.044021 -0.568040 0.660295 0.446779 0.996296 0.543383 0.887166 1.696504 0.164237 0.565638 0.240616 0.980219 0.676086 0.528834 0.128308 -0.348116 0.973101 0.673237 1.259063 1.135685 0.928208 1.088345 1.731248 0.837036 -0.669991 1.701824 1.338691 0.198045 1.382482 1.748178 0.598583 0.174133 0.840707 1.239171 1.490991 0.324491 0.560298 0.680939 0.488255 0.866976 0.067351 0.114746 -0.374109 -0.011129 -0.482864 -0.335823 0.770685 0.238886 1.104919 -0.086380 1.175827 1.697828 -0.309033 1.420456 0.050528 0.410791 1.224188 1.576124 0.696620 0.749167 0.492507 1.752832 1.565235 1.317346 -0.708509 1.533585 -0.144615 1.567818 1.921771 0.617703 1.048643 0.900156 0.810098 0.470909 -0.287077)
;; pp:
- 11.348159 #(0.000000 0.420291 0.994113 1.605062 0.142556 0.741991 1.232518 1.818784 0.570117 1.112532 1.715041 0.498288 1.242193 1.903819 0.738569 1.440312 0.052035 0.859274 1.700608 0.416370 1.222707 0.007385 0.792200 1.771446 0.548685 1.661284 0.559436 1.442669 0.358986 1.258045 0.260744 1.254293 0.320180 1.305252 0.361287 1.403913 0.572629 1.603076 0.693636 1.846854 1.012682 0.188863 1.352443 0.397048 1.645973 0.881785 0.066704 1.295103 0.504646 1.870898 1.303297 0.570018 1.829957 1.080888 0.545590 1.923840 1.269013 0.679145 0.161303 1.594647 0.985227 0.464326 0.012233 1.568478 1.180634 0.730528 0.110665 1.618518 1.175834 0.879996 0.432189 0.136812 1.777876 1.490107 1.188949 0.907621 0.550479 0.242984 -0.059790 1.929821 1.371631 1.423168 1.146477 0.972409 0.858534 0.924887 0.595740 0.679411 0.488048 0.636418 0.072322 0.281040 0.204879 0.089915 0.287853 0.416670 0.453983 0.352329 0.503511 0.432486 0.571020 0.790600 0.687796 1.008010 1.155356 1.385540 1.648000 1.747132 0.045146 0.425981 0.717415 0.741128 1.002981 1.282324 1.660931 0.156386 0.411627 0.950904 1.417985 1.747974 0.260323 0.677519 1.016797 1.669557)
+ 11.348159 #r(0.000000 0.420291 0.994113 1.605062 0.142556 0.741991 1.232518 1.818784 0.570117 1.112532 1.715041 0.498288 1.242193 1.903819 0.738569 1.440312 0.052035 0.859274 1.700608 0.416370 1.222707 0.007385 0.792200 1.771446 0.548685 1.661284 0.559436 1.442669 0.358986 1.258045 0.260744 1.254293 0.320180 1.305252 0.361287 1.403913 0.572629 1.603076 0.693636 1.846854 1.012682 0.188863 1.352443 0.397048 1.645973 0.881785 0.066704 1.295103 0.504646 1.870898 1.303297 0.570018 1.829957 1.080888 0.545590 1.923840 1.269013 0.679145 0.161303 1.594647 0.985227 0.464326 0.012233 1.568478 1.180634 0.730528 0.110665 1.618518 1.175834 0.879996 0.432189 0.136812 1.777876 1.490107 1.188949 0.907621 0.550479 0.242984 -0.059790 1.929821 1.371631 1.423168 1.146477 0.972409 0.858534 0.924887 0.595740 0.679411 0.488048 0.636418 0.072322 0.281040 0.204879 0.089915 0.287853 0.416670 0.453983 0.352329 0.503511 0.432486 0.571020 0.790600 0.687796 1.008010 1.155356 1.385540 1.648000 1.747132 0.045146 0.425981 0.717415 0.741128 1.002981 1.282324 1.660931 0.156386 0.411627 0.950904 1.417985 1.747974 0.260323 0.677519 1.016797 1.669557)
;; 125-1
- 11.120334 #(0.000000 0.836933 0.196277 0.584882 0.301240 1.853484 1.324094 0.689541 0.969365 0.207127 0.815576 1.493174 1.646002 1.091372 1.338767 0.007260 0.223249 1.375996 0.396818 0.809290 0.595471 0.291935 0.828280 1.079040 -0.045835 0.055676 0.687157 1.387372 0.387604 1.113048 0.635795 -0.184152 0.086995 0.683755 -0.523880 0.957683 0.004250 0.887892 -0.247566 0.473338 0.863028 1.537875 1.279363 1.883742 -0.079415 1.606587 1.410357 1.815201 1.258365 -0.140836 0.062288 -0.117723 0.136197 0.025366 0.240444 0.337975 0.245314 1.565210 1.190385 0.061707 1.059358 1.066927 -0.243845 -0.140470 0.080704 -0.220916 0.436644 1.755266 1.123977 1.300903 1.292668 0.127266 0.478120 0.197515 0.674823 1.740766 0.286316 1.346417 -0.000673 0.759878 1.360448 0.328373 -0.116210 1.391350 1.022226 1.179474 0.838754 0.041237 0.614743 0.475843 0.203018 1.724933 1.421322 0.133569 1.485945 -0.070709 -0.071535 1.023240 0.511154 0.013014 1.379753 0.972914 1.226974 1.882336 0.135006 1.035934 -0.225880 1.034246 0.410768 0.390305 1.143196 1.223233 0.144114 1.611032 0.509896 1.218446 0.494123 -0.071045 0.511805 0.489583 0.116710 1.542243 0.745207 0.200411)
+ 11.120334 #r(0.000000 0.836933 0.196277 0.584882 0.301240 1.853484 1.324094 0.689541 0.969365 0.207127 0.815576 1.493174 1.646002 1.091372 1.338767 0.007260 0.223249 1.375996 0.396818 0.809290 0.595471 0.291935 0.828280 1.079040 -0.045835 0.055676 0.687157 1.387372 0.387604 1.113048 0.635795 -0.184152 0.086995 0.683755 -0.523880 0.957683 0.004250 0.887892 -0.247566 0.473338 0.863028 1.537875 1.279363 1.883742 -0.079415 1.606587 1.410357 1.815201 1.258365 -0.140836 0.062288 -0.117723 0.136197 0.025366 0.240444 0.337975 0.245314 1.565210 1.190385 0.061707 1.059358 1.066927 -0.243845 -0.140470 0.080704 -0.220916 0.436644 1.755266 1.123977 1.300903 1.292668 0.127266 0.478120 0.197515 0.674823 1.740766 0.286316 1.346417 -0.000673 0.759878 1.360448 0.328373 -0.116210 1.391350 1.022226 1.179474 0.838754 0.041237 0.614743 0.475843 0.203018 1.724933 1.421322 0.133569 1.485945 -0.070709 -0.071535 1.023240 0.511154 0.013014 1.379753 0.972914 1.226974 1.882336 0.135006 1.035934 -0.225880 1.034246 0.410768 0.390305 1.143196 1.223233 0.144114 1.611032 0.509896 1.218446 0.494123 -0.071045 0.511805 0.489583 0.116710 1.542243 0.745207 0.200411)
)
;;; 125 odd -------------------------------------------------------------------------------- ; 11.1803
-(vector 125 14.82163143158 #(0 0 1 1 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0 0 1 0 1 0 1 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 1 1 0 1 0 0 1 1 1 0 0)
+(vector 125 14.82163143158 #r(0 0 1 1 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0 0 1 0 1 0 1 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 1 1 0 1 0 0 1 1 1 0 0)
- 11.122080 #(0.000000 0.847003 0.165605 0.564848 0.227076 1.866949 1.345525 0.694388 0.959809 0.220564 0.772501 1.602410 1.604719 1.034958 1.311625 0.093909 0.283228 1.337145 0.377730 0.845137 0.466461 0.350583 0.723543 1.140286 -0.106738 0.112805 0.654453 1.405583 0.488341 1.115481 0.791692 -0.180702 0.024701 0.675117 -0.401907 0.966930 1.823188 0.970009 -0.163692 0.487827 0.774136 1.664048 1.147399 1.934923 -0.055579 1.590906 1.404741 1.937024 1.297324 -0.074406 0.012276 -0.101828 0.157087 0.049344 0.227099 0.402796 0.390545 1.452083 1.063131 0.134397 1.038993 1.058234 -0.172834 -0.157850 -0.051398 -0.166122 0.368524 1.765197 1.164117 1.233067 1.255917 0.100656 0.389203 0.162934 0.701475 1.871318 0.234658 1.379710 -0.022077 0.663615 1.352469 0.392445 -0.083922 1.307168 0.973714 1.219169 0.823481 0.152576 0.585169 0.393119 0.296805 1.754607 1.427512 0.110549 1.353534 -0.062637 0.005406 0.988733 0.551978 -0.032302 1.396422 1.051496 1.232496 1.873765 0.104448 1.090614 -0.186610 1.107217 0.405013 0.371843 1.166939 1.223105 0.199359 1.547104 0.541567 1.118832 0.462118 -0.111041 0.497800 0.551619 0.175381 1.513543 0.771791 0.282381 0.491699)
+ 11.122080 #r(0.000000 0.847003 0.165605 0.564848 0.227076 1.866949 1.345525 0.694388 0.959809 0.220564 0.772501 1.602410 1.604719 1.034958 1.311625 0.093909 0.283228 1.337145 0.377730 0.845137 0.466461 0.350583 0.723543 1.140286 -0.106738 0.112805 0.654453 1.405583 0.488341 1.115481 0.791692 -0.180702 0.024701 0.675117 -0.401907 0.966930 1.823188 0.970009 -0.163692 0.487827 0.774136 1.664048 1.147399 1.934923 -0.055579 1.590906 1.404741 1.937024 1.297324 -0.074406 0.012276 -0.101828 0.157087 0.049344 0.227099 0.402796 0.390545 1.452083 1.063131 0.134397 1.038993 1.058234 -0.172834 -0.157850 -0.051398 -0.166122 0.368524 1.765197 1.164117 1.233067 1.255917 0.100656 0.389203 0.162934 0.701475 1.871318 0.234658 1.379710 -0.022077 0.663615 1.352469 0.392445 -0.083922 1.307168 0.973714 1.219169 0.823481 0.152576 0.585169 0.393119 0.296805 1.754607 1.427512 0.110549 1.353534 -0.062637 0.005406 0.988733 0.551978 -0.032302 1.396422 1.051496 1.232496 1.873765 0.104448 1.090614 -0.186610 1.107217 0.405013 0.371843 1.166939 1.223105 0.199359 1.547104 0.541567 1.118832 0.462118 -0.111041 0.497800 0.551619 0.175381 1.513543 0.771791 0.282381 0.491699)
)
;;; 126 odd -------------------------------------------------------------------------------- ; 11.2250
-(vector 126 14.961482935205 #(0 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 1)
+(vector 126 14.961482935205 #r(0 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 1)
- 11.217157 #(0.000000 1.333463 1.865492 -0.356718 0.933752 -0.563391 0.868454 1.227379 1.262853 1.734302 0.789925 0.887286 1.032388 0.794621 1.230657 -0.133505 -0.396357 0.347068 1.645124 0.776662 -0.030992 0.148253 0.191160 1.597265 0.105283 0.900423 1.230893 1.571345 0.370052 -0.251197 0.174670 0.404122 -0.082381 0.889967 -0.215160 -0.008260 -0.099660 1.159763 0.889422 1.423884 0.871705 1.850409 0.087109 1.706676 0.622672 0.936165 1.688780 1.528677 0.346829 0.012071 -0.088550 -0.030577 -0.043782 -0.058951 0.933603 1.070465 1.475594 1.531127 0.991234 0.010808 0.356054 0.157103 0.451907 -0.030459 -0.024818 0.523063 -0.129422 0.815521 1.075724 0.055269 0.750932 1.244054 1.306512 0.899391 -0.257291 1.664054 0.588171 1.065503 1.219153 1.371075 1.522174 0.737588 1.228742 1.773501 0.629941 0.387629 0.029457 1.398967 0.393091 1.680074 1.275817 0.905734 0.977246 -0.221887 1.339886 1.268897 1.260526 0.645165 1.510347 1.465708 0.394415 0.283387 1.630537 1.623821 0.888008 0.433073 0.790823 0.410278 1.398034 -0.237262 0.505122 -0.149516 0.721213 -0.202493 0.454561 1.014466 0.552452 1.112325 -1.848818 1.758603 1.154778 1.507049 0.724439 0.691362 -0.014103 1.227764)
+ 11.217157 #r(0.000000 1.333463 1.865492 -0.356718 0.933752 -0.563391 0.868454 1.227379 1.262853 1.734302 0.789925 0.887286 1.032388 0.794621 1.230657 -0.133505 -0.396357 0.347068 1.645124 0.776662 -0.030992 0.148253 0.191160 1.597265 0.105283 0.900423 1.230893 1.571345 0.370052 -0.251197 0.174670 0.404122 -0.082381 0.889967 -0.215160 -0.008260 -0.099660 1.159763 0.889422 1.423884 0.871705 1.850409 0.087109 1.706676 0.622672 0.936165 1.688780 1.528677 0.346829 0.012071 -0.088550 -0.030577 -0.043782 -0.058951 0.933603 1.070465 1.475594 1.531127 0.991234 0.010808 0.356054 0.157103 0.451907 -0.030459 -0.024818 0.523063 -0.129422 0.815521 1.075724 0.055269 0.750932 1.244054 1.306512 0.899391 -0.257291 1.664054 0.588171 1.065503 1.219153 1.371075 1.522174 0.737588 1.228742 1.773501 0.629941 0.387629 0.029457 1.398967 0.393091 1.680074 1.275817 0.905734 0.977246 -0.221887 1.339886 1.268897 1.260526 0.645165 1.510347 1.465708 0.394415 0.283387 1.630537 1.623821 0.888008 0.433073 0.790823 0.410278 1.398034 -0.237262 0.505122 -0.149516 0.721213 -0.202493 0.454561 1.014466 0.552452 1.112325 -1.848818 1.758603 1.154778 1.507049 0.724439 0.691362 -0.014103 1.227764)
)
;;; 127 odd -------------------------------------------------------------------------------- ; 11.2694
-(vector 127 14.695912364919 #(0 0 1 0 1 1 0 0 1 1 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0)
+(vector 127 14.695912364919 #r(0 0 1 0 1 1 0 0 1 1 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0)
- 11.267676 #(0.000000 0.469645 0.796786 0.361018 -0.201613 1.310280 0.989111 0.525386 1.353693 0.378912 -0.241786 1.383164 1.533963 0.433890 0.325960 -0.352400 0.296358 0.481541 1.224829 0.787501 0.393768 1.211089 1.363561 0.247670 0.870376 1.154368 0.308126 1.041640 0.835212 1.804302 0.606799 0.022246 1.619342 1.154695 0.087857 0.758989 -0.028398 1.810844 1.763099 -0.171773 1.163226 0.592499 1.004685 0.695738 1.351120 0.977805 1.234286 1.609466 1.168845 1.598062 -0.321012 0.375057 0.817093 1.176853 0.878725 0.404937 0.672879 0.953648 1.504900 1.779440 0.534644 1.065489 -0.364994 1.703967 1.257601 -0.285618 0.908588 1.590737 1.087624 0.949190 1.204116 1.100315 0.879186 1.728483 1.796612 1.248626 1.298091 0.553842 1.379947 1.414383 0.591234 -0.228889 0.158060 -0.027394 0.157851 1.486700 0.372769 1.034786 0.707926 1.165159 0.328389 0.640197 0.421469 0.024384 1.129354 0.412245 0.531741 0.551732 0.008170 1.397227 1.653335 0.820170 0.216962 1.538735 0.975199 1.704359 0.157705 -0.426269 0.813101 0.999429 0.880927 1.743457 1.627725 0.094175 0.211869 0.002839 0.900464 1.204980 1.320644 1.281147 0.386967 0.783858 1.096686 0.213553 1.120859 -0.145308 0.996884)
+ 11.267676 #r(0.000000 0.469645 0.796786 0.361018 -0.201613 1.310280 0.989111 0.525386 1.353693 0.378912 -0.241786 1.383164 1.533963 0.433890 0.325960 -0.352400 0.296358 0.481541 1.224829 0.787501 0.393768 1.211089 1.363561 0.247670 0.870376 1.154368 0.308126 1.041640 0.835212 1.804302 0.606799 0.022246 1.619342 1.154695 0.087857 0.758989 -0.028398 1.810844 1.763099 -0.171773 1.163226 0.592499 1.004685 0.695738 1.351120 0.977805 1.234286 1.609466 1.168845 1.598062 -0.321012 0.375057 0.817093 1.176853 0.878725 0.404937 0.672879 0.953648 1.504900 1.779440 0.534644 1.065489 -0.364994 1.703967 1.257601 -0.285618 0.908588 1.590737 1.087624 0.949190 1.204116 1.100315 0.879186 1.728483 1.796612 1.248626 1.298091 0.553842 1.379947 1.414383 0.591234 -0.228889 0.158060 -0.027394 0.157851 1.486700 0.372769 1.034786 0.707926 1.165159 0.328389 0.640197 0.421469 0.024384 1.129354 0.412245 0.531741 0.551732 0.008170 1.397227 1.653335 0.820170 0.216962 1.538735 0.975199 1.704359 0.157705 -0.426269 0.813101 0.999429 0.880927 1.743457 1.627725 0.094175 0.211869 0.002839 0.900464 1.204980 1.320644 1.281147 0.386967 0.783858 1.096686 0.213553 1.120859 -0.145308 0.996884)
)
;;; 128 odd -------------------------------------------------------------------------------- ; 11.3137
-(vector 128 14.876242756695 #(0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 0 1)
+(vector 128 14.876242756695 #r(0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 0 1)
- 11.261196 #(0.000000 0.166552 0.658187 0.892812 0.275075 0.681304 0.935134 0.976324 1.751013 1.223679 0.531374 0.670158 0.738172 0.131342 0.784571 -0.001918 0.261947 -0.271711 1.074675 0.180917 0.495904 1.378525 0.720362 0.537440 1.116473 -0.311806 0.462073 0.021129 0.764859 1.361657 1.645691 -0.164691 0.135735 1.576068 0.824450 0.335134 1.099359 0.719625 0.791638 0.999013 0.348593 0.103014 1.062792 0.739933 1.675943 0.488371 0.860700 0.759566 1.276788 -0.135237 0.780818 -0.165115 1.024663 -0.327864 0.608127 1.454969 0.958609 0.555060 1.331156 0.762777 0.625297 1.411237 1.470303 1.190821 0.207444 0.108639 1.023133 1.165243 1.464221 1.564262 0.616076 0.019451 0.729986 0.402652 0.078552 0.454134 0.152695 0.263463 0.361958 1.475980 0.276689 1.365673 0.254488 -0.143709 1.946127 0.309551 1.760348 1.294342 0.981564 0.863637 1.477654 -0.019128 0.751338 0.878849 0.050601 0.063334 1.353561 1.669390 1.451518 0.535767 0.012898 0.428045 -0.011136 0.975409 -0.201088 0.677802 0.866124 0.188482 0.625213 1.342113 1.315837 0.879874 0.445664 1.081775 0.978490 1.662778 0.529736 1.946523 1.542905 0.571344 1.054205 0.430980 0.402697 -0.095096 1.487261 1.198691 1.754313 1.700742)
+ 11.261196 #r(0.000000 0.166552 0.658187 0.892812 0.275075 0.681304 0.935134 0.976324 1.751013 1.223679 0.531374 0.670158 0.738172 0.131342 0.784571 -0.001918 0.261947 -0.271711 1.074675 0.180917 0.495904 1.378525 0.720362 0.537440 1.116473 -0.311806 0.462073 0.021129 0.764859 1.361657 1.645691 -0.164691 0.135735 1.576068 0.824450 0.335134 1.099359 0.719625 0.791638 0.999013 0.348593 0.103014 1.062792 0.739933 1.675943 0.488371 0.860700 0.759566 1.276788 -0.135237 0.780818 -0.165115 1.024663 -0.327864 0.608127 1.454969 0.958609 0.555060 1.331156 0.762777 0.625297 1.411237 1.470303 1.190821 0.207444 0.108639 1.023133 1.165243 1.464221 1.564262 0.616076 0.019451 0.729986 0.402652 0.078552 0.454134 0.152695 0.263463 0.361958 1.475980 0.276689 1.365673 0.254488 -0.143709 1.946127 0.309551 1.760348 1.294342 0.981564 0.863637 1.477654 -0.019128 0.751338 0.878849 0.050601 0.063334 1.353561 1.669390 1.451518 0.535767 0.012898 0.428045 -0.011136 0.975409 -0.201088 0.677802 0.866124 0.188482 0.625213 1.342113 1.315837 0.879874 0.445664 1.081775 0.978490 1.662778 0.529736 1.946523 1.542905 0.571344 1.054205 0.430980 0.402697 -0.095096 1.487261 1.198691 1.754313 1.700742)
)
;;; 256 odd --------------------------------------------------------------------------------
-(vector 256 22.546259712247 #(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)
+(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 #(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.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)
)
;;; 512 odd --------------------------------------------------------------------------------
-(vector 512 35.541 #(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)
+(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 #(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.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)
)
;;; 1024 odd --------------------------------------------------------------------------------
-(vector 1024 52.508 #(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)
+(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 #(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.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)
)
;;; 2048 odd --------------------------------------------------------------------------------
-(vector 2048 83.108 #(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)
+(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 #(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)
+ 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)
)
))
@@ -2454,1046 +2453,1046 @@
(define primoid-min-peak-phases (vector
-(vector 1 1.0 #(0)
+(vector 1 1.0 #r(0)
)
-(vector 2 1.76 #(0 1)
+(vector 2 1.76 #r(0 1)
)
;;; 3 prime --------------------------------------------------------------------------------
-(vector 3 2.1949384212494 #(0 0 1)
- 1.980 #(0 62/39 13/41) ; 1 2 3 -- same as :all in this case
- 1.9798574987316 #(0.0 1.5896952797511 0.31654707828801)
- 1.9798030853271 #(0.0 1.5897271633148 0.31667485833168)
+(vector 3 2.1949384212494 #r(0 0 1)
+ 1.980 #r(0 62/39 13/41) ; 1 2 3 -- same as :all in this case
+ 1.9798574987316 #r(0.0 1.5896952797511 0.31654707828801)
+ 1.9798030853271 #r(0.0 1.5897271633148 0.31667485833168)
)
;;; 4 prime --------------------------------------------------------------------------------
-(vector 4 2.5978584289551 #(0 0 1 1)
+(vector 4 2.5978584289551 #r(0 0 1 1)
- ;2.2039985204158 #(0 0 12 4) / 20
- 2.1930510997772 #(0.000 0.996 0.596 0.217)
- 2.1930510997772 #(0.000 1.996 0.596 0.217)
- 2.1930510997772 #(0.000 0.004 1.404 1.783)
+ ;2.2039985204158 #r(0 0 12 4) / 20
+ 2.1930510997772 #r(0.000 0.996 0.596 0.217)
+ 2.1930510997772 #r(0.000 1.996 0.596 0.217)
+ 2.1930510997772 #r(0.000 0.004 1.404 1.783)
- 2.1927945613861 #(0.0 1.0065363103693 1.4072853370949 1.7873527125308)
- 2.1921416218407 #(0.0 1.0052774357064 1.4058145325161 1.7854903085184)
- 2.1921210289001 #(0.0 1.0052587985992 1.4057868719101 1.7854607105255)
+ 2.1927945613861 #r(0.0 1.0065363103693 1.4072853370949 1.7873527125308)
+ 2.1921416218407 #r(0.0 1.0052774357064 1.4058145325161 1.7854903085184)
+ 2.1921210289001 #r(0.0 1.0052587985992 1.4057868719101 1.7854607105255)
)
;;; 5 prime --------------------------------------------------------------------------------
-(vector 5 2.7172040939331 #(0 0 1 0 0)
+(vector 5 2.7172040939331 #r(0 0 1 0 0)
- 2.476848 #(0.000000 1.577434 0.385232 1.294742 1.022952)
- 2.476837 #(0.000000 0.422530 1.614642 0.705077 0.976763)
+ 2.476848 #r(0.000000 1.577434 0.385232 1.294742 1.022952)
+ 2.476837 #r(0.000000 0.422530 1.614642 0.705077 0.976763)
)
;;; 6 prime --------------------------------------------------------------------------------
-(vector 6 3.1241359710693 #(0 0 0 1 0 0)
+(vector 6 3.1241359710693 #r(0 0 0 1 0 0)
- 2.805574 #(0.000000 1.568945 0.034019 1.082417 0.900415 0.797509)
- 2.805492 #(0.000000 0.431060 -0.033992 0.917551 1.099550 1.202470)
- 2.805413 #(0.000000 0.431110 -0.033974 0.917615 1.099635 1.202594)
+ 2.805574 #r(0.000000 1.568945 0.034019 1.082417 0.900415 0.797509)
+ 2.805492 #r(0.000000 0.431060 -0.033992 0.917551 1.099550 1.202470)
+ 2.805413 #r(0.000000 0.431110 -0.033974 0.917615 1.099635 1.202594)
)
;;; 7 prime --------------------------------------------------------------------------------
-(vector 7 3.4886319637299 #(0 1 1 0 0 0 0)
+(vector 7 3.4886319637299 #r(0 1 1 0 0 0 0)
- 3.061861 #(0.000000 0.715739 0.261422 0.169339 0.062479 1.180650 0.330190)
- 3.061763 #(0.000000 0.715523 0.261251 0.168577 0.061828 1.179155 0.328665)
+ 3.061861 #r(0.000000 0.715739 0.261422 0.169339 0.062479 1.180650 0.330190)
+ 3.061763 #r(0.000000 0.715523 0.261251 0.168577 0.061828 1.179155 0.328665)
)
;;; 8 prime --------------------------------------------------------------------------------
-(vector 8 3.7088720798492 #(0 0 0 0 0 0 1 0)
+(vector 8 3.7088720798492 #r(0 0 0 0 0 0 1 0)
- 3.263115 #(0.000000 0.207652 0.035023 1.752163 0.064249 0.346105 1.403170 0.065734)
- 3.262977 #(0.000000 0.792550 1.965637 0.248661 1.936840 1.655647 0.598935 1.936915)
- 3.262789 #(0.000000 0.792261 1.965087 0.247823 1.935907 1.654053 0.597010 1.934463)
+ 3.263115 #r(0.000000 0.207652 0.035023 1.752163 0.064249 0.346105 1.403170 0.065734)
+ 3.262977 #r(0.000000 0.792550 1.965637 0.248661 1.936840 1.655647 0.598935 1.936915)
+ 3.262789 #r(0.000000 0.792261 1.965087 0.247823 1.935907 1.654053 0.597010 1.934463)
)
;;; 9 prime --------------------------------------------------------------------------------
-(vector 9 3.9154822826385 #(0 0 0 1 1 1 0 0 0)
+(vector 9 3.9154822826385 #r(0 0 0 1 1 1 0 0 0)
- 3.382645 #(0.000000 0.562589 0.520940 1.521127 1.682374 0.721497 0.805534 1.254209 0.726847)
- 3.382399 #(0.000000 1.437745 1.479554 0.480268 0.319088 1.280870 1.197460 0.749784 1.277141)
- 3.382150 #(0.000000 1.437471 1.479039 0.479171 0.317977 1.279012 1.195104 0.746644 1.274032)
+ 3.382645 #r(0.000000 0.562589 0.520940 1.521127 1.682374 0.721497 0.805534 1.254209 0.726847)
+ 3.382399 #r(0.000000 1.437745 1.479554 0.480268 0.319088 1.280870 1.197460 0.749784 1.277141)
+ 3.382150 #r(0.000000 1.437471 1.479039 0.479171 0.317977 1.279012 1.195104 0.746644 1.274032)
)
;;; 10 prime --------------------------------------------------------------------------------
-(vector 10 4.1209712028503 #(0 0 1 0 0 0 1 0 0 0)
+(vector 10 4.1209712028503 #r(0 0 1 0 0 0 1 0 0 0)
- 3.602602 #(0.000000 1.405079 0.694565 0.388252 0.756491 1.849937 0.076683 1.023761 0.374165 1.226329)
- 3.602329 #(0.000000 0.594431 1.305346 1.611464 1.243212 0.149889 1.922392 0.975619 1.625276 0.772405)
- 3.601897 #(0.000000 0.594605 1.305309 1.611462 1.242927 0.149405 1.922318 0.974872 1.624292 0.771826)
+ 3.602602 #r(0.000000 1.405079 0.694565 0.388252 0.756491 1.849937 0.076683 1.023761 0.374165 1.226329)
+ 3.602329 #r(0.000000 0.594431 1.305346 1.611464 1.243212 0.149889 1.922392 0.975619 1.625276 0.772405)
+ 3.601897 #r(0.000000 0.594605 1.305309 1.611462 1.242927 0.149405 1.922318 0.974872 1.624292 0.771826)
)
;;; 11 prime --------------------------------------------------------------------------------
-(vector 11 4.4176635742188 #(0 0 1 0 0 0 0 0 0 1 0)
+(vector 11 4.4176635742188 #r(0 0 1 0 0 0 0 0 0 1 0)
- 3.779046 #(0.000000 0.211414 1.453486 1.827574 1.811694 1.949216 1.313595 0.823256 1.334141 0.127849 0.824659)
- 3.778444 #(0.000000 0.211392 1.453207 1.827566 1.811268 1.948666 1.312975 0.822389 1.333108 0.126706 0.823083)
+ 3.779046 #r(0.000000 0.211414 1.453486 1.827574 1.811694 1.949216 1.313595 0.823256 1.334141 0.127849 0.824659)
+ 3.778444 #r(0.000000 0.211392 1.453207 1.827566 1.811268 1.948666 1.312975 0.822389 1.333108 0.126706 0.823083)
)
;;; 12 prime --------------------------------------------------------------------------------
-(vector 12 4.3595271110535 #(0 0 0 0 0 0 1 0 1 1 0 1)
+(vector 12 4.3595271110535 #r(0 0 0 0 0 0 1 0 1 1 0 1)
- 3.936657 #(0.000000 0.367346 0.997085 1.763425 1.295636 0.140826 0.757652 1.565853 1.284651 0.304758 0.331248 0.325474)
- 3.936584 #(0.000000 0.366730 0.995852 1.762390 1.293763 0.137304 0.753397 1.560313 1.278944 0.297723 0.322472 0.315856)
- 3.935928 #(0.000000 0.367095 0.996695 1.763345 1.295131 0.139476 0.755820 1.563961 1.282494 0.302360 0.327995 0.321982)
+ 3.936657 #r(0.000000 0.367346 0.997085 1.763425 1.295636 0.140826 0.757652 1.565853 1.284651 0.304758 0.331248 0.325474)
+ 3.936584 #r(0.000000 0.366730 0.995852 1.762390 1.293763 0.137304 0.753397 1.560313 1.278944 0.297723 0.322472 0.315856)
+ 3.935928 #r(0.000000 0.367095 0.996695 1.763345 1.295131 0.139476 0.755820 1.563961 1.282494 0.302360 0.327995 0.321982)
)
;;; 13 prime --------------------------------------------------------------------------------
-(vector 13 4.8980793952942 #(0 0 0 1 0 0 1 1 1 1 1 1 0)
+(vector 13 4.8980793952942 #r(0 0 0 1 0 0 1 1 1 1 1 1 0)
- 4.155503 #(0.000000 1.115751 0.463368 0.110540 0.613302 1.581997 1.394002 -0.005270 1.724217 0.023531 1.743892 0.616897 0.124222)
- 4.155104 #(0.000000 0.888606 1.516761 -0.128988 1.376524 0.383262 0.572385 -0.041726 0.228441 1.918487 0.187862 1.304384 1.779710)
- 4.154486 #(0.000000 0.888925 1.516611 -0.128449 1.377349 0.383874 0.573640 -0.040502 0.230047 1.920090 0.190320 1.307111 1.782269)
+ 4.155503 #r(0.000000 1.115751 0.463368 0.110540 0.613302 1.581997 1.394002 -0.005270 1.724217 0.023531 1.743892 0.616897 0.124222)
+ 4.155104 #r(0.000000 0.888606 1.516761 -0.128988 1.376524 0.383262 0.572385 -0.041726 0.228441 1.918487 0.187862 1.304384 1.779710)
+ 4.154486 #r(0.000000 0.888925 1.516611 -0.128449 1.377349 0.383874 0.573640 -0.040502 0.230047 1.920090 0.190320 1.307111 1.782269)
)
;;; 14 prime --------------------------------------------------------------------------------
-(vector 14 4.827317237854 #(0 0 0 0 1 0 0 0 0 1 1 0 0 0)
+(vector 14 4.827317237854 #r(0 0 0 0 1 0 0 0 0 1 1 0 0 0)
- 4.325356 #(0.000000 0.359558 1.885647 0.244632 1.221244 1.839379 1.316045 0.525308 0.483244 1.183590 1.084986 0.271051 0.780356 0.855105)
- 4.324364 #(0.000000 0.359123 1.885242 0.244967 1.221612 1.840358 1.317076 0.526663 0.485486 1.185929 1.087828 0.273652 0.783599 0.859686)
+ 4.325356 #r(0.000000 0.359558 1.885647 0.244632 1.221244 1.839379 1.316045 0.525308 0.483244 1.183590 1.084986 0.271051 0.780356 0.855105)
+ 4.324364 #r(0.000000 0.359123 1.885242 0.244967 1.221612 1.840358 1.317076 0.526663 0.485486 1.185929 1.087828 0.273652 0.783599 0.859686)
)
;;; 15 prime --------------------------------------------------------------------------------
-(vector 15 5.116711139679 #(0 0 0 0 1 1 0 0 1 0 0 0 1 1 1)
+(vector 15 5.116711139679 #r(0 0 0 0 1 1 0 0 1 0 0 0 1 1 1)
- 4.467959 #(0.000000 1.165302 0.822381 1.719844 1.177673 0.000074 -0.047034 0.249259 0.174863 0.272306 -0.034377 1.204925 0.800910 1.798882 0.085175)
- 4.465870 #(0.000000 1.195783 0.875671 1.808021 1.309702 0.184662 0.170474 0.531131 0.521153 0.683109 0.474077 -0.194026 1.432983 0.523484 0.889349)
+ 4.467959 #r(0.000000 1.165302 0.822381 1.719844 1.177673 0.000074 -0.047034 0.249259 0.174863 0.272306 -0.034377 1.204925 0.800910 1.798882 0.085175)
+ 4.465870 #r(0.000000 1.195783 0.875671 1.808021 1.309702 0.184662 0.170474 0.531131 0.521153 0.683109 0.474077 -0.194026 1.432983 0.523484 0.889349)
)
;;; 16 prime --------------------------------------------------------------------------------
-(vector 16 5.2015118598938 #(0 0 0 0 1 1 0 0 1 0 0 0 1 1 1 1)
+(vector 16 5.2015118598938 #r(0 0 0 0 1 1 0 0 1 0 0 0 1 1 1 1)
- 4.602505 #(0.000000 0.065822 0.364277 0.133567 0.202441 1.541212 1.225002 0.832999 1.687176 1.503245 1.015565 1.715739 1.103351 1.602678 1.102870 1.723542)
- 4.600306 #(0.000000 0.087862 0.378855 0.177701 0.258884 1.624830 1.330220 0.960734 1.836164 1.680878 1.236729 1.958382 1.391766 1.922763 1.425076 0.083217)
+ 4.602505 #r(0.000000 0.065822 0.364277 0.133567 0.202441 1.541212 1.225002 0.832999 1.687176 1.503245 1.015565 1.715739 1.103351 1.602678 1.102870 1.723542)
+ 4.600306 #r(0.000000 0.087862 0.378855 0.177701 0.258884 1.624830 1.330220 0.960734 1.836164 1.680878 1.236729 1.958382 1.391766 1.922763 1.425076 0.083217)
)
;;; 17 prime --------------------------------------------------------------------------------
-(vector 17 5.5318970680237 #(0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 0 1)
+(vector 17 5.5318970680237 #r(0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 0 1)
- 4.719141 #(0.000000 0.742295 1.745265 1.857635 0.393094 0.085265 0.379253 1.692020 1.022244 0.008090 1.067230 1.241546 0.650781 0.027258 1.334059 1.354939 0.974983)
- 4.718649 #(0.000000 0.751159 1.770960 1.891296 0.451714 0.167219 0.486669 1.820262 1.171314 0.188288 1.302438 1.491326 0.945450 0.342701 1.668608 1.730493 1.394926)
+ 4.719141 #r(0.000000 0.742295 1.745265 1.857635 0.393094 0.085265 0.379253 1.692020 1.022244 0.008090 1.067230 1.241546 0.650781 0.027258 1.334059 1.354939 0.974983)
+ 4.718649 #r(0.000000 0.751159 1.770960 1.891296 0.451714 0.167219 0.486669 1.820262 1.171314 0.188288 1.302438 1.491326 0.945450 0.342701 1.668608 1.730493 1.394926)
)
;;; 18 prime --------------------------------------------------------------------------------
-(vector 18 5.518 #(0 0 1 0 1 1 1 1 0 0 0 0 1 0 0 0 0 0)
+(vector 18 5.518 #r(0 0 1 0 1 1 1 1 0 0 0 0 1 0 0 0 0 0)
- 4.855354 #(0.000000 0.761212 1.399765 1.386893 -0.022155 1.259519 0.806762 0.461717 0.840663 0.867450 0.860949 1.743030 1.407070 0.651538 1.045391 1.279111 0.110257 1.307989)
- 4.855108 #(0.000000 0.750207 1.384561 1.357598 -0.059069 1.202337 0.735689 0.367843 0.732570 0.743255 0.704408 1.570924 1.212329 0.426050 0.813634 1.013534 -0.181098 0.979190)
+ 4.855354 #r(0.000000 0.761212 1.399765 1.386893 -0.022155 1.259519 0.806762 0.461717 0.840663 0.867450 0.860949 1.743030 1.407070 0.651538 1.045391 1.279111 0.110257 1.307989)
+ 4.855108 #r(0.000000 0.750207 1.384561 1.357598 -0.059069 1.202337 0.735689 0.367843 0.732570 0.743255 0.704408 1.570924 1.212329 0.426050 0.813634 1.013534 -0.181098 0.979190)
)
;;; 19 prime --------------------------------------------------------------------------------
-(vector 19 5.7069295560724 #(0 1 1 0 1 1 0 1 0 1 1 1 0 1 0 0 0 1 1)
+(vector 19 5.7069295560724 #r(0 1 1 0 1 1 0 1 0 1 1 1 0 1 0 0 0 1 1)
- 5.015020 #(0.000000 1.616061 1.626145 1.313686 1.626275 1.187207 1.456980 0.377509 -0.071549 0.474989 0.997350 1.285450 0.372950 1.499943 0.593785 0.033723 1.161466 0.319734 1.064282)
- 4.998754 #(0.000000 1.645363 1.697584 1.402853 1.761967 1.410480 1.731078 0.730841 0.373575 0.971264 1.632848 -0.032567 1.185342 0.399132 1.548900 1.042245 0.314528 1.610838 0.400814)
+ 5.015020 #r(0.000000 1.616061 1.626145 1.313686 1.626275 1.187207 1.456980 0.377509 -0.071549 0.474989 0.997350 1.285450 0.372950 1.499943 0.593785 0.033723 1.161466 0.319734 1.064282)
+ 4.998754 #r(0.000000 1.645363 1.697584 1.402853 1.761967 1.410480 1.731078 0.730841 0.373575 0.971264 1.632848 -0.032567 1.185342 0.399132 1.548900 1.042245 0.314528 1.610838 0.400814)
)
;;; 20 prime --------------------------------------------------------------------------------
-(vector 20 5.8879864574703 #(0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 1)
+(vector 20 5.8879864574703 #r(0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 1)
- 5.188618 #(0.000000 1.304708 0.831211 0.731788 0.021326 1.272273 1.777479 0.002778 1.612017 0.397413 0.057603 1.250739 0.234023 0.556087 0.011742 0.753589 1.624826 0.625035 1.017719 0.079500)
- 5.182566 #(0.000000 1.263246 0.762194 0.608532 -0.162633 0.980718 1.431801 -0.440489 1.122128 -0.196813 -0.666076 0.455149 -0.710850 -0.505486 -1.097448 -0.446751 0.276095 -0.871587 -0.537639 -1.622748)
+ 5.188618 #r(0.000000 1.304708 0.831211 0.731788 0.021326 1.272273 1.777479 0.002778 1.612017 0.397413 0.057603 1.250739 0.234023 0.556087 0.011742 0.753589 1.624826 0.625035 1.017719 0.079500)
+ 5.182566 #r(0.000000 1.263246 0.762194 0.608532 -0.162633 0.980718 1.431801 -0.440489 1.122128 -0.196813 -0.666076 0.455149 -0.710850 -0.505486 -1.097448 -0.446751 0.276095 -0.871587 -0.537639 -1.622748)
)
;;; 21 prime --------------------------------------------------------------------------------
-(vector 21 6.1138607493652 #(0 0 1 0 0 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0)
+(vector 21 6.1138607493652 #r(0 0 1 0 0 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0)
- 5.324980 #(0.000000 0.284388 0.190620 0.601870 1.760108 0.865412 0.509624 0.391482 -0.117180 0.413220 1.669494 1.501699 0.066514 0.632948 0.866546 1.073191 0.975355 1.318609 0.054208 1.081180 1.759607)
- 5.323612 #(0.000000 0.280854 0.184723 0.594540 1.747745 0.845155 0.483640 0.360116 -0.153262 0.371609 1.613941 1.441516 -0.006745 0.553330 0.784905 0.983522 0.871481 1.204293 -0.066217 0.952578 1.624372)
+ 5.324980 #r(0.000000 0.284388 0.190620 0.601870 1.760108 0.865412 0.509624 0.391482 -0.117180 0.413220 1.669494 1.501699 0.066514 0.632948 0.866546 1.073191 0.975355 1.318609 0.054208 1.081180 1.759607)
+ 5.323612 #r(0.000000 0.280854 0.184723 0.594540 1.747745 0.845155 0.483640 0.360116 -0.153262 0.371609 1.613941 1.441516 -0.006745 0.553330 0.784905 0.983522 0.871481 1.204293 -0.066217 0.952578 1.624372)
)
;;; 22 prime --------------------------------------------------------------------------------
-(vector 22 6.3374844973589 #(0 0 1 1 1 0 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0)
+(vector 22 6.3374844973589 #r(0 0 1 1 1 0 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0)
- 5.444390 #(0.000000 1.499825 1.282805 1.145752 0.718322 0.527629 0.660515 1.924701 0.466877 0.510672 0.652853 0.187109 1.099971 0.084112 0.857217 -0.068874 1.056229 1.751779 1.460546 0.258516 0.957206 1.594508)
- 5.433554 #(0.000000 1.486514 1.390599 1.149545 0.921462 0.702749 0.884951 0.283286 0.900936 0.913025 1.182081 0.780309 1.832213 0.822636 1.714820 0.783014 0.057705 0.842269 0.698584 1.561603 0.224265 0.995298)
+ 5.444390 #r(0.000000 1.499825 1.282805 1.145752 0.718322 0.527629 0.660515 1.924701 0.466877 0.510672 0.652853 0.187109 1.099971 0.084112 0.857217 -0.068874 1.056229 1.751779 1.460546 0.258516 0.957206 1.594508)
+ 5.433554 #r(0.000000 1.486514 1.390599 1.149545 0.921462 0.702749 0.884951 0.283286 0.900936 0.913025 1.182081 0.780309 1.832213 0.822636 1.714820 0.783014 0.057705 0.842269 0.698584 1.561603 0.224265 0.995298)
)
;;; 23 prime --------------------------------------------------------------------------------
-(vector 23 6.5309901747782 #(0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 1 1 0 1 1 1 1 1)
+(vector 23 6.5309901747782 #r(0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 1 1 0 1 1 1 1 1)
- 5.563562 #(0.000000 0.281094 0.583074 0.221311 1.169287 1.340406 0.217839 0.992042 0.637288 1.632696 0.471670 0.404966 0.171954 0.469626 0.291125 0.731904 1.276906 1.527897 0.612764 0.143351 1.082353 1.486999 1.452340)
- 5.562290 #(0.000000 0.285874 0.595224 0.235000 1.193968 1.380397 0.263651 1.051885 0.699527 1.708311 0.571007 0.512971 0.292952 0.607887 0.434888 0.887469 1.457277 1.731817 0.825388 0.371687 1.321790 1.739434 1.728651)
+ 5.563562 #r(0.000000 0.281094 0.583074 0.221311 1.169287 1.340406 0.217839 0.992042 0.637288 1.632696 0.471670 0.404966 0.171954 0.469626 0.291125 0.731904 1.276906 1.527897 0.612764 0.143351 1.082353 1.486999 1.452340)
+ 5.562290 #r(0.000000 0.285874 0.595224 0.235000 1.193968 1.380397 0.263651 1.051885 0.699527 1.708311 0.571007 0.512971 0.292952 0.607887 0.434888 0.887469 1.457277 1.731817 0.825388 0.371687 1.321790 1.739434 1.728651)
)
;;; 24 prime --------------------------------------------------------------------------------
-(vector 24 6.5623834870329 #(0 0 1 1 0 0 0 0 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 0)
+(vector 24 6.5623834870329 #r(0 0 1 1 0 0 0 0 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 0)
- 5.645656 #(0.000000 0.825211 1.870903 1.169702 1.224751 0.476917 -0.084281 -0.215343 1.779853 1.403261 0.289331 1.689966 -0.267939 1.131483 1.839470 1.455399 1.365050 0.422908 0.906355 0.161003 0.266551 0.763039 1.248766 1.436520)
- 5.642196 #(0.000000 0.890373 -0.094314 1.286595 1.344700 0.673123 0.114259 0.064347 0.093887 1.778664 0.785400 0.193244 0.317478 1.782787 0.521724 0.200559 0.236076 1.409678 1.913185 1.269474 1.450265 -0.052106 0.501351 0.830713)
+ 5.645656 #r(0.000000 0.825211 1.870903 1.169702 1.224751 0.476917 -0.084281 -0.215343 1.779853 1.403261 0.289331 1.689966 -0.267939 1.131483 1.839470 1.455399 1.365050 0.422908 0.906355 0.161003 0.266551 0.763039 1.248766 1.436520)
+ 5.642196 #r(0.000000 0.890373 -0.094314 1.286595 1.344700 0.673123 0.114259 0.064347 0.093887 1.778664 0.785400 0.193244 0.317478 1.782787 0.521724 0.200559 0.236076 1.409678 1.913185 1.269474 1.450265 -0.052106 0.501351 0.830713)
)
;;; 25 prime --------------------------------------------------------------------------------
-(vector 25 6.635721206665 #(0 0 1 0 0 1 1 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1)
+(vector 25 6.635721206665 #r(0 0 1 0 0 1 1 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1)
- 5.810785 #(0.000000 0.563705 1.200194 1.330185 1.448503 0.304746 -0.097873 1.178970 1.307797 0.187993 1.570595 0.364607 -0.021932 1.552639 -0.223928 1.041142 1.388107 1.015775 1.883861 0.551891 1.621094 0.871585 1.482986 0.450455 0.538066)
+ 5.810785 #r(0.000000 0.563705 1.200194 1.330185 1.448503 0.304746 -0.097873 1.178970 1.307797 0.187993 1.570595 0.364607 -0.021932 1.552639 -0.223928 1.041142 1.388107 1.015775 1.883861 0.551891 1.621094 0.871585 1.482986 0.450455 0.538066)
)
;;; 26 prime --------------------------------------------------------------------------------
-(vector 26 6.8401503562927 #(0 1 0 0 0 1 0 0 1 1 0 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1)
+(vector 26 6.8401503562927 #r(0 1 0 0 0 1 0 0 1 1 0 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1)
- 6.060342 #(0.000000 -0.041165 -0.003731 0.423811 0.999953 0.846414 -0.006772 1.678875 0.280560 0.164498 1.427575 0.432370 0.295956 0.293617 -0.083444 1.838911 -0.050243 0.444002 1.425675 0.812741 0.728420 0.505166 0.737245 1.256666 1.911599 0.384822)
- 6.058136 #(0.000000 -0.021770 0.018901 0.439476 1.003477 0.859441 0.019351 1.721839 0.345805 0.234535 1.519443 0.503441 0.356442 0.416885 0.030839 -0.020167 0.056498 0.603049 1.590340 0.966971 0.922202 0.689424 0.952624 1.488151 0.129980 0.653028)
- 6.056645 #(0.000000 -0.016558 0.026579 0.448353 1.015651 0.876809 0.043994 1.754158 0.381360 0.275434 1.572444 0.558006 0.419413 0.493841 0.110178 0.066677 0.147843 0.710739 1.703199 1.084656 1.051087 0.819777 1.096976 1.639534 0.286953 0.830565)
+ 6.060342 #r(0.000000 -0.041165 -0.003731 0.423811 0.999953 0.846414 -0.006772 1.678875 0.280560 0.164498 1.427575 0.432370 0.295956 0.293617 -0.083444 1.838911 -0.050243 0.444002 1.425675 0.812741 0.728420 0.505166 0.737245 1.256666 1.911599 0.384822)
+ 6.058136 #r(0.000000 -0.021770 0.018901 0.439476 1.003477 0.859441 0.019351 1.721839 0.345805 0.234535 1.519443 0.503441 0.356442 0.416885 0.030839 -0.020167 0.056498 0.603049 1.590340 0.966971 0.922202 0.689424 0.952624 1.488151 0.129980 0.653028)
+ 6.056645 #r(0.000000 -0.016558 0.026579 0.448353 1.015651 0.876809 0.043994 1.754158 0.381360 0.275434 1.572444 0.558006 0.419413 0.493841 0.110178 0.066677 0.147843 0.710739 1.703199 1.084656 1.051087 0.819777 1.096976 1.639534 0.286953 0.830565)
;; 25+1
- 6.122073 #(0.000000 0.460498 1.557923 1.378525 1.718931 0.447198 0.063372 0.871474 1.497987 0.124645 1.393742 0.468348 -0.079259 1.274284 -0.437034 1.081613 1.726707 1.093435 1.712067 0.466467 1.547007 0.967081 1.258363 0.304978 0.430183 0.007813)
+ 6.122073 #r(0.000000 0.460498 1.557923 1.378525 1.718931 0.447198 0.063372 0.871474 1.497987 0.124645 1.393742 0.468348 -0.079259 1.274284 -0.437034 1.081613 1.726707 1.093435 1.712067 0.466467 1.547007 0.967081 1.258363 0.304978 0.430183 0.007813)
;; 27-1
- 6.163135 #(0.000000 0.728435 -0.162948 -0.044439 -0.171766 1.094395 0.029113 0.072422 1.082217 0.879605 -0.111434 1.156162 1.018106 0.872058 0.997367 0.178509 -0.068227 -0.141285 1.119460 -0.213041 0.834585 -0.226205 0.775314 -0.211931 0.098174 0.839934)
+ 6.163135 #r(0.000000 0.728435 -0.162948 -0.044439 -0.171766 1.094395 0.029113 0.072422 1.082217 0.879605 -0.111434 1.156162 1.018106 0.872058 0.997367 0.178509 -0.068227 -0.141285 1.119460 -0.213041 0.834585 -0.226205 0.775314 -0.211931 0.098174 0.839934)
;; 24+2
- 6.157978 #(0.000000 0.747592 -0.138036 -0.096812 -0.252632 1.140904 0.038566 0.088301 1.237633 1.010838 0.001393 0.982309 1.045743 0.842207 0.970725 0.281016 0.130720 0.128208 1.180011 0.026054 0.957275 -0.052702 1.071527 -0.026637 0.338920 1.156596)
+ 6.157978 #r(0.000000 0.747592 -0.138036 -0.096812 -0.252632 1.140904 0.038566 0.088301 1.237633 1.010838 0.001393 0.982309 1.045743 0.842207 0.970725 0.281016 0.130720 0.128208 1.180011 0.026054 0.957275 -0.052702 1.071527 -0.026637 0.338920 1.156596)
)
;;; 27 prime --------------------------------------------------------------------------------
-(vector 27 6.9491486549377 #(0 1 0 0 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 1 1 1 0 1 1 0 1)
+(vector 27 6.9491486549377 #r(0 1 0 0 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 1 1 1 0 1 1 0 1)
- 6.133994 #(0.000000 1.619323 0.268498 0.605329 0.261788 1.741906 1.690385 1.044397 0.095253 1.526766 0.682732 1.844188 1.227922 -0.046848 0.854154 -0.053734 1.525611 0.460071 0.230079 1.191101 1.252287 1.704028 -0.029667 1.798141 1.802482 1.571525 0.379519)
+ 6.133994 #r(0.000000 1.619323 0.268498 0.605329 0.261788 1.741906 1.690385 1.044397 0.095253 1.526766 0.682732 1.844188 1.227922 -0.046848 0.854154 -0.053734 1.525611 0.460071 0.230079 1.191101 1.252287 1.704028 -0.029667 1.798141 1.802482 1.571525 0.379519)
)
;;; 28 prime --------------------------------------------------------------------------------
-(vector 28 7.1576952934265 #(0 1 1 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 0 0)
+(vector 28 7.1576952934265 #r(0 1 1 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 0 0)
- 6.190947 #(0.000000 0.460822 1.000235 0.802902 1.169351 0.023696 1.059034 0.557253 0.339303 -0.037893 0.757652 1.745281 0.808299 1.572816 1.228654 0.154747 0.925847 0.957314 0.565556 0.484885 0.864794 1.110639 0.659146 1.596331 1.587743 0.524304 1.470688 0.086831)
+ 6.190947 #r(0.000000 0.460822 1.000235 0.802902 1.169351 0.023696 1.059034 0.557253 0.339303 -0.037893 0.757652 1.745281 0.808299 1.572816 1.228654 0.154747 0.925847 0.957314 0.565556 0.484885 0.864794 1.110639 0.659146 1.596331 1.587743 0.524304 1.470688 0.086831)
)
;;; 29 prime --------------------------------------------------------------------------------
-(vector 29 7.2415904369233 #(0 0 1 1 1 0 0 1 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 1 1 1 1 0)
+(vector 29 7.2415904369233 #r(0 0 1 1 1 0 0 1 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 1 1 1 1 0)
- 6.364996 #(0.000000 0.899299 0.027883 1.660781 0.583908 0.594226 1.394105 1.009420 -0.076432 0.063436 1.779221 1.537249 1.002516 1.590894 -0.057219 1.023692 1.515341 1.279493 0.140022 -0.035094 0.723643 0.484040 0.612756 1.373872 1.209603 1.304864 0.985337 0.845953 0.581252)
+ 6.364996 #r(0.000000 0.899299 0.027883 1.660781 0.583908 0.594226 1.394105 1.009420 -0.076432 0.063436 1.779221 1.537249 1.002516 1.590894 -0.057219 1.023692 1.515341 1.279493 0.140022 -0.035094 0.723643 0.484040 0.612756 1.373872 1.209603 1.304864 0.985337 0.845953 0.581252)
)
;;; 30 prime --------------------------------------------------------------------------------
-(vector 30 7.1189651489258 #(0 0 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 0 1 0 0 1 0)
+(vector 30 7.1189651489258 #r(0 0 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 0 1 0 0 1 0)
- 6.451812 #(0.000000 1.683608 0.803658 0.933316 0.850814 1.701341 1.277986 1.473972 1.214431 1.898492 0.954836 1.784293 1.951482 1.381903 0.107238 0.105553 1.260609 1.566570 0.409971 0.385253 1.590967 0.968660 0.054889 0.914665 1.664915 1.656054 1.094096 1.343614 0.650979 0.864222)
+ 6.451812 #r(0.000000 1.683608 0.803658 0.933316 0.850814 1.701341 1.277986 1.473972 1.214431 1.898492 0.954836 1.784293 1.951482 1.381903 0.107238 0.105553 1.260609 1.566570 0.409971 0.385253 1.590967 0.968660 0.054889 0.914665 1.664915 1.656054 1.094096 1.343614 0.650979 0.864222)
)
;;; 31 prime --------------------------------------------------------------------------------
-(vector 31 7.4906754493713 #(0 0 1 0 1 1 1 1 1 0 0 0 1 1 1 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 1)
+(vector 31 7.4906754493713 #r(0 0 1 0 1 1 1 1 1 0 0 0 1 1 1 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 1)
- 6.701515 #(0.000000 0.707031 0.658082 0.778665 1.395076 0.565253 0.395956 1.065744 1.710897 0.801620 1.512714 1.121124 1.688469 1.338401 0.622466 1.725968 1.295045 0.892738 0.244280 0.958065 0.828867 0.800413 0.064995 1.349330 1.878947 0.861664 0.695097 1.073201 0.907698 1.910585 0.416756)
+ 6.701515 #r(0.000000 0.707031 0.658082 0.778665 1.395076 0.565253 0.395956 1.065744 1.710897 0.801620 1.512714 1.121124 1.688469 1.338401 0.622466 1.725968 1.295045 0.892738 0.244280 0.958065 0.828867 0.800413 0.064995 1.349330 1.878947 0.861664 0.695097 1.073201 0.907698 1.910585 0.416756)
;; 30+1
- 6.615976 #(0.000000 1.619082 0.923169 1.083084 0.781957 1.611725 1.231796 1.488577 1.226090 0.083999 1.020558 1.699217 -0.014673 1.346295 -0.063182 -0.022308 1.145334 1.655017 0.305814 0.373230 1.594198 0.992544 0.008700 0.844473 1.661053 1.801356 0.850925 1.501091 0.639723 0.929876 0.176165)
+ 6.615976 #r(0.000000 1.619082 0.923169 1.083084 0.781957 1.611725 1.231796 1.488577 1.226090 0.083999 1.020558 1.699217 -0.014673 1.346295 -0.063182 -0.022308 1.145334 1.655017 0.305814 0.373230 1.594198 0.992544 0.008700 0.844473 1.661053 1.801356 0.850925 1.501091 0.639723 0.929876 0.176165)
)
;;; 32 prime --------------------------------------------------------------------------------
-(vector 32 7.6309351921082 #(0 0 1 1 1 1 1 1 1 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 0 0 1 0)
+(vector 32 7.6309351921082 #r(0 0 1 1 1 1 1 1 1 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 0 0 1 0)
- 6.829554 #(0.000000 0.353769 0.512450 0.072420 0.585526 0.147200 0.899992 1.177093 0.978539 1.319655 0.744178 0.765351 0.245581 0.971119 0.793076 1.664663 0.073560 1.968693 0.219541 -0.142255 1.387234 0.796908 0.143099 1.544481 1.359170 -0.183896 0.300411 0.910906 1.770472 1.091214 0.308566 1.575721)
+ 6.829554 #r(0.000000 0.353769 0.512450 0.072420 0.585526 0.147200 0.899992 1.177093 0.978539 1.319655 0.744178 0.765351 0.245581 0.971119 0.793076 1.664663 0.073560 1.968693 0.219541 -0.142255 1.387234 0.796908 0.143099 1.544481 1.359170 -0.183896 0.300411 0.910906 1.770472 1.091214 0.308566 1.575721)
;; 31+1
- 6.864557 #(0.000000 1.684531 0.907871 0.937049 0.576460 1.576459 1.338803 1.563265 1.353157 -0.035626 1.089066 1.735003 -0.147935 1.441252 -0.039130 -0.134227 1.098931 1.555167 0.496142 0.453987 1.332697 1.055734 0.066385 0.757972 1.840407 1.616574 0.776929 1.400044 0.751413 0.894663 0.088525 0.248633)
+ 6.864557 #r(0.000000 1.684531 0.907871 0.937049 0.576460 1.576459 1.338803 1.563265 1.353157 -0.035626 1.089066 1.735003 -0.147935 1.441252 -0.039130 -0.134227 1.098931 1.555167 0.496142 0.453987 1.332697 1.055734 0.066385 0.757972 1.840407 1.616574 0.776929 1.400044 0.751413 0.894663 0.088525 0.248633)
;; 33-1
- 6.772281 #(0.000000 -0.104424 1.369006 0.833384 0.832316 0.684545 1.080484 0.996539 1.125140 0.264781 0.104162 1.034076 1.132845 0.966270 -0.147521 -0.070104 -0.108305 0.137329 0.336575 0.120508 -0.030229 1.160998 -0.149314 0.018366 1.122475 -0.088339 0.190809 0.749038 -0.017283 -0.181633 0.895249 0.011511)
+ 6.772281 #r(0.000000 -0.104424 1.369006 0.833384 0.832316 0.684545 1.080484 0.996539 1.125140 0.264781 0.104162 1.034076 1.132845 0.966270 -0.147521 -0.070104 -0.108305 0.137329 0.336575 0.120508 -0.030229 1.160998 -0.149314 0.018366 1.122475 -0.088339 0.190809 0.749038 -0.017283 -0.181633 0.895249 0.011511)
)
;;; 33 prime --------------------------------------------------------------------------------
-(vector 33 7.7389698028564 #(0 1 0 1 0 0 0 1 0 0 0 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 0 1 0 0 1 1 0)
+(vector 33 7.7389698028564 #r(0 1 0 1 0 0 0 1 0 0 0 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 0 1 0 0 1 1 0)
- 6.846444 #(0.000000 1.540730 1.269040 0.749184 0.961715 0.756150 0.876752 0.416027 1.022774 0.964239 1.083376 0.550495 1.494046 0.196678 0.925862 0.362000 0.602774 1.401166 0.181115 1.142230 0.264880 0.003237 0.994773 0.034504 0.433160 0.985315 1.781928 0.301442 1.605371 1.626266 0.719713 0.024414 0.683173)
+ 6.846444 #r(0.000000 1.540730 1.269040 0.749184 0.961715 0.756150 0.876752 0.416027 1.022774 0.964239 1.083376 0.550495 1.494046 0.196678 0.925862 0.362000 0.602774 1.401166 0.181115 1.142230 0.264880 0.003237 0.994773 0.034504 0.433160 0.985315 1.781928 0.301442 1.605371 1.626266 0.719713 0.024414 0.683173)
)
;;; 34 prime --------------------------------------------------------------------------------
-(vector 34 7.9624452590942 #(0 0 0 1 1 1 1 0 0 0 1 1 0 0 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 1 1 0 0 0)
+(vector 34 7.9624452590942 #r(0 0 0 1 1 1 1 0 0 0 1 1 0 0 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 1 1 0 0 0)
- 6.991192 #(0.000000 1.753519 0.200582 1.709673 0.364080 0.826783 0.339745 0.629017 1.916751 1.209744 1.171294 -1.878381 1.379347 0.682133 1.526150 -0.403398 1.590798 1.225400 1.046260 0.612397 0.683970 1.216405 0.626313 0.038228 1.289324 1.063867 0.495350 0.036835 0.806562 1.424403 1.251942 0.446062 1.562643 0.395827)
+ 6.991192 #r(0.000000 1.753519 0.200582 1.709673 0.364080 0.826783 0.339745 0.629017 1.916751 1.209744 1.171294 -1.878381 1.379347 0.682133 1.526150 -0.403398 1.590798 1.225400 1.046260 0.612397 0.683970 1.216405 0.626313 0.038228 1.289324 1.063867 0.495350 0.036835 0.806562 1.424403 1.251942 0.446062 1.562643 0.395827)
)
;;; 35 prime --------------------------------------------------------------------------------
-(vector 35 8.0019035339355 #(0 0 1 1 0 0 0 1 1 1 0 0 0 0 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 1 1 0 0 0 0)
+(vector 35 8.0019035339355 #r(0 0 1 1 0 0 0 1 1 1 0 0 0 0 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 1 1 0 0 0 0)
- 7.163607 #(0.000000 1.266503 0.439150 0.502027 -0.033212 1.025554 1.236433 1.852606 1.521580 0.894650 0.982935 1.338812 0.175216 1.929333 1.483026 0.812681 0.144350 1.543173 0.347773 0.191753 0.996456 1.584603 0.595312 0.526825 0.409349 0.179419 0.765371 0.331481 0.734526 0.534073 1.395010 0.148584 0.213643 0.199292 1.071967)
+ 7.163607 #r(0.000000 1.266503 0.439150 0.502027 -0.033212 1.025554 1.236433 1.852606 1.521580 0.894650 0.982935 1.338812 0.175216 1.929333 1.483026 0.812681 0.144350 1.543173 0.347773 0.191753 0.996456 1.584603 0.595312 0.526825 0.409349 0.179419 0.765371 0.331481 0.734526 0.534073 1.395010 0.148584 0.213643 0.199292 1.071967)
;; 34+1
- 7.250722 #(0.000000 1.833406 0.276500 1.676183 0.284824 0.952861 0.274961 0.549393 1.855724 1.259088 1.170735 -1.972280 1.233657 0.707290 1.353858 -0.502547 1.522469 1.324648 0.749540 0.580274 0.753018 1.178005 0.466257 0.194427 1.292227 0.949230 0.518969 0.114495 0.772899 1.429905 1.258425 0.333692 1.615077 0.323568 0.024260)
+ 7.250722 #r(0.000000 1.833406 0.276500 1.676183 0.284824 0.952861 0.274961 0.549393 1.855724 1.259088 1.170735 -1.972280 1.233657 0.707290 1.353858 -0.502547 1.522469 1.324648 0.749540 0.580274 0.753018 1.178005 0.466257 0.194427 1.292227 0.949230 0.518969 0.114495 0.772899 1.429905 1.258425 0.333692 1.615077 0.323568 0.024260)
;; 36-1
- 7.226635 #(0.000000 0.015639 1.313898 1.067017 0.012678 0.205933 -0.220601 0.741706 1.132622 1.273222 0.064153 -0.061062 0.016379 -0.109368 1.266070 0.708642 0.100132 0.506303 0.326245 0.009869 0.128374 0.656500 0.103915 0.211137 -0.048847 0.134642 0.911060 -0.081204 1.078761 0.959214 1.298439 0.058469 -0.265528 -0.047843 0.487719)
+ 7.226635 #r(0.000000 0.015639 1.313898 1.067017 0.012678 0.205933 -0.220601 0.741706 1.132622 1.273222 0.064153 -0.061062 0.016379 -0.109368 1.266070 0.708642 0.100132 0.506303 0.326245 0.009869 0.128374 0.656500 0.103915 0.211137 -0.048847 0.134642 0.911060 -0.081204 1.078761 0.959214 1.298439 0.058469 -0.265528 -0.047843 0.487719)
;; 37-2
- 7.337307 #(0.000000 1.255715 1.209445 1.285464 0.609971 1.084010 0.746511 0.131735 0.992588 -0.165317 1.349080 0.347697 1.563547 0.269558 1.052909 1.187133 0.630960 0.126283 1.974444 0.920793 0.149276 0.235777 0.684763 0.805570 1.167945 0.309490 0.732548 0.639985 1.194191 -0.082787 0.442732 0.130132 1.297597 1.522523 -0.004298)
+ 7.337307 #r(0.000000 1.255715 1.209445 1.285464 0.609971 1.084010 0.746511 0.131735 0.992588 -0.165317 1.349080 0.347697 1.563547 0.269558 1.052909 1.187133 0.630960 0.126283 1.974444 0.920793 0.149276 0.235777 0.684763 0.805570 1.167945 0.309490 0.732548 0.639985 1.194191 -0.082787 0.442732 0.130132 1.297597 1.522523 -0.004298)
;; 36-1 again
- 7.270607 #(0.000000 1.224685 0.688298 0.933888 0.799409 1.040304 0.882804 1.691450 1.134732 0.118453 1.557180 0.586802 1.344681 0.201498 1.086994 1.546739 0.883322 0.653756 0.179650 1.296869 -0.225456 -0.099064 0.999391 0.575486 1.210161 0.192596 0.624682 0.585705 1.229555 0.174654 0.165564 0.036132 1.525777 1.424254 0.061875)
+ 7.270607 #r(0.000000 1.224685 0.688298 0.933888 0.799409 1.040304 0.882804 1.691450 1.134732 0.118453 1.557180 0.586802 1.344681 0.201498 1.086994 1.546739 0.883322 0.653756 0.179650 1.296869 -0.225456 -0.099064 0.999391 0.575486 1.210161 0.192596 0.624682 0.585705 1.229555 0.174654 0.165564 0.036132 1.525777 1.424254 0.061875)
)
;;; 36 prime --------------------------------------------------------------------------------
-(vector 36 8.3031883239746 #(0 0 0 1 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0)
+(vector 36 8.3031883239746 #r(0 0 0 1 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0)
- 7.274340 #(0.000000 0.295214 1.648256 0.584870 0.666257 0.185867 0.791897 0.205307 0.094941 1.078003 0.393529 1.106172 0.869922 0.874970 0.914168 -0.075429 0.352173 -0.206951 1.433194 0.016874 1.804925 1.769354 0.780563 1.415336 1.733698 0.569376 0.514365 1.527457 0.738716 1.585860 0.004452 0.303849 0.468887 1.200500 1.687045 -0.272506)
+ 7.274340 #r(0.000000 0.295214 1.648256 0.584870 0.666257 0.185867 0.791897 0.205307 0.094941 1.078003 0.393529 1.106172 0.869922 0.874970 0.914168 -0.075429 0.352173 -0.206951 1.433194 0.016874 1.804925 1.769354 0.780563 1.415336 1.733698 0.569376 0.514365 1.527457 0.738716 1.585860 0.004452 0.303849 0.468887 1.200500 1.687045 -0.272506)
;; 34+2
- 7.326328 #(0.000000 0.224320 -0.145696 0.800619 0.068109 0.664686 1.202282 -0.026091 0.124729 1.390134 0.094406 0.787084 -0.284049 0.196932 0.011705 -0.061258 1.288162 0.209106 0.650222 0.837106 1.144479 -0.004444 -0.079317 -0.252873 1.282751 1.105461 -0.151235 -0.220044 0.048391 0.784914 0.800542 0.208916 -0.135577 0.180326 -0.083829 0.058422)
+ 7.326328 #r(0.000000 0.224320 -0.145696 0.800619 0.068109 0.664686 1.202282 -0.026091 0.124729 1.390134 0.094406 0.787084 -0.284049 0.196932 0.011705 -0.061258 1.288162 0.209106 0.650222 0.837106 1.144479 -0.004444 -0.079317 -0.252873 1.282751 1.105461 -0.151235 -0.220044 0.048391 0.784914 0.800542 0.208916 -0.135577 0.180326 -0.083829 0.058422)
;; 37-1
- 7.188203 #(0.000000 1.311785 0.710177 0.919863 0.806114 1.220385 0.913244 1.649138 1.158903 -0.117650 1.420543 0.532433 1.420824 0.031354 1.130470 1.529113 0.851075 0.566610 -0.022612 1.109803 -0.179865 -0.219467 1.014788 0.671450 1.268941 0.095596 0.593655 0.518696 1.410763 0.018554 0.158212 0.022548 1.368086 1.347905 1.919434 1.204584)
+ 7.188203 #r(0.000000 1.311785 0.710177 0.919863 0.806114 1.220385 0.913244 1.649138 1.158903 -0.117650 1.420543 0.532433 1.420824 0.031354 1.130470 1.529113 0.851075 0.566610 -0.022612 1.109803 -0.179865 -0.219467 1.014788 0.671450 1.268941 0.095596 0.593655 0.518696 1.410763 0.018554 0.158212 0.022548 1.368086 1.347905 1.919434 1.204584)
)
;;; 37 prime --------------------------------------------------------------------------------
-(vector 37 8.4775905609131 #(0 0 1 0 0 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 1 0 1 0 0 1 1)
+(vector 37 8.4775905609131 #r(0 0 1 0 0 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 1 0 1 0 0 1 1)
- 7.291595 #(0.000000 1.385574 1.094219 1.256844 0.579410 1.074351 0.652085 1.737017 1.132509 0.023783 1.497034 0.201580 1.618763 0.156207 1.295800 1.067404 0.684624 0.145230 1.829069 1.057901 0.013674 0.026959 0.892842 0.719241 1.431201 0.175608 0.784924 0.608541 1.031616 0.099402 0.526982 -0.079447 1.301608 1.399791 1.919478 1.303159 1.654914)
+ 7.291595 #r(0.000000 1.385574 1.094219 1.256844 0.579410 1.074351 0.652085 1.737017 1.132509 0.023783 1.497034 0.201580 1.618763 0.156207 1.295800 1.067404 0.684624 0.145230 1.829069 1.057901 0.013674 0.026959 0.892842 0.719241 1.431201 0.175608 0.784924 0.608541 1.031616 0.099402 0.526982 -0.079447 1.301608 1.399791 1.919478 1.303159 1.654914)
)
;;; 38 prime --------------------------------------------------------------------------------
-(vector 38 8.5527725219727 #(0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0)
+(vector 38 8.5527725219727 #r(0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0)
- 7.395907 #(0.000000 0.229361 1.165787 -0.110257 0.360118 0.958030 0.069946 0.724227 0.169462 0.629891 1.545997 1.736970 0.340776 1.117984 1.362890 -0.333746 0.304546 0.284267 1.101870 -0.220411 1.748591 0.492644 0.009938 0.667006 1.844837 0.974373 0.297199 0.452149 0.892727 0.659717 0.488303 1.523287 0.213584 0.164389 -0.141331 1.392379 0.641595 0.183921)
+ 7.395907 #r(0.000000 0.229361 1.165787 -0.110257 0.360118 0.958030 0.069946 0.724227 0.169462 0.629891 1.545997 1.736970 0.340776 1.117984 1.362890 -0.333746 0.304546 0.284267 1.101870 -0.220411 1.748591 0.492644 0.009938 0.667006 1.844837 0.974373 0.297199 0.452149 0.892727 0.659717 0.488303 1.523287 0.213584 0.164389 -0.141331 1.392379 0.641595 0.183921)
)
;;; 39 prime --------------------------------------------------------------------------------
-(vector 39 8.8173857964668 #(0 0 1 0 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0)
+(vector 39 8.8173857964668 #r(0 0 1 0 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0)
- 7.452083 #(0.000000 -0.003327 0.916189 -0.059920 1.642633 1.388547 0.951086 0.403885 -0.174730 0.969870 0.918579 1.463076 0.392796 0.310790 1.322505 1.568519 -0.013721 1.080957 1.546749 1.334291 1.196748 1.241477 0.666226 0.658367 0.483066 0.709740 0.970447 1.021587 1.015221 1.154977 1.464323 0.177481 1.236124 1.797764 1.373028 0.022625 0.381731 1.433474 1.548372)
+ 7.452083 #r(0.000000 -0.003327 0.916189 -0.059920 1.642633 1.388547 0.951086 0.403885 -0.174730 0.969870 0.918579 1.463076 0.392796 0.310790 1.322505 1.568519 -0.013721 1.080957 1.546749 1.334291 1.196748 1.241477 0.666226 0.658367 0.483066 0.709740 0.970447 1.021587 1.015221 1.154977 1.464323 0.177481 1.236124 1.797764 1.373028 0.022625 0.381731 1.433474 1.548372)
)
;;; 40 prime --------------------------------------------------------------------------------
-(vector 40 8.9134502410889 #(0 0 1 0 1 1 0 0 1 0 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 0 0 0 0 1 1 0 1 1 0 1)
+(vector 40 8.9134502410889 #r(0 0 1 0 1 1 0 0 1 0 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 0 0 0 0 1 1 0 1 1 0 1)
- 7.703588 #(0.000000 1.735488 1.656851 1.224286 0.044381 0.581732 0.870499 0.678243 0.396963 1.559949 1.753552 0.343685 1.182244 0.436049 0.704051 1.315848 0.612950 0.283482 1.616300 0.417655 1.870367 0.045128 0.404846 0.027986 1.838093 1.350622 0.788217 0.264993 1.270928 0.453126 0.746731 1.438328 0.714772 1.669939 -0.004462 0.932368 1.451203 0.182154 1.479009 1.559243)
+ 7.703588 #r(0.000000 1.735488 1.656851 1.224286 0.044381 0.581732 0.870499 0.678243 0.396963 1.559949 1.753552 0.343685 1.182244 0.436049 0.704051 1.315848 0.612950 0.283482 1.616300 0.417655 1.870367 0.045128 0.404846 0.027986 1.838093 1.350622 0.788217 0.264993 1.270928 0.453126 0.746731 1.438328 0.714772 1.669939 -0.004462 0.932368 1.451203 0.182154 1.479009 1.559243)
;; 39+1
- 7.542973 #(0.000000 -0.041200 1.048990 -0.088096 1.469596 1.426659 0.704430 0.532863 -0.271666 1.021284 0.854349 1.691302 0.165173 0.234052 1.293759 1.553143 -0.290199 1.111317 1.388897 1.428535 1.198923 1.295686 0.607124 0.554003 0.553080 0.829915 1.372981 1.113790 0.892248 1.036179 1.715559 0.155629 1.485519 1.734906 1.416427 0.111242 0.390867 1.435517 1.580034 0.394829)
+ 7.542973 #r(0.000000 -0.041200 1.048990 -0.088096 1.469596 1.426659 0.704430 0.532863 -0.271666 1.021284 0.854349 1.691302 0.165173 0.234052 1.293759 1.553143 -0.290199 1.111317 1.388897 1.428535 1.198923 1.295686 0.607124 0.554003 0.553080 0.829915 1.372981 1.113790 0.892248 1.036179 1.715559 0.155629 1.485519 1.734906 1.416427 0.111242 0.390867 1.435517 1.580034 0.394829)
)
;;; 41 prime --------------------------------------------------------------------------------
-(vector 41 9.1567583084106 #(0 1 0 0 0 1 0 1 0 0 0 1 1 0 0 1 0 1 1 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0)
+(vector 41 9.1567583084106 #r(0 1 0 0 0 1 0 1 0 0 0 1 1 0 0 1 0 1 1 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0)
- 7.865855 #(0.000000 0.608338 -0.060098 1.260166 0.343974 0.016950 -0.247861 -0.127427 0.108013 -0.084777 1.510985 0.480995 1.445979 -0.013184 1.345726 0.790782 0.040458 1.554753 1.065658 0.404394 0.487625 0.747477 1.296516 0.562390 1.713973 0.682704 0.619563 0.946390 0.938148 0.771516 1.743852 1.318578 0.561202 0.223419 0.656108 1.580261 0.293473 0.865769 0.313306 1.414219 0.732206)
+ 7.865855 #r(0.000000 0.608338 -0.060098 1.260166 0.343974 0.016950 -0.247861 -0.127427 0.108013 -0.084777 1.510985 0.480995 1.445979 -0.013184 1.345726 0.790782 0.040458 1.554753 1.065658 0.404394 0.487625 0.747477 1.296516 0.562390 1.713973 0.682704 0.619563 0.946390 0.938148 0.771516 1.743852 1.318578 0.561202 0.223419 0.656108 1.580261 0.293473 0.865769 0.313306 1.414219 0.732206)
;; 40 + 1
- 7.720320 #(0.000000 -0.115191 1.182807 0.023805 1.562688 1.390669 0.693038 0.384401 -0.432021 0.902901 0.808566 1.764939 0.071559 0.180956 1.306988 1.386263 -0.325917 1.184850 1.379486 1.267820 1.088531 1.531591 0.443244 0.383528 0.465953 0.767254 1.394223 1.223657 0.755343 1.085342 1.737843 0.118005 1.556067 1.593289 1.235706 0.152645 0.264917 1.446707 1.588810 0.262147 0.136941)
+ 7.720320 #r(0.000000 -0.115191 1.182807 0.023805 1.562688 1.390669 0.693038 0.384401 -0.432021 0.902901 0.808566 1.764939 0.071559 0.180956 1.306988 1.386263 -0.325917 1.184850 1.379486 1.267820 1.088531 1.531591 0.443244 0.383528 0.465953 0.767254 1.394223 1.223657 0.755343 1.085342 1.737843 0.118005 1.556067 1.593289 1.235706 0.152645 0.264917 1.446707 1.588810 0.262147 0.136941)
)
;;; 42 prime --------------------------------------------------------------------------------
-(vector 42 9.2193641662598 #(0 0 0 1 1 0 1 1 0 0 1 0 0 0 0 1 1 1 0 1 0 1 1 1 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0)
+(vector 42 9.2193641662598 #r(0 0 0 1 1 0 1 1 0 0 1 0 0 0 0 1 1 1 0 1 0 1 1 1 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0)
- 7.967849 #(0.000000 -0.295563 -0.099748 1.645998 0.994997 1.211069 1.302259 1.702033 0.311003 1.380194 1.021127 1.240710 0.343052 -0.024723 0.792276 0.383501 1.598556 0.301882 1.243030 0.805694 1.869672 1.515585 0.818223 0.277882 0.151155 1.792151 0.439910 1.043803 1.106182 0.814125 1.169477 0.353168 0.087800 0.390591 1.058086 1.167577 0.254783 0.202834 1.385207 0.802821 0.860337 0.585161)
+ 7.967849 #r(0.000000 -0.295563 -0.099748 1.645998 0.994997 1.211069 1.302259 1.702033 0.311003 1.380194 1.021127 1.240710 0.343052 -0.024723 0.792276 0.383501 1.598556 0.301882 1.243030 0.805694 1.869672 1.515585 0.818223 0.277882 0.151155 1.792151 0.439910 1.043803 1.106182 0.814125 1.169477 0.353168 0.087800 0.390591 1.058086 1.167577 0.254783 0.202834 1.385207 0.802821 0.860337 0.585161)
;; 41+1
- 7.869767 #(0.000000 -0.061943 1.138293 -0.062352 1.677941 1.387789 0.696129 0.354209 -0.606277 0.820682 0.889412 1.749845 0.156626 0.153950 1.241240 1.226387 -0.243954 1.180563 1.446765 1.133383 1.088516 1.534516 0.379614 0.441871 0.531294 0.625705 1.211996 1.249505 0.811274 1.137271 1.690807 0.091208 1.719416 1.589298 1.288167 0.231299 0.255350 1.544776 1.691946 0.324682 0.145604 -0.146627)
+ 7.869767 #r(0.000000 -0.061943 1.138293 -0.062352 1.677941 1.387789 0.696129 0.354209 -0.606277 0.820682 0.889412 1.749845 0.156626 0.153950 1.241240 1.226387 -0.243954 1.180563 1.446765 1.133383 1.088516 1.534516 0.379614 0.441871 0.531294 0.625705 1.211996 1.249505 0.811274 1.137271 1.690807 0.091208 1.719416 1.589298 1.288167 0.231299 0.255350 1.544776 1.691946 0.324682 0.145604 -0.146627)
)
;;; 43 prime --------------------------------------------------------------------------------
-(vector 43 9.4329051971436 #(0 0 1 0 0 1 0 0 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 0 0 1 1)
+(vector 43 9.4329051971436 #r(0 0 1 0 0 1 0 0 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 0 0 1 1)
- 8.045098 #(0.000000 1.817726 0.258426 -0.110242 1.213496 0.116841 0.189488 1.576716 0.807175 0.814618 0.974723 1.682997 0.507481 0.400625 1.207987 1.609632 0.042496 -0.018345 0.188609 1.537320 1.421611 1.487985 0.125474 1.195313 1.777900 0.097292 1.089983 0.284602 -0.035452 0.114851 -0.014176 0.684966 0.713816 1.698239 1.505014 0.277355 1.721721 1.307506 0.790560 -0.024590 1.696281 0.234403 1.469880)
+ 8.045098 #r(0.000000 1.817726 0.258426 -0.110242 1.213496 0.116841 0.189488 1.576716 0.807175 0.814618 0.974723 1.682997 0.507481 0.400625 1.207987 1.609632 0.042496 -0.018345 0.188609 1.537320 1.421611 1.487985 0.125474 1.195313 1.777900 0.097292 1.089983 0.284602 -0.035452 0.114851 -0.014176 0.684966 0.713816 1.698239 1.505014 0.277355 1.721721 1.307506 0.790560 -0.024590 1.696281 0.234403 1.469880)
;; 44-1
- 7.936372 #(0.000000 0.547620 0.739031 1.442428 0.549512 0.577585 0.459986 1.527195 1.215306 0.359566 1.254454 1.014209 0.650822 0.596119 0.113760 0.896295 1.336762 1.511746 1.057661 0.208519 1.475881 1.168554 0.473943 0.693948 1.550424 1.853884 0.945372 1.595949 0.778275 1.634785 0.682180 0.046625 1.212650 1.360060 1.301003 1.439535 -0.124409 0.942540 0.731761 1.333209 0.714942 0.471897 0.650290)
+ 7.936372 #r(0.000000 0.547620 0.739031 1.442428 0.549512 0.577585 0.459986 1.527195 1.215306 0.359566 1.254454 1.014209 0.650822 0.596119 0.113760 0.896295 1.336762 1.511746 1.057661 0.208519 1.475881 1.168554 0.473943 0.693948 1.550424 1.853884 0.945372 1.595949 0.778275 1.634785 0.682180 0.046625 1.212650 1.360060 1.301003 1.439535 -0.124409 0.942540 0.731761 1.333209 0.714942 0.471897 0.650290)
)
;;; 44 prime --------------------------------------------------------------------------------
-(vector 44 9.6263332366943 #(0 0 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 0 1 1 0 1)
+(vector 44 9.6263332366943 #r(0 0 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 0 1 1 0 1)
- 8.176709 #(0.000000 1.257550 0.185092 0.796030 0.965692 0.874957 0.509986 0.767942 0.341523 0.782136 0.038164 0.864386 1.769646 0.079272 0.204040 1.740714 1.803726 0.921433 1.521099 0.318212 0.489644 0.199834 1.292293 1.253087 0.592822 0.223282 1.099161 1.260064 0.604685 -0.025938 0.319010 0.021098 0.567021 1.052022 1.286473 1.481285 1.059939 -0.262037 0.222072 1.063305 0.811574 1.525604 0.928719 1.796860)
+ 8.176709 #r(0.000000 1.257550 0.185092 0.796030 0.965692 0.874957 0.509986 0.767942 0.341523 0.782136 0.038164 0.864386 1.769646 0.079272 0.204040 1.740714 1.803726 0.921433 1.521099 0.318212 0.489644 0.199834 1.292293 1.253087 0.592822 0.223282 1.099161 1.260064 0.604685 -0.025938 0.319010 0.021098 0.567021 1.052022 1.286473 1.481285 1.059939 -0.262037 0.222072 1.063305 0.811574 1.525604 0.928719 1.796860)
;; 45-1
- 8.096356 #(0.000000 0.562197 0.780059 1.445061 0.297993 0.361779 0.450977 1.579753 1.251177 0.406295 1.140037 1.270462 0.688429 0.742666 0.310753 0.814792 1.242058 1.590925 1.239292 0.244955 1.563091 1.453652 0.466187 0.926031 1.420624 1.869915 0.975705 1.750035 0.662252 1.713066 0.628893 0.005473 1.403763 1.231668 1.313745 1.548647 0.181657 1.165934 0.757198 1.479137 0.584746 0.478571 0.777834 -0.217890)
+ 8.096356 #r(0.000000 0.562197 0.780059 1.445061 0.297993 0.361779 0.450977 1.579753 1.251177 0.406295 1.140037 1.270462 0.688429 0.742666 0.310753 0.814792 1.242058 1.590925 1.239292 0.244955 1.563091 1.453652 0.466187 0.926031 1.420624 1.869915 0.975705 1.750035 0.662252 1.713066 0.628893 0.005473 1.403763 1.231668 1.313745 1.548647 0.181657 1.165934 0.757198 1.479137 0.584746 0.478571 0.777834 -0.217890)
)
;;; 45 prime --------------------------------------------------------------------------------
-(vector 45 9.7923860549927 #(0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 1)
+(vector 45 9.7923860549927 #r(0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 1)
- 8.156599 #(0.000000 0.504922 0.822887 1.454973 0.213937 0.312131 0.458345 1.480849 1.269108 0.365243 1.136961 1.370780 0.828694 0.744612 0.260671 0.781252 1.246491 1.660559 1.261864 0.159271 1.560422 1.570906 0.366422 0.845904 1.468563 1.922211 0.928352 1.793476 0.526909 1.787205 0.580505 0.086715 1.290991 1.241712 1.319383 1.542592 0.148589 1.164537 0.833531 1.339389 0.578898 0.484755 0.736594 -0.242427 0.801799)
+ 8.156599 #r(0.000000 0.504922 0.822887 1.454973 0.213937 0.312131 0.458345 1.480849 1.269108 0.365243 1.136961 1.370780 0.828694 0.744612 0.260671 0.781252 1.246491 1.660559 1.261864 0.159271 1.560422 1.570906 0.366422 0.845904 1.468563 1.922211 0.928352 1.793476 0.526909 1.787205 0.580505 0.086715 1.290991 1.241712 1.319383 1.542592 0.148589 1.164537 0.833531 1.339389 0.578898 0.484755 0.736594 -0.242427 0.801799)
)
;;; 46 prime --------------------------------------------------------------------------------
-(vector 46 9.7220277786255 #(0 0 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 0 1 0 1 0)
+(vector 46 9.7220277786255 #r(0 0 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 0 1 0 1 0)
- 8.261457 #(0.000000 0.441366 0.083292 1.447582 1.080353 0.774431 1.031820 0.396571 -0.029186 1.855247 0.017145 1.352007 1.097546 -0.117433 1.240120 0.492762 0.418188 1.012485 1.839598 0.629307 1.143304 0.248686 0.786166 1.148481 0.944111 0.160389 0.887598 1.383912 1.951363 0.089194 -0.493379 0.490615 1.318218 0.811054 1.210433 0.709880 -0.035076 1.496491 0.871523 0.967276 1.296575 1.252407 1.309942 0.517653 0.515382 1.088417)
+ 8.261457 #r(0.000000 0.441366 0.083292 1.447582 1.080353 0.774431 1.031820 0.396571 -0.029186 1.855247 0.017145 1.352007 1.097546 -0.117433 1.240120 0.492762 0.418188 1.012485 1.839598 0.629307 1.143304 0.248686 0.786166 1.148481 0.944111 0.160389 0.887598 1.383912 1.951363 0.089194 -0.493379 0.490615 1.318218 0.811054 1.210433 0.709880 -0.035076 1.496491 0.871523 0.967276 1.296575 1.252407 1.309942 0.517653 0.515382 1.088417)
)
;;; 47 prime --------------------------------------------------------------------------------
-(vector 47 10.0 #(0 0 1 1 0 0 1 0 1 0 1 1 1 1 0 0 1 0 1 1 1 0 1 0 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 1 1 0 0)
+(vector 47 10.0 #r(0 0 1 1 0 0 1 0 1 0 1 1 1 1 0 0 1 0 1 1 1 0 1 0 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 1 1 0 0)
- 8.421570 #(0.000000 1.199171 0.222010 0.019659 0.963763 0.124932 1.211729 1.737991 1.094580 1.129734 1.190285 0.683207 -0.164112 0.760349 0.581192 1.729176 1.903941 0.164043 1.172610 0.400191 0.298724 1.638863 1.039149 1.877811 1.604178 1.896976 0.373311 1.442981 1.057507 1.304308 1.366346 0.989245 1.435551 1.273331 -0.037405 1.342363 0.026228 1.277440 1.325955 1.225688 -0.091448 1.243683 1.490056 0.134719 0.038689 0.617889 0.397223)
+ 8.421570 #r(0.000000 1.199171 0.222010 0.019659 0.963763 0.124932 1.211729 1.737991 1.094580 1.129734 1.190285 0.683207 -0.164112 0.760349 0.581192 1.729176 1.903941 0.164043 1.172610 0.400191 0.298724 1.638863 1.039149 1.877811 1.604178 1.896976 0.373311 1.442981 1.057507 1.304308 1.366346 0.989245 1.435551 1.273331 -0.037405 1.342363 0.026228 1.277440 1.325955 1.225688 -0.091448 1.243683 1.490056 0.134719 0.038689 0.617889 0.397223)
;; 46+1
- 8.268289 #(0.000000 0.357443 0.232912 1.380147 1.115226 0.794363 1.003118 0.354162 -0.098010 1.882974 0.011731 1.431470 1.060533 -0.173886 1.243389 0.433576 0.427301 0.932883 1.964789 0.661151 1.135623 0.224910 0.703565 1.198466 0.988252 0.007869 0.877345 1.478313 1.822166 0.223930 -0.274799 0.527743 1.328214 0.957522 1.199220 0.836897 0.009700 1.499725 0.828964 0.836474 1.158394 1.390117 1.252214 0.607531 0.602372 1.108309 -0.308979)
+ 8.268289 #r(0.000000 0.357443 0.232912 1.380147 1.115226 0.794363 1.003118 0.354162 -0.098010 1.882974 0.011731 1.431470 1.060533 -0.173886 1.243389 0.433576 0.427301 0.932883 1.964789 0.661151 1.135623 0.224910 0.703565 1.198466 0.988252 0.007869 0.877345 1.478313 1.822166 0.223930 -0.274799 0.527743 1.328214 0.957522 1.199220 0.836897 0.009700 1.499725 0.828964 0.836474 1.158394 1.390117 1.252214 0.607531 0.602372 1.108309 -0.308979)
)
;;; 48 prime --------------------------------------------------------------------------------
-(vector 48 10.073040962219 #(0 0 0 1 1 1 1 1 0 1 0 0 1 1 1 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1)
+(vector 48 10.073040962219 #r(0 0 0 1 1 1 1 1 0 1 0 0 1 1 1 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1)
- 8.468727 #(0.000000 0.332125 1.567930 1.667264 0.442332 0.427404 0.736248 1.688653 -0.012194 0.001963 0.946717 0.783117 0.528363 1.021452 0.764794 0.424311 0.975629 0.318718 -0.017782 0.452256 -0.011646 0.634442 1.620045 1.251183 1.855810 -0.212250 0.823868 1.371356 1.272442 0.687371 1.532020 1.114788 -0.144494 0.601199 1.707870 0.646890 1.378450 0.845449 0.429827 0.928104 1.365712 1.152987 1.849756 1.181620 0.737310 0.960075 0.285625 -0.264250)
+ 8.468727 #r(0.000000 0.332125 1.567930 1.667264 0.442332 0.427404 0.736248 1.688653 -0.012194 0.001963 0.946717 0.783117 0.528363 1.021452 0.764794 0.424311 0.975629 0.318718 -0.017782 0.452256 -0.011646 0.634442 1.620045 1.251183 1.855810 -0.212250 0.823868 1.371356 1.272442 0.687371 1.532020 1.114788 -0.144494 0.601199 1.707870 0.646890 1.378450 0.845449 0.429827 0.928104 1.365712 1.152987 1.849756 1.181620 0.737310 0.960075 0.285625 -0.264250)
)
;;; 49 prime --------------------------------------------------------------------------------
-(vector 49 10.209 #(0 1 1 0 0 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 0 0 1 0 1 1 1 0 0 0 0)
+(vector 49 10.209 #r(0 1 1 0 0 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 0 0 1 0 1 1 1 0 0 0 0)
- 8.635701 #(0.000000 1.497567 0.290121 0.986848 0.952275 0.318809 -0.087393 0.815566 0.755417 1.644345 1.093196 1.596845 1.195048 1.825278 0.352544 1.500396 0.111683 1.721871 0.368622 0.016610 1.166008 0.992742 0.548001 1.794858 -0.049088 0.145023 0.031735 0.501144 1.167443 1.072488 1.771198 1.965444 1.813832 0.055643 1.178365 0.731304 -0.108216 1.823862 1.684500 1.505474 0.962838 1.663276 0.896417 -0.047513 0.341741 0.867962 0.622940 1.858325 1.225407)
+ 8.635701 #r(0.000000 1.497567 0.290121 0.986848 0.952275 0.318809 -0.087393 0.815566 0.755417 1.644345 1.093196 1.596845 1.195048 1.825278 0.352544 1.500396 0.111683 1.721871 0.368622 0.016610 1.166008 0.992742 0.548001 1.794858 -0.049088 0.145023 0.031735 0.501144 1.167443 1.072488 1.771198 1.965444 1.813832 0.055643 1.178365 0.731304 -0.108216 1.823862 1.684500 1.505474 0.962838 1.663276 0.896417 -0.047513 0.341741 0.867962 0.622940 1.858325 1.225407)
;; 48+1
- 8.663039 #(0.000000 0.233282 1.589447 1.671036 0.438087 0.414167 0.679012 1.728850 0.023692 0.137515 1.015881 0.702030 0.655508 0.905046 0.682763 0.579979 1.082390 0.228729 -0.103033 0.415057 0.029242 0.738968 1.600166 1.205869 1.975508 -0.109422 0.921796 1.220834 1.561720 0.608646 1.497185 1.060920 -0.116318 0.565733 1.743370 0.776166 1.333349 0.886037 0.536440 0.806648 1.332765 1.166311 1.868868 1.215596 0.738421 0.985296 0.279827 -0.366830 0.092455)
+ 8.663039 #r(0.000000 0.233282 1.589447 1.671036 0.438087 0.414167 0.679012 1.728850 0.023692 0.137515 1.015881 0.702030 0.655508 0.905046 0.682763 0.579979 1.082390 0.228729 -0.103033 0.415057 0.029242 0.738968 1.600166 1.205869 1.975508 -0.109422 0.921796 1.220834 1.561720 0.608646 1.497185 1.060920 -0.116318 0.565733 1.743370 0.776166 1.333349 0.886037 0.536440 0.806648 1.332765 1.166311 1.868868 1.215596 0.738421 0.985296 0.279827 -0.366830 0.092455)
;; 51-2
- 8.582839 #(0.000000 1.015072 1.263701 0.053109 -0.198567 -0.119876 -0.074305 0.688310 -0.022609 -0.056918 -0.335561 1.264545 0.175435 0.115160 0.045329 0.044221 0.357377 1.286502 1.011774 0.136492 0.790313 1.216480 1.412877 1.287840 -0.457032 1.185491 0.632250 1.022556 0.092623 0.762340 0.282587 1.173246 0.884457 -0.232556 1.275664 0.026771 1.001804 1.127230 -0.112893 0.390785 1.060560 -0.011579 0.935318 0.798092 1.155912 -0.045270 0.311662 -0.007451 -0.291556)
+ 8.582839 #r(0.000000 1.015072 1.263701 0.053109 -0.198567 -0.119876 -0.074305 0.688310 -0.022609 -0.056918 -0.335561 1.264545 0.175435 0.115160 0.045329 0.044221 0.357377 1.286502 1.011774 0.136492 0.790313 1.216480 1.412877 1.287840 -0.457032 1.185491 0.632250 1.022556 0.092623 0.762340 0.282587 1.173246 0.884457 -0.232556 1.275664 0.026771 1.001804 1.127230 -0.112893 0.390785 1.060560 -0.011579 0.935318 0.798092 1.155912 -0.045270 0.311662 -0.007451 -0.291556)
)
;;; 50 prime --------------------------------------------------------------------------------
-(vector 50 10.402973175049 #(0 0 1 0 0 0 1 1 1 0 1 1 0 0 1 1 1 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 1 0 1 1 0 0 0 1 1 1 0 0 1 1 1)
+(vector 50 10.402973175049 #r(0 0 1 0 0 0 1 1 1 0 1 1 0 0 1 1 1 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 1 0 1 1 0 0 0 1 1 1 0 0 1 1 1)
- 8.676090 #(0.000000 1.487746 1.059441 1.025372 1.327289 1.088034 0.562677 1.658212 1.275003 1.216651 1.253782 1.464671 0.843363 1.799547 0.053937 0.685289 -0.108899 0.042484 1.103905 1.939714 1.165290 1.002239 0.949057 0.182130 0.764686 0.473808 0.974801 0.114296 0.831687 0.096978 1.328258 1.232106 1.944542 0.907302 0.451517 -0.196659 0.834303 1.063413 0.149435 1.600622 0.877347 1.358710 0.921698 1.475066 0.048402 1.601242 0.635073 1.286124 0.058142 1.221762)
+ 8.676090 #r(0.000000 1.487746 1.059441 1.025372 1.327289 1.088034 0.562677 1.658212 1.275003 1.216651 1.253782 1.464671 0.843363 1.799547 0.053937 0.685289 -0.108899 0.042484 1.103905 1.939714 1.165290 1.002239 0.949057 0.182130 0.764686 0.473808 0.974801 0.114296 0.831687 0.096978 1.328258 1.232106 1.944542 0.907302 0.451517 -0.196659 0.834303 1.063413 0.149435 1.600622 0.877347 1.358710 0.921698 1.475066 0.048402 1.601242 0.635073 1.286124 0.058142 1.221762)
)
;;; 51 prime --------------------------------------------------------------------------------
-(vector 51 10.5841327092253 #(0 1 0 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 0 0 0 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 0 0 1 0 0 1)
+(vector 51 10.5841327092253 #r(0 1 0 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 0 0 0 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 0 0 1 0 0 1)
- 8.652946 #(0.000000 0.552138 1.581370 0.856634 0.465868 0.045489 1.205822 1.403218 0.756158 -0.011738 -0.321071 1.578958 0.777145 -0.086815 1.971735 0.371739 1.194751 0.827647 1.040995 0.971514 -0.103101 0.019110 0.372121 0.808088 0.569420 0.781614 0.253334 1.524564 0.516258 0.490039 0.356392 1.792991 0.344408 0.177045 1.267803 0.433404 0.355268 0.458783 0.927023 0.366207 1.155001 1.183690 0.095395 1.563819 1.892864 1.168287 1.234142 0.740278 0.190550 0.004346 0.616333)
+ 8.652946 #r(0.000000 0.552138 1.581370 0.856634 0.465868 0.045489 1.205822 1.403218 0.756158 -0.011738 -0.321071 1.578958 0.777145 -0.086815 1.971735 0.371739 1.194751 0.827647 1.040995 0.971514 -0.103101 0.019110 0.372121 0.808088 0.569420 0.781614 0.253334 1.524564 0.516258 0.490039 0.356392 1.792991 0.344408 0.177045 1.267803 0.433404 0.355268 0.458783 0.927023 0.366207 1.155001 1.183690 0.095395 1.563819 1.892864 1.168287 1.234142 0.740278 0.190550 0.004346 0.616333)
)
;;; 52 prime --------------------------------------------------------------------------------
-(vector 52 10.64324760437 #(0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 0 1 0 1 1 0 0 0 0 1 0 0 0 1 0 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0)
+(vector 52 10.64324760437 #r(0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 0 1 0 1 1 0 0 0 0 1 0 0 0 1 0 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0)
- 8.817479 #(0.000000 0.192798 -0.100823 0.105700 1.730433 1.638226 1.781516 0.446103 1.408775 0.715209 0.415865 -0.245030 1.066219 1.674348 0.092550 0.243790 1.271420 0.492458 1.433072 -0.090924 1.409056 0.418163 -0.043783 1.528262 0.043370 1.470310 -0.026080 0.499433 0.961527 0.302716 0.768317 0.686930 1.132134 1.628592 0.701543 1.788137 -0.034028 1.911798 1.160323 1.534119 1.837005 0.994515 0.926867 1.263245 0.147467 1.441753 0.596623 1.430563 0.749640 0.874777 1.097276 0.882051)
+ 8.817479 #r(0.000000 0.192798 -0.100823 0.105700 1.730433 1.638226 1.781516 0.446103 1.408775 0.715209 0.415865 -0.245030 1.066219 1.674348 0.092550 0.243790 1.271420 0.492458 1.433072 -0.090924 1.409056 0.418163 -0.043783 1.528262 0.043370 1.470310 -0.026080 0.499433 0.961527 0.302716 0.768317 0.686930 1.132134 1.628592 0.701543 1.788137 -0.034028 1.911798 1.160323 1.534119 1.837005 0.994515 0.926867 1.263245 0.147467 1.441753 0.596623 1.430563 0.749640 0.874777 1.097276 0.882051)
)
;;; 53 prime --------------------------------------------------------------------------------
-(vector 53 10.678050692694 #(0 1 0 0 1 0 0 0 0 0 1 0 1 0 0 1 0 0 1 0 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 0 0 1 1 1 1 1 1 0)
+(vector 53 10.678050692694 #r(0 1 0 0 1 0 0 0 0 0 1 0 1 0 0 1 0 0 1 0 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 0 0 1 1 1 1 1 1 0)
- 8.953081 #(0.000000 0.788009 1.225451 0.347894 0.336100 0.208645 0.898104 1.918038 1.003547 1.827170 1.665391 0.306753 1.689654 -0.198226 0.387896 0.060438 0.532055 0.677523 0.983575 1.778621 1.222864 0.337168 0.648048 -0.059018 1.548622 0.344050 1.142170 1.624821 1.518580 1.046929 0.925606 0.370284 1.876402 0.554168 0.470781 0.776401 0.841340 0.579159 -0.039732 0.259208 1.047217 1.262845 0.826737 1.840523 0.361249 1.360958 0.974324 0.708988 1.467968 0.681409 0.951917 1.111614 0.104759)
+ 8.953081 #r(0.000000 0.788009 1.225451 0.347894 0.336100 0.208645 0.898104 1.918038 1.003547 1.827170 1.665391 0.306753 1.689654 -0.198226 0.387896 0.060438 0.532055 0.677523 0.983575 1.778621 1.222864 0.337168 0.648048 -0.059018 1.548622 0.344050 1.142170 1.624821 1.518580 1.046929 0.925606 0.370284 1.876402 0.554168 0.470781 0.776401 0.841340 0.579159 -0.039732 0.259208 1.047217 1.262845 0.826737 1.840523 0.361249 1.360958 0.974324 0.708988 1.467968 0.681409 0.951917 1.111614 0.104759)
)
;;; 54 prime --------------------------------------------------------------------------------
-(vector 54 10.582709312439 #(0 0 1 1 1 0 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 0 1 1)
+(vector 54 10.582709312439 #r(0 0 1 1 1 0 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 0 1 1)
- 9.112388 #(0.000000 1.372093 1.646727 1.761844 1.071783 1.166972 0.499625 1.353759 1.094968 1.557358 1.723230 0.305306 1.364143 0.672762 0.599554 1.674554 1.196343 0.689593 0.333493 0.212755 0.120333 -0.065165 1.426986 0.808156 0.885002 1.618233 0.075135 0.412240 1.106276 -0.040331 -0.211790 1.351271 1.357179 1.301081 0.221358 0.762445 1.564667 0.202710 0.573995 1.689552 -0.051477 0.301020 1.046697 1.701827 0.907077 1.277114 0.971869 1.525859 1.752503 0.167031 0.961443 1.737745 0.154432 0.302453)
+ 9.112388 #r(0.000000 1.372093 1.646727 1.761844 1.071783 1.166972 0.499625 1.353759 1.094968 1.557358 1.723230 0.305306 1.364143 0.672762 0.599554 1.674554 1.196343 0.689593 0.333493 0.212755 0.120333 -0.065165 1.426986 0.808156 0.885002 1.618233 0.075135 0.412240 1.106276 -0.040331 -0.211790 1.351271 1.357179 1.301081 0.221358 0.762445 1.564667 0.202710 0.573995 1.689552 -0.051477 0.301020 1.046697 1.701827 0.907077 1.277114 0.971869 1.525859 1.752503 0.167031 0.961443 1.737745 0.154432 0.302453)
;; 53+1:
- 8.998093 #(0.000000 0.833931 1.255875 0.472195 0.500550 0.340958 0.889757 0.121823 0.999320 0.070168 1.822021 0.295115 1.599399 -0.278061 0.379867 0.053981 0.523149 0.552145 1.083746 1.542483 1.125023 0.280437 0.929583 0.145648 1.540352 0.570681 1.206535 1.391546 1.500834 1.280825 0.880416 0.297287 1.694488 0.607699 0.578077 0.733733 1.017737 0.538903 -0.079031 0.194742 1.159273 1.400820 0.893900 1.836755 0.359898 1.011475 0.991536 0.601097 1.637805 0.711833 1.160027 0.904915 0.240256 -0.100113)
+ 8.998093 #r(0.000000 0.833931 1.255875 0.472195 0.500550 0.340958 0.889757 0.121823 0.999320 0.070168 1.822021 0.295115 1.599399 -0.278061 0.379867 0.053981 0.523149 0.552145 1.083746 1.542483 1.125023 0.280437 0.929583 0.145648 1.540352 0.570681 1.206535 1.391546 1.500834 1.280825 0.880416 0.297287 1.694488 0.607699 0.578077 0.733733 1.017737 0.538903 -0.079031 0.194742 1.159273 1.400820 0.893900 1.836755 0.359898 1.011475 0.991536 0.601097 1.637805 0.711833 1.160027 0.904915 0.240256 -0.100113)
)
;;; 55 prime --------------------------------------------------------------------------------
-(vector 55 10.806410031758 #(0 0 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 1 0 0 0)
+(vector 55 10.806410031758 #r(0 0 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 1 0 0 0)
- 9.146479 #(0.000000 0.967563 0.927691 -0.360864 0.609958 0.765470 0.915027 1.392793 0.614248 0.953214 1.344500 -0.018857 0.737576 1.736931 1.631618 1.349440 1.307993 0.206073 1.281714 1.103145 0.628925 0.887703 0.370354 -0.354414 1.471798 1.220261 -1.840190 0.459998 0.319058 1.569823 -0.402409 1.289240 1.207248 1.401276 1.334659 0.647076 0.124770 0.659947 1.220235 0.570854 1.506684 0.326123 0.300730 0.226766 1.668245 0.069090 1.091084 1.792555 0.448614 1.706735 1.552724 -0.117313 1.845004 0.249242 0.002966)
+ 9.146479 #r(0.000000 0.967563 0.927691 -0.360864 0.609958 0.765470 0.915027 1.392793 0.614248 0.953214 1.344500 -0.018857 0.737576 1.736931 1.631618 1.349440 1.307993 0.206073 1.281714 1.103145 0.628925 0.887703 0.370354 -0.354414 1.471798 1.220261 -1.840190 0.459998 0.319058 1.569823 -0.402409 1.289240 1.207248 1.401276 1.334659 0.647076 0.124770 0.659947 1.220235 0.570854 1.506684 0.326123 0.300730 0.226766 1.668245 0.069090 1.091084 1.792555 0.448614 1.706735 1.552724 -0.117313 1.845004 0.249242 0.002966)
)
;;; 56 prime --------------------------------------------------------------------------------
-(vector 56 10.976176261902 #(0 0 1 0 1 1 1 1 0 1 1 1 0 0 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 0 0 1 1 1 0 0 0 0 1 1 1 1 1 1 1)
+(vector 56 10.976176261902 #r(0 0 1 0 1 1 1 1 0 1 1 1 0 0 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 0 0 1 1 1 0 0 0 0 1 1 1 1 1 1 1)
- 9.398396 #(0.000000 0.094656 0.695846 1.603834 1.096947 0.190376 1.605668 0.402610 1.589743 -0.046719 0.479899 1.053090 1.455624 1.475630 1.560612 1.146935 -0.097134 1.379647 0.063965 0.026372 0.001091 0.417420 0.372665 0.295880 0.375803 1.735862 -0.241158 0.226369 0.344276 0.614802 1.609054 1.733862 -0.048343 1.607193 0.295369 0.796984 0.953479 0.777849 -0.315058 -0.215768 1.445593 0.800481 -0.018312 0.085983 1.492275 1.800390 0.955850 0.344132 0.748720 -0.182377 -0.021909 0.550436 1.590599 1.124545 1.577258 1.243187)
+ 9.398396 #r(0.000000 0.094656 0.695846 1.603834 1.096947 0.190376 1.605668 0.402610 1.589743 -0.046719 0.479899 1.053090 1.455624 1.475630 1.560612 1.146935 -0.097134 1.379647 0.063965 0.026372 0.001091 0.417420 0.372665 0.295880 0.375803 1.735862 -0.241158 0.226369 0.344276 0.614802 1.609054 1.733862 -0.048343 1.607193 0.295369 0.796984 0.953479 0.777849 -0.315058 -0.215768 1.445593 0.800481 -0.018312 0.085983 1.492275 1.800390 0.955850 0.344132 0.748720 -0.182377 -0.021909 0.550436 1.590599 1.124545 1.577258 1.243187)
; 55+1
- 9.213442 #(0.000000 0.950801 0.904714 -0.508703 0.661009 0.831586 0.884308 1.497773 0.634206 0.800998 1.332469 0.044201 0.725326 1.681333 1.804312 1.427989 1.278065 0.225748 1.222051 1.044010 0.570030 1.029930 0.330187 -0.354523 1.385937 1.248658 -1.994529 0.420806 0.301325 1.707662 -0.449043 1.164884 1.219283 1.466837 1.371490 0.636485 0.172055 0.643834 1.272809 0.563267 1.543526 0.353044 0.368529 0.213972 1.758208 0.147525 1.155503 1.739729 0.512727 1.742754 1.612106 -0.186498 1.717200 0.213592 0.028127 -0.105694)
+ 9.213442 #r(0.000000 0.950801 0.904714 -0.508703 0.661009 0.831586 0.884308 1.497773 0.634206 0.800998 1.332469 0.044201 0.725326 1.681333 1.804312 1.427989 1.278065 0.225748 1.222051 1.044010 0.570030 1.029930 0.330187 -0.354523 1.385937 1.248658 -1.994529 0.420806 0.301325 1.707662 -0.449043 1.164884 1.219283 1.466837 1.371490 0.636485 0.172055 0.643834 1.272809 0.563267 1.543526 0.353044 0.368529 0.213972 1.758208 0.147525 1.155503 1.739729 0.512727 1.742754 1.612106 -0.186498 1.717200 0.213592 0.028127 -0.105694)
)
;;; 57 prime --------------------------------------------------------------------------------
-(vector 57 11.247724533081 #(0 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 1 0 1 0 1 1 0 1 1 0 0 0 1 0 0 0 1 0 1 1 0 1 0 0 1 0 0 0 0 0 1 1)
+(vector 57 11.247724533081 #r(0 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 1 0 1 0 1 1 0 1 1 0 0 0 1 0 0 0 1 0 1 1 0 1 0 0 1 0 0 0 0 0 1 1)
- 9.567937 #(0.000000 -0.074489 1.764667 1.562855 -0.045942 1.688785 0.424094 0.788093 1.318249 1.699500 1.597710 0.759778 0.347915 -0.095100 0.967999 1.558373 1.224410 -0.005793 1.163013 1.817831 1.260212 1.123377 0.674940 0.664211 1.043062 -0.159530 1.686511 0.775041 1.335210 0.664604 0.251332 0.046341 0.133324 0.094858 -0.073202 1.314310 1.874591 1.317512 0.082927 1.516375 0.524906 0.812252 0.819331 0.420977 1.188424 0.646402 1.644694 0.551897 0.757891 1.055306 1.295231 1.095924 0.627116 1.401110 0.235317 1.483585 0.936274)
+ 9.567937 #r(0.000000 -0.074489 1.764667 1.562855 -0.045942 1.688785 0.424094 0.788093 1.318249 1.699500 1.597710 0.759778 0.347915 -0.095100 0.967999 1.558373 1.224410 -0.005793 1.163013 1.817831 1.260212 1.123377 0.674940 0.664211 1.043062 -0.159530 1.686511 0.775041 1.335210 0.664604 0.251332 0.046341 0.133324 0.094858 -0.073202 1.314310 1.874591 1.317512 0.082927 1.516375 0.524906 0.812252 0.819331 0.420977 1.188424 0.646402 1.644694 0.551897 0.757891 1.055306 1.295231 1.095924 0.627116 1.401110 0.235317 1.483585 0.936274)
;; old 56+1
- 9.529594 #(0.000000 0.147122 0.761626 1.581775 0.991521 0.303398 1.538303 0.250231 1.516156 -0.033991 0.496296 1.098128 1.450885 1.473689 1.672255 1.122803 -0.210233 1.300861 0.064078 0.004743 0.013527 0.414701 0.325782 0.261492 0.363241 1.708852 -0.205248 0.171322 0.269253 0.615657 1.654144 1.808189 -0.053761 1.665701 0.276750 0.872232 1.105105 0.764170 -0.448707 -0.286149 1.484838 0.786694 -0.015133 0.173812 1.436796 1.864880 0.980591 0.327079 0.799812 -0.230067 -0.066056 0.534676 1.508154 1.155564 1.645708 1.183535 0.088307)
+ 9.529594 #r(0.000000 0.147122 0.761626 1.581775 0.991521 0.303398 1.538303 0.250231 1.516156 -0.033991 0.496296 1.098128 1.450885 1.473689 1.672255 1.122803 -0.210233 1.300861 0.064078 0.004743 0.013527 0.414701 0.325782 0.261492 0.363241 1.708852 -0.205248 0.171322 0.269253 0.615657 1.654144 1.808189 -0.053761 1.665701 0.276750 0.872232 1.105105 0.764170 -0.448707 -0.286149 1.484838 0.786694 -0.015133 0.173812 1.436796 1.864880 0.980591 0.327079 0.799812 -0.230067 -0.066056 0.534676 1.508154 1.155564 1.645708 1.183535 0.088307)
;; 56+1
- 9.246042 #(0.000000 1.068254 0.912344 -0.579409 0.699964 0.833848 0.899690 1.280880 0.729555 0.772814 1.165620 0.113563 0.958418 1.776654 1.746943 1.402708 1.254651 0.244552 1.303164 0.938450 0.572896 0.902407 0.419733 -0.424031 1.525432 1.318732 -1.856680 0.294120 0.271355 1.825185 -0.454382 1.066744 1.206377 1.513453 1.348624 0.487546 0.090590 0.574392 1.204512 0.396962 1.588976 0.339722 0.399778 0.196224 1.725471 0.086935 1.086444 1.835851 0.439978 1.611137 1.567240 -0.063335 1.719558 0.447194 0.045334 -0.250234 0.164616)
+ 9.246042 #r(0.000000 1.068254 0.912344 -0.579409 0.699964 0.833848 0.899690 1.280880 0.729555 0.772814 1.165620 0.113563 0.958418 1.776654 1.746943 1.402708 1.254651 0.244552 1.303164 0.938450 0.572896 0.902407 0.419733 -0.424031 1.525432 1.318732 -1.856680 0.294120 0.271355 1.825185 -0.454382 1.066744 1.206377 1.513453 1.348624 0.487546 0.090590 0.574392 1.204512 0.396962 1.588976 0.339722 0.399778 0.196224 1.725471 0.086935 1.086444 1.835851 0.439978 1.611137 1.567240 -0.063335 1.719558 0.447194 0.045334 -0.250234 0.164616)
)
;;; 58 prime --------------------------------------------------------------------------------
-(vector 58 11.261419321863 #(0 0 1 0 0 1 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 0 1 1 1 1 1 0 0 0 1 0 0 1 1 1 1 0 0 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1)
+(vector 58 11.261419321863 #r(0 0 1 0 0 1 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 0 1 1 1 1 1 0 0 0 1 0 0 1 1 1 1 0 0 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1)
- 9.496347 #(0.000000 0.059743 0.548997 0.530263 0.226709 0.929160 -0.003047 0.125973 0.533773 1.548469 1.087643 1.570490 0.714949 0.863084 1.167817 1.094596 0.710052 1.511445 0.483704 1.291778 1.179203 1.180959 0.109073 0.094424 -0.384843 0.103787 0.722897 0.948977 1.484212 0.671726 0.961877 1.358209 1.232685 1.456297 0.651862 0.171910 0.370224 1.284842 1.052862 0.918644 1.853795 0.756435 1.065168 1.308648 0.977275 0.827028 1.655929 0.742384 0.217339 0.808896 0.296638 1.208667 1.265590 0.019271 0.389600 0.183945 0.533565 1.638734)
+ 9.496347 #r(0.000000 0.059743 0.548997 0.530263 0.226709 0.929160 -0.003047 0.125973 0.533773 1.548469 1.087643 1.570490 0.714949 0.863084 1.167817 1.094596 0.710052 1.511445 0.483704 1.291778 1.179203 1.180959 0.109073 0.094424 -0.384843 0.103787 0.722897 0.948977 1.484212 0.671726 0.961877 1.358209 1.232685 1.456297 0.651862 0.171910 0.370224 1.284842 1.052862 0.918644 1.853795 0.756435 1.065168 1.308648 0.977275 0.827028 1.655929 0.742384 0.217339 0.808896 0.296638 1.208667 1.265590 0.019271 0.389600 0.183945 0.533565 1.638734)
;; 57+1
- 9.428825 #(0.000000 1.018908 0.901444 -0.615819 0.860485 0.681403 0.932140 1.367257 0.748226 0.856986 1.087905 -0.048047 0.777707 1.778584 1.735112 1.472731 1.253932 0.300987 1.373471 0.844264 0.566375 0.847406 0.280264 -0.528105 1.424599 1.371262 -0.084608 0.304532 0.358385 1.652997 -0.476953 1.150522 1.226908 1.441019 1.199333 0.513348 0.039957 0.545771 1.150857 0.473094 1.508935 0.466022 0.322870 0.315957 1.725788 0.047786 1.078150 1.717254 0.429354 1.592876 1.500586 -0.142982 1.851065 0.442979 -0.034671 -0.282154 0.042441 0.094078)
+ 9.428825 #r(0.000000 1.018908 0.901444 -0.615819 0.860485 0.681403 0.932140 1.367257 0.748226 0.856986 1.087905 -0.048047 0.777707 1.778584 1.735112 1.472731 1.253932 0.300987 1.373471 0.844264 0.566375 0.847406 0.280264 -0.528105 1.424599 1.371262 -0.084608 0.304532 0.358385 1.652997 -0.476953 1.150522 1.226908 1.441019 1.199333 0.513348 0.039957 0.545771 1.150857 0.473094 1.508935 0.466022 0.322870 0.315957 1.725788 0.047786 1.078150 1.717254 0.429354 1.592876 1.500586 -0.142982 1.851065 0.442979 -0.034671 -0.282154 0.042441 0.094078)
)
;;; 59 prime --------------------------------------------------------------------------------
-(vector 59 11.34253692627 #(0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 0 0 0 1 1)
+(vector 59 11.34253692627 #r(0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 0 0 0 1 1)
- 9.424456 #(0.000000 0.987831 1.263819 0.296674 0.942023 0.441708 0.159032 1.836629 0.018568 -0.056141 1.409550 -0.045051 1.184001 1.106575 0.859402 0.865929 1.344330 -0.022715 1.852739 1.494636 -0.146236 1.538496 0.317717 1.985293 0.734507 0.982797 0.398619 1.595615 1.945403 0.701589 1.197367 1.012887 0.543978 1.174908 1.430788 -0.128888 0.147545 0.984537 1.324816 1.549298 0.656696 -0.006636 1.201874 1.148588 0.795564 1.108773 1.687645 0.571018 0.266043 1.954157 1.006840 0.084613 0.524554 1.761460 0.208641 0.094850 0.141845 0.437731 0.909728)
+ 9.424456 #r(0.000000 0.987831 1.263819 0.296674 0.942023 0.441708 0.159032 1.836629 0.018568 -0.056141 1.409550 -0.045051 1.184001 1.106575 0.859402 0.865929 1.344330 -0.022715 1.852739 1.494636 -0.146236 1.538496 0.317717 1.985293 0.734507 0.982797 0.398619 1.595615 1.945403 0.701589 1.197367 1.012887 0.543978 1.174908 1.430788 -0.128888 0.147545 0.984537 1.324816 1.549298 0.656696 -0.006636 1.201874 1.148588 0.795564 1.108773 1.687645 0.571018 0.266043 1.954157 1.006840 0.084613 0.524554 1.761460 0.208641 0.094850 0.141845 0.437731 0.909728)
)
;;; 60 prime --------------------------------------------------------------------------------
-(vector 60 11.512454032898 #(0 0 0 0 1 0 1 1 0 0 0 0 0 1 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 0 0 1 1 1 1 0)
+(vector 60 11.512454032898 #r(0 0 0 0 1 0 1 1 0 0 0 0 0 1 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 0 0 1 1 1 1 0)
- 9.657740 #(0.000000 1.547780 1.677673 1.073672 -0.181562 1.466665 0.178185 1.296168 1.180984 0.799114 0.182696 1.568868 1.363180 0.494840 -0.056028 1.003607 1.541063 0.417763 1.700695 0.183440 0.905951 0.331420 0.794062 0.890276 1.122192 1.798420 0.731798 0.770804 1.703299 0.813575 0.660992 1.187791 1.645314 1.481351 1.240486 1.798220 0.254797 0.358769 1.758554 0.791594 0.131877 0.642084 0.956267 -0.226021 -0.095209 1.368914 1.922174 1.414955 -0.029158 0.411776 1.206976 1.720135 0.221233 0.679698 1.694654 0.956928 0.036757 1.792835 0.004408 0.786308)
+ 9.657740 #r(0.000000 1.547780 1.677673 1.073672 -0.181562 1.466665 0.178185 1.296168 1.180984 0.799114 0.182696 1.568868 1.363180 0.494840 -0.056028 1.003607 1.541063 0.417763 1.700695 0.183440 0.905951 0.331420 0.794062 0.890276 1.122192 1.798420 0.731798 0.770804 1.703299 0.813575 0.660992 1.187791 1.645314 1.481351 1.240486 1.798220 0.254797 0.358769 1.758554 0.791594 0.131877 0.642084 0.956267 -0.226021 -0.095209 1.368914 1.922174 1.414955 -0.029158 0.411776 1.206976 1.720135 0.221233 0.679698 1.694654 0.956928 0.036757 1.792835 0.004408 0.786308)
;; 59+1
- 9.567932 #(0.000000 0.987181 1.155730 0.332214 0.959672 0.422609 0.139164 1.858170 1.971933 -0.085625 1.367690 0.092445 1.162248 1.070252 0.880093 0.923540 1.286688 -0.075166 1.802993 1.583654 -0.058064 1.544851 0.459865 -0.017801 0.622918 1.081434 0.420245 1.717169 1.954432 0.771937 1.209324 0.923890 0.475411 1.176878 1.472899 -0.165713 0.114758 1.012016 1.333064 1.459949 0.672973 0.014198 1.279333 1.152000 0.797283 1.103957 1.630723 0.491103 0.146670 1.964833 1.081703 0.052456 0.483259 1.761154 0.245675 0.138222 0.019396 0.460673 0.907223 -0.053470)
+ 9.567932 #r(0.000000 0.987181 1.155730 0.332214 0.959672 0.422609 0.139164 1.858170 1.971933 -0.085625 1.367690 0.092445 1.162248 1.070252 0.880093 0.923540 1.286688 -0.075166 1.802993 1.583654 -0.058064 1.544851 0.459865 -0.017801 0.622918 1.081434 0.420245 1.717169 1.954432 0.771937 1.209324 0.923890 0.475411 1.176878 1.472899 -0.165713 0.114758 1.012016 1.333064 1.459949 0.672973 0.014198 1.279333 1.152000 0.797283 1.103957 1.630723 0.491103 0.146670 1.964833 1.081703 0.052456 0.483259 1.761154 0.245675 0.138222 0.019396 0.460673 0.907223 -0.053470)
)
;;; 61 prime --------------------------------------------------------------------------------
-(vector 61 11.850807189941 #(0 0 1 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 0 0 0 1)
+(vector 61 11.850807189941 #r(0 0 1 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 0 0 0 1)
- 9.848207 #(0.000000 0.465768 1.502052 1.208112 1.687111 1.098823 0.136558 1.242624 0.803898 1.305434 0.569022 0.707134 0.107360 0.681230 1.626786 1.180372 0.428544 0.064966 0.220601 0.606687 1.112200 0.761343 0.147814 1.074432 0.974575 0.150330 0.295078 1.965080 0.596171 1.395202 1.511902 0.719123 0.058806 0.162986 1.356055 1.017221 1.069746 0.022458 1.119273 0.473964 1.602481 0.117785 0.745272 0.467208 1.699348 0.892580 0.864605 0.883970 -0.281719 1.309124 0.657105 1.259919 1.224601 1.818239 1.863265 0.645463 0.762464 -0.184384 0.778659 1.743798 0.403645)
+ 9.848207 #r(0.000000 0.465768 1.502052 1.208112 1.687111 1.098823 0.136558 1.242624 0.803898 1.305434 0.569022 0.707134 0.107360 0.681230 1.626786 1.180372 0.428544 0.064966 0.220601 0.606687 1.112200 0.761343 0.147814 1.074432 0.974575 0.150330 0.295078 1.965080 0.596171 1.395202 1.511902 0.719123 0.058806 0.162986 1.356055 1.017221 1.069746 0.022458 1.119273 0.473964 1.602481 0.117785 0.745272 0.467208 1.699348 0.892580 0.864605 0.883970 -0.281719 1.309124 0.657105 1.259919 1.224601 1.818239 1.863265 0.645463 0.762464 -0.184384 0.778659 1.743798 0.403645)
;; 60+1
- 9.674304 #(0.000000 0.942988 1.185184 0.401228 0.922656 0.384439 0.124613 1.797598 1.871679 -0.085568 1.287716 0.127521 1.211990 1.110404 1.018269 0.906936 1.241998 -0.006224 1.802916 1.625042 -0.136580 1.655334 0.507522 0.019978 0.578715 1.045428 0.440588 1.674467 1.983824 0.788229 1.261730 0.967897 0.387538 1.232060 1.526658 -0.187478 0.170755 1.104323 1.383734 1.532583 0.668063 0.082609 1.255511 1.174792 0.795177 1.135630 1.640793 0.324749 0.311806 1.930005 1.005470 -0.027359 0.440238 1.824355 0.182093 -0.005304 0.026835 0.470199 0.945827 0.102044 -0.110982)
+ 9.674304 #r(0.000000 0.942988 1.185184 0.401228 0.922656 0.384439 0.124613 1.797598 1.871679 -0.085568 1.287716 0.127521 1.211990 1.110404 1.018269 0.906936 1.241998 -0.006224 1.802916 1.625042 -0.136580 1.655334 0.507522 0.019978 0.578715 1.045428 0.440588 1.674467 1.983824 0.788229 1.261730 0.967897 0.387538 1.232060 1.526658 -0.187478 0.170755 1.104323 1.383734 1.532583 0.668063 0.082609 1.255511 1.174792 0.795177 1.135630 1.640793 0.324749 0.311806 1.930005 1.005470 -0.027359 0.440238 1.824355 0.182093 -0.005304 0.026835 0.470199 0.945827 0.102044 -0.110982)
)
;;; 62 prime --------------------------------------------------------------------------------
-(vector 62 11.709966659546 #(0 0 0 0 0 1 1 1 1 1 1 1 0 1 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 1 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 1 1 0 1 0)
+(vector 62 11.709966659546 #r(0 0 0 0 0 1 1 1 1 1 1 1 0 1 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 1 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 1 1 0 1 0)
- 9.787654 #(0.000000 0.164735 0.495571 0.194524 1.700130 -0.039330 1.112293 0.631854 1.622240 0.234398 0.057253 0.622061 1.299807 1.150659 1.089362 1.262936 0.326220 0.146372 0.440190 0.705699 0.320098 1.480138 -0.723459 0.298112 1.483411 -0.413300 0.234477 1.688059 0.592934 1.563752 1.095288 0.196837 0.912297 -0.114061 -0.100816 0.101717 1.569678 0.725974 1.210511 1.268915 0.220895 1.789986 0.880755 0.550271 0.862882 1.562267 1.201540 0.696671 0.139442 0.617496 0.156201 0.378889 1.874933 0.550733 0.693398 0.120666 0.641553 1.379939 0.633855 1.283976 1.797799 0.211762)
+ 9.787654 #r(0.000000 0.164735 0.495571 0.194524 1.700130 -0.039330 1.112293 0.631854 1.622240 0.234398 0.057253 0.622061 1.299807 1.150659 1.089362 1.262936 0.326220 0.146372 0.440190 0.705699 0.320098 1.480138 -0.723459 0.298112 1.483411 -0.413300 0.234477 1.688059 0.592934 1.563752 1.095288 0.196837 0.912297 -0.114061 -0.100816 0.101717 1.569678 0.725974 1.210511 1.268915 0.220895 1.789986 0.880755 0.550271 0.862882 1.562267 1.201540 0.696671 0.139442 0.617496 0.156201 0.378889 1.874933 0.550733 0.693398 0.120666 0.641553 1.379939 0.633855 1.283976 1.797799 0.211762)
;; 63-1
- 9.733736 #(0.000000 -0.139952 0.119957 0.369616 1.566294 0.358962 1.150575 0.658899 1.145823 0.565498 0.818035 -0.078756 0.339361 0.036853 -0.081445 1.284492 0.104736 1.510521 0.937147 0.788271 1.526814 1.396514 1.280490 1.469510 1.789649 0.285213 0.650226 0.881585 0.728974 1.810762 -0.044930 1.659215 0.713447 0.623929 1.496774 0.951425 0.357075 1.369241 1.674041 0.637986 0.902200 0.722908 0.299878 -0.044061 0.733643 0.407073 1.473577 0.408899 -0.199740 0.425185 0.345580 1.674452 0.584665 1.350356 0.031128 1.247150 0.256688 0.635884 0.503839 0.135030 0.263417 1.006656)
+ 9.733736 #r(0.000000 -0.139952 0.119957 0.369616 1.566294 0.358962 1.150575 0.658899 1.145823 0.565498 0.818035 -0.078756 0.339361 0.036853 -0.081445 1.284492 0.104736 1.510521 0.937147 0.788271 1.526814 1.396514 1.280490 1.469510 1.789649 0.285213 0.650226 0.881585 0.728974 1.810762 -0.044930 1.659215 0.713447 0.623929 1.496774 0.951425 0.357075 1.369241 1.674041 0.637986 0.902200 0.722908 0.299878 -0.044061 0.733643 0.407073 1.473577 0.408899 -0.199740 0.425185 0.345580 1.674452 0.584665 1.350356 0.031128 1.247150 0.256688 0.635884 0.503839 0.135030 0.263417 1.006656)
)
;;; 63 prime --------------------------------------------------------------------------------
-(vector 63 11.975765228271 #(0 0 0 1 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 0 1 0 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 0 1 0)
+(vector 63 11.975765228271 #r(0 0 0 1 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 0 1 0 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 0 1 0)
- 9.712956 #(0.000000 -0.211512 0.128156 0.205336 1.631792 0.223993 1.120077 0.677974 1.189520 0.635587 0.786994 -0.140042 0.270508 0.031528 -0.026718 1.271754 0.161836 1.519308 0.919403 0.725190 1.656604 1.430895 1.216006 1.507263 1.740613 0.380045 0.740422 0.860394 0.644699 1.785241 -0.063336 1.757196 0.670969 0.631113 1.432730 0.929994 0.449373 1.355893 1.665671 0.697673 0.900343 0.706516 0.261640 0.022846 0.779166 0.410962 1.451999 0.372853 -0.213671 0.428231 0.418722 1.770544 0.502738 1.423557 0.029160 1.322724 0.247556 0.608992 0.392989 0.101597 0.240746 1.015503 0.321046)
+ 9.712956 #r(0.000000 -0.211512 0.128156 0.205336 1.631792 0.223993 1.120077 0.677974 1.189520 0.635587 0.786994 -0.140042 0.270508 0.031528 -0.026718 1.271754 0.161836 1.519308 0.919403 0.725190 1.656604 1.430895 1.216006 1.507263 1.740613 0.380045 0.740422 0.860394 0.644699 1.785241 -0.063336 1.757196 0.670969 0.631113 1.432730 0.929994 0.449373 1.355893 1.665671 0.697673 0.900343 0.706516 0.261640 0.022846 0.779166 0.410962 1.451999 0.372853 -0.213671 0.428231 0.418722 1.770544 0.502738 1.423557 0.029160 1.322724 0.247556 0.608992 0.392989 0.101597 0.240746 1.015503 0.321046)
)
;;; 64 prime --------------------------------------------------------------------------------
-(vector 64 11.932915769505 #(0 0 1 1 0 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 1)
+(vector 64 11.932915769505 #r(0 0 1 1 0 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 1)
- 9.911897 #(0.000000 -0.176519 0.277243 1.457679 0.409823 0.492128 1.258703 0.953828 0.451970 -0.035755 1.413815 0.576790 1.007663 1.557197 0.406393 0.901721 0.935399 0.344434 0.058666 -0.004874 0.033568 0.266354 0.964058 1.260921 0.110946 0.586184 1.551133 0.560107 1.655832 1.431146 0.094791 0.726936 0.404173 1.258539 0.363860 0.287498 0.704556 1.358694 0.848351 1.352219 1.358382 1.634548 0.646434 0.536511 1.151363 1.507902 0.370229 -0.111562 0.018845 1.351430 0.613337 0.524145 0.030867 1.602701 0.958191 0.774983 0.900142 1.319974 1.665985 0.954409 0.571244 0.683517 0.257283 0.560359)
+ 9.911897 #r(0.000000 -0.176519 0.277243 1.457679 0.409823 0.492128 1.258703 0.953828 0.451970 -0.035755 1.413815 0.576790 1.007663 1.557197 0.406393 0.901721 0.935399 0.344434 0.058666 -0.004874 0.033568 0.266354 0.964058 1.260921 0.110946 0.586184 1.551133 0.560107 1.655832 1.431146 0.094791 0.726936 0.404173 1.258539 0.363860 0.287498 0.704556 1.358694 0.848351 1.352219 1.358382 1.634548 0.646434 0.536511 1.151363 1.507902 0.370229 -0.111562 0.018845 1.351430 0.613337 0.524145 0.030867 1.602701 0.958191 0.774983 0.900142 1.319974 1.665985 0.954409 0.571244 0.683517 0.257283 0.560359)
)
;;; 65 prime --------------------------------------------------------------------------------
-(vector 65 12.264873504639 #(0 0 0 0 1 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 0 1 1 0 0 1 1 1 1 0 1 0)
+(vector 65 12.264873504639 #r(0 0 0 0 1 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 0 1 1 0 0 1 1 1 1 0 1 0)
- 10.245810 #(0.000000 1.314885 -0.128565 -0.061767 0.245423 0.308150 0.666161 1.799635 0.121779 1.318087 1.095106 1.813764 1.363803 0.687883 0.082989 1.252556 0.674431 0.081538 1.120705 -0.053380 0.222404 0.418326 1.266348 1.095265 1.090145 0.914385 0.672015 0.091667 0.221386 0.230885 1.047444 0.950558 0.582123 1.829143 1.939330 0.054401 0.665085 0.669868 1.410783 0.893429 1.398299 1.087907 0.120341 1.456277 0.134554 1.548051 0.155644 0.252207 0.317819 0.803060 0.255268 0.011364 1.407071 1.292331 1.862089 -0.144291 1.528219 0.241256 -0.215537 1.071975 0.180828 1.509027 1.608200 1.880646 0.432459)
+ 10.245810 #r(0.000000 1.314885 -0.128565 -0.061767 0.245423 0.308150 0.666161 1.799635 0.121779 1.318087 1.095106 1.813764 1.363803 0.687883 0.082989 1.252556 0.674431 0.081538 1.120705 -0.053380 0.222404 0.418326 1.266348 1.095265 1.090145 0.914385 0.672015 0.091667 0.221386 0.230885 1.047444 0.950558 0.582123 1.829143 1.939330 0.054401 0.665085 0.669868 1.410783 0.893429 1.398299 1.087907 0.120341 1.456277 0.134554 1.548051 0.155644 0.252207 0.317819 0.803060 0.255268 0.011364 1.407071 1.292331 1.862089 -0.144291 1.528219 0.241256 -0.215537 1.071975 0.180828 1.509027 1.608200 1.880646 0.432459)
;; 64+1
- 10.041913 #(0.000000 -0.231597 0.347996 1.329229 0.210946 0.358775 1.318136 0.940959 0.423445 -0.059602 1.487652 0.528102 0.959962 1.627507 0.242008 0.890416 1.013953 0.381481 0.048421 0.000955 0.073351 0.222260 0.956448 1.250606 0.032874 0.581396 1.552144 0.533024 1.803356 1.588620 0.155988 0.709145 0.416103 1.098822 0.371144 0.488313 0.641224 1.409761 0.769076 1.378012 1.338517 1.672969 0.693576 0.622573 1.111879 1.498797 0.384021 -0.285902 0.098531 1.294593 0.540682 0.514444 0.031708 1.544980 0.882941 0.833995 0.886145 1.471130 1.590019 0.959450 0.407950 0.787696 0.104075 0.545846 0.096608)
+ 10.041913 #r(0.000000 -0.231597 0.347996 1.329229 0.210946 0.358775 1.318136 0.940959 0.423445 -0.059602 1.487652 0.528102 0.959962 1.627507 0.242008 0.890416 1.013953 0.381481 0.048421 0.000955 0.073351 0.222260 0.956448 1.250606 0.032874 0.581396 1.552144 0.533024 1.803356 1.588620 0.155988 0.709145 0.416103 1.098822 0.371144 0.488313 0.641224 1.409761 0.769076 1.378012 1.338517 1.672969 0.693576 0.622573 1.111879 1.498797 0.384021 -0.285902 0.098531 1.294593 0.540682 0.514444 0.031708 1.544980 0.882941 0.833995 0.886145 1.471130 1.590019 0.959450 0.407950 0.787696 0.104075 0.545846 0.096608)
)
;;; 66 prime --------------------------------------------------------------------------------
-(vector 66 12.090668678284 #(0 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 0 1 1 1 0 1 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0)
+(vector 66 12.090668678284 #r(0 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 0 1 1 1 0 1 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0)
- 10.065843 #(0.000000 -0.332278 0.420111 1.296912 0.003400 0.570050 1.383101 1.228319 0.329402 0.002928 0.332461 0.786693 1.331535 0.237292 1.020996 0.126259 1.613105 1.241426 -0.367526 0.057745 0.063068 1.144890 0.058649 0.546763 0.792290 0.527577 1.597907 0.336733 0.558202 0.349266 0.412838 -0.066236 0.132007 1.032081 0.645360 0.084627 0.218015 0.961024 1.464682 1.216442 1.186753 0.039444 1.139907 1.145545 1.026317 1.617341 0.492061 1.804706 -0.218027 0.872723 0.567401 1.745335 1.259266 0.682677 1.100993 1.200392 1.089304 0.237539 0.552581 0.047166 0.743492 0.228597 1.363708 0.915715 -0.032741 0.312099)
+ 10.065843 #r(0.000000 -0.332278 0.420111 1.296912 0.003400 0.570050 1.383101 1.228319 0.329402 0.002928 0.332461 0.786693 1.331535 0.237292 1.020996 0.126259 1.613105 1.241426 -0.367526 0.057745 0.063068 1.144890 0.058649 0.546763 0.792290 0.527577 1.597907 0.336733 0.558202 0.349266 0.412838 -0.066236 0.132007 1.032081 0.645360 0.084627 0.218015 0.961024 1.464682 1.216442 1.186753 0.039444 1.139907 1.145545 1.026317 1.617341 0.492061 1.804706 -0.218027 0.872723 0.567401 1.745335 1.259266 0.682677 1.100993 1.200392 1.089304 0.237539 0.552581 0.047166 0.743492 0.228597 1.363708 0.915715 -0.032741 0.312099)
)
;;; 67 prime --------------------------------------------------------------------------------
-(vector 67 12.20425496356 #(0 1 0 1 1 0 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 0 1 0 0 1 1 1 1 1 0 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 1)
+(vector 67 12.20425496356 #r(0 1 0 1 1 0 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 0 1 0 0 1 1 1 1 1 0 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 1)
- 10.320633 #(0.000000 -0.066702 1.242059 1.936441 0.363520 0.137300 1.303419 1.038801 0.086937 0.040742 0.388452 0.616008 0.087295 0.258798 0.692201 0.072909 1.551804 1.636838 1.398740 0.687317 1.022745 0.988646 1.580618 0.947110 0.593084 0.854099 0.599585 1.071060 0.286673 0.719337 0.932505 1.632806 1.461969 0.862483 1.295247 0.807609 -0.156076 1.297879 1.679745 0.135687 1.421850 1.188268 0.748752 1.493420 1.296035 0.019305 0.979542 0.607739 1.082240 1.014220 1.355630 1.025509 1.427015 0.501576 0.029659 1.501116 0.667518 0.375063 0.738972 1.634670 1.190958 0.695412 0.198543 0.008987 0.953545 0.492193 0.512363)
+ 10.320633 #r(0.000000 -0.066702 1.242059 1.936441 0.363520 0.137300 1.303419 1.038801 0.086937 0.040742 0.388452 0.616008 0.087295 0.258798 0.692201 0.072909 1.551804 1.636838 1.398740 0.687317 1.022745 0.988646 1.580618 0.947110 0.593084 0.854099 0.599585 1.071060 0.286673 0.719337 0.932505 1.632806 1.461969 0.862483 1.295247 0.807609 -0.156076 1.297879 1.679745 0.135687 1.421850 1.188268 0.748752 1.493420 1.296035 0.019305 0.979542 0.607739 1.082240 1.014220 1.355630 1.025509 1.427015 0.501576 0.029659 1.501116 0.667518 0.375063 0.738972 1.634670 1.190958 0.695412 0.198543 0.008987 0.953545 0.492193 0.512363)
;; 66+1
- 10.270103 #(0.000000 -0.339086 0.529826 1.196633 0.017211 0.503338 1.254976 1.117868 0.397424 -0.207937 0.422035 0.795324 1.396533 0.167749 1.073809 0.015795 1.618310 1.175144 -0.342555 0.080333 0.003741 1.084430 -0.010093 0.560025 0.867130 0.369945 1.456200 0.444129 0.652644 0.167650 0.320656 -0.145242 0.307342 1.062944 0.883767 0.299612 0.277397 1.030332 1.417097 1.462867 1.323580 0.189769 1.089141 0.993348 0.915509 1.413244 0.654039 1.674522 -0.169566 0.974872 0.769627 1.866694 1.124536 0.783559 1.039716 1.307670 1.055658 0.169272 0.711344 0.060085 0.731555 0.347823 1.529167 0.605251 0.021941 0.493045 -0.306702)
+ 10.270103 #r(0.000000 -0.339086 0.529826 1.196633 0.017211 0.503338 1.254976 1.117868 0.397424 -0.207937 0.422035 0.795324 1.396533 0.167749 1.073809 0.015795 1.618310 1.175144 -0.342555 0.080333 0.003741 1.084430 -0.010093 0.560025 0.867130 0.369945 1.456200 0.444129 0.652644 0.167650 0.320656 -0.145242 0.307342 1.062944 0.883767 0.299612 0.277397 1.030332 1.417097 1.462867 1.323580 0.189769 1.089141 0.993348 0.915509 1.413244 0.654039 1.674522 -0.169566 0.974872 0.769627 1.866694 1.124536 0.783559 1.039716 1.307670 1.055658 0.169272 0.711344 0.060085 0.731555 0.347823 1.529167 0.605251 0.021941 0.493045 -0.306702)
;; 63+4
- 10.427697 #(0.000000 0.966407 0.007580 1.117030 0.884875 -0.175736 1.107926 1.097831 1.037576 0.927078 0.966085 0.319675 1.083926 1.106087 -0.189435 0.791093 0.993213 0.299434 1.143696 -0.196739 -0.029109 0.887111 0.277418 0.908738 0.949002 0.901486 1.105128 -0.045569 -0.301510 0.181857 -0.008960 0.833755 0.782101 0.955244 1.472884 0.046447 1.032739 0.722326 0.974274 -0.002839 -0.169106 0.164428 1.138848 0.015499 -0.200081 0.988166 0.843017 1.122563 0.966722 1.090406 0.167301 -0.055129 1.042886 1.189957 0.335648 0.995142 0.029028 1.138068 1.075538 0.633942 0.180537 0.051411 0.928317 0.861628 0.910920 0.920218 1.020151)
+ 10.427697 #r(0.000000 0.966407 0.007580 1.117030 0.884875 -0.175736 1.107926 1.097831 1.037576 0.927078 0.966085 0.319675 1.083926 1.106087 -0.189435 0.791093 0.993213 0.299434 1.143696 -0.196739 -0.029109 0.887111 0.277418 0.908738 0.949002 0.901486 1.105128 -0.045569 -0.301510 0.181857 -0.008960 0.833755 0.782101 0.955244 1.472884 0.046447 1.032739 0.722326 0.974274 -0.002839 -0.169106 0.164428 1.138848 0.015499 -0.200081 0.988166 0.843017 1.122563 0.966722 1.090406 0.167301 -0.055129 1.042886 1.189957 0.335648 0.995142 0.029028 1.138068 1.075538 0.633942 0.180537 0.051411 0.928317 0.861628 0.910920 0.920218 1.020151)
)
;;; 68 prime --------------------------------------------------------------------------------
-(vector 68 12.466281890869 #(0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1 1 0 1 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 0 1 0 0 1 0 1)
+(vector 68 12.466281890869 #r(0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1 1 0 1 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 0 1 0 0 1 0 1)
- 10.396366 #(0.000000 0.186038 1.693540 -0.027216 1.013938 1.733700 0.097268 1.072327 -0.058595 1.297512 -0.223714 1.812708 1.571967 1.911449 0.105375 0.724913 0.167937 1.379937 1.003328 0.296337 -0.012219 0.740941 0.185685 1.450530 0.967328 0.422187 -0.221136 1.128630 1.299506 1.950429 -0.063323 -0.049468 0.618925 -0.250368 1.155850 1.363266 1.946601 1.896273 0.663379 0.530614 -0.343257 1.261470 -0.040006 0.308974 1.407553 1.782235 1.820125 1.703055 0.892390 0.956493 1.267334 1.223362 0.886365 0.857699 0.303604 1.740946 1.505785 1.372752 0.598965 0.555179 0.138411 0.702673 0.141261 1.356921 1.480871 1.810731 0.336170 1.491601)
+ 10.396366 #r(0.000000 0.186038 1.693540 -0.027216 1.013938 1.733700 0.097268 1.072327 -0.058595 1.297512 -0.223714 1.812708 1.571967 1.911449 0.105375 0.724913 0.167937 1.379937 1.003328 0.296337 -0.012219 0.740941 0.185685 1.450530 0.967328 0.422187 -0.221136 1.128630 1.299506 1.950429 -0.063323 -0.049468 0.618925 -0.250368 1.155850 1.363266 1.946601 1.896273 0.663379 0.530614 -0.343257 1.261470 -0.040006 0.308974 1.407553 1.782235 1.820125 1.703055 0.892390 0.956493 1.267334 1.223362 0.886365 0.857699 0.303604 1.740946 1.505785 1.372752 0.598965 0.555179 0.138411 0.702673 0.141261 1.356921 1.480871 1.810731 0.336170 1.491601)
;; 69-1:
- 10.294332 #(0.000000 1.774482 1.200978 1.227268 1.382220 0.282793 1.553903 1.732456 0.753211 0.760153 1.851640 1.366776 1.204200 0.843725 0.253043 0.277483 0.103836 -0.065448 1.410455 0.651921 1.994318 0.062621 0.954681 0.275021 0.597686 1.119852 0.016268 -0.163905 1.984242 1.567894 0.922417 -0.007109 1.063508 1.828059 0.334844 1.052665 1.253633 1.262611 1.579598 0.998618 1.505098 1.876188 0.866523 -0.096826 0.810066 0.678537 0.661302 -0.487197 0.199269 0.661440 1.362169 1.024823 0.238200 0.872311 1.253153 1.455210 0.266625 1.222868 1.015892 1.101616 1.115849 0.596998 1.881890 -0.207678 1.082090 0.165311 1.300155 1.153433)
+ 10.294332 #r(0.000000 1.774482 1.200978 1.227268 1.382220 0.282793 1.553903 1.732456 0.753211 0.760153 1.851640 1.366776 1.204200 0.843725 0.253043 0.277483 0.103836 -0.065448 1.410455 0.651921 1.994318 0.062621 0.954681 0.275021 0.597686 1.119852 0.016268 -0.163905 1.984242 1.567894 0.922417 -0.007109 1.063508 1.828059 0.334844 1.052665 1.253633 1.262611 1.579598 0.998618 1.505098 1.876188 0.866523 -0.096826 0.810066 0.678537 0.661302 -0.487197 0.199269 0.661440 1.362169 1.024823 0.238200 0.872311 1.253153 1.455210 0.266625 1.222868 1.015892 1.101616 1.115849 0.596998 1.881890 -0.207678 1.082090 0.165311 1.300155 1.153433)
)
;;; 69 prime --------------------------------------------------------------------------------
-(vector 69 12.29846572876 #(0 0 1 0 0 1 1 0 1 1 0 1 0 1 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 0 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 0 0 0)
+(vector 69 12.29846572876 #r(0 0 1 0 0 1 1 0 1 1 0 1 0 1 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 0 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 0 0 0)
- 10.373386 #(0.000000 1.755739 1.344798 1.270777 1.245975 0.212147 1.637341 1.674637 0.780881 0.678256 0.020823 1.453992 1.251154 0.906274 0.263210 0.219658 0.201277 -0.006107 1.482279 0.690309 1.943780 0.107940 0.891912 0.210217 0.501788 1.062586 1.748465 -0.256216 1.793890 1.653062 0.760504 1.930618 1.125386 1.733012 0.392253 1.017032 1.329369 1.438951 1.614342 0.946373 1.511397 1.735151 0.924137 -0.243047 0.908372 0.619579 0.722525 -0.263766 0.070586 0.505534 1.390127 1.112173 0.360123 0.888486 1.115007 1.574719 0.192671 1.168644 1.072297 1.024494 1.027776 0.495929 1.728234 0.030466 1.010825 0.303774 1.356890 1.301979 0.677665)
+ 10.373386 #r(0.000000 1.755739 1.344798 1.270777 1.245975 0.212147 1.637341 1.674637 0.780881 0.678256 0.020823 1.453992 1.251154 0.906274 0.263210 0.219658 0.201277 -0.006107 1.482279 0.690309 1.943780 0.107940 0.891912 0.210217 0.501788 1.062586 1.748465 -0.256216 1.793890 1.653062 0.760504 1.930618 1.125386 1.733012 0.392253 1.017032 1.329369 1.438951 1.614342 0.946373 1.511397 1.735151 0.924137 -0.243047 0.908372 0.619579 0.722525 -0.263766 0.070586 0.505534 1.390127 1.112173 0.360123 0.888486 1.115007 1.574719 0.192671 1.168644 1.072297 1.024494 1.027776 0.495929 1.728234 0.030466 1.010825 0.303774 1.356890 1.301979 0.677665)
)
;;; 70 prime --------------------------------------------------------------------------------
-(vector 70 12.665026664734 #(0 1 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 1 1 0 1 1 0 1 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 1 0 0)
+(vector 70 12.665026664734 #r(0 1 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 1 1 0 1 1 0 1 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 1 0 0)
- 10.403198 #(0.000000 0.659269 0.149246 -0.229331 0.464031 1.037303 0.297808 1.605092 1.041553 1.638786 0.968456 1.081487 0.986031 0.766531 0.645236 0.176746 0.062926 0.650627 0.887571 0.432390 0.968052 1.660369 1.053082 0.034606 1.910731 1.746043 1.683430 0.821251 1.040772 1.932221 1.382437 0.501614 -0.111054 0.532350 0.190557 0.045053 1.319570 -0.066664 0.486188 1.777508 1.395223 0.491473 0.176001 0.623855 1.347864 1.207736 1.451417 1.558733 1.414717 1.920228 0.418857 1.530616 0.099510 0.214659 0.967449 -0.145006 1.519241 0.691963 1.366826 0.718889 0.337519 0.685633 1.635424 0.816319 0.060380 1.097292 0.149441 0.900329 0.876399 0.145344)
+ 10.403198 #r(0.000000 0.659269 0.149246 -0.229331 0.464031 1.037303 0.297808 1.605092 1.041553 1.638786 0.968456 1.081487 0.986031 0.766531 0.645236 0.176746 0.062926 0.650627 0.887571 0.432390 0.968052 1.660369 1.053082 0.034606 1.910731 1.746043 1.683430 0.821251 1.040772 1.932221 1.382437 0.501614 -0.111054 0.532350 0.190557 0.045053 1.319570 -0.066664 0.486188 1.777508 1.395223 0.491473 0.176001 0.623855 1.347864 1.207736 1.451417 1.558733 1.414717 1.920228 0.418857 1.530616 0.099510 0.214659 0.967449 -0.145006 1.519241 0.691963 1.366826 0.718889 0.337519 0.685633 1.635424 0.816319 0.060380 1.097292 0.149441 0.900329 0.876399 0.145344)
)
;;; 71 prime --------------------------------------------------------------------------------
-(vector 71 12.609085083008 #(0 1 0 1 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 1 1 0 0 0 0 1 1 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 1 1 0 1 1 0)
+(vector 71 12.609085083008 #r(0 1 0 1 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 1 1 0 0 0 0 1 1 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 1 1 0 1 1 0)
- 10.523064 #(0.000000 0.688011 0.968837 0.940634 1.605222 0.888784 0.799658 0.986589 0.551066 0.615309 0.653186 0.893971 1.635005 0.515944 0.737309 0.499869 0.965484 1.166543 1.233403 1.277963 0.357632 0.184373 0.829321 0.533549 0.654127 1.345320 0.132782 0.366320 0.049851 1.315507 0.714178 1.332359 1.090257 0.069099 0.561445 1.760121 1.667327 0.986854 0.112329 0.614048 1.104774 0.212197 1.392955 0.553988 0.863015 1.668891 1.231650 0.232935 1.786061 0.865166 0.966113 0.257005 0.993747 -0.000704 1.235807 0.060112 1.258818 1.073792 0.276968 0.278092 1.838200 0.920318 1.799026 1.603861 0.357301 0.246709 0.264914 0.955910 0.731514 1.325161 1.347000)
+ 10.523064 #r(0.000000 0.688011 0.968837 0.940634 1.605222 0.888784 0.799658 0.986589 0.551066 0.615309 0.653186 0.893971 1.635005 0.515944 0.737309 0.499869 0.965484 1.166543 1.233403 1.277963 0.357632 0.184373 0.829321 0.533549 0.654127 1.345320 0.132782 0.366320 0.049851 1.315507 0.714178 1.332359 1.090257 0.069099 0.561445 1.760121 1.667327 0.986854 0.112329 0.614048 1.104774 0.212197 1.392955 0.553988 0.863015 1.668891 1.231650 0.232935 1.786061 0.865166 0.966113 0.257005 0.993747 -0.000704 1.235807 0.060112 1.258818 1.073792 0.276968 0.278092 1.838200 0.920318 1.799026 1.603861 0.357301 0.246709 0.264914 0.955910 0.731514 1.325161 1.347000)
)
;;; 72 prime --------------------------------------------------------------------------------
-(vector 72 12.708446502686 #(0 0 1 0 0 0 1 1 0 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 0 1 0 1 0 1 1 0 0 0 0 1 1 0 0 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 1 1)
+(vector 72 12.708446502686 #r(0 0 1 0 0 0 1 1 0 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 0 1 0 1 0 1 1 0 0 0 0 1 1 0 0 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 1 1)
- 10.579571 #(0.000000 1.526666 1.114036 -0.188699 1.569783 1.061483 1.461941 0.746029 1.509803 1.264040 0.039120 0.005480 1.670375 0.087176 1.602839 1.411297 1.630968 0.248800 0.070549 1.021733 -0.228089 1.869979 1.152734 0.098898 0.604652 0.265485 1.435929 0.170559 0.737250 0.104974 0.731428 1.774793 1.550528 -0.147974 1.870001 1.248377 1.256893 0.177185 1.205217 1.218210 1.654506 -0.048160 1.262662 0.659765 1.099483 0.193101 1.327235 0.693549 1.139270 0.170053 0.767850 1.284172 -0.044820 1.663616 1.015434 0.890883 1.694823 0.554893 0.622406 0.662793 0.328828 0.995738 1.236624 0.150517 1.587539 1.302619 0.103369 0.398303 0.131685 0.921928 1.168883 0.112924)
+ 10.579571 #r(0.000000 1.526666 1.114036 -0.188699 1.569783 1.061483 1.461941 0.746029 1.509803 1.264040 0.039120 0.005480 1.670375 0.087176 1.602839 1.411297 1.630968 0.248800 0.070549 1.021733 -0.228089 1.869979 1.152734 0.098898 0.604652 0.265485 1.435929 0.170559 0.737250 0.104974 0.731428 1.774793 1.550528 -0.147974 1.870001 1.248377 1.256893 0.177185 1.205217 1.218210 1.654506 -0.048160 1.262662 0.659765 1.099483 0.193101 1.327235 0.693549 1.139270 0.170053 0.767850 1.284172 -0.044820 1.663616 1.015434 0.890883 1.694823 0.554893 0.622406 0.662793 0.328828 0.995738 1.236624 0.150517 1.587539 1.302619 0.103369 0.398303 0.131685 0.921928 1.168883 0.112924)
)
;;; 73 prime --------------------------------------------------------------------------------
-(vector 73 12.877750118249 #(0 1 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 0 0 0 1 0 0 0 1 0 1 0 1 0 1 0)
+(vector 73 12.877750118249 #r(0 1 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 0 0 0 1 0 0 0 1 0 1 0 1 0 1 0)
- 10.737656 #(0.000000 0.602102 0.352641 0.632006 1.552371 0.296077 1.082110 0.013914 1.761810 0.456416 0.737747 0.295270 1.253093 0.753406 0.547256 0.051955 1.746228 0.377469 0.418110 0.901371 0.231886 1.499847 1.247926 1.681473 1.281726 0.414399 -0.025093 0.354821 1.545561 1.180195 1.073840 1.640054 1.311359 1.388818 1.571352 1.435069 -0.082478 0.162069 0.705649 -0.084633 0.587089 0.167800 -0.063043 0.159333 0.913473 1.004072 1.669680 0.741708 1.378872 1.360081 0.270841 1.349751 1.013148 0.450718 0.226120 0.098676 0.779207 1.870363 0.442457 1.048600 1.409639 0.334422 1.713108 0.607567 1.451973 0.551597 1.404406 0.821452 1.414792 0.265647 0.470100 0.101296 1.610504)
+ 10.737656 #r(0.000000 0.602102 0.352641 0.632006 1.552371 0.296077 1.082110 0.013914 1.761810 0.456416 0.737747 0.295270 1.253093 0.753406 0.547256 0.051955 1.746228 0.377469 0.418110 0.901371 0.231886 1.499847 1.247926 1.681473 1.281726 0.414399 -0.025093 0.354821 1.545561 1.180195 1.073840 1.640054 1.311359 1.388818 1.571352 1.435069 -0.082478 0.162069 0.705649 -0.084633 0.587089 0.167800 -0.063043 0.159333 0.913473 1.004072 1.669680 0.741708 1.378872 1.360081 0.270841 1.349751 1.013148 0.450718 0.226120 0.098676 0.779207 1.870363 0.442457 1.048600 1.409639 0.334422 1.713108 0.607567 1.451973 0.551597 1.404406 0.821452 1.414792 0.265647 0.470100 0.101296 1.610504)
;; 72+1
- 10.689130 #(0.000000 1.525750 1.157802 -0.130495 1.566135 1.068083 1.436324 0.699061 1.496431 1.345845 -0.045471 -0.032146 1.656974 0.163846 1.519166 1.394757 1.503557 0.183007 0.248242 1.068642 -0.134987 1.855031 1.116717 -0.022218 0.511499 0.347386 1.347662 0.149072 0.778251 0.082394 0.706357 1.835299 1.598933 -0.137332 1.800937 1.334976 1.258225 0.107942 1.165982 1.097698 1.720927 -0.060245 1.266550 0.522159 1.151393 0.179388 1.306382 0.759803 1.190783 0.160999 0.709993 1.280967 -0.169862 1.562918 1.019413 0.839429 1.731380 0.566096 0.647229 0.704371 0.329975 1.072857 1.320759 0.275029 1.479112 1.297543 0.103782 0.366305 0.194503 1.011614 1.086013 0.243622 -0.036669)
+ 10.689130 #r(0.000000 1.525750 1.157802 -0.130495 1.566135 1.068083 1.436324 0.699061 1.496431 1.345845 -0.045471 -0.032146 1.656974 0.163846 1.519166 1.394757 1.503557 0.183007 0.248242 1.068642 -0.134987 1.855031 1.116717 -0.022218 0.511499 0.347386 1.347662 0.149072 0.778251 0.082394 0.706357 1.835299 1.598933 -0.137332 1.800937 1.334976 1.258225 0.107942 1.165982 1.097698 1.720927 -0.060245 1.266550 0.522159 1.151393 0.179388 1.306382 0.759803 1.190783 0.160999 0.709993 1.280967 -0.169862 1.562918 1.019413 0.839429 1.731380 0.566096 0.647229 0.704371 0.329975 1.072857 1.320759 0.275029 1.479112 1.297543 0.103782 0.366305 0.194503 1.011614 1.086013 0.243622 -0.036669)
)
;;; 74 prime --------------------------------------------------------------------------------
-(vector 74 13.115156173706 #(0 1 1 0 0 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 1 0 1 0 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 1 0 1 1 1 1 1 0 0 0 0 0 1)
+(vector 74 13.115156173706 #r(0 1 1 0 0 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 1 0 1 0 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 1 0 1 1 1 1 1 0 0 0 0 0 1)
- 10.649887 #(0.000000 0.311188 1.290942 0.614169 0.538966 0.384100 0.109850 0.021551 0.798332 1.375278 0.593955 1.270048 0.158912 1.156782 1.030374 0.821590 0.254106 0.736652 -0.160646 1.527962 0.008622 1.070061 1.131441 1.654723 1.927687 1.286729 -0.139272 1.540344 0.234722 1.262327 0.958913 0.415825 0.099669 0.142462 -0.047631 -0.219606 0.497897 0.164613 1.298918 -0.030959 0.077929 0.023069 -0.048674 1.490524 1.421741 1.027040 1.916604 1.756080 0.253777 0.507377 0.665062 0.691819 1.450238 1.738862 1.010067 1.810972 1.515691 0.044783 0.082536 1.267984 0.419709 0.481882 1.832483 1.839130 0.674123 0.733681 1.236692 0.099256 1.206529 1.152388 -0.150515 0.755739 -0.177039 0.279539)
+ 10.649887 #r(0.000000 0.311188 1.290942 0.614169 0.538966 0.384100 0.109850 0.021551 0.798332 1.375278 0.593955 1.270048 0.158912 1.156782 1.030374 0.821590 0.254106 0.736652 -0.160646 1.527962 0.008622 1.070061 1.131441 1.654723 1.927687 1.286729 -0.139272 1.540344 0.234722 1.262327 0.958913 0.415825 0.099669 0.142462 -0.047631 -0.219606 0.497897 0.164613 1.298918 -0.030959 0.077929 0.023069 -0.048674 1.490524 1.421741 1.027040 1.916604 1.756080 0.253777 0.507377 0.665062 0.691819 1.450238 1.738862 1.010067 1.810972 1.515691 0.044783 0.082536 1.267984 0.419709 0.481882 1.832483 1.839130 0.674123 0.733681 1.236692 0.099256 1.206529 1.152388 -0.150515 0.755739 -0.177039 0.279539)
)
;;; 75 prime --------------------------------------------------------------------------------
-(vector 75 13.254356384277 #(0 0 0 1 0 1 1 0 0 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 0 1 0 1 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 1 1 0 1 1)
+(vector 75 13.254356384277 #r(0 0 0 1 0 1 1 0 0 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 0 1 0 1 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 1 1 0 1 1)
- 11.022299 #(0.000000 0.351470 1.008124 1.291533 1.352523 1.219130 1.555492 -0.093523 0.793123 1.710126 0.845582 1.377487 0.007190 1.144398 0.030789 1.388046 0.801302 1.006307 1.228947 1.174967 0.712656 1.235684 0.437185 1.685920 1.628311 0.432535 1.406407 0.211487 1.631733 1.309990 0.088839 1.823347 0.645147 0.984102 0.938592 0.791055 1.200055 1.653923 1.369127 1.660169 1.684809 1.277014 1.423374 1.618705 1.761213 0.185242 0.737016 0.819843 1.700256 1.790111 1.582839 0.397943 0.430644 0.413691 1.861593 0.597392 0.781277 0.169222 1.035252 0.907321 0.225899 -0.109171 1.673244 0.994007 0.840763 0.321135 1.684359 1.522767 0.808080 0.918598 -0.016940 0.115899 0.890010 0.043957 1.335248)
+ 11.022299 #r(0.000000 0.351470 1.008124 1.291533 1.352523 1.219130 1.555492 -0.093523 0.793123 1.710126 0.845582 1.377487 0.007190 1.144398 0.030789 1.388046 0.801302 1.006307 1.228947 1.174967 0.712656 1.235684 0.437185 1.685920 1.628311 0.432535 1.406407 0.211487 1.631733 1.309990 0.088839 1.823347 0.645147 0.984102 0.938592 0.791055 1.200055 1.653923 1.369127 1.660169 1.684809 1.277014 1.423374 1.618705 1.761213 0.185242 0.737016 0.819843 1.700256 1.790111 1.582839 0.397943 0.430644 0.413691 1.861593 0.597392 0.781277 0.169222 1.035252 0.907321 0.225899 -0.109171 1.673244 0.994007 0.840763 0.321135 1.684359 1.522767 0.808080 0.918598 -0.016940 0.115899 0.890010 0.043957 1.335248)
;; 74+1
- 10.845278 #(0.000000 0.303549 1.218741 0.552551 0.569127 0.472240 0.245073 0.036162 0.777257 1.317108 0.637687 1.223165 0.113140 1.175025 0.935816 0.812633 0.204261 0.775370 -0.063348 1.606612 -0.062866 1.039670 1.212702 1.714844 1.899468 1.335566 -0.020119 1.590425 0.290190 1.193213 1.001576 0.516379 0.026311 0.170930 -0.096650 -0.315084 0.554428 0.144183 1.271300 0.005031 0.147859 0.041442 -0.048782 1.533805 1.480719 1.134329 1.851707 1.704199 0.286268 0.581546 0.690124 0.731502 1.497188 1.734408 1.013517 -0.010349 1.506433 0.024492 0.040181 1.200857 0.486442 0.422051 1.858040 1.837071 0.586958 0.629092 1.226159 0.139529 1.240473 1.272372 -0.245955 0.719958 -0.223615 0.281302 0.252047)
+ 10.845278 #r(0.000000 0.303549 1.218741 0.552551 0.569127 0.472240 0.245073 0.036162 0.777257 1.317108 0.637687 1.223165 0.113140 1.175025 0.935816 0.812633 0.204261 0.775370 -0.063348 1.606612 -0.062866 1.039670 1.212702 1.714844 1.899468 1.335566 -0.020119 1.590425 0.290190 1.193213 1.001576 0.516379 0.026311 0.170930 -0.096650 -0.315084 0.554428 0.144183 1.271300 0.005031 0.147859 0.041442 -0.048782 1.533805 1.480719 1.134329 1.851707 1.704199 0.286268 0.581546 0.690124 0.731502 1.497188 1.734408 1.013517 -0.010349 1.506433 0.024492 0.040181 1.200857 0.486442 0.422051 1.858040 1.837071 0.586958 0.629092 1.226159 0.139529 1.240473 1.272372 -0.245955 0.719958 -0.223615 0.281302 0.252047)
)
;;; 76 prime --------------------------------------------------------------------------------
-(vector 76 13.288178191792 #(0 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1)
+(vector 76 13.288178191792 #r(0 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1)
- 11.052689 #(0.000000 1.173531 0.914653 0.927606 1.833325 0.572990 1.228121 1.340974 0.777818 0.101179 0.922381 0.727758 0.848668 1.622591 0.600587 1.207357 0.483679 -0.135739 0.789693 0.557916 0.529588 0.315324 1.810649 0.126643 0.909249 1.640326 1.342327 -0.052236 0.755820 1.799623 0.462177 -0.288032 0.651075 1.169254 1.824988 0.704237 0.880995 1.859829 0.036089 0.149448 0.542052 0.160045 1.646079 0.860838 1.752249 1.025660 0.604221 0.046575 0.711402 1.553525 1.214111 0.036075 0.479955 0.029596 1.070090 1.208893 1.207610 0.470868 0.758081 1.507527 0.678107 0.675805 1.580182 1.324295 0.061587 0.955350 1.218409 1.880195 0.596793 0.165057 0.646006 0.454851 -0.080576 1.833376 0.764382 0.602862)
+ 11.052689 #r(0.000000 1.173531 0.914653 0.927606 1.833325 0.572990 1.228121 1.340974 0.777818 0.101179 0.922381 0.727758 0.848668 1.622591 0.600587 1.207357 0.483679 -0.135739 0.789693 0.557916 0.529588 0.315324 1.810649 0.126643 0.909249 1.640326 1.342327 -0.052236 0.755820 1.799623 0.462177 -0.288032 0.651075 1.169254 1.824988 0.704237 0.880995 1.859829 0.036089 0.149448 0.542052 0.160045 1.646079 0.860838 1.752249 1.025660 0.604221 0.046575 0.711402 1.553525 1.214111 0.036075 0.479955 0.029596 1.070090 1.208893 1.207610 0.470868 0.758081 1.507527 0.678107 0.675805 1.580182 1.324295 0.061587 0.955350 1.218409 1.880195 0.596793 0.165057 0.646006 0.454851 -0.080576 1.833376 0.764382 0.602862)
;; 75+1
- 10.919127 #(0.000000 0.249051 1.283752 0.578538 0.465889 0.328282 0.397520 0.048700 0.732044 1.506763 0.870470 1.024466 0.125905 1.199969 1.200490 0.828996 0.327349 0.743916 -0.083081 1.581866 -0.022026 1.010771 1.314126 1.641110 1.977207 1.418126 -0.002727 1.553515 0.292061 1.103162 1.068475 0.567360 0.089633 0.183619 -0.243814 -0.246117 0.459882 0.118225 1.182209 0.017390 0.042772 0.114593 -0.081235 1.493721 1.405420 1.147867 1.909741 1.653034 0.237976 0.515913 0.601555 0.768092 1.451311 1.697940 1.055226 -0.095470 1.438708 0.052821 -0.122724 1.275935 0.441115 0.338376 1.822506 1.852761 0.555244 0.752898 1.362553 0.167682 1.066534 1.298923 -0.414288 0.895495 -0.078589 0.121695 0.415788 -0.032714)
+ 10.919127 #r(0.000000 0.249051 1.283752 0.578538 0.465889 0.328282 0.397520 0.048700 0.732044 1.506763 0.870470 1.024466 0.125905 1.199969 1.200490 0.828996 0.327349 0.743916 -0.083081 1.581866 -0.022026 1.010771 1.314126 1.641110 1.977207 1.418126 -0.002727 1.553515 0.292061 1.103162 1.068475 0.567360 0.089633 0.183619 -0.243814 -0.246117 0.459882 0.118225 1.182209 0.017390 0.042772 0.114593 -0.081235 1.493721 1.405420 1.147867 1.909741 1.653034 0.237976 0.515913 0.601555 0.768092 1.451311 1.697940 1.055226 -0.095470 1.438708 0.052821 -0.122724 1.275935 0.441115 0.338376 1.822506 1.852761 0.555244 0.752898 1.362553 0.167682 1.066534 1.298923 -0.414288 0.895495 -0.078589 0.121695 0.415788 -0.032714)
)
;;; 77 prime --------------------------------------------------------------------------------
-(vector 77 13.158900260925 #(0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0 1 0 0 0 0 0 0 1 0 1 1 1 1 1 1)
+(vector 77 13.158900260925 #r(0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0 1 0 0 0 0 0 0 1 0 1 1 1 1 1 1)
- 10.802937 #(0.000000 1.170348 0.872365 1.938370 0.176318 1.425001 1.816351 0.600885 0.838206 0.617008 0.862854 1.459906 1.685266 -0.294339 0.340282 0.188975 1.272363 0.222263 0.754500 0.303643 1.420294 0.520239 1.223316 1.153660 0.209190 1.335123 1.331714 0.719154 0.909245 -0.009852 0.827474 -0.139034 0.531790 0.623898 0.587466 0.935238 0.452213 -0.149439 0.923750 0.885640 -0.429219 0.037445 0.354080 0.150061 0.302072 1.423031 0.130250 -0.009435 0.571653 0.410660 0.194501 1.802956 0.455392 0.509514 1.619972 1.373513 1.082720 1.024058 0.798330 0.005055 0.529388 0.193199 0.652877 0.658529 1.505933 1.232728 0.171053 1.366924 1.004855 0.355582 1.506276 0.574068 1.502183 1.005869 -0.239104 1.730993 -0.006156)
+ 10.802937 #r(0.000000 1.170348 0.872365 1.938370 0.176318 1.425001 1.816351 0.600885 0.838206 0.617008 0.862854 1.459906 1.685266 -0.294339 0.340282 0.188975 1.272363 0.222263 0.754500 0.303643 1.420294 0.520239 1.223316 1.153660 0.209190 1.335123 1.331714 0.719154 0.909245 -0.009852 0.827474 -0.139034 0.531790 0.623898 0.587466 0.935238 0.452213 -0.149439 0.923750 0.885640 -0.429219 0.037445 0.354080 0.150061 0.302072 1.423031 0.130250 -0.009435 0.571653 0.410660 0.194501 1.802956 0.455392 0.509514 1.619972 1.373513 1.082720 1.024058 0.798330 0.005055 0.529388 0.193199 0.652877 0.658529 1.505933 1.232728 0.171053 1.366924 1.004855 0.355582 1.506276 0.574068 1.502183 1.005869 -0.239104 1.730993 -0.006156)
)
;;; 78 prime --------------------------------------------------------------------------------
-(vector 78 13.498236182018 #(0 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 0 1 1 1 0 1 0 0 1 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 1 1 0 0 1 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1)
+(vector 78 13.498236182018 #r(0 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 0 1 1 1 0 1 0 0 1 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 1 1 0 0 1 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1)
- 11.128810 #(0.000000 1.556151 1.350766 1.079560 1.627456 1.824396 0.970239 1.719188 0.076491 0.356551 0.956437 1.450393 1.649467 1.028644 0.913293 0.244507 0.114759 1.070289 1.644113 1.454817 0.980418 0.918084 0.619510 1.767585 1.807117 0.656270 1.762010 0.672983 0.042023 -0.071247 0.983492 -0.081135 0.135693 0.114828 1.357805 -0.252941 1.850579 1.671928 0.257832 0.920719 0.631282 0.706947 1.321680 1.346893 -0.182371 -0.272451 0.054087 1.657623 0.055118 0.350677 1.314600 0.063294 0.902678 0.105522 1.670846 0.405032 -0.075578 -0.012369 -0.068016 1.298918 0.818077 -0.266776 0.759067 0.508057 -0.040066 1.459059 0.532881 1.133191 1.019843 -0.486096 1.086169 0.894532 1.300427 1.601490 0.616399 1.768752 1.000095 1.636458)
+ 11.128810 #r(0.000000 1.556151 1.350766 1.079560 1.627456 1.824396 0.970239 1.719188 0.076491 0.356551 0.956437 1.450393 1.649467 1.028644 0.913293 0.244507 0.114759 1.070289 1.644113 1.454817 0.980418 0.918084 0.619510 1.767585 1.807117 0.656270 1.762010 0.672983 0.042023 -0.071247 0.983492 -0.081135 0.135693 0.114828 1.357805 -0.252941 1.850579 1.671928 0.257832 0.920719 0.631282 0.706947 1.321680 1.346893 -0.182371 -0.272451 0.054087 1.657623 0.055118 0.350677 1.314600 0.063294 0.902678 0.105522 1.670846 0.405032 -0.075578 -0.012369 -0.068016 1.298918 0.818077 -0.266776 0.759067 0.508057 -0.040066 1.459059 0.532881 1.133191 1.019843 -0.486096 1.086169 0.894532 1.300427 1.601490 0.616399 1.768752 1.000095 1.636458)
;; 77+1
- 11.104393 #(0.000000 1.124037 0.854979 1.945811 0.208140 1.468398 1.815990 0.611918 0.912844 0.730140 0.961369 1.376309 1.803559 -0.243021 0.398976 0.193476 1.338837 0.340346 0.793855 0.341671 1.410779 0.565778 1.176931 1.048390 0.277106 1.445162 1.185150 0.642492 0.933385 0.019030 0.859542 -0.113411 0.532157 0.598476 0.550518 0.931780 0.311264 -0.108835 0.867767 0.932278 -0.351004 0.021213 0.390636 0.076987 0.338139 1.457487 0.082705 1.889708 0.513158 0.413795 0.138548 1.809057 0.494899 0.552125 1.690745 1.358244 1.250637 0.989495 0.775385 1.847135 0.528873 0.242941 0.558866 0.669472 1.484739 1.334473 0.249966 1.409992 1.022049 0.346238 1.534652 0.641930 1.394789 0.932978 -0.210333 1.769933 -0.083609 -0.106856)
+ 11.104393 #r(0.000000 1.124037 0.854979 1.945811 0.208140 1.468398 1.815990 0.611918 0.912844 0.730140 0.961369 1.376309 1.803559 -0.243021 0.398976 0.193476 1.338837 0.340346 0.793855 0.341671 1.410779 0.565778 1.176931 1.048390 0.277106 1.445162 1.185150 0.642492 0.933385 0.019030 0.859542 -0.113411 0.532157 0.598476 0.550518 0.931780 0.311264 -0.108835 0.867767 0.932278 -0.351004 0.021213 0.390636 0.076987 0.338139 1.457487 0.082705 1.889708 0.513158 0.413795 0.138548 1.809057 0.494899 0.552125 1.690745 1.358244 1.250637 0.989495 0.775385 1.847135 0.528873 0.242941 0.558866 0.669472 1.484739 1.334473 0.249966 1.409992 1.022049 0.346238 1.534652 0.641930 1.394789 0.932978 -0.210333 1.769933 -0.083609 -0.106856)
)
;;; 79 prime --------------------------------------------------------------------------------
-(vector 79 13.178678233398 #(0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1 0 1 0 0 0 0 0 1 0 1 1 0 1)
+(vector 79 13.178678233398 #r(0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1 0 1 0 0 0 0 0 1 0 1 1 0 1)
- 11.177833 #(0.000000 1.310798 1.470398 1.323367 0.553981 1.135824 0.783258 1.090444 0.524280 1.788975 1.639185 0.764585 0.676397 1.561727 -0.046007 0.428923 1.763449 0.011640 0.636361 1.341212 0.004579 1.608860 0.575061 0.243266 0.907181 0.977184 1.726699 0.431482 0.140827 0.464141 1.057140 1.400168 0.289408 0.838151 1.631807 1.530460 1.501458 0.566438 1.487014 0.015110 1.680036 1.296993 1.364424 0.039821 1.528230 0.589464 0.715462 0.552663 -0.017058 1.149326 1.516482 -0.030051 0.582733 -0.149911 0.234725 0.517539 1.013720 0.964483 -0.295150 -0.068887 -0.069035 1.472439 0.368231 1.600803 0.316013 0.723864 0.014324 0.524613 1.419685 1.673198 -0.043005 -0.029455 1.487321 1.686189 1.173017 1.833259 1.763911 1.426155 0.892867)
+ 11.177833 #r(0.000000 1.310798 1.470398 1.323367 0.553981 1.135824 0.783258 1.090444 0.524280 1.788975 1.639185 0.764585 0.676397 1.561727 -0.046007 0.428923 1.763449 0.011640 0.636361 1.341212 0.004579 1.608860 0.575061 0.243266 0.907181 0.977184 1.726699 0.431482 0.140827 0.464141 1.057140 1.400168 0.289408 0.838151 1.631807 1.530460 1.501458 0.566438 1.487014 0.015110 1.680036 1.296993 1.364424 0.039821 1.528230 0.589464 0.715462 0.552663 -0.017058 1.149326 1.516482 -0.030051 0.582733 -0.149911 0.234725 0.517539 1.013720 0.964483 -0.295150 -0.068887 -0.069035 1.472439 0.368231 1.600803 0.316013 0.723864 0.014324 0.524613 1.419685 1.673198 -0.043005 -0.029455 1.487321 1.686189 1.173017 1.833259 1.763911 1.426155 0.892867)
)
;;; 80 prime --------------------------------------------------------------------------------
-(vector 80 13.547472953796 #(0 1 1 1 0 0 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 1 1 1 1 1 0 0 1 0 0 1 0 1 0 1)
+(vector 80 13.547472953796 #r(0 1 1 1 0 0 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 1 1 1 1 1 0 0 1 0 0 1 0 1 0 1)
- 11.451369 #(0.000000 -0.011188 0.391305 0.222144 0.025668 0.977359 0.513223 0.531901 0.360643 0.616841 1.341911 0.888846 1.600347 1.373974 0.123418 0.279769 -0.016126 0.463887 1.222914 1.957299 0.569052 1.699668 0.580517 1.202146 1.407428 1.172831 0.507495 0.800333 0.267556 -0.108002 1.745992 0.435164 1.044228 1.843822 0.030677 1.871048 0.542929 1.649600 0.514183 1.864352 0.330625 0.131744 0.409433 0.986423 1.602974 0.780283 0.138004 1.178452 0.747173 1.116954 0.917346 0.796903 0.356061 1.164738 0.640385 1.216938 0.366648 0.258624 0.900284 0.041536 1.817962 1.403113 1.192348 0.700576 1.370480 0.286847 0.603480 0.172807 1.255252 0.148259 1.272121 0.592895 1.744785 0.951797 1.489669 1.384870 1.365248 1.727217 1.576364 1.630892)
+ 11.451369 #r(0.000000 -0.011188 0.391305 0.222144 0.025668 0.977359 0.513223 0.531901 0.360643 0.616841 1.341911 0.888846 1.600347 1.373974 0.123418 0.279769 -0.016126 0.463887 1.222914 1.957299 0.569052 1.699668 0.580517 1.202146 1.407428 1.172831 0.507495 0.800333 0.267556 -0.108002 1.745992 0.435164 1.044228 1.843822 0.030677 1.871048 0.542929 1.649600 0.514183 1.864352 0.330625 0.131744 0.409433 0.986423 1.602974 0.780283 0.138004 1.178452 0.747173 1.116954 0.917346 0.796903 0.356061 1.164738 0.640385 1.216938 0.366648 0.258624 0.900284 0.041536 1.817962 1.403113 1.192348 0.700576 1.370480 0.286847 0.603480 0.172807 1.255252 0.148259 1.272121 0.592895 1.744785 0.951797 1.489669 1.384870 1.365248 1.727217 1.576364 1.630892)
;; 79+1
- 11.248369 #(0.000000 1.320660 1.562587 1.230907 0.791500 1.111831 0.776332 1.212269 0.471199 1.929248 1.797736 0.814341 0.620835 1.395121 -0.166860 0.291055 1.737100 0.070444 0.531137 1.293083 0.075352 1.711864 0.539841 0.274514 0.922582 0.992421 1.608388 0.391268 0.216699 0.537576 0.886521 1.411196 0.301396 0.827503 1.619143 1.601542 1.558307 0.639158 1.445488 -0.167072 1.736837 1.279584 1.414784 0.077225 1.537483 0.689000 0.730293 0.519349 -0.104713 1.140696 1.722734 -0.057361 0.493518 -0.183111 0.352303 0.572659 0.917617 1.016232 -0.317574 -0.040058 -0.065357 1.491653 0.416263 1.654521 0.241001 0.536870 0.065165 0.568896 1.612372 1.840754 0.054958 0.057425 1.377368 1.668931 1.097005 1.763836 1.887359 1.244817 0.894926 -0.107373)
+ 11.248369 #r(0.000000 1.320660 1.562587 1.230907 0.791500 1.111831 0.776332 1.212269 0.471199 1.929248 1.797736 0.814341 0.620835 1.395121 -0.166860 0.291055 1.737100 0.070444 0.531137 1.293083 0.075352 1.711864 0.539841 0.274514 0.922582 0.992421 1.608388 0.391268 0.216699 0.537576 0.886521 1.411196 0.301396 0.827503 1.619143 1.601542 1.558307 0.639158 1.445488 -0.167072 1.736837 1.279584 1.414784 0.077225 1.537483 0.689000 0.730293 0.519349 -0.104713 1.140696 1.722734 -0.057361 0.493518 -0.183111 0.352303 0.572659 0.917617 1.016232 -0.317574 -0.040058 -0.065357 1.491653 0.416263 1.654521 0.241001 0.536870 0.065165 0.568896 1.612372 1.840754 0.054958 0.057425 1.377368 1.668931 1.097005 1.763836 1.887359 1.244817 0.894926 -0.107373)
)
;;; 81 prime --------------------------------------------------------------------------------
-(vector 81 13.652944564819 #(0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 0 0 0 1 1 0 0 1 1 1)
+(vector 81 13.652944564819 #r(0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 0 0 0 1 1 0 0 1 1 1)
- 11.500874 #(0.000000 0.060156 1.198187 0.010810 -0.059627 1.336892 0.174682 0.177182 0.303039 0.507728 0.174616 0.162104 0.767672 0.283268 0.740356 1.244073 0.411651 0.771082 0.597722 1.646364 0.130092 1.399674 1.196320 1.542256 1.814795 0.969378 1.368552 0.008802 1.647015 1.538679 0.957584 0.562757 0.185463 0.612441 1.264483 1.129777 -0.291833 0.231345 1.808426 -0.095607 1.827790 0.807634 0.929515 0.025793 1.640598 1.271614 1.470525 0.036943 0.657753 0.872430 1.519719 0.128077 0.109048 0.492656 -0.089269 0.591629 -0.109776 0.882829 0.675418 0.557752 1.879709 0.050861 1.363712 1.313213 0.120759 0.673965 0.894225 1.390640 -0.198915 1.435867 0.650146 0.682721 0.919339 1.509191 0.176654 0.428794 0.550059 1.279511 0.067206 1.270072 0.509792)
+ 11.500874 #r(0.000000 0.060156 1.198187 0.010810 -0.059627 1.336892 0.174682 0.177182 0.303039 0.507728 0.174616 0.162104 0.767672 0.283268 0.740356 1.244073 0.411651 0.771082 0.597722 1.646364 0.130092 1.399674 1.196320 1.542256 1.814795 0.969378 1.368552 0.008802 1.647015 1.538679 0.957584 0.562757 0.185463 0.612441 1.264483 1.129777 -0.291833 0.231345 1.808426 -0.095607 1.827790 0.807634 0.929515 0.025793 1.640598 1.271614 1.470525 0.036943 0.657753 0.872430 1.519719 0.128077 0.109048 0.492656 -0.089269 0.591629 -0.109776 0.882829 0.675418 0.557752 1.879709 0.050861 1.363712 1.313213 0.120759 0.673965 0.894225 1.390640 -0.198915 1.435867 0.650146 0.682721 0.919339 1.509191 0.176654 0.428794 0.550059 1.279511 0.067206 1.270072 0.509792)
;; 80+1
- 11.318789 #(0.000000 1.312875 1.595991 1.250300 0.860994 1.125394 0.798611 1.212371 0.450471 1.878426 1.854513 0.914795 0.516574 1.401974 -0.113348 0.191503 1.535380 0.090102 0.579969 1.358286 0.094046 1.749820 0.409421 0.342346 0.891748 1.034938 1.701846 0.411592 0.161183 0.550475 0.945261 1.433769 0.390250 0.782945 1.725670 1.526810 1.626189 0.651868 1.370885 -0.153655 1.876481 1.236862 1.409437 0.102929 1.494796 0.718278 0.752798 0.534726 -0.125235 1.053652 1.624242 -0.009527 0.513674 -0.193412 0.274147 0.590252 0.888478 1.001277 -0.294725 -0.017970 0.022617 1.502755 0.474472 1.669991 0.292823 0.423633 -0.068585 0.472411 1.717891 1.789153 0.120369 -0.013158 1.253256 1.671744 1.049132 1.799303 1.831390 1.289936 0.966946 -0.056458 0.096803)
+ 11.318789 #r(0.000000 1.312875 1.595991 1.250300 0.860994 1.125394 0.798611 1.212371 0.450471 1.878426 1.854513 0.914795 0.516574 1.401974 -0.113348 0.191503 1.535380 0.090102 0.579969 1.358286 0.094046 1.749820 0.409421 0.342346 0.891748 1.034938 1.701846 0.411592 0.161183 0.550475 0.945261 1.433769 0.390250 0.782945 1.725670 1.526810 1.626189 0.651868 1.370885 -0.153655 1.876481 1.236862 1.409437 0.102929 1.494796 0.718278 0.752798 0.534726 -0.125235 1.053652 1.624242 -0.009527 0.513674 -0.193412 0.274147 0.590252 0.888478 1.001277 -0.294725 -0.017970 0.022617 1.502755 0.474472 1.669991 0.292823 0.423633 -0.068585 0.472411 1.717891 1.789153 0.120369 -0.013158 1.253256 1.671744 1.049132 1.799303 1.831390 1.289936 0.966946 -0.056458 0.096803)
)
;;; 82 prime --------------------------------------------------------------------------------
-(vector 82 14.126787045134 #(0 1 0 1 1 1 1 0 0 0 1 1 1 0 0 0 1 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 1 0 0 1 0 0 1 0 0 1 0 0 0 1 0 0 1 0 0 1 0 0 0 0 1 1 0 1 0 0 1 0 1 1 0 1 1 1 1 0 1 0 0)
+(vector 82 14.126787045134 #r(0 1 0 1 1 1 1 0 0 0 1 1 1 0 0 0 1 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 1 0 0 1 0 0 1 0 0 1 0 0 0 1 0 0 1 0 0 1 0 0 0 0 1 1 0 1 0 0 1 0 1 1 0 1 1 1 1 0 1 0 0)
- 11.462533 #(0.000000 1.174537 -0.036810 1.449073 0.002634 1.412064 0.527823 1.690777 0.901678 -0.091711 1.027422 0.397477 1.526657 0.088004 0.143741 1.426347 1.215238 1.051627 0.132305 0.242096 1.932884 0.204037 1.515523 0.068047 0.117753 1.158626 0.459284 1.081363 0.079849 0.326802 0.035989 0.012387 0.861938 0.605551 1.407324 0.411725 0.979703 0.090881 0.271335 0.152506 0.410872 1.149930 0.566324 1.611304 1.416641 0.010695 1.743925 0.323768 0.693725 0.691039 0.186118 0.191067 0.629603 -0.034867 0.109309 0.522152 1.478755 1.337464 1.245454 -0.020762 0.796712 1.449381 1.763960 0.000713 0.577015 1.247460 1.754051 1.376869 0.724941 0.407841 1.068454 1.226119 0.726352 1.657000 0.543820 1.177669 0.881363 0.120220 0.019239 0.418519 0.727327 0.208388)
+ 11.462533 #r(0.000000 1.174537 -0.036810 1.449073 0.002634 1.412064 0.527823 1.690777 0.901678 -0.091711 1.027422 0.397477 1.526657 0.088004 0.143741 1.426347 1.215238 1.051627 0.132305 0.242096 1.932884 0.204037 1.515523 0.068047 0.117753 1.158626 0.459284 1.081363 0.079849 0.326802 0.035989 0.012387 0.861938 0.605551 1.407324 0.411725 0.979703 0.090881 0.271335 0.152506 0.410872 1.149930 0.566324 1.611304 1.416641 0.010695 1.743925 0.323768 0.693725 0.691039 0.186118 0.191067 0.629603 -0.034867 0.109309 0.522152 1.478755 1.337464 1.245454 -0.020762 0.796712 1.449381 1.763960 0.000713 0.577015 1.247460 1.754051 1.376869 0.724941 0.407841 1.068454 1.226119 0.726352 1.657000 0.543820 1.177669 0.881363 0.120220 0.019239 0.418519 0.727327 0.208388)
;; 81+1
- 11.476728 #(0.000000 1.354025 1.769404 1.190492 0.845403 1.129164 0.681502 1.298591 0.526568 1.843796 1.839481 0.929391 0.545970 1.407502 -0.189236 0.155330 1.457831 0.110325 0.689064 1.222186 0.140271 1.863572 0.397423 0.425505 0.924253 1.034491 1.746896 0.221413 0.062871 0.570198 0.961166 1.514028 0.333971 0.850400 1.784003 1.484569 1.642647 0.680600 1.387654 -0.169385 1.868168 1.192895 1.317483 0.057642 1.550333 0.713537 0.826588 0.568782 -0.116091 1.031193 1.647713 0.076692 0.476679 -0.258739 0.325137 0.519423 0.928625 1.015174 -0.230419 -0.032172 0.037533 1.492936 0.495027 1.663321 0.378454 0.435791 -0.107582 0.529403 1.716992 1.827784 0.057964 -0.044990 1.256674 1.627386 1.007381 1.757651 1.738780 1.265746 1.051412 0.004277 0.076991 0.034105)
+ 11.476728 #r(0.000000 1.354025 1.769404 1.190492 0.845403 1.129164 0.681502 1.298591 0.526568 1.843796 1.839481 0.929391 0.545970 1.407502 -0.189236 0.155330 1.457831 0.110325 0.689064 1.222186 0.140271 1.863572 0.397423 0.425505 0.924253 1.034491 1.746896 0.221413 0.062871 0.570198 0.961166 1.514028 0.333971 0.850400 1.784003 1.484569 1.642647 0.680600 1.387654 -0.169385 1.868168 1.192895 1.317483 0.057642 1.550333 0.713537 0.826588 0.568782 -0.116091 1.031193 1.647713 0.076692 0.476679 -0.258739 0.325137 0.519423 0.928625 1.015174 -0.230419 -0.032172 0.037533 1.492936 0.495027 1.663321 0.378454 0.435791 -0.107582 0.529403 1.716992 1.827784 0.057964 -0.044990 1.256674 1.627386 1.007381 1.757651 1.738780 1.265746 1.051412 0.004277 0.076991 0.034105)
;; 83-1
- 11.480416 #(0.000000 0.454164 1.374754 0.722227 0.986349 1.377355 1.172894 0.123589 1.410636 1.726879 1.302862 1.602018 1.474058 1.472070 0.412168 1.770446 1.982011 1.625710 0.940561 0.534669 0.102735 0.053883 0.631657 1.350304 0.393669 0.521507 -0.049446 0.629634 1.041110 1.379158 -0.156331 1.690517 0.010013 1.800842 0.947691 1.681261 1.009361 1.763476 0.941228 1.218725 1.847726 0.614247 1.223796 0.150627 0.820237 0.298534 1.321472 0.537094 1.742045 0.701084 0.211813 0.587227 0.340134 0.598492 1.566318 1.525148 0.920822 1.421639 1.608617 0.590851 0.062396 0.476310 0.647458 0.340763 1.923701 0.385843 0.256835 1.446458 1.741785 0.470072 1.939455 0.907485 0.836540 0.652790 1.796743 1.327810 0.106788 1.646107 1.364400 0.210392 0.634295 1.443213)
+ 11.480416 #r(0.000000 0.454164 1.374754 0.722227 0.986349 1.377355 1.172894 0.123589 1.410636 1.726879 1.302862 1.602018 1.474058 1.472070 0.412168 1.770446 1.982011 1.625710 0.940561 0.534669 0.102735 0.053883 0.631657 1.350304 0.393669 0.521507 -0.049446 0.629634 1.041110 1.379158 -0.156331 1.690517 0.010013 1.800842 0.947691 1.681261 1.009361 1.763476 0.941228 1.218725 1.847726 0.614247 1.223796 0.150627 0.820237 0.298534 1.321472 0.537094 1.742045 0.701084 0.211813 0.587227 0.340134 0.598492 1.566318 1.525148 0.920822 1.421639 1.608617 0.590851 0.062396 0.476310 0.647458 0.340763 1.923701 0.385843 0.256835 1.446458 1.741785 0.470072 1.939455 0.907485 0.836540 0.652790 1.796743 1.327810 0.106788 1.646107 1.364400 0.210392 0.634295 1.443213)
)
;;; 83 prime --------------------------------------------------------------------------------
-(vector 83 14.019070339131 #(0 1 1 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 0 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 1 0 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 1 1 0 0 0 1)
+(vector 83 14.019070339131 #r(0 1 1 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 0 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 1 0 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 1 1 0 0 0 1)
- 11.495305 #(0.000000 0.489724 1.459665 0.744876 0.880930 1.487259 1.179525 0.143969 1.398705 1.711637 1.229644 1.599300 1.480153 1.405136 0.390934 1.640936 1.928348 1.588509 0.860260 0.449815 0.093357 1.993956 0.692831 1.455573 0.371844 0.551569 -0.014841 0.652289 1.000821 1.372208 -0.157122 1.697110 0.020676 1.736939 1.000046 1.712927 0.862704 1.740081 0.913067 1.344458 1.894797 0.629049 1.175321 0.159464 0.992773 0.367516 1.362985 0.576721 1.753109 0.776625 0.227603 0.452205 0.315264 0.636900 1.541376 1.554828 0.983967 1.431020 1.527430 0.561443 -0.018728 0.579720 0.634527 0.252657 1.931947 0.472631 0.403447 1.506115 1.700022 0.443875 1.857223 0.863365 0.830784 0.658374 1.791596 1.216322 0.200510 1.645886 1.544611 0.129139 0.651447 1.366065 0.329410)
+ 11.495305 #r(0.000000 0.489724 1.459665 0.744876 0.880930 1.487259 1.179525 0.143969 1.398705 1.711637 1.229644 1.599300 1.480153 1.405136 0.390934 1.640936 1.928348 1.588509 0.860260 0.449815 0.093357 1.993956 0.692831 1.455573 0.371844 0.551569 -0.014841 0.652289 1.000821 1.372208 -0.157122 1.697110 0.020676 1.736939 1.000046 1.712927 0.862704 1.740081 0.913067 1.344458 1.894797 0.629049 1.175321 0.159464 0.992773 0.367516 1.362985 0.576721 1.753109 0.776625 0.227603 0.452205 0.315264 0.636900 1.541376 1.554828 0.983967 1.431020 1.527430 0.561443 -0.018728 0.579720 0.634527 0.252657 1.931947 0.472631 0.403447 1.506115 1.700022 0.443875 1.857223 0.863365 0.830784 0.658374 1.791596 1.216322 0.200510 1.645886 1.544611 0.129139 0.651447 1.366065 0.329410)
)
;;; 84 prime --------------------------------------------------------------------------------
-(vector 84 14.024940956301 #(0 1 0 1 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 1 1 0 1 1 1 0)
+(vector 84 14.024940956301 #r(0 1 0 1 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 1 1 0 1 1 1 0)
- 11.536851 #(0.000000 1.288171 1.222912 1.421316 0.994256 1.309106 0.862461 -0.365885 -0.460542 0.530989 0.804830 1.140139 0.788715 0.769440 0.941320 -0.061500 1.897753 1.285116 0.647118 0.948482 1.478812 1.645309 -0.360540 1.475165 0.480180 0.398442 1.131834 0.453887 0.828958 0.223971 1.033478 0.103677 1.715711 0.595485 0.422094 0.246530 1.081093 0.706350 0.534924 0.737096 0.520740 1.348231 0.027898 1.430351 0.071366 0.456025 1.024992 0.563780 1.148663 1.244878 0.023430 1.078768 -0.035007 1.108834 0.481954 -0.628990 0.715248 0.675907 1.709977 0.563135 1.037605 0.888801 0.556599 0.958729 0.571715 1.126122 -0.072129 1.378438 0.187340 0.783805 0.989989 0.112073 -0.183972 1.388719 1.544777 0.651714 0.568338 1.234814 0.056527 0.901152 1.674263 0.800528 0.192396 0.655541)
+ 11.536851 #r(0.000000 1.288171 1.222912 1.421316 0.994256 1.309106 0.862461 -0.365885 -0.460542 0.530989 0.804830 1.140139 0.788715 0.769440 0.941320 -0.061500 1.897753 1.285116 0.647118 0.948482 1.478812 1.645309 -0.360540 1.475165 0.480180 0.398442 1.131834 0.453887 0.828958 0.223971 1.033478 0.103677 1.715711 0.595485 0.422094 0.246530 1.081093 0.706350 0.534924 0.737096 0.520740 1.348231 0.027898 1.430351 0.071366 0.456025 1.024992 0.563780 1.148663 1.244878 0.023430 1.078768 -0.035007 1.108834 0.481954 -0.628990 0.715248 0.675907 1.709977 0.563135 1.037605 0.888801 0.556599 0.958729 0.571715 1.126122 -0.072129 1.378438 0.187340 0.783805 0.989989 0.112073 -0.183972 1.388719 1.544777 0.651714 0.568338 1.234814 0.056527 0.901152 1.674263 0.800528 0.192396 0.655541)
)
;;; 85 prime --------------------------------------------------------------------------------
-(vector 85 14.253310943921 #(0 0 1 1 1 0 0 0 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 1 0 1 0 0 0 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 0 0 0 0 1 0 1)
+(vector 85 14.253310943921 #r(0 0 1 1 1 0 0 0 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 1 0 1 0 0 0 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 0 0 0 0 1 0 1)
- 11.588928 #(0.000000 0.051144 0.232251 1.722677 0.580164 1.682133 1.175152 1.551429 1.040385 1.746433 0.629958 1.774843 0.701195 0.931344 1.300787 -0.092863 1.300643 1.259885 1.530011 1.258206 1.393028 0.930782 0.485840 1.244517 -0.032618 0.062247 0.154622 1.065009 0.904299 1.262092 0.852812 0.408235 0.633914 1.770716 1.085864 1.265219 1.003699 1.255985 1.195701 1.382932 0.704891 0.246143 0.639193 1.457010 0.146909 1.982729 0.165366 1.294717 0.624758 1.669440 0.868773 0.953753 0.230896 0.915079 -0.212743 0.773612 0.218470 1.122339 1.601419 1.730078 1.474786 -0.488722 1.796889 1.514239 1.703114 -0.437786 0.743917 1.859124 1.287147 1.160254 0.159597 0.817545 1.148746 -0.204270 1.716652 0.382598 -0.057580 0.598631 0.343212 0.230053 1.103741 1.603024 0.720362 -0.247891 -0.077598)
+ 11.588928 #r(0.000000 0.051144 0.232251 1.722677 0.580164 1.682133 1.175152 1.551429 1.040385 1.746433 0.629958 1.774843 0.701195 0.931344 1.300787 -0.092863 1.300643 1.259885 1.530011 1.258206 1.393028 0.930782 0.485840 1.244517 -0.032618 0.062247 0.154622 1.065009 0.904299 1.262092 0.852812 0.408235 0.633914 1.770716 1.085864 1.265219 1.003699 1.255985 1.195701 1.382932 0.704891 0.246143 0.639193 1.457010 0.146909 1.982729 0.165366 1.294717 0.624758 1.669440 0.868773 0.953753 0.230896 0.915079 -0.212743 0.773612 0.218470 1.122339 1.601419 1.730078 1.474786 -0.488722 1.796889 1.514239 1.703114 -0.437786 0.743917 1.859124 1.287147 1.160254 0.159597 0.817545 1.148746 -0.204270 1.716652 0.382598 -0.057580 0.598631 0.343212 0.230053 1.103741 1.603024 0.720362 -0.247891 -0.077598)
)
;;; 86 prime --------------------------------------------------------------------------------
-(vector 86 14.017106967247 #(0 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0 0 1 1 1 0 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 0 1 1 0 0 1 0 0 1 1 0 0 0 0 1 0 1 1 1)
+(vector 86 14.017106967247 #r(0 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0 0 1 1 1 0 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 0 1 1 0 0 1 0 0 1 1 0 0 0 0 1 0 1 1 1)
- 11.517897 #(0.000000 1.259153 0.753054 1.764686 1.049517 1.125067 1.190973 0.991011 1.742456 0.708907 0.178161 0.559310 1.128716 0.240782 0.729992 0.303371 0.569838 1.273658 0.861674 0.290602 0.694623 0.362989 0.243116 1.696103 0.326714 1.481176 0.105867 1.763155 0.389638 1.096089 1.860461 0.384795 1.595111 0.327309 0.224303 1.457357 0.863276 1.221159 0.474861 0.148710 1.484645 1.778010 1.802629 1.714822 1.122256 0.709074 0.540633 -0.317254 0.997156 1.115917 0.123376 1.869025 1.339712 0.876345 1.682733 0.893530 0.998209 1.642978 1.224902 0.836368 1.948885 0.464451 1.058190 1.080864 1.538683 1.521142 0.009248 0.654339 -0.126350 0.282369 0.636445 1.771914 0.323435 1.302976 0.483884 1.466774 1.898584 0.571020 1.479654 0.824385 0.735539 0.638514 1.340179 1.302713 1.869702 1.497079)
+ 11.517897 #r(0.000000 1.259153 0.753054 1.764686 1.049517 1.125067 1.190973 0.991011 1.742456 0.708907 0.178161 0.559310 1.128716 0.240782 0.729992 0.303371 0.569838 1.273658 0.861674 0.290602 0.694623 0.362989 0.243116 1.696103 0.326714 1.481176 0.105867 1.763155 0.389638 1.096089 1.860461 0.384795 1.595111 0.327309 0.224303 1.457357 0.863276 1.221159 0.474861 0.148710 1.484645 1.778010 1.802629 1.714822 1.122256 0.709074 0.540633 -0.317254 0.997156 1.115917 0.123376 1.869025 1.339712 0.876345 1.682733 0.893530 0.998209 1.642978 1.224902 0.836368 1.948885 0.464451 1.058190 1.080864 1.538683 1.521142 0.009248 0.654339 -0.126350 0.282369 0.636445 1.771914 0.323435 1.302976 0.483884 1.466774 1.898584 0.571020 1.479654 0.824385 0.735539 0.638514 1.340179 1.302713 1.869702 1.497079)
)
;;; 87 prime --------------------------------------------------------------------------------
-(vector 87 13.98394199918 #(0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0 0 1 1 1 0 1 0 1 1 1 1 1 1 1 1 0 0 0 0)
+(vector 87 13.98394199918 #r(0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0 0 1 1 1 0 1 0 1 1 1 1 1 1 1 1 0 0 0 0)
- 11.888688 #(0.000000 0.482398 1.227138 1.272721 0.078687 1.831113 1.162310 1.536977 1.689231 0.888900 -0.147273 1.167875 0.136674 0.075484 0.629027 1.034119 0.307327 0.024754 1.634526 1.779718 -0.119653 0.312698 0.930420 1.385321 1.107173 1.761414 0.822994 0.223996 0.948219 0.050573 1.181566 -0.076310 1.414999 0.950580 1.442020 0.563152 0.962072 1.833788 0.503591 1.266688 1.037104 0.455604 0.146748 1.270845 0.375842 1.270415 0.973599 0.773789 1.316233 0.694384 1.909797 0.637408 1.683609 1.640242 0.084358 0.069276 0.823261 1.794579 0.489470 1.507812 0.467715 1.270885 1.378929 1.892053 0.446100 1.349825 1.591977 0.875580 1.281794 0.089884 0.566164 1.762552 1.251149 0.938610 1.580460 1.542270 0.684665 0.182715 1.926062 0.347598 0.716836 1.752700 1.597850 1.520331 1.622999 0.031320 1.757914)
+ 11.888688 #r(0.000000 0.482398 1.227138 1.272721 0.078687 1.831113 1.162310 1.536977 1.689231 0.888900 -0.147273 1.167875 0.136674 0.075484 0.629027 1.034119 0.307327 0.024754 1.634526 1.779718 -0.119653 0.312698 0.930420 1.385321 1.107173 1.761414 0.822994 0.223996 0.948219 0.050573 1.181566 -0.076310 1.414999 0.950580 1.442020 0.563152 0.962072 1.833788 0.503591 1.266688 1.037104 0.455604 0.146748 1.270845 0.375842 1.270415 0.973599 0.773789 1.316233 0.694384 1.909797 0.637408 1.683609 1.640242 0.084358 0.069276 0.823261 1.794579 0.489470 1.507812 0.467715 1.270885 1.378929 1.892053 0.446100 1.349825 1.591977 0.875580 1.281794 0.089884 0.566164 1.762552 1.251149 0.938610 1.580460 1.542270 0.684665 0.182715 1.926062 0.347598 0.716836 1.752700 1.597850 1.520331 1.622999 0.031320 1.757914)
;; 86 + 1
- 11.612976 #(0.000000 1.296504 0.726706 1.718822 1.046681 1.126904 1.153426 0.940241 1.708793 0.818644 0.107576 0.530980 1.122499 0.334577 0.735679 0.325192 0.616360 1.132997 0.845995 0.287311 0.640223 0.397260 0.270000 1.691583 0.368381 1.503691 0.176791 1.719860 0.415279 1.070108 1.956631 0.329587 1.654694 0.271910 0.194847 1.468802 0.897532 1.267673 0.483007 0.130123 1.446495 1.802533 1.802082 1.708319 1.123221 0.822012 0.552025 -0.324423 0.903301 1.074684 0.198879 1.961955 1.280447 0.787297 1.695626 0.996555 1.020892 1.595011 1.302967 0.813723 1.889725 0.419999 1.093466 1.051442 1.549928 1.587010 -0.012516 0.597662 -0.094834 0.261495 0.632231 1.919100 0.281141 1.272306 0.493568 1.244869 1.877721 0.661378 1.459138 0.814695 0.650143 0.614249 1.318253 1.365141 1.852338 1.532615 -0.014292)
+ 11.612976 #r(0.000000 1.296504 0.726706 1.718822 1.046681 1.126904 1.153426 0.940241 1.708793 0.818644 0.107576 0.530980 1.122499 0.334577 0.735679 0.325192 0.616360 1.132997 0.845995 0.287311 0.640223 0.397260 0.270000 1.691583 0.368381 1.503691 0.176791 1.719860 0.415279 1.070108 1.956631 0.329587 1.654694 0.271910 0.194847 1.468802 0.897532 1.267673 0.483007 0.130123 1.446495 1.802533 1.802082 1.708319 1.123221 0.822012 0.552025 -0.324423 0.903301 1.074684 0.198879 1.961955 1.280447 0.787297 1.695626 0.996555 1.020892 1.595011 1.302967 0.813723 1.889725 0.419999 1.093466 1.051442 1.549928 1.587010 -0.012516 0.597662 -0.094834 0.261495 0.632231 1.919100 0.281141 1.272306 0.493568 1.244869 1.877721 0.661378 1.459138 0.814695 0.650143 0.614249 1.318253 1.365141 1.852338 1.532615 -0.014292)
)
;;; 88 prime --------------------------------------------------------------------------------
-(vector 88 14.825139803345 #(0 0 0 0 1 0 1 1 0 1 1 0 0 1 0 0 0 0 0 0 1 0 1 0 1 1 1 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 0 1 1 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 0)
+(vector 88 14.825139803345 #r(0 0 0 0 1 0 1 1 0 1 1 0 0 1 0 0 0 0 0 0 1 0 1 0 1 1 1 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 0 1 1 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 0)
- 11.988941 #(0.000000 0.784577 0.582655 -0.034103 0.163974 0.329543 0.693568 0.791635 0.508446 0.396915 1.248395 0.826252 1.437835 1.346260 1.098554 0.836111 0.285181 0.833650 0.396981 0.462954 0.362450 1.183096 1.004262 0.908804 0.301743 1.532670 0.011752 -0.072123 0.996811 1.778401 0.688894 0.044599 0.465473 0.579840 0.996613 0.177680 1.437542 0.677747 1.616279 0.045690 0.566144 1.136899 0.636783 0.355278 1.821475 1.658271 1.588631 1.539506 1.624123 1.239000 1.605890 0.921379 1.791768 0.223451 1.057625 1.753981 0.669208 1.245749 0.682902 0.319986 0.831757 1.041603 0.551747 0.279645 1.731984 0.406762 1.759751 -0.021178 1.248606 0.309853 0.756421 0.658187 1.127576 -0.365423 1.909061 0.823437 1.017441 0.941761 1.686220 0.570407 1.741961 1.705746 1.303576 0.477079 0.894393 0.214957 1.446786 0.714971)
+ 11.988941 #r(0.000000 0.784577 0.582655 -0.034103 0.163974 0.329543 0.693568 0.791635 0.508446 0.396915 1.248395 0.826252 1.437835 1.346260 1.098554 0.836111 0.285181 0.833650 0.396981 0.462954 0.362450 1.183096 1.004262 0.908804 0.301743 1.532670 0.011752 -0.072123 0.996811 1.778401 0.688894 0.044599 0.465473 0.579840 0.996613 0.177680 1.437542 0.677747 1.616279 0.045690 0.566144 1.136899 0.636783 0.355278 1.821475 1.658271 1.588631 1.539506 1.624123 1.239000 1.605890 0.921379 1.791768 0.223451 1.057625 1.753981 0.669208 1.245749 0.682902 0.319986 0.831757 1.041603 0.551747 0.279645 1.731984 0.406762 1.759751 -0.021178 1.248606 0.309853 0.756421 0.658187 1.127576 -0.365423 1.909061 0.823437 1.017441 0.941761 1.686220 0.570407 1.741961 1.705746 1.303576 0.477079 0.894393 0.214957 1.446786 0.714971)
;; 87+1
- 11.814735 #(0.000000 1.368148 0.691154 1.687498 1.039684 1.203556 1.189736 1.006697 1.714307 0.763256 0.064985 0.571039 1.207048 0.283865 0.790295 0.371929 0.626841 1.136922 0.897180 0.250579 0.703180 0.367153 0.285039 1.638464 0.403793 1.574680 0.178418 1.768394 0.361495 1.131365 1.971622 0.329290 1.677397 0.231014 0.189969 1.483487 0.936641 1.267305 0.514462 0.133317 1.438805 1.804423 1.766680 1.772823 1.080035 0.819063 0.520465 -0.385910 0.897901 1.088041 0.197160 0.026953 1.297496 0.779688 1.684839 1.075719 1.000862 1.653028 1.332924 0.886650 1.939949 0.418280 1.124021 1.085155 1.563576 1.537898 -0.095926 0.685710 -0.089908 0.297752 0.611005 1.863915 0.336806 1.344864 0.522590 1.267887 1.872098 0.632836 1.388439 0.783559 0.644197 0.609366 1.338438 1.322505 1.876261 1.537568 -0.063978 -0.021791)
+ 11.814735 #r(0.000000 1.368148 0.691154 1.687498 1.039684 1.203556 1.189736 1.006697 1.714307 0.763256 0.064985 0.571039 1.207048 0.283865 0.790295 0.371929 0.626841 1.136922 0.897180 0.250579 0.703180 0.367153 0.285039 1.638464 0.403793 1.574680 0.178418 1.768394 0.361495 1.131365 1.971622 0.329290 1.677397 0.231014 0.189969 1.483487 0.936641 1.267305 0.514462 0.133317 1.438805 1.804423 1.766680 1.772823 1.080035 0.819063 0.520465 -0.385910 0.897901 1.088041 0.197160 0.026953 1.297496 0.779688 1.684839 1.075719 1.000862 1.653028 1.332924 0.886650 1.939949 0.418280 1.124021 1.085155 1.563576 1.537898 -0.095926 0.685710 -0.089908 0.297752 0.611005 1.863915 0.336806 1.344864 0.522590 1.267887 1.872098 0.632836 1.388439 0.783559 0.644197 0.609366 1.338438 1.322505 1.876261 1.537568 -0.063978 -0.021791)
)
;;; 89 prime --------------------------------------------------------------------------------
-(vector 89 14.69031483888 #(0 1 0 1 1 0 0 1 1 0 1 1 0 0 1 0 0 1 1 0 1 1 1 0 1 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 0 1 1 1 0 1 1 1 1 1 1 1 1 0 0 0 0 1 0 1 1 0 0 1 0 1 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1 1 1 0 1 0 1 1 1)
+(vector 89 14.69031483888 #r(0 1 0 1 1 0 0 1 1 0 1 1 0 0 1 0 0 1 1 0 1 1 1 0 1 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 0 1 1 1 0 1 1 1 1 1 1 1 1 0 0 0 0 1 0 1 1 0 0 1 0 1 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1 1 1 0 1 0 1 1 1)
- 12.145572 #(0.000000 0.358269 1.288170 -0.001864 0.867779 1.364244 1.109375 1.164634 -0.016236 -0.166115 0.449176 1.706240 1.833933 -0.037127 1.772608 0.464339 0.514549 -0.440413 0.091904 1.161505 1.250171 0.825773 0.104691 1.330145 0.165858 0.782047 0.989298 1.471958 -1.844798 0.511831 1.629263 1.091421 0.075823 0.883705 0.737372 1.834115 1.253424 0.188184 -0.236434 0.698883 0.462924 1.137084 1.094253 1.071593 1.735305 1.138289 1.560372 0.992360 1.412813 1.873908 0.448635 -0.005058 0.329007 1.672360 0.604898 1.727995 0.648160 0.750281 0.125793 1.632855 1.581670 1.571564 1.278678 0.191912 0.145586 1.306040 0.445369 -0.231408 -0.001410 1.354497 1.551515 1.659096 -0.403896 0.821589 1.439452 1.005908 1.563170 1.260522 0.450255 1.234179 0.926658 0.279960 0.002426 1.200149 1.285451 0.986678 0.303114 1.568249 0.304851)
+ 12.145572 #r(0.000000 0.358269 1.288170 -0.001864 0.867779 1.364244 1.109375 1.164634 -0.016236 -0.166115 0.449176 1.706240 1.833933 -0.037127 1.772608 0.464339 0.514549 -0.440413 0.091904 1.161505 1.250171 0.825773 0.104691 1.330145 0.165858 0.782047 0.989298 1.471958 -1.844798 0.511831 1.629263 1.091421 0.075823 0.883705 0.737372 1.834115 1.253424 0.188184 -0.236434 0.698883 0.462924 1.137084 1.094253 1.071593 1.735305 1.138289 1.560372 0.992360 1.412813 1.873908 0.448635 -0.005058 0.329007 1.672360 0.604898 1.727995 0.648160 0.750281 0.125793 1.632855 1.581670 1.571564 1.278678 0.191912 0.145586 1.306040 0.445369 -0.231408 -0.001410 1.354497 1.551515 1.659096 -0.403896 0.821589 1.439452 1.005908 1.563170 1.260522 0.450255 1.234179 0.926658 0.279960 0.002426 1.200149 1.285451 0.986678 0.303114 1.568249 0.304851)
;; 88+1
- 11.787567 #(0.000000 1.314164 0.689513 1.628993 1.144940 1.224705 1.150205 1.016059 1.723195 0.713105 0.005841 0.484975 1.239550 0.341275 0.773786 0.398433 0.655094 1.170929 1.038464 0.301899 0.723090 0.410530 0.287119 1.633201 0.260609 1.623354 0.115980 1.879009 0.455545 1.070015 0.017172 0.270422 1.692490 0.233092 0.152980 1.556192 0.883089 1.261531 0.502559 0.146173 1.438907 1.785157 1.804773 1.715166 1.064977 0.807912 0.565628 -0.439659 0.842957 1.290534 0.179519 -0.023924 1.443203 0.792272 1.565433 1.032012 0.991867 1.644953 1.337404 0.854036 0.023578 0.413260 1.087165 1.065012 1.583652 1.496116 -0.065654 0.692422 -0.146363 0.297624 0.616209 1.798178 0.385485 1.334745 0.400370 1.168196 1.828136 0.707167 1.548668 0.793572 0.670466 0.690206 1.451727 1.295947 1.819151 1.442501 -0.262177 -0.013858 0.006952)
+ 11.787567 #r(0.000000 1.314164 0.689513 1.628993 1.144940 1.224705 1.150205 1.016059 1.723195 0.713105 0.005841 0.484975 1.239550 0.341275 0.773786 0.398433 0.655094 1.170929 1.038464 0.301899 0.723090 0.410530 0.287119 1.633201 0.260609 1.623354 0.115980 1.879009 0.455545 1.070015 0.017172 0.270422 1.692490 0.233092 0.152980 1.556192 0.883089 1.261531 0.502559 0.146173 1.438907 1.785157 1.804773 1.715166 1.064977 0.807912 0.565628 -0.439659 0.842957 1.290534 0.179519 -0.023924 1.443203 0.792272 1.565433 1.032012 0.991867 1.644953 1.337404 0.854036 0.023578 0.413260 1.087165 1.065012 1.583652 1.496116 -0.065654 0.692422 -0.146363 0.297624 0.616209 1.798178 0.385485 1.334745 0.400370 1.168196 1.828136 0.707167 1.548668 0.793572 0.670466 0.690206 1.451727 1.295947 1.819151 1.442501 -0.262177 -0.013858 0.006952)
)
;;; 90 prime --------------------------------------------------------------------------------
-(vector 90 14.831111851861 #(0 1 1 0 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 0 1 1 1)
+(vector 90 14.831111851861 #r(0 1 1 0 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 0 1 1 1)
- 12.022848 #(0.000000 0.304537 1.829033 1.070382 1.207038 0.596236 0.255424 0.517237 0.518037 0.555724 0.263998 -0.092809 0.086181 1.031798 1.764620 1.155127 1.629595 1.381762 0.374989 1.817825 0.178145 1.717460 -0.421617 0.620765 1.435692 1.136975 0.618586 -0.142602 0.257261 0.632270 1.492625 0.098530 0.089288 1.438957 0.096419 -0.388671 1.239417 1.591519 1.418382 0.224847 0.327382 1.847389 0.645292 1.057386 0.245292 0.974759 0.113802 0.520412 0.536708 1.166960 -0.123664 0.466667 1.597708 0.387840 1.876598 1.035063 1.402503 0.035393 0.945965 1.170137 1.338358 1.449697 1.072439 0.060883 1.296995 1.652836 0.462073 1.502645 1.166005 1.209720 0.739421 0.202107 1.382598 0.210680 0.451167 1.145693 0.222332 1.637533 0.245553 0.987799 0.980876 1.068255 -0.276826 -0.417000 1.573560 0.382232 0.604329 -0.155944 1.170763 0.979682)
+ 12.022848 #r(0.000000 0.304537 1.829033 1.070382 1.207038 0.596236 0.255424 0.517237 0.518037 0.555724 0.263998 -0.092809 0.086181 1.031798 1.764620 1.155127 1.629595 1.381762 0.374989 1.817825 0.178145 1.717460 -0.421617 0.620765 1.435692 1.136975 0.618586 -0.142602 0.257261 0.632270 1.492625 0.098530 0.089288 1.438957 0.096419 -0.388671 1.239417 1.591519 1.418382 0.224847 0.327382 1.847389 0.645292 1.057386 0.245292 0.974759 0.113802 0.520412 0.536708 1.166960 -0.123664 0.466667 1.597708 0.387840 1.876598 1.035063 1.402503 0.035393 0.945965 1.170137 1.338358 1.449697 1.072439 0.060883 1.296995 1.652836 0.462073 1.502645 1.166005 1.209720 0.739421 0.202107 1.382598 0.210680 0.451167 1.145693 0.222332 1.637533 0.245553 0.987799 0.980876 1.068255 -0.276826 -0.417000 1.573560 0.382232 0.604329 -0.155944 1.170763 0.979682)
)
;;; 91 prime --------------------------------------------------------------------------------
-(vector 91 14.702056847646 #(0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 0 1 0 1 1 1 0 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 1 1 0 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0)
+(vector 91 14.702056847646 #r(0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 0 1 0 1 1 1 0 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 1 1 0 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0)
- 12.084424 #(0.000000 1.661963 0.526933 0.737897 1.547408 1.147810 -0.075617 1.067829 0.852458 1.831985 1.111705 1.210703 0.536594 1.562730 1.564495 0.931257 1.183443 1.206159 1.917460 -0.142965 1.673803 1.211553 1.446589 0.613092 0.971147 0.710033 1.752892 1.683084 1.418254 1.337958 1.028503 0.530465 0.358051 0.607198 0.374767 1.422247 1.801820 -0.023693 0.571429 0.547868 -0.171993 -0.069230 0.452658 0.503964 0.822577 0.139237 1.564879 1.109027 0.054201 0.693725 1.047747 0.930670 0.524559 -1.746051 0.764531 1.459015 0.440040 0.505370 1.433135 1.753190 0.597210 0.403986 1.752023 0.224587 -0.006227 1.424459 1.006632 1.837329 0.717913 1.423544 0.374217 1.561701 0.508321 0.662754 0.466739 0.959175 1.632864 0.950048 1.612332 0.591280 -0.303047 1.088472 1.746777 0.350796 0.275475 0.538357 0.642430 0.726819 1.423969 -0.019252 0.614624)
+ 12.084424 #r(0.000000 1.661963 0.526933 0.737897 1.547408 1.147810 -0.075617 1.067829 0.852458 1.831985 1.111705 1.210703 0.536594 1.562730 1.564495 0.931257 1.183443 1.206159 1.917460 -0.142965 1.673803 1.211553 1.446589 0.613092 0.971147 0.710033 1.752892 1.683084 1.418254 1.337958 1.028503 0.530465 0.358051 0.607198 0.374767 1.422247 1.801820 -0.023693 0.571429 0.547868 -0.171993 -0.069230 0.452658 0.503964 0.822577 0.139237 1.564879 1.109027 0.054201 0.693725 1.047747 0.930670 0.524559 -1.746051 0.764531 1.459015 0.440040 0.505370 1.433135 1.753190 0.597210 0.403986 1.752023 0.224587 -0.006227 1.424459 1.006632 1.837329 0.717913 1.423544 0.374217 1.561701 0.508321 0.662754 0.466739 0.959175 1.632864 0.950048 1.612332 0.591280 -0.303047 1.088472 1.746777 0.350796 0.275475 0.538357 0.642430 0.726819 1.423969 -0.019252 0.614624)
)
;;; 92 prime --------------------------------------------------------------------------------
-(vector 92 14.556435035882 #(0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 1 0 1 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 1 0 0 0 1 0 1 0 0 0)
+(vector 92 14.556435035882 #r(0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 1 0 1 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 1 0 0 0 1 0 1 0 0 0)
- 12.111629 #(0.000000 1.123677 1.203180 1.174948 1.560019 1.384341 0.367155 0.099459 1.212291 0.682305 1.716557 0.261123 0.730999 0.903465 1.369526 0.155486 0.590372 -0.569988 0.244209 0.083007 1.764474 0.389454 0.365639 1.245993 1.816418 0.730704 -0.475666 0.929928 1.528963 0.279291 0.611191 0.845099 1.029972 1.753120 1.126371 1.838017 0.163977 1.146545 0.659479 1.341785 0.566953 0.273863 0.527929 0.012905 1.508411 1.113794 0.790470 1.810888 0.619444 1.306005 1.764955 0.757522 1.532832 1.638004 1.292139 -0.220293 1.326791 0.207925 0.021426 0.636407 0.595067 0.920176 1.364542 1.317600 0.792553 1.523336 0.199497 1.310295 1.126679 1.660906 0.580494 1.441629 1.307014 -0.149187 1.422606 1.228427 0.874268 1.519111 1.056591 1.949465 -0.426058 1.208008 1.301151 1.521711 0.452094 0.671757 0.665097 0.498102 0.181724 0.953835 0.725167 1.124133)
+ 12.111629 #r(0.000000 1.123677 1.203180 1.174948 1.560019 1.384341 0.367155 0.099459 1.212291 0.682305 1.716557 0.261123 0.730999 0.903465 1.369526 0.155486 0.590372 -0.569988 0.244209 0.083007 1.764474 0.389454 0.365639 1.245993 1.816418 0.730704 -0.475666 0.929928 1.528963 0.279291 0.611191 0.845099 1.029972 1.753120 1.126371 1.838017 0.163977 1.146545 0.659479 1.341785 0.566953 0.273863 0.527929 0.012905 1.508411 1.113794 0.790470 1.810888 0.619444 1.306005 1.764955 0.757522 1.532832 1.638004 1.292139 -0.220293 1.326791 0.207925 0.021426 0.636407 0.595067 0.920176 1.364542 1.317600 0.792553 1.523336 0.199497 1.310295 1.126679 1.660906 0.580494 1.441629 1.307014 -0.149187 1.422606 1.228427 0.874268 1.519111 1.056591 1.949465 -0.426058 1.208008 1.301151 1.521711 0.452094 0.671757 0.665097 0.498102 0.181724 0.953835 0.725167 1.124133)
)
;;; 93 prime --------------------------------------------------------------------------------
-(vector 93 14.994668960571 #(0 1 0 1 0 0 1 0 1 1 0 1 1 1 0 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 1)
+(vector 93 14.994668960571 #r(0 1 0 1 0 0 1 0 1 1 0 1 1 1 0 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 1)
- 12.323397 #(0.000000 0.199963 1.180724 -0.024343 1.226375 -0.402136 0.168523 1.313836 1.060714 1.370552 -0.471865 0.051393 1.826180 -0.226097 1.794079 0.176177 0.029279 1.765656 -0.022993 0.924413 1.319281 1.348871 0.657083 1.021102 0.556079 1.679658 0.119278 0.154784 0.786857 0.314106 1.909349 1.379970 0.486239 0.159940 1.547391 1.177792 0.671257 -0.176460 1.805002 1.892101 1.067471 1.153719 0.249337 0.426943 1.568658 0.284044 0.861446 -0.338286 0.531428 1.450755 0.605670 0.121121 1.131478 1.187561 1.041801 1.153378 1.486202 0.325760 0.201023 0.376157 0.907130 0.389618 0.779509 0.246617 0.355275 0.698575 1.371835 1.170196 1.188933 0.531048 0.008203 1.693556 0.426031 -0.330917 0.226068 0.478929 -0.022448 0.820583 0.181321 1.394112 0.214726 0.952096 1.780527 0.477402 0.370644 0.018381 1.506735 0.676340 -0.005190 1.098917 1.472044 0.136836 1.154585)
+ 12.323397 #r(0.000000 0.199963 1.180724 -0.024343 1.226375 -0.402136 0.168523 1.313836 1.060714 1.370552 -0.471865 0.051393 1.826180 -0.226097 1.794079 0.176177 0.029279 1.765656 -0.022993 0.924413 1.319281 1.348871 0.657083 1.021102 0.556079 1.679658 0.119278 0.154784 0.786857 0.314106 1.909349 1.379970 0.486239 0.159940 1.547391 1.177792 0.671257 -0.176460 1.805002 1.892101 1.067471 1.153719 0.249337 0.426943 1.568658 0.284044 0.861446 -0.338286 0.531428 1.450755 0.605670 0.121121 1.131478 1.187561 1.041801 1.153378 1.486202 0.325760 0.201023 0.376157 0.907130 0.389618 0.779509 0.246617 0.355275 0.698575 1.371835 1.170196 1.188933 0.531048 0.008203 1.693556 0.426031 -0.330917 0.226068 0.478929 -0.022448 0.820583 0.181321 1.394112 0.214726 0.952096 1.780527 0.477402 0.370644 0.018381 1.506735 0.676340 -0.005190 1.098917 1.472044 0.136836 1.154585)
;; 92+1
- 11.941773 #(0.000000 1.137688 1.089778 1.068356 1.532544 1.432457 0.360804 -0.026160 1.251592 0.723161 1.753475 0.321792 0.652597 0.831785 1.248203 0.098788 0.605754 -0.620144 0.303325 -0.047105 1.719165 0.369582 0.426774 1.169373 1.859324 0.741230 -0.571365 0.881904 1.545056 0.328084 0.606744 0.850606 0.996606 1.766597 1.046556 1.767688 0.237622 1.228793 0.632423 1.337245 0.542894 0.162245 0.534219 0.069759 1.516061 1.102446 0.948393 1.619738 0.549855 1.379503 1.785272 0.859611 1.503940 1.656139 1.246212 -0.223489 1.412206 0.325338 0.101699 0.705391 0.747074 0.979316 1.385520 1.241306 0.625921 1.535144 0.140376 1.223617 1.154594 1.635856 0.580110 1.431599 1.354268 -0.085341 1.513604 1.083083 0.960280 1.481804 1.049034 1.936911 -0.305123 1.144650 1.328494 1.401780 0.463677 0.612788 0.648525 0.589928 0.274669 0.913704 0.769534 1.048236 -0.031107)
+ 11.941773 #r(0.000000 1.137688 1.089778 1.068356 1.532544 1.432457 0.360804 -0.026160 1.251592 0.723161 1.753475 0.321792 0.652597 0.831785 1.248203 0.098788 0.605754 -0.620144 0.303325 -0.047105 1.719165 0.369582 0.426774 1.169373 1.859324 0.741230 -0.571365 0.881904 1.545056 0.328084 0.606744 0.850606 0.996606 1.766597 1.046556 1.767688 0.237622 1.228793 0.632423 1.337245 0.542894 0.162245 0.534219 0.069759 1.516061 1.102446 0.948393 1.619738 0.549855 1.379503 1.785272 0.859611 1.503940 1.656139 1.246212 -0.223489 1.412206 0.325338 0.101699 0.705391 0.747074 0.979316 1.385520 1.241306 0.625921 1.535144 0.140376 1.223617 1.154594 1.635856 0.580110 1.431599 1.354268 -0.085341 1.513604 1.083083 0.960280 1.481804 1.049034 1.936911 -0.305123 1.144650 1.328494 1.401780 0.463677 0.612788 0.648525 0.589928 0.274669 0.913704 0.769534 1.048236 -0.031107)
)
;;; 94 prime --------------------------------------------------------------------------------
-(vector 94 14.811392756555 #(0 0 0 1 0 0 1 0 0 0 1 1 0 0 1 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 0 1 0 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0)
+(vector 94 14.811392756555 #r(0 0 0 1 0 0 1 0 0 0 1 1 0 0 1 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 0 1 0 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0)
- 12.372284 #(0.000000 0.443961 0.975468 0.665627 0.603420 0.053131 0.306985 1.398862 1.315822 1.027281 0.141353 0.068859 0.515109 1.551710 0.559483 1.154898 1.062171 1.088212 0.844250 0.492324 -0.085203 0.372997 1.377703 1.412362 1.590941 0.015253 -0.053671 1.084827 1.672259 1.823973 0.424632 1.792989 0.693404 1.273404 0.373397 1.282394 -0.222604 0.823730 1.821435 0.830056 0.905326 1.119027 0.338679 0.323132 1.572257 1.693368 1.617589 1.262068 1.377617 -0.071238 1.120960 0.924011 0.108375 0.409469 0.705856 1.358638 1.649735 1.159074 1.592832 0.679108 1.663652 1.223795 0.200633 -0.160917 1.201748 0.776569 0.821633 0.259058 0.902729 0.178012 1.711364 0.349704 0.758303 0.750335 0.936872 0.168192 0.485748 0.828259 1.367780 0.601135 0.970970 1.052074 1.846930 -0.031412 0.332694 1.027172 1.579686 0.520946 0.479472 0.979137 -0.124751 1.022187 0.809346 1.384445)
+ 12.372284 #r(0.000000 0.443961 0.975468 0.665627 0.603420 0.053131 0.306985 1.398862 1.315822 1.027281 0.141353 0.068859 0.515109 1.551710 0.559483 1.154898 1.062171 1.088212 0.844250 0.492324 -0.085203 0.372997 1.377703 1.412362 1.590941 0.015253 -0.053671 1.084827 1.672259 1.823973 0.424632 1.792989 0.693404 1.273404 0.373397 1.282394 -0.222604 0.823730 1.821435 0.830056 0.905326 1.119027 0.338679 0.323132 1.572257 1.693368 1.617589 1.262068 1.377617 -0.071238 1.120960 0.924011 0.108375 0.409469 0.705856 1.358638 1.649735 1.159074 1.592832 0.679108 1.663652 1.223795 0.200633 -0.160917 1.201748 0.776569 0.821633 0.259058 0.902729 0.178012 1.711364 0.349704 0.758303 0.750335 0.936872 0.168192 0.485748 0.828259 1.367780 0.601135 0.970970 1.052074 1.846930 -0.031412 0.332694 1.027172 1.579686 0.520946 0.479472 0.979137 -0.124751 1.022187 0.809346 1.384445)
;; 93+1
- 12.114932 #(0.000000 1.123175 1.150884 1.058343 1.465121 1.413282 0.350764 0.114071 1.226428 0.791079 1.790932 0.440109 0.565381 0.734544 1.327723 -0.001005 0.566798 -0.729477 0.316829 -0.017120 1.801895 0.389351 0.381914 1.198959 1.820572 0.721571 -0.570163 0.955754 1.536499 0.370558 0.593528 0.885066 1.037479 1.768525 1.105455 1.756351 0.226836 1.186245 0.651550 1.384674 0.494435 0.218370 0.473389 0.034709 1.487137 1.083964 0.911945 1.641974 0.559886 1.326260 1.842092 0.870886 1.399307 1.629693 1.284916 -0.226560 1.347506 0.289919 0.059989 0.740638 0.739763 0.950849 1.395859 1.190558 0.656884 1.519451 0.124394 1.191107 1.225318 1.686413 0.517977 1.395642 1.256343 -0.098747 1.532037 1.044403 0.978522 1.573287 0.994934 1.946711 -0.367453 1.259056 1.292220 1.531327 0.451283 0.592779 0.641359 0.711046 0.198007 0.990565 0.746192 1.039960 -0.062670 0.073205)
+ 12.114932 #r(0.000000 1.123175 1.150884 1.058343 1.465121 1.413282 0.350764 0.114071 1.226428 0.791079 1.790932 0.440109 0.565381 0.734544 1.327723 -0.001005 0.566798 -0.729477 0.316829 -0.017120 1.801895 0.389351 0.381914 1.198959 1.820572 0.721571 -0.570163 0.955754 1.536499 0.370558 0.593528 0.885066 1.037479 1.768525 1.105455 1.756351 0.226836 1.186245 0.651550 1.384674 0.494435 0.218370 0.473389 0.034709 1.487137 1.083964 0.911945 1.641974 0.559886 1.326260 1.842092 0.870886 1.399307 1.629693 1.284916 -0.226560 1.347506 0.289919 0.059989 0.740638 0.739763 0.950849 1.395859 1.190558 0.656884 1.519451 0.124394 1.191107 1.225318 1.686413 0.517977 1.395642 1.256343 -0.098747 1.532037 1.044403 0.978522 1.573287 0.994934 1.946711 -0.367453 1.259056 1.292220 1.531327 0.451283 0.592779 0.641359 0.711046 0.198007 0.990565 0.746192 1.039960 -0.062670 0.073205)
)
;;; 95 prime --------------------------------------------------------------------------------
-(vector 95 15.240 #(0 0 0 1 1 1 1 1 0 0 1 1 1 1 0 0 1 1 0 1 1 1 1 1 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 1 0 1 1 0 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 0 0 0 1)
+(vector 95 15.240 #r(0 0 0 1 1 1 1 1 0 0 1 1 1 1 0 0 1 1 0 1 1 1 1 1 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 1 0 1 1 0 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 0 0 0 1)
- 12.459772 #(0.000000 0.308397 0.934622 0.587781 1.397996 1.615701 1.668964 1.492915 1.308563 0.159020 1.213403 -0.279408 1.096006 1.085558 0.623876 0.907176 0.667480 1.557434 1.743106 1.498468 1.233171 0.109361 0.947947 -0.262447 0.459131 0.819588 -0.021230 0.492364 0.906782 0.461816 0.056526 0.050587 0.383393 0.910532 0.762726 0.098762 0.955132 1.150421 0.604248 0.259751 1.309549 1.704622 1.855016 0.399458 0.217387 0.513436 1.433314 0.218651 0.133592 1.857292 0.423016 0.136928 0.083580 1.034506 1.391713 0.293770 0.897050 0.785540 0.765384 1.736279 0.958030 0.524446 0.709466 0.374572 1.361583 0.387916 0.039566 1.900932 -0.119192 0.460590 -0.150181 0.605728 1.448737 1.077599 1.714282 1.351134 0.667262 0.278426 0.183437 0.118876 0.258415 0.843668 0.748044 1.868376 0.252888 1.363041 0.638212 1.171836 0.388947 0.935784 0.020120 0.828215 -0.177354 1.862097 0.788220)
+ 12.459772 #r(0.000000 0.308397 0.934622 0.587781 1.397996 1.615701 1.668964 1.492915 1.308563 0.159020 1.213403 -0.279408 1.096006 1.085558 0.623876 0.907176 0.667480 1.557434 1.743106 1.498468 1.233171 0.109361 0.947947 -0.262447 0.459131 0.819588 -0.021230 0.492364 0.906782 0.461816 0.056526 0.050587 0.383393 0.910532 0.762726 0.098762 0.955132 1.150421 0.604248 0.259751 1.309549 1.704622 1.855016 0.399458 0.217387 0.513436 1.433314 0.218651 0.133592 1.857292 0.423016 0.136928 0.083580 1.034506 1.391713 0.293770 0.897050 0.785540 0.765384 1.736279 0.958030 0.524446 0.709466 0.374572 1.361583 0.387916 0.039566 1.900932 -0.119192 0.460590 -0.150181 0.605728 1.448737 1.077599 1.714282 1.351134 0.667262 0.278426 0.183437 0.118876 0.258415 0.843668 0.748044 1.868376 0.252888 1.363041 0.638212 1.171836 0.388947 0.935784 0.020120 0.828215 -0.177354 1.862097 0.788220)
;; 94+1
- 12.114676 #(0.000000 1.049345 1.220803 1.147373 1.381621 1.355515 0.454825 -0.009436 1.057569 0.663900 1.874811 0.433507 0.556807 0.623352 1.242792 0.067786 0.465225 -0.661340 0.331985 0.032227 1.933091 0.432343 0.547379 1.107124 1.846431 0.517946 -0.547570 0.897607 1.611921 0.403112 0.647511 0.899598 0.890804 1.716130 0.996200 1.713540 0.243854 1.180551 0.688999 1.559934 0.583466 0.197293 0.600073 0.000101 1.458490 0.994760 0.956495 1.648139 0.660393 1.228976 1.774516 0.893844 1.390831 1.720570 1.135089 -0.091470 1.277862 0.255881 0.036343 0.799886 0.761090 0.891306 1.295964 1.096543 0.475861 1.537136 0.091181 1.218377 1.140426 1.690539 0.527790 1.400945 1.266740 -0.072678 1.541904 1.035302 1.038433 1.493972 1.075712 0.036991 -0.268077 1.190854 1.324282 1.468048 0.376266 0.545926 0.611626 0.692246 0.190910 0.902204 0.677044 1.063647 0.021187 0.238133 0.189775)
+ 12.114676 #r(0.000000 1.049345 1.220803 1.147373 1.381621 1.355515 0.454825 -0.009436 1.057569 0.663900 1.874811 0.433507 0.556807 0.623352 1.242792 0.067786 0.465225 -0.661340 0.331985 0.032227 1.933091 0.432343 0.547379 1.107124 1.846431 0.517946 -0.547570 0.897607 1.611921 0.403112 0.647511 0.899598 0.890804 1.716130 0.996200 1.713540 0.243854 1.180551 0.688999 1.559934 0.583466 0.197293 0.600073 0.000101 1.458490 0.994760 0.956495 1.648139 0.660393 1.228976 1.774516 0.893844 1.390831 1.720570 1.135089 -0.091470 1.277862 0.255881 0.036343 0.799886 0.761090 0.891306 1.295964 1.096543 0.475861 1.537136 0.091181 1.218377 1.140426 1.690539 0.527790 1.400945 1.266740 -0.072678 1.541904 1.035302 1.038433 1.493972 1.075712 0.036991 -0.268077 1.190854 1.324282 1.468048 0.376266 0.545926 0.611626 0.692246 0.190910 0.902204 0.677044 1.063647 0.021187 0.238133 0.189775)
)
;;; 96 prime --------------------------------------------------------------------------------
-(vector 96 15.135 #(0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 0 0 1 1 0 1 1 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 1 0 0 1 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 1 0 0 1 0)
+(vector 96 15.135 #r(0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 0 0 1 1 0 1 1 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 1 0 0 1 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 1 0 0 1 0)
- 12.492843 #(0.000000 0.873070 1.523025 1.689063 1.621286 0.209607 1.316613 0.108148 0.756280 0.640008 0.419483 0.710721 0.117557 0.928853 0.153806 1.300975 1.239985 1.289571 0.156284 0.662086 0.349173 1.208328 1.779199 0.633972 1.299682 1.009543 0.022986 0.835814 1.094725 0.331638 0.023179 0.982537 0.733828 1.430422 0.013874 0.572853 1.429326 1.360223 0.715744 1.266448 0.151948 -0.250137 0.209445 1.031335 1.611402 0.877878 0.362241 0.304460 0.144893 0.651630 1.742329 -0.323477 0.366805 -0.060410 1.858308 0.038329 0.825659 1.544770 1.420995 1.255395 1.068254 0.786905 1.057541 1.015027 0.909813 1.295370 1.205379 0.957770 1.601794 1.221780 -0.114116 0.749254 1.369402 1.509613 0.642078 1.929687 1.163562 0.908511 0.510199 1.519292 0.122002 1.225494 0.717297 1.501496 1.345341 1.759811 1.056238 0.842883 0.086174 -0.090366 1.445692 1.226504 0.003120 1.148302 0.440021 0.622101)
+ 12.492843 #r(0.000000 0.873070 1.523025 1.689063 1.621286 0.209607 1.316613 0.108148 0.756280 0.640008 0.419483 0.710721 0.117557 0.928853 0.153806 1.300975 1.239985 1.289571 0.156284 0.662086 0.349173 1.208328 1.779199 0.633972 1.299682 1.009543 0.022986 0.835814 1.094725 0.331638 0.023179 0.982537 0.733828 1.430422 0.013874 0.572853 1.429326 1.360223 0.715744 1.266448 0.151948 -0.250137 0.209445 1.031335 1.611402 0.877878 0.362241 0.304460 0.144893 0.651630 1.742329 -0.323477 0.366805 -0.060410 1.858308 0.038329 0.825659 1.544770 1.420995 1.255395 1.068254 0.786905 1.057541 1.015027 0.909813 1.295370 1.205379 0.957770 1.601794 1.221780 -0.114116 0.749254 1.369402 1.509613 0.642078 1.929687 1.163562 0.908511 0.510199 1.519292 0.122002 1.225494 0.717297 1.501496 1.345341 1.759811 1.056238 0.842883 0.086174 -0.090366 1.445692 1.226504 0.003120 1.148302 0.440021 0.622101)
;; 95+1:
- 12.292710 #(0.000000 0.988646 1.162429 1.171314 1.353255 1.405759 0.327802 0.036207 1.152154 0.760541 1.790856 0.433527 0.499858 0.656756 1.296573 0.100791 0.476489 -0.653216 0.158372 -0.037710 1.892726 0.409386 0.436140 1.049351 1.766476 0.708019 -0.505881 0.843836 1.661627 0.229932 0.569810 0.855526 0.889991 1.754840 1.079009 1.690629 0.282542 1.176826 0.695771 1.456983 0.462708 0.168189 0.469857 -0.027597 1.521311 1.099282 0.982686 1.576751 0.669770 1.287335 1.818933 0.859497 1.442403 1.798895 1.290873 -0.254434 1.216440 0.266504 0.064071 0.816920 0.860902 0.922870 1.417663 1.159681 0.595958 1.424400 0.223626 1.172296 1.139585 1.606147 0.520047 1.392856 1.257846 -0.113917 1.518583 1.050121 0.979442 1.573289 0.984941 0.063610 -0.290095 1.277068 1.272139 1.596596 0.361931 0.600022 0.601776 0.740696 0.153344 0.997841 0.670149 1.019583 -0.020870 0.222109 0.072606 -0.120463)
+ 12.292710 #r(0.000000 0.988646 1.162429 1.171314 1.353255 1.405759 0.327802 0.036207 1.152154 0.760541 1.790856 0.433527 0.499858 0.656756 1.296573 0.100791 0.476489 -0.653216 0.158372 -0.037710 1.892726 0.409386 0.436140 1.049351 1.766476 0.708019 -0.505881 0.843836 1.661627 0.229932 0.569810 0.855526 0.889991 1.754840 1.079009 1.690629 0.282542 1.176826 0.695771 1.456983 0.462708 0.168189 0.469857 -0.027597 1.521311 1.099282 0.982686 1.576751 0.669770 1.287335 1.818933 0.859497 1.442403 1.798895 1.290873 -0.254434 1.216440 0.266504 0.064071 0.816920 0.860902 0.922870 1.417663 1.159681 0.595958 1.424400 0.223626 1.172296 1.139585 1.606147 0.520047 1.392856 1.257846 -0.113917 1.518583 1.050121 0.979442 1.573289 0.984941 0.063610 -0.290095 1.277068 1.272139 1.596596 0.361931 0.600022 0.601776 0.740696 0.153344 0.997841 0.670149 1.019583 -0.020870 0.222109 0.072606 -0.120463)
)
;;; 97 prime --------------------------------------------------------------------------------
-(vector 97 15.404807595571 #(0 0 0 1 0 1 0 1 0 1 1 0 1 1 1 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 0 0 0 1 0 1 1 0 0 0 0 1 0 1 0 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1)
+(vector 97 15.404807595571 #r(0 0 0 1 0 1 0 1 0 1 1 0 1 1 1 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 0 0 0 1 0 1 1 0 0 0 0 1 0 1 0 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1)
- 12.614880 #(0.000000 1.284279 0.149066 0.562607 0.268625 0.641221 0.361525 0.485960 -0.169882 0.664945 1.289316 0.500133 0.276653 0.768466 1.755836 1.046199 1.488691 0.489610 1.701223 1.395902 0.323258 1.026098 0.187307 0.308257 0.739745 0.789576 0.492878 1.589801 0.464866 1.368873 1.280528 0.783754 1.321490 0.013196 1.554947 1.672951 1.438390 1.698792 0.240337 1.015821 1.431743 -0.194791 0.030419 0.391715 0.797023 1.035054 1.666367 1.927621 0.564941 0.590092 0.408995 0.415222 1.147686 0.588418 0.024767 -0.204650 -0.157255 1.351342 1.609704 0.733349 1.898358 0.761937 1.674424 1.298247 0.616295 1.801868 0.366757 0.227606 0.881755 0.435048 0.566914 -0.068726 1.464351 0.867461 0.114711 1.507714 0.831540 0.049432 0.189086 0.282295 1.125245 -0.244779 0.442202 1.591355 -0.090711 1.248227 1.649885 0.616280 1.727109 0.815894 0.698498 -0.049477 0.179382 1.436511 0.773196 0.738555 0.962998)
+ 12.614880 #r(0.000000 1.284279 0.149066 0.562607 0.268625 0.641221 0.361525 0.485960 -0.169882 0.664945 1.289316 0.500133 0.276653 0.768466 1.755836 1.046199 1.488691 0.489610 1.701223 1.395902 0.323258 1.026098 0.187307 0.308257 0.739745 0.789576 0.492878 1.589801 0.464866 1.368873 1.280528 0.783754 1.321490 0.013196 1.554947 1.672951 1.438390 1.698792 0.240337 1.015821 1.431743 -0.194791 0.030419 0.391715 0.797023 1.035054 1.666367 1.927621 0.564941 0.590092 0.408995 0.415222 1.147686 0.588418 0.024767 -0.204650 -0.157255 1.351342 1.609704 0.733349 1.898358 0.761937 1.674424 1.298247 0.616295 1.801868 0.366757 0.227606 0.881755 0.435048 0.566914 -0.068726 1.464351 0.867461 0.114711 1.507714 0.831540 0.049432 0.189086 0.282295 1.125245 -0.244779 0.442202 1.591355 -0.090711 1.248227 1.649885 0.616280 1.727109 0.815894 0.698498 -0.049477 0.179382 1.436511 0.773196 0.738555 0.962998)
;; 96+1
- 12.398175 #(0.000000 0.974270 1.133417 1.101751 1.279979 1.359434 0.467927 0.007144 1.127487 0.748820 1.781756 0.396487 0.493733 0.688975 1.203401 0.019970 0.359263 -0.697201 0.166440 -0.073865 1.841340 0.479438 0.471569 1.120468 1.818011 0.722611 -0.578854 0.797365 1.619794 0.192675 0.470320 0.880530 0.894647 1.773867 1.129911 1.684306 0.298114 1.192448 0.753562 1.463120 0.415850 0.230519 0.523840 -0.047429 1.497367 1.045637 0.968082 1.645436 0.623475 1.314407 1.792633 0.841218 1.383624 1.923347 1.362714 -0.210443 1.197651 0.311815 0.117464 0.802332 0.840490 0.962756 1.351153 1.154240 0.658169 1.483444 0.257624 1.139948 1.196778 1.594898 0.489729 1.391360 1.298495 -0.114146 1.474319 1.038981 0.962592 1.548377 0.947581 0.030073 -0.290725 1.335845 1.310097 1.567936 0.325931 0.520450 0.493969 0.704044 0.140441 0.974535 0.754580 0.981153 0.043144 0.213245 0.187923 -0.104791 0.154449)
+ 12.398175 #r(0.000000 0.974270 1.133417 1.101751 1.279979 1.359434 0.467927 0.007144 1.127487 0.748820 1.781756 0.396487 0.493733 0.688975 1.203401 0.019970 0.359263 -0.697201 0.166440 -0.073865 1.841340 0.479438 0.471569 1.120468 1.818011 0.722611 -0.578854 0.797365 1.619794 0.192675 0.470320 0.880530 0.894647 1.773867 1.129911 1.684306 0.298114 1.192448 0.753562 1.463120 0.415850 0.230519 0.523840 -0.047429 1.497367 1.045637 0.968082 1.645436 0.623475 1.314407 1.792633 0.841218 1.383624 1.923347 1.362714 -0.210443 1.197651 0.311815 0.117464 0.802332 0.840490 0.962756 1.351153 1.154240 0.658169 1.483444 0.257624 1.139948 1.196778 1.594898 0.489729 1.391360 1.298495 -0.114146 1.474319 1.038981 0.962592 1.548377 0.947581 0.030073 -0.290725 1.335845 1.310097 1.567936 0.325931 0.520450 0.493969 0.704044 0.140441 0.974535 0.754580 0.981153 0.043144 0.213245 0.187923 -0.104791 0.154449)
)
;;; 98 prime --------------------------------------------------------------------------------
-(vector 98 15.435913738557 #(0 0 0 0 1 1 1 0 1 1 1 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 1 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 0 0 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 0)
+(vector 98 15.435913738557 #r(0 0 0 0 1 1 1 0 1 1 1 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 1 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 0 0 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 0)
- 12.753270 #(0.000000 0.786132 0.095307 1.867898 0.883791 1.021595 1.308123 1.131908 0.540702 0.504302 1.434468 1.493630 0.417411 0.284692 1.504062 1.429716 1.676581 -0.039254 0.683934 0.973509 0.648393 1.434613 -0.061544 1.814076 0.647769 0.683085 1.793781 0.237679 0.776690 1.663998 0.170625 1.433546 1.041819 1.122171 1.897558 1.320541 0.723949 1.237497 0.689348 1.846291 1.246028 1.446201 0.606616 1.671663 1.464134 0.585342 0.644021 0.435796 0.213425 1.357738 1.586232 1.545703 0.819890 1.367545 0.012567 0.450279 0.655234 0.788890 0.591992 0.545966 1.254900 0.392933 1.583204 0.076358 1.856160 0.823271 1.021281 1.623051 1.585893 1.245898 0.683755 0.476818 1.035792 1.047834 -0.069790 -0.004312 -0.361114 1.398618 1.383822 0.421997 1.705664 0.029556 -0.066198 0.051203 1.722364 1.322079 1.292928 1.662147 -0.016256 1.310728 1.707597 1.375469 1.546348 1.943030 -0.036451 0.558144 -0.266574 0.833410)
+ 12.753270 #r(0.000000 0.786132 0.095307 1.867898 0.883791 1.021595 1.308123 1.131908 0.540702 0.504302 1.434468 1.493630 0.417411 0.284692 1.504062 1.429716 1.676581 -0.039254 0.683934 0.973509 0.648393 1.434613 -0.061544 1.814076 0.647769 0.683085 1.793781 0.237679 0.776690 1.663998 0.170625 1.433546 1.041819 1.122171 1.897558 1.320541 0.723949 1.237497 0.689348 1.846291 1.246028 1.446201 0.606616 1.671663 1.464134 0.585342 0.644021 0.435796 0.213425 1.357738 1.586232 1.545703 0.819890 1.367545 0.012567 0.450279 0.655234 0.788890 0.591992 0.545966 1.254900 0.392933 1.583204 0.076358 1.856160 0.823271 1.021281 1.623051 1.585893 1.245898 0.683755 0.476818 1.035792 1.047834 -0.069790 -0.004312 -0.361114 1.398618 1.383822 0.421997 1.705664 0.029556 -0.066198 0.051203 1.722364 1.322079 1.292928 1.662147 -0.016256 1.310728 1.707597 1.375469 1.546348 1.943030 -0.036451 0.558144 -0.266574 0.833410)
;; 99-1
- 12.622612 #(0.000000 1.601197 0.675735 0.824937 1.585712 1.856247 0.097348 -0.128093 1.025651 0.480455 0.954279 0.347491 0.626587 0.694458 0.898162 1.272532 0.684634 1.137767 1.643934 1.521275 1.047103 0.680901 1.232138 0.886175 0.603433 0.065324 -0.003442 1.143022 1.262279 1.001078 1.502240 1.539684 0.387527 -0.240796 0.914257 1.021072 0.830135 0.895349 0.823768 1.454208 -0.127486 1.570891 0.443883 0.892431 1.170381 1.366309 0.941425 0.702939 0.571855 0.280140 1.656638 0.472320 0.260055 1.153301 0.949715 0.148316 1.066487 0.427830 0.818544 -0.167385 0.411934 0.330689 0.887299 0.734213 1.728731 0.063612 0.466751 0.013162 -0.447231 0.444351 1.131814 0.061263 1.074639 0.944421 1.055502 -0.026068 1.648026 1.034453 1.399998 0.887501 0.104617 0.511260 1.435502 0.677269 0.344898 0.942483 -0.009809 0.923335 0.650809 -0.003419 1.067454 1.910756 0.250458 1.576481 0.901923 1.611933 1.145031 0.515175)
+ 12.622612 #r(0.000000 1.601197 0.675735 0.824937 1.585712 1.856247 0.097348 -0.128093 1.025651 0.480455 0.954279 0.347491 0.626587 0.694458 0.898162 1.272532 0.684634 1.137767 1.643934 1.521275 1.047103 0.680901 1.232138 0.886175 0.603433 0.065324 -0.003442 1.143022 1.262279 1.001078 1.502240 1.539684 0.387527 -0.240796 0.914257 1.021072 0.830135 0.895349 0.823768 1.454208 -0.127486 1.570891 0.443883 0.892431 1.170381 1.366309 0.941425 0.702939 0.571855 0.280140 1.656638 0.472320 0.260055 1.153301 0.949715 0.148316 1.066487 0.427830 0.818544 -0.167385 0.411934 0.330689 0.887299 0.734213 1.728731 0.063612 0.466751 0.013162 -0.447231 0.444351 1.131814 0.061263 1.074639 0.944421 1.055502 -0.026068 1.648026 1.034453 1.399998 0.887501 0.104617 0.511260 1.435502 0.677269 0.344898 0.942483 -0.009809 0.923335 0.650809 -0.003419 1.067454 1.910756 0.250458 1.576481 0.901923 1.611933 1.145031 0.515175)
;; 97+1
- 12.554819 #(0.000000 0.994754 1.201978 1.095875 1.228090 1.349063 0.520404 -0.005278 1.113744 0.684830 1.821835 0.418458 0.556811 0.671609 1.340860 -0.027127 0.490888 -0.669559 0.196112 -0.069433 1.791636 0.479800 0.480819 1.161113 1.931188 0.706820 -0.575437 0.825517 1.635684 0.154310 0.437054 0.834616 0.805687 1.760916 1.041481 1.654400 0.268843 1.252679 0.716018 1.507696 0.427453 0.212559 0.610822 -0.045110 1.474585 1.069280 0.938458 1.658424 0.606033 1.274272 1.871557 0.851412 1.378375 1.849718 1.305539 -0.196977 1.250436 0.271972 0.159635 0.861188 0.835566 1.009947 1.382413 1.136755 0.601730 1.508016 0.177040 1.096731 1.112114 1.556213 0.514409 1.424495 1.306796 -0.096547 1.551938 0.983953 0.982538 1.547826 0.947292 0.070780 -0.301979 1.274952 1.268078 1.506608 0.343339 0.539960 0.515360 0.716545 0.138903 1.075775 0.830359 1.045994 0.028008 0.165284 0.183640 -0.064893 0.128193 -0.025514)
+ 12.554819 #r(0.000000 0.994754 1.201978 1.095875 1.228090 1.349063 0.520404 -0.005278 1.113744 0.684830 1.821835 0.418458 0.556811 0.671609 1.340860 -0.027127 0.490888 -0.669559 0.196112 -0.069433 1.791636 0.479800 0.480819 1.161113 1.931188 0.706820 -0.575437 0.825517 1.635684 0.154310 0.437054 0.834616 0.805687 1.760916 1.041481 1.654400 0.268843 1.252679 0.716018 1.507696 0.427453 0.212559 0.610822 -0.045110 1.474585 1.069280 0.938458 1.658424 0.606033 1.274272 1.871557 0.851412 1.378375 1.849718 1.305539 -0.196977 1.250436 0.271972 0.159635 0.861188 0.835566 1.009947 1.382413 1.136755 0.601730 1.508016 0.177040 1.096731 1.112114 1.556213 0.514409 1.424495 1.306796 -0.096547 1.551938 0.983953 0.982538 1.547826 0.947292 0.070780 -0.301979 1.274952 1.268078 1.506608 0.343339 0.539960 0.515360 0.716545 0.138903 1.075775 0.830359 1.045994 0.028008 0.165284 0.183640 -0.064893 0.128193 -0.025514)
)
;;; 99 prime --------------------------------------------------------------------------------
-(vector 99 15.391923904419 #(0 0 1 0 1 0 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 0 0 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 1 0 0 1 1 1 0 0 0 0 0 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 0)
+(vector 99 15.391923904419 #r(0 0 1 0 1 0 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 0 0 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 1 0 0 1 1 1 0 0 0 0 0 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 0)
;; started at 13.08
- 12.671121 #(0.000000 1.578825 0.666211 0.726552 1.538384 1.791570 0.099320 -0.160491 0.989473 0.596822 1.035192 0.247178 0.628445 0.721303 0.845175 1.341449 0.627742 1.157974 1.573300 1.577559 1.146243 0.642518 1.253235 0.873141 0.677674 1.983841 -0.058813 1.145842 1.258749 1.002052 1.540728 1.596826 0.319265 -0.110992 0.873225 1.001714 0.958663 0.883044 0.804615 1.392171 -0.105346 1.566142 0.586138 0.950489 1.209868 1.332589 1.087730 0.608633 0.545623 0.189852 1.681493 0.487350 0.405093 1.121113 0.988264 0.089589 1.002114 0.406924 0.857351 -0.106561 0.434389 0.315978 0.874454 0.677274 1.738995 0.126523 0.418419 -0.034288 -0.514474 0.544729 1.186629 0.091214 1.023974 0.889868 1.105258 -0.014030 1.568529 1.019817 1.384214 0.868550 0.027819 0.525808 1.447056 0.636493 0.394992 1.091277 -0.079518 0.886075 0.569418 -0.004838 1.104104 1.810908 0.227707 1.565455 0.923044 1.560572 1.031354 0.513130 1.131259)
+ 12.671121 #r(0.000000 1.578825 0.666211 0.726552 1.538384 1.791570 0.099320 -0.160491 0.989473 0.596822 1.035192 0.247178 0.628445 0.721303 0.845175 1.341449 0.627742 1.157974 1.573300 1.577559 1.146243 0.642518 1.253235 0.873141 0.677674 1.983841 -0.058813 1.145842 1.258749 1.002052 1.540728 1.596826 0.319265 -0.110992 0.873225 1.001714 0.958663 0.883044 0.804615 1.392171 -0.105346 1.566142 0.586138 0.950489 1.209868 1.332589 1.087730 0.608633 0.545623 0.189852 1.681493 0.487350 0.405093 1.121113 0.988264 0.089589 1.002114 0.406924 0.857351 -0.106561 0.434389 0.315978 0.874454 0.677274 1.738995 0.126523 0.418419 -0.034288 -0.514474 0.544729 1.186629 0.091214 1.023974 0.889868 1.105258 -0.014030 1.568529 1.019817 1.384214 0.868550 0.027819 0.525808 1.447056 0.636493 0.394992 1.091277 -0.079518 0.886075 0.569418 -0.004838 1.104104 1.810908 0.227707 1.565455 0.923044 1.560572 1.031354 0.513130 1.131259)
)
;;; 100 prime --------------------------------------------------------------------------------
-(vector 100 15.637986183167 #(0 1 0 1 0 0 0 0 1 1 0 1 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 0 0 0 1 0 0 1 1 0 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 1 0 0 1 1 0 0 0 0 0 1 0 0 1 1)
+(vector 100 15.637986183167 #r(0 1 0 1 0 0 0 0 1 1 0 1 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 0 0 0 1 0 0 1 1 0 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 1 0 0 1 1 0 0 0 0 0 1 0 0 1 1)
- 12.957637 #(0.000000 1.386453 1.370643 1.628038 1.538390 0.424621 1.485227 0.897618 0.907971 0.449160 0.163275 1.571834 1.093156 0.838120 0.247905 1.436852 0.372882 -0.220773 1.118451 0.054878 1.267282 0.565411 0.289581 0.731340 0.458703 -0.367224 -0.030109 0.334428 1.397987 0.598724 0.901920 1.214518 -0.004754 1.438150 1.307411 0.016366 1.337284 1.304934 1.171963 0.021267 0.117441 0.560545 0.340812 1.151463 1.666509 1.019303 -0.015114 0.880146 1.373879 0.049199 1.503584 1.604549 0.862952 0.189305 0.529694 1.029077 0.778339 1.706291 1.914727 1.273598 1.699313 -0.031345 -0.253493 1.258299 1.649412 1.077808 1.672514 1.251013 0.462905 1.384023 0.091088 1.738772 0.445974 1.424109 1.582876 1.988433 0.984011 1.200230 -0.169021 0.062775 1.511082 0.660711 1.089055 0.545793 1.273058 1.509833 0.626971 0.715771 1.564417 1.945654 0.972744 0.969507 1.754542 1.683747 0.602245 0.329311 0.710216 0.150434 1.629408 1.227167)
+ 12.957637 #r(0.000000 1.386453 1.370643 1.628038 1.538390 0.424621 1.485227 0.897618 0.907971 0.449160 0.163275 1.571834 1.093156 0.838120 0.247905 1.436852 0.372882 -0.220773 1.118451 0.054878 1.267282 0.565411 0.289581 0.731340 0.458703 -0.367224 -0.030109 0.334428 1.397987 0.598724 0.901920 1.214518 -0.004754 1.438150 1.307411 0.016366 1.337284 1.304934 1.171963 0.021267 0.117441 0.560545 0.340812 1.151463 1.666509 1.019303 -0.015114 0.880146 1.373879 0.049199 1.503584 1.604549 0.862952 0.189305 0.529694 1.029077 0.778339 1.706291 1.914727 1.273598 1.699313 -0.031345 -0.253493 1.258299 1.649412 1.077808 1.672514 1.251013 0.462905 1.384023 0.091088 1.738772 0.445974 1.424109 1.582876 1.988433 0.984011 1.200230 -0.169021 0.062775 1.511082 0.660711 1.089055 0.545793 1.273058 1.509833 0.626971 0.715771 1.564417 1.945654 0.972744 0.969507 1.754542 1.683747 0.602245 0.329311 0.710216 0.150434 1.629408 1.227167)
;; 99+1
- 12.716986 #(0.000000 1.614268 0.794652 0.719356 1.522693 1.839206 0.053187 -0.216045 1.077547 0.626072 0.992447 0.258424 0.613665 0.666154 0.797791 1.297151 0.666442 1.138663 1.568655 1.598721 1.081507 0.701607 1.189990 0.875992 0.670799 0.120588 0.002798 1.147193 1.214233 0.961367 1.487074 1.498267 0.315736 -0.163747 0.892348 0.853335 0.781180 0.904959 0.815695 1.365580 -0.161311 1.770543 0.467808 0.858870 1.202500 1.263259 1.179260 0.605694 0.567979 0.170780 1.783259 0.557899 0.419137 1.246376 1.015382 0.060732 1.143789 0.421313 0.784488 -0.191174 0.582308 0.326318 0.868037 0.700245 1.775099 0.084259 0.487674 0.052341 -0.505041 0.601192 1.234546 0.060079 0.970347 0.831571 1.221404 0.028687 1.689191 1.030841 1.384017 0.852184 0.054733 0.492124 1.493372 0.743678 0.351949 0.983070 -0.060785 0.924421 0.622513 0.041911 1.106639 1.715696 0.158455 1.595681 0.922989 1.564481 1.036395 0.544443 1.152503 -0.027178)
+ 12.716986 #r(0.000000 1.614268 0.794652 0.719356 1.522693 1.839206 0.053187 -0.216045 1.077547 0.626072 0.992447 0.258424 0.613665 0.666154 0.797791 1.297151 0.666442 1.138663 1.568655 1.598721 1.081507 0.701607 1.189990 0.875992 0.670799 0.120588 0.002798 1.147193 1.214233 0.961367 1.487074 1.498267 0.315736 -0.163747 0.892348 0.853335 0.781180 0.904959 0.815695 1.365580 -0.161311 1.770543 0.467808 0.858870 1.202500 1.263259 1.179260 0.605694 0.567979 0.170780 1.783259 0.557899 0.419137 1.246376 1.015382 0.060732 1.143789 0.421313 0.784488 -0.191174 0.582308 0.326318 0.868037 0.700245 1.775099 0.084259 0.487674 0.052341 -0.505041 0.601192 1.234546 0.060079 0.970347 0.831571 1.221404 0.028687 1.689191 1.030841 1.384017 0.852184 0.054733 0.492124 1.493372 0.743678 0.351949 0.983070 -0.060785 0.924421 0.622513 0.041911 1.106639 1.715696 0.158455 1.595681 0.922989 1.564481 1.036395 0.544443 1.152503 -0.027178)
)
;;; 101 prime --------------------------------------------------------------------------------
-(vector 101 15.735968313601 #(0 1 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 0 0 0 1 1 0 1 0 0 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 1 0 1 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 0 0 1)
+(vector 101 15.735968313601 #r(0 1 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 0 0 0 1 1 0 1 0 0 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 1 0 1 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 0 0 1)
- 12.909758 #(0.000000 0.720714 -0.182655 1.565457 0.753622 0.130143 0.334294 1.650697 0.417832 0.048827 0.344422 1.486401 0.292931 1.799521 1.111655 1.558792 -0.221559 1.531040 0.348578 0.973695 0.761485 1.268033 0.273978 1.313895 1.704221 0.068165 0.481602 0.743938 -0.351235 -0.099468 0.085867 1.467502 0.670175 1.060411 0.557784 1.309992 0.991970 0.107757 0.556296 0.077508 1.974081 0.189947 1.303789 1.238050 0.718111 0.534076 0.252095 1.598289 1.547761 1.182866 0.464613 1.755609 0.089102 1.246032 0.080260 1.036577 0.473927 0.107892 0.368036 0.986840 0.765140 -0.036059 1.290823 0.227451 0.726294 -0.006595 0.616819 -0.359117 0.861664 1.267742 1.139832 0.077396 1.257827 0.004277 1.664182 0.904514 1.106007 1.213475 0.580481 1.709443 0.640563 0.036194 0.492519 1.274675 0.574901 0.832654 0.371185 0.344722 0.998543 0.576680 0.369414 0.177252 0.865880 0.137875 0.239059 0.486022 1.121460 0.939339 0.230403 0.470154 0.464729)
+ 12.909758 #r(0.000000 0.720714 -0.182655 1.565457 0.753622 0.130143 0.334294 1.650697 0.417832 0.048827 0.344422 1.486401 0.292931 1.799521 1.111655 1.558792 -0.221559 1.531040 0.348578 0.973695 0.761485 1.268033 0.273978 1.313895 1.704221 0.068165 0.481602 0.743938 -0.351235 -0.099468 0.085867 1.467502 0.670175 1.060411 0.557784 1.309992 0.991970 0.107757 0.556296 0.077508 1.974081 0.189947 1.303789 1.238050 0.718111 0.534076 0.252095 1.598289 1.547761 1.182866 0.464613 1.755609 0.089102 1.246032 0.080260 1.036577 0.473927 0.107892 0.368036 0.986840 0.765140 -0.036059 1.290823 0.227451 0.726294 -0.006595 0.616819 -0.359117 0.861664 1.267742 1.139832 0.077396 1.257827 0.004277 1.664182 0.904514 1.106007 1.213475 0.580481 1.709443 0.640563 0.036194 0.492519 1.274675 0.574901 0.832654 0.371185 0.344722 0.998543 0.576680 0.369414 0.177252 0.865880 0.137875 0.239059 0.486022 1.121460 0.939339 0.230403 0.470154 0.464729)
;; 102-1
- 12.654378 #(0.000000 0.039802 1.217841 -0.018794 -0.264350 1.648606 -0.106572 1.436093 1.744759 1.197340 1.116039 0.322269 -0.319802 1.429760 1.337731 1.367755 1.294986 0.934427 1.178285 0.242928 0.397639 0.030160 0.470705 0.489509 0.721431 0.877160 0.586365 1.300090 0.056753 0.396042 0.694396 -0.123538 0.601882 1.828235 1.061453 1.208202 1.515734 1.300848 0.385739 1.295236 0.466727 1.125610 1.584167 0.360500 0.430768 1.515128 1.002486 1.429469 1.701067 0.146032 1.922601 1.668726 1.734188 0.898236 1.467655 0.751985 1.587598 0.572766 0.063367 1.242347 -0.141898 0.518327 1.188113 1.385035 1.498198 -0.400261 -0.058961 1.288706 1.366806 0.035365 1.606021 -0.052356 0.617357 0.512726 0.520602 1.405519 1.969640 -0.459289 0.438819 1.509996 1.047832 0.536024 0.230428 0.540739 1.290987 1.664498 0.615778 1.436029 1.298481 1.467348 0.158627 0.119363 1.098827 0.065055 0.380410 0.835569 0.455358 0.512707 1.391092 0.922515 1.335905)
+ 12.654378 #r(0.000000 0.039802 1.217841 -0.018794 -0.264350 1.648606 -0.106572 1.436093 1.744759 1.197340 1.116039 0.322269 -0.319802 1.429760 1.337731 1.367755 1.294986 0.934427 1.178285 0.242928 0.397639 0.030160 0.470705 0.489509 0.721431 0.877160 0.586365 1.300090 0.056753 0.396042 0.694396 -0.123538 0.601882 1.828235 1.061453 1.208202 1.515734 1.300848 0.385739 1.295236 0.466727 1.125610 1.584167 0.360500 0.430768 1.515128 1.002486 1.429469 1.701067 0.146032 1.922601 1.668726 1.734188 0.898236 1.467655 0.751985 1.587598 0.572766 0.063367 1.242347 -0.141898 0.518327 1.188113 1.385035 1.498198 -0.400261 -0.058961 1.288706 1.366806 0.035365 1.606021 -0.052356 0.617357 0.512726 0.520602 1.405519 1.969640 -0.459289 0.438819 1.509996 1.047832 0.536024 0.230428 0.540739 1.290987 1.664498 0.615778 1.436029 1.298481 1.467348 0.158627 0.119363 1.098827 0.065055 0.380410 0.835569 0.455358 0.512707 1.391092 0.922515 1.335905)
)
;;; 102 prime --------------------------------------------------------------------------------
-(vector 102 15.374809992584 #(0 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 0 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 0 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 0 1)
+(vector 102 15.374809992584 #r(0 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 0 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 0 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 0 1)
- 13.125163 #(0.000000 0.284570 1.185932 0.254020 0.458026 1.777924 0.273972 0.352012 0.871247 1.673334 1.496604 0.270045 1.591827 -0.188397 0.589501 1.091682 1.741121 0.196787 0.525310 1.321393 1.205053 -0.057392 1.556520 -1.961535 1.179860 1.122770 0.814829 1.500056 -0.069946 0.070497 1.237530 1.280644 0.820936 1.402645 0.152660 1.210341 0.842206 0.369359 0.105608 0.811471 0.529059 0.041857 1.655756 0.893298 1.337926 1.496211 1.428234 0.556092 0.432069 0.925348 1.205854 1.544664 1.704644 1.229630 0.303212 1.758935 1.188278 1.467436 1.586279 1.260300 1.300112 1.011729 1.695629 1.060370 1.604385 0.957028 1.624378 0.311506 0.745336 0.578867 0.572336 1.655636 0.424967 1.250130 0.974803 1.251963 1.312562 0.463398 -0.038700 1.540879 0.156800 0.564982 0.689178 0.544052 1.778377 0.813450 0.561441 0.695184 0.270384 1.438063 0.744019 1.224468 0.148794 1.411742 1.416148 0.158444 1.282043 0.332184 1.434585 0.991269 -0.118131 -0.014118)
+ 13.125163 #r(0.000000 0.284570 1.185932 0.254020 0.458026 1.777924 0.273972 0.352012 0.871247 1.673334 1.496604 0.270045 1.591827 -0.188397 0.589501 1.091682 1.741121 0.196787 0.525310 1.321393 1.205053 -0.057392 1.556520 -1.961535 1.179860 1.122770 0.814829 1.500056 -0.069946 0.070497 1.237530 1.280644 0.820936 1.402645 0.152660 1.210341 0.842206 0.369359 0.105608 0.811471 0.529059 0.041857 1.655756 0.893298 1.337926 1.496211 1.428234 0.556092 0.432069 0.925348 1.205854 1.544664 1.704644 1.229630 0.303212 1.758935 1.188278 1.467436 1.586279 1.260300 1.300112 1.011729 1.695629 1.060370 1.604385 0.957028 1.624378 0.311506 0.745336 0.578867 0.572336 1.655636 0.424967 1.250130 0.974803 1.251963 1.312562 0.463398 -0.038700 1.540879 0.156800 0.564982 0.689178 0.544052 1.778377 0.813450 0.561441 0.695184 0.270384 1.438063 0.744019 1.224468 0.148794 1.411742 1.416148 0.158444 1.282043 0.332184 1.434585 0.991269 -0.118131 -0.014118)
;; 103-1
- 12.631141 #(0.000000 0.074843 1.219158 -0.027199 -0.254073 1.624605 -0.135701 1.453877 1.755897 1.198675 1.090421 0.272002 -0.249474 1.447439 1.360955 1.341148 1.290153 0.969167 1.135329 0.243792 0.418984 1.946250 0.601544 0.456951 0.765282 0.872982 0.576621 1.365615 0.094262 0.399525 0.677984 -0.086420 0.567433 1.780255 1.046981 1.205389 1.534885 1.234066 0.439028 1.336514 0.490354 1.104410 1.622676 0.382214 0.417306 1.496561 0.975909 1.398390 1.624475 0.141661 1.921427 1.688187 1.741843 0.901238 1.419496 0.813192 1.607447 0.585967 -0.020824 1.251511 -0.203691 0.513177 1.192285 1.326136 1.473869 -0.455142 -0.016589 1.259703 1.293519 0.048863 1.685391 -0.099881 0.662916 0.500247 0.557103 1.438861 1.941547 -0.474933 0.373608 1.542760 1.006189 0.593009 0.247793 0.539650 1.340923 1.675659 0.620550 1.469642 1.328665 1.442498 0.149610 0.049207 1.111223 0.085126 0.353623 0.826677 0.461777 0.518667 1.404379 0.899861 1.337308 0.525132)
+ 12.631141 #r(0.000000 0.074843 1.219158 -0.027199 -0.254073 1.624605 -0.135701 1.453877 1.755897 1.198675 1.090421 0.272002 -0.249474 1.447439 1.360955 1.341148 1.290153 0.969167 1.135329 0.243792 0.418984 1.946250 0.601544 0.456951 0.765282 0.872982 0.576621 1.365615 0.094262 0.399525 0.677984 -0.086420 0.567433 1.780255 1.046981 1.205389 1.534885 1.234066 0.439028 1.336514 0.490354 1.104410 1.622676 0.382214 0.417306 1.496561 0.975909 1.398390 1.624475 0.141661 1.921427 1.688187 1.741843 0.901238 1.419496 0.813192 1.607447 0.585967 -0.020824 1.251511 -0.203691 0.513177 1.192285 1.326136 1.473869 -0.455142 -0.016589 1.259703 1.293519 0.048863 1.685391 -0.099881 0.662916 0.500247 0.557103 1.438861 1.941547 -0.474933 0.373608 1.542760 1.006189 0.593009 0.247793 0.539650 1.340923 1.675659 0.620550 1.469642 1.328665 1.442498 0.149610 0.049207 1.111223 0.085126 0.353623 0.826677 0.461777 0.518667 1.404379 0.899861 1.337308 0.525132)
)
;;; 103 prime --------------------------------------------------------------------------------
-(vector 103 16.296298498866 #(0 0 1 0 1 1 1 0 0 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 1 1 1 0 1 1 1 0 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 1 1 1 1 1 1)
+(vector 103 16.296298498866 #r(0 0 1 0 1 1 1 0 0 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 1 1 1 0 1 1 1 0 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 1 1 1 1 1 1)
- 13.256855 #(0.000000 0.253687 0.364122 0.283681 0.599056 0.452778 1.412525 1.578158 0.723002 1.502688 0.469327 0.823618 0.138223 0.170924 -0.041881 1.730522 0.763213 0.124296 1.756004 0.298966 0.867744 1.163387 -0.026926 0.637630 1.135341 0.124472 0.638511 0.161082 1.417534 1.311969 1.355755 0.769867 -0.015620 1.263904 0.253925 1.195956 0.435477 0.207251 1.875570 0.589212 -0.141939 1.489218 1.811390 0.546189 -0.100127 1.137591 0.512565 0.982503 0.208205 0.661546 0.459680 0.647870 0.862493 1.703684 1.626808 1.293610 1.244032 1.833651 0.313984 0.098233 0.713078 -0.030639 0.471225 0.283054 1.436428 1.697146 0.363648 0.928407 1.232119 0.232840 0.986487 -0.076225 0.058237 1.691889 0.445904 1.400974 1.534686 0.353656 1.081845 0.844988 1.752497 1.490478 0.820514 0.624503 1.244095 0.481359 1.092852 1.038822 0.122193 0.306870 1.545599 1.882053 0.840143 1.618524 0.664876 1.172112 0.425428 1.063389 1.459465 1.132826 0.707914 0.476065 0.729618)
+ 13.256855 #r(0.000000 0.253687 0.364122 0.283681 0.599056 0.452778 1.412525 1.578158 0.723002 1.502688 0.469327 0.823618 0.138223 0.170924 -0.041881 1.730522 0.763213 0.124296 1.756004 0.298966 0.867744 1.163387 -0.026926 0.637630 1.135341 0.124472 0.638511 0.161082 1.417534 1.311969 1.355755 0.769867 -0.015620 1.263904 0.253925 1.195956 0.435477 0.207251 1.875570 0.589212 -0.141939 1.489218 1.811390 0.546189 -0.100127 1.137591 0.512565 0.982503 0.208205 0.661546 0.459680 0.647870 0.862493 1.703684 1.626808 1.293610 1.244032 1.833651 0.313984 0.098233 0.713078 -0.030639 0.471225 0.283054 1.436428 1.697146 0.363648 0.928407 1.232119 0.232840 0.986487 -0.076225 0.058237 1.691889 0.445904 1.400974 1.534686 0.353656 1.081845 0.844988 1.752497 1.490478 0.820514 0.624503 1.244095 0.481359 1.092852 1.038822 0.122193 0.306870 1.545599 1.882053 0.840143 1.618524 0.664876 1.172112 0.425428 1.063389 1.459465 1.132826 0.707914 0.476065 0.729618)
;; 104-1
- 12.891616 #(0.000000 0.020230 1.100455 -0.027655 -0.341498 1.573639 -0.166459 1.336909 1.614334 1.265242 1.070753 0.200336 -0.139945 1.315758 1.256048 1.330780 1.163466 0.897749 1.119686 0.362299 0.301310 1.883571 0.506864 0.431140 0.779158 0.861103 0.563763 1.317182 0.358448 0.581384 0.662511 -0.059228 0.585764 1.735705 1.134223 1.253804 1.488711 1.296145 0.401006 1.318547 0.409838 1.063168 1.784758 0.605346 0.454705 1.514331 1.036227 1.443746 1.590100 0.152638 1.937048 1.659118 1.596372 0.834928 1.202317 0.791629 1.638040 0.394481 0.036287 1.308852 -0.027851 0.483382 1.137070 1.471797 1.436021 -0.339247 1.959465 1.416371 1.274782 -0.056416 1.618621 0.073487 0.645516 0.465048 0.562814 1.499952 1.962975 -0.425202 0.177209 1.576794 1.092923 0.684292 0.216536 0.469811 1.278388 1.697283 0.494244 1.421192 1.305461 1.352595 0.145716 0.152674 1.146529 0.138563 0.239706 0.891463 0.397696 0.605319 1.317917 0.759776 1.395135 0.600443 1.308594)
+ 12.891616 #r(0.000000 0.020230 1.100455 -0.027655 -0.341498 1.573639 -0.166459 1.336909 1.614334 1.265242 1.070753 0.200336 -0.139945 1.315758 1.256048 1.330780 1.163466 0.897749 1.119686 0.362299 0.301310 1.883571 0.506864 0.431140 0.779158 0.861103 0.563763 1.317182 0.358448 0.581384 0.662511 -0.059228 0.585764 1.735705 1.134223 1.253804 1.488711 1.296145 0.401006 1.318547 0.409838 1.063168 1.784758 0.605346 0.454705 1.514331 1.036227 1.443746 1.590100 0.152638 1.937048 1.659118 1.596372 0.834928 1.202317 0.791629 1.638040 0.394481 0.036287 1.308852 -0.027851 0.483382 1.137070 1.471797 1.436021 -0.339247 1.959465 1.416371 1.274782 -0.056416 1.618621 0.073487 0.645516 0.465048 0.562814 1.499952 1.962975 -0.425202 0.177209 1.576794 1.092923 0.684292 0.216536 0.469811 1.278388 1.697283 0.494244 1.421192 1.305461 1.352595 0.145716 0.152674 1.146529 0.138563 0.239706 0.891463 0.397696 0.605319 1.317917 0.759776 1.395135 0.600443 1.308594)
)
;;; 104 prime --------------------------------------------------------------------------------
-(vector 104 15.919013023376 #(0 1 0 1 1 0 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 1 0 1 1 0 0 0 0 1 0 0 0 1 1 1 0 1 1 0 0 0 0 1 0 1 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 0 1)
+(vector 104 15.919013023376 #r(0 1 0 1 1 0 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 1 0 1 1 0 0 0 0 1 0 0 0 1 1 1 0 1 1 0 0 0 0 1 0 1 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 0 1)
- 12.987392 #(0.000000 0.019656 1.020820 -0.122857 -0.383416 1.743762 -0.077551 1.285344 1.556500 1.347778 1.007108 0.271391 -0.017599 1.323289 1.224441 1.254961 1.192419 0.950226 1.083964 0.356128 0.296702 1.898956 0.423819 0.431784 0.740632 0.838009 0.555934 1.287966 0.437690 0.641910 0.602950 -0.082685 0.609730 1.650999 1.107220 1.287768 1.459073 1.340092 0.368618 1.276887 0.523746 1.035407 1.951274 0.598910 0.440828 1.523180 1.064599 1.442876 1.610632 0.084831 1.933213 1.678415 1.492367 0.869607 1.168981 0.759731 1.683066 0.461763 1.964877 1.344876 -0.085783 0.568560 1.208659 1.424190 1.445388 -0.303350 1.915514 1.421848 1.165687 -0.066096 1.641117 0.068094 0.584541 0.457188 0.559162 1.501643 1.956646 -0.560037 0.043217 1.538096 1.142301 0.678432 0.239030 0.380298 1.373491 1.617773 0.449327 1.348144 1.243227 1.328890 0.139617 0.253213 1.094223 0.214901 0.235818 0.939054 0.321415 0.563100 1.348449 0.703267 1.435425 0.687968 1.242454 -0.344280)
+ 12.987392 #r(0.000000 0.019656 1.020820 -0.122857 -0.383416 1.743762 -0.077551 1.285344 1.556500 1.347778 1.007108 0.271391 -0.017599 1.323289 1.224441 1.254961 1.192419 0.950226 1.083964 0.356128 0.296702 1.898956 0.423819 0.431784 0.740632 0.838009 0.555934 1.287966 0.437690 0.641910 0.602950 -0.082685 0.609730 1.650999 1.107220 1.287768 1.459073 1.340092 0.368618 1.276887 0.523746 1.035407 1.951274 0.598910 0.440828 1.523180 1.064599 1.442876 1.610632 0.084831 1.933213 1.678415 1.492367 0.869607 1.168981 0.759731 1.683066 0.461763 1.964877 1.344876 -0.085783 0.568560 1.208659 1.424190 1.445388 -0.303350 1.915514 1.421848 1.165687 -0.066096 1.641117 0.068094 0.584541 0.457188 0.559162 1.501643 1.956646 -0.560037 0.043217 1.538096 1.142301 0.678432 0.239030 0.380298 1.373491 1.617773 0.449327 1.348144 1.243227 1.328890 0.139617 0.253213 1.094223 0.214901 0.235818 0.939054 0.321415 0.563100 1.348449 0.703267 1.435425 0.687968 1.242454 -0.344280)
)
;;; 105 prime --------------------------------------------------------------------------------
-(vector 105 16.038356734428 #(0 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 0 1 0 0 0 1 0 1 1 1 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 0 0 0 1 1 0 0 1 1 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 0)
+(vector 105 16.038356734428 #r(0 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 0 1 0 0 0 1 0 1 1 1 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 0 0 0 1 1 0 0 1 1 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 0)
- 13.058436 #(0.000000 0.018841 0.195855 0.206420 0.065633 1.458550 0.564954 0.584050 0.255393 0.821477 0.473289 1.497087 0.488701 0.595510 1.763919 1.795152 1.020709 0.148507 1.419452 -0.190874 1.252819 -0.115417 1.572364 1.086172 1.203320 0.123978 1.519196 1.337538 1.222474 1.661628 1.792441 1.530814 0.073522 0.146382 0.880812 1.383907 1.455106 1.313842 0.612949 1.097744 0.661951 0.056058 0.292577 0.309700 1.553938 1.839317 1.798626 0.412574 -0.220475 0.391331 1.230536 1.329793 -0.061036 0.863566 1.369439 -0.108592 1.446517 1.870258 0.562986 0.909666 0.015512 0.313473 0.325423 1.421234 1.107012 0.906081 -0.185513 0.052032 0.945263 0.140137 1.151954 1.558716 1.433167 -0.154754 1.358982 -0.108152 1.794830 0.776903 1.411273 0.506284 0.746113 0.870064 0.655404 0.430773 1.492137 1.947814 1.106281 1.476409 1.624757 1.670125 1.262143 0.090556 0.017948 1.208649 1.518613 0.097884 0.893396 1.883764 0.459504 1.072858 0.258050 0.025247 0.792929 1.431035 1.911968)
+ 13.058436 #r(0.000000 0.018841 0.195855 0.206420 0.065633 1.458550 0.564954 0.584050 0.255393 0.821477 0.473289 1.497087 0.488701 0.595510 1.763919 1.795152 1.020709 0.148507 1.419452 -0.190874 1.252819 -0.115417 1.572364 1.086172 1.203320 0.123978 1.519196 1.337538 1.222474 1.661628 1.792441 1.530814 0.073522 0.146382 0.880812 1.383907 1.455106 1.313842 0.612949 1.097744 0.661951 0.056058 0.292577 0.309700 1.553938 1.839317 1.798626 0.412574 -0.220475 0.391331 1.230536 1.329793 -0.061036 0.863566 1.369439 -0.108592 1.446517 1.870258 0.562986 0.909666 0.015512 0.313473 0.325423 1.421234 1.107012 0.906081 -0.185513 0.052032 0.945263 0.140137 1.151954 1.558716 1.433167 -0.154754 1.358982 -0.108152 1.794830 0.776903 1.411273 0.506284 0.746113 0.870064 0.655404 0.430773 1.492137 1.947814 1.106281 1.476409 1.624757 1.670125 1.262143 0.090556 0.017948 1.208649 1.518613 0.097884 0.893396 1.883764 0.459504 1.072858 0.258050 0.025247 0.792929 1.431035 1.911968)
)
;;; 106 prime --------------------------------------------------------------------------------
-(vector 106 15.730461834714 #(0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1 1 1 1 0 1 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 0 0 1 1 0 0 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1)
+(vector 106 15.730461834714 #r(0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1 1 1 1 0 1 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 0 0 1 1 0 0 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1)
- 13.079950 #(0.000000 0.991683 1.667079 0.952198 -0.158134 0.908256 -0.128985 1.883696 0.540349 0.614398 0.596989 0.783975 1.428368 1.597136 0.736884 1.252068 1.305873 0.231319 1.020117 1.388373 0.377031 1.796792 1.091025 -0.916486 1.247592 1.449627 1.096507 0.594132 -0.088485 1.169711 1.329459 0.003695 0.368539 -0.180221 0.842521 1.314435 1.291992 1.272149 0.292625 1.025337 1.197144 0.687141 1.597409 1.201509 1.264866 0.210655 0.462014 0.072105 1.054043 0.490923 0.945944 1.071461 0.064888 0.965001 1.073253 1.205548 1.546442 0.256599 0.512902 -0.205146 0.188856 1.063444 0.616804 1.743279 0.914154 0.807038 1.016753 1.132350 0.990751 0.400337 1.345943 0.880688 0.534474 0.323663 1.462334 0.913980 0.240611 1.904272 0.651788 0.182999 -0.180558 -0.266742 1.405697 0.476547 1.309300 1.415664 1.075072 1.577006 1.108476 0.911007 -0.337178 0.168855 1.245061 1.768086 1.542431 1.828360 0.829179 1.275739 -0.086776 0.463079 -0.336090 0.362914 1.505253 0.753982 0.654367 1.043320)
+ 13.079950 #r(0.000000 0.991683 1.667079 0.952198 -0.158134 0.908256 -0.128985 1.883696 0.540349 0.614398 0.596989 0.783975 1.428368 1.597136 0.736884 1.252068 1.305873 0.231319 1.020117 1.388373 0.377031 1.796792 1.091025 -0.916486 1.247592 1.449627 1.096507 0.594132 -0.088485 1.169711 1.329459 0.003695 0.368539 -0.180221 0.842521 1.314435 1.291992 1.272149 0.292625 1.025337 1.197144 0.687141 1.597409 1.201509 1.264866 0.210655 0.462014 0.072105 1.054043 0.490923 0.945944 1.071461 0.064888 0.965001 1.073253 1.205548 1.546442 0.256599 0.512902 -0.205146 0.188856 1.063444 0.616804 1.743279 0.914154 0.807038 1.016753 1.132350 0.990751 0.400337 1.345943 0.880688 0.534474 0.323663 1.462334 0.913980 0.240611 1.904272 0.651788 0.182999 -0.180558 -0.266742 1.405697 0.476547 1.309300 1.415664 1.075072 1.577006 1.108476 0.911007 -0.337178 0.168855 1.245061 1.768086 1.542431 1.828360 0.829179 1.275739 -0.086776 0.463079 -0.336090 0.362914 1.505253 0.753982 0.654367 1.043320)
)
;;; 107 prime --------------------------------------------------------------------------------
-(vector 107 16.2013 #(0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 1 1 0 1 0 1 0 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 0 1 1 1)
+(vector 107 16.2013 #r(0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 1 1 0 1 0 1 0 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 0 1 1 1)
- 13.454325 #(0.000000 0.389504 0.200622 1.043121 0.761894 1.811391 1.013338 -0.029178 1.657156 0.071414 1.541808 1.697328 1.530731 0.828486 0.142611 0.827276 0.363623 0.731067 0.344946 0.056374 1.429426 0.761263 0.713573 1.043714 1.789986 0.913538 0.284688 1.632024 0.219315 1.596281 0.482719 0.716103 0.082813 0.889064 1.454911 -0.018694 1.031913 0.769500 1.225826 1.094301 0.011285 1.403439 1.540236 1.228421 1.198312 0.763787 1.489126 0.037842 1.393526 1.595697 1.484515 1.699381 0.910044 0.346999 1.483481 0.762896 0.323372 1.323234 0.494595 1.056252 0.710041 0.505300 0.227945 0.637730 1.459638 1.234710 0.493803 1.016315 0.230683 0.093113 0.713556 0.351744 1.777886 0.983943 0.185348 0.658457 0.665347 0.215532 0.767846 1.194595 0.781272 1.709017 0.088709 0.815194 0.381579 0.627948 1.674861 0.568794 1.433122 0.535438 1.473475 1.534920 1.207161 0.582128 0.284193 0.977855 0.959238 0.627080 0.292937 0.193644 0.627895 1.586822 1.256893 1.318535 0.663707 0.022219 1.167626)
+ 13.454325 #r(0.000000 0.389504 0.200622 1.043121 0.761894 1.811391 1.013338 -0.029178 1.657156 0.071414 1.541808 1.697328 1.530731 0.828486 0.142611 0.827276 0.363623 0.731067 0.344946 0.056374 1.429426 0.761263 0.713573 1.043714 1.789986 0.913538 0.284688 1.632024 0.219315 1.596281 0.482719 0.716103 0.082813 0.889064 1.454911 -0.018694 1.031913 0.769500 1.225826 1.094301 0.011285 1.403439 1.540236 1.228421 1.198312 0.763787 1.489126 0.037842 1.393526 1.595697 1.484515 1.699381 0.910044 0.346999 1.483481 0.762896 0.323372 1.323234 0.494595 1.056252 0.710041 0.505300 0.227945 0.637730 1.459638 1.234710 0.493803 1.016315 0.230683 0.093113 0.713556 0.351744 1.777886 0.983943 0.185348 0.658457 0.665347 0.215532 0.767846 1.194595 0.781272 1.709017 0.088709 0.815194 0.381579 0.627948 1.674861 0.568794 1.433122 0.535438 1.473475 1.534920 1.207161 0.582128 0.284193 0.977855 0.959238 0.627080 0.292937 0.193644 0.627895 1.586822 1.256893 1.318535 0.663707 0.022219 1.167626)
;; 106+1
- 13.202367 #(0.000000 1.000613 1.684756 1.030591 -0.144674 0.930087 -0.073206 1.869216 0.492462 0.667691 0.532693 0.721976 1.419258 1.577138 0.740297 1.322068 1.346534 0.154223 1.065715 1.368889 0.410182 1.822841 1.125450 -0.885511 1.290555 1.433074 1.046721 0.707499 -0.124656 1.201693 1.347393 0.018662 0.502177 -0.078873 0.756433 1.230311 1.259142 1.367069 0.315216 1.023759 1.259356 0.661168 1.411343 1.215010 1.266771 0.189892 0.505302 -0.011494 1.187732 0.519532 0.949942 1.050962 -0.019894 1.078182 0.992807 1.143414 1.633065 0.324324 0.492441 -0.218768 0.188780 0.963413 0.578702 1.692089 1.002935 0.841457 1.096611 1.231089 0.982778 0.479408 1.297577 0.816566 0.491832 0.381540 1.447787 0.924630 0.221301 1.796849 0.662118 0.111778 -0.098285 -0.205921 1.443651 0.375879 1.302820 1.419045 1.157539 1.514324 1.141534 0.934891 -0.258550 0.136149 1.293417 1.740995 1.504775 1.852338 0.849037 1.301984 -0.143638 0.497510 -0.382560 0.320355 1.490322 0.666001 0.663075 0.925267 0.075096)
+ 13.202367 #r(0.000000 1.000613 1.684756 1.030591 -0.144674 0.930087 -0.073206 1.869216 0.492462 0.667691 0.532693 0.721976 1.419258 1.577138 0.740297 1.322068 1.346534 0.154223 1.065715 1.368889 0.410182 1.822841 1.125450 -0.885511 1.290555 1.433074 1.046721 0.707499 -0.124656 1.201693 1.347393 0.018662 0.502177 -0.078873 0.756433 1.230311 1.259142 1.367069 0.315216 1.023759 1.259356 0.661168 1.411343 1.215010 1.266771 0.189892 0.505302 -0.011494 1.187732 0.519532 0.949942 1.050962 -0.019894 1.078182 0.992807 1.143414 1.633065 0.324324 0.492441 -0.218768 0.188780 0.963413 0.578702 1.692089 1.002935 0.841457 1.096611 1.231089 0.982778 0.479408 1.297577 0.816566 0.491832 0.381540 1.447787 0.924630 0.221301 1.796849 0.662118 0.111778 -0.098285 -0.205921 1.443651 0.375879 1.302820 1.419045 1.157539 1.514324 1.141534 0.934891 -0.258550 0.136149 1.293417 1.740995 1.504775 1.852338 0.849037 1.301984 -0.143638 0.497510 -0.382560 0.320355 1.490322 0.666001 0.663075 0.925267 0.075096)
)
;;; 108 prime --------------------------------------------------------------------------------
-(vector 108 16.517358779907 #(0 1 0 0 0 0 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 0 1)
+(vector 108 16.517358779907 #r(0 1 0 0 0 0 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 0 1)
- 13.566156 #(0.000000 0.728699 0.665336 1.259359 0.312955 1.409197 -0.227152 1.537467 1.153791 1.627076 -0.109225 0.091841 1.196044 0.651957 1.667279 0.297872 1.708304 1.600040 1.279774 0.976975 0.859888 1.094622 0.659631 0.928550 0.001741 -0.027962 0.214582 0.238151 1.673247 1.887884 0.736064 0.892280 0.140937 0.557264 1.253347 0.704162 0.470712 1.242786 0.158371 0.301659 0.524953 1.272263 1.156799 -0.239176 0.540826 0.229025 0.331628 1.768533 0.578592 1.809543 0.717505 1.699923 1.628036 -0.006910 1.357544 -0.139327 0.574888 1.440391 0.790214 1.511908 0.799982 0.339724 0.692982 0.670833 0.340679 0.340555 1.796897 1.303289 0.258157 0.027036 0.818761 0.552085 1.636862 0.719532 0.280874 1.446822 1.675335 0.170540 0.167079 0.487215 1.068313 1.129396 0.130584 -0.078228 1.601308 0.067975 0.896148 0.221651 0.232515 0.805049 1.470867 0.339643 0.563679 1.554585 0.968287 0.574484 1.097469 1.601363 0.583017 1.789341 1.359201 1.858560 0.117486 0.025512 1.678463 -0.072670 -0.213093 1.615471)
+ 13.566156 #r(0.000000 0.728699 0.665336 1.259359 0.312955 1.409197 -0.227152 1.537467 1.153791 1.627076 -0.109225 0.091841 1.196044 0.651957 1.667279 0.297872 1.708304 1.600040 1.279774 0.976975 0.859888 1.094622 0.659631 0.928550 0.001741 -0.027962 0.214582 0.238151 1.673247 1.887884 0.736064 0.892280 0.140937 0.557264 1.253347 0.704162 0.470712 1.242786 0.158371 0.301659 0.524953 1.272263 1.156799 -0.239176 0.540826 0.229025 0.331628 1.768533 0.578592 1.809543 0.717505 1.699923 1.628036 -0.006910 1.357544 -0.139327 0.574888 1.440391 0.790214 1.511908 0.799982 0.339724 0.692982 0.670833 0.340679 0.340555 1.796897 1.303289 0.258157 0.027036 0.818761 0.552085 1.636862 0.719532 0.280874 1.446822 1.675335 0.170540 0.167079 0.487215 1.068313 1.129396 0.130584 -0.078228 1.601308 0.067975 0.896148 0.221651 0.232515 0.805049 1.470867 0.339643 0.563679 1.554585 0.968287 0.574484 1.097469 1.601363 0.583017 1.789341 1.359201 1.858560 0.117486 0.025512 1.678463 -0.072670 -0.213093 1.615471)
;; 107+1
- 13.161718 #(0.000000 0.987739 1.733133 1.054188 -0.119939 0.910849 0.010896 1.915591 0.510331 0.662472 0.507733 0.711187 1.421434 1.531951 0.698359 1.366502 1.433114 0.162830 1.031829 1.385260 0.380744 1.872146 1.120453 -0.900242 1.311562 1.361998 1.093182 0.717990 -0.097277 1.161510 1.367817 0.082904 0.485601 -0.064734 0.731587 1.181418 1.308157 1.250173 0.316423 1.011227 1.301355 0.644463 1.445963 1.205118 1.208647 0.244654 0.589262 -0.059634 1.176596 0.571146 1.043371 1.083159 0.006076 1.077933 0.991663 1.165270 1.605164 0.390047 0.441435 -0.106544 0.175661 1.010931 0.543321 1.751721 0.965777 0.870079 1.024670 1.181296 0.990067 0.440808 1.351390 0.806214 0.421993 0.407648 1.468845 0.828507 0.187943 1.771172 0.634836 0.107090 -0.067569 -0.177001 1.469562 0.463678 1.334677 1.387523 1.126011 1.572881 1.170585 1.010919 -0.335535 0.129689 1.331430 1.676924 1.536965 1.783188 0.838550 1.260495 -0.084649 0.463288 -0.384118 0.341860 1.494266 0.699617 0.647486 0.913118 0.121686 0.025406)
+ 13.161718 #r(0.000000 0.987739 1.733133 1.054188 -0.119939 0.910849 0.010896 1.915591 0.510331 0.662472 0.507733 0.711187 1.421434 1.531951 0.698359 1.366502 1.433114 0.162830 1.031829 1.385260 0.380744 1.872146 1.120453 -0.900242 1.311562 1.361998 1.093182 0.717990 -0.097277 1.161510 1.367817 0.082904 0.485601 -0.064734 0.731587 1.181418 1.308157 1.250173 0.316423 1.011227 1.301355 0.644463 1.445963 1.205118 1.208647 0.244654 0.589262 -0.059634 1.176596 0.571146 1.043371 1.083159 0.006076 1.077933 0.991663 1.165270 1.605164 0.390047 0.441435 -0.106544 0.175661 1.010931 0.543321 1.751721 0.965777 0.870079 1.024670 1.181296 0.990067 0.440808 1.351390 0.806214 0.421993 0.407648 1.468845 0.828507 0.187943 1.771172 0.634836 0.107090 -0.067569 -0.177001 1.469562 0.463678 1.334677 1.387523 1.126011 1.572881 1.170585 1.010919 -0.335535 0.129689 1.331430 1.676924 1.536965 1.783188 0.838550 1.260495 -0.084649 0.463288 -0.384118 0.341860 1.494266 0.699617 0.647486 0.913118 0.121686 0.025406)
)
;;; 109 prime --------------------------------------------------------------------------------
-(vector 109 16.726722717285 #(0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 0 0 0 0 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 1 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1 0 1 1 0 1 1 1)
+(vector 109 16.726722717285 #r(0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 0 0 0 0 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 1 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1 0 1 1 0 1 1 1)
- 13.649150 #(0.000000 1.372685 -0.023096 0.764121 0.652451 1.161206 0.008161 0.316013 0.797732 0.714473 0.487368 1.050633 1.595865 0.070630 1.790292 1.172057 1.415647 1.153468 1.827169 0.230707 0.215213 0.858764 0.278893 1.454000 0.649000 1.487731 -0.093971 1.467452 0.578832 1.089439 0.854711 1.680527 0.623468 0.213876 1.468708 0.944679 1.289165 0.802006 0.813501 1.223343 1.569276 1.613534 0.610297 0.672562 1.232493 0.103141 1.459267 0.251097 0.877797 0.013403 1.560238 0.500350 1.399744 0.774367 0.659639 0.252122 0.824594 0.812839 0.861276 1.156805 0.833828 1.345402 0.790424 1.718416 0.402535 0.733335 1.522110 0.842132 1.600144 1.051832 -0.203657 0.911191 0.314178 0.284195 1.331343 0.434428 0.490954 1.410099 0.311769 1.658687 1.103289 1.173009 0.197955 0.613754 0.369986 0.003017 -0.302157 0.765490 1.656484 0.479210 0.563523 0.438269 0.714490 -0.012143 1.495468 -0.063161 0.479473 0.509000 1.902431 1.448189 0.587148 0.187985 1.316513 1.133117 1.008029 0.693260 0.907818 1.116038 0.394946)
+ 13.649150 #r(0.000000 1.372685 -0.023096 0.764121 0.652451 1.161206 0.008161 0.316013 0.797732 0.714473 0.487368 1.050633 1.595865 0.070630 1.790292 1.172057 1.415647 1.153468 1.827169 0.230707 0.215213 0.858764 0.278893 1.454000 0.649000 1.487731 -0.093971 1.467452 0.578832 1.089439 0.854711 1.680527 0.623468 0.213876 1.468708 0.944679 1.289165 0.802006 0.813501 1.223343 1.569276 1.613534 0.610297 0.672562 1.232493 0.103141 1.459267 0.251097 0.877797 0.013403 1.560238 0.500350 1.399744 0.774367 0.659639 0.252122 0.824594 0.812839 0.861276 1.156805 0.833828 1.345402 0.790424 1.718416 0.402535 0.733335 1.522110 0.842132 1.600144 1.051832 -0.203657 0.911191 0.314178 0.284195 1.331343 0.434428 0.490954 1.410099 0.311769 1.658687 1.103289 1.173009 0.197955 0.613754 0.369986 0.003017 -0.302157 0.765490 1.656484 0.479210 0.563523 0.438269 0.714490 -0.012143 1.495468 -0.063161 0.479473 0.509000 1.902431 1.448189 0.587148 0.187985 1.316513 1.133117 1.008029 0.693260 0.907818 1.116038 0.394946)
;; 108+1
- 13.143741 #(0.000000 0.981295 1.812666 1.117956 -0.185500 0.887133 -0.042123 1.869958 0.605292 0.660698 0.487240 0.624166 1.449694 1.534689 0.782613 1.451064 1.414295 0.227989 1.073340 1.379009 0.377980 1.849622 1.090582 -0.935851 1.300468 1.325519 1.018826 0.640677 -0.151618 1.157148 1.372788 0.030561 0.535214 0.003928 0.716545 1.230702 1.288510 1.214069 0.401399 1.044897 1.420969 0.699802 1.461844 1.182797 1.140031 0.222134 0.599399 -0.075721 1.205878 0.475321 1.079680 1.212881 -0.096955 1.107746 1.109769 1.169670 1.644352 0.462528 0.400247 -0.075889 0.244499 0.883273 0.555132 1.799341 1.047944 0.815280 0.989170 1.236643 1.002684 0.340197 1.339964 0.830022 0.342213 0.420385 1.313509 0.797027 0.138670 1.741420 0.612419 0.142853 -0.104009 -0.165428 1.519255 0.376528 1.265335 1.374075 1.080427 1.589793 1.292179 1.057071 -0.356737 0.109826 1.273643 1.715122 1.539078 1.804591 0.847821 1.225593 -0.104087 0.410682 -0.411370 0.366927 1.453570 0.665830 0.721383 0.960549 0.197868 0.027654 -0.001988)
+ 13.143741 #r(0.000000 0.981295 1.812666 1.117956 -0.185500 0.887133 -0.042123 1.869958 0.605292 0.660698 0.487240 0.624166 1.449694 1.534689 0.782613 1.451064 1.414295 0.227989 1.073340 1.379009 0.377980 1.849622 1.090582 -0.935851 1.300468 1.325519 1.018826 0.640677 -0.151618 1.157148 1.372788 0.030561 0.535214 0.003928 0.716545 1.230702 1.288510 1.214069 0.401399 1.044897 1.420969 0.699802 1.461844 1.182797 1.140031 0.222134 0.599399 -0.075721 1.205878 0.475321 1.079680 1.212881 -0.096955 1.107746 1.109769 1.169670 1.644352 0.462528 0.400247 -0.075889 0.244499 0.883273 0.555132 1.799341 1.047944 0.815280 0.989170 1.236643 1.002684 0.340197 1.339964 0.830022 0.342213 0.420385 1.313509 0.797027 0.138670 1.741420 0.612419 0.142853 -0.104009 -0.165428 1.519255 0.376528 1.265335 1.374075 1.080427 1.589793 1.292179 1.057071 -0.356737 0.109826 1.273643 1.715122 1.539078 1.804591 0.847821 1.225593 -0.104087 0.410682 -0.411370 0.366927 1.453570 0.665830 0.721383 0.960549 0.197868 0.027654 -0.001988)
)
;;; 110 prime --------------------------------------------------------------------------------
-(vector 110 16.455888332339 #(0 1 1 0 1 1 1 1 1 0 0 1 0 0 0 0 0 1 0 0 0 1 1 1 0 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 1 0 1 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 1)
+(vector 110 16.455888332339 #r(0 1 1 0 1 1 1 1 1 0 0 1 0 0 0 0 0 1 0 0 0 1 1 1 0 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 1 0 1 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 1)
- 13.753511 #(0.000000 0.848399 0.494893 1.537753 0.056503 1.192968 1.014976 1.000380 0.176221 0.063643 0.945853 -0.068422 1.888547 0.530097 1.932585 0.363227 0.205713 0.801411 0.700920 0.687774 0.323313 0.855436 1.706412 1.023431 1.539017 1.189953 0.005598 1.402697 1.398321 0.097413 0.650843 0.983076 -0.039672 1.076216 1.303860 0.579074 0.077434 1.403649 0.444054 1.850591 1.616413 0.004099 1.016957 0.276287 0.460935 1.424558 0.455559 1.774494 1.736742 0.257321 1.711197 0.589769 0.080807 0.068711 1.794312 0.030231 1.983460 1.792079 0.697501 1.563642 0.912299 1.306605 0.631662 1.306070 -0.020912 0.369231 0.339819 1.307905 -0.099842 0.333029 0.056818 -0.061161 0.558252 1.627518 -0.126860 1.759233 1.646547 0.826803 -0.148545 1.670003 1.989516 1.496557 0.799184 0.829408 0.352552 1.567755 1.722037 1.366413 1.337959 0.542553 0.828268 -0.090626 1.570252 0.921528 0.763668 1.791188 0.313328 1.353716 0.012540 0.577255 1.197100 -0.067959 0.264526 0.484251 0.882328 0.325360 0.489410 0.497137 1.466498 0.363086)
+ 13.753511 #r(0.000000 0.848399 0.494893 1.537753 0.056503 1.192968 1.014976 1.000380 0.176221 0.063643 0.945853 -0.068422 1.888547 0.530097 1.932585 0.363227 0.205713 0.801411 0.700920 0.687774 0.323313 0.855436 1.706412 1.023431 1.539017 1.189953 0.005598 1.402697 1.398321 0.097413 0.650843 0.983076 -0.039672 1.076216 1.303860 0.579074 0.077434 1.403649 0.444054 1.850591 1.616413 0.004099 1.016957 0.276287 0.460935 1.424558 0.455559 1.774494 1.736742 0.257321 1.711197 0.589769 0.080807 0.068711 1.794312 0.030231 1.983460 1.792079 0.697501 1.563642 0.912299 1.306605 0.631662 1.306070 -0.020912 0.369231 0.339819 1.307905 -0.099842 0.333029 0.056818 -0.061161 0.558252 1.627518 -0.126860 1.759233 1.646547 0.826803 -0.148545 1.670003 1.989516 1.496557 0.799184 0.829408 0.352552 1.567755 1.722037 1.366413 1.337959 0.542553 0.828268 -0.090626 1.570252 0.921528 0.763668 1.791188 0.313328 1.353716 0.012540 0.577255 1.197100 -0.067959 0.264526 0.484251 0.882328 0.325360 0.489410 0.497137 1.466498 0.363086)
;; 109+1
- 13.385857 #(0.000000 1.005423 1.782283 1.037310 -0.213053 0.879928 -0.046517 1.873303 0.602952 0.747924 0.548631 0.551919 1.533520 1.564233 0.767686 1.439845 1.429058 0.210745 1.048360 1.272572 0.420497 1.907528 1.007798 -0.875985 1.280681 1.283565 1.002224 0.663448 -0.175829 1.191021 1.396519 0.008645 0.463633 -0.035145 0.773513 1.183723 1.280027 1.209216 0.370736 1.024088 1.346178 0.572424 1.493165 1.210957 1.190749 0.243885 0.627363 -0.093472 1.163170 0.538660 1.062757 1.203025 -0.076830 1.020755 1.065456 1.180141 1.616909 0.426164 0.442881 -0.033300 0.224949 0.880028 0.544694 1.835856 0.965989 0.842443 0.993190 1.292542 0.995849 0.354562 1.374934 0.864622 0.357717 0.414238 1.429257 0.844435 0.199497 1.704803 0.599091 0.164856 -0.041591 -0.188982 1.576927 0.379552 1.197978 1.412448 1.100509 1.573418 1.244031 1.006949 -0.394739 0.102675 1.270463 1.672535 1.525836 1.772058 0.832852 1.187053 -0.004100 0.474378 -0.431920 0.321063 1.410302 0.680526 0.673358 0.951529 0.162772 0.079611 0.022569 0.116743)
+ 13.385857 #r(0.000000 1.005423 1.782283 1.037310 -0.213053 0.879928 -0.046517 1.873303 0.602952 0.747924 0.548631 0.551919 1.533520 1.564233 0.767686 1.439845 1.429058 0.210745 1.048360 1.272572 0.420497 1.907528 1.007798 -0.875985 1.280681 1.283565 1.002224 0.663448 -0.175829 1.191021 1.396519 0.008645 0.463633 -0.035145 0.773513 1.183723 1.280027 1.209216 0.370736 1.024088 1.346178 0.572424 1.493165 1.210957 1.190749 0.243885 0.627363 -0.093472 1.163170 0.538660 1.062757 1.203025 -0.076830 1.020755 1.065456 1.180141 1.616909 0.426164 0.442881 -0.033300 0.224949 0.880028 0.544694 1.835856 0.965989 0.842443 0.993190 1.292542 0.995849 0.354562 1.374934 0.864622 0.357717 0.414238 1.429257 0.844435 0.199497 1.704803 0.599091 0.164856 -0.041591 -0.188982 1.576927 0.379552 1.197978 1.412448 1.100509 1.573418 1.244031 1.006949 -0.394739 0.102675 1.270463 1.672535 1.525836 1.772058 0.832852 1.187053 -0.004100 0.474378 -0.431920 0.321063 1.410302 0.680526 0.673358 0.951529 0.162772 0.079611 0.022569 0.116743)
)
;;; 111 prime --------------------------------------------------------------------------------
-(vector 111 16.6662 #(0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 1 0 1 1 0 1 0 0 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1 0 1 0 0)
+(vector 111 16.6662 #r(0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 1 0 1 1 0 1 0 0 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1 0 1 0 0)
- 13.722535 #(0.000000 0.609754 0.477824 0.498205 -0.160828 1.311478 1.827872 1.163524 0.877088 0.528558 0.012460 0.425841 0.347225 1.111527 1.506620 1.410636 0.996952 -0.131493 1.544916 1.238729 0.920166 1.777555 1.246912 0.483008 1.025725 -0.124782 0.923160 0.448660 1.543112 1.342373 1.038202 0.935130 1.601650 0.963178 1.878258 0.588174 1.312098 0.758893 0.091784 1.903351 1.707234 0.845481 0.771218 1.534277 0.275800 0.904288 0.700394 1.584631 1.096911 0.048546 1.076681 -0.004790 1.712699 1.002701 0.028040 0.631055 0.000599 0.321247 1.728365 1.696152 0.050007 0.370978 0.617539 1.556864 1.281962 1.845086 1.923574 1.593500 1.577659 0.887043 0.956244 1.403764 1.038378 1.157002 1.529481 1.305687 0.017547 0.326930 0.654165 -0.007752 -0.267214 1.694215 0.852596 1.259529 0.832944 0.035647 0.361584 1.075053 1.075715 1.409307 1.062617 -0.201186 0.434486 -0.180399 1.188883 -0.221873 1.452975 -0.020938 0.072031 0.208492 1.474047 1.409906 0.615391 1.726165 0.685592 0.292682 1.428870 0.069915 -0.271563 0.353890 1.174756)
+ 13.722535 #r(0.000000 0.609754 0.477824 0.498205 -0.160828 1.311478 1.827872 1.163524 0.877088 0.528558 0.012460 0.425841 0.347225 1.111527 1.506620 1.410636 0.996952 -0.131493 1.544916 1.238729 0.920166 1.777555 1.246912 0.483008 1.025725 -0.124782 0.923160 0.448660 1.543112 1.342373 1.038202 0.935130 1.601650 0.963178 1.878258 0.588174 1.312098 0.758893 0.091784 1.903351 1.707234 0.845481 0.771218 1.534277 0.275800 0.904288 0.700394 1.584631 1.096911 0.048546 1.076681 -0.004790 1.712699 1.002701 0.028040 0.631055 0.000599 0.321247 1.728365 1.696152 0.050007 0.370978 0.617539 1.556864 1.281962 1.845086 1.923574 1.593500 1.577659 0.887043 0.956244 1.403764 1.038378 1.157002 1.529481 1.305687 0.017547 0.326930 0.654165 -0.007752 -0.267214 1.694215 0.852596 1.259529 0.832944 0.035647 0.361584 1.075053 1.075715 1.409307 1.062617 -0.201186 0.434486 -0.180399 1.188883 -0.221873 1.452975 -0.020938 0.072031 0.208492 1.474047 1.409906 0.615391 1.726165 0.685592 0.292682 1.428870 0.069915 -0.271563 0.353890 1.174756)
;; 110+1
- 13.484289 #(0.000000 0.995043 1.654854 0.951488 -0.186960 0.850693 -0.104052 1.791806 0.632389 0.741244 0.372539 0.536429 1.585222 1.564873 0.754743 1.533715 1.436886 0.265913 1.082971 1.345237 0.422609 1.896766 1.047262 -0.941259 1.315104 1.247825 1.012008 0.626763 -0.163895 1.147771 1.361070 0.089508 0.489357 -0.001980 0.747126 1.129161 1.312043 1.244841 0.335129 1.099634 1.435470 0.558588 1.594865 1.187385 1.215330 0.231616 0.653215 -0.079848 1.147198 0.522561 1.074244 1.189158 0.024016 1.002127 1.145705 1.183921 1.636771 0.398476 0.358443 -0.058263 0.246181 0.942683 0.482681 1.823368 1.038771 0.798364 0.979012 1.260203 1.008839 0.331481 1.329527 0.889282 0.388705 0.378727 1.394091 0.860317 0.191774 1.792101 0.682065 0.246000 -0.121897 -0.155296 1.603714 0.392748 1.177859 1.362462 1.085317 1.557823 1.337471 1.045764 -0.299177 0.095852 1.207771 1.749557 1.574722 1.798042 0.795838 1.277804 -0.046897 0.399079 -0.477065 0.322241 1.436449 0.774690 0.635047 0.952898 0.197693 0.020089 0.072586 0.105711 -0.061722)
+ 13.484289 #r(0.000000 0.995043 1.654854 0.951488 -0.186960 0.850693 -0.104052 1.791806 0.632389 0.741244 0.372539 0.536429 1.585222 1.564873 0.754743 1.533715 1.436886 0.265913 1.082971 1.345237 0.422609 1.896766 1.047262 -0.941259 1.315104 1.247825 1.012008 0.626763 -0.163895 1.147771 1.361070 0.089508 0.489357 -0.001980 0.747126 1.129161 1.312043 1.244841 0.335129 1.099634 1.435470 0.558588 1.594865 1.187385 1.215330 0.231616 0.653215 -0.079848 1.147198 0.522561 1.074244 1.189158 0.024016 1.002127 1.145705 1.183921 1.636771 0.398476 0.358443 -0.058263 0.246181 0.942683 0.482681 1.823368 1.038771 0.798364 0.979012 1.260203 1.008839 0.331481 1.329527 0.889282 0.388705 0.378727 1.394091 0.860317 0.191774 1.792101 0.682065 0.246000 -0.121897 -0.155296 1.603714 0.392748 1.177859 1.362462 1.085317 1.557823 1.337471 1.045764 -0.299177 0.095852 1.207771 1.749557 1.574722 1.798042 0.795838 1.277804 -0.046897 0.399079 -0.477065 0.322241 1.436449 0.774690 0.635047 0.952898 0.197693 0.020089 0.072586 0.105711 -0.061722)
)
;;; 112 prime --------------------------------------------------------------------------------
-(vector 112 16.697049415765 #(0 0 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 1 1 0 0 1 0 1 0 0 0 0 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 1 0 1 1 1)
+(vector 112 16.697049415765 #r(0 0 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 1 1 0 0 1 0 1 0 0 0 0 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 1 0 1 1 1)
- 13.804835 #(0.000000 0.660626 0.012013 1.067055 1.731382 0.878320 0.900685 1.333334 0.681047 1.863220 1.352916 0.703854 1.515374 0.461716 0.898953 1.919840 0.286167 0.735654 -0.086197 0.617448 0.511110 1.353376 1.062165 1.636012 0.515505 1.399695 1.421287 -0.379478 0.731516 0.180102 1.567557 1.923199 -0.007316 1.368320 1.294564 0.578724 1.657029 0.985867 0.321763 1.643211 0.183594 -0.095598 1.792723 0.880687 0.335377 0.402596 1.614065 0.786600 0.590837 0.174605 0.357314 0.363837 -0.136455 0.186803 1.076928 1.936757 0.633832 1.217976 0.067642 0.078632 0.866945 1.729624 0.916168 1.228002 1.090442 0.162856 0.012895 1.357444 0.829157 1.905883 0.224325 1.392049 1.223672 1.768609 0.413025 0.871017 1.661030 1.831359 0.223665 1.475164 0.272068 0.564210 0.622152 1.113002 0.676345 -0.006078 1.737306 1.187465 0.535707 1.077110 1.810506 1.386823 0.000557 1.452387 1.030585 0.842150 -0.158625 1.174437 0.579578 -0.079023 1.196883 0.846201 0.482764 0.945473 0.701184 0.898505 0.170202 0.481114 0.605193 0.955521 -0.054086 0.358715)
+ 13.804835 #r(0.000000 0.660626 0.012013 1.067055 1.731382 0.878320 0.900685 1.333334 0.681047 1.863220 1.352916 0.703854 1.515374 0.461716 0.898953 1.919840 0.286167 0.735654 -0.086197 0.617448 0.511110 1.353376 1.062165 1.636012 0.515505 1.399695 1.421287 -0.379478 0.731516 0.180102 1.567557 1.923199 -0.007316 1.368320 1.294564 0.578724 1.657029 0.985867 0.321763 1.643211 0.183594 -0.095598 1.792723 0.880687 0.335377 0.402596 1.614065 0.786600 0.590837 0.174605 0.357314 0.363837 -0.136455 0.186803 1.076928 1.936757 0.633832 1.217976 0.067642 0.078632 0.866945 1.729624 0.916168 1.228002 1.090442 0.162856 0.012895 1.357444 0.829157 1.905883 0.224325 1.392049 1.223672 1.768609 0.413025 0.871017 1.661030 1.831359 0.223665 1.475164 0.272068 0.564210 0.622152 1.113002 0.676345 -0.006078 1.737306 1.187465 0.535707 1.077110 1.810506 1.386823 0.000557 1.452387 1.030585 0.842150 -0.158625 1.174437 0.579578 -0.079023 1.196883 0.846201 0.482764 0.945473 0.701184 0.898505 0.170202 0.481114 0.605193 0.955521 -0.054086 0.358715)
;; 111+1
- 13.560854 #(0.000000 0.996200 1.682628 0.999634 -0.183169 0.941340 -0.063380 1.872352 0.588785 0.718316 0.404204 0.564721 1.640073 1.488214 0.688322 1.540833 1.402097 0.325664 1.088557 1.271965 0.430614 -0.023931 1.082172 -0.819505 1.289052 1.272358 1.016703 0.615500 -0.063492 1.173776 1.419856 0.160057 0.471424 0.025687 0.794626 1.093604 1.347648 1.313640 0.365769 1.198433 1.539259 0.590650 1.625522 1.236869 1.255735 0.261849 0.614310 -0.133810 1.106507 0.525198 1.040282 1.242100 -0.009151 0.940124 1.120632 1.244098 1.583333 0.484225 0.270298 -0.091909 0.275038 0.915341 0.498191 1.846447 1.147765 0.805686 0.960525 1.293095 0.980148 0.249336 1.277364 0.859717 0.447170 0.347316 1.500244 0.749545 0.120155 1.639932 0.628998 0.242589 -0.052482 -0.149374 1.587211 0.461604 1.136482 1.323997 1.019660 1.587802 1.220439 1.097627 -0.381422 0.113408 1.209314 1.808025 1.585895 1.749582 0.823561 1.289475 0.074159 0.350519 -0.613785 0.308515 1.554187 0.783853 0.541355 0.955629 0.179584 0.128995 -0.001165 0.025208 -0.107472 -0.097625)
+ 13.560854 #r(0.000000 0.996200 1.682628 0.999634 -0.183169 0.941340 -0.063380 1.872352 0.588785 0.718316 0.404204 0.564721 1.640073 1.488214 0.688322 1.540833 1.402097 0.325664 1.088557 1.271965 0.430614 -0.023931 1.082172 -0.819505 1.289052 1.272358 1.016703 0.615500 -0.063492 1.173776 1.419856 0.160057 0.471424 0.025687 0.794626 1.093604 1.347648 1.313640 0.365769 1.198433 1.539259 0.590650 1.625522 1.236869 1.255735 0.261849 0.614310 -0.133810 1.106507 0.525198 1.040282 1.242100 -0.009151 0.940124 1.120632 1.244098 1.583333 0.484225 0.270298 -0.091909 0.275038 0.915341 0.498191 1.846447 1.147765 0.805686 0.960525 1.293095 0.980148 0.249336 1.277364 0.859717 0.447170 0.347316 1.500244 0.749545 0.120155 1.639932 0.628998 0.242589 -0.052482 -0.149374 1.587211 0.461604 1.136482 1.323997 1.019660 1.587802 1.220439 1.097627 -0.381422 0.113408 1.209314 1.808025 1.585895 1.749582 0.823561 1.289475 0.074159 0.350519 -0.613785 0.308515 1.554187 0.783853 0.541355 0.955629 0.179584 0.128995 -0.001165 0.025208 -0.107472 -0.097625)
)
;;; 113 prime --------------------------------------------------------------------------------
-(vector 113 16.203890830538 #(0 1 0 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 0 1 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 1 0 0 0 1 0 1)
+(vector 113 16.203890830538 #r(0 1 0 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 0 1 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 1 0 0 0 1 0 1)
- 13.613456 #(0.000000 0.554013 -0.189590 1.040342 1.895741 0.972257 1.983763 0.925350 1.413107 1.187039 0.890581 -0.092527 0.648924 0.275297 1.034974 0.578278 1.412961 1.217860 0.290211 0.146756 1.277989 1.797973 1.243546 0.309623 0.588952 0.766281 1.732300 0.158146 0.970241 1.057713 0.155581 0.740347 -0.278224 0.813051 0.090610 1.633987 0.141253 1.362430 1.811341 0.106172 0.560908 0.975141 0.414465 1.325189 1.317848 1.670918 1.310037 0.138103 1.544695 0.427642 0.688876 1.115251 0.104011 1.249484 1.283379 -0.217415 1.248803 -0.055143 1.377781 1.794050 -0.051929 -0.190679 -0.001958 1.872135 1.015649 0.017838 -0.117121 0.829495 -0.198380 0.905735 0.272607 0.619166 1.647347 0.816228 0.007369 0.650952 0.045714 0.308454 0.434057 0.201848 1.245915 0.933121 1.619736 1.351637 0.362509 1.868147 1.070766 1.188359 0.400988 0.049686 0.087230 0.628970 0.077489 1.262876 0.220162 0.869503 1.130712 0.267514 1.396227 1.721653 1.550102 1.446927 1.155950 0.841581 0.384623 1.977430 1.631746 0.006140 0.715062 1.236385 1.051311 0.995413 0.371400)
+ 13.613456 #r(0.000000 0.554013 -0.189590 1.040342 1.895741 0.972257 1.983763 0.925350 1.413107 1.187039 0.890581 -0.092527 0.648924 0.275297 1.034974 0.578278 1.412961 1.217860 0.290211 0.146756 1.277989 1.797973 1.243546 0.309623 0.588952 0.766281 1.732300 0.158146 0.970241 1.057713 0.155581 0.740347 -0.278224 0.813051 0.090610 1.633987 0.141253 1.362430 1.811341 0.106172 0.560908 0.975141 0.414465 1.325189 1.317848 1.670918 1.310037 0.138103 1.544695 0.427642 0.688876 1.115251 0.104011 1.249484 1.283379 -0.217415 1.248803 -0.055143 1.377781 1.794050 -0.051929 -0.190679 -0.001958 1.872135 1.015649 0.017838 -0.117121 0.829495 -0.198380 0.905735 0.272607 0.619166 1.647347 0.816228 0.007369 0.650952 0.045714 0.308454 0.434057 0.201848 1.245915 0.933121 1.619736 1.351637 0.362509 1.868147 1.070766 1.188359 0.400988 0.049686 0.087230 0.628970 0.077489 1.262876 0.220162 0.869503 1.130712 0.267514 1.396227 1.721653 1.550102 1.446927 1.155950 0.841581 0.384623 1.977430 1.631746 0.006140 0.715062 1.236385 1.051311 0.995413 0.371400)
)
;;; 114 prime --------------------------------------------------------------------------------
-(vector 114 16.442732865586 #(0 0 1 1 0 0 1 1 0 0 0 0 1 1 1 0 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 1 0 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 1)
+(vector 114 16.442732865586 #r(0 0 1 1 0 0 1 1 0 0 0 0 1 1 1 0 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 1 0 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 1)
- 14.166020 #(0.000000 1.038356 0.826275 1.128674 -0.125090 1.829063 1.262013 1.160559 1.519516 1.502014 1.857796 1.525394 0.946893 1.361851 0.493317 1.621550 0.040839 0.825455 1.881008 1.165270 1.273827 0.159303 1.756090 1.393155 1.413051 0.957215 0.252091 1.226129 -0.094317 0.742943 1.002043 1.336572 1.592258 -0.082802 1.594640 0.366562 0.390860 1.427038 1.739079 0.663205 0.933325 1.484965 0.194283 0.375410 0.493300 0.605961 1.748551 0.279636 1.804517 0.357640 0.998348 0.681772 0.367098 0.467866 1.810315 1.933552 1.894370 1.189828 1.415118 1.834729 1.938426 1.415450 0.009074 1.747634 1.249287 0.770928 -0.115261 1.409451 1.246513 0.675514 1.266338 1.477875 -0.114148 0.185420 0.629532 1.098645 0.874254 0.446592 0.243371 0.516051 1.248852 0.028651 -0.007127 1.709807 1.312205 0.257361 1.279674 0.901557 0.855388 1.469222 1.328726 1.208217 1.433035 1.922664 0.274941 0.148828 0.367238 -0.254062 1.751340 0.773665 1.053171 0.567664 1.773987 1.113690 1.183578 1.066952 0.102607 0.071815 1.625657 1.255723 1.028659 0.085305 0.356288 0.418655)
+ 14.166020 #r(0.000000 1.038356 0.826275 1.128674 -0.125090 1.829063 1.262013 1.160559 1.519516 1.502014 1.857796 1.525394 0.946893 1.361851 0.493317 1.621550 0.040839 0.825455 1.881008 1.165270 1.273827 0.159303 1.756090 1.393155 1.413051 0.957215 0.252091 1.226129 -0.094317 0.742943 1.002043 1.336572 1.592258 -0.082802 1.594640 0.366562 0.390860 1.427038 1.739079 0.663205 0.933325 1.484965 0.194283 0.375410 0.493300 0.605961 1.748551 0.279636 1.804517 0.357640 0.998348 0.681772 0.367098 0.467866 1.810315 1.933552 1.894370 1.189828 1.415118 1.834729 1.938426 1.415450 0.009074 1.747634 1.249287 0.770928 -0.115261 1.409451 1.246513 0.675514 1.266338 1.477875 -0.114148 0.185420 0.629532 1.098645 0.874254 0.446592 0.243371 0.516051 1.248852 0.028651 -0.007127 1.709807 1.312205 0.257361 1.279674 0.901557 0.855388 1.469222 1.328726 1.208217 1.433035 1.922664 0.274941 0.148828 0.367238 -0.254062 1.751340 0.773665 1.053171 0.567664 1.773987 1.113690 1.183578 1.066952 0.102607 0.071815 1.625657 1.255723 1.028659 0.085305 0.356288 0.418655)
;; 113+1
- 13.529505 #(0.000000 0.609603 -0.150717 1.144620 1.885952 1.029695 -0.017328 1.023651 1.375935 1.049542 0.876959 -0.157071 0.712430 0.086142 1.092731 0.678537 1.443976 1.204147 0.360088 0.209607 1.268934 1.814390 1.230253 0.384833 0.625288 0.787682 1.706820 0.104070 0.975842 1.091508 0.162798 0.719194 -0.185681 0.851344 0.004406 1.551988 0.158850 1.400167 1.727125 0.074860 0.565161 0.958867 0.364724 1.349213 1.351889 1.679509 1.314199 0.132307 1.403589 0.369532 0.648564 1.160585 -0.009001 1.392847 1.218123 -0.146011 1.322032 -0.127699 1.286444 1.741589 -0.086769 -0.151954 0.062929 1.896116 1.063027 0.005563 -0.069693 0.819283 -0.185224 0.958608 0.217640 0.593867 1.814658 0.753485 -0.046094 0.586286 0.067659 0.127457 0.558174 0.155027 1.389478 0.905687 1.516935 1.472391 0.370204 1.903438 1.085058 1.201428 0.394426 0.093638 0.098055 0.586236 0.108735 1.290199 0.287019 0.975146 1.134274 0.275315 1.391551 1.689333 1.493530 1.402264 1.275785 0.772955 0.474442 0.009426 1.766587 0.112461 0.593436 1.228805 0.896377 1.061049 0.277890 -0.013199)
+ 13.529505 #r(0.000000 0.609603 -0.150717 1.144620 1.885952 1.029695 -0.017328 1.023651 1.375935 1.049542 0.876959 -0.157071 0.712430 0.086142 1.092731 0.678537 1.443976 1.204147 0.360088 0.209607 1.268934 1.814390 1.230253 0.384833 0.625288 0.787682 1.706820 0.104070 0.975842 1.091508 0.162798 0.719194 -0.185681 0.851344 0.004406 1.551988 0.158850 1.400167 1.727125 0.074860 0.565161 0.958867 0.364724 1.349213 1.351889 1.679509 1.314199 0.132307 1.403589 0.369532 0.648564 1.160585 -0.009001 1.392847 1.218123 -0.146011 1.322032 -0.127699 1.286444 1.741589 -0.086769 -0.151954 0.062929 1.896116 1.063027 0.005563 -0.069693 0.819283 -0.185224 0.958608 0.217640 0.593867 1.814658 0.753485 -0.046094 0.586286 0.067659 0.127457 0.558174 0.155027 1.389478 0.905687 1.516935 1.472391 0.370204 1.903438 1.085058 1.201428 0.394426 0.093638 0.098055 0.586236 0.108735 1.290199 0.287019 0.975146 1.134274 0.275315 1.391551 1.689333 1.493530 1.402264 1.275785 0.772955 0.474442 0.009426 1.766587 0.112461 0.593436 1.228805 0.896377 1.061049 0.277890 -0.013199)
)
;;; 115 prime --------------------------------------------------------------------------------
-(vector 115 16.774665887963 #(0 1 0 0 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 1 1 0 1 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 1 1 0 1 0)
+(vector 115 16.774665887963 #r(0 1 0 0 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 1 1 0 1 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 1 1 0 1 0)
- 14.106616 #(0.000000 1.570092 0.362453 1.337474 0.264875 0.921400 0.355874 1.476538 0.382397 0.690102 0.627233 1.283297 1.585161 0.461353 0.250428 0.070613 -0.478768 0.954888 0.726879 1.251951 0.417891 0.945598 0.563852 0.084589 0.533104 0.472131 1.084144 1.608792 0.044337 1.518184 0.783171 0.484129 1.900804 -0.149622 0.399475 1.517825 0.218983 1.531509 -0.230530 0.567148 1.520162 -0.082961 1.681948 0.292123 0.756368 0.448131 1.473802 1.014666 -0.012646 1.572834 1.242744 0.425093 -0.031699 0.769537 1.112143 1.298398 0.333581 1.945824 -0.101577 1.894990 1.397266 1.272345 1.210062 1.810802 0.715502 0.534600 1.359024 1.288083 -0.103335 0.078475 0.156596 1.496646 1.076856 0.312782 0.361663 1.568537 1.496774 0.979145 1.697729 0.843520 0.130906 1.341892 0.946201 1.950539 0.684184 1.344931 0.821452 1.479748 1.308019 0.296269 1.793184 0.500147 0.839533 0.057599 0.886809 0.752434 1.587024 1.203157 1.022448 0.212093 1.492893 0.209714 0.165780 1.402030 -0.307350 0.474032 1.513784 1.517441 1.459089 1.632203 1.421380 1.032369 0.154966 0.002531 0.304007)
+ 14.106616 #r(0.000000 1.570092 0.362453 1.337474 0.264875 0.921400 0.355874 1.476538 0.382397 0.690102 0.627233 1.283297 1.585161 0.461353 0.250428 0.070613 -0.478768 0.954888 0.726879 1.251951 0.417891 0.945598 0.563852 0.084589 0.533104 0.472131 1.084144 1.608792 0.044337 1.518184 0.783171 0.484129 1.900804 -0.149622 0.399475 1.517825 0.218983 1.531509 -0.230530 0.567148 1.520162 -0.082961 1.681948 0.292123 0.756368 0.448131 1.473802 1.014666 -0.012646 1.572834 1.242744 0.425093 -0.031699 0.769537 1.112143 1.298398 0.333581 1.945824 -0.101577 1.894990 1.397266 1.272345 1.210062 1.810802 0.715502 0.534600 1.359024 1.288083 -0.103335 0.078475 0.156596 1.496646 1.076856 0.312782 0.361663 1.568537 1.496774 0.979145 1.697729 0.843520 0.130906 1.341892 0.946201 1.950539 0.684184 1.344931 0.821452 1.479748 1.308019 0.296269 1.793184 0.500147 0.839533 0.057599 0.886809 0.752434 1.587024 1.203157 1.022448 0.212093 1.492893 0.209714 0.165780 1.402030 -0.307350 0.474032 1.513784 1.517441 1.459089 1.632203 1.421380 1.032369 0.154966 0.002531 0.304007)
;; 114+1
- 13.732359 #(0.000000 0.572178 -0.139025 0.983887 1.920434 1.123578 1.978353 0.968214 1.349051 1.117228 0.839675 -0.190533 0.694004 0.125250 1.107764 0.641260 1.405169 1.199788 0.276763 0.250348 1.204416 1.682914 1.257883 0.312057 0.695310 0.801198 1.682635 0.125698 0.950119 1.070718 0.245730 0.776193 -0.167540 0.949181 -0.042356 1.548062 0.106820 1.334788 1.742804 0.109905 0.567469 0.997715 0.375385 1.298162 1.314791 1.688434 1.235156 0.141282 1.427214 0.400188 0.631107 1.144708 -0.003109 1.362927 1.143332 -0.234998 1.276203 -0.143654 1.307422 1.689156 -0.014380 -0.262664 0.075462 1.880295 1.062640 0.101776 -0.026648 0.801460 -0.217311 0.971985 0.270988 0.672521 1.816202 0.778522 0.051104 0.549038 0.052885 0.201837 0.612616 0.180579 1.355932 0.900040 1.595492 1.482393 0.476525 1.886230 0.983641 1.114556 0.404677 0.048952 0.080076 0.569993 0.080539 1.262764 0.266797 0.946313 1.101489 0.203645 1.377876 1.725578 1.491484 1.434839 1.127583 0.826060 0.448266 0.008333 1.780636 0.098825 0.586600 1.122038 0.995066 1.017216 0.354291 0.057246 0.069092)
+ 13.732359 #r(0.000000 0.572178 -0.139025 0.983887 1.920434 1.123578 1.978353 0.968214 1.349051 1.117228 0.839675 -0.190533 0.694004 0.125250 1.107764 0.641260 1.405169 1.199788 0.276763 0.250348 1.204416 1.682914 1.257883 0.312057 0.695310 0.801198 1.682635 0.125698 0.950119 1.070718 0.245730 0.776193 -0.167540 0.949181 -0.042356 1.548062 0.106820 1.334788 1.742804 0.109905 0.567469 0.997715 0.375385 1.298162 1.314791 1.688434 1.235156 0.141282 1.427214 0.400188 0.631107 1.144708 -0.003109 1.362927 1.143332 -0.234998 1.276203 -0.143654 1.307422 1.689156 -0.014380 -0.262664 0.075462 1.880295 1.062640 0.101776 -0.026648 0.801460 -0.217311 0.971985 0.270988 0.672521 1.816202 0.778522 0.051104 0.549038 0.052885 0.201837 0.612616 0.180579 1.355932 0.900040 1.595492 1.482393 0.476525 1.886230 0.983641 1.114556 0.404677 0.048952 0.080076 0.569993 0.080539 1.262764 0.266797 0.946313 1.101489 0.203645 1.377876 1.725578 1.491484 1.434839 1.127583 0.826060 0.448266 0.008333 1.780636 0.098825 0.586600 1.122038 0.995066 1.017216 0.354291 0.057246 0.069092)
)
;;; 116 prime --------------------------------------------------------------------------------
-(vector 116 16.812931137234 #(0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 0 1 1 1 0 0)
+(vector 116 16.812931137234 #r(0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 0 1 1 1 0 0)
- 14.328742 #(0.000000 0.856207 0.986788 0.751460 1.884184 1.255896 0.144210 1.208511 0.255866 1.782286 0.019244 0.566742 0.407768 -0.089210 1.344767 1.018853 -0.034882 0.530119 1.597864 0.501326 -0.230774 -0.097023 -0.000389 0.665472 1.635375 1.228232 1.206358 0.850292 0.888987 0.993112 0.654339 0.818974 0.003413 1.565831 0.042608 0.878547 0.321526 0.088958 0.292372 -0.331777 0.700821 0.894714 0.005944 -0.346944 0.114845 1.049758 0.798720 0.790858 0.117448 1.021841 0.389934 0.399103 0.195343 1.878118 1.577823 0.477002 0.256545 1.229924 -0.002011 0.133077 0.537008 0.396216 0.701816 0.985840 1.738910 0.328555 0.541523 0.876819 0.876185 0.445666 0.685165 1.594949 0.620581 -0.127456 0.921400 0.311110 1.793307 0.275641 1.366815 0.824915 0.239454 0.832837 1.417323 1.769240 0.980992 1.239944 1.591029 -0.051475 1.486421 1.525417 -0.025657 0.653170 1.313243 1.650610 1.580897 1.618532 0.633267 0.393928 1.496919 -0.276408 0.878277 0.281939 0.351152 0.468289 1.618075 1.571369 0.984717 1.909405 0.851519 1.720488 0.929949 1.296555 1.289941 0.911398 0.225491 0.695200)
+ 14.328742 #r(0.000000 0.856207 0.986788 0.751460 1.884184 1.255896 0.144210 1.208511 0.255866 1.782286 0.019244 0.566742 0.407768 -0.089210 1.344767 1.018853 -0.034882 0.530119 1.597864 0.501326 -0.230774 -0.097023 -0.000389 0.665472 1.635375 1.228232 1.206358 0.850292 0.888987 0.993112 0.654339 0.818974 0.003413 1.565831 0.042608 0.878547 0.321526 0.088958 0.292372 -0.331777 0.700821 0.894714 0.005944 -0.346944 0.114845 1.049758 0.798720 0.790858 0.117448 1.021841 0.389934 0.399103 0.195343 1.878118 1.577823 0.477002 0.256545 1.229924 -0.002011 0.133077 0.537008 0.396216 0.701816 0.985840 1.738910 0.328555 0.541523 0.876819 0.876185 0.445666 0.685165 1.594949 0.620581 -0.127456 0.921400 0.311110 1.793307 0.275641 1.366815 0.824915 0.239454 0.832837 1.417323 1.769240 0.980992 1.239944 1.591029 -0.051475 1.486421 1.525417 -0.025657 0.653170 1.313243 1.650610 1.580897 1.618532 0.633267 0.393928 1.496919 -0.276408 0.878277 0.281939 0.351152 0.468289 1.618075 1.571369 0.984717 1.909405 0.851519 1.720488 0.929949 1.296555 1.289941 0.911398 0.225491 0.695200)
;; 115+1
- 13.782751 #(0.000000 1.670105 0.303378 1.514771 0.060477 0.906403 0.370378 1.628880 0.301098 0.717479 0.564448 1.198544 1.701046 0.489974 0.092684 0.106689 -0.600359 0.960290 0.727113 1.181333 0.468036 0.933578 0.612714 0.102105 0.439119 0.536613 0.989488 1.668598 -0.080124 1.683573 0.654250 0.599004 1.870044 -0.069895 0.298556 1.555710 0.285805 1.565873 -0.205135 0.563645 1.519179 -0.152285 1.687696 0.402404 0.955645 0.241673 1.401865 1.046960 -0.019116 1.640885 1.197901 0.505391 0.095168 0.718441 1.181463 1.406618 0.309258 1.952979 -0.107329 1.969648 1.502137 1.090118 1.043918 1.702710 0.780485 0.583772 1.473922 1.490931 -0.163373 0.133574 0.135840 1.533071 1.015158 0.398692 0.320450 1.364722 1.538313 0.970480 1.636937 0.963390 0.136800 1.340905 1.204598 0.054477 0.486418 1.417827 0.808183 1.530254 1.191144 0.320075 1.853919 0.467453 0.809752 0.120164 0.781600 0.697424 1.379599 1.216021 0.948183 0.099657 1.566373 0.116729 -0.093843 1.319423 -0.420543 0.691568 1.660724 1.496943 1.401099 1.619305 1.446415 0.867038 0.105822 0.158044 0.282349 -0.011943)
+ 13.782751 #r(0.000000 1.670105 0.303378 1.514771 0.060477 0.906403 0.370378 1.628880 0.301098 0.717479 0.564448 1.198544 1.701046 0.489974 0.092684 0.106689 -0.600359 0.960290 0.727113 1.181333 0.468036 0.933578 0.612714 0.102105 0.439119 0.536613 0.989488 1.668598 -0.080124 1.683573 0.654250 0.599004 1.870044 -0.069895 0.298556 1.555710 0.285805 1.565873 -0.205135 0.563645 1.519179 -0.152285 1.687696 0.402404 0.955645 0.241673 1.401865 1.046960 -0.019116 1.640885 1.197901 0.505391 0.095168 0.718441 1.181463 1.406618 0.309258 1.952979 -0.107329 1.969648 1.502137 1.090118 1.043918 1.702710 0.780485 0.583772 1.473922 1.490931 -0.163373 0.133574 0.135840 1.533071 1.015158 0.398692 0.320450 1.364722 1.538313 0.970480 1.636937 0.963390 0.136800 1.340905 1.204598 0.054477 0.486418 1.417827 0.808183 1.530254 1.191144 0.320075 1.853919 0.467453 0.809752 0.120164 0.781600 0.697424 1.379599 1.216021 0.948183 0.099657 1.566373 0.116729 -0.093843 1.319423 -0.420543 0.691568 1.660724 1.496943 1.401099 1.619305 1.446415 0.867038 0.105822 0.158044 0.282349 -0.011943)
)
;;; 117 prime --------------------------------------------------------------------------------
-(vector 117 17.5997 #(0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 1 0 0 0 0 1 0 1 0 1 1 1 1 1 0 1 0 1 0 0 1 0 1 0 1 1 0 1 0 1 1 0 1 1 0 1 1 1 1 0 0 1)
+(vector 117 17.5997 #r(0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 1 0 0 0 0 1 0 1 0 1 1 1 1 1 0 1 0 1 0 0 1 0 1 0 1 1 0 1 0 1 1 0 1 1 0 1 1 1 1 0 0 1)
- 14.497812 #(0.000000 0.224426 0.992019 0.138711 1.176503 1.236445 0.315077 1.906428 0.448900 0.678218 -0.088951 0.205668 0.157937 1.760779 0.121986 1.314615 1.230068 1.510274 1.468208 1.579772 0.156575 1.223695 1.547174 0.976223 0.294979 0.682844 1.254567 0.255930 0.581609 0.421918 0.606116 0.691338 0.828316 1.627063 1.800785 0.001165 -0.086581 0.763116 0.639955 0.291470 1.735899 0.422553 0.362144 1.186351 1.590842 0.426463 0.245182 0.967296 0.891425 0.519158 0.866605 1.346855 0.815662 0.075921 1.039570 1.274467 1.634408 1.602113 1.536366 0.552713 0.810604 0.673899 0.744845 0.479678 1.304967 1.905715 1.460213 0.317282 1.748084 -0.013722 -1.881692 0.174856 -0.080552 1.785033 0.698053 0.094949 0.417990 0.698446 0.985481 1.584075 1.403772 0.388703 0.009472 1.646671 1.128281 1.234472 1.443078 1.392782 1.271405 0.499301 0.604344 -0.127230 1.264738 1.785688 0.416206 1.113044 0.215095 1.469439 0.236533 0.117496 0.271632 1.034059 1.537681 0.722701 1.631698 0.103905 0.435634 0.027785 0.196356 1.018099 1.623844 0.142536 1.403226 -0.013797 0.598011 1.913682 0.626571)
+ 14.497812 #r(0.000000 0.224426 0.992019 0.138711 1.176503 1.236445 0.315077 1.906428 0.448900 0.678218 -0.088951 0.205668 0.157937 1.760779 0.121986 1.314615 1.230068 1.510274 1.468208 1.579772 0.156575 1.223695 1.547174 0.976223 0.294979 0.682844 1.254567 0.255930 0.581609 0.421918 0.606116 0.691338 0.828316 1.627063 1.800785 0.001165 -0.086581 0.763116 0.639955 0.291470 1.735899 0.422553 0.362144 1.186351 1.590842 0.426463 0.245182 0.967296 0.891425 0.519158 0.866605 1.346855 0.815662 0.075921 1.039570 1.274467 1.634408 1.602113 1.536366 0.552713 0.810604 0.673899 0.744845 0.479678 1.304967 1.905715 1.460213 0.317282 1.748084 -0.013722 -1.881692 0.174856 -0.080552 1.785033 0.698053 0.094949 0.417990 0.698446 0.985481 1.584075 1.403772 0.388703 0.009472 1.646671 1.128281 1.234472 1.443078 1.392782 1.271405 0.499301 0.604344 -0.127230 1.264738 1.785688 0.416206 1.113044 0.215095 1.469439 0.236533 0.117496 0.271632 1.034059 1.537681 0.722701 1.631698 0.103905 0.435634 0.027785 0.196356 1.018099 1.623844 0.142536 1.403226 -0.013797 0.598011 1.913682 0.626571)
;; 116 + 1
- 13.889211 #(0.000000 1.679442 0.299199 1.367111 0.052770 0.927297 0.328215 1.615881 0.302404 0.707696 0.516039 1.151316 1.673258 0.534217 0.190986 0.074151 -0.598397 0.913919 0.765928 1.260413 0.423264 1.023745 0.609735 0.153506 0.453539 0.468256 1.018228 1.788765 -0.068307 1.692855 0.624116 0.609141 1.910624 -0.022395 0.256365 1.514074 0.233219 1.516754 -0.154609 0.590788 1.514050 -0.043651 1.742187 0.341087 0.951970 0.371363 1.447587 1.079612 0.057107 1.623815 1.214707 0.567773 0.057804 0.791128 1.221209 1.383201 0.340554 -0.013292 -0.005609 1.947264 1.370803 1.062963 1.024336 1.739421 0.767066 0.671699 1.426918 1.511148 -0.149781 0.104225 0.061945 1.535119 0.940075 0.392689 0.259023 1.411809 1.598917 0.941897 1.683270 0.884953 0.108874 1.319701 1.100749 -0.050961 0.639728 1.429813 0.861586 1.511163 1.232212 0.240917 1.860927 0.406637 0.844627 0.125914 0.873615 0.651653 1.385473 1.135755 0.994702 0.030143 1.590457 0.161005 0.055154 1.334956 -0.459106 0.663912 1.678280 1.514956 1.365867 1.519273 1.441132 0.891112 0.176832 0.115181 0.351957 -0.175561 0.176948)
+ 13.889211 #r(0.000000 1.679442 0.299199 1.367111 0.052770 0.927297 0.328215 1.615881 0.302404 0.707696 0.516039 1.151316 1.673258 0.534217 0.190986 0.074151 -0.598397 0.913919 0.765928 1.260413 0.423264 1.023745 0.609735 0.153506 0.453539 0.468256 1.018228 1.788765 -0.068307 1.692855 0.624116 0.609141 1.910624 -0.022395 0.256365 1.514074 0.233219 1.516754 -0.154609 0.590788 1.514050 -0.043651 1.742187 0.341087 0.951970 0.371363 1.447587 1.079612 0.057107 1.623815 1.214707 0.567773 0.057804 0.791128 1.221209 1.383201 0.340554 -0.013292 -0.005609 1.947264 1.370803 1.062963 1.024336 1.739421 0.767066 0.671699 1.426918 1.511148 -0.149781 0.104225 0.061945 1.535119 0.940075 0.392689 0.259023 1.411809 1.598917 0.941897 1.683270 0.884953 0.108874 1.319701 1.100749 -0.050961 0.639728 1.429813 0.861586 1.511163 1.232212 0.240917 1.860927 0.406637 0.844627 0.125914 0.873615 0.651653 1.385473 1.135755 0.994702 0.030143 1.590457 0.161005 0.055154 1.334956 -0.459106 0.663912 1.678280 1.514956 1.365867 1.519273 1.441132 0.891112 0.176832 0.115181 0.351957 -0.175561 0.176948)
)
;;; 118 prime --------------------------------------------------------------------------------
-(vector 118 17.181785583496 #(0 0 0 1 0 0 1 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 1 0 0 0 0 1 1 0 1 1 1 0 0 0 1 1 0 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 1 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 1 0 0 1 0 1 0)
+(vector 118 17.181785583496 #r(0 0 0 1 0 0 1 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 1 0 0 0 0 1 1 0 1 1 1 0 0 0 1 1 0 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 1 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 1 0 0 1 0 1 0)
- 14.497443 #(0.000000 1.591354 0.741888 1.722967 -0.237709 0.685421 0.503550 1.254854 0.808656 0.911251 0.050157 0.861734 0.314280 1.341176 0.379991 0.875641 1.466708 0.300573 0.954767 1.385324 0.125132 0.348374 0.577011 1.655837 0.564307 0.582376 1.167510 0.907420 0.444532 0.218679 1.737312 0.252903 0.411946 1.083113 -0.185163 0.978023 -0.109963 1.511202 0.503851 1.662809 0.033875 0.523452 0.521481 0.883976 -0.357599 0.187161 0.880047 1.490736 0.844255 0.801313 0.683070 1.279258 1.624126 0.834042 1.570571 1.331665 0.812207 0.082063 -0.178779 0.727851 0.635760 0.472598 0.529740 1.710166 0.757477 0.262267 0.672628 0.403198 0.034164 -0.022037 0.130101 1.350219 1.105735 1.695932 0.323683 1.252068 0.744970 1.161905 1.322245 0.994864 0.697837 1.637816 0.396302 1.702348 -0.270747 -0.077800 0.225947 1.713037 1.228521 1.665048 1.679022 1.393803 0.704244 0.296414 -0.016270 0.947613 1.856633 1.384283 0.527416 0.984409 1.396798 0.351021 0.292270 0.549569 1.663499 0.778229 0.016680 1.156232 0.122381 0.159439 0.648535 0.193057 0.084166 -0.213455 0.477204 0.673154 0.992874 0.783540)
+ 14.497443 #r(0.000000 1.591354 0.741888 1.722967 -0.237709 0.685421 0.503550 1.254854 0.808656 0.911251 0.050157 0.861734 0.314280 1.341176 0.379991 0.875641 1.466708 0.300573 0.954767 1.385324 0.125132 0.348374 0.577011 1.655837 0.564307 0.582376 1.167510 0.907420 0.444532 0.218679 1.737312 0.252903 0.411946 1.083113 -0.185163 0.978023 -0.109963 1.511202 0.503851 1.662809 0.033875 0.523452 0.521481 0.883976 -0.357599 0.187161 0.880047 1.490736 0.844255 0.801313 0.683070 1.279258 1.624126 0.834042 1.570571 1.331665 0.812207 0.082063 -0.178779 0.727851 0.635760 0.472598 0.529740 1.710166 0.757477 0.262267 0.672628 0.403198 0.034164 -0.022037 0.130101 1.350219 1.105735 1.695932 0.323683 1.252068 0.744970 1.161905 1.322245 0.994864 0.697837 1.637816 0.396302 1.702348 -0.270747 -0.077800 0.225947 1.713037 1.228521 1.665048 1.679022 1.393803 0.704244 0.296414 -0.016270 0.947613 1.856633 1.384283 0.527416 0.984409 1.396798 0.351021 0.292270 0.549569 1.663499 0.778229 0.016680 1.156232 0.122381 0.159439 0.648535 0.193057 0.084166 -0.213455 0.477204 0.673154 0.992874 0.783540)
;; 117+1
- 13.955663 #(0.000000 1.656893 0.312860 1.406022 0.045609 0.940726 0.323204 1.558622 0.313593 0.699110 0.536076 1.119751 1.657613 0.469730 0.215020 0.137907 -0.614064 0.902352 0.821797 1.171991 0.441310 1.059221 0.661850 0.277594 0.394536 0.546400 0.968850 1.793240 -0.073575 1.622506 0.677941 0.641837 1.952355 -0.044282 0.215122 1.490798 0.302768 1.506837 -0.235108 0.508030 1.520891 -0.097109 1.755394 0.256002 1.007243 0.327520 1.464098 1.079175 0.017892 1.590910 1.290254 0.601225 -0.032662 0.654468 1.229419 1.312262 0.353655 -0.032649 0.034883 1.896617 1.433210 1.047605 1.126390 1.674282 0.764405 0.618210 1.508232 1.671380 -0.173491 0.106521 0.149565 1.507742 0.949278 0.443666 0.317362 1.314645 1.634673 0.873102 1.588608 0.915021 0.172843 1.351037 1.151673 -0.042685 0.619993 1.550214 0.823729 1.429222 1.211772 0.248747 1.864022 0.374155 0.849134 0.123908 0.792603 0.736151 1.435290 1.198233 1.078587 0.058874 1.626102 0.122469 0.017624 1.330950 -0.499655 0.706598 1.629594 1.438050 1.370171 1.549897 1.430173 0.915025 0.119087 0.070759 0.413439 -0.125417 0.236481 -0.031842)
+ 13.955663 #r(0.000000 1.656893 0.312860 1.406022 0.045609 0.940726 0.323204 1.558622 0.313593 0.699110 0.536076 1.119751 1.657613 0.469730 0.215020 0.137907 -0.614064 0.902352 0.821797 1.171991 0.441310 1.059221 0.661850 0.277594 0.394536 0.546400 0.968850 1.793240 -0.073575 1.622506 0.677941 0.641837 1.952355 -0.044282 0.215122 1.490798 0.302768 1.506837 -0.235108 0.508030 1.520891 -0.097109 1.755394 0.256002 1.007243 0.327520 1.464098 1.079175 0.017892 1.590910 1.290254 0.601225 -0.032662 0.654468 1.229419 1.312262 0.353655 -0.032649 0.034883 1.896617 1.433210 1.047605 1.126390 1.674282 0.764405 0.618210 1.508232 1.671380 -0.173491 0.106521 0.149565 1.507742 0.949278 0.443666 0.317362 1.314645 1.634673 0.873102 1.588608 0.915021 0.172843 1.351037 1.151673 -0.042685 0.619993 1.550214 0.823729 1.429222 1.211772 0.248747 1.864022 0.374155 0.849134 0.123908 0.792603 0.736151 1.435290 1.198233 1.078587 0.058874 1.626102 0.122469 0.017624 1.330950 -0.499655 0.706598 1.629594 1.438050 1.370171 1.549897 1.430173 0.915025 0.119087 0.070759 0.413439 -0.125417 0.236481 -0.031842)
)
;;; 119 prime --------------------------------------------------------------------------------
-(vector 119 17.167841346875 #(0 1 0 1 1 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1)
+(vector 119 17.167841346875 #r(0 1 0 1 1 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1)
- 14.390682 #(0.000000 1.375664 1.071878 1.242281 0.449872 0.997239 0.326902 1.844870 0.041292 1.299611 1.550408 0.729190 0.953350 0.209856 0.257680 0.853205 0.858641 1.807278 0.814295 0.490323 1.317949 0.220101 1.124178 0.689692 0.845713 1.610142 0.807190 0.053107 0.167263 1.261235 1.535767 1.158168 0.246566 1.099513 1.210170 1.481156 0.887639 1.096230 0.144442 0.446125 0.627726 -0.213400 0.869947 0.988021 1.647446 0.493250 1.672678 1.658411 -0.130924 1.196700 0.900590 0.905506 1.144054 1.144682 1.583644 1.532418 1.405419 1.861571 1.337158 1.938890 1.060547 0.949400 1.139259 1.324089 1.811791 1.700889 0.580433 -0.043873 0.685223 0.393731 1.345217 0.593893 0.307423 0.675865 1.845148 0.894101 0.377727 1.240396 0.150868 0.234381 0.772691 0.408668 1.155960 1.889975 0.784676 1.158424 1.614216 1.924591 0.178912 0.577105 0.980476 1.603643 0.495073 -0.104468 1.507041 0.927685 1.105445 1.078554 0.022413 0.000361 0.338859 1.519222 0.863311 0.615320 0.570559 1.762687 0.669024 0.026456 1.421100 1.955221 0.629611 -0.125129 1.900181 -0.021163 -0.020189 1.567842 0.924421 1.826999 0.630355)
+ 14.390682 #r(0.000000 1.375664 1.071878 1.242281 0.449872 0.997239 0.326902 1.844870 0.041292 1.299611 1.550408 0.729190 0.953350 0.209856 0.257680 0.853205 0.858641 1.807278 0.814295 0.490323 1.317949 0.220101 1.124178 0.689692 0.845713 1.610142 0.807190 0.053107 0.167263 1.261235 1.535767 1.158168 0.246566 1.099513 1.210170 1.481156 0.887639 1.096230 0.144442 0.446125 0.627726 -0.213400 0.869947 0.988021 1.647446 0.493250 1.672678 1.658411 -0.130924 1.196700 0.900590 0.905506 1.144054 1.144682 1.583644 1.532418 1.405419 1.861571 1.337158 1.938890 1.060547 0.949400 1.139259 1.324089 1.811791 1.700889 0.580433 -0.043873 0.685223 0.393731 1.345217 0.593893 0.307423 0.675865 1.845148 0.894101 0.377727 1.240396 0.150868 0.234381 0.772691 0.408668 1.155960 1.889975 0.784676 1.158424 1.614216 1.924591 0.178912 0.577105 0.980476 1.603643 0.495073 -0.104468 1.507041 0.927685 1.105445 1.078554 0.022413 0.000361 0.338859 1.519222 0.863311 0.615320 0.570559 1.762687 0.669024 0.026456 1.421100 1.955221 0.629611 -0.125129 1.900181 -0.021163 -0.020189 1.567842 0.924421 1.826999 0.630355)
;; 118+1
- 14.018618 #(0.000000 1.667367 0.322872 1.356274 0.058995 0.960979 0.391067 1.596203 0.294396 0.668831 0.482386 1.201983 1.684789 0.511518 0.202150 0.119421 -0.566103 0.969879 0.710276 1.185777 0.439002 1.081943 0.730732 0.236637 0.526675 0.480731 1.028367 1.739731 -0.138846 1.593254 0.713861 0.553938 1.957692 0.049573 0.238503 1.491899 0.251089 1.428730 -0.126673 0.452175 1.482756 -0.053077 1.780248 0.323594 0.960159 0.318559 1.403830 1.045323 0.072970 1.671965 1.340192 0.627012 0.093313 0.726626 1.260031 1.369364 0.271099 0.039064 -0.011301 1.960494 1.463622 1.056374 1.121811 1.627859 0.817517 0.663209 1.409881 1.612732 -0.152806 0.038886 0.274896 1.521348 0.915556 0.404329 0.221685 1.199737 1.694611 0.915335 1.572323 0.961485 0.112089 1.311173 1.127868 -0.177640 0.609597 1.415894 0.807680 1.506084 1.239635 0.162405 1.866700 0.317949 0.857946 0.112683 0.879435 0.694750 1.339170 1.270491 1.111213 0.092592 1.497893 0.151420 0.069449 1.319832 -0.496262 0.680555 1.680836 1.536147 1.322680 1.555058 1.410956 0.888418 0.228998 0.018175 0.403145 -0.128572 0.219741 -0.075154 -0.155224)
+ 14.018618 #r(0.000000 1.667367 0.322872 1.356274 0.058995 0.960979 0.391067 1.596203 0.294396 0.668831 0.482386 1.201983 1.684789 0.511518 0.202150 0.119421 -0.566103 0.969879 0.710276 1.185777 0.439002 1.081943 0.730732 0.236637 0.526675 0.480731 1.028367 1.739731 -0.138846 1.593254 0.713861 0.553938 1.957692 0.049573 0.238503 1.491899 0.251089 1.428730 -0.126673 0.452175 1.482756 -0.053077 1.780248 0.323594 0.960159 0.318559 1.403830 1.045323 0.072970 1.671965 1.340192 0.627012 0.093313 0.726626 1.260031 1.369364 0.271099 0.039064 -0.011301 1.960494 1.463622 1.056374 1.121811 1.627859 0.817517 0.663209 1.409881 1.612732 -0.152806 0.038886 0.274896 1.521348 0.915556 0.404329 0.221685 1.199737 1.694611 0.915335 1.572323 0.961485 0.112089 1.311173 1.127868 -0.177640 0.609597 1.415894 0.807680 1.506084 1.239635 0.162405 1.866700 0.317949 0.857946 0.112683 0.879435 0.694750 1.339170 1.270491 1.111213 0.092592 1.497893 0.151420 0.069449 1.319832 -0.496262 0.680555 1.680836 1.536147 1.322680 1.555058 1.410956 0.888418 0.228998 0.018175 0.403145 -0.128572 0.219741 -0.075154 -0.155224)
)
;;; 120 prime --------------------------------------------------------------------------------
-(vector 120 17.067 #(0 1 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 1 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0)
+(vector 120 17.067 #r(0 1 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 1 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0)
- 14.458666 #(0.000000 1.293108 0.698019 1.317447 0.029496 0.078825 1.245576 0.933427 0.917420 1.172126 0.357395 1.156156 0.879865 0.129592 1.181392 0.882110 0.690853 1.687107 0.025873 0.234607 1.243328 0.528035 0.272217 0.646247 0.920540 -0.212257 1.217024 1.877596 1.938817 0.737497 0.901785 1.059044 1.128268 0.954000 0.339889 0.097863 -0.055556 1.539115 0.342970 1.531145 0.894486 1.025619 0.519579 0.900743 0.956748 -0.133937 0.256714 0.139176 0.495069 1.185608 1.684763 0.822374 0.580038 0.873037 1.366028 1.356196 1.900731 0.458911 0.428437 1.433784 -0.025135 1.471236 0.210352 1.314750 0.475084 0.493167 0.205827 0.317580 1.227052 1.530659 1.302191 0.347571 0.409940 0.502737 1.688087 1.230409 1.337757 1.342952 1.903513 0.955786 -0.215055 0.487009 1.948923 1.411678 0.225274 0.421106 0.203875 0.568136 0.977570 1.560054 1.164692 1.211841 0.037236 1.165323 0.284280 0.274360 0.776762 0.207157 -0.008462 -0.022949 0.633618 1.519303 0.349119 1.348337 0.561608 1.136896 0.486384 1.690665 0.939858 1.037942 0.628883 1.115783 0.551269 0.261357 0.835768 0.754522 0.995311 0.736018 1.536035 -0.082119)
+ 14.458666 #r(0.000000 1.293108 0.698019 1.317447 0.029496 0.078825 1.245576 0.933427 0.917420 1.172126 0.357395 1.156156 0.879865 0.129592 1.181392 0.882110 0.690853 1.687107 0.025873 0.234607 1.243328 0.528035 0.272217 0.646247 0.920540 -0.212257 1.217024 1.877596 1.938817 0.737497 0.901785 1.059044 1.128268 0.954000 0.339889 0.097863 -0.055556 1.539115 0.342970 1.531145 0.894486 1.025619 0.519579 0.900743 0.956748 -0.133937 0.256714 0.139176 0.495069 1.185608 1.684763 0.822374 0.580038 0.873037 1.366028 1.356196 1.900731 0.458911 0.428437 1.433784 -0.025135 1.471236 0.210352 1.314750 0.475084 0.493167 0.205827 0.317580 1.227052 1.530659 1.302191 0.347571 0.409940 0.502737 1.688087 1.230409 1.337757 1.342952 1.903513 0.955786 -0.215055 0.487009 1.948923 1.411678 0.225274 0.421106 0.203875 0.568136 0.977570 1.560054 1.164692 1.211841 0.037236 1.165323 0.284280 0.274360 0.776762 0.207157 -0.008462 -0.022949 0.633618 1.519303 0.349119 1.348337 0.561608 1.136896 0.486384 1.690665 0.939858 1.037942 0.628883 1.115783 0.551269 0.261357 0.835768 0.754522 0.995311 0.736018 1.536035 -0.082119)
;; 119+1
- 14.042466 #(0.000000 1.695702 0.296711 1.338908 -0.078265 1.044647 0.445401 1.570773 0.356080 0.726875 0.562835 1.121698 1.696368 0.511401 0.207025 0.089500 -0.565140 0.942644 0.652808 1.167682 0.412919 0.987661 0.705879 0.198820 0.440865 0.512441 1.083421 1.751114 -0.069762 1.661970 0.763824 0.509555 1.981466 0.038582 0.269865 1.492095 0.267412 1.351405 -0.147933 0.429115 1.485596 -0.131353 1.737203 0.373649 0.934842 0.295981 1.401570 1.025505 0.159868 1.751013 1.267064 0.606930 0.033477 0.655345 1.307003 1.298431 0.292781 -0.055933 0.016301 1.947579 1.426247 1.012103 1.014686 1.610683 0.794183 0.636102 1.398468 1.630487 -0.106933 0.019245 0.234173 1.454561 0.871538 0.489427 0.182807 1.191314 1.653186 0.812730 1.596587 0.968349 0.144419 1.254337 1.168160 -0.201543 0.642098 1.430541 0.891933 1.544951 1.231299 0.070309 1.961946 0.325740 0.895972 0.097452 0.983847 0.726652 1.390398 1.237569 1.108864 0.162933 1.463000 0.108857 0.104118 1.340850 -0.457424 0.750886 1.757915 1.530952 1.370214 1.508778 1.434766 0.846018 0.114800 0.004043 0.307829 -0.143116 0.279204 -0.090078 -0.107619 0.067028)
+ 14.042466 #r(0.000000 1.695702 0.296711 1.338908 -0.078265 1.044647 0.445401 1.570773 0.356080 0.726875 0.562835 1.121698 1.696368 0.511401 0.207025 0.089500 -0.565140 0.942644 0.652808 1.167682 0.412919 0.987661 0.705879 0.198820 0.440865 0.512441 1.083421 1.751114 -0.069762 1.661970 0.763824 0.509555 1.981466 0.038582 0.269865 1.492095 0.267412 1.351405 -0.147933 0.429115 1.485596 -0.131353 1.737203 0.373649 0.934842 0.295981 1.401570 1.025505 0.159868 1.751013 1.267064 0.606930 0.033477 0.655345 1.307003 1.298431 0.292781 -0.055933 0.016301 1.947579 1.426247 1.012103 1.014686 1.610683 0.794183 0.636102 1.398468 1.630487 -0.106933 0.019245 0.234173 1.454561 0.871538 0.489427 0.182807 1.191314 1.653186 0.812730 1.596587 0.968349 0.144419 1.254337 1.168160 -0.201543 0.642098 1.430541 0.891933 1.544951 1.231299 0.070309 1.961946 0.325740 0.895972 0.097452 0.983847 0.726652 1.390398 1.237569 1.108864 0.162933 1.463000 0.108857 0.104118 1.340850 -0.457424 0.750886 1.757915 1.530952 1.370214 1.508778 1.434766 0.846018 0.114800 0.004043 0.307829 -0.143116 0.279204 -0.090078 -0.107619 0.067028)
)
;;; 121 prime --------------------------------------------------------------------------------
-(vector 121 17.782977183017 #(0 0 1 0 1 0 0 1 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 1 0 1 0 0 0 0 0 1 0 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 1 0 1 0 1 0 0)
+(vector 121 17.782977183017 #r(0 0 1 0 1 0 0 1 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 1 0 1 0 0 0 0 0 1 0 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 1 0 1 0 1 0 0)
- 14.145310 #(0.000000 -0.025891 1.793636 0.033424 0.540007 1.698366 1.937124 -0.609559 0.386368 0.372251 1.167122 0.009884 1.449702 0.151646 0.129257 0.221923 0.286263 0.194141 1.256596 -0.022208 0.587239 1.364223 1.036771 0.840539 0.300738 0.487086 1.849878 -0.356013 -0.244608 -0.042719 1.244769 1.401449 0.301842 1.027056 1.091793 0.623370 1.184562 0.517907 0.649838 0.331082 0.619154 1.467356 0.525086 0.836576 0.132708 0.186394 1.646954 1.207107 -0.124102 1.434383 0.438192 1.403615 1.086842 1.456374 0.098749 0.654033 1.469902 -0.092397 0.999549 0.914715 1.334656 0.842194 0.762721 1.400578 1.518574 1.628966 0.557815 0.576931 -0.575198 0.632751 1.009717 1.185394 -0.060402 1.274789 1.032399 -0.216393 1.814193 1.597562 0.558478 0.044897 1.319287 0.285577 -0.020660 1.082584 0.821657 1.849151 0.241943 0.297525 1.569624 1.593287 0.604518 1.347238 0.159734 0.361474 0.136103 1.298636 0.140131 1.192829 1.398339 0.674275 0.995843 0.943454 0.693721 0.589259 1.642401 1.051611 -0.266130 0.115428 0.439245 0.514540 1.691776 1.063362 0.306592 0.883309 1.563638 -0.186910 0.971866 0.448146 0.177042 1.080065 0.466207)
+ 14.145310 #r(0.000000 -0.025891 1.793636 0.033424 0.540007 1.698366 1.937124 -0.609559 0.386368 0.372251 1.167122 0.009884 1.449702 0.151646 0.129257 0.221923 0.286263 0.194141 1.256596 -0.022208 0.587239 1.364223 1.036771 0.840539 0.300738 0.487086 1.849878 -0.356013 -0.244608 -0.042719 1.244769 1.401449 0.301842 1.027056 1.091793 0.623370 1.184562 0.517907 0.649838 0.331082 0.619154 1.467356 0.525086 0.836576 0.132708 0.186394 1.646954 1.207107 -0.124102 1.434383 0.438192 1.403615 1.086842 1.456374 0.098749 0.654033 1.469902 -0.092397 0.999549 0.914715 1.334656 0.842194 0.762721 1.400578 1.518574 1.628966 0.557815 0.576931 -0.575198 0.632751 1.009717 1.185394 -0.060402 1.274789 1.032399 -0.216393 1.814193 1.597562 0.558478 0.044897 1.319287 0.285577 -0.020660 1.082584 0.821657 1.849151 0.241943 0.297525 1.569624 1.593287 0.604518 1.347238 0.159734 0.361474 0.136103 1.298636 0.140131 1.192829 1.398339 0.674275 0.995843 0.943454 0.693721 0.589259 1.642401 1.051611 -0.266130 0.115428 0.439245 0.514540 1.691776 1.063362 0.306592 0.883309 1.563638 -0.186910 0.971866 0.448146 0.177042 1.080065 0.466207)
)
;;; 122 prime --------------------------------------------------------------------------------
-(vector 122 17.876078447724 #(0 1 1 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 1 0 1 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 1 1 0 1 1 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1)
+(vector 122 17.876078447724 #r(0 1 1 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 1 0 1 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 1 1 0 1 1 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1)
- 14.809716 #(0.000000 0.670494 1.886159 1.577487 1.777777 0.820522 0.567040 1.808673 1.691383 1.749354 0.999669 0.365962 -0.283305 1.315547 1.858625 0.083801 0.099076 1.593409 0.962399 0.938500 1.204685 1.174037 0.436114 0.616669 1.449802 0.424694 -0.043743 0.290754 0.536765 1.858591 1.302286 0.144562 1.898540 1.713336 0.304273 0.606056 -0.343580 1.320384 1.725243 1.070484 1.043894 1.041218 1.783423 1.623935 -0.119894 0.812509 0.330462 0.830339 1.651746 1.473863 0.826929 0.035844 0.962490 1.154392 0.108692 0.207697 -0.125372 0.785657 0.181654 0.507958 -0.099870 0.817795 0.576379 1.616959 1.203159 1.408060 0.803943 1.042280 0.347552 1.737313 1.151753 0.038129 1.376834 1.472899 0.308707 -0.055847 1.688664 1.527458 1.503192 0.428260 1.398802 0.697613 0.797253 1.257898 1.721624 0.405578 1.003490 0.227680 1.041522 0.134919 1.342074 1.464937 0.605066 -0.038087 1.389658 0.040933 0.121007 0.729584 0.212582 0.373515 1.668140 -0.235335 0.732650 0.289389 1.049347 -0.077662 0.429686 0.147005 1.585407 1.353860 1.815248 1.314972 0.285783 1.787337 1.040122 0.959573 1.461408 0.006176 1.591906 -0.004243 1.203878 1.856838)
+ 14.809716 #r(0.000000 0.670494 1.886159 1.577487 1.777777 0.820522 0.567040 1.808673 1.691383 1.749354 0.999669 0.365962 -0.283305 1.315547 1.858625 0.083801 0.099076 1.593409 0.962399 0.938500 1.204685 1.174037 0.436114 0.616669 1.449802 0.424694 -0.043743 0.290754 0.536765 1.858591 1.302286 0.144562 1.898540 1.713336 0.304273 0.606056 -0.343580 1.320384 1.725243 1.070484 1.043894 1.041218 1.783423 1.623935 -0.119894 0.812509 0.330462 0.830339 1.651746 1.473863 0.826929 0.035844 0.962490 1.154392 0.108692 0.207697 -0.125372 0.785657 0.181654 0.507958 -0.099870 0.817795 0.576379 1.616959 1.203159 1.408060 0.803943 1.042280 0.347552 1.737313 1.151753 0.038129 1.376834 1.472899 0.308707 -0.055847 1.688664 1.527458 1.503192 0.428260 1.398802 0.697613 0.797253 1.257898 1.721624 0.405578 1.003490 0.227680 1.041522 0.134919 1.342074 1.464937 0.605066 -0.038087 1.389658 0.040933 0.121007 0.729584 0.212582 0.373515 1.668140 -0.235335 0.732650 0.289389 1.049347 -0.077662 0.429686 0.147005 1.585407 1.353860 1.815248 1.314972 0.285783 1.787337 1.040122 0.959573 1.461408 0.006176 1.591906 -0.004243 1.203878 1.856838)
;; from 121+1
- 14.077769 #(0.000000 -0.102882 1.749236 -0.004117 0.483853 1.765874 1.938255 -0.600392 0.405831 0.339694 1.084448 1.949979 1.449950 0.179825 0.196465 0.250508 0.230057 0.267538 1.186702 -0.013547 0.609348 1.275263 1.002412 0.929479 0.351264 0.550827 1.866085 -0.207369 -0.221459 -0.043981 1.181650 1.372732 0.322165 0.950666 1.016902 0.608561 1.206924 0.503654 0.566235 0.334378 0.545128 1.400875 0.599963 0.865496 0.228459 0.195440 1.563459 1.162224 -0.092823 1.463200 0.340144 1.432985 0.949791 1.498279 0.068471 0.623276 1.392543 -0.178909 0.913012 0.880422 1.353490 0.813253 0.747974 1.430440 1.480413 1.631261 0.640181 0.621156 -0.581884 0.645199 1.046241 1.177765 0.048757 1.254481 1.019786 -0.266200 1.761071 1.575419 0.546658 -0.000712 1.213661 0.352510 -0.036380 1.089333 0.735910 1.940744 0.321816 0.327061 1.683870 1.638125 0.601090 1.278317 0.270163 0.360522 0.023473 1.250704 0.243204 1.199993 1.329172 0.588810 0.966119 0.939463 0.761317 0.553614 1.599868 1.062777 -0.228048 0.241966 0.388550 0.647592 1.729999 1.118550 0.325131 0.887699 1.516026 -0.170170 1.006043 0.421332 0.259983 1.062250 0.497913 0.166635)
+ 14.077769 #r(0.000000 -0.102882 1.749236 -0.004117 0.483853 1.765874 1.938255 -0.600392 0.405831 0.339694 1.084448 1.949979 1.449950 0.179825 0.196465 0.250508 0.230057 0.267538 1.186702 -0.013547 0.609348 1.275263 1.002412 0.929479 0.351264 0.550827 1.866085 -0.207369 -0.221459 -0.043981 1.181650 1.372732 0.322165 0.950666 1.016902 0.608561 1.206924 0.503654 0.566235 0.334378 0.545128 1.400875 0.599963 0.865496 0.228459 0.195440 1.563459 1.162224 -0.092823 1.463200 0.340144 1.432985 0.949791 1.498279 0.068471 0.623276 1.392543 -0.178909 0.913012 0.880422 1.353490 0.813253 0.747974 1.430440 1.480413 1.631261 0.640181 0.621156 -0.581884 0.645199 1.046241 1.177765 0.048757 1.254481 1.019786 -0.266200 1.761071 1.575419 0.546658 -0.000712 1.213661 0.352510 -0.036380 1.089333 0.735910 1.940744 0.321816 0.327061 1.683870 1.638125 0.601090 1.278317 0.270163 0.360522 0.023473 1.250704 0.243204 1.199993 1.329172 0.588810 0.966119 0.939463 0.761317 0.553614 1.599868 1.062777 -0.228048 0.241966 0.388550 0.647592 1.729999 1.118550 0.325131 0.887699 1.516026 -0.170170 1.006043 0.421332 0.259983 1.062250 0.497913 0.166635)
)
;;; 123 prime --------------------------------------------------------------------------------
-(vector 123 17.273 #(0 0 0 0 0 0 1 0 1 1 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 0 0 1 0 0)
+(vector 123 17.273 #r(0 0 0 0 0 0 1 0 1 1 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 0 0 1 0 0)
- 14.606318 #(0.000000 0.018375 0.589471 0.983384 0.991984 0.372395 -0.040275 0.299423 1.756771 0.367581 1.925315 0.431987 -0.091930 1.365768 0.790238 1.730935 1.453895 0.945086 0.541022 0.665855 -0.133333 1.898784 1.614955 0.125913 -0.075642 1.042483 1.409785 1.598074 0.355453 1.697472 1.704234 0.447761 0.702787 1.037349 1.268895 1.641450 0.389018 0.691038 0.964549 0.799007 -0.028923 0.682141 1.218121 0.346438 0.248506 0.187480 1.166792 0.799601 1.529262 1.053370 1.663430 1.815223 1.438810 1.297963 0.281072 0.228128 0.996820 1.126305 0.635366 1.152238 1.612305 0.687034 0.492102 0.223406 1.290673 0.404319 0.673144 1.585101 1.003033 0.671106 0.630415 0.262596 -0.092794 0.970586 -0.143151 1.120737 0.513895 1.346570 0.209142 0.468700 0.483816 0.465304 -0.188333 0.812984 1.400518 1.773921 1.423889 0.414054 -0.317948 0.988906 0.349734 -0.120165 0.609604 -0.196752 0.649574 0.752742 0.402866 1.001890 0.667657 -0.097642 -0.022329 0.780061 0.422052 0.637506 0.933615 0.491032 1.329969 0.891484 0.826863 0.432342 1.071482 1.483913 0.545228 0.886707 1.473772 1.459843 1.911936 0.601733 -0.070730 1.820410 1.529051 0.044995 0.589246)
+ 14.606318 #r(0.000000 0.018375 0.589471 0.983384 0.991984 0.372395 -0.040275 0.299423 1.756771 0.367581 1.925315 0.431987 -0.091930 1.365768 0.790238 1.730935 1.453895 0.945086 0.541022 0.665855 -0.133333 1.898784 1.614955 0.125913 -0.075642 1.042483 1.409785 1.598074 0.355453 1.697472 1.704234 0.447761 0.702787 1.037349 1.268895 1.641450 0.389018 0.691038 0.964549 0.799007 -0.028923 0.682141 1.218121 0.346438 0.248506 0.187480 1.166792 0.799601 1.529262 1.053370 1.663430 1.815223 1.438810 1.297963 0.281072 0.228128 0.996820 1.126305 0.635366 1.152238 1.612305 0.687034 0.492102 0.223406 1.290673 0.404319 0.673144 1.585101 1.003033 0.671106 0.630415 0.262596 -0.092794 0.970586 -0.143151 1.120737 0.513895 1.346570 0.209142 0.468700 0.483816 0.465304 -0.188333 0.812984 1.400518 1.773921 1.423889 0.414054 -0.317948 0.988906 0.349734 -0.120165 0.609604 -0.196752 0.649574 0.752742 0.402866 1.001890 0.667657 -0.097642 -0.022329 0.780061 0.422052 0.637506 0.933615 0.491032 1.329969 0.891484 0.826863 0.432342 1.071482 1.483913 0.545228 0.886707 1.473772 1.459843 1.911936 0.601733 -0.070730 1.820410 1.529051 0.044995 0.589246)
;; 122+1
- 14.218431 #(0.000000 -0.071277 1.809148 -0.020616 0.407111 1.755823 1.904945 -0.715971 0.341233 0.449964 1.085208 0.031030 1.532200 0.268807 0.148267 0.268084 0.272209 0.202242 1.223891 -0.064002 0.629461 1.331632 1.050525 0.887285 0.370000 0.565442 1.910419 -0.226719 -0.262129 -0.049320 1.111879 1.377442 0.321129 0.921437 0.982936 0.703155 1.229920 0.446816 0.492798 0.314076 0.541522 1.414758 0.522185 0.801174 0.218712 0.168371 1.631951 1.208384 -0.085808 1.408101 0.423643 1.324899 0.982011 1.466628 0.095538 0.635570 1.314596 -0.072617 1.020892 0.911989 1.330565 0.770391 0.725410 1.510974 1.479974 1.759621 0.639552 0.614948 -0.510015 0.641435 0.965296 1.113277 0.074254 1.206499 1.003706 -0.366482 1.772703 1.570225 0.592942 0.091270 1.226107 0.311704 0.007633 0.964361 0.718780 1.974845 0.242071 0.343141 1.709800 1.693786 0.483738 1.265900 0.338851 0.340533 0.047929 1.263159 0.240281 1.186223 1.427920 0.613439 0.969107 0.960914 0.712662 0.596951 1.686986 1.021249 -0.262802 0.214377 0.402786 0.561682 1.740484 1.058116 0.341115 0.933358 1.469760 -0.231395 1.023135 0.404403 0.200269 1.060708 0.484072 0.072981 0.045518)
+ 14.218431 #r(0.000000 -0.071277 1.809148 -0.020616 0.407111 1.755823 1.904945 -0.715971 0.341233 0.449964 1.085208 0.031030 1.532200 0.268807 0.148267 0.268084 0.272209 0.202242 1.223891 -0.064002 0.629461 1.331632 1.050525 0.887285 0.370000 0.565442 1.910419 -0.226719 -0.262129 -0.049320 1.111879 1.377442 0.321129 0.921437 0.982936 0.703155 1.229920 0.446816 0.492798 0.314076 0.541522 1.414758 0.522185 0.801174 0.218712 0.168371 1.631951 1.208384 -0.085808 1.408101 0.423643 1.324899 0.982011 1.466628 0.095538 0.635570 1.314596 -0.072617 1.020892 0.911989 1.330565 0.770391 0.725410 1.510974 1.479974 1.759621 0.639552 0.614948 -0.510015 0.641435 0.965296 1.113277 0.074254 1.206499 1.003706 -0.366482 1.772703 1.570225 0.592942 0.091270 1.226107 0.311704 0.007633 0.964361 0.718780 1.974845 0.242071 0.343141 1.709800 1.693786 0.483738 1.265900 0.338851 0.340533 0.047929 1.263159 0.240281 1.186223 1.427920 0.613439 0.969107 0.960914 0.712662 0.596951 1.686986 1.021249 -0.262802 0.214377 0.402786 0.561682 1.740484 1.058116 0.341115 0.933358 1.469760 -0.231395 1.023135 0.404403 0.200269 1.060708 0.484072 0.072981 0.045518)
)
;;; 124 prime --------------------------------------------------------------------------------
-(vector 124 17.868420183527 #(0 0 0 1 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0 0 1 1 0 0 1)
+(vector 124 17.868420183527 #r(0 0 0 1 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0 0 1 1 0 0 1)
- 14.790618 #(0.000000 1.222162 0.999539 1.142487 1.505674 0.123191 1.078191 1.428308 0.398665 0.193203 0.342797 1.160548 0.272137 0.744922 1.397108 1.629980 0.516700 0.161533 1.540757 0.951466 1.306414 1.131481 0.340080 0.022600 1.902411 0.678905 -0.266096 0.618248 -0.195173 1.348860 1.656222 0.843246 1.086674 0.610041 0.732222 1.576567 -0.001222 1.325305 -0.206092 0.061466 0.937472 0.938375 0.951723 1.351728 0.822770 1.101763 0.749753 0.602996 1.016336 0.240295 1.282512 0.877283 1.675716 1.308583 0.020424 0.112525 1.125186 0.567562 1.325344 0.286941 1.392684 1.457107 1.070715 1.116929 0.019425 1.553921 0.611895 0.374394 1.517480 0.357614 0.351325 1.265831 1.671035 0.028656 0.694185 0.608779 0.968580 0.705917 0.557377 -0.050792 0.760543 1.517363 0.410154 1.478833 1.629314 1.203011 0.602580 1.412252 0.251943 1.776030 1.689098 1.335837 1.695826 1.914988 1.139727 1.661355 -0.008029 1.815582 0.952555 0.813836 0.589787 1.222025 1.184138 0.133013 1.235368 -0.243658 1.554911 0.580687 0.939871 0.323060 0.942785 1.574937 1.605974 1.858030 0.079942 -0.197497 0.010513 0.448075 -0.013192 0.950902 1.198378 1.685266 1.111201 1.137042)
+ 14.790618 #r(0.000000 1.222162 0.999539 1.142487 1.505674 0.123191 1.078191 1.428308 0.398665 0.193203 0.342797 1.160548 0.272137 0.744922 1.397108 1.629980 0.516700 0.161533 1.540757 0.951466 1.306414 1.131481 0.340080 0.022600 1.902411 0.678905 -0.266096 0.618248 -0.195173 1.348860 1.656222 0.843246 1.086674 0.610041 0.732222 1.576567 -0.001222 1.325305 -0.206092 0.061466 0.937472 0.938375 0.951723 1.351728 0.822770 1.101763 0.749753 0.602996 1.016336 0.240295 1.282512 0.877283 1.675716 1.308583 0.020424 0.112525 1.125186 0.567562 1.325344 0.286941 1.392684 1.457107 1.070715 1.116929 0.019425 1.553921 0.611895 0.374394 1.517480 0.357614 0.351325 1.265831 1.671035 0.028656 0.694185 0.608779 0.968580 0.705917 0.557377 -0.050792 0.760543 1.517363 0.410154 1.478833 1.629314 1.203011 0.602580 1.412252 0.251943 1.776030 1.689098 1.335837 1.695826 1.914988 1.139727 1.661355 -0.008029 1.815582 0.952555 0.813836 0.589787 1.222025 1.184138 0.133013 1.235368 -0.243658 1.554911 0.580687 0.939871 0.323060 0.942785 1.574937 1.605974 1.858030 0.079942 -0.197497 0.010513 0.448075 -0.013192 0.950902 1.198378 1.685266 1.111201 1.137042)
;; 123+1
- 14.279834 #(0.000000 -0.081380 1.782165 -0.062634 0.363611 1.777729 1.870086 -0.748456 0.397000 0.457689 1.108119 0.004930 1.540452 0.247288 0.180358 0.333199 0.182296 0.178249 1.230554 -0.108533 0.646062 1.305622 0.825072 0.858877 0.381906 0.623442 1.836712 -0.249134 -0.191182 -0.125952 1.112553 1.374523 0.342721 0.833331 0.944734 0.720943 1.282090 0.390216 0.453997 0.358637 0.493600 1.372859 0.624272 0.735874 0.299299 0.184937 1.617155 1.281616 -0.070863 1.469387 0.307926 1.334541 0.930607 1.487203 0.131059 0.597353 1.290211 -0.242352 1.036453 0.942866 1.246650 0.636276 0.826032 1.531105 1.485955 1.813085 0.625741 0.627771 -0.579465 0.642188 0.969289 1.138476 0.074565 1.189823 0.939892 -0.416570 1.739435 1.565378 0.588268 0.099664 1.234765 0.379725 -0.063217 0.934469 0.845969 1.930710 0.181988 0.295750 1.696778 1.677311 0.505493 1.249700 0.433102 0.439581 0.020795 1.231023 0.285770 1.217649 1.421529 0.551828 0.924619 0.972048 0.789871 0.556108 1.717849 1.016229 -0.325643 0.376556 0.293594 0.487260 1.648794 1.072609 0.281420 0.961161 1.519437 -0.241812 1.031705 0.425825 0.197195 1.096632 0.361878 0.106170 -0.074233 0.005979)
+ 14.279834 #r(0.000000 -0.081380 1.782165 -0.062634 0.363611 1.777729 1.870086 -0.748456 0.397000 0.457689 1.108119 0.004930 1.540452 0.247288 0.180358 0.333199 0.182296 0.178249 1.230554 -0.108533 0.646062 1.305622 0.825072 0.858877 0.381906 0.623442 1.836712 -0.249134 -0.191182 -0.125952 1.112553 1.374523 0.342721 0.833331 0.944734 0.720943 1.282090 0.390216 0.453997 0.358637 0.493600 1.372859 0.624272 0.735874 0.299299 0.184937 1.617155 1.281616 -0.070863 1.469387 0.307926 1.334541 0.930607 1.487203 0.131059 0.597353 1.290211 -0.242352 1.036453 0.942866 1.246650 0.636276 0.826032 1.531105 1.485955 1.813085 0.625741 0.627771 -0.579465 0.642188 0.969289 1.138476 0.074565 1.189823 0.939892 -0.416570 1.739435 1.565378 0.588268 0.099664 1.234765 0.379725 -0.063217 0.934469 0.845969 1.930710 0.181988 0.295750 1.696778 1.677311 0.505493 1.249700 0.433102 0.439581 0.020795 1.231023 0.285770 1.217649 1.421529 0.551828 0.924619 0.972048 0.789871 0.556108 1.717849 1.016229 -0.325643 0.376556 0.293594 0.487260 1.648794 1.072609 0.281420 0.961161 1.519437 -0.241812 1.031705 0.425825 0.197195 1.096632 0.361878 0.106170 -0.074233 0.005979)
)
;;; 125 prime --------------------------------------------------------------------------------
-(vector 125 17.637776156888 #(0 1 1 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 0 1 1 1)
+(vector 125 17.637776156888 #r(0 1 1 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 0 1 1 1)
- 14.772411 #(0.000000 1.488367 0.539453 0.636319 1.701536 0.864646 0.653079 -0.015234 -0.146959 -0.016393 1.159310 0.253720 0.483376 0.791134 0.148523 1.139178 0.651015 0.419622 1.011424 1.343222 0.375202 1.487445 1.136349 1.264222 1.195821 1.118452 0.058438 0.180283 -0.364874 1.141390 0.108460 0.432578 1.082489 -0.344327 0.561149 -0.050777 0.153514 0.046289 0.013379 0.201861 0.723817 0.636257 0.099730 -0.252366 1.579710 1.247947 0.727318 0.604484 0.768675 1.814508 0.866882 0.945446 1.203952 0.553202 1.570818 0.438899 1.210503 0.074303 1.805294 1.142851 0.477720 0.743449 -0.030259 0.761798 0.442190 0.180723 0.743309 -0.143585 1.116545 1.404371 0.204979 0.238499 1.331119 1.234638 1.176686 1.242725 0.433339 0.737611 -0.052694 0.108421 1.540317 0.211091 1.637087 0.618282 0.999958 1.643481 0.805826 1.863967 0.824505 0.797379 0.836059 -0.009548 1.065334 1.608230 -0.042496 0.454917 0.581669 0.915626 0.146732 0.685151 0.520442 1.115897 0.367688 0.129909 1.145807 0.921815 0.252576 -0.010734 0.180757 1.854774 0.546533 1.532747 1.382619 0.143523 0.214257 0.954384 0.657013 1.826584 1.432640 0.172761 -0.181378 1.290872 1.519863 0.506886 0.104986)
+ 14.772411 #r(0.000000 1.488367 0.539453 0.636319 1.701536 0.864646 0.653079 -0.015234 -0.146959 -0.016393 1.159310 0.253720 0.483376 0.791134 0.148523 1.139178 0.651015 0.419622 1.011424 1.343222 0.375202 1.487445 1.136349 1.264222 1.195821 1.118452 0.058438 0.180283 -0.364874 1.141390 0.108460 0.432578 1.082489 -0.344327 0.561149 -0.050777 0.153514 0.046289 0.013379 0.201861 0.723817 0.636257 0.099730 -0.252366 1.579710 1.247947 0.727318 0.604484 0.768675 1.814508 0.866882 0.945446 1.203952 0.553202 1.570818 0.438899 1.210503 0.074303 1.805294 1.142851 0.477720 0.743449 -0.030259 0.761798 0.442190 0.180723 0.743309 -0.143585 1.116545 1.404371 0.204979 0.238499 1.331119 1.234638 1.176686 1.242725 0.433339 0.737611 -0.052694 0.108421 1.540317 0.211091 1.637087 0.618282 0.999958 1.643481 0.805826 1.863967 0.824505 0.797379 0.836059 -0.009548 1.065334 1.608230 -0.042496 0.454917 0.581669 0.915626 0.146732 0.685151 0.520442 1.115897 0.367688 0.129909 1.145807 0.921815 0.252576 -0.010734 0.180757 1.854774 0.546533 1.532747 1.382619 0.143523 0.214257 0.954384 0.657013 1.826584 1.432640 0.172761 -0.181378 1.290872 1.519863 0.506886 0.104986)
;; 124+1
- 14.335616 #(0.000000 -0.073704 1.756721 -0.027521 0.555274 1.787030 1.851198 -0.739687 0.444117 0.371512 1.030097 0.041170 1.545538 0.189519 0.163161 0.279241 0.173564 0.127795 1.239047 -0.127708 0.674274 1.329026 0.927305 0.921971 0.291034 0.575583 1.919448 -0.265928 -0.189299 -0.242314 1.071327 1.320148 0.401414 0.885029 1.046562 0.775451 1.215839 0.374013 0.421290 0.242139 0.417910 1.413086 0.643233 0.744664 0.179383 0.219870 1.572661 1.345306 -0.060756 1.371806 0.318705 1.344767 0.903717 1.446972 0.029587 0.642047 1.254548 -0.199918 1.025990 0.987502 1.268140 0.763438 0.716412 1.540475 1.448750 1.854247 0.619685 0.691226 -0.557884 0.607847 0.974173 1.151524 -0.000158 1.208581 0.923167 -0.344361 1.808080 1.613014 0.625897 0.097908 1.229154 0.352252 -0.000924 0.978476 0.892610 1.915124 0.237884 0.295218 1.727938 1.672743 0.433468 1.238004 0.487776 0.417610 0.023342 1.153124 0.251246 1.196960 1.459291 0.552975 0.974914 0.953186 0.742186 0.557329 1.742338 1.006012 -0.331621 0.294231 0.321006 0.465332 1.742325 1.134043 0.251983 0.900167 1.477710 -0.206427 1.075443 0.425293 0.211597 1.112385 0.321994 0.162492 -0.098661 0.047474 0.072546)
+ 14.335616 #r(0.000000 -0.073704 1.756721 -0.027521 0.555274 1.787030 1.851198 -0.739687 0.444117 0.371512 1.030097 0.041170 1.545538 0.189519 0.163161 0.279241 0.173564 0.127795 1.239047 -0.127708 0.674274 1.329026 0.927305 0.921971 0.291034 0.575583 1.919448 -0.265928 -0.189299 -0.242314 1.071327 1.320148 0.401414 0.885029 1.046562 0.775451 1.215839 0.374013 0.421290 0.242139 0.417910 1.413086 0.643233 0.744664 0.179383 0.219870 1.572661 1.345306 -0.060756 1.371806 0.318705 1.344767 0.903717 1.446972 0.029587 0.642047 1.254548 -0.199918 1.025990 0.987502 1.268140 0.763438 0.716412 1.540475 1.448750 1.854247 0.619685 0.691226 -0.557884 0.607847 0.974173 1.151524 -0.000158 1.208581 0.923167 -0.344361 1.808080 1.613014 0.625897 0.097908 1.229154 0.352252 -0.000924 0.978476 0.892610 1.915124 0.237884 0.295218 1.727938 1.672743 0.433468 1.238004 0.487776 0.417610 0.023342 1.153124 0.251246 1.196960 1.459291 0.552975 0.974914 0.953186 0.742186 0.557329 1.742338 1.006012 -0.331621 0.294231 0.321006 0.465332 1.742325 1.134043 0.251983 0.900167 1.477710 -0.206427 1.075443 0.425293 0.211597 1.112385 0.321994 0.162492 -0.098661 0.047474 0.072546)
)
;;; 126 prime --------------------------------------------------------------------------------
-(vector 126 18.284595039843 #(0 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 1 0 0 0 0 1 1 0 1 1 0 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 0 0 1 0 1 1 1 0 1)
+(vector 126 18.284595039843 #r(0 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 1 0 0 0 0 1 1 0 1 1 0 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 0 0 1 0 1 1 1 0 1)
- 14.919977 #(0.000000 1.469803 0.590807 0.764079 1.791170 0.333377 0.787711 1.497688 1.425800 1.198769 -0.142602 1.315353 -0.073058 1.238142 -0.046252 1.358363 0.881227 0.034517 0.376307 0.332870 0.693500 1.217503 0.199404 -0.446423 0.007791 1.544042 1.693684 1.705920 0.539256 1.329303 -0.184478 1.516336 1.012314 1.494800 1.597619 0.336783 1.080235 0.583130 1.276101 1.725256 0.652789 1.276830 1.460138 1.593259 0.514539 1.170620 1.278633 0.619783 1.325249 1.591358 0.207365 1.060129 0.815013 0.040269 1.468914 0.227402 0.515366 0.731820 0.621073 0.837063 1.275146 0.259307 0.585385 0.909317 0.921047 0.261764 0.230595 1.268807 1.340737 0.628738 0.406147 1.678580 0.814730 0.487283 1.140440 0.869819 1.474812 0.775855 -0.116531 0.130586 0.641169 1.517310 1.370799 1.423659 0.321563 0.178649 1.411675 1.146911 0.966764 1.521079 1.121859 -0.427787 0.506332 1.644605 1.138614 1.523684 0.664505 0.648038 0.075277 0.416802 0.443365 1.235830 1.173282 1.107298 0.136026 -0.032457 1.449977 -0.023926 1.087880 -0.136228 1.342249 1.136201 1.846662 0.865407 0.833970 1.810099 1.018847 -0.107251 0.065627 1.367299 0.507024 0.142912 1.416639 0.609252 0.711456 0.417251)
+ 14.919977 #r(0.000000 1.469803 0.590807 0.764079 1.791170 0.333377 0.787711 1.497688 1.425800 1.198769 -0.142602 1.315353 -0.073058 1.238142 -0.046252 1.358363 0.881227 0.034517 0.376307 0.332870 0.693500 1.217503 0.199404 -0.446423 0.007791 1.544042 1.693684 1.705920 0.539256 1.329303 -0.184478 1.516336 1.012314 1.494800 1.597619 0.336783 1.080235 0.583130 1.276101 1.725256 0.652789 1.276830 1.460138 1.593259 0.514539 1.170620 1.278633 0.619783 1.325249 1.591358 0.207365 1.060129 0.815013 0.040269 1.468914 0.227402 0.515366 0.731820 0.621073 0.837063 1.275146 0.259307 0.585385 0.909317 0.921047 0.261764 0.230595 1.268807 1.340737 0.628738 0.406147 1.678580 0.814730 0.487283 1.140440 0.869819 1.474812 0.775855 -0.116531 0.130586 0.641169 1.517310 1.370799 1.423659 0.321563 0.178649 1.411675 1.146911 0.966764 1.521079 1.121859 -0.427787 0.506332 1.644605 1.138614 1.523684 0.664505 0.648038 0.075277 0.416802 0.443365 1.235830 1.173282 1.107298 0.136026 -0.032457 1.449977 -0.023926 1.087880 -0.136228 1.342249 1.136201 1.846662 0.865407 0.833970 1.810099 1.018847 -0.107251 0.065627 1.367299 0.507024 0.142912 1.416639 0.609252 0.711456 0.417251)
;; 127 - 1
- 14.478183 #(0.000000 0.930861 1.435103 1.015217 0.133148 0.287358 1.954448 0.877191 -0.313979 0.188033 1.404924 0.797822 1.641089 -0.072460 0.883498 1.253629 0.955039 1.649989 1.112182 0.909200 1.887346 0.566087 0.831325 1.595619 1.015259 1.132981 1.214225 1.758075 1.475152 1.620993 0.072446 -0.059078 -0.182289 -0.039338 0.155445 0.529297 0.046388 1.441668 0.535178 0.222607 0.659275 1.874433 0.311495 1.718719 0.434358 1.778879 1.619012 0.517997 0.354459 -0.261087 0.248995 1.922764 0.605114 1.052457 -0.265751 1.118974 0.375392 1.608325 1.902594 0.729575 1.283255 1.305350 0.868120 1.355763 1.680987 0.242830 0.477218 1.016250 0.628871 -0.030446 0.679211 1.826138 1.874720 1.129680 1.690954 1.195384 0.889438 1.205646 1.461460 -0.453690 0.712708 1.258870 1.879622 1.875344 1.343716 1.283838 0.647289 0.933542 0.025722 -0.304513 0.859639 0.850257 0.333502 1.942927 1.798084 1.335700 0.932797 0.281618 -0.061736 1.117606 1.074494 0.424155 0.429073 1.579564 1.707609 0.889204 0.016152 1.499631 0.327239 1.110073 0.816898 0.676932 0.517090 0.873228 0.943685 1.557236 1.328668 0.393069 1.595818 0.801812 0.427544 0.632088 1.930520 1.052145 0.001869 0.373834)
+ 14.478183 #r(0.000000 0.930861 1.435103 1.015217 0.133148 0.287358 1.954448 0.877191 -0.313979 0.188033 1.404924 0.797822 1.641089 -0.072460 0.883498 1.253629 0.955039 1.649989 1.112182 0.909200 1.887346 0.566087 0.831325 1.595619 1.015259 1.132981 1.214225 1.758075 1.475152 1.620993 0.072446 -0.059078 -0.182289 -0.039338 0.155445 0.529297 0.046388 1.441668 0.535178 0.222607 0.659275 1.874433 0.311495 1.718719 0.434358 1.778879 1.619012 0.517997 0.354459 -0.261087 0.248995 1.922764 0.605114 1.052457 -0.265751 1.118974 0.375392 1.608325 1.902594 0.729575 1.283255 1.305350 0.868120 1.355763 1.680987 0.242830 0.477218 1.016250 0.628871 -0.030446 0.679211 1.826138 1.874720 1.129680 1.690954 1.195384 0.889438 1.205646 1.461460 -0.453690 0.712708 1.258870 1.879622 1.875344 1.343716 1.283838 0.647289 0.933542 0.025722 -0.304513 0.859639 0.850257 0.333502 1.942927 1.798084 1.335700 0.932797 0.281618 -0.061736 1.117606 1.074494 0.424155 0.429073 1.579564 1.707609 0.889204 0.016152 1.499631 0.327239 1.110073 0.816898 0.676932 0.517090 0.873228 0.943685 1.557236 1.328668 0.393069 1.595818 0.801812 0.427544 0.632088 1.930520 1.052145 0.001869 0.373834)
)
;;; 127 prime --------------------------------------------------------------------------------
-(vector 127 18.198689419357 #(0 0 0 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 0 1 0 1 1 0 1 0 1 0 0 0 0 1 0 1 1 0 1 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1)
+(vector 127 18.198689419357 #r(0 0 0 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 0 1 0 1 1 0 1 0 1 0 0 0 0 1 0 1 1 0 1 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1)
- 14.912432 #(0.000000 -0.112564 0.330831 0.563931 0.720452 1.659462 1.770279 1.222445 1.859857 0.126001 0.651461 1.215294 -0.233033 0.427403 0.814844 0.606037 1.919973 0.930971 0.148326 0.698675 1.110446 0.338577 1.107127 0.863142 1.130521 0.352666 0.715295 1.098761 0.639947 1.470989 0.137887 1.186298 0.901174 1.895291 0.359770 0.973168 1.699946 0.771080 1.375904 -0.248826 1.181644 1.789978 0.712701 0.277767 1.875124 0.813518 1.712932 0.451921 0.276945 1.323596 1.302350 1.483287 1.090079 0.743389 1.264854 1.950370 0.782969 0.914279 0.320477 0.990740 0.622004 0.030993 0.934242 0.961767 0.268688 1.789126 0.206081 0.101936 -0.529878 1.903369 0.539774 1.823204 -0.147241 0.928082 0.776302 1.167127 1.638509 1.576221 0.666141 0.750484 0.892326 0.100670 1.158426 0.166814 1.186903 1.306719 1.235546 0.635532 0.425679 1.719459 0.863874 0.092801 1.266262 1.369621 1.347298 0.966081 0.206817 0.754899 1.254971 0.922627 0.087389 0.135770 0.821247 0.230310 1.412479 0.655130 0.149628 1.814319 1.923709 1.016259 0.975859 0.575686 1.520455 1.205512 0.978744 1.845650 0.833521 0.220528 0.380346 0.141961 -0.028883 0.515081 0.897680 0.876651 0.794347 1.289685 0.792317)
+ 14.912432 #r(0.000000 -0.112564 0.330831 0.563931 0.720452 1.659462 1.770279 1.222445 1.859857 0.126001 0.651461 1.215294 -0.233033 0.427403 0.814844 0.606037 1.919973 0.930971 0.148326 0.698675 1.110446 0.338577 1.107127 0.863142 1.130521 0.352666 0.715295 1.098761 0.639947 1.470989 0.137887 1.186298 0.901174 1.895291 0.359770 0.973168 1.699946 0.771080 1.375904 -0.248826 1.181644 1.789978 0.712701 0.277767 1.875124 0.813518 1.712932 0.451921 0.276945 1.323596 1.302350 1.483287 1.090079 0.743389 1.264854 1.950370 0.782969 0.914279 0.320477 0.990740 0.622004 0.030993 0.934242 0.961767 0.268688 1.789126 0.206081 0.101936 -0.529878 1.903369 0.539774 1.823204 -0.147241 0.928082 0.776302 1.167127 1.638509 1.576221 0.666141 0.750484 0.892326 0.100670 1.158426 0.166814 1.186903 1.306719 1.235546 0.635532 0.425679 1.719459 0.863874 0.092801 1.266262 1.369621 1.347298 0.966081 0.206817 0.754899 1.254971 0.922627 0.087389 0.135770 0.821247 0.230310 1.412479 0.655130 0.149628 1.814319 1.923709 1.016259 0.975859 0.575686 1.520455 1.205512 0.978744 1.845650 0.833521 0.220528 0.380346 0.141961 -0.028883 0.515081 0.897680 0.876651 0.794347 1.289685 0.792317)
;; 128-1
- 14.536393 #(0.000000 0.910972 1.475131 1.009861 0.062727 0.222323 1.938743 0.836711 -0.379271 0.255108 1.367947 0.841274 1.648864 0.015930 0.884691 1.125991 0.989606 1.607929 1.107388 0.857011 1.831346 0.433218 0.833149 1.592445 1.050762 1.008151 1.363530 1.700977 1.491038 1.682961 0.086100 -0.103806 -0.179348 0.003896 0.165438 0.493687 0.089620 1.387284 0.581547 0.176309 0.705269 1.811651 0.301490 1.707605 0.333845 1.832817 1.652148 0.600871 0.309714 -0.231587 0.303261 1.879368 0.673797 1.138199 -0.287759 1.071255 0.390644 1.597999 1.895638 0.729896 1.280128 1.313792 0.920129 1.387655 1.675038 0.226144 0.498585 1.104083 0.607578 0.005976 0.644124 1.859066 1.816208 1.159654 1.721231 1.377183 0.892151 1.087634 1.544878 -0.427006 0.761009 1.308993 1.890672 1.804683 1.325584 1.333615 0.649826 0.878906 0.043600 -0.222822 0.983855 0.725901 0.429955 1.892651 1.820617 1.395993 0.939478 0.246907 -0.065788 1.167118 1.004041 0.432075 0.450312 1.618752 1.686873 0.868341 1.893872 1.401676 0.376204 1.113598 0.748962 0.732995 0.557016 0.919800 0.871855 1.529811 1.275389 0.387399 1.586418 0.758929 0.456983 0.576267 1.810711 1.106484 0.012213 0.311973 1.081248)
+ 14.536393 #r(0.000000 0.910972 1.475131 1.009861 0.062727 0.222323 1.938743 0.836711 -0.379271 0.255108 1.367947 0.841274 1.648864 0.015930 0.884691 1.125991 0.989606 1.607929 1.107388 0.857011 1.831346 0.433218 0.833149 1.592445 1.050762 1.008151 1.363530 1.700977 1.491038 1.682961 0.086100 -0.103806 -0.179348 0.003896 0.165438 0.493687 0.089620 1.387284 0.581547 0.176309 0.705269 1.811651 0.301490 1.707605 0.333845 1.832817 1.652148 0.600871 0.309714 -0.231587 0.303261 1.879368 0.673797 1.138199 -0.287759 1.071255 0.390644 1.597999 1.895638 0.729896 1.280128 1.313792 0.920129 1.387655 1.675038 0.226144 0.498585 1.104083 0.607578 0.005976 0.644124 1.859066 1.816208 1.159654 1.721231 1.377183 0.892151 1.087634 1.544878 -0.427006 0.761009 1.308993 1.890672 1.804683 1.325584 1.333615 0.649826 0.878906 0.043600 -0.222822 0.983855 0.725901 0.429955 1.892651 1.820617 1.395993 0.939478 0.246907 -0.065788 1.167118 1.004041 0.432075 0.450312 1.618752 1.686873 0.868341 1.893872 1.401676 0.376204 1.113598 0.748962 0.732995 0.557016 0.919800 0.871855 1.529811 1.275389 0.387399 1.586418 0.758929 0.456983 0.576267 1.810711 1.106484 0.012213 0.311973 1.081248)
)
;;; 128 prime --------------------------------------------------------------------------------
-(vector 128 18.276384353638 #(0 0 1 0 1 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1)
+(vector 128 18.276384353638 #r(0 0 1 0 1 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1)
- 14.551285 #(0.000000 0.924459 1.485422 0.985256 0.056811 0.219930 1.908499 0.913743 -0.403193 0.259904 1.334649 0.827148 1.624714 -0.021872 0.937257 1.122813 0.961899 1.532146 1.148701 0.868319 1.827482 0.356035 0.897995 1.553711 0.943178 0.960525 1.352917 1.720117 1.523327 1.617955 0.013172 -0.149597 -0.137644 -0.034035 0.111097 0.498787 0.121406 1.399436 0.620595 0.082527 0.702328 1.824635 0.362315 1.752651 0.335052 1.794344 1.642190 0.610334 0.262361 -0.222978 0.248243 1.869656 0.644580 1.192948 -0.312319 1.070271 0.368940 1.593867 1.836900 0.676177 1.276819 1.276408 0.936758 1.361721 1.692175 0.215294 0.511916 1.079847 0.588820 0.055407 0.579633 1.891289 1.810098 1.133091 1.733591 1.452365 0.980479 1.078929 1.556717 -0.427469 0.779143 1.336023 1.912299 1.782248 1.339461 1.329616 0.616924 0.917615 0.006788 -0.195359 0.981816 0.758001 0.419952 1.868089 1.758394 1.479010 0.921655 0.244745 -0.038674 1.158515 0.987245 0.469852 0.442126 1.652528 1.699770 0.900506 1.793377 1.368738 0.405805 1.083967 0.706228 0.759055 0.550546 0.985536 0.835398 1.537041 1.252754 0.414912 1.587016 0.741668 0.441787 0.537126 1.829954 1.207186 -0.038603 0.324826 1.093300 0.845470)
+ 14.551285 #r(0.000000 0.924459 1.485422 0.985256 0.056811 0.219930 1.908499 0.913743 -0.403193 0.259904 1.334649 0.827148 1.624714 -0.021872 0.937257 1.122813 0.961899 1.532146 1.148701 0.868319 1.827482 0.356035 0.897995 1.553711 0.943178 0.960525 1.352917 1.720117 1.523327 1.617955 0.013172 -0.149597 -0.137644 -0.034035 0.111097 0.498787 0.121406 1.399436 0.620595 0.082527 0.702328 1.824635 0.362315 1.752651 0.335052 1.794344 1.642190 0.610334 0.262361 -0.222978 0.248243 1.869656 0.644580 1.192948 -0.312319 1.070271 0.368940 1.593867 1.836900 0.676177 1.276819 1.276408 0.936758 1.361721 1.692175 0.215294 0.511916 1.079847 0.588820 0.055407 0.579633 1.891289 1.810098 1.133091 1.733591 1.452365 0.980479 1.078929 1.556717 -0.427469 0.779143 1.336023 1.912299 1.782248 1.339461 1.329616 0.616924 0.917615 0.006788 -0.195359 0.981816 0.758001 0.419952 1.868089 1.758394 1.479010 0.921655 0.244745 -0.038674 1.158515 0.987245 0.469852 0.442126 1.652528 1.699770 0.900506 1.793377 1.368738 0.405805 1.083967 0.706228 0.759055 0.550546 0.985536 0.835398 1.537041 1.252754 0.414912 1.587016 0.741668 0.441787 0.537126 1.829954 1.207186 -0.038603 0.324826 1.093300 0.845470)
)
;;; 256 prime --------------------------------------------------------------------------------
-(vector 256 27.740 #(0 1 0 1 0 1 0 1 0 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 1 1 0 0 1 1 1 0 1 0 0 1 1 1 1 1 1 0 0 1 0 0 0 1 0 1 0 1 1 1 0 0 0 0 0 0 1 1 0 1 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 0 0 0 1 0 0 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 1 1 0 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 1 0 0 0 0 1)
+(vector 256 27.740 #r(0 1 0 1 0 1 0 1 0 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 1 1 0 0 1 1 1 0 1 0 0 1 1 1 1 1 1 0 0 1 0 0 0 1 0 1 0 1 1 1 0 0 0 0 0 0 1 1 0 1 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 0 0 0 1 0 0 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 1 1 0 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 1 0 0 0 0 1)
- 23.954812 #(0.000000 1.204657 1.078759 1.682184 0.289433 1.857298 -0.103078 0.812130 1.708916 1.896961 1.156555 1.703874 1.227021 0.182267 1.041071 0.489158 1.008682 0.135723 0.046495 1.634992 0.566031 1.311776 1.337489 0.673226 1.836763 0.159154 0.202747 0.341271 0.471573 0.119586 1.124289 1.100574 1.091468 1.313210 0.642853 0.117292 -0.058379 0.647409 0.710309 0.207284 0.060417 0.146614 1.530493 1.426852 1.584556 0.403196 0.281684 1.359791 1.211733 1.335753 1.885602 1.477601 0.688497 0.894421 1.600991 1.328569 0.005997 0.453096 0.992624 0.185444 0.508566 0.835246 0.264281 0.242464 0.561992 0.572786 1.360366 0.402158 1.414686 0.275179 0.381572 -0.113917 0.093761 0.181937 1.876554 0.763184 0.742398 0.316668 0.919942 0.466632 1.953058 0.269310 1.678357 0.562522 0.033550 0.978955 0.884214 0.441468 1.069549 1.818992 0.418629 1.336178 1.464108 0.008854 1.818306 0.399905 1.080809 0.763485 0.787603 1.378379 0.936433 0.806686 0.536881 1.819028 1.671276 0.786432 1.275261 1.884577 0.933469 1.355576 1.479258 0.462174 0.332804 0.282457 0.550215 0.317652 0.454496 0.923565 0.787078 1.464952 0.107434 1.071904 1.315331 0.744343 0.731492 0.092424 1.422672 1.730219 1.887932 1.793030 0.347585 0.560825 1.039175 1.321464 0.820946 1.971856 1.662872 1.726858 0.163305 0.618347 1.843241 1.984311 0.060498 0.046747 0.257781 0.365656 1.677750 -0.207494 0.053362 0.938280 1.295484 0.245637 0.522272 1.268074 1.776463 1.391102 0.235187 1.356696 0.411477 0.726380 0.608354 1.031435 0.374485 1.212534 0.683978 1.636985 -0.020727 1.002990 0.490099 1.193211 1.072433 1.116935 0.177132 1.577198 1.488833 1.426992 0.196808 1.359200 0.812178 0.923445 1.498869 0.535636 1.325569 0.453085 0.957271 0.999087 0.721363 0.748530 0.296873 0.424017 1.951248 0.179282 0.622927 -0.057442 0.420195 1.292402 0.421561 0.376166 1.549061 0.996315 0.165646 0.418099 0.201640 0.421702 0.831456 0.106402 1.463327 0.005503 1.240637 0.776492 0.181978 0.800991 0.047810 1.685961 1.102672 1.488982 0.855213 0.435527 1.756187 1.183435 0.997613 0.162344 0.965285 0.203761 1.756880 0.117280 1.723671 0.647873 1.760056 1.248565 0.397491 1.167098 0.048428 0.194870 -0.145837 0.946144 1.336821 0.037491 0.496156 0.411789 1.814729 0.171113 0.774274 1.046076 0.369134 1.865905 1.353847 0.811560 1.792633 0.305766 0.578868 1.799589 0.584644 1.768023 1.140595 0.983334)
+ 23.954812 #r(0.000000 1.204657 1.078759 1.682184 0.289433 1.857298 -0.103078 0.812130 1.708916 1.896961 1.156555 1.703874 1.227021 0.182267 1.041071 0.489158 1.008682 0.135723 0.046495 1.634992 0.566031 1.311776 1.337489 0.673226 1.836763 0.159154 0.202747 0.341271 0.471573 0.119586 1.124289 1.100574 1.091468 1.313210 0.642853 0.117292 -0.058379 0.647409 0.710309 0.207284 0.060417 0.146614 1.530493 1.426852 1.584556 0.403196 0.281684 1.359791 1.211733 1.335753 1.885602 1.477601 0.688497 0.894421 1.600991 1.328569 0.005997 0.453096 0.992624 0.185444 0.508566 0.835246 0.264281 0.242464 0.561992 0.572786 1.360366 0.402158 1.414686 0.275179 0.381572 -0.113917 0.093761 0.181937 1.876554 0.763184 0.742398 0.316668 0.919942 0.466632 1.953058 0.269310 1.678357 0.562522 0.033550 0.978955 0.884214 0.441468 1.069549 1.818992 0.418629 1.336178 1.464108 0.008854 1.818306 0.399905 1.080809 0.763485 0.787603 1.378379 0.936433 0.806686 0.536881 1.819028 1.671276 0.786432 1.275261 1.884577 0.933469 1.355576 1.479258 0.462174 0.332804 0.282457 0.550215 0.317652 0.454496 0.923565 0.787078 1.464952 0.107434 1.071904 1.315331 0.744343 0.731492 0.092424 1.422672 1.730219 1.887932 1.793030 0.347585 0.560825 1.039175 1.321464 0.820946 1.971856 1.662872 1.726858 0.163305 0.618347 1.843241 1.984311 0.060498 0.046747 0.257781 0.365656 1.677750 -0.207494 0.053362 0.938280 1.295484 0.245637 0.522272 1.268074 1.776463 1.391102 0.235187 1.356696 0.411477 0.726380 0.608354 1.031435 0.374485 1.212534 0.683978 1.636985 -0.020727 1.002990 0.490099 1.193211 1.072433 1.116935 0.177132 1.577198 1.488833 1.426992 0.196808 1.359200 0.812178 0.923445 1.498869 0.535636 1.325569 0.453085 0.957271 0.999087 0.721363 0.748530 0.296873 0.424017 1.951248 0.179282 0.622927 -0.057442 0.420195 1.292402 0.421561 0.376166 1.549061 0.996315 0.165646 0.418099 0.201640 0.421702 0.831456 0.106402 1.463327 0.005503 1.240637 0.776492 0.181978 0.800991 0.047810 1.685961 1.102672 1.488982 0.855213 0.435527 1.756187 1.183435 0.997613 0.162344 0.965285 0.203761 1.756880 0.117280 1.723671 0.647873 1.760056 1.248565 0.397491 1.167098 0.048428 0.194870 -0.145837 0.946144 1.336821 0.037491 0.496156 0.411789 1.814729 0.171113 0.774274 1.046076 0.369134 1.865905 1.353847 0.811560 1.792633 0.305766 0.578868 1.799589 0.584644 1.768023 1.140595 0.983334)
)
;;; 512 prime --------------------------------------------------------------------------------
-(vector 512 43.486 #(0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 0 0 0 0 1 0 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1 1 1 0 0 1 1 0 1 0 0 1 1 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0 1 0 0 1 1 1 0 0 1 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 0 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 0 1 0 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 0 0 0 0 1 0 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 0 0 0 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 1 1 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 1 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 1)
+(vector 512 43.486 #r(0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 0 0 0 0 1 0 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1 1 1 0 0 1 1 0 1 0 0 1 1 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0 1 0 0 1 1 1 0 0 1 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 0 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 0 1 0 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 0 0 0 0 1 0 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 0 0 0 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 1 1 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 1 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 1)
- 38.602884 #(0.000000 1.082143 1.690042 0.893575 0.756109 0.365343 0.807438 0.940757 0.585435 0.342350 0.594341 1.140652 1.817226 1.102492 0.331462 1.612595 0.512173 -1.909591 0.094152 0.360726 0.151765 0.706858 0.749498 1.906233 1.235313 0.796232 0.500830 0.064536 1.490244 0.959772 0.522500 0.779779 0.400580 1.439171 1.288511 1.693600 1.634346 1.612029 0.250323 0.286364 -0.273948 -0.057072 0.444920 0.673291 1.660718 0.950511 -0.044480 1.277714 0.922828 1.742498 0.067040 1.123761 0.731844 1.393404 1.039320 1.324896 1.831174 0.387406 1.709067 0.274769 1.267431 0.959919 0.715608 1.693570 0.000362 1.870214 0.699669 0.668933 0.997821 -0.008050 1.092934 0.993144 0.278118 0.973866 0.508203 1.715050 0.139916 0.132362 1.047327 -0.053979 0.185439 0.405403 1.344059 0.788131 1.083324 0.893261 1.764451 1.883814 1.299760 0.554300 0.979273 1.155257 1.533722 0.768283 0.256481 0.366299 0.921394 1.649597 0.976718 0.165847 0.006944 0.856772 0.899715 1.074092 0.112821 1.082075 0.258835 0.138175 -0.004825 0.001351 1.429175 0.630347 0.684026 0.531342 0.847633 0.762458 0.815632 0.219787 0.092949 0.202477 0.797900 -0.145417 -0.117708 1.761218 0.769741 1.161104 1.342323 0.523211 0.405201 0.497008 0.787122 1.231664 1.866867 0.811507 1.822296 0.236359 -0.004728 0.793757 0.887814 1.429788 1.804982 1.942786 0.923502 0.603222 0.794618 0.368216 1.088308 0.796327 0.542686 1.544013 1.716025 0.878200 1.782174 0.062214 0.364255 0.646601 0.833457 0.599270 0.751311 0.607033 1.116295 0.605117 1.252490 0.144452 0.065646 0.340371 1.042827 1.788314 1.880686 0.569623 0.189168 0.776287 1.195192 0.727742 0.491941 0.571446 0.260116 1.294844 -0.224851 1.513707 1.029946 1.744464 -0.045793 1.705297 0.170929 0.776558 1.159210 1.100586 0.974908 0.889723 0.131669 1.514065 0.483669 0.374957 1.765248 0.173880 1.574655 0.579673 1.075226 1.695626 0.618344 0.910042 1.785601 1.685191 1.340397 -0.031592 1.930247 1.607968 0.311691 1.234826 1.008031 0.136574 0.693831 1.350593 1.790691 1.248723 0.321392 0.332409 0.211515 0.677389 0.675342 0.748083 1.542146 0.537541 0.945052 0.644544 1.587504 -0.198604 0.497285 1.589685 1.631769 -0.102021 1.434262 0.504366 1.007294 -0.071908 0.889783 0.106723 1.597262 1.184125 1.385914 1.784083 1.814813 1.444514 0.168106 0.275712 -0.230240 1.482952 1.749244 0.624319 0.820132 0.038543 0.453451 1.192705 1.551536 0.933988 1.412615 0.290421 0.996887 0.879431 1.841715 0.672561 0.642185 1.873294 1.346219 1.516340 0.034439 -0.025203 0.114641 1.027748 0.436673 1.695049 0.946949 0.531849 0.288148 0.279537 1.094778 0.375490 0.307554 0.627782 0.418409 0.832934 0.666935 0.114950 -0.053285 1.218299 1.879745 0.386673 0.915368 -0.165173 1.124058 0.466149 1.878428 1.629128 1.512993 0.806896 0.046040 1.932554 1.129093 0.063911 0.559840 1.823056 0.947920 0.467855 1.479381 1.855655 0.408469 1.725599 1.305170 0.270211 0.911615 0.523954 1.318986 1.354400 1.104393 0.792536 0.687738 1.816953 0.079500 1.734615 0.148004 0.393542 1.491324 1.809997 0.036899 1.917219 0.036016 1.292915 1.439271 0.992174 0.734749 0.043086 0.632449 1.678465 1.214089 0.407041 1.157576 0.467194 1.849834 1.465874 1.299867 0.452820 0.577350 1.178402 0.504471 1.704246 1.529399 0.119449 1.587272 1.187154 1.736018 1.251019 0.054071 0.448967 1.151610 -0.041983 -0.058564 1.189234 1.429143 1.489017 0.205182 1.257753 0.994036 0.781546 0.390902 0.744400 1.772431 0.919261 0.499894 0.419934 0.281518 0.736860 0.910447 1.681100 1.722013 1.141474 0.827377 0.320102 0.007503 0.593080 1.581219 0.475353 0.227567 1.630156 0.895436 0.162740 0.389713 0.427078 0.505436 0.990570 0.227561 1.922194 1.293488 0.525156 0.798692 0.804781 1.222760 -0.002373 0.214414 1.011966 1.489753 0.749041 1.209362 1.542616 0.129806 1.948618 0.096126 0.340987 1.210097 1.746925 0.607998 0.771692 0.843752 0.870293 0.931325 1.216995 -0.219011 0.558727 0.605157 0.764943 0.813267 0.109796 0.025290 0.418750 0.976910 0.611063 1.425653 1.312703 1.416454 1.541723 0.279510 0.000239 1.660016 0.196937 1.482933 0.237398 1.048222 1.226372 0.074770 0.565242 0.782888 1.814840 1.669287 0.878760 1.658003 1.628831 0.063412 1.934276 0.152397 1.633067 1.697411 0.919379 1.358819 1.021028 1.568829 0.560019 1.191100 1.722100 0.879855 0.967865 1.958702 0.180163 1.190964 1.472899 0.387723 1.635329 -0.004167 1.194302 0.101361 0.922515 1.847355 1.174116 0.380497 0.721821 1.201075 1.612741 1.020268 -0.168817 0.406276 1.455790 1.666789 0.232089 1.791143 1.515844 0.427944 0.351285 1.732308 0.954418 0.569378 1.065546 1.527300 1.587063 1.317922 0.415597 0.001422 1.240139 0.099248 1.639437 1.663543 0.562245 1.762090 1.669121 1.738347 1.503729 0.665114 0.450457 0.358214 1.358391 1.040768 0.320330 -0.191120 1.844458)
+ 38.602884 #r(0.000000 1.082143 1.690042 0.893575 0.756109 0.365343 0.807438 0.940757 0.585435 0.342350 0.594341 1.140652 1.817226 1.102492 0.331462 1.612595 0.512173 -1.909591 0.094152 0.360726 0.151765 0.706858 0.749498 1.906233 1.235313 0.796232 0.500830 0.064536 1.490244 0.959772 0.522500 0.779779 0.400580 1.439171 1.288511 1.693600 1.634346 1.612029 0.250323 0.286364 -0.273948 -0.057072 0.444920 0.673291 1.660718 0.950511 -0.044480 1.277714 0.922828 1.742498 0.067040 1.123761 0.731844 1.393404 1.039320 1.324896 1.831174 0.387406 1.709067 0.274769 1.267431 0.959919 0.715608 1.693570 0.000362 1.870214 0.699669 0.668933 0.997821 -0.008050 1.092934 0.993144 0.278118 0.973866 0.508203 1.715050 0.139916 0.132362 1.047327 -0.053979 0.185439 0.405403 1.344059 0.788131 1.083324 0.893261 1.764451 1.883814 1.299760 0.554300 0.979273 1.155257 1.533722 0.768283 0.256481 0.366299 0.921394 1.649597 0.976718 0.165847 0.006944 0.856772 0.899715 1.074092 0.112821 1.082075 0.258835 0.138175 -0.004825 0.001351 1.429175 0.630347 0.684026 0.531342 0.847633 0.762458 0.815632 0.219787 0.092949 0.202477 0.797900 -0.145417 -0.117708 1.761218 0.769741 1.161104 1.342323 0.523211 0.405201 0.497008 0.787122 1.231664 1.866867 0.811507 1.822296 0.236359 -0.004728 0.793757 0.887814 1.429788 1.804982 1.942786 0.923502 0.603222 0.794618 0.368216 1.088308 0.796327 0.542686 1.544013 1.716025 0.878200 1.782174 0.062214 0.364255 0.646601 0.833457 0.599270 0.751311 0.607033 1.116295 0.605117 1.252490 0.144452 0.065646 0.340371 1.042827 1.788314 1.880686 0.569623 0.189168 0.776287 1.195192 0.727742 0.491941 0.571446 0.260116 1.294844 -0.224851 1.513707 1.029946 1.744464 -0.045793 1.705297 0.170929 0.776558 1.159210 1.100586 0.974908 0.889723 0.131669 1.514065 0.483669 0.374957 1.765248 0.173880 1.574655 0.579673 1.075226 1.695626 0.618344 0.910042 1.785601 1.685191 1.340397 -0.031592 1.930247 1.607968 0.311691 1.234826 1.008031 0.136574 0.693831 1.350593 1.790691 1.248723 0.321392 0.332409 0.211515 0.677389 0.675342 0.748083 1.542146 0.537541 0.945052 0.644544 1.587504 -0.198604 0.497285 1.589685 1.631769 -0.102021 1.434262 0.504366 1.007294 -0.071908 0.889783 0.106723 1.597262 1.184125 1.385914 1.784083 1.814813 1.444514 0.168106 0.275712 -0.230240 1.482952 1.749244 0.624319 0.820132 0.038543 0.453451 1.192705 1.551536 0.933988 1.412615 0.290421 0.996887 0.879431 1.841715 0.672561 0.642185 1.873294 1.346219 1.516340 0.034439 -0.025203 0.114641 1.027748 0.436673 1.695049 0.946949 0.531849 0.288148 0.279537 1.094778 0.375490 0.307554 0.627782 0.418409 0.832934 0.666935 0.114950 -0.053285 1.218299 1.879745 0.386673 0.915368 -0.165173 1.124058 0.466149 1.878428 1.629128 1.512993 0.806896 0.046040 1.932554 1.129093 0.063911 0.559840 1.823056 0.947920 0.467855 1.479381 1.855655 0.408469 1.725599 1.305170 0.270211 0.911615 0.523954 1.318986 1.354400 1.104393 0.792536 0.687738 1.816953 0.079500 1.734615 0.148004 0.393542 1.491324 1.809997 0.036899 1.917219 0.036016 1.292915 1.439271 0.992174 0.734749 0.043086 0.632449 1.678465 1.214089 0.407041 1.157576 0.467194 1.849834 1.465874 1.299867 0.452820 0.577350 1.178402 0.504471 1.704246 1.529399 0.119449 1.587272 1.187154 1.736018 1.251019 0.054071 0.448967 1.151610 -0.041983 -0.058564 1.189234 1.429143 1.489017 0.205182 1.257753 0.994036 0.781546 0.390902 0.744400 1.772431 0.919261 0.499894 0.419934 0.281518 0.736860 0.910447 1.681100 1.722013 1.141474 0.827377 0.320102 0.007503 0.593080 1.581219 0.475353 0.227567 1.630156 0.895436 0.162740 0.389713 0.427078 0.505436 0.990570 0.227561 1.922194 1.293488 0.525156 0.798692 0.804781 1.222760 -0.002373 0.214414 1.011966 1.489753 0.749041 1.209362 1.542616 0.129806 1.948618 0.096126 0.340987 1.210097 1.746925 0.607998 0.771692 0.843752 0.870293 0.931325 1.216995 -0.219011 0.558727 0.605157 0.764943 0.813267 0.109796 0.025290 0.418750 0.976910 0.611063 1.425653 1.312703 1.416454 1.541723 0.279510 0.000239 1.660016 0.196937 1.482933 0.237398 1.048222 1.226372 0.074770 0.565242 0.782888 1.814840 1.669287 0.878760 1.658003 1.628831 0.063412 1.934276 0.152397 1.633067 1.697411 0.919379 1.358819 1.021028 1.568829 0.560019 1.191100 1.722100 0.879855 0.967865 1.958702 0.180163 1.190964 1.472899 0.387723 1.635329 -0.004167 1.194302 0.101361 0.922515 1.847355 1.174116 0.380497 0.721821 1.201075 1.612741 1.020268 -0.168817 0.406276 1.455790 1.666789 0.232089 1.791143 1.515844 0.427944 0.351285 1.732308 0.954418 0.569378 1.065546 1.527300 1.587063 1.317922 0.415597 0.001422 1.240139 0.099248 1.639437 1.663543 0.562245 1.762090 1.669121 1.738347 1.503729 0.665114 0.450457 0.358214 1.358391 1.040768 0.320330 -0.191120 1.844458)
)
;;; 1024 prime --------------------------------------------------------------------------------
-(vector 1024 70.140 #(0 0 1 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 1 1 0 1 1 1 0 1 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 1 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 1 0 1 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 1 1 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 0 0 1 0 1 0 1 1 0 0 0 0 0 1 1 0 1 1 1 1 1 0 0 1 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 0 0 1 0 1 1 1 0 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 0 1 1 0 1 1 1 1 1 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 0 1 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 1 1 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 1 1 0 1 1 0 1 0 0 1 1 0 1 1 0 0 1 1 0 0 0 0 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 1 0 1 0 1 0 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 0 0 1 1 0 0 1 1 0 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 1 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 1 0 1 1 0 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 0 1 1 0 1 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0 1 0 1 0 1 1)
+(vector 1024 70.140 #r(0 0 1 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 1 1 0 1 1 1 0 1 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 1 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 1 0 1 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 1 1 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 0 0 1 0 1 0 1 1 0 0 0 0 0 1 1 0 1 1 1 1 1 0 0 1 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 0 0 1 0 1 1 1 0 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 0 1 1 0 1 1 1 1 1 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 0 1 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 1 1 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 1 1 0 1 1 0 1 0 0 1 1 0 1 1 0 0 1 1 0 0 0 0 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 1 0 1 0 1 0 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 0 0 1 1 0 0 1 1 0 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 1 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 1 0 1 1 0 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 0 1 1 0 1 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0 1 0 1 0 1 1)
- 65.349256 #(0.000000 -0.129848 0.969209 0.836351 0.061754 1.032484 0.051397 -0.047672 0.218624 0.018916 -0.064346 -0.087720 0.896115 1.194836 0.077672 -0.093665 -0.097710 -0.086592 0.949666 1.122929 -0.067767 0.950039 1.122745 0.018018 0.930855 -0.245701 0.859196 -0.118393 -0.017421 0.154025 -0.211100 -0.109137 0.940842 -0.140564 0.967517 -0.167684 0.023269 0.025376 -0.045911 0.903419 -0.200515 -0.239733 0.820269 1.087952 1.103155 -0.067139 0.794572 -0.000447 0.796383 -0.050127 -0.097253 1.071546 0.028226 0.109239 0.999458 0.870447 0.946254 -0.081085 1.245293 0.861076 0.913395 -0.009593 0.921868 1.075746 0.111204 0.213778 0.007799 0.861516 0.879520 1.119282 1.112758 0.023180 0.087708 -0.039342 0.017034 -0.142251 -0.066926 0.123437 -0.087868 0.910913 0.108597 -0.196132 1.069560 1.014239 0.192506 0.075011 0.674937 -0.174632 1.062546 0.982886 -0.071153 -0.102231 1.008769 -0.021251 -0.043692 0.910660 1.203363 0.930076 1.192149 1.079643 1.139869 -0.102933 0.892075 1.081967 1.117296 1.069641 0.961155 0.889926 0.104236 -0.012679 1.018557 0.083425 0.102764 1.041332 1.049506 1.057530 0.927572 -0.192969 -0.132492 0.997314 1.171628 1.067315 1.038820 1.033745 1.322831 -0.007981 0.994085 0.965156 0.070645 1.143780 -0.097751 -0.035141 1.081372 0.841845 0.110341 -0.016561 1.124066 1.050833 0.937074 0.926741 -0.150226 0.056436 0.964946 1.014226 0.961483 0.200116 -0.027025 -0.042596 0.873435 1.128675 -0.074217 0.034750 0.002625 0.037174 1.052187 -0.007505 1.057468 -0.020629 0.954765 1.162873 0.836305 0.919671 0.176115 0.867824 0.159416 0.913293 0.972493 -0.057629 0.902111 0.973589 -0.086627 -0.008031 -0.139087 0.943821 1.137966 0.070214 -0.004563 0.871135 -0.028372 0.970905 -0.036782 0.845326 0.108872 0.880706 -0.063917 0.888627 0.925543 1.066596 0.853571 -0.093806 0.904332 -0.112339 0.945758 0.871634 -0.096140 1.001890 1.129246 0.963672 0.170539 1.085873 0.061910 1.045363 -0.043655 0.071480 -0.112838 1.140479 -0.203871 0.018032 0.967477 -0.109462 0.786798 0.159117 0.091987 1.000511 0.121439 0.998700 0.114766 0.043124 -0.051500 1.039391 -0.116269 0.884009 0.038584 0.870599 -0.009894 -0.177026 1.208055 1.281757 0.041090 1.074146 -0.185247 -0.160109 -0.084894 -0.013678 1.116236 0.043626 0.914436 1.186335 0.008002 -0.013450 -0.068550 0.867764 -0.069795 0.028624 1.053037 1.105179 1.148503 -0.078114 -0.107345 0.808140 0.888280 -0.101397 0.863680 -0.177989 0.805880 0.985054 0.997369 0.970739 0.045371 0.041317 -0.112380 1.007911 0.837435 0.969586 0.893134 1.011096 0.079245 0.911597 -0.043743 1.012740 1.031412 0.069924 0.910651 0.066980 0.855519 1.128309 1.046886 -0.009687 -0.147082 0.900969 1.137525 0.881305 1.084781 -0.031000 1.031283 0.123503 -0.135598 0.951868 0.887466 -0.122854 -0.039498 1.017664 -0.102471 1.018993 1.022945 0.093609 0.101814 1.044330 -0.102747 0.051954 0.001832 1.002061 1.025387 0.930853 0.958319 0.146189 0.932064 0.106399 1.032653 0.014707 0.032026 0.879101 -0.027770 0.031687 0.111934 0.802921 -0.076047 0.059286 0.065123 0.128711 0.974155 1.040636 -0.158251 -0.044445 -0.146345 1.152523 0.901758 -0.061750 0.921515 0.108254 -0.128639 1.088615 0.119335 1.107712 0.012965 0.831934 0.917791 0.827352 0.931376 0.029208 0.968659 1.110903 1.139422 0.103217 0.804597 0.104877 1.024813 1.110962 1.158506 1.074313 0.918885 1.091629 1.052239 1.155470 0.969547 0.176177 1.193274 1.000806 0.167489 -0.087811 1.272916 0.090580 0.837388 0.853777 0.021673 0.795498 0.153088 -0.039163 0.886259 0.953876 0.846456 0.902225 0.108103 -0.023242 1.091272 0.796242 1.011212 0.961046 1.021211 0.039001 -0.032781 1.042170 1.131254 1.092307 0.999148 0.071362 0.869992 0.079822 1.110594 1.044065 1.166722 0.955017 0.117000 0.059709 1.113545 0.131377 1.023012 -0.114272 0.975103 0.983023 -0.046717 0.032378 0.224959 -0.069345 0.040516 1.089631 0.899237 0.136151 0.832552 1.215356 0.881670 0.944211 0.848668 0.152316 -0.124640 0.919395 0.853571 0.038901 0.049308 1.049839 -0.129701 1.004425 -0.052754 0.002949 -0.037696 0.133904 -0.020847 0.967100 0.902003 0.019567 -0.130260 -0.157473 -0.071944 0.135523 0.944472 -0.199005 -0.011428 -0.057531 1.218722 0.021172 0.873547 0.871952 0.950595 -0.066828 0.911583 0.960085 0.059484 1.216384 -0.015251 0.921576 1.107399 1.190526 1.009427 1.067453 1.067973 0.105850 -0.001821 0.968722 0.047666 0.095350 1.060487 0.951973 0.082517 1.139249 1.053557 0.799986 0.981175 0.927100 1.108483 -0.113217 0.056334 0.923079 -0.168060 1.160952 1.109659 0.931859 0.005663 0.016298 0.221144 -0.021547 1.134376 1.041640 -0.085720 1.009292 1.001582 0.885811 0.011233 0.110421 0.907129 0.093259 0.973361 0.842954 0.055170 1.054987 1.014198 -0.048044 0.812989 -0.144503 0.010466 1.029196 0.774851 0.843001 0.004633 1.225056 0.948512 -0.001831 -0.091454 -0.110441 0.000770 0.042991 0.840050 0.957463 0.073186 1.131453 -0.127608 1.100834 0.028867 0.991329 -0.079297 0.226099 1.081074 1.094744 -0.196334 -0.315150 -0.099639 0.860961 1.022403 0.767717 0.956186 1.242205 -0.055123 0.982544 1.115183 0.186049 0.867447 -0.036624 0.161043 -0.021433 0.029621 0.825744 0.027361 -0.010122 1.051195 0.027158 0.125747 -0.012676 1.018144 0.217569 -0.139580 1.065948 0.653885 0.017558 0.122910 1.005607 -0.024503 1.016854 0.118126 0.117812 0.209380 0.129761 0.103368 0.851695 0.818381 -0.060532 0.047740 1.092005 0.126179 -0.128900 1.046458 1.172438 0.945933 0.969409 0.186286 0.067827 0.866733 1.045200 1.053391 0.154799 -0.076177 1.034977 -0.251459 0.843987 1.036970 0.109710 1.081980 -0.054976 -0.104881 0.977835 0.917720 1.151081 1.224827 0.036178 1.178894 0.852252 1.170082 1.170461 0.979772 0.962385 0.904510 0.000036 -0.069878 0.919872 0.173255 1.075581 -0.013411 1.144951 -0.113696 0.013363 1.098609 1.014644 -0.003549 -0.244091 0.859325 1.071514 0.043866 1.123524 0.973631 0.994259 0.294619 0.940489 0.920230 0.796504 -0.004450 1.029035 -0.000831 0.920995 1.002150 0.986683 1.009523 1.089643 0.007497 1.152282 0.045887 1.088386 0.885838 -0.027924 0.051985 -0.076538 -0.224663 0.028256 -0.124194 0.724391 1.154873 0.792085 0.945537 1.154353 0.115964 0.986499 0.966811 1.012457 1.019910 -0.144866 0.815479 0.985586 0.913383 -0.150963 0.023412 -0.040408 -0.003953 0.004799 0.998876 0.002820 -0.098213 1.057293 -0.129926 0.137392 1.102538 1.079292 1.089070 1.130675 1.020925 1.154058 1.123118 0.858700 0.978386 0.138491 0.154692 1.041549 1.046975 1.030488 -0.158543 0.870238 0.064134 0.875614 -0.094478 0.900905 0.880022 1.134267 0.779059 0.063545 1.070040 -0.086015 1.008573 0.109322 -0.247240 0.015151 1.151193 -0.102164 0.087261 0.007995 0.854703 1.140979 -0.090975 0.812937 1.001838 0.168940 0.981369 -0.006072 -0.134631 1.058021 1.081911 0.004162 1.014677 0.995130 1.055979 -0.015306 0.058775 1.111668 0.059318 1.008648 0.996646 0.848989 -0.109175 1.102945 0.116474 0.906494 -0.120660 0.877452 0.886871 0.085411 0.884701 1.181621 1.062561 0.189097 0.973371 1.214908 0.001252 1.030678 0.152018 -0.037592 1.176813 0.948804 0.061120 1.019977 1.028438 -0.000808 0.087217 0.826864 0.893273 -0.207696 -0.074786 -0.108728 0.152240 -0.121688 0.980366 -0.049309 0.988905 0.044844 1.037851 0.979360 0.997856 1.209193 0.179051 1.004545 0.962175 1.139200 1.064077 0.021192 0.871727 0.976645 -0.060807 -0.016180 1.233966 0.984256 -0.044995 0.845917 0.182605 0.998382 0.007096 -0.023173 -0.024155 0.146239 1.013539 0.995536 0.048524 1.174691 1.141919 1.101145 -0.104732 0.114083 1.102748 0.983142 1.123097 -0.131915 1.072939 -0.138725 0.845004 -0.163152 -0.079593 1.018944 1.012216 0.030165 1.054447 0.994960 0.152361 -0.060656 1.093567 0.946563 0.106698 0.153793 -0.034551 1.295949 0.943407 -0.163119 0.067866 1.194305 0.979105 1.022403 1.106721 0.934941 -0.016105 1.092573 -0.050474 0.132465 0.025768 0.046448 0.920971 0.032186 0.827060 -0.132549 0.143363 0.083704 0.912578 -0.030293 0.096970 -0.039315 -0.023765 1.016646 0.854818 -0.052889 1.056921 0.089890 1.018924 0.081699 -0.114805 0.930082 -0.021013 0.109704 0.995297 -0.078029 1.125314 0.178931 0.020308 -0.221485 1.187702 0.047629 0.040061 1.015073 0.069320 0.060090 -0.115159 1.088644 -0.081572 0.068986 0.955768 0.084087 0.114901 1.013399 0.080815 -0.114939 1.007244 -0.059946 1.062447 1.043256 0.100314 1.021597 1.004933 -0.021577 -0.187720 -0.061395 -0.075323 -0.009496 0.985795 0.872323 -0.046461 0.888848 -0.053261 -0.110021 1.099191 0.979002 1.060305 1.062463 1.171427 0.691334 1.098940 0.054888 -0.017909 -0.010409 -0.111589 0.082490 0.948398 1.144871 0.127743 0.031811 1.026180 1.046146 -0.030210 -0.103802 0.989801 -0.310437 1.153393 1.012685 0.952894 1.001378 0.015652 1.054587 1.328504 -0.151531 1.037238 1.151575 0.030623 1.108802 -0.028053 0.044671 0.901073 0.934031 0.058498 0.039050 1.065155 0.024139 -0.131291 -0.082086 0.854526 1.154246 -0.049980 -0.184925 1.049877 -0.115467 -0.018300 1.001119 0.057983 1.189518 -0.114544 1.258100 1.123841 0.961039 1.070424 -0.124628 0.209509 0.034004 0.948762 1.100182 0.083224 0.948264 1.081482 0.076927 -0.000455 0.950737 0.098354 1.005742 1.019785 0.974317 0.230726 -0.067827 1.165865 0.048218 -0.058027 0.937849 0.079916 -0.012394 0.069161 0.050349 0.906284 0.832283 0.101171 0.790746 0.156878 0.740395 1.017554 0.191391 0.080956 1.000597 0.844203 0.944456 -0.111179 0.982617 1.037761 0.099785 0.851180 0.116591 0.142708 -0.015906 0.096645 0.965791 0.020953 0.925519 1.197465 -0.055737 1.095928 -0.064679 0.010255 0.936661 1.178645 0.190866 1.141107 0.130145 0.023056 0.121484 0.185090 -0.056773 0.100045 0.069574 1.039529 0.996635 1.085726 0.949189 -0.165723 -0.039203 1.116369 -0.064244 0.940174 -0.154655 1.121041 0.902088)
+ 65.349256 #r(0.000000 -0.129848 0.969209 0.836351 0.061754 1.032484 0.051397 -0.047672 0.218624 0.018916 -0.064346 -0.087720 0.896115 1.194836 0.077672 -0.093665 -0.097710 -0.086592 0.949666 1.122929 -0.067767 0.950039 1.122745 0.018018 0.930855 -0.245701 0.859196 -0.118393 -0.017421 0.154025 -0.211100 -0.109137 0.940842 -0.140564 0.967517 -0.167684 0.023269 0.025376 -0.045911 0.903419 -0.200515 -0.239733 0.820269 1.087952 1.103155 -0.067139 0.794572 -0.000447 0.796383 -0.050127 -0.097253 1.071546 0.028226 0.109239 0.999458 0.870447 0.946254 -0.081085 1.245293 0.861076 0.913395 -0.009593 0.921868 1.075746 0.111204 0.213778 0.007799 0.861516 0.879520 1.119282 1.112758 0.023180 0.087708 -0.039342 0.017034 -0.142251 -0.066926 0.123437 -0.087868 0.910913 0.108597 -0.196132 1.069560 1.014239 0.192506 0.075011 0.674937 -0.174632 1.062546 0.982886 -0.071153 -0.102231 1.008769 -0.021251 -0.043692 0.910660 1.203363 0.930076 1.192149 1.079643 1.139869 -0.102933 0.892075 1.081967 1.117296 1.069641 0.961155 0.889926 0.104236 -0.012679 1.018557 0.083425 0.102764 1.041332 1.049506 1.057530 0.927572 -0.192969 -0.132492 0.997314 1.171628 1.067315 1.038820 1.033745 1.322831 -0.007981 0.994085 0.965156 0.070645 1.143780 -0.097751 -0.035141 1.081372 0.841845 0.110341 -0.016561 1.124066 1.050833 0.937074 0.926741 -0.150226 0.056436 0.964946 1.014226 0.961483 0.200116 -0.027025 -0.042596 0.873435 1.128675 -0.074217 0.034750 0.002625 0.037174 1.052187 -0.007505 1.057468 -0.020629 0.954765 1.162873 0.836305 0.919671 0.176115 0.867824 0.159416 0.913293 0.972493 -0.057629 0.902111 0.973589 -0.086627 -0.008031 -0.139087 0.943821 1.137966 0.070214 -0.004563 0.871135 -0.028372 0.970905 -0.036782 0.845326 0.108872 0.880706 -0.063917 0.888627 0.925543 1.066596 0.853571 -0.093806 0.904332 -0.112339 0.945758 0.871634 -0.096140 1.001890 1.129246 0.963672 0.170539 1.085873 0.061910 1.045363 -0.043655 0.071480 -0.112838 1.140479 -0.203871 0.018032 0.967477 -0.109462 0.786798 0.159117 0.091987 1.000511 0.121439 0.998700 0.114766 0.043124 -0.051500 1.039391 -0.116269 0.884009 0.038584 0.870599 -0.009894 -0.177026 1.208055 1.281757 0.041090 1.074146 -0.185247 -0.160109 -0.084894 -0.013678 1.116236 0.043626 0.914436 1.186335 0.008002 -0.013450 -0.068550 0.867764 -0.069795 0.028624 1.053037 1.105179 1.148503 -0.078114 -0.107345 0.808140 0.888280 -0.101397 0.863680 -0.177989 0.805880 0.985054 0.997369 0.970739 0.045371 0.041317 -0.112380 1.007911 0.837435 0.969586 0.893134 1.011096 0.079245 0.911597 -0.043743 1.012740 1.031412 0.069924 0.910651 0.066980 0.855519 1.128309 1.046886 -0.009687 -0.147082 0.900969 1.137525 0.881305 1.084781 -0.031000 1.031283 0.123503 -0.135598 0.951868 0.887466 -0.122854 -0.039498 1.017664 -0.102471 1.018993 1.022945 0.093609 0.101814 1.044330 -0.102747 0.051954 0.001832 1.002061 1.025387 0.930853 0.958319 0.146189 0.932064 0.106399 1.032653 0.014707 0.032026 0.879101 -0.027770 0.031687 0.111934 0.802921 -0.076047 0.059286 0.065123 0.128711 0.974155 1.040636 -0.158251 -0.044445 -0.146345 1.152523 0.901758 -0.061750 0.921515 0.108254 -0.128639 1.088615 0.119335 1.107712 0.012965 0.831934 0.917791 0.827352 0.931376 0.029208 0.968659 1.110903 1.139422 0.103217 0.804597 0.104877 1.024813 1.110962 1.158506 1.074313 0.918885 1.091629 1.052239 1.155470 0.969547 0.176177 1.193274 1.000806 0.167489 -0.087811 1.272916 0.090580 0.837388 0.853777 0.021673 0.795498 0.153088 -0.039163 0.886259 0.953876 0.846456 0.902225 0.108103 -0.023242 1.091272 0.796242 1.011212 0.961046 1.021211 0.039001 -0.032781 1.042170 1.131254 1.092307 0.999148 0.071362 0.869992 0.079822 1.110594 1.044065 1.166722 0.955017 0.117000 0.059709 1.113545 0.131377 1.023012 -0.114272 0.975103 0.983023 -0.046717 0.032378 0.224959 -0.069345 0.040516 1.089631 0.899237 0.136151 0.832552 1.215356 0.881670 0.944211 0.848668 0.152316 -0.124640 0.919395 0.853571 0.038901 0.049308 1.049839 -0.129701 1.004425 -0.052754 0.002949 -0.037696 0.133904 -0.020847 0.967100 0.902003 0.019567 -0.130260 -0.157473 -0.071944 0.135523 0.944472 -0.199005 -0.011428 -0.057531 1.218722 0.021172 0.873547 0.871952 0.950595 -0.066828 0.911583 0.960085 0.059484 1.216384 -0.015251 0.921576 1.107399 1.190526 1.009427 1.067453 1.067973 0.105850 -0.001821 0.968722 0.047666 0.095350 1.060487 0.951973 0.082517 1.139249 1.053557 0.799986 0.981175 0.927100 1.108483 -0.113217 0.056334 0.923079 -0.168060 1.160952 1.109659 0.931859 0.005663 0.016298 0.221144 -0.021547 1.134376 1.041640 -0.085720 1.009292 1.001582 0.885811 0.011233 0.110421 0.907129 0.093259 0.973361 0.842954 0.055170 1.054987 1.014198 -0.048044 0.812989 -0.144503 0.010466 1.029196 0.774851 0.843001 0.004633 1.225056 0.948512 -0.001831 -0.091454 -0.110441 0.000770 0.042991 0.840050 0.957463 0.073186 1.131453 -0.127608 1.100834 0.028867 0.991329 -0.079297 0.226099 1.081074 1.094744 -0.196334 -0.315150 -0.099639 0.860961 1.022403 0.767717 0.956186 1.242205 -0.055123 0.982544 1.115183 0.186049 0.867447 -0.036624 0.161043 -0.021433 0.029621 0.825744 0.027361 -0.010122 1.051195 0.027158 0.125747 -0.012676 1.018144 0.217569 -0.139580 1.065948 0.653885 0.017558 0.122910 1.005607 -0.024503 1.016854 0.118126 0.117812 0.209380 0.129761 0.103368 0.851695 0.818381 -0.060532 0.047740 1.092005 0.126179 -0.128900 1.046458 1.172438 0.945933 0.969409 0.186286 0.067827 0.866733 1.045200 1.053391 0.154799 -0.076177 1.034977 -0.251459 0.843987 1.036970 0.109710 1.081980 -0.054976 -0.104881 0.977835 0.917720 1.151081 1.224827 0.036178 1.178894 0.852252 1.170082 1.170461 0.979772 0.962385 0.904510 0.000036 -0.069878 0.919872 0.173255 1.075581 -0.013411 1.144951 -0.113696 0.013363 1.098609 1.014644 -0.003549 -0.244091 0.859325 1.071514 0.043866 1.123524 0.973631 0.994259 0.294619 0.940489 0.920230 0.796504 -0.004450 1.029035 -0.000831 0.920995 1.002150 0.986683 1.009523 1.089643 0.007497 1.152282 0.045887 1.088386 0.885838 -0.027924 0.051985 -0.076538 -0.224663 0.028256 -0.124194 0.724391 1.154873 0.792085 0.945537 1.154353 0.115964 0.986499 0.966811 1.012457 1.019910 -0.144866 0.815479 0.985586 0.913383 -0.150963 0.023412 -0.040408 -0.003953 0.004799 0.998876 0.002820 -0.098213 1.057293 -0.129926 0.137392 1.102538 1.079292 1.089070 1.130675 1.020925 1.154058 1.123118 0.858700 0.978386 0.138491 0.154692 1.041549 1.046975 1.030488 -0.158543 0.870238 0.064134 0.875614 -0.094478 0.900905 0.880022 1.134267 0.779059 0.063545 1.070040 -0.086015 1.008573 0.109322 -0.247240 0.015151 1.151193 -0.102164 0.087261 0.007995 0.854703 1.140979 -0.090975 0.812937 1.001838 0.168940 0.981369 -0.006072 -0.134631 1.058021 1.081911 0.004162 1.014677 0.995130 1.055979 -0.015306 0.058775 1.111668 0.059318 1.008648 0.996646 0.848989 -0.109175 1.102945 0.116474 0.906494 -0.120660 0.877452 0.886871 0.085411 0.884701 1.181621 1.062561 0.189097 0.973371 1.214908 0.001252 1.030678 0.152018 -0.037592 1.176813 0.948804 0.061120 1.019977 1.028438 -0.000808 0.087217 0.826864 0.893273 -0.207696 -0.074786 -0.108728 0.152240 -0.121688 0.980366 -0.049309 0.988905 0.044844 1.037851 0.979360 0.997856 1.209193 0.179051 1.004545 0.962175 1.139200 1.064077 0.021192 0.871727 0.976645 -0.060807 -0.016180 1.233966 0.984256 -0.044995 0.845917 0.182605 0.998382 0.007096 -0.023173 -0.024155 0.146239 1.013539 0.995536 0.048524 1.174691 1.141919 1.101145 -0.104732 0.114083 1.102748 0.983142 1.123097 -0.131915 1.072939 -0.138725 0.845004 -0.163152 -0.079593 1.018944 1.012216 0.030165 1.054447 0.994960 0.152361 -0.060656 1.093567 0.946563 0.106698 0.153793 -0.034551 1.295949 0.943407 -0.163119 0.067866 1.194305 0.979105 1.022403 1.106721 0.934941 -0.016105 1.092573 -0.050474 0.132465 0.025768 0.046448 0.920971 0.032186 0.827060 -0.132549 0.143363 0.083704 0.912578 -0.030293 0.096970 -0.039315 -0.023765 1.016646 0.854818 -0.052889 1.056921 0.089890 1.018924 0.081699 -0.114805 0.930082 -0.021013 0.109704 0.995297 -0.078029 1.125314 0.178931 0.020308 -0.221485 1.187702 0.047629 0.040061 1.015073 0.069320 0.060090 -0.115159 1.088644 -0.081572 0.068986 0.955768 0.084087 0.114901 1.013399 0.080815 -0.114939 1.007244 -0.059946 1.062447 1.043256 0.100314 1.021597 1.004933 -0.021577 -0.187720 -0.061395 -0.075323 -0.009496 0.985795 0.872323 -0.046461 0.888848 -0.053261 -0.110021 1.099191 0.979002 1.060305 1.062463 1.171427 0.691334 1.098940 0.054888 -0.017909 -0.010409 -0.111589 0.082490 0.948398 1.144871 0.127743 0.031811 1.026180 1.046146 -0.030210 -0.103802 0.989801 -0.310437 1.153393 1.012685 0.952894 1.001378 0.015652 1.054587 1.328504 -0.151531 1.037238 1.151575 0.030623 1.108802 -0.028053 0.044671 0.901073 0.934031 0.058498 0.039050 1.065155 0.024139 -0.131291 -0.082086 0.854526 1.154246 -0.049980 -0.184925 1.049877 -0.115467 -0.018300 1.001119 0.057983 1.189518 -0.114544 1.258100 1.123841 0.961039 1.070424 -0.124628 0.209509 0.034004 0.948762 1.100182 0.083224 0.948264 1.081482 0.076927 -0.000455 0.950737 0.098354 1.005742 1.019785 0.974317 0.230726 -0.067827 1.165865 0.048218 -0.058027 0.937849 0.079916 -0.012394 0.069161 0.050349 0.906284 0.832283 0.101171 0.790746 0.156878 0.740395 1.017554 0.191391 0.080956 1.000597 0.844203 0.944456 -0.111179 0.982617 1.037761 0.099785 0.851180 0.116591 0.142708 -0.015906 0.096645 0.965791 0.020953 0.925519 1.197465 -0.055737 1.095928 -0.064679 0.010255 0.936661 1.178645 0.190866 1.141107 0.130145 0.023056 0.121484 0.185090 -0.056773 0.100045 0.069574 1.039529 0.996635 1.085726 0.949189 -0.165723 -0.039203 1.116369 -0.064244 0.940174 -0.154655 1.121041 0.902088)
)
;;; 2048 prime --------------------------------------------------------------------------------
-(vector 2048 102.619 #(0 0 0 0 1 1 1 1 0 0 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 1 0 1 1 1 0 0 1 0 1 1 1 1 1 0 1 1 0 1 0 0 1 0 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 0 0 0 1 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 1 1 1 1 0 1 1 0 0 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 0 1 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 0 0 1 0 1 0 1 0 1 1 1 0 0 1 1 1 1 1 1 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 1 1 0 1 0 0 1 1 1 1 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 1 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 0 0 0 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1 0 1 1 0 0 1 1 1 1 0 1 0 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 1 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 1 0 1 1 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 0 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1 0 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 1 0 1 1 0 0 1 0 0 1 0 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0 0 1 1 0 0 1 0 0 0 0 1 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 1 1 1 0 0 1 1 1 0 1 0 0 0 1 1 0 1 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 0 1 1 0 0 0 1 1 1 0 0 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 1 0 0 1 0 1 0 1 0 1 0 0 1 0 1 1 0 0 0 0 0 1 1 1 0 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 1 1 1 1 1 0 0 0 1 1 0 0 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 1 0 1 1 1 0 1 0 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 1 0 1 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 0 1 1 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 1 0 0 1 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 1 0 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 0 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 0 0 1 0 1 1 0 1 0 1 0 1 1 0 0 0 0 1 0 0 0 1 0 1 1 0 1 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 0 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 0 1 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 1 1 0 0 0 0 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 0 1 0 0 0 0 1 1 1 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 1 1 0 1 0 0 1 1 1 1 1 1 1 1 0 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 0 1 0 0 0 0 1 1 1 0 1 0 0 0 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 1 1 1 1 0 0 1 0 1 1 1 1 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 1 1)
+(vector 2048 102.619 #r(0 0 0 0 1 1 1 1 0 0 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 1 0 1 1 1 0 0 1 0 1 1 1 1 1 0 1 1 0 1 0 0 1 0 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 0 0 0 1 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 1 1 1 1 0 1 1 0 0 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 0 1 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 0 0 1 0 1 0 1 0 1 1 1 0 0 1 1 1 1 1 1 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 1 1 0 1 0 0 1 1 1 1 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 1 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 0 0 0 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1 0 1 1 0 0 1 1 1 1 0 1 0 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 1 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 1 0 1 1 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 0 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1 0 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 1 0 1 1 0 0 1 0 0 1 0 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0 0 1 1 0 0 1 0 0 0 0 1 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 1 1 1 0 0 1 1 1 0 1 0 0 0 1 1 0 1 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 0 1 1 0 0 0 1 1 1 0 0 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 1 0 0 1 0 1 0 1 0 1 0 0 1 0 1 1 0 0 0 0 0 1 1 1 0 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 1 1 1 1 1 0 0 0 1 1 0 0 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 1 0 1 1 1 0 1 0 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 1 0 1 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 0 1 1 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 1 0 0 1 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 1 0 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 0 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 0 0 1 0 1 1 0 1 0 1 0 1 1 0 0 0 0 1 0 0 0 1 0 1 1 0 1 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 0 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 0 1 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 1 1 0 0 0 0 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 0 1 0 0 0 0 1 1 1 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 1 1 0 1 0 0 1 1 1 1 1 1 1 1 0 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 0 1 0 0 0 0 1 1 1 0 1 0 0 0 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 1 1 1 1 0 0 1 0 1 1 1 1 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 1 1)
- 95.904258 #(0.000000 -0.184827 -0.106502 -0.094974 0.803466 0.945074 0.963289 0.946874 -0.103266 0.049155 1.087214 0.886218 0.016107 0.059052 1.086003 0.896052 0.832875 0.168267 0.929954 0.104821 0.801629 0.032075 0.032796 0.227531 0.906532 1.124909 1.032850 0.878053 0.813900 -0.267885 0.885447 1.090714 0.853533 -0.000373 1.207049 0.922018 0.048308 0.893672 0.856221 0.975035 0.868154 0.098949 0.791588 1.196055 0.919249 -0.152557 0.991948 1.006717 1.133320 1.186246 0.920884 -0.060763 0.895777 0.020781 0.811521 0.941459 0.931533 0.044866 -0.116604 0.896466 0.029517 1.096540 0.918555 0.948344 0.929326 1.133930 0.012583 0.960301 1.199033 0.051836 1.012281 -0.182278 -0.104579 0.982487 0.083391 -0.235240 0.238134 0.851365 1.147123 -0.183897 0.931617 0.014719 0.969454 0.114930 -0.007528 0.927332 0.038357 0.920680 -0.081674 -0.182395 -0.011442 1.061361 0.921566 -0.084353 1.041705 0.161045 -0.067878 1.074036 0.941106 0.966219 0.919599 1.168159 1.032081 0.945189 0.044320 0.039817 -0.089720 1.130429 -0.069569 -0.278003 0.838588 0.754892 0.905296 0.076030 0.931578 0.143938 -0.063198 0.009752 0.994216 -0.018389 1.061023 0.998466 -0.064949 0.889855 -0.094736 -0.151667 1.224271 -0.191231 0.981083 0.017183 -0.228680 -0.064528 -0.051088 0.940309 1.101261 -0.034752 0.950794 -0.088223 1.190759 0.000979 1.058816 1.106846 0.070946 0.194156 1.093892 0.886993 1.017953 -0.051739 -0.284107 0.024602 0.969253 1.247816 0.935610 -0.089803 0.006657 0.841177 1.059923 1.023429 0.866137 0.046390 -0.124782 -0.252595 0.166144 1.083896 1.139053 0.949050 1.094868 1.174455 -0.189695 1.188365 1.031424 1.009889 1.067591 0.935164 0.237409 0.909064 0.009677 -0.177665 0.046406 1.016694 1.057379 -0.055836 0.052713 -0.065039 0.120813 0.836055 1.178838 0.902715 0.920359 0.806116 -0.117471 1.158887 0.994531 -0.009494 -0.163337 1.040739 1.131213 0.025531 -0.009616 0.139395 0.950856 -0.014744 0.115132 1.125894 -0.190579 0.101124 -0.125308 0.963704 0.026526 1.118700 0.022614 0.807945 0.913877 0.030742 0.927436 0.988232 -0.140750 0.124385 0.986885 0.991816 1.146772 -0.062919 0.074766 -0.034226 1.128490 0.957963 1.096308 1.046278 -0.048364 0.116505 1.136521 1.090002 -0.014238 -0.112155 1.033034 1.160610 -0.094599 0.068313 1.266010 1.098976 0.044651 0.131033 -0.116651 -0.075950 1.046348 0.030055 0.793219 -0.117150 1.124225 -0.160989 1.100541 1.045178 0.962828 -0.073358 -0.019227 1.173791 1.059709 0.937667 0.966884 0.928018 1.041334 -0.201315 0.174562 1.021851 -0.049449 0.907458 -0.107815 1.126703 0.073928 0.982065 0.825831 -0.033241 0.067472 0.917284 0.902681 1.015596 0.904075 -0.075353 -0.108265 0.963265 -0.090615 0.920339 0.977780 0.090733 0.904078 0.000883 1.347356 1.014221 0.985375 -0.100963 0.008783 0.942615 1.002685 1.149002 0.158462 0.917602 -0.099583 -0.025442 1.103430 0.071006 -0.151207 0.055689 -0.038941 0.098832 0.911418 1.062737 0.996744 0.760254 0.996130 0.014262 0.032851 0.956371 0.019061 0.996091 0.200667 1.164966 0.045741 0.060264 1.166834 -0.025387 0.966912 1.043716 0.969667 1.084931 -0.065039 0.974364 0.980017 0.844958 0.179207 0.723395 1.083973 -0.074447 0.912360 1.089065 1.005958 -0.119354 1.049441 0.937401 0.912303 0.937357 0.078173 0.927334 -0.094425 0.851189 0.132753 0.133028 1.043045 0.054936 -0.083812 0.903122 1.042637 1.178266 -0.107401 1.047050 -0.128737 0.160133 0.840861 0.896100 1.126802 0.903407 0.262267 0.053879 0.947798 -0.144016 -0.003985 0.146029 0.074915 0.771488 1.227288 0.890268 0.933106 1.075829 0.057968 0.066132 0.249704 -0.017827 0.090465 -0.047385 -0.060718 0.123360 0.988529 0.904277 -0.005465 -0.084169 -0.247831 0.999998 0.910292 1.144645 0.071091 0.088886 1.023713 -0.025414 0.984571 -0.240585 0.967555 -0.138539 0.196983 1.010405 -0.049670 -0.081707 0.064139 0.997860 0.836573 1.161272 -0.021657 0.041743 -0.127308 0.045553 0.018541 -0.044739 0.088082 0.142342 0.114457 1.055260 1.064567 -0.119380 -0.070251 -0.004341 0.963091 -0.120638 0.258819 1.053558 0.878500 1.069022 -0.123646 -0.014321 1.121295 1.085748 -0.044674 0.870738 0.685253 -0.051358 1.001113 -0.231350 0.033853 0.961438 0.037712 -0.113045 0.108555 1.037350 1.011749 1.028331 -0.080798 0.196328 0.059651 0.046311 0.977929 0.955683 -0.011917 0.990010 0.826271 0.043303 1.009806 1.189345 0.021063 0.072917 0.057585 0.061242 0.879010 0.849055 1.018528 0.955494 -0.055041 1.189587 -0.028346 -0.082984 0.099423 -0.024146 0.146930 -0.067314 0.849801 0.213148 0.924340 0.080454 0.905046 -0.129837 0.863551 -0.015056 1.161555 -0.111647 0.827215 0.819815 1.100249 1.048851 0.084224 1.096872 0.064524 1.027164 0.125925 0.828778 -0.032148 1.059894 1.017072 0.834004 -0.032573 -0.063582 1.159025 1.022326 0.063607 1.022556 1.099517 0.097842 0.150138 1.115534 0.951150 0.988949 0.155650 -0.134289 -0.115258 1.037176 1.021182 0.975772 1.072700 1.222345 0.924272 0.973662 0.930252 0.059705 0.077967 -0.109443 -0.103486 0.972696 -0.144205 0.802195 0.975677 0.802607 -0.042079 1.071307 1.022073 0.907916 1.035902 -0.048853 0.907965 0.883285 0.084385 -0.108649 0.944568 0.005988 0.933534 1.065312 -0.070265 -0.076879 -0.017044 -0.098932 1.208925 0.930986 -0.119229 -0.037509 1.090406 0.992176 -0.000651 0.937690 0.916741 -0.066544 1.095679 -0.058814 1.036581 -0.051849 -0.017058 -0.030283 0.051491 0.954183 0.950362 -0.021757 -0.062612 1.017252 0.855360 0.008584 0.998471 0.053177 -0.102277 -0.071410 -0.113602 0.020219 0.047660 0.112990 0.815120 1.152303 1.067537 1.052888 0.004076 0.157730 0.930208 0.885789 0.948613 1.018989 0.998994 -0.098675 0.134960 0.084711 0.092822 0.103312 -0.196457 1.024530 1.108457 0.891294 1.054699 1.016928 -0.022703 0.811591 1.004965 -0.017036 0.232325 0.973190 1.052258 1.071581 1.167101 -0.078778 1.126544 0.054092 0.108866 0.166665 1.087490 0.998143 -0.013409 0.871172 0.885040 1.019108 1.127064 1.196444 0.957927 0.852239 -0.008268 -0.145143 1.063054 -0.026011 1.007974 0.983277 -0.031336 1.126868 0.969557 0.015995 0.940510 0.206836 -0.166196 0.069999 0.106477 0.969534 0.962793 1.057184 0.039570 1.013939 0.966957 -0.186086 1.043328 0.103727 0.826020 0.082145 0.142187 0.193131 0.806568 -0.194497 0.073921 0.929470 0.014750 1.003891 1.130669 0.912871 -0.166896 -0.010434 0.224001 0.019969 0.882091 1.015999 0.050540 0.927299 -0.028913 0.088865 -0.038210 0.838785 0.179969 -0.063760 0.909551 0.970913 0.864195 -0.147216 1.017549 0.931612 1.076838 0.174334 -0.004854 1.146351 -0.071188 0.005023 0.983870 0.987921 -0.073293 1.144937 -0.008273 1.069178 0.160218 0.940671 -0.099513 -0.160986 -0.053460 -0.000349 -0.066930 0.258818 0.037651 0.899944 1.011860 -0.024019 0.049159 -0.114396 0.997122 0.988277 -0.086170 1.100402 0.827506 -0.071549 1.014472 0.830365 -0.029296 1.033932 -0.095907 -0.073030 0.967696 1.060165 0.920338 1.199129 -0.072200 0.053416 -0.126898 1.108390 0.903008 1.109424 0.964135 -0.083890 0.099047 -0.111937 1.079528 1.230021 1.124700 0.946124 1.081677 -0.089364 1.123287 0.082817 -0.048549 0.013111 -0.005217 1.016286 0.025359 -0.151572 1.137235 1.013948 1.006359 -0.020039 -0.117293 1.111762 0.892597 1.058754 0.795600 0.996014 0.931963 1.115786 -0.029889 0.877043 -0.234877 1.149674 1.027911 1.261517 0.048880 0.113954 -0.024127 0.075365 -0.048636 0.036252 0.831941 0.943628 0.982317 0.918776 1.086510 0.931126 -0.077364 0.039915 1.020953 -0.068839 0.962253 0.910823 0.025853 0.065365 0.021206 -0.021296 0.872652 0.026536 -0.052762 0.003250 0.029539 0.991921 1.021217 -0.042456 0.777756 0.980840 0.078981 -0.130613 0.133311 -0.065841 -0.085861 1.178451 0.115564 1.082062 1.015392 0.928586 0.967073 1.156891 -0.010223 0.936469 -0.154645 0.995277 1.073333 -0.010159 -0.073318 1.117785 0.123446 0.035440 0.914424 0.055982 1.255170 0.975126 0.021080 -0.037628 1.048938 0.871136 1.107293 0.955878 -0.056277 1.017033 0.090456 0.993267 0.757034 1.002409 0.941223 0.920711 1.181339 0.032023 -0.085516 0.974206 -0.026907 0.142086 -0.002800 0.952901 1.119119 1.039547 0.762175 1.056838 -0.114595 0.884738 0.718220 0.960728 -0.156479 1.189199 -0.165202 0.904637 -0.041429 -0.050488 -0.179745 1.054673 -0.082418 0.030881 1.160170 0.821960 -0.086297 0.010350 0.932553 0.035420 -0.009593 0.011040 0.051718 0.904123 0.028769 0.100605 1.033920 -0.169584 1.086360 1.131494 0.107596 -0.114123 0.021393 0.010364 -0.152848 0.035197 0.012279 -0.133590 -0.062321 1.204840 0.937029 -0.068386 1.145671 0.973614 1.135843 0.883055 0.070061 0.997608 1.003482 0.989245 1.204030 1.197676 0.838535 0.029369 -0.215349 1.060468 0.880276 0.931456 0.125650 1.132780 -0.117697 0.200533 0.075686 1.191015 1.016195 0.037000 1.110074 0.982317 0.982573 0.824837 -0.229925 1.006482 -0.062451 -0.057872 0.979641 -0.230341 -0.020939 1.006077 0.857917 1.098933 -0.267219 0.043265 0.935436 0.964162 -0.007168 0.164970 0.165342 1.068220 0.945315 0.948634 1.023862 -0.029831 0.992343 0.020292 0.067126 0.932456 0.808919 0.096733 0.000609 0.083113 1.019237 0.858419 1.013183 0.098990 0.930352 -0.062223 1.082324 -0.042610 1.104376 0.999943 -0.136202 0.964477 -0.092847 1.096219 1.036690 1.110447 0.987439 0.893158 0.111588 -0.094486 0.748732 0.981962 1.023640 1.021660 0.931300 1.325728 0.988586 0.832724 0.042650 -0.080219 -0.124412 0.083378 -0.047165 0.013229 0.179035 1.036229 0.106634 -0.154080 0.015828 -0.138512 0.228898 0.970943 1.152854 0.994299 1.087348 1.079495 -0.014073 0.985630 1.046303 0.921605 -0.148486 -0.082307 1.049524 0.140156 1.012720 0.976567 0.874688 -0.045198 1.031276 0.883380 0.011846 -0.003498 1.009216 0.885002 0.172619 0.843282 0.029227 -0.097679 -0.125796 0.933874 0.978897 0.725114 0.844720 1.075252 0.947844 0.926610 0.182857 0.841432 1.040159 0.998281 0.169201 0.136041 1.216461 0.161331 -0.074244 1.061895 0.862101 0.118827 1.150273 1.131402 0.028905 0.802992 -0.116645 0.004795 -0.035171 -0.225349 -0.011793 1.004637 1.052814 0.132105 0.965384 1.075721 0.233900 0.952135 0.901143 1.131006 0.032321 1.011176 0.873840 0.182329 -0.079077 0.896822 0.005166 0.903099 1.092780 -0.025076 -0.019178 0.015239 0.984311 1.216486 0.992874 0.054129 0.144836 0.099554 0.103521 0.100432 -0.026631 0.042079 0.163741 1.041917 0.792159 0.979852 0.977128 0.103524 1.113377 -0.157199 1.027202 0.929073 1.074076 -0.112317 0.199279 0.760239 0.001430 1.277148 0.009244 0.986963 0.109581 1.086070 -0.134094 0.327295 0.686709 -0.296672 0.932890 0.968488 0.216488 0.165531 0.285075 -0.094601 -0.165028 0.950486 0.963591 0.864035 -0.065266 1.013992 0.911092 -0.094152 -0.152792 1.070739 -0.039448 1.166353 -0.004048 0.032871 0.996625 1.100064 1.255396 0.839630 -0.081969 0.162263 0.140738 1.003998 0.779814 0.961648 1.146742 0.167212 0.925641 1.185256 0.824157 -0.033666 -0.007601 0.908697 0.230017 0.822888 0.740994 0.033372 1.160544 1.098836 -0.044005 1.021078 0.126042 0.049334 0.898357 1.032574 0.865757 0.947486 0.886121 0.055309 0.044278 -0.037421 1.134951 0.864539 -0.011595 -0.007199 0.067683 1.090102 1.092557 0.046997 0.027613 0.949146 0.875265 0.136983 -0.135656 0.985803 -0.132003 0.135341 0.013222 1.091309 1.098115 0.015599 0.119349 0.014805 1.069340 1.102334 1.032680 -0.031084 0.906554 -0.088863 0.069579 1.064396 0.128172 1.022790 1.107156 -0.057182 0.995012 1.054566 1.042520 -0.160709 1.125070 -0.094154 0.046403 -0.069345 0.119373 -0.184893 0.070830 1.044722 1.098693 1.111409 1.135049 0.985119 0.066473 0.058424 1.004842 -0.094015 1.117752 0.799547 1.268968 0.039520 0.996895 -0.102408 -0.030667 0.930842 1.078283 1.102597 0.055578 0.110127 0.923904 1.005813 0.918634 1.079133 -0.099263 0.905943 1.047321 0.848243 -0.009403 -0.068258 1.012623 -0.037975 1.142196 0.851851 0.109046 1.141382 0.890904 0.996832 -0.088058 1.288646 1.097971 -0.100491 0.918525 0.015332 1.145115 0.117738 1.014796 -0.205627 -0.177297 -0.006318 0.055035 1.183699 0.900390 1.055439 1.182836 0.107470 0.210820 -0.154634 1.100666 0.004257 0.125613 0.849489 1.120995 -0.046236 -0.066772 0.011079 -0.102932 0.932197 0.023264 0.246085 0.163405 0.869069 0.102531 1.077511 0.954854 0.038602 0.079792 0.927047 0.983181 1.030696 0.962590 -0.055603 -0.107934 1.126555 0.946728 1.063664 0.137033 -0.128875 0.885196 0.091522 0.893839 1.007955 0.978475 0.978266 0.067848 1.038168 1.090875 -0.061309 1.116028 1.016019 0.011872 -0.108054 0.108874 0.083760 0.113696 1.116111 0.014309 0.005128 1.099189 -0.004973 1.325065 1.221479 0.028469 1.235019 -0.212490 0.962518 1.027151 -0.044149 0.142639 0.155400 0.936540 -0.039180 0.937115 -0.085578 1.019973 1.270603 0.140594 0.061038 1.087655 0.063712 1.177018 -0.029958 0.758319 0.051019 -0.094233 0.962416 -0.006348 -0.003660 0.019678 1.112579 1.058837 -0.108754 0.005081 0.979604 0.909652 -0.162160 0.189741 1.115396 -0.046934 0.809487 0.174222 -0.004756 1.140939 0.812895 0.050537 0.171915 -0.128895 0.969610 0.953147 1.047572 0.122563 0.889198 -0.104048 0.001916 -0.008785 1.172703 -0.213570 -0.114233 -0.152007 -0.161789 -0.132968 1.055565 0.784424 0.202349 -0.012066 0.004158 -0.039121 1.114936 0.962613 0.954226 1.105200 0.985756 1.026320 -0.117780 0.866616 1.000189 -0.163224 0.999105 1.165142 0.001717 1.023313 -0.052468 -0.233246 -0.078417 -0.014831 0.008989 0.105092 1.100102 -0.114187 0.962275 0.827359 -0.135499 1.155899 0.983914 -0.197096 0.920622 0.925756 0.074101 1.105182 0.068112 0.889324 0.995794 -0.181975 1.079197 -0.174077 -0.086147 1.108775 0.836038 0.920177 0.069115 1.056833 1.065288 1.011220 0.037095 -0.051383 0.059023 0.966919 0.975420 0.992209 -0.050411 1.034776 0.060947 0.024827 0.189251 1.128565 -0.026102 0.882647 1.113292 0.059688 -0.055524 1.097931 -0.076831 0.148308 0.009684 0.993343 0.181407 0.980680 -0.253676 1.203786 0.837538 -0.111906 -0.046920 0.992998 1.138650 0.102810 0.732933 0.974495 1.134363 0.841220 -0.244832 0.191984 1.089926 -0.014286 1.033093 0.795315 0.027888 1.086315 0.921910 0.023081 1.023830 0.070684 1.183612 -0.197469 -0.072227 1.175515 1.132615 0.147372 1.165071 0.693358 0.086944 0.167356 1.154251 0.067038 1.011388 0.195281 0.162053 0.058855 0.118483 1.091391 1.199083 0.861074 0.152693 -0.184650 -0.275426 0.016699 1.041744 1.082925 0.896020 -0.212005 -0.028325 0.837564 1.192865 0.964038 1.140280 0.832699 0.060523 1.017736 0.007067 1.222558 0.776881 1.025602 0.136510 1.065558 0.031534 1.120667 -0.017440 -0.095844 0.986588 0.811881 1.008160 1.083596 -0.057608 1.030774 -0.185755 1.016553 -0.060277 0.044570 0.071469 1.026382 -0.218238 -0.134819 0.125155 1.052665 0.219534 1.053074 0.975626 0.942097 0.042773 0.914988 0.904458 1.068383 0.122945 -0.160737 0.195111 -0.112309 0.079404 0.873713 0.743694 -0.042029 0.017013 1.026689 -0.033216 0.846494 1.151063 -0.096712 0.933521 -0.150138 0.998351 0.097766 1.014397 1.003826 0.249110 -0.089820 -0.095115 -0.041617 1.005328 -0.026956 0.282608 -0.227117 0.900497 0.151081 1.074944 0.999410 0.070956 0.989252 1.046830 0.036838 0.060586 0.119680 1.033878 1.147593 1.072223 1.038019 -0.063806 -0.066418 -0.094579 0.121532 0.058665 0.065637 0.015630 1.033625 -0.167401 -0.044227 0.109799 1.069494 0.978455 0.951966 0.848373 1.183717 0.052564 -0.139052 0.109210 1.056692 1.084067 0.913136 0.026099 0.888367 1.004145 -0.006357 -0.186626 1.147417 0.008987 1.033956 0.198511 1.087879 0.153898 -0.007073 -0.053729 0.960733 -0.079153 -0.112602 0.118601 1.127696 0.124208 -0.118455 1.113389 -0.141400 0.095581 0.831887 0.079625 1.065606 1.064953 -0.043117 0.883460 -0.117838 0.984417 1.073930 -0.020071 -0.020565 -0.110661 -0.029427 0.000735 0.129840 -0.059144 0.853604 0.029159 1.153760 -0.035371 0.120975 0.829886 0.902305 0.004019 1.024841 -0.008315 -0.040841 0.081011 0.034157 0.925135 0.026143 -0.146226 0.818801 0.997553 -0.057337 0.039344 0.045043 -0.058730 0.061450 0.034397 0.032312 1.021479 0.069734 0.032385 -0.034352 1.143739 0.128130 0.837756 0.143447 1.191780 1.005715 -0.145746 0.060156 -0.089751 0.993522 1.117964 1.113924 -0.051214 0.989301 1.131346 0.978070 1.120586 -0.104089 0.755209 0.911168 0.043338 0.799533 -0.065789 1.035956 1.103884 1.108033 -0.011160 0.018199 1.076458 1.033226 1.049461 0.927281 0.875446 -0.132488 -0.016539 1.040494 -0.085837 0.845351 0.082137 0.957295 0.975488 -0.233161 1.046308 0.968283 1.119329 0.799388 0.835437 1.198178 1.006967 -0.080996 1.022071 0.222670 1.054955 1.028112 0.145964 0.775125 0.053077 -0.139928 0.982870 0.012204 1.181785 -0.055209 0.064440 0.028436 -0.055658 0.988257 0.885626 0.925751 1.041503 -0.102556 0.199169 0.817618 1.118232 -0.154162 1.103379 0.161217 0.043204 0.038827 0.297793 0.101115 1.084585 0.911258 -0.017387 1.093864 1.174369 -0.052884 1.010587 1.084918 1.042023 0.988052 1.008470 1.079842 0.911711 -0.105412 1.049916 0.966051 -0.030853 0.634323 0.027996 0.065373 0.165603 -0.198745 0.121133 0.904870 0.798116 0.109313 -0.023197 -0.012270 -0.099679 -0.007982 0.957938 0.064886 1.066324 0.891833 0.030809 0.008848 -0.058683 1.151904 -0.064909 0.005548 0.092447 0.994226 0.980543 0.036553 0.977629 0.908112 1.053035 1.015332 1.120582 1.029707 0.935519 0.767415 -0.107332 1.106993 0.051063 -0.090849 -0.152447 1.074408 0.930237 -0.134191 -0.041339 1.154220 0.912402 0.915882 -0.155688 0.004278 1.005960 -0.029173 0.929692 0.891253 0.904414 -0.022210 0.912185 0.032760 -0.175809 1.064184 0.004444 1.023131 0.014814 0.025559 0.065555 0.781532 -0.029379 -0.197955 0.897852 -0.013217 1.093294 0.004968 -0.102189 1.031592 0.748643 0.996666 0.053363 -0.174095 0.022123 1.073767 0.026629 0.817199 0.923850 0.016734 1.000997 0.181206 0.011231 0.956073 0.190711 0.864217 -0.176983 1.016978 1.028389 0.023092 0.841323 1.197465 -0.032185 -0.023935 -0.154948 0.938794 0.022079 0.018001 0.863273 0.095137 -0.103529 1.048691 1.044424 1.076913 -0.091685 1.016448 0.235867 -0.191122 1.021688 0.903834 1.103008 1.062811 0.974671 0.808982 0.919788 0.797299 0.003866 0.924240 1.138022 1.138392 -0.086041 -0.072381 1.089510 0.997304 -0.196238 -0.081117 0.998652 -0.136927 1.094476 1.025478 1.128812 -0.043799 -0.160622 1.202644 -0.097115 1.028359 1.128248 1.149200 0.046912 1.215106 0.095300 0.230991 -0.177631 1.060265 0.025009 -0.087069 -0.045585 0.107297 0.905981 1.067101 1.105134 0.200901 0.832244 -0.158358 0.063741 -0.002433 0.178939 1.150184 -0.013758 0.739082 0.970621 1.116445 -0.077580 0.874011 -0.000811 0.757786 1.027494 0.948749 0.128206 1.197540 -0.121973 -0.035650 0.227456 1.012591 0.093402 0.788900 0.046330 1.127347 0.937960 0.147998 0.295156 0.047168 -0.449697 1.185666 1.027567 1.056837 0.896828 0.093411 0.188188 1.051113 0.196550 0.986178 0.963111 1.064836 0.986799 0.068409 0.940694 0.044600 0.930849 0.776664 1.119660 0.877476 -0.187121 0.889222 0.896426 1.114193 0.109176 0.974296 0.017034 0.058848 0.003626 -0.056434 -0.053055 -0.327863 1.110462 1.191687 0.833810 -0.093180 1.062518 0.877602 0.130458 1.046517 0.945395 -0.042202 0.884421 0.076614 0.998365 0.963405 -0.042360 1.233324 1.032498 0.850640 0.878991 1.172081 -0.131938 0.138522 1.031223 -0.060356 1.045766 1.146384 1.014251 1.035122 1.033944 0.910994 0.140291 0.017496 0.074785 0.017803 1.051564 0.940908 1.102397 0.914000 -0.151381 -0.037398 0.841172 0.980431 0.926522 1.010521 0.906633 0.898542 -0.046207 1.056040 -0.119697 -0.388635 1.042092 1.062407 -0.114191 0.973897 0.038767 0.170771 0.104476 0.108748 0.973779 0.829369 0.903094)
+ 95.904258 #r(0.000000 -0.184827 -0.106502 -0.094974 0.803466 0.945074 0.963289 0.946874 -0.103266 0.049155 1.087214 0.886218 0.016107 0.059052 1.086003 0.896052 0.832875 0.168267 0.929954 0.104821 0.801629 0.032075 0.032796 0.227531 0.906532 1.124909 1.032850 0.878053 0.813900 -0.267885 0.885447 1.090714 0.853533 -0.000373 1.207049 0.922018 0.048308 0.893672 0.856221 0.975035 0.868154 0.098949 0.791588 1.196055 0.919249 -0.152557 0.991948 1.006717 1.133320 1.186246 0.920884 -0.060763 0.895777 0.020781 0.811521 0.941459 0.931533 0.044866 -0.116604 0.896466 0.029517 1.096540 0.918555 0.948344 0.929326 1.133930 0.012583 0.960301 1.199033 0.051836 1.012281 -0.182278 -0.104579 0.982487 0.083391 -0.235240 0.238134 0.851365 1.147123 -0.183897 0.931617 0.014719 0.969454 0.114930 -0.007528 0.927332 0.038357 0.920680 -0.081674 -0.182395 -0.011442 1.061361 0.921566 -0.084353 1.041705 0.161045 -0.067878 1.074036 0.941106 0.966219 0.919599 1.168159 1.032081 0.945189 0.044320 0.039817 -0.089720 1.130429 -0.069569 -0.278003 0.838588 0.754892 0.905296 0.076030 0.931578 0.143938 -0.063198 0.009752 0.994216 -0.018389 1.061023 0.998466 -0.064949 0.889855 -0.094736 -0.151667 1.224271 -0.191231 0.981083 0.017183 -0.228680 -0.064528 -0.051088 0.940309 1.101261 -0.034752 0.950794 -0.088223 1.190759 0.000979 1.058816 1.106846 0.070946 0.194156 1.093892 0.886993 1.017953 -0.051739 -0.284107 0.024602 0.969253 1.247816 0.935610 -0.089803 0.006657 0.841177 1.059923 1.023429 0.866137 0.046390 -0.124782 -0.252595 0.166144 1.083896 1.139053 0.949050 1.094868 1.174455 -0.189695 1.188365 1.031424 1.009889 1.067591 0.935164 0.237409 0.909064 0.009677 -0.177665 0.046406 1.016694 1.057379 -0.055836 0.052713 -0.065039 0.120813 0.836055 1.178838 0.902715 0.920359 0.806116 -0.117471 1.158887 0.994531 -0.009494 -0.163337 1.040739 1.131213 0.025531 -0.009616 0.139395 0.950856 -0.014744 0.115132 1.125894 -0.190579 0.101124 -0.125308 0.963704 0.026526 1.118700 0.022614 0.807945 0.913877 0.030742 0.927436 0.988232 -0.140750 0.124385 0.986885 0.991816 1.146772 -0.062919 0.074766 -0.034226 1.128490 0.957963 1.096308 1.046278 -0.048364 0.116505 1.136521 1.090002 -0.014238 -0.112155 1.033034 1.160610 -0.094599 0.068313 1.266010 1.098976 0.044651 0.131033 -0.116651 -0.075950 1.046348 0.030055 0.793219 -0.117150 1.124225 -0.160989 1.100541 1.045178 0.962828 -0.073358 -0.019227 1.173791 1.059709 0.937667 0.966884 0.928018 1.041334 -0.201315 0.174562 1.021851 -0.049449 0.907458 -0.107815 1.126703 0.073928 0.982065 0.825831 -0.033241 0.067472 0.917284 0.902681 1.015596 0.904075 -0.075353 -0.108265 0.963265 -0.090615 0.920339 0.977780 0.090733 0.904078 0.000883 1.347356 1.014221 0.985375 -0.100963 0.008783 0.942615 1.002685 1.149002 0.158462 0.917602 -0.099583 -0.025442 1.103430 0.071006 -0.151207 0.055689 -0.038941 0.098832 0.911418 1.062737 0.996744 0.760254 0.996130 0.014262 0.032851 0.956371 0.019061 0.996091 0.200667 1.164966 0.045741 0.060264 1.166834 -0.025387 0.966912 1.043716 0.969667 1.084931 -0.065039 0.974364 0.980017 0.844958 0.179207 0.723395 1.083973 -0.074447 0.912360 1.089065 1.005958 -0.119354 1.049441 0.937401 0.912303 0.937357 0.078173 0.927334 -0.094425 0.851189 0.132753 0.133028 1.043045 0.054936 -0.083812 0.903122 1.042637 1.178266 -0.107401 1.047050 -0.128737 0.160133 0.840861 0.896100 1.126802 0.903407 0.262267 0.053879 0.947798 -0.144016 -0.003985 0.146029 0.074915 0.771488 1.227288 0.890268 0.933106 1.075829 0.057968 0.066132 0.249704 -0.017827 0.090465 -0.047385 -0.060718 0.123360 0.988529 0.904277 -0.005465 -0.084169 -0.247831 0.999998 0.910292 1.144645 0.071091 0.088886 1.023713 -0.025414 0.984571 -0.240585 0.967555 -0.138539 0.196983 1.010405 -0.049670 -0.081707 0.064139 0.997860 0.836573 1.161272 -0.021657 0.041743 -0.127308 0.045553 0.018541 -0.044739 0.088082 0.142342 0.114457 1.055260 1.064567 -0.119380 -0.070251 -0.004341 0.963091 -0.120638 0.258819 1.053558 0.878500 1.069022 -0.123646 -0.014321 1.121295 1.085748 -0.044674 0.870738 0.685253 -0.051358 1.001113 -0.231350 0.033853 0.961438 0.037712 -0.113045 0.108555 1.037350 1.011749 1.028331 -0.080798 0.196328 0.059651 0.046311 0.977929 0.955683 -0.011917 0.990010 0.826271 0.043303 1.009806 1.189345 0.021063 0.072917 0.057585 0.061242 0.879010 0.849055 1.018528 0.955494 -0.055041 1.189587 -0.028346 -0.082984 0.099423 -0.024146 0.146930 -0.067314 0.849801 0.213148 0.924340 0.080454 0.905046 -0.129837 0.863551 -0.015056 1.161555 -0.111647 0.827215 0.819815 1.100249 1.048851 0.084224 1.096872 0.064524 1.027164 0.125925 0.828778 -0.032148 1.059894 1.017072 0.834004 -0.032573 -0.063582 1.159025 1.022326 0.063607 1.022556 1.099517 0.097842 0.150138 1.115534 0.951150 0.988949 0.155650 -0.134289 -0.115258 1.037176 1.021182 0.975772 1.072700 1.222345 0.924272 0.973662 0.930252 0.059705 0.077967 -0.109443 -0.103486 0.972696 -0.144205 0.802195 0.975677 0.802607 -0.042079 1.071307 1.022073 0.907916 1.035902 -0.048853 0.907965 0.883285 0.084385 -0.108649 0.944568 0.005988 0.933534 1.065312 -0.070265 -0.076879 -0.017044 -0.098932 1.208925 0.930986 -0.119229 -0.037509 1.090406 0.992176 -0.000651 0.937690 0.916741 -0.066544 1.095679 -0.058814 1.036581 -0.051849 -0.017058 -0.030283 0.051491 0.954183 0.950362 -0.021757 -0.062612 1.017252 0.855360 0.008584 0.998471 0.053177 -0.102277 -0.071410 -0.113602 0.020219 0.047660 0.112990 0.815120 1.152303 1.067537 1.052888 0.004076 0.157730 0.930208 0.885789 0.948613 1.018989 0.998994 -0.098675 0.134960 0.084711 0.092822 0.103312 -0.196457 1.024530 1.108457 0.891294 1.054699 1.016928 -0.022703 0.811591 1.004965 -0.017036 0.232325 0.973190 1.052258 1.071581 1.167101 -0.078778 1.126544 0.054092 0.108866 0.166665 1.087490 0.998143 -0.013409 0.871172 0.885040 1.019108 1.127064 1.196444 0.957927 0.852239 -0.008268 -0.145143 1.063054 -0.026011 1.007974 0.983277 -0.031336 1.126868 0.969557 0.015995 0.940510 0.206836 -0.166196 0.069999 0.106477 0.969534 0.962793 1.057184 0.039570 1.013939 0.966957 -0.186086 1.043328 0.103727 0.826020 0.082145 0.142187 0.193131 0.806568 -0.194497 0.073921 0.929470 0.014750 1.003891 1.130669 0.912871 -0.166896 -0.010434 0.224001 0.019969 0.882091 1.015999 0.050540 0.927299 -0.028913 0.088865 -0.038210 0.838785 0.179969 -0.063760 0.909551 0.970913 0.864195 -0.147216 1.017549 0.931612 1.076838 0.174334 -0.004854 1.146351 -0.071188 0.005023 0.983870 0.987921 -0.073293 1.144937 -0.008273 1.069178 0.160218 0.940671 -0.099513 -0.160986 -0.053460 -0.000349 -0.066930 0.258818 0.037651 0.899944 1.011860 -0.024019 0.049159 -0.114396 0.997122 0.988277 -0.086170 1.100402 0.827506 -0.071549 1.014472 0.830365 -0.029296 1.033932 -0.095907 -0.073030 0.967696 1.060165 0.920338 1.199129 -0.072200 0.053416 -0.126898 1.108390 0.903008 1.109424 0.964135 -0.083890 0.099047 -0.111937 1.079528 1.230021 1.124700 0.946124 1.081677 -0.089364 1.123287 0.082817 -0.048549 0.013111 -0.005217 1.016286 0.025359 -0.151572 1.137235 1.013948 1.006359 -0.020039 -0.117293 1.111762 0.892597 1.058754 0.795600 0.996014 0.931963 1.115786 -0.029889 0.877043 -0.234877 1.149674 1.027911 1.261517 0.048880 0.113954 -0.024127 0.075365 -0.048636 0.036252 0.831941 0.943628 0.982317 0.918776 1.086510 0.931126 -0.077364 0.039915 1.020953 -0.068839 0.962253 0.910823 0.025853 0.065365 0.021206 -0.021296 0.872652 0.026536 -0.052762 0.003250 0.029539 0.991921 1.021217 -0.042456 0.777756 0.980840 0.078981 -0.130613 0.133311 -0.065841 -0.085861 1.178451 0.115564 1.082062 1.015392 0.928586 0.967073 1.156891 -0.010223 0.936469 -0.154645 0.995277 1.073333 -0.010159 -0.073318 1.117785 0.123446 0.035440 0.914424 0.055982 1.255170 0.975126 0.021080 -0.037628 1.048938 0.871136 1.107293 0.955878 -0.056277 1.017033 0.090456 0.993267 0.757034 1.002409 0.941223 0.920711 1.181339 0.032023 -0.085516 0.974206 -0.026907 0.142086 -0.002800 0.952901 1.119119 1.039547 0.762175 1.056838 -0.114595 0.884738 0.718220 0.960728 -0.156479 1.189199 -0.165202 0.904637 -0.041429 -0.050488 -0.179745 1.054673 -0.082418 0.030881 1.160170 0.821960 -0.086297 0.010350 0.932553 0.035420 -0.009593 0.011040 0.051718 0.904123 0.028769 0.100605 1.033920 -0.169584 1.086360 1.131494 0.107596 -0.114123 0.021393 0.010364 -0.152848 0.035197 0.012279 -0.133590 -0.062321 1.204840 0.937029 -0.068386 1.145671 0.973614 1.135843 0.883055 0.070061 0.997608 1.003482 0.989245 1.204030 1.197676 0.838535 0.029369 -0.215349 1.060468 0.880276 0.931456 0.125650 1.132780 -0.117697 0.200533 0.075686 1.191015 1.016195 0.037000 1.110074 0.982317 0.982573 0.824837 -0.229925 1.006482 -0.062451 -0.057872 0.979641 -0.230341 -0.020939 1.006077 0.857917 1.098933 -0.267219 0.043265 0.935436 0.964162 -0.007168 0.164970 0.165342 1.068220 0.945315 0.948634 1.023862 -0.029831 0.992343 0.020292 0.067126 0.932456 0.808919 0.096733 0.000609 0.083113 1.019237 0.858419 1.013183 0.098990 0.930352 -0.062223 1.082324 -0.042610 1.104376 0.999943 -0.136202 0.964477 -0.092847 1.096219 1.036690 1.110447 0.987439 0.893158 0.111588 -0.094486 0.748732 0.981962 1.023640 1.021660 0.931300 1.325728 0.988586 0.832724 0.042650 -0.080219 -0.124412 0.083378 -0.047165 0.013229 0.179035 1.036229 0.106634 -0.154080 0.015828 -0.138512 0.228898 0.970943 1.152854 0.994299 1.087348 1.079495 -0.014073 0.985630 1.046303 0.921605 -0.148486 -0.082307 1.049524 0.140156 1.012720 0.976567 0.874688 -0.045198 1.031276 0.883380 0.011846 -0.003498 1.009216 0.885002 0.172619 0.843282 0.029227 -0.097679 -0.125796 0.933874 0.978897 0.725114 0.844720 1.075252 0.947844 0.926610 0.182857 0.841432 1.040159 0.998281 0.169201 0.136041 1.216461 0.161331 -0.074244 1.061895 0.862101 0.118827 1.150273 1.131402 0.028905 0.802992 -0.116645 0.004795 -0.035171 -0.225349 -0.011793 1.004637 1.052814 0.132105 0.965384 1.075721 0.233900 0.952135 0.901143 1.131006 0.032321 1.011176 0.873840 0.182329 -0.079077 0.896822 0.005166 0.903099 1.092780 -0.025076 -0.019178 0.015239 0.984311 1.216486 0.992874 0.054129 0.144836 0.099554 0.103521 0.100432 -0.026631 0.042079 0.163741 1.041917 0.792159 0.979852 0.977128 0.103524 1.113377 -0.157199 1.027202 0.929073 1.074076 -0.112317 0.199279 0.760239 0.001430 1.277148 0.009244 0.986963 0.109581 1.086070 -0.134094 0.327295 0.686709 -0.296672 0.932890 0.968488 0.216488 0.165531 0.285075 -0.094601 -0.165028 0.950486 0.963591 0.864035 -0.065266 1.013992 0.911092 -0.094152 -0.152792 1.070739 -0.039448 1.166353 -0.004048 0.032871 0.996625 1.100064 1.255396 0.839630 -0.081969 0.162263 0.140738 1.003998 0.779814 0.961648 1.146742 0.167212 0.925641 1.185256 0.824157 -0.033666 -0.007601 0.908697 0.230017 0.822888 0.740994 0.033372 1.160544 1.098836 -0.044005 1.021078 0.126042 0.049334 0.898357 1.032574 0.865757 0.947486 0.886121 0.055309 0.044278 -0.037421 1.134951 0.864539 -0.011595 -0.007199 0.067683 1.090102 1.092557 0.046997 0.027613 0.949146 0.875265 0.136983 -0.135656 0.985803 -0.132003 0.135341 0.013222 1.091309 1.098115 0.015599 0.119349 0.014805 1.069340 1.102334 1.032680 -0.031084 0.906554 -0.088863 0.069579 1.064396 0.128172 1.022790 1.107156 -0.057182 0.995012 1.054566 1.042520 -0.160709 1.125070 -0.094154 0.046403 -0.069345 0.119373 -0.184893 0.070830 1.044722 1.098693 1.111409 1.135049 0.985119 0.066473 0.058424 1.004842 -0.094015 1.117752 0.799547 1.268968 0.039520 0.996895 -0.102408 -0.030667 0.930842 1.078283 1.102597 0.055578 0.110127 0.923904 1.005813 0.918634 1.079133 -0.099263 0.905943 1.047321 0.848243 -0.009403 -0.068258 1.012623 -0.037975 1.142196 0.851851 0.109046 1.141382 0.890904 0.996832 -0.088058 1.288646 1.097971 -0.100491 0.918525 0.015332 1.145115 0.117738 1.014796 -0.205627 -0.177297 -0.006318 0.055035 1.183699 0.900390 1.055439 1.182836 0.107470 0.210820 -0.154634 1.100666 0.004257 0.125613 0.849489 1.120995 -0.046236 -0.066772 0.011079 -0.102932 0.932197 0.023264 0.246085 0.163405 0.869069 0.102531 1.077511 0.954854 0.038602 0.079792 0.927047 0.983181 1.030696 0.962590 -0.055603 -0.107934 1.126555 0.946728 1.063664 0.137033 -0.128875 0.885196 0.091522 0.893839 1.007955 0.978475 0.978266 0.067848 1.038168 1.090875 -0.061309 1.116028 1.016019 0.011872 -0.108054 0.108874 0.083760 0.113696 1.116111 0.014309 0.005128 1.099189 -0.004973 1.325065 1.221479 0.028469 1.235019 -0.212490 0.962518 1.027151 -0.044149 0.142639 0.155400 0.936540 -0.039180 0.937115 -0.085578 1.019973 1.270603 0.140594 0.061038 1.087655 0.063712 1.177018 -0.029958 0.758319 0.051019 -0.094233 0.962416 -0.006348 -0.003660 0.019678 1.112579 1.058837 -0.108754 0.005081 0.979604 0.909652 -0.162160 0.189741 1.115396 -0.046934 0.809487 0.174222 -0.004756 1.140939 0.812895 0.050537 0.171915 -0.128895 0.969610 0.953147 1.047572 0.122563 0.889198 -0.104048 0.001916 -0.008785 1.172703 -0.213570 -0.114233 -0.152007 -0.161789 -0.132968 1.055565 0.784424 0.202349 -0.012066 0.004158 -0.039121 1.114936 0.962613 0.954226 1.105200 0.985756 1.026320 -0.117780 0.866616 1.000189 -0.163224 0.999105 1.165142 0.001717 1.023313 -0.052468 -0.233246 -0.078417 -0.014831 0.008989 0.105092 1.100102 -0.114187 0.962275 0.827359 -0.135499 1.155899 0.983914 -0.197096 0.920622 0.925756 0.074101 1.105182 0.068112 0.889324 0.995794 -0.181975 1.079197 -0.174077 -0.086147 1.108775 0.836038 0.920177 0.069115 1.056833 1.065288 1.011220 0.037095 -0.051383 0.059023 0.966919 0.975420 0.992209 -0.050411 1.034776 0.060947 0.024827 0.189251 1.128565 -0.026102 0.882647 1.113292 0.059688 -0.055524 1.097931 -0.076831 0.148308 0.009684 0.993343 0.181407 0.980680 -0.253676 1.203786 0.837538 -0.111906 -0.046920 0.992998 1.138650 0.102810 0.732933 0.974495 1.134363 0.841220 -0.244832 0.191984 1.089926 -0.014286 1.033093 0.795315 0.027888 1.086315 0.921910 0.023081 1.023830 0.070684 1.183612 -0.197469 -0.072227 1.175515 1.132615 0.147372 1.165071 0.693358 0.086944 0.167356 1.154251 0.067038 1.011388 0.195281 0.162053 0.058855 0.118483 1.091391 1.199083 0.861074 0.152693 -0.184650 -0.275426 0.016699 1.041744 1.082925 0.896020 -0.212005 -0.028325 0.837564 1.192865 0.964038 1.140280 0.832699 0.060523 1.017736 0.007067 1.222558 0.776881 1.025602 0.136510 1.065558 0.031534 1.120667 -0.017440 -0.095844 0.986588 0.811881 1.008160 1.083596 -0.057608 1.030774 -0.185755 1.016553 -0.060277 0.044570 0.071469 1.026382 -0.218238 -0.134819 0.125155 1.052665 0.219534 1.053074 0.975626 0.942097 0.042773 0.914988 0.904458 1.068383 0.122945 -0.160737 0.195111 -0.112309 0.079404 0.873713 0.743694 -0.042029 0.017013 1.026689 -0.033216 0.846494 1.151063 -0.096712 0.933521 -0.150138 0.998351 0.097766 1.014397 1.003826 0.249110 -0.089820 -0.095115 -0.041617 1.005328 -0.026956 0.282608 -0.227117 0.900497 0.151081 1.074944 0.999410 0.070956 0.989252 1.046830 0.036838 0.060586 0.119680 1.033878 1.147593 1.072223 1.038019 -0.063806 -0.066418 -0.094579 0.121532 0.058665 0.065637 0.015630 1.033625 -0.167401 -0.044227 0.109799 1.069494 0.978455 0.951966 0.848373 1.183717 0.052564 -0.139052 0.109210 1.056692 1.084067 0.913136 0.026099 0.888367 1.004145 -0.006357 -0.186626 1.147417 0.008987 1.033956 0.198511 1.087879 0.153898 -0.007073 -0.053729 0.960733 -0.079153 -0.112602 0.118601 1.127696 0.124208 -0.118455 1.113389 -0.141400 0.095581 0.831887 0.079625 1.065606 1.064953 -0.043117 0.883460 -0.117838 0.984417 1.073930 -0.020071 -0.020565 -0.110661 -0.029427 0.000735 0.129840 -0.059144 0.853604 0.029159 1.153760 -0.035371 0.120975 0.829886 0.902305 0.004019 1.024841 -0.008315 -0.040841 0.081011 0.034157 0.925135 0.026143 -0.146226 0.818801 0.997553 -0.057337 0.039344 0.045043 -0.058730 0.061450 0.034397 0.032312 1.021479 0.069734 0.032385 -0.034352 1.143739 0.128130 0.837756 0.143447 1.191780 1.005715 -0.145746 0.060156 -0.089751 0.993522 1.117964 1.113924 -0.051214 0.989301 1.131346 0.978070 1.120586 -0.104089 0.755209 0.911168 0.043338 0.799533 -0.065789 1.035956 1.103884 1.108033 -0.011160 0.018199 1.076458 1.033226 1.049461 0.927281 0.875446 -0.132488 -0.016539 1.040494 -0.085837 0.845351 0.082137 0.957295 0.975488 -0.233161 1.046308 0.968283 1.119329 0.799388 0.835437 1.198178 1.006967 -0.080996 1.022071 0.222670 1.054955 1.028112 0.145964 0.775125 0.053077 -0.139928 0.982870 0.012204 1.181785 -0.055209 0.064440 0.028436 -0.055658 0.988257 0.885626 0.925751 1.041503 -0.102556 0.199169 0.817618 1.118232 -0.154162 1.103379 0.161217 0.043204 0.038827 0.297793 0.101115 1.084585 0.911258 -0.017387 1.093864 1.174369 -0.052884 1.010587 1.084918 1.042023 0.988052 1.008470 1.079842 0.911711 -0.105412 1.049916 0.966051 -0.030853 0.634323 0.027996 0.065373 0.165603 -0.198745 0.121133 0.904870 0.798116 0.109313 -0.023197 -0.012270 -0.099679 -0.007982 0.957938 0.064886 1.066324 0.891833 0.030809 0.008848 -0.058683 1.151904 -0.064909 0.005548 0.092447 0.994226 0.980543 0.036553 0.977629 0.908112 1.053035 1.015332 1.120582 1.029707 0.935519 0.767415 -0.107332 1.106993 0.051063 -0.090849 -0.152447 1.074408 0.930237 -0.134191 -0.041339 1.154220 0.912402 0.915882 -0.155688 0.004278 1.005960 -0.029173 0.929692 0.891253 0.904414 -0.022210 0.912185 0.032760 -0.175809 1.064184 0.004444 1.023131 0.014814 0.025559 0.065555 0.781532 -0.029379 -0.197955 0.897852 -0.013217 1.093294 0.004968 -0.102189 1.031592 0.748643 0.996666 0.053363 -0.174095 0.022123 1.073767 0.026629 0.817199 0.923850 0.016734 1.000997 0.181206 0.011231 0.956073 0.190711 0.864217 -0.176983 1.016978 1.028389 0.023092 0.841323 1.197465 -0.032185 -0.023935 -0.154948 0.938794 0.022079 0.018001 0.863273 0.095137 -0.103529 1.048691 1.044424 1.076913 -0.091685 1.016448 0.235867 -0.191122 1.021688 0.903834 1.103008 1.062811 0.974671 0.808982 0.919788 0.797299 0.003866 0.924240 1.138022 1.138392 -0.086041 -0.072381 1.089510 0.997304 -0.196238 -0.081117 0.998652 -0.136927 1.094476 1.025478 1.128812 -0.043799 -0.160622 1.202644 -0.097115 1.028359 1.128248 1.149200 0.046912 1.215106 0.095300 0.230991 -0.177631 1.060265 0.025009 -0.087069 -0.045585 0.107297 0.905981 1.067101 1.105134 0.200901 0.832244 -0.158358 0.063741 -0.002433 0.178939 1.150184 -0.013758 0.739082 0.970621 1.116445 -0.077580 0.874011 -0.000811 0.757786 1.027494 0.948749 0.128206 1.197540 -0.121973 -0.035650 0.227456 1.012591 0.093402 0.788900 0.046330 1.127347 0.937960 0.147998 0.295156 0.047168 -0.449697 1.185666 1.027567 1.056837 0.896828 0.093411 0.188188 1.051113 0.196550 0.986178 0.963111 1.064836 0.986799 0.068409 0.940694 0.044600 0.930849 0.776664 1.119660 0.877476 -0.187121 0.889222 0.896426 1.114193 0.109176 0.974296 0.017034 0.058848 0.003626 -0.056434 -0.053055 -0.327863 1.110462 1.191687 0.833810 -0.093180 1.062518 0.877602 0.130458 1.046517 0.945395 -0.042202 0.884421 0.076614 0.998365 0.963405 -0.042360 1.233324 1.032498 0.850640 0.878991 1.172081 -0.131938 0.138522 1.031223 -0.060356 1.045766 1.146384 1.014251 1.035122 1.033944 0.910994 0.140291 0.017496 0.074785 0.017803 1.051564 0.940908 1.102397 0.914000 -0.151381 -0.037398 0.841172 0.980431 0.926522 1.010521 0.906633 0.898542 -0.046207 1.056040 -0.119697 -0.388635 1.042092 1.062407 -0.114191 0.973897 0.038767 0.170771 0.104476 0.108748 0.973779 0.829369 0.903094)
)
)
)
@@ -3503,951 +3502,951 @@
(define neven-min-peak-phases (vector
-(vector 1 1.0 #(0)
+(vector 1 1.0 #r(0)
)
-(vector 2 1.7601724863052 #(0 0)
+(vector 2 1.7601724863052 #r(0 0)
)
;;; 3 even --------------------------------------------------------------------------------
-(vector 3 2.2325525283813 #(0 0 0)
- 2.0235652605711 #(0 33/64 63/128)
+(vector 3 2.2325525283813 #r(0 0 0)
+ 2.0235652605711 #r(0 33/64 63/128)
- 2.0214650630951 #(0.0 0.52414411306381 0.48787820339203)
- 2.021465 #(0.000000 0.475854 0.512123)
- 2.021465 #(0.000000 0.524145 0.487877)
- 2.021465 #(0.000000 1.475854 1.512123) ; etc
+ 2.0214650630951 #r(0.0 0.52414411306381 0.48787820339203)
+ 2.021465 #r(0.000000 0.475854 0.512123)
+ 2.021465 #r(0.000000 0.524145 0.487877)
+ 2.021465 #r(0.000000 1.475854 1.512123) ; etc
)
;;; 4 even --------------------------------------------------------------------------------
-(vector 4 2.8359191417694 #(0 0 0 0)
- 2.450505601523 #(0 3/16 21/32 15/32)
+(vector 4 2.8359191417694 #r(0 0 0 0)
+ 2.450505601523 #r(0 3/16 21/32 15/32)
- ;2.434727537119 #(0 37 52 46) / 31
+ ;2.434727537119 #r(0 37 52 46) / 31
- 2.4311048984528 #(0.000 0.191 0.672 0.479)
- 2.4311048984528 #(0.000 0.809 0.328 0.521)
+ 2.4311048984528 #r(0.000 0.191 0.672 0.479)
+ 2.4311048984528 #r(0.000 0.809 0.328 0.521)
- ;; (optit :even 4 1/4 (expt 2 -100) 2.8359191417694 #(0 0 0 0))
- 2.4308773660653 #(0.0 -1.907463741733863571425899863243103027344E-1 -6.709215487223971763341978657990694046021E-1 -4.783757035623090736464746441924944519997E-1)
+ ;; (optit :even 4 1/4 (expt 2 -100) 2.8359191417694 #r(0 0 0 0))
+ 2.4308773660653 #r(0.0 -1.907463741733863571425899863243103027344E-1 -6.709215487223971763341978657990694046021E-1 -4.783757035623090736464746441924944519997E-1)
- ;; (optit :even 4 1/4 (expt 2 -100) 2.450505601523 #(0 3/16 21/32 15/32))
- 2.430877366065 #(0.0 1.907463741737958073940717440564185380936E-1 6.709215487230322239042834553401917219162E-1 4.783757035631506226991405128501355648041E-1)
- 2.4305741786957 #(0.0 0.19146482345276 0.67236139177392 0.47990912646831)
+ ;; (optit :even 4 1/4 (expt 2 -100) 2.450505601523 #r(0 3/16 21/32 15/32))
+ 2.430877366065 #r(0.0 1.907463741737958073940717440564185380936E-1 6.709215487230322239042834553401917219162E-1 4.783757035631506226991405128501355648041E-1)
+ 2.4305741786957 #r(0.0 0.19146482345276 0.67236139177392 0.47990912646831)
)
;;; 5 even --------------------------------------------------------------------------------
-(vector 5 2.816308259964 #(0 1 0 0 0)
+(vector 5 2.816308259964 #r(0 1 0 0 0)
- 2.6048328876495 #(0.0 1.7889379262924 0.49464252591133 0.018512051552534 0.013387856073678)
+ 2.6048328876495 #r(0.0 1.7889379262924 0.49464252591133 0.018512051552534 0.013387856073678)
- 2.604848 #(0.000000 0.211049 1.505353 1.981536 -0.013355)
+ 2.604848 #r(0.000000 0.211049 1.505353 1.981536 -0.013355)
)
;;; 6 even --------------------------------------------------------------------------------
-(vector 6 2.9795869831363 #(0 0 1 0 0 0)
+(vector 6 2.9795869831363 #r(0 0 1 0 0 0)
- 2.8369779013614 #(0.0 0.17925976781335 1.4035822186281 0.79344665247706 0.91203230191116 1.0958477007498)
+ 2.8369779013614 #r(0.0 0.17925976781335 1.4035822186281 0.79344665247706 0.91203230191116 1.0958477007498)
- 2.836991 #(0.000000 0.178390 1.402472 0.792230 0.912414 1.093877)
- 2.836980 #(0.000000 1.821818 0.597785 1.208038 1.087532 0.906567)
- 2.836978 #(0.000000 1.178373 0.402442 1.792189 1.912334 0.093818)
- 2.836972 #(0.000000 1.178483 0.402570 -0.207680 -0.087726 0.094035)
- 2.836966 #(0.000000 0.821717 1.597697 0.207985 0.087685 -0.093549)
- 2.836953 #(0.000000 0.821609 1.597559 0.207843 0.087745 -0.093780)
+ 2.836991 #r(0.000000 0.178390 1.402472 0.792230 0.912414 1.093877)
+ 2.836980 #r(0.000000 1.821818 0.597785 1.208038 1.087532 0.906567)
+ 2.836978 #r(0.000000 1.178373 0.402442 1.792189 1.912334 0.093818)
+ 2.836972 #r(0.000000 1.178483 0.402570 -0.207680 -0.087726 0.094035)
+ 2.836966 #r(0.000000 0.821717 1.597697 0.207985 0.087685 -0.093549)
+ 2.836953 #r(0.000000 0.821609 1.597559 0.207843 0.087745 -0.093780)
)
;;; 7 even --------------------------------------------------------------------------------
-(vector 7 3.3825581073761 #(0 0 0 0 0 1 0)
+(vector 7 3.3825581073761 #r(0 0 0 0 0 1 0)
- 3.0470769405365 #(0.0 0.503662109375 0.87483215332031 1.0009307861328 1.2656555175781 0.71012878417969 0.30850219726562)
- 3.0469672679901 #(0.0 0.50373814372209 0.87540721456314 1.0012873875657 1.2663739438299 0.71078327011007 0.30959991380794)
- 3.046965 #(0.000000 0.503616 0.874674 1.000689 1.265332 0.709676 0.308046)
+ 3.0470769405365 #r(0.0 0.503662109375 0.87483215332031 1.0009307861328 1.2656555175781 0.71012878417969 0.30850219726562)
+ 3.0469672679901 #r(0.0 0.50373814372209 0.87540721456314 1.0012873875657 1.2663739438299 0.71078327011007 0.30959991380794)
+ 3.046965 #r(0.000000 0.503616 0.874674 1.000689 1.265332 0.709676 0.308046)
)
;;; 8 even --------------------------------------------------------------------------------
-(vector 8 3.611234664917 #(0 0 0 0 0 1 0 0)
+(vector 8 3.611234664917 #r(0 0 0 0 0 1 0 0)
- 3.197691 #(0.000000 1.463442 0.984712 1.413077 0.862890 0.889575 1.684691 1.613214)
- 3.197689 #(0.000000 0.536983 1.016250 0.588185 1.138902 1.112562 0.318083 0.389844)
- 3.197673 #(0.000000 0.463394 -0.015494 0.412641 1.862274 -0.111008 0.683799 0.612199)
- 3.197643 #(0.000000 1.536907 0.016088 1.587997 0.138641 0.112256 1.317694 1.389405)
- 3.197539 #(0.000000 1.536753 0.015811 1.587753 0.138248 0.111716 1.317048 1.388715)
+ 3.197691 #r(0.000000 1.463442 0.984712 1.413077 0.862890 0.889575 1.684691 1.613214)
+ 3.197689 #r(0.000000 0.536983 1.016250 0.588185 1.138902 1.112562 0.318083 0.389844)
+ 3.197673 #r(0.000000 0.463394 -0.015494 0.412641 1.862274 -0.111008 0.683799 0.612199)
+ 3.197643 #r(0.000000 1.536907 0.016088 1.587997 0.138641 0.112256 1.317694 1.389405)
+ 3.197539 #r(0.000000 1.536753 0.015811 1.587753 0.138248 0.111716 1.317048 1.388715)
)
;;; 9 even --------------------------------------------------------------------------------
-(vector 9 4.0601739883423 #(0 0 0 0 0 0 1 1 0)
+(vector 9 4.0601739883423 #r(0 0 0 0 0 0 1 1 0)
- 3.454235 #(0.000000 1.380130 1.542684 1.103203 1.094600 0.755189 1.642794 1.504783 0.092364)
- 3.454343 #(0.000000 0.380149 0.542653 0.103243 0.094157 1.755278 0.642603 0.504207 1.092117)
- 3.454167 #(0.000000 1.619814 1.457133 1.896576 1.905245 0.244460 1.356830 1.494866 0.907164)
- 3.454104 #(0.000000 1.619789 1.457225 1.896592 1.905347 0.244468 1.356940 1.495046 0.907280)
- 3.453978 #(0.000000 1.619848 1.457320 1.896841 1.905503 0.244896 1.357384 1.495389 0.907798)
+ 3.454235 #r(0.000000 1.380130 1.542684 1.103203 1.094600 0.755189 1.642794 1.504783 0.092364)
+ 3.454343 #r(0.000000 0.380149 0.542653 0.103243 0.094157 1.755278 0.642603 0.504207 1.092117)
+ 3.454167 #r(0.000000 1.619814 1.457133 1.896576 1.905245 0.244460 1.356830 1.494866 0.907164)
+ 3.454104 #r(0.000000 1.619789 1.457225 1.896592 1.905347 0.244468 1.356940 1.495046 0.907280)
+ 3.453978 #r(0.000000 1.619848 1.457320 1.896841 1.905503 0.244896 1.357384 1.495389 0.907798)
)
;;; 10 even --------------------------------------------------------------------------------
-(vector 10 4.0054845809937 #(0 1 1 0 0 0 0 0 1 0)
+(vector 10 4.0054845809937 #r(0 1 1 0 0 0 0 0 1 0)
- 3.559069 #(0.000000 0.728493 1.283356 1.458356 0.068046 1.297046 -0.008724 1.763762 1.458102 1.082546)
- 3.559031 #(0.000000 1.271816 0.716134 0.541742 -0.068143 0.702758 0.008941 0.237259 0.543599 0.918279)
- 3.558934 #(0.000000 0.270311 1.713387 1.540231 0.930533 1.700561 1.006089 1.239216 1.544459 1.919820)
- 3.558711 #(0.000000 0.271020 1.715408 1.541006 0.931409 1.702058 1.007613 1.237445 1.543048 1.918285)
+ 3.559069 #r(0.000000 0.728493 1.283356 1.458356 0.068046 1.297046 -0.008724 1.763762 1.458102 1.082546)
+ 3.559031 #r(0.000000 1.271816 0.716134 0.541742 -0.068143 0.702758 0.008941 0.237259 0.543599 0.918279)
+ 3.558934 #r(0.000000 0.270311 1.713387 1.540231 0.930533 1.700561 1.006089 1.239216 1.544459 1.919820)
+ 3.558711 #r(0.000000 0.271020 1.715408 1.541006 0.931409 1.702058 1.007613 1.237445 1.543048 1.918285)
)
;;; 11 even --------------------------------------------------------------------------------
-(vector 11 4.2368197441101 #(0 0 1 1 0 1 1 1 0 0 0)
+(vector 11 4.2368197441101 #r(0 0 1 1 0 1 1 1 0 0 0)
- 3.656997 #(0.000000 0.364553 0.246524 0.545081 1.820586 -0.010486 0.065265 0.895857 0.689390 0.398119 1.238723)
- 3.656853 #(0.000000 0.636042 0.753996 0.455733 1.180490 1.011649 0.936897 0.106845 0.312362 0.605377 1.764604)
- 3.656814 #(0.000000 1.363823 1.245209 1.543687 0.818338 0.986715 1.061848 1.892251 1.683956 1.393470 0.233084)
- 3.656676 #(0.000000 1.635670 1.752596 1.453762 0.177717 0.008296 -0.065661 1.103599 1.306278 1.601279 0.759437)
- 3.656141 #(0.000000 1.635206 1.752773 1.453484 0.177816 0.008586 -0.066147 1.102294 1.308244 1.599463 0.758738)
+ 3.656997 #r(0.000000 0.364553 0.246524 0.545081 1.820586 -0.010486 0.065265 0.895857 0.689390 0.398119 1.238723)
+ 3.656853 #r(0.000000 0.636042 0.753996 0.455733 1.180490 1.011649 0.936897 0.106845 0.312362 0.605377 1.764604)
+ 3.656814 #r(0.000000 1.363823 1.245209 1.543687 0.818338 0.986715 1.061848 1.892251 1.683956 1.393470 0.233084)
+ 3.656676 #r(0.000000 1.635670 1.752596 1.453762 0.177717 0.008296 -0.065661 1.103599 1.306278 1.601279 0.759437)
+ 3.656141 #r(0.000000 1.635206 1.752773 1.453484 0.177816 0.008586 -0.066147 1.102294 1.308244 1.599463 0.758738)
)
;;; 12 even --------------------------------------------------------------------------------
-(vector 12 4.4100483425078 #(0 0 0 1 1 0 1 0 0 0 0 0)
+(vector 12 4.4100483425078 #r(0 0 0 1 1 0 1 0 0 0 0 0)
- 3.787770 #(0.000000 1.448638 0.653979 0.460567 1.750296 1.187409 1.823828 0.621465 0.835166 0.896814 0.649295 0.954712)
- 3.787607 #(0.000000 1.552098 0.349619 0.543969 1.255255 1.818801 1.184427 0.387699 0.175349 0.115468 0.364328 0.059990)
- 3.787594 #(0.000000 0.551763 1.347551 1.541126 0.252553 0.815620 0.180247 1.383525 1.170726 1.109400 1.357991 1.052935)
- 3.786929 #(0.000000 0.551301 1.345490 1.538545 0.249324 0.811835 0.175379 1.377915 1.164645 1.102028 1.349918 1.044104)
+ 3.787770 #r(0.000000 1.448638 0.653979 0.460567 1.750296 1.187409 1.823828 0.621465 0.835166 0.896814 0.649295 0.954712)
+ 3.787607 #r(0.000000 1.552098 0.349619 0.543969 1.255255 1.818801 1.184427 0.387699 0.175349 0.115468 0.364328 0.059990)
+ 3.787594 #r(0.000000 0.551763 1.347551 1.541126 0.252553 0.815620 0.180247 1.383525 1.170726 1.109400 1.357991 1.052935)
+ 3.786929 #r(0.000000 0.551301 1.345490 1.538545 0.249324 0.811835 0.175379 1.377915 1.164645 1.102028 1.349918 1.044104)
)
;;; 13 even --------------------------------------------------------------------------------
-(vector 13 4.4076361656189 #(0 0 1 0 1 1 0 0 1 1 1 1 1)
+(vector 13 4.4076361656189 #r(0 0 1 0 1 1 0 0 1 1 1 1 1)
- 3.973518 #(0.000000 1.227848 0.569459 0.032525 1.602849 0.995992 1.561449 0.851502 1.005100 0.700156 1.033637 1.225072 1.740227)
- 3.973285 #(0.000000 0.221343 1.559694 1.013474 0.580564 -0.035047 0.522724 -0.190833 -0.044249 1.645456 -0.025041 0.160741 0.667019)
- 3.973148 #(0.000000 0.225623 1.564256 1.022022 0.590378 -0.019884 0.539658 -0.171656 -0.022033 1.670109 0.001495 0.190555 0.699291)
- 3.973041 #(0.000000 0.226214 1.565751 1.024299 0.592784 -0.015292 0.545848 -0.164098 -0.014254 1.677783 0.010954 0.201582 0.710821)
- 3.972554 #(0.000000 0.227025 1.566229 1.025033 0.594027 -0.014872 0.545046 -0.165560 -0.014836 1.678196 0.010096 0.200561 0.709954)
+ 3.973518 #r(0.000000 1.227848 0.569459 0.032525 1.602849 0.995992 1.561449 0.851502 1.005100 0.700156 1.033637 1.225072 1.740227)
+ 3.973285 #r(0.000000 0.221343 1.559694 1.013474 0.580564 -0.035047 0.522724 -0.190833 -0.044249 1.645456 -0.025041 0.160741 0.667019)
+ 3.973148 #r(0.000000 0.225623 1.564256 1.022022 0.590378 -0.019884 0.539658 -0.171656 -0.022033 1.670109 0.001495 0.190555 0.699291)
+ 3.973041 #r(0.000000 0.226214 1.565751 1.024299 0.592784 -0.015292 0.545848 -0.164098 -0.014254 1.677783 0.010954 0.201582 0.710821)
+ 3.972554 #r(0.000000 0.227025 1.566229 1.025033 0.594027 -0.014872 0.545046 -0.165560 -0.014836 1.678196 0.010096 0.200561 0.709954)
)
;;; 14 even --------------------------------------------------------------------------------
-(vector 14 4.5770673751831 #(0 1 1 0 0 1 1 1 1 1 1 0 1 0)
+(vector 14 4.5770673751831 #r(0 1 1 0 0 1 1 1 1 1 1 0 1 0)
- 4.097747 #(0.000000 0.927497 0.986240 1.222647 1.417439 1.485272 1.245695 0.840056 0.775783 1.393795 0.027626 0.815063 1.945062 1.449403)
- 4.096703 #(0.000000 0.927014 0.985352 1.221418 1.415761 1.483290 1.243140 0.836933 0.772657 1.390170 0.023348 0.810693 1.940171 1.444293)
+ 4.097747 #r(0.000000 0.927497 0.986240 1.222647 1.417439 1.485272 1.245695 0.840056 0.775783 1.393795 0.027626 0.815063 1.945062 1.449403)
+ 4.096703 #r(0.000000 0.927014 0.985352 1.221418 1.415761 1.483290 1.243140 0.836933 0.772657 1.390170 0.023348 0.810693 1.940171 1.444293)
)
;;; 15 even --------------------------------------------------------------------------------
-(vector 15 4.7838921546936 #(0 0 0 0 0 1 1 1 1 0 1 1 1 0 1)
+(vector 15 4.7838921546936 #r(0 0 0 0 0 1 1 1 1 0 1 1 1 0 1)
- 4.193545 #(0.000000 1.673990 1.704095 0.184742 0.312157 1.759699 0.661838 0.338558 1.336129 0.060082 0.592895 0.470075 0.323799 1.690560 1.851587)
- 4.193539 #(0.000000 1.674972 1.705674 0.187574 0.315997 1.764079 0.667192 0.344813 1.343115 0.068186 0.601740 0.479341 0.334140 1.702389 1.863580)
- 4.192089 #(0.000000 1.673474 1.702683 0.182852 0.310553 1.756894 0.658556 0.335052 1.332116 0.055950 0.587971 0.464438 0.317829 1.684035 1.844319)
+ 4.193545 #r(0.000000 1.673990 1.704095 0.184742 0.312157 1.759699 0.661838 0.338558 1.336129 0.060082 0.592895 0.470075 0.323799 1.690560 1.851587)
+ 4.193539 #r(0.000000 1.674972 1.705674 0.187574 0.315997 1.764079 0.667192 0.344813 1.343115 0.068186 0.601740 0.479341 0.334140 1.702389 1.863580)
+ 4.192089 #r(0.000000 1.673474 1.702683 0.182852 0.310553 1.756894 0.658556 0.335052 1.332116 0.055950 0.587971 0.464438 0.317829 1.684035 1.844319)
)
;;; 16 even --------------------------------------------------------------------------------
-(vector 16 5.0737318992615 #(0 1 1 1 1 1 1 1 0 0 1 1 1 0 1 0)
+(vector 16 5.0737318992615 #r(0 1 1 1 1 1 1 1 0 0 1 1 1 0 1 0)
- 4.326467 #(0.000000 0.954646 0.857741 0.564427 0.380619 -0.030405 0.027220 0.443651 0.347240 0.290827 1.057423 1.274647 0.193509 1.337335 0.715554 1.355809)
- 4.326323 #(0.000000 0.953094 0.856111 0.562335 0.378555 -0.035716 0.021343 0.437774 0.341052 0.283988 1.049334 1.266917 0.184364 1.326298 0.704383 1.343207)
- 4.325044 #(0.000000 0.953571 0.856165 0.561119 0.376819 -0.035768 0.021241 0.436352 0.339200 0.281830 1.047126 1.263828 0.181703 1.324018 0.701028 1.340302)
+ 4.326467 #r(0.000000 0.954646 0.857741 0.564427 0.380619 -0.030405 0.027220 0.443651 0.347240 0.290827 1.057423 1.274647 0.193509 1.337335 0.715554 1.355809)
+ 4.326323 #r(0.000000 0.953094 0.856111 0.562335 0.378555 -0.035716 0.021343 0.437774 0.341052 0.283988 1.049334 1.266917 0.184364 1.326298 0.704383 1.343207)
+ 4.325044 #r(0.000000 0.953571 0.856165 0.561119 0.376819 -0.035768 0.021241 0.436352 0.339200 0.281830 1.047126 1.263828 0.181703 1.324018 0.701028 1.340302)
)
;;; 17 even --------------------------------------------------------------------------------
-(vector 17 5.2332563400269 #(0 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 0)
+(vector 17 5.2332563400269 #r(0 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 0)
- 4.464096 #(0.000000 1.478399 1.021179 1.293532 1.222041 1.188322 1.479616 1.284032 0.091138 1.349289 0.401522 0.364537 -0.044880 1.268488 1.386805 0.039323 0.607489)
- 4.463016 #(0.000000 1.478182 1.023133 1.293051 1.222719 1.187462 1.479990 1.285327 0.088371 1.348357 0.403976 0.365587 -0.044469 1.267681 1.387786 0.039745 0.610112)
+ 4.464096 #r(0.000000 1.478399 1.021179 1.293532 1.222041 1.188322 1.479616 1.284032 0.091138 1.349289 0.401522 0.364537 -0.044880 1.268488 1.386805 0.039323 0.607489)
+ 4.463016 #r(0.000000 1.478182 1.023133 1.293051 1.222719 1.187462 1.479990 1.285327 0.088371 1.348357 0.403976 0.365587 -0.044469 1.267681 1.387786 0.039745 0.610112)
)
;;; 18 even --------------------------------------------------------------------------------
-(vector 18 5.3310880661011 #(0 1 1 1 1 0 0 1 0 1 1 0 0 0 1 0 0 0)
+(vector 18 5.3310880661011 #r(0 1 1 1 1 0 0 1 0 1 1 0 0 0 1 0 0 0)
- 4.569421 #(0.000000 1.011793 0.580064 1.185332 1.624771 0.036509 -0.103084 0.721775 1.089226 0.493658 0.073953 1.074825 1.595710 1.108207 1.196849 1.497424 1.163445 0.995437)
+ 4.569421 #r(0.000000 1.011793 0.580064 1.185332 1.624771 0.036509 -0.103084 0.721775 1.089226 0.493658 0.073953 1.074825 1.595710 1.108207 1.196849 1.497424 1.163445 0.995437)
)
;;; 19 even --------------------------------------------------------------------------------
-(vector 19 5.4619059562683 #(0 0 1 0 0 0 0 0 0 0 1 0 0 1 1 1 0 0 0)
+(vector 19 5.4619059562683 #r(0 0 1 0 0 0 0 0 0 0 1 0 0 1 1 1 0 0 0)
- 4.741489 #(0.000000 1.217162 0.660633 0.437661 1.320878 1.235636 0.094939 -0.184508 -0.090396 0.415156 1.119340 1.141612 0.652398 0.817014 0.525642 1.150459 0.295913 0.906911 0.831168)
+ 4.741489 #r(0.000000 1.217162 0.660633 0.437661 1.320878 1.235636 0.094939 -0.184508 -0.090396 0.415156 1.119340 1.141612 0.652398 0.817014 0.525642 1.150459 0.295913 0.906911 0.831168)
)
;;; 20 even --------------------------------------------------------------------------------
-(vector 20 5.5266017913818 #(0 0 1 1 1 0 0 0 1 0 1 1 0 1 1 1 1 1 1 0)
+(vector 20 5.5266017913818 #r(0 0 1 1 1 0 0 0 1 0 1 1 0 1 1 1 1 1 1 0)
- 4.839482 #(0.000000 0.882739 0.097549 0.018330 1.302731 0.272028 1.407538 1.702479 0.580972 1.045015 0.992304 1.669564 0.673981 0.282219 0.289947 0.363499 1.033218 0.803741 0.771035 0.508087)
+ 4.839482 #r(0.000000 0.882739 0.097549 0.018330 1.302731 0.272028 1.407538 1.702479 0.580972 1.045015 0.992304 1.669564 0.673981 0.282219 0.289947 0.363499 1.033218 0.803741 0.771035 0.508087)
)
;;; 21 even --------------------------------------------------------------------------------
-(vector 21 5.6849967470046 #(0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 0 0 0 0)
+(vector 21 5.6849967470046 #r(0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 0 0 0 0)
- 4.919735 #(0.000000 -0.021966 1.377831 1.499470 -0.139205 1.937761 0.320320 0.217546 0.069290 0.938854 1.308616 0.123782 0.469963 1.818882 1.581666 1.414927 0.056553 1.301602 0.788305 1.336052 0.607478)
+ 4.919735 #r(0.000000 -0.021966 1.377831 1.499470 -0.139205 1.937761 0.320320 0.217546 0.069290 0.938854 1.308616 0.123782 0.469963 1.818882 1.581666 1.414927 0.056553 1.301602 0.788305 1.336052 0.607478)
)
;;; 22 even --------------------------------------------------------------------------------
-(vector 22 5.8572781078687 #(0 1 0 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 0 0)
+(vector 22 5.8572781078687 #r(0 1 0 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 0 0)
- 5.055233 #(0.000000 -1.550778 1.843415 0.900724 0.955590 0.677531 1.390686 0.133831 1.229871 1.016503 1.245622 1.546957 -1.869615 1.414871 -0.060378 -0.077148 1.210164 1.132173 0.909114 1.325478 1.285781 0.509617)
+ 5.055233 #r(0.000000 -1.550778 1.843415 0.900724 0.955590 0.677531 1.390686 0.133831 1.229871 1.016503 1.245622 1.546957 -1.869615 1.414871 -0.060378 -0.077148 1.210164 1.132173 0.909114 1.325478 1.285781 0.509617)
)
;;; 23 even --------------------------------------------------------------------------------
-(vector 23 5.9208135892745 #(0 0 1 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 0 0 0 0)
+(vector 23 5.9208135892745 #r(0 0 1 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 0 0 0 0)
- 5.147900 #(0.000000 0.493561 0.617878 0.386087 -0.215675 1.136922 0.632292 0.891205 1.398746 0.878537 0.676611 0.945565 0.610792 -0.182076 0.354229 1.383426 1.649635 0.414770 0.152656 0.561509 0.267633 1.102796 1.466348)
+ 5.147900 #r(0.000000 0.493561 0.617878 0.386087 -0.215675 1.136922 0.632292 0.891205 1.398746 0.878537 0.676611 0.945565 0.610792 -0.182076 0.354229 1.383426 1.649635 0.414770 0.152656 0.561509 0.267633 1.102796 1.466348)
)
;;; 24 even --------------------------------------------------------------------------------
-(vector 24 6.0318420391191 #(0 1 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 0)
+(vector 24 6.0318420391191 #r(0 1 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 0)
- 5.253162 #(0.000000 0.045084 0.641921 -0.205904 0.266767 1.228115 0.912709 0.214922 1.487762 1.357882 0.864877 0.404420 0.601935 0.594931 0.069420 1.052347 1.659787 1.624121 0.035857 0.245103 1.406872 0.042697 -0.053953 0.167577)
+ 5.253162 #r(0.000000 0.045084 0.641921 -0.205904 0.266767 1.228115 0.912709 0.214922 1.487762 1.357882 0.864877 0.404420 0.601935 0.594931 0.069420 1.052347 1.659787 1.624121 0.035857 0.245103 1.406872 0.042697 -0.053953 0.167577)
;; nce:
- 5.253153 #(0.000000 0.045202 0.642246 -0.205352 0.266926 1.228585 0.913398 0.215740 1.488650 1.358650 0.865965 0.405240 0.603061 0.596132 0.070695 1.053498 1.661316 1.625634 0.037488 0.246663 1.408918 0.044558 -0.052337 0.169870)
+ 5.253153 #r(0.000000 0.045202 0.642246 -0.205352 0.266926 1.228585 0.913398 0.215740 1.488650 1.358650 0.865965 0.405240 0.603061 0.596132 0.070695 1.053498 1.661316 1.625634 0.037488 0.246663 1.408918 0.044558 -0.052337 0.169870)
)
;;; 25 even --------------------------------------------------------------------------------
-(vector 25 6.1513186981755 #(0 0 1 0 1 0 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 1 1)
+(vector 25 6.1513186981755 #r(0 0 1 0 1 0 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 1 1)
- 5.403228 #(0.000000 0.045060 1.794212 1.406802 1.249045 0.257853 0.430644 -0.020674 0.209605 1.159346 1.742584 0.244624 1.006989 0.948352 0.613996 0.229169 0.745474 0.773295 0.271006 1.529917 0.384835 1.822065 0.327936 0.153008 0.689262)
+ 5.403228 #r(0.000000 0.045060 1.794212 1.406802 1.249045 0.257853 0.430644 -0.020674 0.209605 1.159346 1.742584 0.244624 1.006989 0.948352 0.613996 0.229169 0.745474 0.773295 0.271006 1.529917 0.384835 1.822065 0.327936 0.153008 0.689262)
;; nce:
- 5.408253 #(0.000000 -0.043635 1.870808 1.373617 1.322838 0.337670 0.345509 0.039602 0.231587 1.174477 1.746219 0.272425 1.051956 0.894710 0.701095 0.201178 0.713607 0.745859 0.396015 1.495521 0.465720 1.748739 0.254514 0.207309 0.670746)
+ 5.408253 #r(0.000000 -0.043635 1.870808 1.373617 1.322838 0.337670 0.345509 0.039602 0.231587 1.174477 1.746219 0.272425 1.051956 0.894710 0.701095 0.201178 0.713607 0.745859 0.396015 1.495521 0.465720 1.748739 0.254514 0.207309 0.670746)
)
;;; 26 even --------------------------------------------------------------------------------
-(vector 26 6.2921685546205 #(0 0 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 0)
+(vector 26 6.2921685546205 #r(0 0 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 0)
- 5.452331 #(0.000000 0.051327 0.204117 1.807782 0.408597 -0.021081 0.115796 0.407761 0.824888 0.626144 0.637118 0.067354 0.844059 0.574978 -0.127497 -0.091341 1.702516 0.546084 0.986055 1.260143 0.631019 1.781357 1.305578 1.812413 0.666374 0.989339)
+ 5.452331 #r(0.000000 0.051327 0.204117 1.807782 0.408597 -0.021081 0.115796 0.407761 0.824888 0.626144 0.637118 0.067354 0.844059 0.574978 -0.127497 -0.091341 1.702516 0.546084 0.986055 1.260143 0.631019 1.781357 1.305578 1.812413 0.666374 0.989339)
)
;;; 27 even --------------------------------------------------------------------------------
-(vector 27 6.2436904245852 #(0 1 1 0 0 0 0 0 1 0 0 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 1)
+(vector 27 6.2436904245852 #r(0 1 1 0 0 0 0 0 1 0 0 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 1)
- 5.620374 #(0.000000 -0.021456 0.516604 0.372410 0.864531 1.336703 -0.209149 1.689313 0.033950 1.772624 0.571345 1.616802 0.355488 1.092886 1.391271 1.240098 1.111612 0.854249 0.888716 0.157123 -0.311986 1.252460 1.082038 -0.272435 1.564985 0.964546 1.600742)
+ 5.620374 #r(0.000000 -0.021456 0.516604 0.372410 0.864531 1.336703 -0.209149 1.689313 0.033950 1.772624 0.571345 1.616802 0.355488 1.092886 1.391271 1.240098 1.111612 0.854249 0.888716 0.157123 -0.311986 1.252460 1.082038 -0.272435 1.564985 0.964546 1.600742)
)
;;; 28 even --------------------------------------------------------------------------------
-(vector 28 6.5361909866333 #(0 0 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1)
+(vector 28 6.5361909866333 #r(0 0 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1)
- 5.731679 #(0.000000 1.447589 1.395977 0.797533 1.295906 1.462640 1.534875 1.774902 1.013697 0.705377 0.626264 1.242696 1.362454 0.181714 0.805604 1.271981 0.570662 1.779635 -0.124462 1.352040 -0.225912 1.764222 0.153642 1.298969 0.773437 0.201599 0.803480 0.102660)
+ 5.731679 #r(0.000000 1.447589 1.395977 0.797533 1.295906 1.462640 1.534875 1.774902 1.013697 0.705377 0.626264 1.242696 1.362454 0.181714 0.805604 1.271981 0.570662 1.779635 -0.124462 1.352040 -0.225912 1.764222 0.153642 1.298969 0.773437 0.201599 0.803480 0.102660)
;; nce:
- 5.757769 #(0.000000 -0.064452 1.194800 0.947245 0.026529 0.920008 0.673833 0.051447 -0.007043 1.637680 1.814843 1.945096 0.720067 0.530198 0.753640 0.603773 1.296939 0.860024 0.197512 0.571117 0.903138 1.152266 0.326717 0.457781 -0.069831 0.864587 1.677694 0.471749)
+ 5.757769 #r(0.000000 -0.064452 1.194800 0.947245 0.026529 0.920008 0.673833 0.051447 -0.007043 1.637680 1.814843 1.945096 0.720067 0.530198 0.753640 0.603773 1.296939 0.860024 0.197512 0.571117 0.903138 1.152266 0.326717 0.457781 -0.069831 0.864587 1.677694 0.471749)
)
;;; 29 even --------------------------------------------------------------------------------
-(vector 29 6.6767044067383 #(0 1 0 0 0 1 0 1 0 1 1 1 0 0 1 0 0 1 0 1 1 1 1 0 0 1 1 1 1)
+(vector 29 6.6767044067383 #r(0 1 0 0 0 1 0 1 0 1 1 1 0 0 1 0 0 1 0 1 1 1 1 0 0 1 1 1 1)
- 5.766338 #(0.000000 1.750571 1.825931 1.106253 0.681108 0.654013 0.530242 0.078216 0.174544 1.354195 1.454712 1.045782 1.722411 1.607453 0.347380 0.849326 0.377709 1.136286 1.004911 0.970793 0.410809 0.919085 1.010160 0.193230 0.966878 0.662369 1.289507 1.533180 0.429508)
+ 5.766338 #r(0.000000 1.750571 1.825931 1.106253 0.681108 0.654013 0.530242 0.078216 0.174544 1.354195 1.454712 1.045782 1.722411 1.607453 0.347380 0.849326 0.377709 1.136286 1.004911 0.970793 0.410809 0.919085 1.010160 0.193230 0.966878 0.662369 1.289507 1.533180 0.429508)
)
;;; 30 even --------------------------------------------------------------------------------
-(vector 30 6.6998701095581 #(0 0 0 1 0 1 1 0 1 1 1 1 1 0 0 0 0 1 1 1 1 0 1 1 1 0 1 1 1 0)
+(vector 30 6.6998701095581 #r(0 0 0 1 0 1 1 0 1 1 1 1 1 0 0 0 0 1 1 1 1 0 1 1 1 0 1 1 1 0)
- 5.906955 #(0.000000 0.906624 1.374273 1.276597 -0.178673 0.094922 0.333601 0.129339 0.400307 0.946356 1.401096 0.557587 0.654474 1.274947 0.061009 -0.048005 1.903626 1.753056 1.439902 1.944968 1.607217 1.115332 0.419220 1.617499 1.734563 1.091117 0.095163 0.781775 -0.001559 1.852411)
+ 5.906955 #r(0.000000 0.906624 1.374273 1.276597 -0.178673 0.094922 0.333601 0.129339 0.400307 0.946356 1.401096 0.557587 0.654474 1.274947 0.061009 -0.048005 1.903626 1.753056 1.439902 1.944968 1.607217 1.115332 0.419220 1.617499 1.734563 1.091117 0.095163 0.781775 -0.001559 1.852411)
;; nce:
- 5.930402 #(0.000000 -0.023546 1.489564 1.475097 0.916826 0.864026 1.899229 1.607559 0.910332 0.924096 1.371927 0.795577 0.542873 0.396054 0.844978 1.658639 0.174074 0.939529 1.326938 1.039010 1.301858 1.417763 1.619561 1.723680 0.850267 0.018519 1.089727 0.405902 1.206335 1.833260)
+ 5.930402 #r(0.000000 -0.023546 1.489564 1.475097 0.916826 0.864026 1.899229 1.607559 0.910332 0.924096 1.371927 0.795577 0.542873 0.396054 0.844978 1.658639 0.174074 0.939529 1.326938 1.039010 1.301858 1.417763 1.619561 1.723680 0.850267 0.018519 1.089727 0.405902 1.206335 1.833260)
)
;;; 31 even --------------------------------------------------------------------------------
-(vector 31 6.8660564422607 #(0 1 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0)
+(vector 31 6.8660564422607 #r(0 1 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0)
- 5.987789 #(0.000000 1.294084 1.380328 1.151198 1.131917 1.032100 1.467500 1.317593 1.561230 1.149337 1.426512 0.310391 0.093956 -0.092069 1.618651 0.385482 1.276093 0.768907 0.092705 1.372235 0.935730 0.030657 0.353616 1.817773 0.372502 0.700675 1.341184 1.537494 1.331726 0.302069 0.818207)
+ 5.987789 #r(0.000000 1.294084 1.380328 1.151198 1.131917 1.032100 1.467500 1.317593 1.561230 1.149337 1.426512 0.310391 0.093956 -0.092069 1.618651 0.385482 1.276093 0.768907 0.092705 1.372235 0.935730 0.030657 0.353616 1.817773 0.372502 0.700675 1.341184 1.537494 1.331726 0.302069 0.818207)
)
;;; 32 even --------------------------------------------------------------------------------
-(vector 32 6.9974670410156 #(0 0 0 1 1 1 0 1 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 0)
+(vector 32 6.9974670410156 #r(0 0 0 1 1 1 0 1 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 0)
- 6.061091 #(0.000000 0.284769 1.824838 0.360868 1.114185 0.962149 1.153553 1.836957 0.183317 1.504519 0.431670 1.106470 0.465083 1.359049 1.532974 1.672623 0.833072 1.851412 -0.259099 1.829526 0.240313 0.782734 0.067562 1.704922 0.670838 0.000337 1.835105 1.184487 1.464400 1.660678 0.971147 1.137597)
+ 6.061091 #r(0.000000 0.284769 1.824838 0.360868 1.114185 0.962149 1.153553 1.836957 0.183317 1.504519 0.431670 1.106470 0.465083 1.359049 1.532974 1.672623 0.833072 1.851412 -0.259099 1.829526 0.240313 0.782734 0.067562 1.704922 0.670838 0.000337 1.835105 1.184487 1.464400 1.660678 0.971147 1.137597)
)
;;; 33 even --------------------------------------------------------------------------------
-(vector 33 6.978609085083 #(0 0 0 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 0 1 0 0 1 1 0 1 0 1 1 0)
+(vector 33 6.978609085083 #r(0 0 0 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 0 1 0 0 1 1 0 1 0 1 1 0)
- 6.162617 #(0.000000 -0.095863 -0.402980 1.394421 -0.306134 0.366840 0.337119 0.377845 0.129322 0.155850 1.349812 0.235845 0.252319 0.242909 1.431344 1.664418 1.236043 1.670315 1.653641 0.461681 0.695631 0.916345 0.353418 1.885954 1.309177 0.582371 1.382992 1.788982 0.399357 0.760664 0.154447 0.882692 0.073082)
+ 6.162617 #r(0.000000 -0.095863 -0.402980 1.394421 -0.306134 0.366840 0.337119 0.377845 0.129322 0.155850 1.349812 0.235845 0.252319 0.242909 1.431344 1.664418 1.236043 1.670315 1.653641 0.461681 0.695631 0.916345 0.353418 1.885954 1.309177 0.582371 1.382992 1.788982 0.399357 0.760664 0.154447 0.882692 0.073082)
)
;;; 34 even --------------------------------------------------------------------------------
-(vector 34 7.2615523338318 #(0 1 0 0 1 0 1 1 0 1 0 1 1 1 0 0 0 1 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0)
+(vector 34 7.2615523338318 #r(0 1 0 0 1 0 1 1 0 1 0 1 1 1 0 0 0 1 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0)
- 6.222816 #(0.000000 -0.031974 0.094234 0.502100 0.850042 0.574691 0.752336 1.914959 -0.024174 0.146232 0.295078 1.383128 -0.007584 0.943763 1.235227 0.413741 0.587141 -0.053979 1.839683 0.252526 0.156123 0.682869 0.409598 -0.127649 0.823619 0.505563 1.228553 1.452425 1.154757 0.224780 1.122198 1.589227 1.075252 0.529430)
+ 6.222816 #r(0.000000 -0.031974 0.094234 0.502100 0.850042 0.574691 0.752336 1.914959 -0.024174 0.146232 0.295078 1.383128 -0.007584 0.943763 1.235227 0.413741 0.587141 -0.053979 1.839683 0.252526 0.156123 0.682869 0.409598 -0.127649 0.823619 0.505563 1.228553 1.452425 1.154757 0.224780 1.122198 1.589227 1.075252 0.529430)
)
;;; 35 even --------------------------------------------------------------------------------
-(vector 35 7.2921919822693 #(0 0 0 0 0 1 0 1 1 1 0 0 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 0 1 0 0 0 0 0)
+(vector 35 7.2921919822693 #r(0 0 0 0 0 1 0 1 1 1 0 0 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 0 1 0 0 0 0 0)
- 6.362258 #(0.000000 -0.109595 1.553671 0.219728 0.238496 1.170971 0.131935 0.808676 1.471325 1.403853 0.916637 1.560710 -0.099827 1.196395 0.221158 1.202313 0.775632 0.876517 1.782554 1.124579 1.420710 0.952275 0.641256 1.819844 1.425015 -0.516862 1.352551 1.568353 1.482981 0.524776 0.577204 0.865347 -0.128894 -0.102429 0.426519)
+ 6.362258 #r(0.000000 -0.109595 1.553671 0.219728 0.238496 1.170971 0.131935 0.808676 1.471325 1.403853 0.916637 1.560710 -0.099827 1.196395 0.221158 1.202313 0.775632 0.876517 1.782554 1.124579 1.420710 0.952275 0.641256 1.819844 1.425015 -0.516862 1.352551 1.568353 1.482981 0.524776 0.577204 0.865347 -0.128894 -0.102429 0.426519)
)
;;; 36 even --------------------------------------------------------------------------------
-(vector 36 7.3326554298401 #(0 0 1 0 1 0 1 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 0)
+(vector 36 7.3326554298401 #r(0 0 1 0 1 0 1 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 0)
- 6.432117 #(0.000000 0.004340 0.086403 1.388728 0.898065 1.458617 0.131985 1.657435 1.521273 1.472417 0.951218 1.324245 1.241442 1.395549 0.150266 1.064974 0.650640 1.427046 1.086279 0.098701 0.328772 1.795832 1.461165 0.857821 1.693245 1.032679 1.245848 0.174782 -0.135078 0.155045 -0.013817 0.388292 0.719587 1.603641 0.575715 0.836424)
+ 6.432117 #r(0.000000 0.004340 0.086403 1.388728 0.898065 1.458617 0.131985 1.657435 1.521273 1.472417 0.951218 1.324245 1.241442 1.395549 0.150266 1.064974 0.650640 1.427046 1.086279 0.098701 0.328772 1.795832 1.461165 0.857821 1.693245 1.032679 1.245848 0.174782 -0.135078 0.155045 -0.013817 0.388292 0.719587 1.603641 0.575715 0.836424)
;; nce:
- 6.433446 #(0.000000 -0.039571 0.060618 1.408936 0.882042 1.447670 0.143068 1.639607 1.518329 1.469129 0.942793 1.305387 1.226395 1.375800 0.162353 1.047466 0.675921 1.406954 1.102981 0.111251 0.337382 1.829176 1.494772 0.804464 1.712328 1.039053 1.250692 0.166362 -0.143216 0.133112 -0.012403 0.370517 0.701621 1.606484 0.581751 0.854317)
+ 6.433446 #r(0.000000 -0.039571 0.060618 1.408936 0.882042 1.447670 0.143068 1.639607 1.518329 1.469129 0.942793 1.305387 1.226395 1.375800 0.162353 1.047466 0.675921 1.406954 1.102981 0.111251 0.337382 1.829176 1.494772 0.804464 1.712328 1.039053 1.250692 0.166362 -0.143216 0.133112 -0.012403 0.370517 0.701621 1.606484 0.581751 0.854317)
)
;;; 37 even --------------------------------------------------------------------------------
-(vector 37 7.4919209480286 #(0 1 1 0 0 1 1 1 0 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 0)
+(vector 37 7.4919209480286 #r(0 1 1 0 0 1 1 1 0 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 0)
;; ce:
- 6.533287 #(0.000000 0.011564 0.880733 1.522736 0.250376 0.789024 1.673119 0.570623 1.276735 0.341425 -0.532081 0.348007 -0.836598 0.457646 -0.009210 1.409326 1.013302 0.369886 1.439731 1.104224 1.371479 0.882940 0.611993 0.167228 0.213651 -0.123007 -0.145430 -0.035562 0.326284 0.342544 0.027533 0.469211 0.589131 1.242729 -0.350729 -0.122043 0.359222)
+ 6.533287 #r(0.000000 0.011564 0.880733 1.522736 0.250376 0.789024 1.673119 0.570623 1.276735 0.341425 -0.532081 0.348007 -0.836598 0.457646 -0.009210 1.409326 1.013302 0.369886 1.439731 1.104224 1.371479 0.882940 0.611993 0.167228 0.213651 -0.123007 -0.145430 -0.035562 0.326284 0.342544 0.027533 0.469211 0.589131 1.242729 -0.350729 -0.122043 0.359222)
)
;;; 38 even --------------------------------------------------------------------------------
-(vector 38 7.669114112854 #(0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 0 0 0 0 0 0 0)
+(vector 38 7.669114112854 #r(0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 0 0 0 0 0 0 0)
- 6.536590 #(0.000000 -0.020563 1.377251 1.769036 0.243537 1.765876 1.779834 1.045673 1.286350 0.293614 0.321305 1.723518 1.560003 0.401205 0.333918 -0.059485 0.232219 0.960903 1.594163 1.401434 0.649608 0.412099 1.329747 0.099455 1.939824 0.267997 0.403580 1.515217 0.579512 0.002234 0.262847 1.800156 0.419089 1.615975 1.110793 1.305676 1.421012 1.714827)
+ 6.536590 #r(0.000000 -0.020563 1.377251 1.769036 0.243537 1.765876 1.779834 1.045673 1.286350 0.293614 0.321305 1.723518 1.560003 0.401205 0.333918 -0.059485 0.232219 0.960903 1.594163 1.401434 0.649608 0.412099 1.329747 0.099455 1.939824 0.267997 0.403580 1.515217 0.579512 0.002234 0.262847 1.800156 0.419089 1.615975 1.110793 1.305676 1.421012 1.714827)
)
;;; 39 even --------------------------------------------------------------------------------
-(vector 39 8.0062685830938 #(0 0 0 1 1 0 1 0 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0)
+(vector 39 8.0062685830938 #r(0 0 0 1 1 0 1 0 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0)
- 6.683157 #(0.000000 1.091390 0.284404 0.240879 1.660743 1.656550 0.223587 1.552502 0.232972 0.325977 1.767287 0.511127 0.573904 0.685387 0.354731 1.006014 0.648089 0.445081 1.696394 0.327980 -0.210151 0.338005 -0.052572 -0.119111 0.551717 1.087945 0.035621 1.385382 0.802270 1.342811 0.005749 0.410111 0.489512 1.361009 1.309724 1.490142 1.368577 0.636471 0.518214)
+ 6.683157 #r(0.000000 1.091390 0.284404 0.240879 1.660743 1.656550 0.223587 1.552502 0.232972 0.325977 1.767287 0.511127 0.573904 0.685387 0.354731 1.006014 0.648089 0.445081 1.696394 0.327980 -0.210151 0.338005 -0.052572 -0.119111 0.551717 1.087945 0.035621 1.385382 0.802270 1.342811 0.005749 0.410111 0.489512 1.361009 1.309724 1.490142 1.368577 0.636471 0.518214)
)
;;; 40 even --------------------------------------------------------------------------------
-(vector 40 8.0304555793911 #(0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 0 0 1)
+(vector 40 8.0304555793911 #r(0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 0 0 1)
- 6.748142 #(0.000000 0.029455 0.022065 0.136105 1.638522 1.203180 0.744941 -0.148784 0.506171 0.560051 -0.084723 -0.078289 0.149301 0.575133 1.046850 1.733499 1.932780 1.304846 -0.055855 1.484587 1.130478 0.869457 1.564935 1.665772 1.478237 0.851162 0.123617 0.568797 1.544770 0.060395 1.377474 0.739849 -0.238843 1.303906 1.521850 1.552033 0.224167 1.493979 0.103832 0.387098)
+ 6.748142 #r(0.000000 0.029455 0.022065 0.136105 1.638522 1.203180 0.744941 -0.148784 0.506171 0.560051 -0.084723 -0.078289 0.149301 0.575133 1.046850 1.733499 1.932780 1.304846 -0.055855 1.484587 1.130478 0.869457 1.564935 1.665772 1.478237 0.851162 0.123617 0.568797 1.544770 0.060395 1.377474 0.739849 -0.238843 1.303906 1.521850 1.552033 0.224167 1.493979 0.103832 0.387098)
)
;;; 41 even --------------------------------------------------------------------------------
-(vector 41 8.2169809341431 #(0 1 1 1 0 1 0 1 1 1 1 0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0)
+(vector 41 8.2169809341431 #r(0 1 1 1 0 1 0 1 1 1 1 0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0)
- 6.881035 #(0.000000 0.133290 0.436430 -0.019956 0.597994 -0.299445 0.298044 -0.291816 -0.125561 1.379945 1.227240 1.012471 0.995085 0.165521 0.059156 -0.315277 -0.410140 1.321719 -0.217071 0.006502 1.718169 0.636248 0.520158 0.977079 1.417462 -0.764436 1.377242 0.286309 1.475385 1.360726 0.551504 -0.329940 1.190956 0.377718 1.221012 1.703028 0.053941 0.664915 1.563928 1.320457 0.168607)
+ 6.881035 #r(0.000000 0.133290 0.436430 -0.019956 0.597994 -0.299445 0.298044 -0.291816 -0.125561 1.379945 1.227240 1.012471 0.995085 0.165521 0.059156 -0.315277 -0.410140 1.321719 -0.217071 0.006502 1.718169 0.636248 0.520158 0.977079 1.417462 -0.764436 1.377242 0.286309 1.475385 1.360726 0.551504 -0.329940 1.190956 0.377718 1.221012 1.703028 0.053941 0.664915 1.563928 1.320457 0.168607)
)
;;; 42 even --------------------------------------------------------------------------------
-(vector 42 8.3605623245239 #(0 1 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 0 1 1 0 1 0 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 0 1)
+(vector 42 8.3605623245239 #r(0 1 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 0 1 1 0 1 0 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 0 1)
- 6.941481 #(0.000000 -0.007293 1.286795 1.752349 -0.276621 1.210682 0.997503 0.480778 0.607692 1.419140 -0.000887 0.317063 0.225619 -1.792990 -0.085405 1.621718 1.141369 0.612500 1.711137 0.371822 0.494518 1.158070 0.720118 -0.061260 0.895705 0.558493 0.565336 0.673764 0.965927 1.131140 0.011389 1.067604 1.758075 0.687249 0.164819 0.032158 0.192333 0.816334 0.404498 1.292703 0.160108 0.486834)
+ 6.941481 #r(0.000000 -0.007293 1.286795 1.752349 -0.276621 1.210682 0.997503 0.480778 0.607692 1.419140 -0.000887 0.317063 0.225619 -1.792990 -0.085405 1.621718 1.141369 0.612500 1.711137 0.371822 0.494518 1.158070 0.720118 -0.061260 0.895705 0.558493 0.565336 0.673764 0.965927 1.131140 0.011389 1.067604 1.758075 0.687249 0.164819 0.032158 0.192333 0.816334 0.404498 1.292703 0.160108 0.486834)
)
;;; 43 even --------------------------------------------------------------------------------
-(vector 43 8.3471550144283 #(0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 0 1 0 0 0 0 1 0 0 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0)
+(vector 43 8.3471550144283 #r(0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 0 1 0 0 0 0 1 0 0 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0)
- 7.055197 #(0.000000 0.047763 1.657931 1.619393 1.901312 1.535197 1.519084 0.139389 -0.012074 1.734976 0.124057 1.726677 0.967925 0.859090 0.315172 0.782383 0.749080 1.794616 -0.192964 1.214822 1.594002 0.299675 1.830679 1.396713 1.089896 0.461626 0.318824 0.888695 1.307168 1.600142 0.874003 1.625797 0.872538 1.803252 0.868969 0.618677 0.932144 0.968270 1.700058 0.258149 0.614848 0.031586 0.805044)
+ 7.055197 #r(0.000000 0.047763 1.657931 1.619393 1.901312 1.535197 1.519084 0.139389 -0.012074 1.734976 0.124057 1.726677 0.967925 0.859090 0.315172 0.782383 0.749080 1.794616 -0.192964 1.214822 1.594002 0.299675 1.830679 1.396713 1.089896 0.461626 0.318824 0.888695 1.307168 1.600142 0.874003 1.625797 0.872538 1.803252 0.868969 0.618677 0.932144 0.968270 1.700058 0.258149 0.614848 0.031586 0.805044)
)
;;; 44 even --------------------------------------------------------------------------------
-(vector 44 8.4271850585938 #(0 0 1 0 0 1 1 0 1 0 1 0 0 0 1 0 1 0 1 1 0 0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 1 1)
+(vector 44 8.4271850585938 #r(0 0 1 0 0 1 1 0 1 0 1 0 0 0 1 0 1 0 1 1 0 0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 1 1)
- 7.048255 #(0.000000 -0.024272 1.042039 1.706381 0.915231 0.667566 0.791468 1.060500 0.486474 0.357952 1.448848 0.555099 0.559674 0.047957 0.101663 0.263196 0.561105 1.754886 1.445748 0.607834 0.094941 0.549126 0.219045 0.643754 0.108792 0.622710 0.657739 1.176141 0.892775 1.899443 0.047927 1.097541 1.395320 1.432930 0.524754 1.590031 -0.111160 0.804186 0.328664 0.621384 1.470620 1.417525 -0.298999 1.020701)
+ 7.048255 #r(0.000000 -0.024272 1.042039 1.706381 0.915231 0.667566 0.791468 1.060500 0.486474 0.357952 1.448848 0.555099 0.559674 0.047957 0.101663 0.263196 0.561105 1.754886 1.445748 0.607834 0.094941 0.549126 0.219045 0.643754 0.108792 0.622710 0.657739 1.176141 0.892775 1.899443 0.047927 1.097541 1.395320 1.432930 0.524754 1.590031 -0.111160 0.804186 0.328664 0.621384 1.470620 1.417525 -0.298999 1.020701)
)
;;; 45 even --------------------------------------------------------------------------------
-(vector 45 8.6353975051189 #(0 0 1 0 0 1 1 0 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 1 0 1 0 1)
+(vector 45 8.6353975051189 #r(0 0 1 0 0 1 1 0 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 1 0 1 0 1)
- 7.165216 #(0.000000 0.100769 0.427512 0.242955 0.443088 -0.380155 1.940929 -0.101098 -0.133968 -0.026473 1.678192 1.774836 0.508005 0.350465 0.553068 1.094302 0.286670 -1.617200 0.541014 0.212204 1.154970 1.344936 0.804485 1.614258 1.391670 0.188798 0.475817 0.610176 0.585642 -0.044233 1.516307 0.921356 1.091747 0.246161 0.592046 1.532410 0.320765 0.050475 1.141805 0.866052 0.300507 0.986581 -0.103223 1.338567 0.196051)
+ 7.165216 #r(0.000000 0.100769 0.427512 0.242955 0.443088 -0.380155 1.940929 -0.101098 -0.133968 -0.026473 1.678192 1.774836 0.508005 0.350465 0.553068 1.094302 0.286670 -1.617200 0.541014 0.212204 1.154970 1.344936 0.804485 1.614258 1.391670 0.188798 0.475817 0.610176 0.585642 -0.044233 1.516307 0.921356 1.091747 0.246161 0.592046 1.532410 0.320765 0.050475 1.141805 0.866052 0.300507 0.986581 -0.103223 1.338567 0.196051)
)
;;; 46 even --------------------------------------------------------------------------------
-(vector 46 8.7939519711145 #(0 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 0)
+(vector 46 8.7939519711145 #r(0 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 0)
- 7.276006 #(0.000000 -0.054506 1.032755 -0.130142 -0.261502 1.224902 0.252129 0.556107 0.758621 1.480820 -0.142360 1.184737 0.014000 1.776705 0.882036 1.883695 0.222183 0.298085 0.448405 1.172485 0.678362 1.341204 0.081280 -0.085381 0.763100 -0.029414 -0.367000 0.048240 1.040410 1.413704 0.227444 -0.058776 -0.204130 1.202166 1.632528 1.205475 1.219937 1.182203 -0.061521 1.269256 0.937830 0.491219 -0.180909 0.028085 1.489097 0.059386)
+ 7.276006 #r(0.000000 -0.054506 1.032755 -0.130142 -0.261502 1.224902 0.252129 0.556107 0.758621 1.480820 -0.142360 1.184737 0.014000 1.776705 0.882036 1.883695 0.222183 0.298085 0.448405 1.172485 0.678362 1.341204 0.081280 -0.085381 0.763100 -0.029414 -0.367000 0.048240 1.040410 1.413704 0.227444 -0.058776 -0.204130 1.202166 1.632528 1.205475 1.219937 1.182203 -0.061521 1.269256 0.937830 0.491219 -0.180909 0.028085 1.489097 0.059386)
)
;;; 47 even --------------------------------------------------------------------------------
-(vector 47 8.7835607528687 #(0 0 0 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 0 1 0 0 1 1 1 1 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 1 1 1 1 1 1)
+(vector 47 8.7835607528687 #r(0 0 0 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 0 1 0 0 1 1 1 1 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 1 1 1 1 1 1)
- 7.292551 #(0.000000 -0.062265 1.442422 1.057676 1.927078 0.605872 0.092606 0.058532 0.177290 1.141099 0.824596 0.143569 1.542821 0.439342 0.943358 1.070588 0.909454 0.332472 1.825929 1.744493 0.079522 0.781524 1.378798 1.290207 0.477850 0.651309 0.041772 0.753335 1.194909 0.871931 1.816269 1.466251 1.199198 1.733301 1.531356 -0.102896 0.905701 1.309802 1.098908 1.238880 1.394185 0.875551 1.145434 -0.145313 0.593458 0.073230 0.938656)
+ 7.292551 #r(0.000000 -0.062265 1.442422 1.057676 1.927078 0.605872 0.092606 0.058532 0.177290 1.141099 0.824596 0.143569 1.542821 0.439342 0.943358 1.070588 0.909454 0.332472 1.825929 1.744493 0.079522 0.781524 1.378798 1.290207 0.477850 0.651309 0.041772 0.753335 1.194909 0.871931 1.816269 1.466251 1.199198 1.733301 1.531356 -0.102896 0.905701 1.309802 1.098908 1.238880 1.394185 0.875551 1.145434 -0.145313 0.593458 0.073230 0.938656)
)
;;; 48 even --------------------------------------------------------------------------------
-(vector 48 8.9965600967407 #(0 1 1 0 1 0 0 0 0 0 0 0 0 1 1 1 0 1 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1)
+(vector 48 8.9965600967407 #r(0 1 1 0 1 0 0 0 0 0 0 0 0 1 1 1 0 1 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1)
;; ce:
- 7.406994 #(0.000000 0.047945 0.826536 0.973372 1.740017 0.529769 1.008330 1.827057 0.727986 1.449120 0.514522 1.295511 0.015768 1.206235 0.269772 1.336523 0.110706 1.398598 0.887898 1.776715 1.044804 0.419039 -0.057090 1.238424 0.514960 0.147966 1.655287 1.338551 0.870612 0.661410 0.361317 0.267510 -0.382725 -0.031215 1.567563 1.583622 1.671939 1.775367 1.875910 1.638385 1.546190 0.129055 0.397477 0.763475 0.970476 1.468225 1.622446 0.158949)
+ 7.406994 #r(0.000000 0.047945 0.826536 0.973372 1.740017 0.529769 1.008330 1.827057 0.727986 1.449120 0.514522 1.295511 0.015768 1.206235 0.269772 1.336523 0.110706 1.398598 0.887898 1.776715 1.044804 0.419039 -0.057090 1.238424 0.514960 0.147966 1.655287 1.338551 0.870612 0.661410 0.361317 0.267510 -0.382725 -0.031215 1.567563 1.583622 1.671939 1.775367 1.875910 1.638385 1.546190 0.129055 0.397477 0.763475 0.970476 1.468225 1.622446 0.158949)
)
;;; 49 even --------------------------------------------------------------------------------
-(vector 49 9.1650037765503 #(0 1 0 1 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 0 0 0 1 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0)
+(vector 49 9.1650037765503 #r(0 1 0 1 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 0 0 0 1 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0)
;; ce:
- 7.532053 #(0.000000 0.041305 0.532327 1.215473 1.024214 1.052795 0.585923 1.613470 1.301563 0.656356 1.815283 1.368492 -0.020005 0.356482 1.940348 0.124177 0.127083 1.593092 1.501593 0.678778 0.554128 0.952456 -0.422395 1.575963 0.870840 0.819687 0.743668 0.245617 0.895216 0.369895 0.471783 1.223006 0.679195 1.170671 0.931311 1.629049 0.745807 0.483912 0.397101 0.224181 0.816909 1.126241 1.477811 0.320980 1.574780 0.412692 0.741112 1.583749 0.654625)
+ 7.532053 #r(0.000000 0.041305 0.532327 1.215473 1.024214 1.052795 0.585923 1.613470 1.301563 0.656356 1.815283 1.368492 -0.020005 0.356482 1.940348 0.124177 0.127083 1.593092 1.501593 0.678778 0.554128 0.952456 -0.422395 1.575963 0.870840 0.819687 0.743668 0.245617 0.895216 0.369895 0.471783 1.223006 0.679195 1.170671 0.931311 1.629049 0.745807 0.483912 0.397101 0.224181 0.816909 1.126241 1.477811 0.320980 1.574780 0.412692 0.741112 1.583749 0.654625)
)
;;; 50 even --------------------------------------------------------------------------------
-(vector 50 9.1582123370176 #(0 1 0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 0 0 0 1)
+(vector 50 9.1582123370176 #r(0 1 0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 0 0 0 1)
;; ce:
- 7.553949 #(0.000000 0.001153 1.444901 -0.126735 -0.207597 1.037485 0.982912 0.657278 1.609015 0.548946 0.388265 1.860455 1.146064 0.991559 1.714083 0.419464 0.114879 0.538313 1.517340 1.406138 0.768916 1.006070 1.575014 1.565071 1.458974 0.980173 1.203265 1.481696 -0.150280 1.613515 0.690225 0.227360 0.618441 0.290246 1.012000 0.302852 -0.136236 -0.046604 1.075996 0.025371 0.550031 1.195469 0.193455 0.810822 0.527380 1.640757 0.113795 0.191137 1.871211 0.281051)
+ 7.553949 #r(0.000000 0.001153 1.444901 -0.126735 -0.207597 1.037485 0.982912 0.657278 1.609015 0.548946 0.388265 1.860455 1.146064 0.991559 1.714083 0.419464 0.114879 0.538313 1.517340 1.406138 0.768916 1.006070 1.575014 1.565071 1.458974 0.980173 1.203265 1.481696 -0.150280 1.613515 0.690225 0.227360 0.618441 0.290246 1.012000 0.302852 -0.136236 -0.046604 1.075996 0.025371 0.550031 1.195469 0.193455 0.810822 0.527380 1.640757 0.113795 0.191137 1.871211 0.281051)
)
;;; 51 even --------------------------------------------------------------------------------
-(vector 51 9.3615226745605 #(0 0 0 1 1 1 1 0 1 0 1 1 0 1 0 0 0 1 1 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 1 0)
+(vector 51 9.3615226745605 #r(0 0 0 1 1 1 1 0 1 0 1 1 0 1 0 0 0 1 1 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 1 0)
;; nce:
- 7.601889 #(0.000000 -0.097299 1.522524 0.604656 1.190459 -0.046061 1.637924 0.391838 1.914014 1.191379 0.937217 0.903859 1.190560 -0.310642 0.795112 0.607488 1.496318 -0.432640 -0.101925 0.993972 1.031274 1.167246 0.466609 0.643027 0.235799 0.569210 0.641350 0.632197 0.268712 1.299950 1.493958 0.876871 -0.115765 0.447597 1.299543 -0.601543 0.991250 1.221680 0.433618 1.269835 0.891674 -0.222937 1.508906 1.194487 1.696510 0.136336 0.547118 0.154250 -0.399784 0.814800 1.474647)
+ 7.601889 #r(0.000000 -0.097299 1.522524 0.604656 1.190459 -0.046061 1.637924 0.391838 1.914014 1.191379 0.937217 0.903859 1.190560 -0.310642 0.795112 0.607488 1.496318 -0.432640 -0.101925 0.993972 1.031274 1.167246 0.466609 0.643027 0.235799 0.569210 0.641350 0.632197 0.268712 1.299950 1.493958 0.876871 -0.115765 0.447597 1.299543 -0.601543 0.991250 1.221680 0.433618 1.269835 0.891674 -0.222937 1.508906 1.194487 1.696510 0.136336 0.547118 0.154250 -0.399784 0.814800 1.474647)
)
;;; 52 even --------------------------------------------------------------------------------
-(vector 52 9.449512348335 #(0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 0 0 1 1 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 0 1 1 1 1 0 1 1)
+(vector 52 9.449512348335 #r(0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 0 0 1 1 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 0 1 1 1 1 0 1 1)
;; ce:
- 7.715514 #(0.000000 -0.034843 1.299671 1.297722 1.635310 -0.140716 1.100950 -0.118100 0.547763 0.498559 0.115301 1.387617 0.497862 0.517177 1.775867 1.036003 1.303001 0.627699 1.126538 0.667873 0.716185 0.672233 0.573373 1.713393 1.674703 1.675881 -0.219625 0.205462 0.688511 -0.167042 0.095308 -0.056923 0.925655 1.318413 1.379568 1.567357 0.318805 -0.064577 1.458169 1.228224 0.320505 1.504325 0.170852 1.908593 0.774335 0.156462 0.959528 -0.009590 -0.029886 1.318052 1.521653 0.208620)
+ 7.715514 #r(0.000000 -0.034843 1.299671 1.297722 1.635310 -0.140716 1.100950 -0.118100 0.547763 0.498559 0.115301 1.387617 0.497862 0.517177 1.775867 1.036003 1.303001 0.627699 1.126538 0.667873 0.716185 0.672233 0.573373 1.713393 1.674703 1.675881 -0.219625 0.205462 0.688511 -0.167042 0.095308 -0.056923 0.925655 1.318413 1.379568 1.567357 0.318805 -0.064577 1.458169 1.228224 0.320505 1.504325 0.170852 1.908593 0.774335 0.156462 0.959528 -0.009590 -0.029886 1.318052 1.521653 0.208620)
)
;;; 53 even --------------------------------------------------------------------------------
-(vector 53 9.6159172058105 #(0 1 0 1 1 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 0 1 1 1 1 0 1 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 0 0 1 0)
+(vector 53 9.6159172058105 #r(0 1 0 1 1 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 0 1 1 1 1 0 1 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 0 0 1 0)
- 7.750487 #(0.000000 0.036779 0.620619 1.389030 1.448590 0.206060 1.401187 0.716369 0.552235 0.039103 0.347305 1.846613 0.552018 1.491421 1.339207 1.372862 1.129023 1.023345 1.671571 0.563034 0.162746 0.439370 1.163228 -0.070535 0.315773 0.561792 1.174490 1.839925 1.161557 1.788132 0.000155 0.215127 1.156326 0.635275 1.204301 0.236777 -0.137602 1.267159 0.914139 0.933059 0.732878 0.757869 1.209147 1.287260 1.087065 1.355017 0.578394 1.465757 0.725442 0.562270 1.513798 1.240390 0.721272)
+ 7.750487 #r(0.000000 0.036779 0.620619 1.389030 1.448590 0.206060 1.401187 0.716369 0.552235 0.039103 0.347305 1.846613 0.552018 1.491421 1.339207 1.372862 1.129023 1.023345 1.671571 0.563034 0.162746 0.439370 1.163228 -0.070535 0.315773 0.561792 1.174490 1.839925 1.161557 1.788132 0.000155 0.215127 1.156326 0.635275 1.204301 0.236777 -0.137602 1.267159 0.914139 0.933059 0.732878 0.757869 1.209147 1.287260 1.087065 1.355017 0.578394 1.465757 0.725442 0.562270 1.513798 1.240390 0.721272)
)
;;; 54 even --------------------------------------------------------------------------------
-(vector 54 9.5190944671631 #(0 1 0 1 1 1 1 1 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 0 1 1 0 1 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 1 1)
+(vector 54 9.5190944671631 #r(0 1 0 1 1 1 1 1 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 0 1 1 0 1 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 1 1)
- 7.845083 #(0.000000 0.061451 0.633202 0.842273 1.609750 1.150617 1.710229 0.507090 -0.042557 0.310551 0.314728 0.987790 1.351858 1.063896 1.713078 1.603814 0.132592 0.924440 -0.380633 0.855851 1.637781 0.813597 1.013698 0.861640 0.327742 0.192164 0.896540 1.734094 0.874167 -0.001625 0.106463 0.214754 1.657275 0.272925 1.907315 1.437104 1.086576 0.701261 0.411048 1.402011 1.872416 0.559924 1.401281 1.776842 1.632661 1.672063 -0.088862 1.645896 0.861803 0.137030 1.828399 0.307366 0.083970 1.711361)
+ 7.845083 #r(0.000000 0.061451 0.633202 0.842273 1.609750 1.150617 1.710229 0.507090 -0.042557 0.310551 0.314728 0.987790 1.351858 1.063896 1.713078 1.603814 0.132592 0.924440 -0.380633 0.855851 1.637781 0.813597 1.013698 0.861640 0.327742 0.192164 0.896540 1.734094 0.874167 -0.001625 0.106463 0.214754 1.657275 0.272925 1.907315 1.437104 1.086576 0.701261 0.411048 1.402011 1.872416 0.559924 1.401281 1.776842 1.632661 1.672063 -0.088862 1.645896 0.861803 0.137030 1.828399 0.307366 0.083970 1.711361)
)
;;; 55 even --------------------------------------------------------------------------------
-(vector 55 9.6719217300415 #(0 1 0 0 1 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1)
+(vector 55 9.6719217300415 #r(0 1 0 0 1 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1)
;; ce:
- 7.908224 #(0.000000 -0.006122 1.706850 -0.138031 1.409264 -0.179924 1.291393 0.095673 0.477101 1.213765 -0.191085 0.117017 0.016865 0.128090 1.052814 -0.223928 0.648751 1.402762 0.456990 0.553356 1.095940 1.027495 0.299767 0.447120 0.205834 1.452671 -0.085699 1.609363 1.101039 1.058600 -0.087300 1.595987 1.179897 0.004643 1.423903 0.778740 0.553053 1.139184 0.724189 1.453952 0.381783 0.586983 0.831862 1.181073 0.788144 1.024391 1.771531 1.598505 0.863121 0.198894 0.450345 0.085968 1.228457 0.544951 0.771388)
+ 7.908224 #r(0.000000 -0.006122 1.706850 -0.138031 1.409264 -0.179924 1.291393 0.095673 0.477101 1.213765 -0.191085 0.117017 0.016865 0.128090 1.052814 -0.223928 0.648751 1.402762 0.456990 0.553356 1.095940 1.027495 0.299767 0.447120 0.205834 1.452671 -0.085699 1.609363 1.101039 1.058600 -0.087300 1.595987 1.179897 0.004643 1.423903 0.778740 0.553053 1.139184 0.724189 1.453952 0.381783 0.586983 0.831862 1.181073 0.788144 1.024391 1.771531 1.598505 0.863121 0.198894 0.450345 0.085968 1.228457 0.544951 0.771388)
)
;;; 56 even --------------------------------------------------------------------------------
-(vector 56 9.6809562784664 #(0 0 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 0 1 0 1)
+(vector 56 9.6809562784664 #r(0 0 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 0 1 0 1)
;; ce:
- 8.011195 #(0.000000 0.008210 0.905992 0.396571 1.720897 1.158304 1.138541 -0.149073 1.014952 1.018591 1.745765 0.438732 0.854592 1.654860 1.011019 1.080405 0.999544 1.358343 1.494524 -0.322084 1.515909 1.690243 0.974840 0.937768 1.405811 0.436415 0.424543 1.360935 -0.014499 1.482939 0.090605 0.959441 1.032814 1.287153 0.868562 1.424617 0.689023 1.690605 0.303801 0.396076 -0.120753 1.039594 0.342297 0.231504 -0.042441 1.626406 0.755064 0.442808 1.366653 1.769637 -0.205340 -0.239797 0.934356 1.176593 0.655901 1.488666)
+ 8.011195 #r(0.000000 0.008210 0.905992 0.396571 1.720897 1.158304 1.138541 -0.149073 1.014952 1.018591 1.745765 0.438732 0.854592 1.654860 1.011019 1.080405 0.999544 1.358343 1.494524 -0.322084 1.515909 1.690243 0.974840 0.937768 1.405811 0.436415 0.424543 1.360935 -0.014499 1.482939 0.090605 0.959441 1.032814 1.287153 0.868562 1.424617 0.689023 1.690605 0.303801 0.396076 -0.120753 1.039594 0.342297 0.231504 -0.042441 1.626406 0.755064 0.442808 1.366653 1.769637 -0.205340 -0.239797 0.934356 1.176593 0.655901 1.488666)
)
;;; 57 even --------------------------------------------------------------------------------
-(vector 57 9.8992366790771 #(0 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 0 1 0 1 0 0 1 1 0 0 1)
+(vector 57 9.8992366790771 #r(0 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 0 1 0 1 0 0 1 1 0 0 1)
;; ce:
- 7.998443 #(0.000000 -0.014666 1.566831 1.522473 -0.249684 1.548885 0.061859 1.226467 1.343794 0.283370 1.644204 -0.263860 0.040445 -0.006696 1.612019 1.549636 0.536480 0.507272 1.129223 0.096416 0.070654 1.146329 0.116347 1.310955 1.044576 1.855920 1.741244 0.737054 0.646099 0.980172 1.413425 1.269711 1.581860 1.800144 1.281998 -0.058342 0.653062 1.547228 1.144145 0.578917 0.690679 0.861263 0.345954 0.676296 0.259007 0.725329 -0.285685 1.547409 0.602010 1.240793 0.038406 1.789143 1.881017 1.026132 0.600098 1.097228 -1.919911)
+ 7.998443 #r(0.000000 -0.014666 1.566831 1.522473 -0.249684 1.548885 0.061859 1.226467 1.343794 0.283370 1.644204 -0.263860 0.040445 -0.006696 1.612019 1.549636 0.536480 0.507272 1.129223 0.096416 0.070654 1.146329 0.116347 1.310955 1.044576 1.855920 1.741244 0.737054 0.646099 0.980172 1.413425 1.269711 1.581860 1.800144 1.281998 -0.058342 0.653062 1.547228 1.144145 0.578917 0.690679 0.861263 0.345954 0.676296 0.259007 0.725329 -0.285685 1.547409 0.602010 1.240793 0.038406 1.789143 1.881017 1.026132 0.600098 1.097228 -1.919911)
)
;;; 58 even --------------------------------------------------------------------------------
-(vector 58 9.8761510848999 #(0 1 1 1 1 1 0 0 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 1 0 0 0 1)
+(vector 58 9.8761510848999 #r(0 1 1 1 1 1 0 0 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 1 0 0 0 1)
- 8.102746 #(0.000000 0.021804 0.347449 0.712574 0.904596 1.645925 0.230015 0.473992 0.104969 1.934740 1.209012 1.104800 1.062683 0.358409 0.785934 1.465266 1.235573 1.772411 0.072477 1.559281 1.754795 0.147077 0.219637 0.050078 1.441852 0.333339 0.672730 1.789640 1.230725 1.303568 1.622831 1.659814 0.995447 1.205094 1.295826 0.837873 0.521849 1.476121 0.531055 1.439237 1.534776 0.923559 1.866584 1.504388 0.402718 1.262304 0.589470 1.403389 1.379169 0.218840 1.535374 0.130494 0.618342 0.285582 1.711521 1.399310 1.463120 1.577451)
+ 8.102746 #r(0.000000 0.021804 0.347449 0.712574 0.904596 1.645925 0.230015 0.473992 0.104969 1.934740 1.209012 1.104800 1.062683 0.358409 0.785934 1.465266 1.235573 1.772411 0.072477 1.559281 1.754795 0.147077 0.219637 0.050078 1.441852 0.333339 0.672730 1.789640 1.230725 1.303568 1.622831 1.659814 0.995447 1.205094 1.295826 0.837873 0.521849 1.476121 0.531055 1.439237 1.534776 0.923559 1.866584 1.504388 0.402718 1.262304 0.589470 1.403389 1.379169 0.218840 1.535374 0.130494 0.618342 0.285582 1.711521 1.399310 1.463120 1.577451)
;; nce:
- 8.160514 #(0.000000 0.018101 0.649039 1.105139 0.805799 1.552840 0.507143 0.455093 0.410985 1.820561 0.914505 0.984750 1.066413 0.191884 0.653627 1.510871 1.561405 1.875189 -0.078120 1.639973 1.489309 -0.122302 0.187579 -0.137707 1.247718 0.796984 0.621022 1.565078 1.132796 1.098952 1.427880 1.663078 0.762131 0.965307 1.352999 0.722067 0.412348 1.684775 0.457834 1.443318 1.385930 0.962906 1.869715 1.351690 0.195092 1.084773 0.690763 1.132481 1.402235 0.306205 1.443881 0.266933 0.858427 0.045513 1.705481 1.280871 1.423605 1.246177)
+ 8.160514 #r(0.000000 0.018101 0.649039 1.105139 0.805799 1.552840 0.507143 0.455093 0.410985 1.820561 0.914505 0.984750 1.066413 0.191884 0.653627 1.510871 1.561405 1.875189 -0.078120 1.639973 1.489309 -0.122302 0.187579 -0.137707 1.247718 0.796984 0.621022 1.565078 1.132796 1.098952 1.427880 1.663078 0.762131 0.965307 1.352999 0.722067 0.412348 1.684775 0.457834 1.443318 1.385930 0.962906 1.869715 1.351690 0.195092 1.084773 0.690763 1.132481 1.402235 0.306205 1.443881 0.266933 0.858427 0.045513 1.705481 1.280871 1.423605 1.246177)
)
;;; 59 even --------------------------------------------------------------------------------
-(vector 59 10.094394683838 #(0 1 1 0 1 0 1 0 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 1 0 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 1 1 1 1)
+(vector 59 10.094394683838 #r(0 1 1 0 1 0 1 0 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 1 0 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 1 1 1 1)
- 8.194538 #(0.000000 0.192440 1.064997 1.405447 0.666893 0.441718 0.460123 -0.029893 0.102290 1.233991 1.287456 0.262828 0.891341 1.622477 -0.078945 0.794492 1.676056 0.757298 1.625170 1.288224 1.021602 1.270621 0.622162 1.173256 0.639594 0.085293 0.804874 1.211161 -0.067577 0.210901 0.178378 0.446246 -0.092053 1.813463 1.120832 1.269392 -0.271084 1.861664 0.195222 0.087459 0.045547 0.257753 0.386709 0.151559 1.002452 0.352762 0.090741 1.494023 0.840240 1.424148 0.778422 -0.109268 1.896909 0.853535 0.284500 1.503148 1.606229 1.606587 0.287318)
+ 8.194538 #r(0.000000 0.192440 1.064997 1.405447 0.666893 0.441718 0.460123 -0.029893 0.102290 1.233991 1.287456 0.262828 0.891341 1.622477 -0.078945 0.794492 1.676056 0.757298 1.625170 1.288224 1.021602 1.270621 0.622162 1.173256 0.639594 0.085293 0.804874 1.211161 -0.067577 0.210901 0.178378 0.446246 -0.092053 1.813463 1.120832 1.269392 -0.271084 1.861664 0.195222 0.087459 0.045547 0.257753 0.386709 0.151559 1.002452 0.352762 0.090741 1.494023 0.840240 1.424148 0.778422 -0.109268 1.896909 0.853535 0.284500 1.503148 1.606229 1.606587 0.287318)
)
;;; 60 even --------------------------------------------------------------------------------
-(vector 60 10.333255371943 #(0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 0 1 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 1 0 0)
+(vector 60 10.333255371943 #r(0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 0 1 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 1 0 0)
- 8.312421 #(0.000000 0.016764 0.099999 0.395290 1.344482 1.502674 0.248570 0.971438 0.736859 1.561216 0.263938 1.242184 -0.428796 -0.122031 1.528486 0.190921 1.269506 0.099840 0.618839 0.286668 0.310580 0.121766 0.645000 0.953645 1.140529 0.456214 0.631806 0.922426 0.396932 1.354468 1.176819 0.515695 0.171198 0.662750 1.320434 0.506395 1.565445 0.874857 0.531897 0.782628 0.471079 -1.819575 1.656923 0.206815 0.413621 0.205859 1.749126 1.236787 1.333671 0.085487 1.468799 1.666444 0.266215 0.649751 0.639546 0.431656 1.171882 1.863798 1.376382 0.482890)
+ 8.312421 #r(0.000000 0.016764 0.099999 0.395290 1.344482 1.502674 0.248570 0.971438 0.736859 1.561216 0.263938 1.242184 -0.428796 -0.122031 1.528486 0.190921 1.269506 0.099840 0.618839 0.286668 0.310580 0.121766 0.645000 0.953645 1.140529 0.456214 0.631806 0.922426 0.396932 1.354468 1.176819 0.515695 0.171198 0.662750 1.320434 0.506395 1.565445 0.874857 0.531897 0.782628 0.471079 -1.819575 1.656923 0.206815 0.413621 0.205859 1.749126 1.236787 1.333671 0.085487 1.468799 1.666444 0.266215 0.649751 0.639546 0.431656 1.171882 1.863798 1.376382 0.482890)
;; ce:
- 8.297419 #(0.000000 -0.050827 -0.093113 0.415337 1.376502 1.483467 0.139153 0.992518 0.529850 1.653904 0.191931 1.095275 -0.256090 -0.161285 1.405742 0.150354 1.336151 -0.049296 0.676639 0.179468 0.223738 -0.026447 0.633754 1.009834 1.247179 0.478290 0.662079 0.748655 0.357085 1.374703 1.160927 0.429236 0.231499 0.680606 1.275377 0.482417 1.486029 0.955636 0.656194 0.784771 0.415616 -1.691681 1.767041 0.147548 0.371057 0.291191 1.824186 1.135403 1.361375 0.394251 1.554796 1.735953 0.147583 0.633615 0.589877 0.598198 0.971637 1.904531 1.249959 0.504018)
+ 8.297419 #r(0.000000 -0.050827 -0.093113 0.415337 1.376502 1.483467 0.139153 0.992518 0.529850 1.653904 0.191931 1.095275 -0.256090 -0.161285 1.405742 0.150354 1.336151 -0.049296 0.676639 0.179468 0.223738 -0.026447 0.633754 1.009834 1.247179 0.478290 0.662079 0.748655 0.357085 1.374703 1.160927 0.429236 0.231499 0.680606 1.275377 0.482417 1.486029 0.955636 0.656194 0.784771 0.415616 -1.691681 1.767041 0.147548 0.371057 0.291191 1.824186 1.135403 1.361375 0.394251 1.554796 1.735953 0.147583 0.633615 0.589877 0.598198 0.971637 1.904531 1.249959 0.504018)
)
;;; 61 even --------------------------------------------------------------------------------
-(vector 61 10.120587847566 #(0 0 0 0 0 1 0 0 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1)
+(vector 61 10.120587847566 #r(0 0 0 0 0 1 0 0 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1)
;; ce:
- 8.246633 #(0.000000 0.014137 0.312612 0.249295 0.935740 0.710600 -0.670222 0.029791 0.000981 1.147441 0.399682 0.888394 1.440126 0.108877 -0.294608 1.403751 1.053458 0.779516 0.066815 1.543587 0.107940 1.359190 1.494404 1.618478 0.815280 -0.244135 0.981345 0.739684 0.088784 1.710138 1.218977 0.672306 0.896304 0.148600 0.266242 0.612315 0.136648 0.136688 0.184375 -0.198309 0.518044 0.411032 1.286324 0.855547 0.828794 0.991646 1.167294 -0.167119 0.070397 0.487614 -0.198225 0.121902 0.696143 0.291992 0.984667 1.799531 0.623251 0.161592 0.779281 0.099176 0.369046)
+ 8.246633 #r(0.000000 0.014137 0.312612 0.249295 0.935740 0.710600 -0.670222 0.029791 0.000981 1.147441 0.399682 0.888394 1.440126 0.108877 -0.294608 1.403751 1.053458 0.779516 0.066815 1.543587 0.107940 1.359190 1.494404 1.618478 0.815280 -0.244135 0.981345 0.739684 0.088784 1.710138 1.218977 0.672306 0.896304 0.148600 0.266242 0.612315 0.136648 0.136688 0.184375 -0.198309 0.518044 0.411032 1.286324 0.855547 0.828794 0.991646 1.167294 -0.167119 0.070397 0.487614 -0.198225 0.121902 0.696143 0.291992 0.984667 1.799531 0.623251 0.161592 0.779281 0.099176 0.369046)
)
;;; 62 even --------------------------------------------------------------------------------
-(vector 62 10.318392753601 #(0 0 0 0 1 1 1 1 1 1 1 1 1 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 1 1 0 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 0 1 1 0 0 1 1)
+(vector 62 10.318392753601 #r(0 0 0 0 1 1 1 1 1 1 1 1 1 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 1 1 0 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 0 1 1 0 0 1 1)
- 8.390962 #(0.000000 0.864131 -0.039302 0.501838 0.179590 0.198870 0.408743 -0.099436 -0.035241 1.399095 1.555420 1.066003 1.126029 -0.412606 0.371657 1.690168 1.511157 0.827619 0.057876 1.184261 0.354886 0.869166 0.825315 1.069197 0.055544 0.926747 0.994446 -0.406535 1.243161 1.409918 0.623323 1.296612 0.600545 1.814707 1.913723 0.665613 1.150575 0.642943 -0.000728 0.108004 1.148509 1.338004 0.731747 0.682804 1.190657 0.379742 0.514953 0.586813 0.784946 1.269079 1.453729 1.496418 0.332671 -0.412333 0.644169 0.803815 1.053593 1.563066 0.967726 0.733563 -0.027726 1.710240)
+ 8.390962 #r(0.000000 0.864131 -0.039302 0.501838 0.179590 0.198870 0.408743 -0.099436 -0.035241 1.399095 1.555420 1.066003 1.126029 -0.412606 0.371657 1.690168 1.511157 0.827619 0.057876 1.184261 0.354886 0.869166 0.825315 1.069197 0.055544 0.926747 0.994446 -0.406535 1.243161 1.409918 0.623323 1.296612 0.600545 1.814707 1.913723 0.665613 1.150575 0.642943 -0.000728 0.108004 1.148509 1.338004 0.731747 0.682804 1.190657 0.379742 0.514953 0.586813 0.784946 1.269079 1.453729 1.496418 0.332671 -0.412333 0.644169 0.803815 1.053593 1.563066 0.967726 0.733563 -0.027726 1.710240)
)
;;; 63 even --------------------------------------------------------------------------------
-(vector 63 10.45694065094 #(0 0 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 0 0 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 1 1 0)
+(vector 63 10.45694065094 #r(0 0 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 0 0 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 1 1 0)
- 8.413888 #(0.000000 0.010634 0.820887 1.791906 0.180821 1.699733 1.457775 1.781040 1.049055 0.063682 0.656198 -0.016519 1.426220 1.490473 0.018505 1.749295 0.166920 0.934178 0.018879 0.949939 1.163838 0.694420 0.665805 0.087679 1.619302 0.169784 1.099805 0.390614 0.230991 0.703447 0.620497 0.345622 1.520041 1.514348 1.626503 0.238228 1.445149 1.071455 0.772257 1.186699 1.488207 -0.090097 0.947955 1.288711 1.143854 0.328539 1.581009 1.516219 1.752145 1.825272 0.656629 1.607807 1.482688 0.741468 0.684282 0.938749 1.078766 0.076298 1.127102 0.768415 0.654765 1.253057 1.466721)
+ 8.413888 #r(0.000000 0.010634 0.820887 1.791906 0.180821 1.699733 1.457775 1.781040 1.049055 0.063682 0.656198 -0.016519 1.426220 1.490473 0.018505 1.749295 0.166920 0.934178 0.018879 0.949939 1.163838 0.694420 0.665805 0.087679 1.619302 0.169784 1.099805 0.390614 0.230991 0.703447 0.620497 0.345622 1.520041 1.514348 1.626503 0.238228 1.445149 1.071455 0.772257 1.186699 1.488207 -0.090097 0.947955 1.288711 1.143854 0.328539 1.581009 1.516219 1.752145 1.825272 0.656629 1.607807 1.482688 0.741468 0.684282 0.938749 1.078766 0.076298 1.127102 0.768415 0.654765 1.253057 1.466721)
)
;;; 64 even --------------------------------------------------------------------------------
-(vector 64 10.487 #(0 0 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 1 1 0 1 1 0 0 0 1 0 1 0 0 0 0 0 0 0 1 1 1 1)
+(vector 64 10.487 #r(0 0 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 1 1 0 1 1 0 0 0 1 0 1 0 0 0 0 0 0 0 1 1 1 1)
- 8.500897 #(0.000000 -0.110230 0.253682 0.149208 0.517156 1.680690 0.261962 -0.311932 1.499119 0.134139 0.193946 1.528316 0.126448 1.680960 0.957330 -0.015272 0.163098 1.233151 0.955877 1.516677 1.271750 0.225924 1.801609 0.924065 0.996478 1.135973 0.892170 1.311436 1.257336 0.314351 0.968388 0.136861 1.841069 1.348391 1.398845 -0.195293 1.345125 1.529238 1.112945 1.363188 0.328366 0.804723 1.816185 1.478898 0.163962 1.500837 0.226838 0.805475 0.515967 0.095385 1.528024 1.274946 0.915048 0.129649 1.022985 1.362093 -0.189345 -0.123957 -0.176055 0.992212 1.710004 0.183155 0.509794 0.492211)
+ 8.500897 #r(0.000000 -0.110230 0.253682 0.149208 0.517156 1.680690 0.261962 -0.311932 1.499119 0.134139 0.193946 1.528316 0.126448 1.680960 0.957330 -0.015272 0.163098 1.233151 0.955877 1.516677 1.271750 0.225924 1.801609 0.924065 0.996478 1.135973 0.892170 1.311436 1.257336 0.314351 0.968388 0.136861 1.841069 1.348391 1.398845 -0.195293 1.345125 1.529238 1.112945 1.363188 0.328366 0.804723 1.816185 1.478898 0.163962 1.500837 0.226838 0.805475 0.515967 0.095385 1.528024 1.274946 0.915048 0.129649 1.022985 1.362093 -0.189345 -0.123957 -0.176055 0.992212 1.710004 0.183155 0.509794 0.492211)
)
;;; 65 even --------------------------------------------------------------------------------
-(vector 65 10.593795776367 #(0 1 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 0 1 1 1 0 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0)
+(vector 65 10.593795776367 #r(0 1 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 0 1 1 1 0 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0)
;; ce:
- 8.609777 #(0.000000 0.010286 0.073308 0.156025 1.953119 0.326605 1.156187 1.359503 0.615092 0.625095 1.209776 1.377583 -0.310622 1.815585 1.618945 0.328652 -0.127781 1.904210 1.297763 1.916187 0.801813 0.929154 1.581967 0.478151 0.556340 1.031862 1.480609 -1.661291 1.218834 0.549647 1.223081 1.263443 0.189207 -0.057436 1.688891 1.890453 1.705454 1.164550 1.023002 0.394890 -0.072758 -0.362543 1.102983 0.220165 0.570828 0.506586 1.236790 0.668284 1.330270 0.072079 0.187084 1.026028 0.423887 1.229321 0.594086 1.447463 0.979393 0.850808 0.463831 1.022159 0.562154 0.740405 1.709952 0.862548 0.909149)
+ 8.609777 #r(0.000000 0.010286 0.073308 0.156025 1.953119 0.326605 1.156187 1.359503 0.615092 0.625095 1.209776 1.377583 -0.310622 1.815585 1.618945 0.328652 -0.127781 1.904210 1.297763 1.916187 0.801813 0.929154 1.581967 0.478151 0.556340 1.031862 1.480609 -1.661291 1.218834 0.549647 1.223081 1.263443 0.189207 -0.057436 1.688891 1.890453 1.705454 1.164550 1.023002 0.394890 -0.072758 -0.362543 1.102983 0.220165 0.570828 0.506586 1.236790 0.668284 1.330270 0.072079 0.187084 1.026028 0.423887 1.229321 0.594086 1.447463 0.979393 0.850808 0.463831 1.022159 0.562154 0.740405 1.709952 0.862548 0.909149)
)
;;; 66 even --------------------------------------------------------------------------------
-(vector 66 10.77367179842 #(0 0 1 1 1 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 1 1 0 0 1 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 0)
+(vector 66 10.77367179842 #r(0 0 1 1 1 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 1 1 0 0 1 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 0)
;; ce:
- 8.678699 #(0.000000 0.454997 1.496948 0.519770 1.672039 0.567223 1.755017 0.736664 1.985212 1.381007 0.655920 0.131168 1.193358 0.617219 1.831999 1.143743 0.488405 0.001490 1.636224 1.056726 0.387222 0.101202 1.826852 1.187505 0.710721 0.377670 0.096617 1.812536 1.688958 1.476343 1.264972 1.142558 1.049579 0.690750 1.195534 0.929938 1.522099 1.266451 1.390797 1.538518 1.605610 1.574083 1.889598 0.006801 0.695550 0.832932 1.160944 1.293180 1.683176 0.244325 0.530816 1.180483 1.812767 0.268820 0.993683 1.695534 1.919653 0.449948 1.560150 0.338318 1.266700 1.853107 0.910590 1.381060 0.420174 1.311948)
+ 8.678699 #r(0.000000 0.454997 1.496948 0.519770 1.672039 0.567223 1.755017 0.736664 1.985212 1.381007 0.655920 0.131168 1.193358 0.617219 1.831999 1.143743 0.488405 0.001490 1.636224 1.056726 0.387222 0.101202 1.826852 1.187505 0.710721 0.377670 0.096617 1.812536 1.688958 1.476343 1.264972 1.142558 1.049579 0.690750 1.195534 0.929938 1.522099 1.266451 1.390797 1.538518 1.605610 1.574083 1.889598 0.006801 0.695550 0.832932 1.160944 1.293180 1.683176 0.244325 0.530816 1.180483 1.812767 0.268820 0.993683 1.695534 1.919653 0.449948 1.560150 0.338318 1.266700 1.853107 0.910590 1.381060 0.420174 1.311948)
)
;;; 67 even --------------------------------------------------------------------------------
-(vector 67 10.668939590454 #(0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 0 0 1 0 1 0 0 0 1 1 1 1 1 0 0 0 0 1 1 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 0 1 0 1 0 0 1 0 0 0)
+(vector 67 10.668939590454 #r(0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 0 0 1 0 1 0 0 0 1 1 1 1 1 0 0 0 0 1 1 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 0 1 0 1 0 0 1 0 0 0)
;; ce:
- 8.715278 #(0.000000 -0.048714 1.201233 1.932201 0.432152 1.784378 1.706119 1.715110 0.918127 0.634326 -0.280426 0.736091 0.881233 0.715749 1.255373 0.306961 0.430124 1.043814 0.355900 1.887422 0.161687 0.974683 1.590380 -0.300251 0.580494 -0.035950 1.388432 1.396578 1.262995 0.125471 0.427569 0.132635 1.747845 1.090690 1.059664 0.781885 0.922127 1.269399 0.290961 0.283370 1.543322 0.245179 1.267332 1.559397 1.540498 0.278811 0.442330 0.979302 0.305622 1.057402 0.123531 1.659773 0.687811 0.574242 1.988850 0.928855 0.118304 0.916897 0.064414 0.547707 0.733829 0.168859 0.108897 0.552498 0.271579 0.641458 0.722670)
+ 8.715278 #r(0.000000 -0.048714 1.201233 1.932201 0.432152 1.784378 1.706119 1.715110 0.918127 0.634326 -0.280426 0.736091 0.881233 0.715749 1.255373 0.306961 0.430124 1.043814 0.355900 1.887422 0.161687 0.974683 1.590380 -0.300251 0.580494 -0.035950 1.388432 1.396578 1.262995 0.125471 0.427569 0.132635 1.747845 1.090690 1.059664 0.781885 0.922127 1.269399 0.290961 0.283370 1.543322 0.245179 1.267332 1.559397 1.540498 0.278811 0.442330 0.979302 0.305622 1.057402 0.123531 1.659773 0.687811 0.574242 1.988850 0.928855 0.118304 0.916897 0.064414 0.547707 0.733829 0.168859 0.108897 0.552498 0.271579 0.641458 0.722670)
)
;;; 68 even --------------------------------------------------------------------------------
-(vector 68 10.834321813096 #(0 1 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 1 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 0 1 0)
+(vector 68 10.834321813096 #r(0 1 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 1 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 0 1 0)
;; ce:
- 8.754943 #(0.000000 0.006701 0.662467 1.132456 -0.029127 0.614111 1.150467 1.706479 0.619454 1.199242 1.758840 0.562498 1.597544 0.407921 1.558651 0.097672 0.926756 -0.032275 0.853950 0.002762 0.680777 1.599641 0.725147 0.147702 1.201496 0.263849 1.380478 0.615269 0.086221 1.573333 1.233822 0.463104 -0.134996 1.463347 0.467790 -0.201328 1.692933 1.307865 0.941345 0.423601 0.364303 1.897445 -0.044200 1.168331 0.738828 0.662829 0.834882 0.503840 0.773952 0.485349 0.168198 0.227087 0.122039 0.075266 0.590053 0.402757 0.920519 0.805378 1.169878 1.002493 1.566599 1.933905 0.435730 0.760806 1.023096 1.785992 1.801946 0.257114)
+ 8.754943 #r(0.000000 0.006701 0.662467 1.132456 -0.029127 0.614111 1.150467 1.706479 0.619454 1.199242 1.758840 0.562498 1.597544 0.407921 1.558651 0.097672 0.926756 -0.032275 0.853950 0.002762 0.680777 1.599641 0.725147 0.147702 1.201496 0.263849 1.380478 0.615269 0.086221 1.573333 1.233822 0.463104 -0.134996 1.463347 0.467790 -0.201328 1.692933 1.307865 0.941345 0.423601 0.364303 1.897445 -0.044200 1.168331 0.738828 0.662829 0.834882 0.503840 0.773952 0.485349 0.168198 0.227087 0.122039 0.075266 0.590053 0.402757 0.920519 0.805378 1.169878 1.002493 1.566599 1.933905 0.435730 0.760806 1.023096 1.785992 1.801946 0.257114)
)
;;; 69 even --------------------------------------------------------------------------------
-(vector 69 11.164121627808 #(0 0 0 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 0 0 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 0)
+(vector 69 11.164121627808 #r(0 0 0 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 0 0 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 0)
- 8.870351 #(0.000000 -0.002928 0.090043 1.728264 1.193144 0.838010 0.865027 0.720973 0.639322 0.246096 0.057627 0.302959 -0.048089 1.638389 0.900762 0.946630 1.090094 0.801115 1.083281 1.325801 0.953024 0.800047 1.660883 0.042716 1.927302 1.582152 0.107129 0.057190 -0.097633 0.434745 0.530943 1.556013 -0.117080 1.617479 1.566580 -0.082197 0.137002 1.745306 1.025473 1.476477 1.524388 0.192617 1.281951 0.528156 0.227376 1.631586 1.077576 0.616842 1.479500 0.199402 1.336867 0.525138 1.593133 1.323175 0.217188 0.498012 1.287694 0.007842 1.310482 0.013236 0.970642 -0.011247 0.684481 1.560396 -0.131105 0.613388 0.586300 0.981366 1.715362)
+ 8.870351 #r(0.000000 -0.002928 0.090043 1.728264 1.193144 0.838010 0.865027 0.720973 0.639322 0.246096 0.057627 0.302959 -0.048089 1.638389 0.900762 0.946630 1.090094 0.801115 1.083281 1.325801 0.953024 0.800047 1.660883 0.042716 1.927302 1.582152 0.107129 0.057190 -0.097633 0.434745 0.530943 1.556013 -0.117080 1.617479 1.566580 -0.082197 0.137002 1.745306 1.025473 1.476477 1.524388 0.192617 1.281951 0.528156 0.227376 1.631586 1.077576 0.616842 1.479500 0.199402 1.336867 0.525138 1.593133 1.323175 0.217188 0.498012 1.287694 0.007842 1.310482 0.013236 0.970642 -0.011247 0.684481 1.560396 -0.131105 0.613388 0.586300 0.981366 1.715362)
;; ce:
- 8.871460 #(0.000000 0.024677 0.348753 1.853212 1.026433 0.764498 0.988619 0.726212 0.717099 0.354110 0.211391 0.453497 0.101716 1.483433 0.914508 0.822283 0.913048 0.815074 1.083064 1.158865 1.024685 0.695931 1.752852 0.025183 1.742985 1.441890 0.242171 0.072208 0.012411 0.538299 0.676243 1.315025 0.155925 1.560315 1.592984 0.078875 0.242794 1.804492 0.950070 1.285093 1.411716 0.049957 1.246246 0.728985 0.030862 1.434432 1.085297 0.759494 1.436818 0.422412 1.268623 0.590795 1.364269 1.235546 0.170900 0.477972 1.127120 -0.054549 1.479098 0.172668 1.199653 -0.107230 0.674735 1.486658 -0.230242 0.542693 0.703829 0.966900 1.458811)
+ 8.871460 #r(0.000000 0.024677 0.348753 1.853212 1.026433 0.764498 0.988619 0.726212 0.717099 0.354110 0.211391 0.453497 0.101716 1.483433 0.914508 0.822283 0.913048 0.815074 1.083064 1.158865 1.024685 0.695931 1.752852 0.025183 1.742985 1.441890 0.242171 0.072208 0.012411 0.538299 0.676243 1.315025 0.155925 1.560315 1.592984 0.078875 0.242794 1.804492 0.950070 1.285093 1.411716 0.049957 1.246246 0.728985 0.030862 1.434432 1.085297 0.759494 1.436818 0.422412 1.268623 0.590795 1.364269 1.235546 0.170900 0.477972 1.127120 -0.054549 1.479098 0.172668 1.199653 -0.107230 0.674735 1.486658 -0.230242 0.542693 0.703829 0.966900 1.458811)
)
;;; 70 even --------------------------------------------------------------------------------
-(vector 70 11.188811302185 #(0 1 1 1 0 0 1 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 0 1 0 0 0 0 0 0 0 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 0 1 0 1 1)
+(vector 70 11.188811302185 #r(0 1 1 1 0 0 1 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 0 1 0 0 0 0 0 0 0 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 0 1 0 1 1)
;; ce:
- 8.848811 #(0.000000 0.246703 1.002261 0.886061 0.801873 1.809738 1.108544 0.562043 1.825392 1.804522 1.262385 0.421389 0.361557 1.923401 1.951742 1.062427 0.438003 0.228289 1.097160 1.013865 0.764041 0.470243 0.831289 0.101425 1.763202 0.709481 0.498799 0.216191 0.861166 0.122620 0.547738 1.235046 0.857238 0.383439 0.822746 0.754977 0.703208 0.715041 0.359010 1.832044 0.247507 1.317151 1.405217 0.206638 0.707472 1.340219 1.707159 1.823029 1.938700 1.479437 0.258261 1.667534 0.316971 1.157956 1.277369 0.826722 1.196822 0.248386 0.546752 1.821030 1.066474 1.952221 1.238401 0.305398 0.369743 0.877722 1.232005 1.532682 1.629962 0.062770)
+ 8.848811 #r(0.000000 0.246703 1.002261 0.886061 0.801873 1.809738 1.108544 0.562043 1.825392 1.804522 1.262385 0.421389 0.361557 1.923401 1.951742 1.062427 0.438003 0.228289 1.097160 1.013865 0.764041 0.470243 0.831289 0.101425 1.763202 0.709481 0.498799 0.216191 0.861166 0.122620 0.547738 1.235046 0.857238 0.383439 0.822746 0.754977 0.703208 0.715041 0.359010 1.832044 0.247507 1.317151 1.405217 0.206638 0.707472 1.340219 1.707159 1.823029 1.938700 1.479437 0.258261 1.667534 0.316971 1.157956 1.277369 0.826722 1.196822 0.248386 0.546752 1.821030 1.066474 1.952221 1.238401 0.305398 0.369743 0.877722 1.232005 1.532682 1.629962 0.062770)
)
;;; 71 even --------------------------------------------------------------------------------
-(vector 71 11.146488189697 #(0 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 0 0 1 1 0)
+(vector 71 11.146488189697 #r(0 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 0 0 1 1 0)
;; ce:
- 8.877033 #(0.000000 0.494925 1.537244 0.892084 0.150008 1.375283 0.111396 0.180070 1.039621 1.603551 0.974071 0.067462 1.566530 0.645476 1.559374 0.286202 1.250076 1.040362 0.597158 0.170031 1.495084 0.538551 1.605790 0.911462 0.561795 0.131327 0.669920 1.494711 1.488338 0.162432 0.349959 1.071758 0.876821 1.835299 1.877472 1.338427 1.055237 0.961547 0.343936 0.685277 1.268629 0.932565 0.412531 1.233930 1.960684 0.356135 1.869394 1.068031 1.470058 1.669216 1.450884 1.495861 1.103585 1.290131 0.589390 1.675751 1.864756 1.328404 1.588855 1.689588 1.394915 1.481997 1.790524 0.376533 0.659979 0.194369 0.714680 1.009374 1.293563 1.133522 0.906132)
+ 8.877033 #r(0.000000 0.494925 1.537244 0.892084 0.150008 1.375283 0.111396 0.180070 1.039621 1.603551 0.974071 0.067462 1.566530 0.645476 1.559374 0.286202 1.250076 1.040362 0.597158 0.170031 1.495084 0.538551 1.605790 0.911462 0.561795 0.131327 0.669920 1.494711 1.488338 0.162432 0.349959 1.071758 0.876821 1.835299 1.877472 1.338427 1.055237 0.961547 0.343936 0.685277 1.268629 0.932565 0.412531 1.233930 1.960684 0.356135 1.869394 1.068031 1.470058 1.669216 1.450884 1.495861 1.103585 1.290131 0.589390 1.675751 1.864756 1.328404 1.588855 1.689588 1.394915 1.481997 1.790524 0.376533 0.659979 0.194369 0.714680 1.009374 1.293563 1.133522 0.906132)
)
;;; 72 even --------------------------------------------------------------------------------
-(vector 72 11.323646371629 #(0 0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0)
+(vector 72 11.323646371629 #r(0 0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0)
- 8.985526 #(0.000000 -0.132001 0.251840 -0.152367 1.238134 0.223104 0.102612 0.998567 1.283059 0.195894 1.573363 0.407537 1.033361 -0.202081 0.593147 0.635495 1.000647 1.220151 0.876169 0.891935 0.590452 0.848621 0.474219 0.520369 1.077034 0.562333 1.205154 1.187120 1.031050 1.268084 0.666333 -0.432529 0.483326 0.764356 0.428610 0.084679 1.685196 -0.154809 0.749260 1.099715 -0.153921 1.175926 0.117589 0.701530 0.528397 1.669792 1.315998 0.695987 0.047259 0.736352 1.073555 1.525504 1.860608 -0.168018 1.587814 -0.029717 0.367471 1.076978 0.934753 0.510954 0.369425 1.530708 0.338598 0.869566 1.012951 0.841118 0.372289 1.598627 0.202786 1.450618 0.578685 0.231358)
+ 8.985526 #r(0.000000 -0.132001 0.251840 -0.152367 1.238134 0.223104 0.102612 0.998567 1.283059 0.195894 1.573363 0.407537 1.033361 -0.202081 0.593147 0.635495 1.000647 1.220151 0.876169 0.891935 0.590452 0.848621 0.474219 0.520369 1.077034 0.562333 1.205154 1.187120 1.031050 1.268084 0.666333 -0.432529 0.483326 0.764356 0.428610 0.084679 1.685196 -0.154809 0.749260 1.099715 -0.153921 1.175926 0.117589 0.701530 0.528397 1.669792 1.315998 0.695987 0.047259 0.736352 1.073555 1.525504 1.860608 -0.168018 1.587814 -0.029717 0.367471 1.076978 0.934753 0.510954 0.369425 1.530708 0.338598 0.869566 1.012951 0.841118 0.372289 1.598627 0.202786 1.450618 0.578685 0.231358)
;; nce:
- 8.996610 #(0.000000 0.020435 0.148826 -0.173981 1.377729 0.211130 0.166992 1.053622 1.458337 0.005572 1.576161 0.391690 1.074146 -0.213327 0.588223 0.422230 0.994634 1.149413 0.858889 0.855458 0.451324 0.722371 0.451607 0.485779 1.099748 0.481778 1.183724 1.119200 0.986503 1.262651 0.778215 -0.493824 0.577630 0.838272 0.526378 0.254738 1.698601 -0.156321 0.698602 1.048110 -0.140804 0.991469 0.138073 0.652727 0.457506 1.770023 1.311357 0.782250 0.170414 0.740584 1.195615 1.519642 1.761376 -0.154135 1.542454 -0.027224 0.389381 1.045008 1.107881 0.609081 0.244277 1.495852 0.294775 0.922470 1.153689 1.027914 0.296649 1.621186 0.277016 1.409256 0.557607 0.152023)
+ 8.996610 #r(0.000000 0.020435 0.148826 -0.173981 1.377729 0.211130 0.166992 1.053622 1.458337 0.005572 1.576161 0.391690 1.074146 -0.213327 0.588223 0.422230 0.994634 1.149413 0.858889 0.855458 0.451324 0.722371 0.451607 0.485779 1.099748 0.481778 1.183724 1.119200 0.986503 1.262651 0.778215 -0.493824 0.577630 0.838272 0.526378 0.254738 1.698601 -0.156321 0.698602 1.048110 -0.140804 0.991469 0.138073 0.652727 0.457506 1.770023 1.311357 0.782250 0.170414 0.740584 1.195615 1.519642 1.761376 -0.154135 1.542454 -0.027224 0.389381 1.045008 1.107881 0.609081 0.244277 1.495852 0.294775 0.922470 1.153689 1.027914 0.296649 1.621186 0.277016 1.409256 0.557607 0.152023)
)
;;; 73 even --------------------------------------------------------------------------------
-(vector 73 11.416394233704 #(0 0 0 0 0 1 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 0 1 0 0 1 0 0 1 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 0)
+(vector 73 11.416394233704 #r(0 0 0 0 0 1 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 0 1 0 0 1 0 0 1 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 0)
;; ce:
- 9.061347 #(0.000000 -0.013492 0.700057 0.971458 1.656489 0.226217 1.266397 1.217251 0.034107 1.132703 0.209805 0.859555 1.676063 0.359664 0.948491 1.631395 0.566735 1.564253 0.503600 1.614448 0.423074 1.551405 0.311534 1.292368 0.836304 0.277624 0.872873 0.108697 1.546043 0.974228 -0.054286 1.516659 0.873622 0.075543 -0.025545 1.027508 0.575666 -0.130582 1.023997 1.136740 0.704834 -0.015132 -0.346526 1.509690 1.112218 0.655940 0.431045 0.092523 0.384582 -0.406961 0.058570 -0.216957 1.536312 1.587308 1.645182 1.277358 1.546578 1.141387 -0.381783 1.707248 -0.163708 -0.313272 -0.263055 0.347717 0.363093 0.778459 1.216671 1.669453 -0.038813 0.148398 0.866038 0.847643 1.513063)
+ 9.061347 #r(0.000000 -0.013492 0.700057 0.971458 1.656489 0.226217 1.266397 1.217251 0.034107 1.132703 0.209805 0.859555 1.676063 0.359664 0.948491 1.631395 0.566735 1.564253 0.503600 1.614448 0.423074 1.551405 0.311534 1.292368 0.836304 0.277624 0.872873 0.108697 1.546043 0.974228 -0.054286 1.516659 0.873622 0.075543 -0.025545 1.027508 0.575666 -0.130582 1.023997 1.136740 0.704834 -0.015132 -0.346526 1.509690 1.112218 0.655940 0.431045 0.092523 0.384582 -0.406961 0.058570 -0.216957 1.536312 1.587308 1.645182 1.277358 1.546578 1.141387 -0.381783 1.707248 -0.163708 -0.313272 -0.263055 0.347717 0.363093 0.778459 1.216671 1.669453 -0.038813 0.148398 0.866038 0.847643 1.513063)
)
;;; 74 even --------------------------------------------------------------------------------
-(vector 74 11.47264289856 #(0 0 0 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 0 0 1 0 0 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 1 0 1 1)
+(vector 74 11.47264289856 #r(0 0 0 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 0 0 1 0 0 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 1 0 1 1)
;; ce:
- 9.134480 #(0.000000 0.102279 0.371397 0.523001 1.843248 1.152941 1.651341 1.411384 0.791794 0.097952 1.057024 0.161099 0.857363 0.427397 0.372120 0.661194 1.523876 0.922082 -0.041073 -0.033604 0.996743 1.697191 1.295880 0.242720 0.296660 0.925120 0.229105 1.701968 1.808512 0.155026 0.755549 1.603330 1.534401 1.305218 1.056671 1.959110 0.012243 0.095634 0.866653 0.499791 0.642664 1.366362 0.320578 0.556112 0.471836 0.546071 0.453257 0.620145 0.487633 1.413108 0.647644 1.248023 1.294495 1.814325 0.514274 1.440895 0.132821 0.969503 0.559010 0.339598 1.732485 1.513938 0.682886 0.936970 1.342790 0.397470 0.364797 1.929409 1.198862 0.270546 1.048858 1.252852 0.860205 0.013479)
+ 9.134480 #r(0.000000 0.102279 0.371397 0.523001 1.843248 1.152941 1.651341 1.411384 0.791794 0.097952 1.057024 0.161099 0.857363 0.427397 0.372120 0.661194 1.523876 0.922082 -0.041073 -0.033604 0.996743 1.697191 1.295880 0.242720 0.296660 0.925120 0.229105 1.701968 1.808512 0.155026 0.755549 1.603330 1.534401 1.305218 1.056671 1.959110 0.012243 0.095634 0.866653 0.499791 0.642664 1.366362 0.320578 0.556112 0.471836 0.546071 0.453257 0.620145 0.487633 1.413108 0.647644 1.248023 1.294495 1.814325 0.514274 1.440895 0.132821 0.969503 0.559010 0.339598 1.732485 1.513938 0.682886 0.936970 1.342790 0.397470 0.364797 1.929409 1.198862 0.270546 1.048858 1.252852 0.860205 0.013479)
)
;;; 75 even --------------------------------------------------------------------------------
-(vector 75 11.479255355845 #(0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 1)
+(vector 75 11.479255355845 #r(0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 1)
;; ce:
- 9.136718 #(0.000000 0.002886 1.335455 0.159358 1.480181 0.946385 -0.044639 1.084031 0.633473 0.070872 0.846110 0.073920 0.712875 1.849807 0.002049 1.333644 0.084510 1.217578 1.455838 0.351015 0.583697 1.521673 -0.105875 -0.161704 1.008277 1.067855 -0.227255 1.066234 0.968179 0.069816 1.652420 0.515209 -0.583628 1.701274 1.644474 0.045597 -0.072256 1.396842 -0.036343 1.242335 0.205214 -0.046339 1.655176 1.585631 1.056865 0.812824 1.251896 1.501857 -0.501015 0.327372 1.079894 1.360106 0.639144 -0.102077 0.025865 0.258537 0.650404 0.029251 0.316419 1.073801 1.065871 0.953311 0.976263 -0.016818 0.369518 -0.028524 0.754304 0.267168 0.876021 1.386930 1.128217 -0.044803 -0.305853 1.417010 1.210349)
+ 9.136718 #r(0.000000 0.002886 1.335455 0.159358 1.480181 0.946385 -0.044639 1.084031 0.633473 0.070872 0.846110 0.073920 0.712875 1.849807 0.002049 1.333644 0.084510 1.217578 1.455838 0.351015 0.583697 1.521673 -0.105875 -0.161704 1.008277 1.067855 -0.227255 1.066234 0.968179 0.069816 1.652420 0.515209 -0.583628 1.701274 1.644474 0.045597 -0.072256 1.396842 -0.036343 1.242335 0.205214 -0.046339 1.655176 1.585631 1.056865 0.812824 1.251896 1.501857 -0.501015 0.327372 1.079894 1.360106 0.639144 -0.102077 0.025865 0.258537 0.650404 0.029251 0.316419 1.073801 1.065871 0.953311 0.976263 -0.016818 0.369518 -0.028524 0.754304 0.267168 0.876021 1.386930 1.128217 -0.044803 -0.305853 1.417010 1.210349)
)
;;; 76 even --------------------------------------------------------------------------------
-(vector 76 11.477294510597 #(0 0 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 0 1 0 1 0 1 1 1 1 1 0 1 1 0 0 0 0 1 1 1)
+(vector 76 11.477294510597 #r(0 0 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 0 1 0 1 0 1 1 1 1 1 0 1 1 0 0 0 0 1 1 1)
;; ce:
- 9.274323 #(0.000000 -0.012165 1.750183 1.230595 1.387108 0.131448 0.902665 1.325819 0.139220 0.132421 1.315838 0.916320 1.247629 1.543004 0.326242 0.479315 1.525889 1.714627 0.992625 1.849378 1.028201 1.309429 1.365818 1.322280 1.222257 1.381076 1.644593 0.773733 0.614835 0.306624 1.009114 1.162734 0.610055 0.099066 1.125761 1.356329 0.324777 0.800340 1.850117 0.710340 0.610191 0.810114 1.107918 1.417728 -0.023776 1.259738 0.196765 1.355631 1.575090 1.576385 1.741085 1.748236 0.050375 1.081011 0.178534 1.097122 0.438057 -0.170346 1.371443 0.019537 1.307599 0.833238 0.430491 0.202986 1.382655 1.791419 0.002565 0.061873 0.176928 1.554826 0.852820 1.065814 0.297645 0.742549 0.387652 1.429885)
+ 9.274323 #r(0.000000 -0.012165 1.750183 1.230595 1.387108 0.131448 0.902665 1.325819 0.139220 0.132421 1.315838 0.916320 1.247629 1.543004 0.326242 0.479315 1.525889 1.714627 0.992625 1.849378 1.028201 1.309429 1.365818 1.322280 1.222257 1.381076 1.644593 0.773733 0.614835 0.306624 1.009114 1.162734 0.610055 0.099066 1.125761 1.356329 0.324777 0.800340 1.850117 0.710340 0.610191 0.810114 1.107918 1.417728 -0.023776 1.259738 0.196765 1.355631 1.575090 1.576385 1.741085 1.748236 0.050375 1.081011 0.178534 1.097122 0.438057 -0.170346 1.371443 0.019537 1.307599 0.833238 0.430491 0.202986 1.382655 1.791419 0.002565 0.061873 0.176928 1.554826 0.852820 1.065814 0.297645 0.742549 0.387652 1.429885)
)
;;; 77 even --------------------------------------------------------------------------------
-(vector 77 11.594018936157 #(0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 0 0 1 0 1 0 1 1 1 0 1 0 1 0 1 1 1 1 0 0 0 0 0 0 0 0 1 1 1 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1)
+(vector 77 11.594018936157 #r(0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 0 0 1 0 1 0 1 1 1 0 1 0 1 0 1 1 1 1 0 0 0 0 0 0 0 0 1 1 1 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1)
;; ce:
- 9.277681 #(0.000000 -0.007935 0.356695 -0.167840 1.436050 1.267495 0.166108 0.719740 1.788089 0.701383 1.502062 0.971109 -0.201146 1.261312 1.596232 0.380082 0.436900 1.530759 0.673592 1.168750 0.815135 1.757429 0.573966 1.406748 1.792933 1.256151 0.643583 0.884960 0.868508 0.759790 1.464002 -0.196244 0.635729 1.419530 -0.026848 0.857441 0.646295 0.815860 0.331225 0.324537 0.379771 0.793029 -0.189194 0.533286 0.175986 1.162021 0.894997 1.330799 0.028604 0.329088 -0.042751 1.722552 1.010170 0.365295 -0.089972 0.186813 0.250172 1.045796 0.805669 1.150679 1.074682 0.666765 1.119179 0.223717 0.745979 0.727191 0.250299 1.103832 0.833082 -0.215344 1.645081 0.897326 0.690160 1.501085 1.581868 1.570534 1.086810)
+ 9.277681 #r(0.000000 -0.007935 0.356695 -0.167840 1.436050 1.267495 0.166108 0.719740 1.788089 0.701383 1.502062 0.971109 -0.201146 1.261312 1.596232 0.380082 0.436900 1.530759 0.673592 1.168750 0.815135 1.757429 0.573966 1.406748 1.792933 1.256151 0.643583 0.884960 0.868508 0.759790 1.464002 -0.196244 0.635729 1.419530 -0.026848 0.857441 0.646295 0.815860 0.331225 0.324537 0.379771 0.793029 -0.189194 0.533286 0.175986 1.162021 0.894997 1.330799 0.028604 0.329088 -0.042751 1.722552 1.010170 0.365295 -0.089972 0.186813 0.250172 1.045796 0.805669 1.150679 1.074682 0.666765 1.119179 0.223717 0.745979 0.727191 0.250299 1.103832 0.833082 -0.215344 1.645081 0.897326 0.690160 1.501085 1.581868 1.570534 1.086810)
)
;;; 78 even --------------------------------------------------------------------------------
-(vector 78 11.940728787203 #(0 1 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 0 0 1 0 1 1 1 1 1 0 0)
+(vector 78 11.940728787203 #r(0 1 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 0 0 1 0 1 1 1 1 1 0 0)
- 9.335941 #(0.000000 1.404748 1.136727 0.627680 0.129528 0.271686 0.002711 1.737837 1.295987 1.387168 0.097658 1.822832 0.846464 1.039100 1.481322 0.895294 0.827592 0.841157 0.429643 0.718521 1.651578 0.732848 0.670593 1.833752 0.966314 1.266799 1.852734 1.169793 1.403542 0.722295 1.054728 1.444480 1.323054 1.351419 0.414445 0.928183 1.497407 0.895056 0.003473 1.202042 1.804296 0.448756 1.139768 0.075452 1.121542 0.477216 1.723231 0.402648 0.668323 0.045598 1.846940 0.961710 0.765295 1.814929 0.327072 0.120487 1.324670 1.238079 1.405578 -0.005216 1.466365 1.535268 1.050547 0.249219 1.956711 0.420435 0.291291 0.855796 1.032224 0.874733 1.340034 0.852331 1.473861 1.078790 -0.021411 0.624891 0.620475 1.381664)
+ 9.335941 #r(0.000000 1.404748 1.136727 0.627680 0.129528 0.271686 0.002711 1.737837 1.295987 1.387168 0.097658 1.822832 0.846464 1.039100 1.481322 0.895294 0.827592 0.841157 0.429643 0.718521 1.651578 0.732848 0.670593 1.833752 0.966314 1.266799 1.852734 1.169793 1.403542 0.722295 1.054728 1.444480 1.323054 1.351419 0.414445 0.928183 1.497407 0.895056 0.003473 1.202042 1.804296 0.448756 1.139768 0.075452 1.121542 0.477216 1.723231 0.402648 0.668323 0.045598 1.846940 0.961710 0.765295 1.814929 0.327072 0.120487 1.324670 1.238079 1.405578 -0.005216 1.466365 1.535268 1.050547 0.249219 1.956711 0.420435 0.291291 0.855796 1.032224 0.874733 1.340034 0.852331 1.473861 1.078790 -0.021411 0.624891 0.620475 1.381664)
)
;;; 79 even --------------------------------------------------------------------------------
-(vector 79 11.878196632448 #(0 0 1 1 0 1 0 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1 1)
+(vector 79 11.878196632448 #r(0 0 1 1 0 1 0 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1 1)
;; ce:
- 9.380733 #(0.000000 0.510780 0.252633 0.712748 0.045825 0.533290 0.570911 1.782693 1.778269 1.965545 0.949265 0.812889 1.687090 1.664308 1.581407 1.710616 0.952117 1.113251 0.535130 1.949191 0.392710 1.113892 0.673455 0.088774 1.234594 1.234700 1.363303 0.874218 0.053582 1.508928 0.207664 0.009853 1.481504 1.794166 0.192648 0.693227 0.386323 1.341036 0.276027 0.630139 0.405686 0.785949 0.090167 1.080676 0.339556 0.634603 1.972094 0.909674 0.642872 1.742555 1.044458 1.900464 0.893867 1.044986 0.466092 0.081355 1.748407 0.417739 0.609777 0.867444 0.996078 1.921822 0.146017 1.547350 1.786775 0.079134 0.379049 1.145195 0.491146 0.827840 1.444544 0.381774 1.018247 0.133450 0.186735 0.732527 1.660451 1.720421 1.438682)
+ 9.380733 #r(0.000000 0.510780 0.252633 0.712748 0.045825 0.533290 0.570911 1.782693 1.778269 1.965545 0.949265 0.812889 1.687090 1.664308 1.581407 1.710616 0.952117 1.113251 0.535130 1.949191 0.392710 1.113892 0.673455 0.088774 1.234594 1.234700 1.363303 0.874218 0.053582 1.508928 0.207664 0.009853 1.481504 1.794166 0.192648 0.693227 0.386323 1.341036 0.276027 0.630139 0.405686 0.785949 0.090167 1.080676 0.339556 0.634603 1.972094 0.909674 0.642872 1.742555 1.044458 1.900464 0.893867 1.044986 0.466092 0.081355 1.748407 0.417739 0.609777 0.867444 0.996078 1.921822 0.146017 1.547350 1.786775 0.079134 0.379049 1.145195 0.491146 0.827840 1.444544 0.381774 1.018247 0.133450 0.186735 0.732527 1.660451 1.720421 1.438682)
)
;;; 80 even --------------------------------------------------------------------------------
-(vector 80 11.989325523376 #(0 1 0 0 1 0 0 1 1 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 1 1 1 0 1 1 0 1 0 1 1 0 0 0 0)
+(vector 80 11.989325523376 #r(0 1 0 0 1 0 0 1 1 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 1 1 1 0 1 1 0 1 0 1 1 0 0 0 0)
;; ce:
- 9.493437 #(0.000000 -0.003056 0.871305 1.349319 1.858308 0.466908 1.244422 1.764043 0.291426 1.076281 1.682758 0.386304 1.182056 -0.041504 1.018049 1.794160 0.591085 1.410404 0.075268 1.154361 0.262047 1.215494 0.086813 1.119384 0.112085 1.492482 0.546321 1.626715 0.687674 1.840924 1.113879 0.412411 1.693842 1.217772 0.566191 1.613902 0.702693 0.386708 1.626693 1.362021 0.738932 0.368846 1.672871 1.299617 0.788427 0.551598 0.187991 1.803477 1.774821 1.164009 1.487614 0.770019 0.742630 0.390398 -0.088422 1.923288 -0.109062 1.842146 1.690251 0.008381 1.550824 1.531659 1.497616 1.396079 1.603050 1.793260 0.154336 0.252178 0.425516 0.421130 0.697112 0.901699 1.252555 0.016759 0.375241 0.855613 1.211546 1.433945 1.792863 0.351953)
+ 9.493437 #r(0.000000 -0.003056 0.871305 1.349319 1.858308 0.466908 1.244422 1.764043 0.291426 1.076281 1.682758 0.386304 1.182056 -0.041504 1.018049 1.794160 0.591085 1.410404 0.075268 1.154361 0.262047 1.215494 0.086813 1.119384 0.112085 1.492482 0.546321 1.626715 0.687674 1.840924 1.113879 0.412411 1.693842 1.217772 0.566191 1.613902 0.702693 0.386708 1.626693 1.362021 0.738932 0.368846 1.672871 1.299617 0.788427 0.551598 0.187991 1.803477 1.774821 1.164009 1.487614 0.770019 0.742630 0.390398 -0.088422 1.923288 -0.109062 1.842146 1.690251 0.008381 1.550824 1.531659 1.497616 1.396079 1.603050 1.793260 0.154336 0.252178 0.425516 0.421130 0.697112 0.901699 1.252555 0.016759 0.375241 0.855613 1.211546 1.433945 1.792863 0.351953)
)
;;; 81 even --------------------------------------------------------------------------------
-(vector 81 11.979215621948 #(0 0 1 0 1 0 1 1 0 0 1 0 0 0 0 0 1 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0)
+(vector 81 11.979215621948 #r(0 0 1 0 1 0 1 1 0 0 1 0 0 0 0 0 1 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0)
;; ce:
- 9.529325 #(0.000000 -0.003984 0.725186 0.743737 0.729531 1.119765 1.541925 1.678935 1.738481 1.721543 1.393185 0.731045 0.019478 0.771584 0.581855 0.216656 0.563399 1.242114 0.560651 1.738359 1.170491 0.159270 0.566126 0.483569 1.182790 0.181604 1.706151 1.854339 -0.002194 0.437844 -0.070207 1.440872 0.286463 1.398996 1.367061 0.708028 -0.290957 0.883528 0.399205 0.712176 0.881360 0.586332 1.691690 -0.045439 0.598789 -0.244443 0.663603 1.393152 0.011936 0.502973 1.160110 0.596199 0.257846 0.544341 0.629333 1.752684 0.177491 0.528429 1.038556 0.728481 0.384225 0.529890 0.711236 1.400194 1.498453 1.156244 0.653763 0.305758 -0.155269 1.073363 1.458379 0.702870 0.141716 1.302726 -0.329814 0.298639 1.892688 1.900138 1.655169 0.812034 -0.182220)
+ 9.529325 #r(0.000000 -0.003984 0.725186 0.743737 0.729531 1.119765 1.541925 1.678935 1.738481 1.721543 1.393185 0.731045 0.019478 0.771584 0.581855 0.216656 0.563399 1.242114 0.560651 1.738359 1.170491 0.159270 0.566126 0.483569 1.182790 0.181604 1.706151 1.854339 -0.002194 0.437844 -0.070207 1.440872 0.286463 1.398996 1.367061 0.708028 -0.290957 0.883528 0.399205 0.712176 0.881360 0.586332 1.691690 -0.045439 0.598789 -0.244443 0.663603 1.393152 0.011936 0.502973 1.160110 0.596199 0.257846 0.544341 0.629333 1.752684 0.177491 0.528429 1.038556 0.728481 0.384225 0.529890 0.711236 1.400194 1.498453 1.156244 0.653763 0.305758 -0.155269 1.073363 1.458379 0.702870 0.141716 1.302726 -0.329814 0.298639 1.892688 1.900138 1.655169 0.812034 -0.182220)
)
;;; 82 even --------------------------------------------------------------------------------
-(vector 82 11.74796962738 #(0 0 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 1 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0)
+(vector 82 11.74796962738 #r(0 0 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 1 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0)
;; ce:
- 9.530985 #(0.000000 0.002581 0.665465 1.069477 1.708629 0.244744 0.815275 1.389506 0.072967 0.518149 1.258636 0.104869 0.672550 1.578904 0.486254 1.275378 -0.016236 0.797153 -0.276393 0.747043 -0.159462 0.727529 0.109229 1.313965 0.107559 1.101244 0.135391 1.229652 0.386704 1.699152 0.875100 0.220480 1.674529 0.566929 1.803565 1.281089 0.420527 -0.095373 1.451514 0.833105 0.334393 1.926106 1.521915 0.797742 0.037620 1.890450 1.238469 1.288596 0.773237 0.606049 0.213821 0.049140 1.607755 1.437666 0.833194 0.946550 0.684670 0.626164 0.630512 0.902897 0.480081 0.471365 0.308602 0.413372 0.258949 0.442607 0.453613 0.854111 1.173261 1.257079 1.135118 1.379336 1.476222 -0.234240 0.311478 0.480664 1.015136 1.521091 1.852304 0.056526 0.425563 0.785949)
+ 9.530985 #r(0.000000 0.002581 0.665465 1.069477 1.708629 0.244744 0.815275 1.389506 0.072967 0.518149 1.258636 0.104869 0.672550 1.578904 0.486254 1.275378 -0.016236 0.797153 -0.276393 0.747043 -0.159462 0.727529 0.109229 1.313965 0.107559 1.101244 0.135391 1.229652 0.386704 1.699152 0.875100 0.220480 1.674529 0.566929 1.803565 1.281089 0.420527 -0.095373 1.451514 0.833105 0.334393 1.926106 1.521915 0.797742 0.037620 1.890450 1.238469 1.288596 0.773237 0.606049 0.213821 0.049140 1.607755 1.437666 0.833194 0.946550 0.684670 0.626164 0.630512 0.902897 0.480081 0.471365 0.308602 0.413372 0.258949 0.442607 0.453613 0.854111 1.173261 1.257079 1.135118 1.379336 1.476222 -0.234240 0.311478 0.480664 1.015136 1.521091 1.852304 0.056526 0.425563 0.785949)
)
;;; 83 even --------------------------------------------------------------------------------
-(vector 83 11.931811297539 #(0 0 1 1 0 1 1 0 0 1 1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 1 1 1 0 0 0 0 0 0 0 1 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 1 0 1 0 1 1 0 0 1)
+(vector 83 11.931811297539 #r(0 0 1 1 0 1 1 0 0 1 1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 1 1 1 0 0 0 0 0 0 0 1 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 1 0 1 0 1 1 0 0 1)
;; ce:
- 9.549360 #(0.000000 0.032288 0.834116 1.401416 0.035368 0.406563 1.177626 1.509613 0.291626 0.972552 1.726763 0.692721 1.687201 0.129594 1.085873 0.204017 1.139515 0.273445 1.482102 0.192295 1.080179 1.979882 1.285941 0.340403 0.985304 0.533609 1.865099 0.628799 1.889210 1.180384 0.539244 1.842377 1.350512 0.512399 1.815213 1.164340 0.726996 -0.012813 1.099275 1.226281 0.551613 0.011231 1.538277 1.191883 0.928674 0.507861 1.826344 1.417654 1.468918 1.265287 0.819366 0.969679 0.428274 0.455249 1.949916 0.041645 1.591382 1.883937 1.784338 1.762163 1.899526 1.307740 1.800619 1.929764 0.063585 1.701620 1.807254 0.159705 0.531560 0.710036 1.009902 1.081386 1.423742 1.377653 1.714397 0.170534 0.667428 1.526663 1.444085 1.827303 0.046079 0.991518 1.278845)
+ 9.549360 #r(0.000000 0.032288 0.834116 1.401416 0.035368 0.406563 1.177626 1.509613 0.291626 0.972552 1.726763 0.692721 1.687201 0.129594 1.085873 0.204017 1.139515 0.273445 1.482102 0.192295 1.080179 1.979882 1.285941 0.340403 0.985304 0.533609 1.865099 0.628799 1.889210 1.180384 0.539244 1.842377 1.350512 0.512399 1.815213 1.164340 0.726996 -0.012813 1.099275 1.226281 0.551613 0.011231 1.538277 1.191883 0.928674 0.507861 1.826344 1.417654 1.468918 1.265287 0.819366 0.969679 0.428274 0.455249 1.949916 0.041645 1.591382 1.883937 1.784338 1.762163 1.899526 1.307740 1.800619 1.929764 0.063585 1.701620 1.807254 0.159705 0.531560 0.710036 1.009902 1.081386 1.423742 1.377653 1.714397 0.170534 0.667428 1.526663 1.444085 1.827303 0.046079 0.991518 1.278845)
)
;;; 84 even --------------------------------------------------------------------------------
-(vector 84 12.426499838032 #(0 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 0)
+(vector 84 12.426499838032 #r(0 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 0)
;; ce:
- 9.633962 #(0.000000 0.374922 1.183581 1.290870 0.705975 0.037122 1.139367 1.048350 0.334310 1.326801 1.647856 1.857607 1.812109 0.301068 1.658406 1.344389 0.416349 0.219667 1.233884 1.040486 1.625160 1.657982 1.232289 1.436356 0.879314 1.500837 0.083989 0.524445 1.496583 0.195492 0.415250 0.867702 1.173743 1.828747 1.840334 -0.001715 0.114874 1.289221 0.907468 1.568406 0.412257 0.461669 1.993995 0.175480 1.741500 1.629849 1.860704 1.739722 1.644034 1.223183 0.177672 0.444348 1.320675 1.200379 1.245918 0.030713 1.304971 1.969297 1.489901 0.864880 0.577011 0.034043 1.934323 1.447131 0.730445 1.571480 0.003554 0.387041 0.486597 1.351900 0.594794 1.157107 0.726867 1.857734 0.748709 1.799335 1.043537 0.919611 0.874828 0.732255 1.153375 1.608544 0.740331 1.571952)
+ 9.633962 #r(0.000000 0.374922 1.183581 1.290870 0.705975 0.037122 1.139367 1.048350 0.334310 1.326801 1.647856 1.857607 1.812109 0.301068 1.658406 1.344389 0.416349 0.219667 1.233884 1.040486 1.625160 1.657982 1.232289 1.436356 0.879314 1.500837 0.083989 0.524445 1.496583 0.195492 0.415250 0.867702 1.173743 1.828747 1.840334 -0.001715 0.114874 1.289221 0.907468 1.568406 0.412257 0.461669 1.993995 0.175480 1.741500 1.629849 1.860704 1.739722 1.644034 1.223183 0.177672 0.444348 1.320675 1.200379 1.245918 0.030713 1.304971 1.969297 1.489901 0.864880 0.577011 0.034043 1.934323 1.447131 0.730445 1.571480 0.003554 0.387041 0.486597 1.351900 0.594794 1.157107 0.726867 1.857734 0.748709 1.799335 1.043537 0.919611 0.874828 0.732255 1.153375 1.608544 0.740331 1.571952)
)
;;; 85 even --------------------------------------------------------------------------------
-(vector 85 12.270205061432 #(0 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 1 1 0 0 1 0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 1)
+(vector 85 12.270205061432 #r(0 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 1 1 0 0 1 0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 1)
- 9.693668 #(0.000000 0.195989 0.490949 0.331600 0.887562 0.028445 1.546017 1.385311 0.812190 1.115113 1.801497 0.487288 0.525794 0.074082 1.723182 1.944316 1.781964 0.421600 0.177518 1.829367 0.571078 1.783004 0.344177 0.329133 1.891108 0.440324 0.259558 0.143603 0.779362 1.104207 1.976902 0.561742 0.767039 1.340228 0.253563 1.774888 1.741378 1.554241 1.474673 0.298807 0.272176 1.211675 1.002346 0.130871 1.176937 0.697418 0.199450 0.178715 1.330092 0.855241 1.512332 1.331159 0.219055 1.811575 1.934102 1.939888 1.043996 0.748687 0.643521 0.780509 1.267694 0.441215 0.667193 0.454905 1.688291 1.972173 0.503377 0.756581 0.239100 0.784029 1.470486 0.189182 1.795940 0.379978 1.569889 1.093199 1.711138 0.905143 0.045022 0.285289 1.219061 0.953496 1.196694 1.742789 0.902060)
+ 9.693668 #r(0.000000 0.195989 0.490949 0.331600 0.887562 0.028445 1.546017 1.385311 0.812190 1.115113 1.801497 0.487288 0.525794 0.074082 1.723182 1.944316 1.781964 0.421600 0.177518 1.829367 0.571078 1.783004 0.344177 0.329133 1.891108 0.440324 0.259558 0.143603 0.779362 1.104207 1.976902 0.561742 0.767039 1.340228 0.253563 1.774888 1.741378 1.554241 1.474673 0.298807 0.272176 1.211675 1.002346 0.130871 1.176937 0.697418 0.199450 0.178715 1.330092 0.855241 1.512332 1.331159 0.219055 1.811575 1.934102 1.939888 1.043996 0.748687 0.643521 0.780509 1.267694 0.441215 0.667193 0.454905 1.688291 1.972173 0.503377 0.756581 0.239100 0.784029 1.470486 0.189182 1.795940 0.379978 1.569889 1.093199 1.711138 0.905143 0.045022 0.285289 1.219061 0.953496 1.196694 1.742789 0.902060)
;; nce:
- 9.690941 #(0.000000 -0.005460 0.145938 -0.187800 0.177698 1.176520 0.517469 0.210175 1.436686 1.607383 0.066090 0.593136 0.482635 1.868920 1.291310 1.386910 1.029893 1.540100 1.084274 0.614905 1.153312 0.206651 0.588776 0.424148 1.780700 0.201677 -0.148794 1.539105 1.959298 0.153524 0.855868 1.263643 1.287920 -0.293735 0.438019 -0.206018 -0.356273 1.231052 1.001435 1.635849 1.476715 0.216231 -0.158631 0.753539 1.686606 0.980832 0.355756 0.168014 1.126044 0.500388 0.943877 0.638970 1.307633 0.790226 0.733504 0.595806 1.464991 1.037472 0.754676 0.719213 1.040414 0.002877 0.074104 1.737856 0.729741 0.862345 1.242108 1.321487 0.621750 1.011073 1.510125 0.085724 1.514690 -0.060524 0.938871 0.309540 0.743320 -0.211769 0.753436 0.803987 1.556267 1.083936 1.193072 1.598509 0.578392)
+ 9.690941 #r(0.000000 -0.005460 0.145938 -0.187800 0.177698 1.176520 0.517469 0.210175 1.436686 1.607383 0.066090 0.593136 0.482635 1.868920 1.291310 1.386910 1.029893 1.540100 1.084274 0.614905 1.153312 0.206651 0.588776 0.424148 1.780700 0.201677 -0.148794 1.539105 1.959298 0.153524 0.855868 1.263643 1.287920 -0.293735 0.438019 -0.206018 -0.356273 1.231052 1.001435 1.635849 1.476715 0.216231 -0.158631 0.753539 1.686606 0.980832 0.355756 0.168014 1.126044 0.500388 0.943877 0.638970 1.307633 0.790226 0.733504 0.595806 1.464991 1.037472 0.754676 0.719213 1.040414 0.002877 0.074104 1.737856 0.729741 0.862345 1.242108 1.321487 0.621750 1.011073 1.510125 0.085724 1.514690 -0.060524 0.938871 0.309540 0.743320 -0.211769 0.753436 0.803987 1.556267 1.083936 1.193072 1.598509 0.578392)
)
;;; 86 even --------------------------------------------------------------------------------
-(vector 86 12.791990425787 #(0 0 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 0 0 1 0 0 0 1 0 1 0 1 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 1 1 0 0 0 0 1 1 1 0 0)
+(vector 86 12.791990425787 #r(0 0 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 0 0 1 0 0 0 1 0 1 0 1 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 1 1 0 0 0 0 1 1 1 0 0)
- 9.804520 #(0.000000 0.137494 0.326172 0.010382 1.487613 0.505001 1.228062 0.954717 -0.127893 -0.290666 0.636565 1.325872 1.732483 0.567284 1.353499 0.704440 1.806655 1.469223 0.382393 0.706107 0.545460 0.307640 1.039546 0.875080 1.787391 0.105900 0.639604 0.989302 -0.045857 1.717167 1.835064 1.163334 0.033557 1.525348 0.510815 0.463389 0.777198 0.612036 1.665125 1.493136 0.475659 1.095674 1.296538 1.117478 0.603294 1.233039 0.344624 0.414746 0.337889 1.713708 0.141791 0.820548 1.699043 0.899800 0.803706 0.771637 1.413475 1.319088 1.268258 0.265658 0.770528 0.659195 0.900807 0.683986 1.290180 0.800356 1.418815 1.036184 1.201710 0.337696 1.582663 1.435772 0.606855 1.068190 0.540979 1.320205 -0.195129 0.714820 0.387530 0.040243 0.270436 -0.038662 1.702501 0.563408 0.676006 0.165316)
+ 9.804520 #r(0.000000 0.137494 0.326172 0.010382 1.487613 0.505001 1.228062 0.954717 -0.127893 -0.290666 0.636565 1.325872 1.732483 0.567284 1.353499 0.704440 1.806655 1.469223 0.382393 0.706107 0.545460 0.307640 1.039546 0.875080 1.787391 0.105900 0.639604 0.989302 -0.045857 1.717167 1.835064 1.163334 0.033557 1.525348 0.510815 0.463389 0.777198 0.612036 1.665125 1.493136 0.475659 1.095674 1.296538 1.117478 0.603294 1.233039 0.344624 0.414746 0.337889 1.713708 0.141791 0.820548 1.699043 0.899800 0.803706 0.771637 1.413475 1.319088 1.268258 0.265658 0.770528 0.659195 0.900807 0.683986 1.290180 0.800356 1.418815 1.036184 1.201710 0.337696 1.582663 1.435772 0.606855 1.068190 0.540979 1.320205 -0.195129 0.714820 0.387530 0.040243 0.270436 -0.038662 1.702501 0.563408 0.676006 0.165316)
;; nce:
- 9.779022 #(0.000000 0.012842 0.387371 0.019737 1.439011 0.434664 1.128389 0.730743 -0.150815 -0.440514 0.639771 1.390058 1.794981 0.621810 1.311431 0.767684 1.625416 1.570273 0.387894 0.736564 0.474233 0.261823 1.118332 0.820501 1.669010 0.015560 0.675733 0.978312 -0.064261 1.739844 1.817488 1.131007 0.062688 1.453390 0.448140 0.394070 0.831458 0.606366 1.363181 1.537589 0.426586 0.909340 1.240040 0.972834 0.683746 1.305881 0.259400 0.331948 0.295699 1.578329 0.042939 0.918607 1.689154 0.940724 1.007722 0.753380 1.536736 1.334795 1.258278 0.206096 0.883227 0.623082 0.840214 0.596829 1.277982 0.836896 1.407813 0.924493 1.193604 0.465208 1.513477 1.273116 0.679902 0.975579 0.664944 1.360910 -0.287799 0.710949 0.308010 -0.006577 0.020520 -0.156639 1.682660 0.621205 0.561199 0.080346)
+ 9.779022 #r(0.000000 0.012842 0.387371 0.019737 1.439011 0.434664 1.128389 0.730743 -0.150815 -0.440514 0.639771 1.390058 1.794981 0.621810 1.311431 0.767684 1.625416 1.570273 0.387894 0.736564 0.474233 0.261823 1.118332 0.820501 1.669010 0.015560 0.675733 0.978312 -0.064261 1.739844 1.817488 1.131007 0.062688 1.453390 0.448140 0.394070 0.831458 0.606366 1.363181 1.537589 0.426586 0.909340 1.240040 0.972834 0.683746 1.305881 0.259400 0.331948 0.295699 1.578329 0.042939 0.918607 1.689154 0.940724 1.007722 0.753380 1.536736 1.334795 1.258278 0.206096 0.883227 0.623082 0.840214 0.596829 1.277982 0.836896 1.407813 0.924493 1.193604 0.465208 1.513477 1.273116 0.679902 0.975579 0.664944 1.360910 -0.287799 0.710949 0.308010 -0.006577 0.020520 -0.156639 1.682660 0.621205 0.561199 0.080346)
)
;;; 87 even --------------------------------------------------------------------------------
-(vector 87 12.625063286678 #(0 0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 1 0 0 1 0 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0)
+(vector 87 12.625063286678 #r(0 0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 1 0 0 1 0 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0)
- 9.874660 #(0.000000 0.366900 0.585885 0.360276 1.741378 1.383744 0.806085 0.218985 1.748601 1.513484 1.913086 1.499231 1.804617 1.560415 0.976184 0.564077 0.614555 0.706893 1.155782 1.743949 0.256106 1.587276 1.479629 0.499900 0.621596 1.318438 0.505053 -0.000351 1.493931 0.351932 1.677582 1.117619 1.631442 0.001969 0.286212 0.372264 0.187053 0.296894 0.961309 0.849648 1.557109 1.714474 -0.039206 1.347988 1.896634 1.217858 1.504538 0.380552 0.871895 1.911392 0.768943 1.752782 0.535064 0.764217 0.468880 0.181130 0.490835 1.212121 1.451975 1.107304 0.551132 0.225217 0.930971 0.652946 1.821236 0.839189 1.745456 0.283826 1.910401 1.397382 1.626785 0.236815 0.165723 1.103589 1.501862 1.903299 0.205800 0.189795 0.285228 0.129502 1.654212 0.651262 -0.043737 0.438462 1.813853 0.852642 1.712123)
+ 9.874660 #r(0.000000 0.366900 0.585885 0.360276 1.741378 1.383744 0.806085 0.218985 1.748601 1.513484 1.913086 1.499231 1.804617 1.560415 0.976184 0.564077 0.614555 0.706893 1.155782 1.743949 0.256106 1.587276 1.479629 0.499900 0.621596 1.318438 0.505053 -0.000351 1.493931 0.351932 1.677582 1.117619 1.631442 0.001969 0.286212 0.372264 0.187053 0.296894 0.961309 0.849648 1.557109 1.714474 -0.039206 1.347988 1.896634 1.217858 1.504538 0.380552 0.871895 1.911392 0.768943 1.752782 0.535064 0.764217 0.468880 0.181130 0.490835 1.212121 1.451975 1.107304 0.551132 0.225217 0.930971 0.652946 1.821236 0.839189 1.745456 0.283826 1.910401 1.397382 1.626785 0.236815 0.165723 1.103589 1.501862 1.903299 0.205800 0.189795 0.285228 0.129502 1.654212 0.651262 -0.043737 0.438462 1.813853 0.852642 1.712123)
;; nce:
- 9.877641 #(0.000000 -0.021457 -0.332767 0.963844 -0.139669 1.122611 0.073163 0.865822 -0.025982 1.478876 1.300682 0.423658 0.322274 1.661211 0.500543 1.705512 1.176402 0.809437 0.981075 0.972708 1.087640 1.788381 1.486099 1.855937 1.496729 1.909818 0.429000 1.696291 0.561926 0.965567 -0.162109 0.839848 1.033495 0.899864 0.728978 0.135257 1.630992 1.197929 1.514698 0.814714 1.165293 0.851600 0.892043 1.519176 1.529996 0.381556 0.396698 0.783215 0.824621 1.214567 1.738938 0.263930 0.560204 0.335777 1.558427 0.771167 0.709316 1.002333 0.687389 -0.031156 0.967435 0.220860 0.392729 1.627417 0.223702 0.908693 1.299159 1.409401 0.619154 1.469733 -0.654637 1.678656 0.999708 1.410546 1.423816 1.288829 1.153651 0.643357 0.343990 1.755018 0.782145 1.521746 0.184384 0.116670 1.179413 -0.365261 0.035182)
+ 9.877641 #r(0.000000 -0.021457 -0.332767 0.963844 -0.139669 1.122611 0.073163 0.865822 -0.025982 1.478876 1.300682 0.423658 0.322274 1.661211 0.500543 1.705512 1.176402 0.809437 0.981075 0.972708 1.087640 1.788381 1.486099 1.855937 1.496729 1.909818 0.429000 1.696291 0.561926 0.965567 -0.162109 0.839848 1.033495 0.899864 0.728978 0.135257 1.630992 1.197929 1.514698 0.814714 1.165293 0.851600 0.892043 1.519176 1.529996 0.381556 0.396698 0.783215 0.824621 1.214567 1.738938 0.263930 0.560204 0.335777 1.558427 0.771167 0.709316 1.002333 0.687389 -0.031156 0.967435 0.220860 0.392729 1.627417 0.223702 0.908693 1.299159 1.409401 0.619154 1.469733 -0.654637 1.678656 0.999708 1.410546 1.423816 1.288829 1.153651 0.643357 0.343990 1.755018 0.782145 1.521746 0.184384 0.116670 1.179413 -0.365261 0.035182)
)
;;; 88 even --------------------------------------------------------------------------------
-(vector 88 12.661032846106 #(0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1)
+(vector 88 12.661032846106 #r(0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1)
;; ce:
- 9.812216 #(0.000000 0.055268 0.583779 1.234211 1.628798 0.277023 0.822779 1.625146 0.035507 0.649602 1.426919 0.034524 0.760555 1.584090 0.426236 1.297108 -0.064648 1.003285 1.954848 1.040940 1.931089 0.684474 1.457006 0.442932 1.400956 0.522371 1.821243 1.045778 -0.071524 1.059165 0.175444 1.376515 0.683418 0.093932 0.976929 0.065328 1.602577 1.185163 0.398809 1.873751 1.266959 0.334189 1.528861 1.254369 0.874420 0.121432 1.565807 1.331351 0.966676 0.377764 -0.254628 1.470234 1.160191 1.088192 0.680440 0.787715 0.046065 0.265716 -0.241611 1.809516 1.268665 1.177712 1.068293 0.934673 1.317512 0.907560 0.977837 0.781524 0.997530 0.958638 1.010309 1.152240 1.559668 1.510870 1.793541 0.022384 -0.034413 0.066685 0.419014 0.865510 1.381137 1.729658 1.950350 0.466719 0.747652 1.418392 1.765101 -0.161755)
+ 9.812216 #r(0.000000 0.055268 0.583779 1.234211 1.628798 0.277023 0.822779 1.625146 0.035507 0.649602 1.426919 0.034524 0.760555 1.584090 0.426236 1.297108 -0.064648 1.003285 1.954848 1.040940 1.931089 0.684474 1.457006 0.442932 1.400956 0.522371 1.821243 1.045778 -0.071524 1.059165 0.175444 1.376515 0.683418 0.093932 0.976929 0.065328 1.602577 1.185163 0.398809 1.873751 1.266959 0.334189 1.528861 1.254369 0.874420 0.121432 1.565807 1.331351 0.966676 0.377764 -0.254628 1.470234 1.160191 1.088192 0.680440 0.787715 0.046065 0.265716 -0.241611 1.809516 1.268665 1.177712 1.068293 0.934673 1.317512 0.907560 0.977837 0.781524 0.997530 0.958638 1.010309 1.152240 1.559668 1.510870 1.793541 0.022384 -0.034413 0.066685 0.419014 0.865510 1.381137 1.729658 1.950350 0.466719 0.747652 1.418392 1.765101 -0.161755)
)
;;; 89 even --------------------------------------------------------------------------------
-(vector 89 12.335865540187 #(0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 0 1 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 1)
+(vector 89 12.335865540187 #r(0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 0 1 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 1)
;; ce:
- 9.997916 #(0.000000 0.020244 0.870163 0.459782 1.610176 0.844000 1.631839 0.198513 0.309236 0.389591 1.266554 0.907717 1.601376 1.371297 1.457522 1.745042 1.476212 0.073975 0.814060 0.353740 0.627872 0.101452 1.077167 0.352892 0.063779 0.448255 0.216020 0.534427 1.535778 -0.255643 1.360537 0.276814 0.262932 1.399548 0.980210 0.702925 0.453704 0.501694 1.341730 0.007203 0.345436 0.837214 0.770776 -0.073243 0.532634 1.583256 0.698601 0.593928 1.599304 0.808070 1.440125 1.148274 0.114072 0.434799 -0.164129 1.193330 -0.269745 0.418138 1.192504 1.289901 0.986576 0.905136 0.005956 1.233570 1.751871 1.723660 1.197839 1.205999 1.118756 1.106261 1.003380 0.216161 0.037880 0.928786 0.755785 -0.278629 0.531970 0.188018 0.465858 1.197436 0.572455 1.090538 1.091674 0.532343 0.511453 1.688563 1.590718 0.571898 1.255870)
+ 9.997916 #r(0.000000 0.020244 0.870163 0.459782 1.610176 0.844000 1.631839 0.198513 0.309236 0.389591 1.266554 0.907717 1.601376 1.371297 1.457522 1.745042 1.476212 0.073975 0.814060 0.353740 0.627872 0.101452 1.077167 0.352892 0.063779 0.448255 0.216020 0.534427 1.535778 -0.255643 1.360537 0.276814 0.262932 1.399548 0.980210 0.702925 0.453704 0.501694 1.341730 0.007203 0.345436 0.837214 0.770776 -0.073243 0.532634 1.583256 0.698601 0.593928 1.599304 0.808070 1.440125 1.148274 0.114072 0.434799 -0.164129 1.193330 -0.269745 0.418138 1.192504 1.289901 0.986576 0.905136 0.005956 1.233570 1.751871 1.723660 1.197839 1.205999 1.118756 1.106261 1.003380 0.216161 0.037880 0.928786 0.755785 -0.278629 0.531970 0.188018 0.465858 1.197436 0.572455 1.090538 1.091674 0.532343 0.511453 1.688563 1.590718 0.571898 1.255870)
)
;;; 90 even --------------------------------------------------------------------------------
-(vector 90 12.716424196959 #(0 1 1 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 1 1 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 1 0)
+(vector 90 12.716424196959 #r(0 1 1 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 1 1 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 1 0)
;; ce:
- 10.013305 #(0.000000 0.276249 0.662327 1.808806 0.247081 1.503786 1.940324 0.419803 0.731998 1.474410 1.308170 1.676869 1.811609 1.215798 0.664610 0.066241 0.912393 1.461826 0.512334 1.631743 1.956766 1.975237 0.185753 0.741305 0.480828 1.966454 1.916940 1.119423 0.845500 1.620533 0.975449 0.450183 0.934883 1.109333 0.667354 1.305384 1.605133 1.189882 1.538095 1.240075 1.975310 0.162522 1.100171 1.036777 1.043788 0.744032 1.593875 0.517982 0.225081 0.407155 1.741456 1.796412 1.700950 0.367751 0.443832 0.733427 0.886793 0.217138 0.457578 1.931221 1.821137 1.223426 0.206884 1.785700 -0.026139 0.112791 0.288549 1.184345 0.406919 0.005051 0.510070 1.732554 1.458011 0.524459 1.130913 0.434368 0.819466 0.015795 0.021375 1.211968 0.985111 0.213416 0.003383 0.752814 1.988526 0.349626 0.383655 1.548554 0.699363 -0.001079)
+ 10.013305 #r(0.000000 0.276249 0.662327 1.808806 0.247081 1.503786 1.940324 0.419803 0.731998 1.474410 1.308170 1.676869 1.811609 1.215798 0.664610 0.066241 0.912393 1.461826 0.512334 1.631743 1.956766 1.975237 0.185753 0.741305 0.480828 1.966454 1.916940 1.119423 0.845500 1.620533 0.975449 0.450183 0.934883 1.109333 0.667354 1.305384 1.605133 1.189882 1.538095 1.240075 1.975310 0.162522 1.100171 1.036777 1.043788 0.744032 1.593875 0.517982 0.225081 0.407155 1.741456 1.796412 1.700950 0.367751 0.443832 0.733427 0.886793 0.217138 0.457578 1.931221 1.821137 1.223426 0.206884 1.785700 -0.026139 0.112791 0.288549 1.184345 0.406919 0.005051 0.510070 1.732554 1.458011 0.524459 1.130913 0.434368 0.819466 0.015795 0.021375 1.211968 0.985111 0.213416 0.003383 0.752814 1.988526 0.349626 0.383655 1.548554 0.699363 -0.001079)
)
;;; 91 even --------------------------------------------------------------------------------
-(vector 91 12.853587071592 #(0 0 0 1 1 0 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 0 1 1 0 1 1 1 0 1 0 0 1 1 1 0 1 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 0 1 0 1 0 0 1 1 1 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 0 0)
+(vector 91 12.853587071592 #r(0 0 0 1 1 0 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 0 1 1 0 1 1 1 0 1 0 0 1 1 1 0 1 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 0 1 0 1 0 0 1 1 1 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 0 0)
;; ce:
- 10.062777 #(0.000000 -0.044026 0.916183 1.049904 0.191738 0.191234 1.416236 1.067714 0.063138 1.147303 0.129837 0.429350 1.643604 1.587481 1.357034 0.252125 0.130779 1.268840 1.505767 0.040246 0.758000 0.845409 1.205711 0.041467 0.397400 0.371419 1.129085 1.761538 0.418123 -0.386013 -0.020991 1.418674 -0.227521 0.262381 1.257327 0.247702 0.200474 1.000030 0.059835 0.524653 0.278663 0.930707 1.291316 0.903105 1.153153 1.399218 1.175091 1.040190 0.853009 0.848960 0.050279 1.156146 0.310675 1.870226 0.711775 0.475029 1.761660 0.754317 0.936989 -0.122427 1.219572 0.099878 0.730317 0.306957 0.685890 1.871434 1.660611 0.509309 0.546923 0.432379 0.751420 0.579102 -0.249566 -0.007122 1.880100 1.723260 0.707224 -0.253994 0.741449 0.308553 0.722662 0.266964 1.454100 1.331867 1.250657 0.301803 0.242062 0.553976 0.852613 0.695715 0.487374)
+ 10.062777 #r(0.000000 -0.044026 0.916183 1.049904 0.191738 0.191234 1.416236 1.067714 0.063138 1.147303 0.129837 0.429350 1.643604 1.587481 1.357034 0.252125 0.130779 1.268840 1.505767 0.040246 0.758000 0.845409 1.205711 0.041467 0.397400 0.371419 1.129085 1.761538 0.418123 -0.386013 -0.020991 1.418674 -0.227521 0.262381 1.257327 0.247702 0.200474 1.000030 0.059835 0.524653 0.278663 0.930707 1.291316 0.903105 1.153153 1.399218 1.175091 1.040190 0.853009 0.848960 0.050279 1.156146 0.310675 1.870226 0.711775 0.475029 1.761660 0.754317 0.936989 -0.122427 1.219572 0.099878 0.730317 0.306957 0.685890 1.871434 1.660611 0.509309 0.546923 0.432379 0.751420 0.579102 -0.249566 -0.007122 1.880100 1.723260 0.707224 -0.253994 0.741449 0.308553 0.722662 0.266964 1.454100 1.331867 1.250657 0.301803 0.242062 0.553976 0.852613 0.695715 0.487374)
)
;;; 92 even --------------------------------------------------------------------------------
-(vector 92 12.754180011349 #(0 1 1 1 0 0 1 1 0 1 1 0 1 1 0 1 0 0 0 1 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 1 0 1 1 1 0)
+(vector 92 12.754180011349 #r(0 1 1 1 0 0 1 1 0 1 1 0 1 1 0 1 0 0 0 1 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 1 0 1 1 1 0)
;; ce:
- 10.123598 #(0.000000 0.031164 0.420530 1.499100 1.680395 0.704037 1.385766 1.730884 1.246618 0.630183 0.903224 0.818406 1.762884 0.926615 1.036829 0.514947 1.139487 1.191198 0.306323 0.126221 1.698783 1.815556 0.082954 0.421957 1.558085 -0.046639 0.629395 0.492462 0.620351 1.539766 0.337850 1.829874 -0.029044 1.650869 1.891900 -0.107840 0.000042 1.651572 0.308113 0.328220 0.164791 0.503391 1.668351 1.327181 0.552781 1.134137 0.130061 0.912409 -0.106533 1.117087 0.419486 1.645903 0.619628 0.903437 1.717082 0.277879 0.300313 -0.111169 1.701263 -0.282651 0.916960 1.725278 0.299760 0.206730 0.258427 0.976768 1.006419 1.405478 1.458477 0.511219 1.976132 0.649673 1.067569 1.036236 0.561892 1.032699 1.113462 1.760313 -0.031912 0.151642 1.253446 0.366329 -0.207662 1.411375 0.168281 1.402361 1.015831 0.966440 0.109303 1.719898 -0.033652 0.850348)
+ 10.123598 #r(0.000000 0.031164 0.420530 1.499100 1.680395 0.704037 1.385766 1.730884 1.246618 0.630183 0.903224 0.818406 1.762884 0.926615 1.036829 0.514947 1.139487 1.191198 0.306323 0.126221 1.698783 1.815556 0.082954 0.421957 1.558085 -0.046639 0.629395 0.492462 0.620351 1.539766 0.337850 1.829874 -0.029044 1.650869 1.891900 -0.107840 0.000042 1.651572 0.308113 0.328220 0.164791 0.503391 1.668351 1.327181 0.552781 1.134137 0.130061 0.912409 -0.106533 1.117087 0.419486 1.645903 0.619628 0.903437 1.717082 0.277879 0.300313 -0.111169 1.701263 -0.282651 0.916960 1.725278 0.299760 0.206730 0.258427 0.976768 1.006419 1.405478 1.458477 0.511219 1.976132 0.649673 1.067569 1.036236 0.561892 1.032699 1.113462 1.760313 -0.031912 0.151642 1.253446 0.366329 -0.207662 1.411375 0.168281 1.402361 1.015831 0.966440 0.109303 1.719898 -0.033652 0.850348)
)
;;; 93 even --------------------------------------------------------------------------------
-(vector 93 12.876626968384 #(0 0 0 1 1 0 0 0 0 1 0 1 1 1 1 1 0 1 0 1 0 0 0 0 0 1 0 1 1 1 0 0 0 1 1 1 0 0 1 1 0 0 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0)
+(vector 93 12.876626968384 #r(0 0 0 1 1 0 0 0 0 1 0 1 1 1 1 1 0 1 0 1 0 0 0 0 0 1 0 1 1 1 0 0 0 1 1 1 0 0 1 1 0 0 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0)
- 10.120779 #(0.000000 -0.035376 0.073991 0.427701 -0.282243 -0.018747 0.215658 -0.153445 1.426646 1.066559 1.939228 0.906624 0.410081 0.611941 0.984019 1.022397 0.624511 1.012954 0.533644 1.662254 0.644321 0.184706 0.621632 0.642800 -0.008009 1.949179 1.710653 -0.084032 0.277398 1.824022 0.699251 0.129968 1.020811 0.661971 1.702058 0.534563 1.888605 -0.287827 0.144583 1.379920 1.385073 1.054451 1.007433 0.338841 0.857467 1.489234 0.309837 0.300057 1.146999 0.772495 0.275152 0.667315 1.064213 0.727453 1.142263 1.118538 0.931092 1.595399 1.937578 1.220927 0.920538 0.541725 0.173459 0.580373 1.100745 1.191038 -0.340664 1.515332 1.223959 0.649170 0.846642 -0.414943 0.030223 1.461947 0.288064 0.141033 0.634411 1.011893 0.138288 1.584616 0.333385 0.901662 0.043826 0.951055 1.409243 0.569338 0.143517 0.644810 -0.103707 1.742249 0.748991 1.014192 0.003204)
+ 10.120779 #r(0.000000 -0.035376 0.073991 0.427701 -0.282243 -0.018747 0.215658 -0.153445 1.426646 1.066559 1.939228 0.906624 0.410081 0.611941 0.984019 1.022397 0.624511 1.012954 0.533644 1.662254 0.644321 0.184706 0.621632 0.642800 -0.008009 1.949179 1.710653 -0.084032 0.277398 1.824022 0.699251 0.129968 1.020811 0.661971 1.702058 0.534563 1.888605 -0.287827 0.144583 1.379920 1.385073 1.054451 1.007433 0.338841 0.857467 1.489234 0.309837 0.300057 1.146999 0.772495 0.275152 0.667315 1.064213 0.727453 1.142263 1.118538 0.931092 1.595399 1.937578 1.220927 0.920538 0.541725 0.173459 0.580373 1.100745 1.191038 -0.340664 1.515332 1.223959 0.649170 0.846642 -0.414943 0.030223 1.461947 0.288064 0.141033 0.634411 1.011893 0.138288 1.584616 0.333385 0.901662 0.043826 0.951055 1.409243 0.569338 0.143517 0.644810 -0.103707 1.742249 0.748991 1.014192 0.003204)
)
;;; 94 even --------------------------------------------------------------------------------
-(vector 94 12.991560374803 #(0 0 1 0 0 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 0 1 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 1 1 1 0 1 0 1 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 1 1 1)
+(vector 94 12.991560374803 #r(0 0 1 0 0 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 0 1 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 1 1 1 0 1 0 1 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 1 1 1)
;; ce:
- 10.168153 #(0.000000 0.158749 0.428472 1.119399 1.397485 1.337099 1.326309 0.765212 0.646549 0.366853 0.358406 0.186940 -0.004160 1.693556 1.760221 1.908281 -0.019516 0.044061 0.077064 0.115948 0.108699 0.200075 0.580690 0.574214 0.728439 1.050221 1.095053 1.499686 1.600782 1.705303 0.371346 0.785397 1.061620 1.118378 1.565155 0.180785 0.671073 0.956955 1.179900 0.062702 0.732776 1.104782 1.678100 1.936449 1.211526 1.440956 1.926880 0.701684 1.206989 0.357893 0.937759 1.642399 0.674496 1.095199 1.838835 0.811161 1.664081 0.728543 1.536793 0.935285 1.167394 0.592984 1.298896 0.711769 1.719531 0.207782 1.415604 0.678365 1.539785 1.187347 0.265338 1.410498 0.621725 1.553961 0.975230 0.124475 1.147511 0.723691 1.974302 1.764820 1.095390 0.083191 1.554760 0.873910 0.746004 0.060230 1.781492 1.338588 0.986007 0.875321 0.329252 1.786619 1.490792 0.801318)
+ 10.168153 #r(0.000000 0.158749 0.428472 1.119399 1.397485 1.337099 1.326309 0.765212 0.646549 0.366853 0.358406 0.186940 -0.004160 1.693556 1.760221 1.908281 -0.019516 0.044061 0.077064 0.115948 0.108699 0.200075 0.580690 0.574214 0.728439 1.050221 1.095053 1.499686 1.600782 1.705303 0.371346 0.785397 1.061620 1.118378 1.565155 0.180785 0.671073 0.956955 1.179900 0.062702 0.732776 1.104782 1.678100 1.936449 1.211526 1.440956 1.926880 0.701684 1.206989 0.357893 0.937759 1.642399 0.674496 1.095199 1.838835 0.811161 1.664081 0.728543 1.536793 0.935285 1.167394 0.592984 1.298896 0.711769 1.719531 0.207782 1.415604 0.678365 1.539785 1.187347 0.265338 1.410498 0.621725 1.553961 0.975230 0.124475 1.147511 0.723691 1.974302 1.764820 1.095390 0.083191 1.554760 0.873910 0.746004 0.060230 1.781492 1.338588 0.986007 0.875321 0.329252 1.786619 1.490792 0.801318)
)
;;; 95 even --------------------------------------------------------------------------------
-(vector 95 12.939489078295 #(0 0 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 1 0 1 1 0 1 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 1 0 0 1 0)
+(vector 95 12.939489078295 #r(0 0 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 1 0 1 1 0 1 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 1 0 0 1 0)
;; ce:
- 10.274816 #(0.000000 0.191955 0.747873 1.620627 1.444931 1.117449 0.280309 0.480520 1.626406 1.210786 1.123735 0.279148 1.110058 1.602457 1.869386 0.773421 1.408758 0.850581 0.528012 0.913946 0.482409 1.573182 0.994233 1.305292 1.545980 0.033608 1.905037 0.750852 0.522232 1.918658 0.047508 1.217238 0.972743 0.083444 0.371581 0.796063 1.083361 0.261908 1.433959 0.521900 0.192999 1.966737 0.129605 0.500888 0.331274 0.913857 0.815429 1.023459 0.478085 1.566987 1.222813 1.708572 1.719376 0.723585 1.103104 1.428438 0.152348 0.040494 1.696898 0.190236 1.378447 1.550950 1.870103 1.503205 0.324210 0.355888 1.476257 1.524550 1.168199 1.485278 1.191081 0.963527 1.662530 1.621072 0.604273 0.737525 1.817225 0.670588 1.938761 1.575766 0.221849 1.885601 1.971423 1.331586 0.219292 1.195712 0.125970 0.883030 0.146163 0.807704 1.769915 -0.019375 1.792299 1.733519 1.458753)
+ 10.274816 #r(0.000000 0.191955 0.747873 1.620627 1.444931 1.117449 0.280309 0.480520 1.626406 1.210786 1.123735 0.279148 1.110058 1.602457 1.869386 0.773421 1.408758 0.850581 0.528012 0.913946 0.482409 1.573182 0.994233 1.305292 1.545980 0.033608 1.905037 0.750852 0.522232 1.918658 0.047508 1.217238 0.972743 0.083444 0.371581 0.796063 1.083361 0.261908 1.433959 0.521900 0.192999 1.966737 0.129605 0.500888 0.331274 0.913857 0.815429 1.023459 0.478085 1.566987 1.222813 1.708572 1.719376 0.723585 1.103104 1.428438 0.152348 0.040494 1.696898 0.190236 1.378447 1.550950 1.870103 1.503205 0.324210 0.355888 1.476257 1.524550 1.168199 1.485278 1.191081 0.963527 1.662530 1.621072 0.604273 0.737525 1.817225 0.670588 1.938761 1.575766 0.221849 1.885601 1.971423 1.331586 0.219292 1.195712 0.125970 0.883030 0.146163 0.807704 1.769915 -0.019375 1.792299 1.733519 1.458753)
)
;;; 96 even --------------------------------------------------------------------------------
-(vector 96 13.077001047978 #(0 0 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 1)
+(vector 96 13.077001047978 #r(0 0 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 1)
;; ce:
- 10.249441 #(0.000000 0.009923 1.397522 1.166061 1.129381 0.862136 0.621841 0.072414 1.181071 0.867293 0.079004 1.693135 -0.014893 0.108345 1.780717 1.327197 1.625536 0.881623 1.921096 0.933503 1.182023 0.476766 1.614305 1.196403 0.811564 0.443720 1.497667 1.275176 0.722032 1.799828 1.704575 1.646983 1.348940 1.072546 0.729932 1.823713 0.260241 0.680766 1.080411 1.441731 1.246268 1.050406 0.336794 0.747049 0.875357 0.924454 1.579785 0.440504 0.667236 1.229671 0.158392 0.708858 1.967741 0.138461 0.274346 0.799091 1.692696 0.840214 1.597165 1.145148 1.181538 0.078566 1.784249 0.079340 0.404851 1.249515 0.162426 0.631488 1.171930 0.883287 1.256995 0.882531 0.425580 1.043774 0.166379 1.858551 0.915286 1.404785 1.287221 1.948447 1.096165 0.270960 1.267765 0.984855 1.705672 1.206954 1.635747 1.831700 1.675862 0.020775 1.394335 0.961664 1.111073 1.653261 0.221394 1.853173)
+ 10.249441 #r(0.000000 0.009923 1.397522 1.166061 1.129381 0.862136 0.621841 0.072414 1.181071 0.867293 0.079004 1.693135 -0.014893 0.108345 1.780717 1.327197 1.625536 0.881623 1.921096 0.933503 1.182023 0.476766 1.614305 1.196403 0.811564 0.443720 1.497667 1.275176 0.722032 1.799828 1.704575 1.646983 1.348940 1.072546 0.729932 1.823713 0.260241 0.680766 1.080411 1.441731 1.246268 1.050406 0.336794 0.747049 0.875357 0.924454 1.579785 0.440504 0.667236 1.229671 0.158392 0.708858 1.967741 0.138461 0.274346 0.799091 1.692696 0.840214 1.597165 1.145148 1.181538 0.078566 1.784249 0.079340 0.404851 1.249515 0.162426 0.631488 1.171930 0.883287 1.256995 0.882531 0.425580 1.043774 0.166379 1.858551 0.915286 1.404785 1.287221 1.948447 1.096165 0.270960 1.267765 0.984855 1.705672 1.206954 1.635747 1.831700 1.675862 0.020775 1.394335 0.961664 1.111073 1.653261 0.221394 1.853173)
)
;;; 97 even --------------------------------------------------------------------------------
-(vector 97 12.969611395004 #(0 0 0 0 0 1 1 0 0 1 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 0 0 0 1 1 0)
+(vector 97 12.969611395004 #r(0 0 0 0 0 1 1 0 0 1 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 0 0 0 1 1 0)
;; ce:
- 10.353915 #(0.000000 0.014320 1.699930 0.475338 0.327588 0.038537 1.537175 1.151125 1.532968 0.067981 0.615972 0.753995 1.850077 0.031584 -0.245176 0.175732 0.019153 0.133227 1.047045 1.449249 1.470511 1.537141 1.108379 0.638023 0.512045 -0.123137 1.442397 -0.285045 0.550401 0.725732 1.137347 0.384697 0.518421 0.107675 0.832943 1.779119 1.053524 1.101550 0.692043 0.797241 -0.542271 0.567053 0.702166 1.746525 1.756713 0.337727 1.446061 0.906449 1.109794 0.007168 1.480499 1.290329 0.754314 1.222669 -0.462191 1.087068 -0.251963 0.941593 1.663909 1.425711 -0.319978 0.693993 1.098604 -0.057825 0.103974 0.674596 -0.040855 0.861405 0.891647 0.007811 0.988956 -0.007355 1.453777 1.088127 0.560798 1.836913 1.159295 1.225761 1.137877 0.994253 -0.314791 0.194425 0.944400 0.940972 1.573317 1.084581 0.080135 1.392169 0.150957 -0.334184 0.271188 0.375796 0.741022 -0.072930 1.298672 1.087468 1.547582)
+ 10.353915 #r(0.000000 0.014320 1.699930 0.475338 0.327588 0.038537 1.537175 1.151125 1.532968 0.067981 0.615972 0.753995 1.850077 0.031584 -0.245176 0.175732 0.019153 0.133227 1.047045 1.449249 1.470511 1.537141 1.108379 0.638023 0.512045 -0.123137 1.442397 -0.285045 0.550401 0.725732 1.137347 0.384697 0.518421 0.107675 0.832943 1.779119 1.053524 1.101550 0.692043 0.797241 -0.542271 0.567053 0.702166 1.746525 1.756713 0.337727 1.446061 0.906449 1.109794 0.007168 1.480499 1.290329 0.754314 1.222669 -0.462191 1.087068 -0.251963 0.941593 1.663909 1.425711 -0.319978 0.693993 1.098604 -0.057825 0.103974 0.674596 -0.040855 0.861405 0.891647 0.007811 0.988956 -0.007355 1.453777 1.088127 0.560798 1.836913 1.159295 1.225761 1.137877 0.994253 -0.314791 0.194425 0.944400 0.940972 1.573317 1.084581 0.080135 1.392169 0.150957 -0.334184 0.271188 0.375796 0.741022 -0.072930 1.298672 1.087468 1.547582)
)
;;; 98 even --------------------------------------------------------------------------------
-(vector 98 13.468658765207 #(0 0 1 0 1 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 1 1 0 1)
+(vector 98 13.468658765207 #r(0 0 1 0 1 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 1 1 0 1)
;; ce:
- 10.480580 #(0.000000 0.029942 1.595740 0.929637 0.140250 1.273956 1.370085 1.486506 0.768736 0.810999 0.987699 0.622931 1.874848 1.232431 0.796670 -0.004456 1.530075 1.744503 -0.182347 -0.272539 -0.039867 0.251416 0.711006 1.684207 0.083442 1.563617 0.619745 1.154797 1.221621 1.412817 0.843588 0.857496 0.194384 1.348416 0.436247 0.378473 1.472625 0.199665 1.452604 1.135822 1.388047 0.919731 1.753351 0.083481 1.454770 1.242435 0.826611 -0.194897 -0.034005 0.041385 0.915233 0.468973 -0.449881 -0.034037 1.686105 0.937405 1.775189 1.272187 0.656772 0.051128 1.735808 1.941754 -0.153834 1.560953 0.798180 1.420628 1.100906 1.382273 0.014181 1.975964 0.450586 0.615591 0.885414 1.287826 0.533661 0.896633 1.605571 0.202012 1.330045 1.186911 0.653866 0.460432 0.799268 1.432588 0.419263 1.021867 0.188412 0.775135 0.208746 0.411264 0.553114 1.806129 0.584153 1.223473 0.816232 -0.069138 0.707217 1.215423)
+ 10.480580 #r(0.000000 0.029942 1.595740 0.929637 0.140250 1.273956 1.370085 1.486506 0.768736 0.810999 0.987699 0.622931 1.874848 1.232431 0.796670 -0.004456 1.530075 1.744503 -0.182347 -0.272539 -0.039867 0.251416 0.711006 1.684207 0.083442 1.563617 0.619745 1.154797 1.221621 1.412817 0.843588 0.857496 0.194384 1.348416 0.436247 0.378473 1.472625 0.199665 1.452604 1.135822 1.388047 0.919731 1.753351 0.083481 1.454770 1.242435 0.826611 -0.194897 -0.034005 0.041385 0.915233 0.468973 -0.449881 -0.034037 1.686105 0.937405 1.775189 1.272187 0.656772 0.051128 1.735808 1.941754 -0.153834 1.560953 0.798180 1.420628 1.100906 1.382273 0.014181 1.975964 0.450586 0.615591 0.885414 1.287826 0.533661 0.896633 1.605571 0.202012 1.330045 1.186911 0.653866 0.460432 0.799268 1.432588 0.419263 1.021867 0.188412 0.775135 0.208746 0.411264 0.553114 1.806129 0.584153 1.223473 0.816232 -0.069138 0.707217 1.215423)
)
;;; 99 even --------------------------------------------------------------------------------
-(vector 99 13.341398779709 #(0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 1)
+(vector 99 13.341398779709 #r(0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 1)
- 10.395229 #(0.000000 0.706072 1.286640 0.926913 0.137440 1.547226 0.117224 1.604362 0.484929 0.893678 0.211396 1.934935 1.381569 0.741431 1.002510 1.548591 1.501995 1.642732 0.386486 0.063170 0.535977 1.363015 0.485356 1.002502 1.149707 1.971779 0.610054 0.176963 1.296429 0.848185 0.077879 0.989380 0.162448 1.939484 1.081728 1.291006 1.781243 0.747318 1.861605 -0.003717 0.355879 1.413789 0.958311 0.004291 0.617108 1.378378 1.118347 1.632856 0.492813 0.823307 1.406872 1.588630 0.799940 0.218833 0.397527 1.627895 0.349077 0.557886 0.566534 1.362311 0.876480 1.822463 0.047284 1.726490 0.281473 1.360892 1.302327 0.630439 0.026319 0.398853 1.499306 1.696667 1.409746 0.843535 1.156093 0.782651 0.844572 0.996729 0.505075 0.454056 0.125470 0.633842 0.812248 1.139044 1.201855 0.936107 1.075661 1.055341 1.239337 1.081381 1.450660 0.544145 0.960193 1.261524 0.471575 0.159670 1.647942 0.617964 0.426032)
+ 10.395229 #r(0.000000 0.706072 1.286640 0.926913 0.137440 1.547226 0.117224 1.604362 0.484929 0.893678 0.211396 1.934935 1.381569 0.741431 1.002510 1.548591 1.501995 1.642732 0.386486 0.063170 0.535977 1.363015 0.485356 1.002502 1.149707 1.971779 0.610054 0.176963 1.296429 0.848185 0.077879 0.989380 0.162448 1.939484 1.081728 1.291006 1.781243 0.747318 1.861605 -0.003717 0.355879 1.413789 0.958311 0.004291 0.617108 1.378378 1.118347 1.632856 0.492813 0.823307 1.406872 1.588630 0.799940 0.218833 0.397527 1.627895 0.349077 0.557886 0.566534 1.362311 0.876480 1.822463 0.047284 1.726490 0.281473 1.360892 1.302327 0.630439 0.026319 0.398853 1.499306 1.696667 1.409746 0.843535 1.156093 0.782651 0.844572 0.996729 0.505075 0.454056 0.125470 0.633842 0.812248 1.139044 1.201855 0.936107 1.075661 1.055341 1.239337 1.081381 1.450660 0.544145 0.960193 1.261524 0.471575 0.159670 1.647942 0.617964 0.426032)
)
;;; 100 even --------------------------------------------------------------------------------
-(vector 100 13.512077331543 #(0 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 0 1 1 0 1 1 1 1 1 0 1 1 1 0 1 1 1 1 0 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 0 0 1 0 1 0 0 0 0 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 0 0)
+(vector 100 13.512077331543 #r(0 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 0 1 1 0 1 1 1 1 1 0 1 1 1 0 1 1 1 1 0 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 0 0 1 0 1 0 0 0 0 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 0 0)
- 10.472141 #(0.000000 -0.079327 0.575962 1.216890 -0.014744 1.794579 0.223351 1.035736 1.450027 1.621511 1.146130 0.664482 0.663607 -0.266960 0.246822 0.754872 1.746592 -0.423496 -0.112090 1.668859 1.661047 0.950742 0.085504 0.302466 1.790192 0.512158 1.549763 -0.087872 1.606339 1.457814 0.979132 1.246348 1.572286 1.270907 0.557192 1.282392 0.773062 0.627296 0.449140 1.192929 0.105994 0.224683 -0.182519 0.743965 0.463017 1.607410 -0.217575 1.706348 1.917272 0.364576 0.425823 0.089107 1.477241 0.882347 1.143269 0.061661 0.026397 0.093540 1.833116 0.100956 -0.001875 0.084325 0.282798 1.183349 0.971365 0.306714 1.553029 0.062053 0.155585 0.754942 -0.336663 0.692895 0.554870 1.705080 0.442045 1.319460 0.995119 1.023180 1.734006 0.775241 1.099502 1.819778 -0.446034 1.513278 1.247469 0.530165 0.247921 1.473754 1.799924 0.292965 1.840516 0.908343 1.781887 1.143210 0.571911 1.546526 0.744154 1.261450 1.702101 1.407355)
+ 10.472141 #r(0.000000 -0.079327 0.575962 1.216890 -0.014744 1.794579 0.223351 1.035736 1.450027 1.621511 1.146130 0.664482 0.663607 -0.266960 0.246822 0.754872 1.746592 -0.423496 -0.112090 1.668859 1.661047 0.950742 0.085504 0.302466 1.790192 0.512158 1.549763 -0.087872 1.606339 1.457814 0.979132 1.246348 1.572286 1.270907 0.557192 1.282392 0.773062 0.627296 0.449140 1.192929 0.105994 0.224683 -0.182519 0.743965 0.463017 1.607410 -0.217575 1.706348 1.917272 0.364576 0.425823 0.089107 1.477241 0.882347 1.143269 0.061661 0.026397 0.093540 1.833116 0.100956 -0.001875 0.084325 0.282798 1.183349 0.971365 0.306714 1.553029 0.062053 0.155585 0.754942 -0.336663 0.692895 0.554870 1.705080 0.442045 1.319460 0.995119 1.023180 1.734006 0.775241 1.099502 1.819778 -0.446034 1.513278 1.247469 0.530165 0.247921 1.473754 1.799924 0.292965 1.840516 0.908343 1.781887 1.143210 0.571911 1.546526 0.744154 1.261450 1.702101 1.407355)
)
;;; 101 even --------------------------------------------------------------------------------
-(vector 101 13.916260357992 #(0 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 0 1 0 0 0 1 0 0 1 0 1 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 1 0 1 0 1 1 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1)
+(vector 101 13.916260357992 #r(0 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 0 1 0 0 0 1 0 0 1 0 1 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 1 0 1 0 1 1 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1)
;; ce:
- 10.577830 #(0.000000 0.230088 0.489949 1.896308 0.933068 0.593501 0.422308 0.060228 1.624707 0.198599 1.858938 1.074760 1.176893 0.981397 1.101455 0.671865 0.424692 0.090154 1.204682 1.678470 1.838266 0.024568 0.595975 1.448081 0.084971 1.587793 0.520717 0.874796 1.272960 1.935410 1.267081 1.651444 1.443667 0.106075 1.743028 0.700933 0.469120 0.378892 0.399951 0.519935 1.685545 1.698426 0.785883 0.473603 0.884326 1.731208 1.464294 1.924822 0.636901 0.305356 0.801079 1.744433 1.003951 0.836001 0.264502 0.624042 1.251558 0.465073 1.095465 1.359393 1.201558 0.893610 0.464655 0.265401 1.373759 1.898225 1.761890 -0.002084 1.345698 1.606225 0.081343 1.615987 1.843685 0.952555 0.240683 1.457724 0.753500 1.550264 1.132929 0.635603 1.553592 1.597112 0.562720 1.442901 1.005554 1.242061 1.201605 1.261095 1.477713 0.348336 0.005918 1.590197 0.313622 0.668027 1.281558 1.857136 1.788055 0.849243 1.615883 0.119440 1.251097)
+ 10.577830 #r(0.000000 0.230088 0.489949 1.896308 0.933068 0.593501 0.422308 0.060228 1.624707 0.198599 1.858938 1.074760 1.176893 0.981397 1.101455 0.671865 0.424692 0.090154 1.204682 1.678470 1.838266 0.024568 0.595975 1.448081 0.084971 1.587793 0.520717 0.874796 1.272960 1.935410 1.267081 1.651444 1.443667 0.106075 1.743028 0.700933 0.469120 0.378892 0.399951 0.519935 1.685545 1.698426 0.785883 0.473603 0.884326 1.731208 1.464294 1.924822 0.636901 0.305356 0.801079 1.744433 1.003951 0.836001 0.264502 0.624042 1.251558 0.465073 1.095465 1.359393 1.201558 0.893610 0.464655 0.265401 1.373759 1.898225 1.761890 -0.002084 1.345698 1.606225 0.081343 1.615987 1.843685 0.952555 0.240683 1.457724 0.753500 1.550264 1.132929 0.635603 1.553592 1.597112 0.562720 1.442901 1.005554 1.242061 1.201605 1.261095 1.477713 0.348336 0.005918 1.590197 0.313622 0.668027 1.281558 1.857136 1.788055 0.849243 1.615883 0.119440 1.251097)
)
;;; 102 even --------------------------------------------------------------------------------
-(vector 102 13.554303556646 #(0 0 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 1 0 0 1 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 0 1 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 1 0 1 1 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0)
+(vector 102 13.554303556646 #r(0 0 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 1 0 0 1 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 0 1 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 1 0 1 1 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0)
;; ce:
- 10.573986 #(0.000000 0.455448 1.592339 0.516746 1.755302 0.430730 1.719525 0.951344 -0.011584 1.094962 0.249269 1.210204 0.681046 1.814999 1.100181 0.342805 1.598301 0.973279 1.813912 1.543187 1.213360 0.476019 1.876128 1.338406 0.323141 0.086213 1.782029 1.276211 0.922086 0.263981 1.923412 1.289879 0.951410 0.707896 0.012549 1.851646 1.630674 1.384243 1.051926 0.762336 0.305766 0.298705 1.874016 1.899771 1.620966 1.734952 1.429925 1.177184 1.271518 1.112585 1.351310 1.169594 1.017169 1.072042 1.161752 0.892462 1.662674 1.237843 1.407508 1.778309 1.632181 -0.005924 0.137286 0.529299 0.602002 0.855550 1.115330 1.528193 1.708150 1.986964 0.217781 0.770088 1.353099 1.819055 0.042966 0.583719 0.854932 1.780394 1.890656 0.692898 1.277125 1.902467 0.022802 0.892858 1.554169 0.132068 0.918216 1.832708 0.149377 0.742587 1.856221 0.273349 1.013342 0.114623 0.855957 1.713909 0.875532 1.432041 0.715192 1.022773 0.307135 1.424286)
+ 10.573986 #r(0.000000 0.455448 1.592339 0.516746 1.755302 0.430730 1.719525 0.951344 -0.011584 1.094962 0.249269 1.210204 0.681046 1.814999 1.100181 0.342805 1.598301 0.973279 1.813912 1.543187 1.213360 0.476019 1.876128 1.338406 0.323141 0.086213 1.782029 1.276211 0.922086 0.263981 1.923412 1.289879 0.951410 0.707896 0.012549 1.851646 1.630674 1.384243 1.051926 0.762336 0.305766 0.298705 1.874016 1.899771 1.620966 1.734952 1.429925 1.177184 1.271518 1.112585 1.351310 1.169594 1.017169 1.072042 1.161752 0.892462 1.662674 1.237843 1.407508 1.778309 1.632181 -0.005924 0.137286 0.529299 0.602002 0.855550 1.115330 1.528193 1.708150 1.986964 0.217781 0.770088 1.353099 1.819055 0.042966 0.583719 0.854932 1.780394 1.890656 0.692898 1.277125 1.902467 0.022802 0.892858 1.554169 0.132068 0.918216 1.832708 0.149377 0.742587 1.856221 0.273349 1.013342 0.114623 0.855957 1.713909 0.875532 1.432041 0.715192 1.022773 0.307135 1.424286)
)
;;; 103 even --------------------------------------------------------------------------------
-(vector 103 13.923377530893 #(0 1 0 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0 0 0 0 1 0 1 0)
+(vector 103 13.923377530893 #r(0 1 0 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0 0 0 0 1 0 1 0)
;; ce:
- 10.655070 #(0.000000 0.098203 0.840876 1.375107 0.153742 0.905827 1.598049 0.226902 1.106387 1.951313 0.409173 1.416206 0.300008 0.991894 1.877024 0.769923 1.633937 0.581083 1.464525 0.440302 1.508923 0.447643 1.643543 0.650572 1.662974 0.812624 0.114340 1.320550 0.512587 1.607339 0.712150 1.624256 0.673697 0.132515 1.684625 1.034157 0.294350 1.413417 0.670789 0.070085 1.514860 0.928557 0.150294 1.635889 1.040664 0.560013 0.195302 1.710399 1.367615 1.043173 0.402177 1.662716 1.456941 1.147051 0.985707 0.632104 0.408799 0.275068 1.862616 1.424547 1.082981 1.090416 0.822477 0.915783 0.592819 0.610365 0.257982 0.450718 0.126885 0.491389 0.133294 0.376246 0.118720 0.195423 1.887844 0.645109 0.531798 0.762689 0.732490 0.998025 0.912568 1.060467 1.162384 1.198622 1.637406 0.207879 0.126974 0.580167 0.848976 1.222343 1.532632 1.780660 0.095903 0.581413 1.052384 1.441822 1.990917 0.734482 1.101269 1.710370 0.157742 0.650375 1.262955)
+ 10.655070 #r(0.000000 0.098203 0.840876 1.375107 0.153742 0.905827 1.598049 0.226902 1.106387 1.951313 0.409173 1.416206 0.300008 0.991894 1.877024 0.769923 1.633937 0.581083 1.464525 0.440302 1.508923 0.447643 1.643543 0.650572 1.662974 0.812624 0.114340 1.320550 0.512587 1.607339 0.712150 1.624256 0.673697 0.132515 1.684625 1.034157 0.294350 1.413417 0.670789 0.070085 1.514860 0.928557 0.150294 1.635889 1.040664 0.560013 0.195302 1.710399 1.367615 1.043173 0.402177 1.662716 1.456941 1.147051 0.985707 0.632104 0.408799 0.275068 1.862616 1.424547 1.082981 1.090416 0.822477 0.915783 0.592819 0.610365 0.257982 0.450718 0.126885 0.491389 0.133294 0.376246 0.118720 0.195423 1.887844 0.645109 0.531798 0.762689 0.732490 0.998025 0.912568 1.060467 1.162384 1.198622 1.637406 0.207879 0.126974 0.580167 0.848976 1.222343 1.532632 1.780660 0.095903 0.581413 1.052384 1.441822 1.990917 0.734482 1.101269 1.710370 0.157742 0.650375 1.262955)
)
;;; 104 even --------------------------------------------------------------------------------
-(vector 104 14.080453047533 #(0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1 0 0 1 0 0 0 0 1 1 1 1 0 0 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 1 1 1 1 1 1 1)
+(vector 104 14.080453047533 #r(0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1 0 0 1 0 0 0 0 1 1 1 1 0 0 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 1 1 1 1 1 1 1)
;; ce:
- 10.681525 #(0.000000 -0.024256 0.783678 0.790357 0.543059 0.305361 -0.134503 0.818664 1.525254 0.494738 0.824462 0.413278 0.768548 0.076204 0.116598 0.283930 0.002578 1.585676 1.025319 1.696095 0.040592 0.097252 1.464874 0.943760 1.446445 1.337085 -0.054264 0.475515 1.125978 1.147471 1.094995 0.186610 0.588805 0.970144 0.882957 0.245963 0.284357 -0.394290 1.437271 0.927960 1.125343 0.492129 -0.680606 0.536491 0.927855 1.405256 0.384789 0.057902 1.208331 0.288662 1.508156 1.581082 1.167052 1.243667 1.226450 0.112600 1.111908 1.348016 0.638821 1.169461 0.306222 1.466381 0.659007 1.306085 1.700156 1.339421 0.711646 0.085484 0.909896 -0.178331 1.447928 0.767489 1.399367 -0.197416 1.574394 0.605814 -0.011981 -0.082006 0.824364 0.264841 1.418643 0.988277 -0.314078 0.146715 0.221811 0.630751 0.576546 0.496630 0.654974 1.143866 1.326186 1.202136 1.173988 0.681397 1.563605 0.912110 1.479070 0.009348 0.151736 0.948455 0.251873 0.215256 0.959463 1.013975)
+ 10.681525 #r(0.000000 -0.024256 0.783678 0.790357 0.543059 0.305361 -0.134503 0.818664 1.525254 0.494738 0.824462 0.413278 0.768548 0.076204 0.116598 0.283930 0.002578 1.585676 1.025319 1.696095 0.040592 0.097252 1.464874 0.943760 1.446445 1.337085 -0.054264 0.475515 1.125978 1.147471 1.094995 0.186610 0.588805 0.970144 0.882957 0.245963 0.284357 -0.394290 1.437271 0.927960 1.125343 0.492129 -0.680606 0.536491 0.927855 1.405256 0.384789 0.057902 1.208331 0.288662 1.508156 1.581082 1.167052 1.243667 1.226450 0.112600 1.111908 1.348016 0.638821 1.169461 0.306222 1.466381 0.659007 1.306085 1.700156 1.339421 0.711646 0.085484 0.909896 -0.178331 1.447928 0.767489 1.399367 -0.197416 1.574394 0.605814 -0.011981 -0.082006 0.824364 0.264841 1.418643 0.988277 -0.314078 0.146715 0.221811 0.630751 0.576546 0.496630 0.654974 1.143866 1.326186 1.202136 1.173988 0.681397 1.563605 0.912110 1.479070 0.009348 0.151736 0.948455 0.251873 0.215256 0.959463 1.013975)
)
;;; 105 even --------------------------------------------------------------------------------
-(vector 105 14.023490699521 #(0 1 1 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 0 1 1 1 0 1 1 1 1 1 0 0 0 1 0 1 0 0 0 1 1 0 0 0 0 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 1 1 0 0 0 1 1 0 1 1 1 0 0)
+(vector 105 14.023490699521 #r(0 1 1 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 0 1 1 1 0 1 1 1 1 1 0 0 0 1 0 1 0 0 0 1 1 0 0 0 0 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 1 1 0 0 0 1 1 0 1 1 1 0 0)
;; ce:
- 10.762178 #(0.000000 0.397875 0.415370 0.882172 0.546824 1.353988 1.428323 0.899356 0.371635 0.978504 0.763060 1.852147 0.544169 0.212342 0.787152 0.707632 0.540670 1.634630 1.456913 1.887455 0.659515 1.903305 1.487136 0.606049 0.181640 0.198532 0.870626 0.299967 1.007267 0.225649 1.806738 0.672311 0.647212 0.706876 1.445160 0.654294 0.635429 0.365790 0.507155 0.852393 0.362305 0.862000 0.544259 1.758526 1.506465 1.313083 0.892464 0.407338 1.550831 0.757533 1.555137 -0.026848 1.155141 1.305207 1.788542 1.889285 0.358766 1.027604 0.314507 0.587817 0.916345 0.200487 1.411080 1.048840 1.178903 0.194143 1.901728 1.960301 1.945844 1.173118 1.765984 0.206171 1.625946 0.040059 1.626954 0.263952 1.564387 1.266244 1.622196 0.755369 0.949828 0.255858 0.753659 1.729344 1.050369 1.743664 1.440420 0.145640 0.301718 1.174665 0.822890 1.317300 1.570892 0.407998 0.956005 1.432600 0.239369 0.699233 1.040355 0.955730 0.525379 0.245609 0.402988 1.983561 1.494957)
+ 10.762178 #r(0.000000 0.397875 0.415370 0.882172 0.546824 1.353988 1.428323 0.899356 0.371635 0.978504 0.763060 1.852147 0.544169 0.212342 0.787152 0.707632 0.540670 1.634630 1.456913 1.887455 0.659515 1.903305 1.487136 0.606049 0.181640 0.198532 0.870626 0.299967 1.007267 0.225649 1.806738 0.672311 0.647212 0.706876 1.445160 0.654294 0.635429 0.365790 0.507155 0.852393 0.362305 0.862000 0.544259 1.758526 1.506465 1.313083 0.892464 0.407338 1.550831 0.757533 1.555137 -0.026848 1.155141 1.305207 1.788542 1.889285 0.358766 1.027604 0.314507 0.587817 0.916345 0.200487 1.411080 1.048840 1.178903 0.194143 1.901728 1.960301 1.945844 1.173118 1.765984 0.206171 1.625946 0.040059 1.626954 0.263952 1.564387 1.266244 1.622196 0.755369 0.949828 0.255858 0.753659 1.729344 1.050369 1.743664 1.440420 0.145640 0.301718 1.174665 0.822890 1.317300 1.570892 0.407998 0.956005 1.432600 0.239369 0.699233 1.040355 0.955730 0.525379 0.245609 0.402988 1.983561 1.494957)
)
;;; 106 even --------------------------------------------------------------------------------
-(vector 106 14.077123010357 #(0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 1)
+(vector 106 14.077123010357 #r(0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 1)
;; ce:
- 10.830737 #(0.000000 -0.005846 0.570672 0.234799 1.335287 1.359588 -0.419716 0.539638 0.608529 0.339921 1.061903 -0.158242 -0.044398 1.229716 1.763841 1.099423 1.509512 0.089726 1.005316 -0.075124 -0.066461 1.466196 0.771111 0.468552 1.415804 0.138963 -0.245805 0.138836 0.477088 1.188902 1.132158 1.069838 1.264025 0.968611 1.914288 1.097597 1.541915 0.300326 1.372837 1.925102 1.312271 -0.023238 1.373743 1.323233 1.094484 0.489712 0.482163 1.087861 0.500643 0.570320 1.558451 0.587192 1.367163 1.157295 0.201827 0.338548 0.589886 0.627255 0.836138 0.810466 -0.203530 1.496837 1.317835 0.258851 0.104005 1.762383 1.590637 1.892947 1.673713 0.391886 0.132951 1.390857 1.679677 1.113406 0.925816 1.243522 0.395898 -0.235350 0.125786 0.071751 0.796497 -0.006564 0.517719 0.324240 -0.029479 1.648460 0.422894 0.173347 0.366226 -0.269652 0.667311 0.224137 1.099578 1.062306 -0.039311 0.586541 0.652636 1.087861 0.037847 0.544588 -0.167470 1.665629 0.356235 0.598705 1.690854 1.284152)
+ 10.830737 #r(0.000000 -0.005846 0.570672 0.234799 1.335287 1.359588 -0.419716 0.539638 0.608529 0.339921 1.061903 -0.158242 -0.044398 1.229716 1.763841 1.099423 1.509512 0.089726 1.005316 -0.075124 -0.066461 1.466196 0.771111 0.468552 1.415804 0.138963 -0.245805 0.138836 0.477088 1.188902 1.132158 1.069838 1.264025 0.968611 1.914288 1.097597 1.541915 0.300326 1.372837 1.925102 1.312271 -0.023238 1.373743 1.323233 1.094484 0.489712 0.482163 1.087861 0.500643 0.570320 1.558451 0.587192 1.367163 1.157295 0.201827 0.338548 0.589886 0.627255 0.836138 0.810466 -0.203530 1.496837 1.317835 0.258851 0.104005 1.762383 1.590637 1.892947 1.673713 0.391886 0.132951 1.390857 1.679677 1.113406 0.925816 1.243522 0.395898 -0.235350 0.125786 0.071751 0.796497 -0.006564 0.517719 0.324240 -0.029479 1.648460 0.422894 0.173347 0.366226 -0.269652 0.667311 0.224137 1.099578 1.062306 -0.039311 0.586541 0.652636 1.087861 0.037847 0.544588 -0.167470 1.665629 0.356235 0.598705 1.690854 1.284152)
)
;;; 107 even --------------------------------------------------------------------------------
-(vector 107 13.979104817741 #(0 0 0 1 0 1 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1)
+(vector 107 13.979104817741 #r(0 0 0 1 0 1 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1)
;; ce:
- 10.937211 #(0.000000 -0.004224 0.060024 -0.045111 1.214471 1.071129 0.959468 -0.117229 0.526421 0.777989 1.101830 1.594870 1.129631 1.240597 0.114410 -0.015477 -0.160025 1.227190 0.975588 0.257050 0.062807 0.334972 0.704097 1.491576 0.263834 0.840227 0.134041 0.515784 0.095610 1.204429 1.214110 -0.209995 0.542934 1.280779 0.060334 1.305652 0.399609 0.055093 1.015156 -0.124325 0.060155 1.228735 0.771913 1.621598 0.808853 1.471209 -0.169978 1.121641 0.399914 1.719441 0.379423 1.503274 1.042517 0.685780 0.947470 0.570388 0.750717 1.227614 1.713741 0.574606 1.613832 0.259018 1.237457 1.030851 1.608948 1.331324 0.222275 1.365789 1.141241 0.137043 0.400610 0.136266 1.777801 -0.008027 -0.188345 0.319469 0.129091 -0.503698 1.075061 0.022495 -0.104170 1.746336 1.362807 0.487726 1.046216 1.025881 -0.113705 0.257262 0.139668 0.033537 0.410121 0.067540 0.536883 1.096402 0.595602 1.418336 1.800057 0.344577 0.240890 1.498996 -0.357281 0.342654 1.655013 1.372406 1.308709 -0.240755 1.334030)
+ 10.937211 #r(0.000000 -0.004224 0.060024 -0.045111 1.214471 1.071129 0.959468 -0.117229 0.526421 0.777989 1.101830 1.594870 1.129631 1.240597 0.114410 -0.015477 -0.160025 1.227190 0.975588 0.257050 0.062807 0.334972 0.704097 1.491576 0.263834 0.840227 0.134041 0.515784 0.095610 1.204429 1.214110 -0.209995 0.542934 1.280779 0.060334 1.305652 0.399609 0.055093 1.015156 -0.124325 0.060155 1.228735 0.771913 1.621598 0.808853 1.471209 -0.169978 1.121641 0.399914 1.719441 0.379423 1.503274 1.042517 0.685780 0.947470 0.570388 0.750717 1.227614 1.713741 0.574606 1.613832 0.259018 1.237457 1.030851 1.608948 1.331324 0.222275 1.365789 1.141241 0.137043 0.400610 0.136266 1.777801 -0.008027 -0.188345 0.319469 0.129091 -0.503698 1.075061 0.022495 -0.104170 1.746336 1.362807 0.487726 1.046216 1.025881 -0.113705 0.257262 0.139668 0.033537 0.410121 0.067540 0.536883 1.096402 0.595602 1.418336 1.800057 0.344577 0.240890 1.498996 -0.357281 0.342654 1.655013 1.372406 1.308709 -0.240755 1.334030)
)
;;; 108 even --------------------------------------------------------------------------------
-(vector 108 14.201394892821 #(0 0 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1)
+(vector 108 14.201394892821 #r(0 0 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1)
;; ce:
- 10.928835 #(0.000000 0.001349 1.292491 0.733848 1.693309 1.799399 0.481169 -0.003953 0.631395 1.556718 0.747743 0.394608 -0.163614 0.178289 1.389719 1.500511 0.566775 1.069628 0.140033 0.292869 1.057556 -0.232775 1.757479 1.152928 0.313785 -0.002063 1.713110 1.409517 1.701701 0.540017 -0.081333 0.363976 1.907649 1.714406 0.366131 1.312522 1.061649 -0.016307 1.204902 0.111229 1.131127 1.599963 0.195405 0.048689 0.148454 1.536192 1.518659 0.029237 0.220432 0.060747 0.889494 0.493752 0.976299 1.363602 1.809211 1.216107 0.616567 0.927578 1.398521 0.961300 1.194676 0.366929 1.180567 1.477072 0.270916 0.119650 1.287137 1.475762 1.163703 1.481070 1.371759 0.541244 1.311014 1.044588 1.313660 0.533979 1.490951 0.356285 -0.069909 0.767914 0.271739 0.014710 1.682385 0.162634 1.095329 0.775810 0.661086 0.068467 1.450209 1.785189 0.063589 1.966358 1.523081 1.437414 0.274911 0.580082 1.089239 -0.463689 1.664646 1.305111 1.466902 1.475663 0.556905 0.115271 0.981770 0.504641 0.709948 1.631495)
+ 10.928835 #r(0.000000 0.001349 1.292491 0.733848 1.693309 1.799399 0.481169 -0.003953 0.631395 1.556718 0.747743 0.394608 -0.163614 0.178289 1.389719 1.500511 0.566775 1.069628 0.140033 0.292869 1.057556 -0.232775 1.757479 1.152928 0.313785 -0.002063 1.713110 1.409517 1.701701 0.540017 -0.081333 0.363976 1.907649 1.714406 0.366131 1.312522 1.061649 -0.016307 1.204902 0.111229 1.131127 1.599963 0.195405 0.048689 0.148454 1.536192 1.518659 0.029237 0.220432 0.060747 0.889494 0.493752 0.976299 1.363602 1.809211 1.216107 0.616567 0.927578 1.398521 0.961300 1.194676 0.366929 1.180567 1.477072 0.270916 0.119650 1.287137 1.475762 1.163703 1.481070 1.371759 0.541244 1.311014 1.044588 1.313660 0.533979 1.490951 0.356285 -0.069909 0.767914 0.271739 0.014710 1.682385 0.162634 1.095329 0.775810 0.661086 0.068467 1.450209 1.785189 0.063589 1.966358 1.523081 1.437414 0.274911 0.580082 1.089239 -0.463689 1.664646 1.305111 1.466902 1.475663 0.556905 0.115271 0.981770 0.504641 0.709948 1.631495)
)
;;; 109 even --------------------------------------------------------------------------------
-(vector 109 14.476561866583 #(0 1 0 1 0 1 0 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 1 1 1 1 0 1 1 1)
+(vector 109 14.476561866583 #r(0 1 0 1 0 1 0 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 1 1 1 1 0 1 1 1)
;; ce:
- 10.962218 #(0.000000 -0.020139 1.296818 0.759398 1.805908 1.100728 0.800122 1.439412 1.622620 0.514993 1.795449 1.209391 0.020235 0.358160 0.092111 0.419753 0.215041 0.890857 0.739133 0.655070 -0.097603 1.149145 1.795049 0.529356 0.278854 0.849651 1.115508 -0.203443 -0.316571 0.636461 0.169404 0.863285 1.244658 0.826671 1.217995 1.641136 1.077104 1.940135 -0.019991 0.361800 0.684590 0.618864 1.574258 0.100541 0.539464 1.815288 0.854878 0.087950 0.096927 0.551713 0.357857 0.524099 0.322958 1.655523 1.025258 0.447127 1.801347 0.241837 1.863980 1.144261 1.218309 0.839437 0.457453 0.658738 1.245153 1.083988 0.663284 0.430502 0.960078 0.132118 0.667264 0.423888 1.801298 1.342075 0.136707 0.381362 0.568108 1.442671 0.522741 -0.163023 0.297994 0.902549 1.034272 0.408426 0.838530 1.491663 1.889043 0.510513 1.243885 -0.037162 0.829406 0.263055 1.957688 1.777764 1.532407 1.532356 -0.098135 1.343701 -0.090007 1.030266 0.540482 0.697946 0.058406 0.051557 1.224797 1.605931 1.084281 1.340523 0.856409)
+ 10.962218 #r(0.000000 -0.020139 1.296818 0.759398 1.805908 1.100728 0.800122 1.439412 1.622620 0.514993 1.795449 1.209391 0.020235 0.358160 0.092111 0.419753 0.215041 0.890857 0.739133 0.655070 -0.097603 1.149145 1.795049 0.529356 0.278854 0.849651 1.115508 -0.203443 -0.316571 0.636461 0.169404 0.863285 1.244658 0.826671 1.217995 1.641136 1.077104 1.940135 -0.019991 0.361800 0.684590 0.618864 1.574258 0.100541 0.539464 1.815288 0.854878 0.087950 0.096927 0.551713 0.357857 0.524099 0.322958 1.655523 1.025258 0.447127 1.801347 0.241837 1.863980 1.144261 1.218309 0.839437 0.457453 0.658738 1.245153 1.083988 0.663284 0.430502 0.960078 0.132118 0.667264 0.423888 1.801298 1.342075 0.136707 0.381362 0.568108 1.442671 0.522741 -0.163023 0.297994 0.902549 1.034272 0.408426 0.838530 1.491663 1.889043 0.510513 1.243885 -0.037162 0.829406 0.263055 1.957688 1.777764 1.532407 1.532356 -0.098135 1.343701 -0.090007 1.030266 0.540482 0.697946 0.058406 0.051557 1.224797 1.605931 1.084281 1.340523 0.856409)
)
;;; 110 even --------------------------------------------------------------------------------
-(vector 110 14.141825477743 #(0 0 0 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0)
+(vector 110 14.141825477743 #r(0 0 0 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0)
;; ce:
- 11.083621 #(0.000000 0.102224 0.391557 0.595597 0.594876 1.372717 0.692712 1.820557 0.592991 0.744933 0.284097 0.094534 1.236489 0.656692 0.836105 1.286301 1.045083 0.906213 0.452242 1.303365 1.815972 0.742162 1.260200 1.034689 1.519277 1.714910 0.030360 1.701396 0.878133 1.252260 1.563515 1.824493 1.440884 0.550691 0.625323 0.322441 0.255155 1.747348 1.715563 1.206982 0.695445 1.179481 0.756077 1.528329 0.919865 1.229029 1.159425 1.320573 0.445003 1.914934 0.957065 0.751755 0.916124 0.636546 1.677594 1.368208 1.478534 0.887675 1.827907 0.505854 0.598384 0.760342 0.616916 0.235984 0.997501 1.394766 0.145444 0.892122 1.825648 1.436307 0.231097 0.844561 0.320584 0.655075 0.450233 0.147790 1.886750 0.073198 0.684099 0.980548 1.422263 1.230129 0.607855 1.708107 1.670067 1.087055 1.809960 1.108445 0.779703 1.445375 0.004959 0.570411 1.025881 0.429647 0.658700 0.663819 0.227169 1.057047 0.056802 0.087954 1.060399 1.762629 1.235596 0.276822 0.266842 1.518690 1.130656 0.442538 0.924181 1.667970)
+ 11.083621 #r(0.000000 0.102224 0.391557 0.595597 0.594876 1.372717 0.692712 1.820557 0.592991 0.744933 0.284097 0.094534 1.236489 0.656692 0.836105 1.286301 1.045083 0.906213 0.452242 1.303365 1.815972 0.742162 1.260200 1.034689 1.519277 1.714910 0.030360 1.701396 0.878133 1.252260 1.563515 1.824493 1.440884 0.550691 0.625323 0.322441 0.255155 1.747348 1.715563 1.206982 0.695445 1.179481 0.756077 1.528329 0.919865 1.229029 1.159425 1.320573 0.445003 1.914934 0.957065 0.751755 0.916124 0.636546 1.677594 1.368208 1.478534 0.887675 1.827907 0.505854 0.598384 0.760342 0.616916 0.235984 0.997501 1.394766 0.145444 0.892122 1.825648 1.436307 0.231097 0.844561 0.320584 0.655075 0.450233 0.147790 1.886750 0.073198 0.684099 0.980548 1.422263 1.230129 0.607855 1.708107 1.670067 1.087055 1.809960 1.108445 0.779703 1.445375 0.004959 0.570411 1.025881 0.429647 0.658700 0.663819 0.227169 1.057047 0.056802 0.087954 1.060399 1.762629 1.235596 0.276822 0.266842 1.518690 1.130656 0.442538 0.924181 1.667970)
)
;;; 111 even --------------------------------------------------------------------------------
-(vector 111 14.043108609984 #(0 1 1 0 0 1 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 1 0 1 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 1 1 1 1 1 0 1 1 1 1 0 1)
+(vector 111 14.043108609984 #r(0 1 1 0 0 1 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 1 0 1 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 1 1 1 1 1 0 1 1 1 1 0 1)
;; ce:
- 11.044285 #(0.000000 0.158015 0.933037 1.614942 0.438728 1.109662 1.925788 0.472812 1.243741 0.106020 0.791740 1.640176 0.492268 1.485008 0.348988 1.215620 0.210371 0.907594 1.877045 0.815828 1.746879 0.708997 1.883211 1.043991 0.199639 1.074067 0.180622 1.253869 0.348260 1.556554 0.806309 0.044157 1.125294 0.382590 1.810361 1.146217 0.335649 1.611965 0.680338 1.937389 1.233789 0.766403 0.308709 1.641326 0.874950 0.294876 0.039653 1.398544 0.690400 0.241248 1.690671 1.329862 0.933824 0.621841 0.215994 1.901023 1.430062 1.233607 0.739730 0.472666 0.123106 0.067252 1.738994 1.459373 1.478846 1.201845 1.291598 0.805256 0.526423 0.555011 0.429805 0.468900 0.550665 0.287845 0.418385 0.091842 0.561234 0.306326 0.551107 0.349285 0.443927 0.497444 0.741730 0.889477 1.210808 1.343091 1.439025 1.479999 1.836181 0.047632 0.373687 0.550415 0.777036 1.388872 1.698564 0.091159 0.463192 0.987707 1.050209 1.564941 1.953806 0.531885 1.227608 1.522869 0.053791 0.776531 1.501133 1.889970 0.686171 0.911252 1.640718)
+ 11.044285 #r(0.000000 0.158015 0.933037 1.614942 0.438728 1.109662 1.925788 0.472812 1.243741 0.106020 0.791740 1.640176 0.492268 1.485008 0.348988 1.215620 0.210371 0.907594 1.877045 0.815828 1.746879 0.708997 1.883211 1.043991 0.199639 1.074067 0.180622 1.253869 0.348260 1.556554 0.806309 0.044157 1.125294 0.382590 1.810361 1.146217 0.335649 1.611965 0.680338 1.937389 1.233789 0.766403 0.308709 1.641326 0.874950 0.294876 0.039653 1.398544 0.690400 0.241248 1.690671 1.329862 0.933824 0.621841 0.215994 1.901023 1.430062 1.233607 0.739730 0.472666 0.123106 0.067252 1.738994 1.459373 1.478846 1.201845 1.291598 0.805256 0.526423 0.555011 0.429805 0.468900 0.550665 0.287845 0.418385 0.091842 0.561234 0.306326 0.551107 0.349285 0.443927 0.497444 0.741730 0.889477 1.210808 1.343091 1.439025 1.479999 1.836181 0.047632 0.373687 0.550415 0.777036 1.388872 1.698564 0.091159 0.463192 0.987707 1.050209 1.564941 1.953806 0.531885 1.227608 1.522869 0.053791 0.776531 1.501133 1.889970 0.686171 0.911252 1.640718)
)
;;; 112 even --------------------------------------------------------------------------------
-(vector 112 14.53456401825 #(0 0 0 1 0 0 0 1 1 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 0 0 0 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 1 1 1 0 0 1 1 0 0 1)
+(vector 112 14.53456401825 #r(0 0 0 1 0 0 0 1 1 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 0 0 0 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 1 1 1 0 0 1 1 0 0 1)
;; ce:
- 11.132899 #(0.000000 -0.004199 1.283910 0.989370 -0.208623 1.916334 0.074521 1.835438 1.334006 0.305929 1.500009 -0.074494 1.168847 0.049877 1.276892 1.333761 -0.092116 1.454810 0.477624 0.576171 0.178508 0.764025 0.524952 1.017918 1.503303 0.222438 0.024354 0.989207 -0.051649 0.790422 1.303684 -0.215343 0.911639 1.672316 0.816315 1.393173 1.438934 1.325167 0.960271 0.472591 1.161764 -0.301446 0.550621 1.114416 1.344136 1.489640 1.336572 0.050968 0.500820 -0.057732 1.192684 1.166393 1.318354 1.292569 1.273498 0.099165 0.438587 1.952651 -0.094274 1.629010 1.153422 1.621198 0.812392 0.958180 1.035359 0.874583 0.398809 1.397735 0.813120 1.083168 1.586479 1.738041 -0.184237 0.887045 0.555348 1.573618 0.841883 0.094362 0.127164 -0.091421 0.370018 0.132149 0.004963 0.522483 0.330656 0.374322 1.610332 1.059431 0.769509 1.653723 0.151945 1.881470 1.251612 1.570585 0.545409 0.439130 1.754244 0.242385 1.453705 1.649898 0.928413 0.488588 1.234024 -0.316648 1.499904 0.614604 0.329349 1.231718 0.063978 0.324984 0.806167 0.116728)
+ 11.132899 #r(0.000000 -0.004199 1.283910 0.989370 -0.208623 1.916334 0.074521 1.835438 1.334006 0.305929 1.500009 -0.074494 1.168847 0.049877 1.276892 1.333761 -0.092116 1.454810 0.477624 0.576171 0.178508 0.764025 0.524952 1.017918 1.503303 0.222438 0.024354 0.989207 -0.051649 0.790422 1.303684 -0.215343 0.911639 1.672316 0.816315 1.393173 1.438934 1.325167 0.960271 0.472591 1.161764 -0.301446 0.550621 1.114416 1.344136 1.489640 1.336572 0.050968 0.500820 -0.057732 1.192684 1.166393 1.318354 1.292569 1.273498 0.099165 0.438587 1.952651 -0.094274 1.629010 1.153422 1.621198 0.812392 0.958180 1.035359 0.874583 0.398809 1.397735 0.813120 1.083168 1.586479 1.738041 -0.184237 0.887045 0.555348 1.573618 0.841883 0.094362 0.127164 -0.091421 0.370018 0.132149 0.004963 0.522483 0.330656 0.374322 1.610332 1.059431 0.769509 1.653723 0.151945 1.881470 1.251612 1.570585 0.545409 0.439130 1.754244 0.242385 1.453705 1.649898 0.928413 0.488588 1.234024 -0.316648 1.499904 0.614604 0.329349 1.231718 0.063978 0.324984 0.806167 0.116728)
)
;;; 113 even --------------------------------------------------------------------------------
-(vector 113 14.699631659332 #(0 0 1 1 0 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0)
+(vector 113 14.699631659332 #r(0 0 1 1 0 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0)
;; ce:
- 11.086230 #(0.000000 -0.000389 -0.085077 1.561730 0.939636 0.783800 0.822356 0.753902 1.063386 1.064106 0.248945 -0.331235 0.891273 0.384236 1.666476 1.209055 0.747827 1.261264 0.977109 0.473018 1.869842 1.640635 0.426272 0.493282 0.533612 0.678013 0.886344 1.278452 0.240683 0.355081 0.485535 1.773399 1.825457 0.749792 0.520365 0.198490 0.250957 0.893317 0.038147 1.767495 1.585752 1.382949 0.153130 0.345263 1.470526 1.544311 -0.012268 0.353892 0.265833 0.472828 0.199271 0.570776 0.068734 -0.052674 -0.058660 0.544786 0.747249 1.268098 -0.214510 0.394163 0.864637 0.802715 -0.354031 0.495687 0.772508 0.500088 0.648134 0.893273 0.437351 0.101751 1.505344 1.430317 1.237725 -0.133160 1.737117 0.276904 0.819294 -0.436692 0.255417 1.171282 -0.127128 0.741289 1.135948 0.224854 1.189320 1.263745 1.436981 1.094323 0.315920 0.551659 -0.076936 0.988425 0.147044 1.117725 1.898145 1.201889 0.000719 0.311682 0.796660 0.441683 0.674490 1.525693 0.432480 -0.261252 0.793197 1.692433 1.264116 1.229766 1.345051 1.012949 0.026436 1.326999 0.385241)
+ 11.086230 #r(0.000000 -0.000389 -0.085077 1.561730 0.939636 0.783800 0.822356 0.753902 1.063386 1.064106 0.248945 -0.331235 0.891273 0.384236 1.666476 1.209055 0.747827 1.261264 0.977109 0.473018 1.869842 1.640635 0.426272 0.493282 0.533612 0.678013 0.886344 1.278452 0.240683 0.355081 0.485535 1.773399 1.825457 0.749792 0.520365 0.198490 0.250957 0.893317 0.038147 1.767495 1.585752 1.382949 0.153130 0.345263 1.470526 1.544311 -0.012268 0.353892 0.265833 0.472828 0.199271 0.570776 0.068734 -0.052674 -0.058660 0.544786 0.747249 1.268098 -0.214510 0.394163 0.864637 0.802715 -0.354031 0.495687 0.772508 0.500088 0.648134 0.893273 0.437351 0.101751 1.505344 1.430317 1.237725 -0.133160 1.737117 0.276904 0.819294 -0.436692 0.255417 1.171282 -0.127128 0.741289 1.135948 0.224854 1.189320 1.263745 1.436981 1.094323 0.315920 0.551659 -0.076936 0.988425 0.147044 1.117725 1.898145 1.201889 0.000719 0.311682 0.796660 0.441683 0.674490 1.525693 0.432480 -0.261252 0.793197 1.692433 1.264116 1.229766 1.345051 1.012949 0.026436 1.326999 0.385241)
)
;;; 114 even --------------------------------------------------------------------------------
-(vector 114 14.492 #(0 1 0 1 0 1 0 0 1 0 0 0 1 0 0 1 1 0 1 1 0 0 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 1 0 1 0 1 0 0 0 0 0 1)
+(vector 114 14.492 #r(0 1 0 1 0 1 0 0 1 0 0 0 1 0 0 1 1 0 1 1 0 0 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 1 0 1 0 1 0 0 0 0 0 1)
;; ce:
- 11.157135 #(0.000000 -0.039464 0.696620 1.049808 1.784392 0.325544 0.858380 1.305402 0.025713 0.621307 1.231983 1.810377 0.686152 1.384942 0.194646 1.038532 1.591698 0.399402 1.138014 1.856685 0.607032 1.487902 0.438056 1.390980 0.254957 1.178058 0.067020 0.938265 1.875276 0.851076 0.004242 1.047055 0.045055 1.007007 0.277254 1.473760 0.430329 1.411705 0.732780 1.815871 0.875020 0.057294 1.303464 0.776395 0.029104 1.052938 0.330119 1.901182 1.233681 0.357134 1.566517 1.090726 0.497634 1.859625 1.337968 0.810851 0.475823 1.810735 1.275081 0.613201 0.249187 1.680606 1.475238 0.917317 0.615081 0.035115 1.985536 1.555790 1.295493 0.711316 0.674571 0.194958 0.031526 1.689053 1.752486 1.376552 1.332463 1.199628 1.038471 0.887824 0.776195 0.244582 0.396901 0.380408 0.272363 0.437965 0.462200 0.460243 0.479976 0.174041 0.442325 0.587458 0.662414 0.624435 0.793505 1.270764 1.312001 1.527872 1.906728 0.154209 0.367925 0.274540 0.568448 0.741643 1.347518 1.802398 -0.015484 0.528377 1.078486 1.236948 1.800583 0.083771 0.530926 0.938750)
+ 11.157135 #r(0.000000 -0.039464 0.696620 1.049808 1.784392 0.325544 0.858380 1.305402 0.025713 0.621307 1.231983 1.810377 0.686152 1.384942 0.194646 1.038532 1.591698 0.399402 1.138014 1.856685 0.607032 1.487902 0.438056 1.390980 0.254957 1.178058 0.067020 0.938265 1.875276 0.851076 0.004242 1.047055 0.045055 1.007007 0.277254 1.473760 0.430329 1.411705 0.732780 1.815871 0.875020 0.057294 1.303464 0.776395 0.029104 1.052938 0.330119 1.901182 1.233681 0.357134 1.566517 1.090726 0.497634 1.859625 1.337968 0.810851 0.475823 1.810735 1.275081 0.613201 0.249187 1.680606 1.475238 0.917317 0.615081 0.035115 1.985536 1.555790 1.295493 0.711316 0.674571 0.194958 0.031526 1.689053 1.752486 1.376552 1.332463 1.199628 1.038471 0.887824 0.776195 0.244582 0.396901 0.380408 0.272363 0.437965 0.462200 0.460243 0.479976 0.174041 0.442325 0.587458 0.662414 0.624435 0.793505 1.270764 1.312001 1.527872 1.906728 0.154209 0.367925 0.274540 0.568448 0.741643 1.347518 1.802398 -0.015484 0.528377 1.078486 1.236948 1.800583 0.083771 0.530926 0.938750)
)
;;; 115 even --------------------------------------------------------------------------------
-(vector 115 14.568 #(0 1 0 1 0 0 1 1 0 1 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 1 0 0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1)
+(vector 115 14.568 #r(0 1 0 1 0 0 1 1 0 1 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 1 0 0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1)
;; ce:
- 11.164043 #(0.000000 -0.007735 0.519521 0.853408 0.869518 0.698179 0.507264 1.931615 0.907177 -0.081980 1.081445 -0.614824 0.113202 -0.200689 1.235563 -0.410618 -0.044424 1.664294 0.004420 -0.047758 -0.084756 0.183149 0.916469 0.869368 0.512976 0.672797 1.215314 0.375058 0.915864 1.704866 0.936574 0.218869 0.698296 0.045271 1.628914 0.078964 0.149407 0.338531 0.117882 -0.320994 1.491596 1.006019 -0.240429 1.202447 1.241878 1.751514 1.720285 0.676992 -0.221839 1.582392 1.209034 1.838537 0.581983 1.407446 0.568243 0.270174 1.675976 1.382944 1.186838 0.261842 1.726931 1.658063 1.186047 0.622126 0.744214 1.106115 1.040724 0.077608 1.153074 1.203757 -0.097198 0.746254 0.828552 0.000738 0.431630 0.964545 1.375943 1.286789 1.299809 0.427471 1.340955 0.754972 1.408156 0.094923 0.222079 1.183606 -0.446708 1.549043 0.356824 0.090057 -0.448761 1.856851 1.141144 -0.262172 1.428502 1.426364 0.962275 0.289782 0.928089 1.983331 -0.130528 1.708026 0.141800 0.998440 0.458314 -0.400945 1.256766 -0.158747 1.393865 0.122714 0.409705 1.066166 0.512662 1.368814 -0.157203)
+ 11.164043 #r(0.000000 -0.007735 0.519521 0.853408 0.869518 0.698179 0.507264 1.931615 0.907177 -0.081980 1.081445 -0.614824 0.113202 -0.200689 1.235563 -0.410618 -0.044424 1.664294 0.004420 -0.047758 -0.084756 0.183149 0.916469 0.869368 0.512976 0.672797 1.215314 0.375058 0.915864 1.704866 0.936574 0.218869 0.698296 0.045271 1.628914 0.078964 0.149407 0.338531 0.117882 -0.320994 1.491596 1.006019 -0.240429 1.202447 1.241878 1.751514 1.720285 0.676992 -0.221839 1.582392 1.209034 1.838537 0.581983 1.407446 0.568243 0.270174 1.675976 1.382944 1.186838 0.261842 1.726931 1.658063 1.186047 0.622126 0.744214 1.106115 1.040724 0.077608 1.153074 1.203757 -0.097198 0.746254 0.828552 0.000738 0.431630 0.964545 1.375943 1.286789 1.299809 0.427471 1.340955 0.754972 1.408156 0.094923 0.222079 1.183606 -0.446708 1.549043 0.356824 0.090057 -0.448761 1.856851 1.141144 -0.262172 1.428502 1.426364 0.962275 0.289782 0.928089 1.983331 -0.130528 1.708026 0.141800 0.998440 0.458314 -0.400945 1.256766 -0.158747 1.393865 0.122714 0.409705 1.066166 0.512662 1.368814 -0.157203)
)
;;; 116 even --------------------------------------------------------------------------------
-(vector 116 15.016979484255 #(0 0 0 1 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 1 0 1 0 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 1 0 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 0 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 1 1 1)
+(vector 116 15.016979484255 #r(0 0 0 1 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 1 0 1 0 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 1 0 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 0 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 1 1 1)
;; ce:
- 11.308873 #(0.000000 0.106229 0.367548 0.759703 1.450113 0.465588 0.341776 1.222993 1.113540 1.977777 0.446611 1.479153 0.955230 1.992164 0.113898 1.375014 0.059260 1.796441 0.549529 1.451646 0.822821 0.184153 0.830995 0.917449 1.204323 1.332702 0.993172 0.476637 0.152682 0.285363 1.211807 1.922965 1.934074 0.639385 1.616893 0.230624 1.048187 1.300335 1.518811 0.179696 1.385435 1.756315 0.391503 1.071522 1.058267 0.918446 1.149703 1.296773 1.452377 0.657106 1.424678 0.536336 1.485981 1.611780 0.685035 0.081570 0.627797 1.372075 1.222404 1.169964 1.598122 0.868152 1.372826 0.969303 1.586861 1.193094 0.604224 0.998617 0.464449 0.148345 1.841878 1.782198 1.348866 0.090916 1.094752 0.710300 0.820593 1.392694 1.514436 0.049760 1.558012 1.165815 1.487314 0.076812 1.896177 1.104849 0.595775 1.855654 1.593410 0.247419 1.353710 0.594589 0.610661 1.819899 0.938600 0.733465 1.567730 0.600698 0.773170 0.184194 0.659368 0.319562 0.537696 0.610429 1.447619 1.265473 0.841708 1.485819 0.127545 1.328769 1.079928 0.763531 0.772097 1.829006 1.877480 1.871926)
+ 11.308873 #r(0.000000 0.106229 0.367548 0.759703 1.450113 0.465588 0.341776 1.222993 1.113540 1.977777 0.446611 1.479153 0.955230 1.992164 0.113898 1.375014 0.059260 1.796441 0.549529 1.451646 0.822821 0.184153 0.830995 0.917449 1.204323 1.332702 0.993172 0.476637 0.152682 0.285363 1.211807 1.922965 1.934074 0.639385 1.616893 0.230624 1.048187 1.300335 1.518811 0.179696 1.385435 1.756315 0.391503 1.071522 1.058267 0.918446 1.149703 1.296773 1.452377 0.657106 1.424678 0.536336 1.485981 1.611780 0.685035 0.081570 0.627797 1.372075 1.222404 1.169964 1.598122 0.868152 1.372826 0.969303 1.586861 1.193094 0.604224 0.998617 0.464449 0.148345 1.841878 1.782198 1.348866 0.090916 1.094752 0.710300 0.820593 1.392694 1.514436 0.049760 1.558012 1.165815 1.487314 0.076812 1.896177 1.104849 0.595775 1.855654 1.593410 0.247419 1.353710 0.594589 0.610661 1.819899 0.938600 0.733465 1.567730 0.600698 0.773170 0.184194 0.659368 0.319562 0.537696 0.610429 1.447619 1.265473 0.841708 1.485819 0.127545 1.328769 1.079928 0.763531 0.772097 1.829006 1.877480 1.871926)
)
;;; 117 even --------------------------------------------------------------------------------
-(vector 117 14.875072951405 #(0 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 0 0 1 1 0 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 0 1 0 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 1 0)
+(vector 117 14.875072951405 #r(0 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 0 0 1 1 0 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 0 1 0 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 1 0)
;; ce:
- 11.316924 #(0.000000 0.002007 0.781183 0.142859 1.136983 0.564897 1.668822 1.434278 0.786253 -0.066154 0.611443 0.995393 0.251112 1.435273 1.364551 0.525535 1.314966 0.129127 0.479417 1.253995 -0.066213 1.791978 1.010496 1.762957 1.001915 0.214345 0.247689 0.903489 0.260750 0.253476 1.207167 1.205379 1.535712 0.678624 0.281388 0.707771 0.067718 0.139190 1.072777 -0.486251 1.036395 0.468802 1.185352 1.038535 0.280173 0.909530 -0.484113 1.287468 1.260568 1.711487 0.150804 1.583879 0.090810 1.204628 1.205628 1.363904 1.302202 -0.374153 1.893817 1.633143 0.456452 1.096868 0.228741 1.451713 1.797254 1.457252 0.043295 1.213733 1.209057 1.602790 0.068325 1.156775 0.622551 0.595184 1.038306 1.138842 -0.234118 1.017885 1.021316 0.185827 1.543882 1.771287 1.232077 0.638733 0.782279 1.727494 1.416897 0.927851 0.310771 0.940398 0.359593 0.479087 0.049395 0.127472 0.206640 1.096147 1.150359 1.659289 0.531691 1.180395 -0.391853 1.508862 1.232699 -0.058238 1.293947 -0.476640 -0.441677 -0.000097 0.976133 1.008107 0.426436 0.349033 0.468049 0.890361 0.742074 -0.282223 0.097574)
+ 11.316924 #r(0.000000 0.002007 0.781183 0.142859 1.136983 0.564897 1.668822 1.434278 0.786253 -0.066154 0.611443 0.995393 0.251112 1.435273 1.364551 0.525535 1.314966 0.129127 0.479417 1.253995 -0.066213 1.791978 1.010496 1.762957 1.001915 0.214345 0.247689 0.903489 0.260750 0.253476 1.207167 1.205379 1.535712 0.678624 0.281388 0.707771 0.067718 0.139190 1.072777 -0.486251 1.036395 0.468802 1.185352 1.038535 0.280173 0.909530 -0.484113 1.287468 1.260568 1.711487 0.150804 1.583879 0.090810 1.204628 1.205628 1.363904 1.302202 -0.374153 1.893817 1.633143 0.456452 1.096868 0.228741 1.451713 1.797254 1.457252 0.043295 1.213733 1.209057 1.602790 0.068325 1.156775 0.622551 0.595184 1.038306 1.138842 -0.234118 1.017885 1.021316 0.185827 1.543882 1.771287 1.232077 0.638733 0.782279 1.727494 1.416897 0.927851 0.310771 0.940398 0.359593 0.479087 0.049395 0.127472 0.206640 1.096147 1.150359 1.659289 0.531691 1.180395 -0.391853 1.508862 1.232699 -0.058238 1.293947 -0.476640 -0.441677 -0.000097 0.976133 1.008107 0.426436 0.349033 0.468049 0.890361 0.742074 -0.282223 0.097574)
)
;;; 118 even --------------------------------------------------------------------------------
-(vector 118 14.774983755641 #(0 1 1 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 1 0 0 1 0 0 1 1 0 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 1 1 1 1 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1)
+(vector 118 14.774983755641 #r(0 1 1 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 1 0 0 1 0 0 1 1 0 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 1 1 1 1 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1)
;; ce:
- 11.484440 #(0.000000 0.001991 1.371443 1.203612 1.612576 0.004093 1.549674 1.288096 -0.387029 0.195003 0.810853 0.270601 -0.577973 0.504742 1.563436 0.486759 1.262262 1.570710 0.506761 0.593681 0.979316 0.335707 1.012168 1.408672 1.854537 -0.158648 0.922395 1.542523 0.986042 0.834203 1.587297 -0.259646 0.182780 1.551059 1.155567 -0.257572 1.455112 0.260440 0.601953 0.584384 0.049890 0.147201 0.144045 0.167346 1.932438 -0.017361 0.127366 1.610439 0.342924 0.013626 1.817380 1.463720 1.349166 1.704788 0.073700 0.915288 0.862503 0.591911 -0.314143 1.485517 0.827715 -0.237036 1.912130 0.274385 1.072007 0.283372 1.321692 0.776602 1.550269 0.993130 0.787661 0.571393 0.826289 1.556852 0.493665 1.623055 1.585319 1.166393 1.153368 1.675993 0.390711 -0.188185 1.283768 1.613360 0.827291 0.287448 0.106800 0.359659 1.804631 1.116403 1.085383 0.798175 1.148482 1.482094 1.397430 -0.132223 0.799212 -0.083458 -0.185498 0.780581 -0.264041 0.816859 1.276724 0.301164 1.464050 0.647926 1.027415 1.036757 -0.070219 0.009504 1.202438 0.566235 0.360100 -0.509218 0.735525 1.198215 0.064044 0.933335)
+ 11.484440 #r(0.000000 0.001991 1.371443 1.203612 1.612576 0.004093 1.549674 1.288096 -0.387029 0.195003 0.810853 0.270601 -0.577973 0.504742 1.563436 0.486759 1.262262 1.570710 0.506761 0.593681 0.979316 0.335707 1.012168 1.408672 1.854537 -0.158648 0.922395 1.542523 0.986042 0.834203 1.587297 -0.259646 0.182780 1.551059 1.155567 -0.257572 1.455112 0.260440 0.601953 0.584384 0.049890 0.147201 0.144045 0.167346 1.932438 -0.017361 0.127366 1.610439 0.342924 0.013626 1.817380 1.463720 1.349166 1.704788 0.073700 0.915288 0.862503 0.591911 -0.314143 1.485517 0.827715 -0.237036 1.912130 0.274385 1.072007 0.283372 1.321692 0.776602 1.550269 0.993130 0.787661 0.571393 0.826289 1.556852 0.493665 1.623055 1.585319 1.166393 1.153368 1.675993 0.390711 -0.188185 1.283768 1.613360 0.827291 0.287448 0.106800 0.359659 1.804631 1.116403 1.085383 0.798175 1.148482 1.482094 1.397430 -0.132223 0.799212 -0.083458 -0.185498 0.780581 -0.264041 0.816859 1.276724 0.301164 1.464050 0.647926 1.027415 1.036757 -0.070219 0.009504 1.202438 0.566235 0.360100 -0.509218 0.735525 1.198215 0.064044 0.933335)
)
;;; 119 even --------------------------------------------------------------------------------
-(vector 119 14.971 #(0 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 1 1 1 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 1 0 0 0 1 1 0 0 1 0 1 0 1 0 1 1 1 1 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 1)
+(vector 119 14.971 #r(0 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 1 1 1 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 1 0 0 0 1 1 0 0 1 0 1 0 1 0 1 1 1 1 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 1)
;; ce:
- 11.482774 #(0.000000 0.022508 -0.154621 -0.133560 0.019055 0.044006 0.744199 -0.189660 1.646970 0.323873 1.389900 0.872285 1.714451 0.465026 0.101347 1.045318 0.619662 0.299667 0.695492 1.761299 -0.465991 1.247091 0.360217 0.709249 0.270723 1.861018 1.538710 1.394055 1.300550 0.683046 1.420419 1.591103 0.068117 0.694826 0.315654 0.206747 0.551524 0.669546 0.407597 0.609362 1.957764 1.313475 1.269191 1.535059 -0.453483 1.127112 -0.438414 1.098010 0.925063 1.295295 0.349547 1.800021 1.265884 1.210725 1.261945 1.409059 0.031987 1.064471 1.087820 0.131065 1.230087 1.008698 0.646880 1.108562 0.465537 -0.286867 1.491020 1.274669 0.240579 1.517428 0.852795 0.970665 0.563004 0.179967 1.049271 1.080429 0.558118 -0.026181 0.946833 1.033681 0.158731 0.889882 0.983418 -0.020663 1.724961 1.892566 0.743055 1.647217 1.582049 1.007387 1.541602 0.779919 1.494250 -0.227797 0.081916 -0.223533 0.250776 1.270562 1.106978 1.124428 0.217158 1.341937 0.121564 0.628868 -0.092377 1.005391 0.266805 1.036087 -0.286050 1.835950 0.190028 0.634731 1.031073 0.250385 1.062823 1.900473 0.065255 0.789889 1.186094)
+ 11.482774 #r(0.000000 0.022508 -0.154621 -0.133560 0.019055 0.044006 0.744199 -0.189660 1.646970 0.323873 1.389900 0.872285 1.714451 0.465026 0.101347 1.045318 0.619662 0.299667 0.695492 1.761299 -0.465991 1.247091 0.360217 0.709249 0.270723 1.861018 1.538710 1.394055 1.300550 0.683046 1.420419 1.591103 0.068117 0.694826 0.315654 0.206747 0.551524 0.669546 0.407597 0.609362 1.957764 1.313475 1.269191 1.535059 -0.453483 1.127112 -0.438414 1.098010 0.925063 1.295295 0.349547 1.800021 1.265884 1.210725 1.261945 1.409059 0.031987 1.064471 1.087820 0.131065 1.230087 1.008698 0.646880 1.108562 0.465537 -0.286867 1.491020 1.274669 0.240579 1.517428 0.852795 0.970665 0.563004 0.179967 1.049271 1.080429 0.558118 -0.026181 0.946833 1.033681 0.158731 0.889882 0.983418 -0.020663 1.724961 1.892566 0.743055 1.647217 1.582049 1.007387 1.541602 0.779919 1.494250 -0.227797 0.081916 -0.223533 0.250776 1.270562 1.106978 1.124428 0.217158 1.341937 0.121564 0.628868 -0.092377 1.005391 0.266805 1.036087 -0.286050 1.835950 0.190028 0.634731 1.031073 0.250385 1.062823 1.900473 0.065255 0.789889 1.186094)
)
;;; 120 even --------------------------------------------------------------------------------
-(vector 120 15.153992567168 #(0 0 1 1 0 0 1 0 1 0 0 1 0 0 1 0 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 1 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 0)
+(vector 120 15.153992567168 #r(0 0 1 1 0 0 1 0 1 0 0 1 0 0 1 0 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 1 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 0)
;; ce:
- 11.467293 #(0.000000 0.182387 0.991318 1.555550 0.388952 1.165472 1.861486 0.514097 1.467680 0.222754 0.972121 1.805786 0.710465 1.475951 0.467146 1.464916 0.222083 1.170792 0.137691 0.926627 1.940353 0.964985 0.072695 1.174272 0.187090 1.145640 0.255557 1.524936 0.697660 1.793860 0.870660 1.991349 1.164698 0.214289 1.427601 0.920631 0.315825 1.506380 0.771158 0.081551 1.397459 0.660219 0.101946 1.376912 0.742252 1.975042 1.384246 0.994395 0.741688 0.116508 1.476904 0.995545 0.574556 -0.050092 1.395747 1.037641 0.654167 0.178367 0.000799 1.661003 1.401198 1.027447 0.549822 0.319024 -0.009775 1.643655 1.451741 1.190761 1.247596 1.019397 0.814792 0.637301 0.619820 0.528955 0.206546 0.210086 1.907606 0.080551 1.852358 0.220977 0.039775 0.240556 0.118697 0.201230 0.183490 0.410415 0.195004 0.346621 0.384871 0.552316 0.919228 0.966578 1.294194 1.669482 1.481782 1.816544 0.045277 0.459121 0.610971 0.884884 1.313099 1.767978 0.251484 0.557317 0.967847 1.457578 1.608185 1.982656 0.491182 1.030233 1.763557 0.343009 0.756305 1.429088 0.071947 0.646318 1.100378 0.016785 0.234469 0.966926)
+ 11.467293 #r(0.000000 0.182387 0.991318 1.555550 0.388952 1.165472 1.861486 0.514097 1.467680 0.222754 0.972121 1.805786 0.710465 1.475951 0.467146 1.464916 0.222083 1.170792 0.137691 0.926627 1.940353 0.964985 0.072695 1.174272 0.187090 1.145640 0.255557 1.524936 0.697660 1.793860 0.870660 1.991349 1.164698 0.214289 1.427601 0.920631 0.315825 1.506380 0.771158 0.081551 1.397459 0.660219 0.101946 1.376912 0.742252 1.975042 1.384246 0.994395 0.741688 0.116508 1.476904 0.995545 0.574556 -0.050092 1.395747 1.037641 0.654167 0.178367 0.000799 1.661003 1.401198 1.027447 0.549822 0.319024 -0.009775 1.643655 1.451741 1.190761 1.247596 1.019397 0.814792 0.637301 0.619820 0.528955 0.206546 0.210086 1.907606 0.080551 1.852358 0.220977 0.039775 0.240556 0.118697 0.201230 0.183490 0.410415 0.195004 0.346621 0.384871 0.552316 0.919228 0.966578 1.294194 1.669482 1.481782 1.816544 0.045277 0.459121 0.610971 0.884884 1.313099 1.767978 0.251484 0.557317 0.967847 1.457578 1.608185 1.982656 0.491182 1.030233 1.763557 0.343009 0.756305 1.429088 0.071947 0.646318 1.100378 0.016785 0.234469 0.966926)
)
;;; 121 even --------------------------------------------------------------------------------
-(vector 121 14.652157793709 #(0 0 1 1 0 0 1 0 0 1 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 1 0 1 0 0 0 0 0 0 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 0 0 1 0 1 1 1 0 0 0 1)
+(vector 121 14.652157793709 #r(0 0 1 1 0 0 1 0 0 1 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 1 0 1 0 0 0 0 0 0 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 0 0 1 0 1 1 1 0 0 0 1)
;; ce:
- 11.519858 #(0.000000 0.011378 1.753896 1.437136 0.631135 0.114781 0.660482 1.334498 0.581894 0.089402 1.905979 0.990187 0.248688 0.037998 1.898481 0.142274 0.776484 1.706556 0.191753 0.338054 1.318431 0.126497 0.601712 -0.255350 -0.163162 0.402669 1.476694 -0.235785 0.342102 -0.362582 1.698550 0.968284 0.940716 1.711626 1.326298 1.313163 0.329811 1.359487 0.105165 0.702440 0.022566 -0.069577 1.342187 0.008210 1.716840 0.240520 -0.171785 1.502743 1.676402 1.248370 0.723049 1.865376 0.001307 0.034537 0.684465 1.516715 0.492834 1.116078 0.672438 1.182471 0.641149 0.373795 0.379475 0.145636 0.762178 0.433641 0.347370 0.948832 -0.132296 -0.133379 1.190338 1.266604 1.009701 0.238209 0.752479 1.596905 -0.296398 -0.192578 0.605136 0.075081 1.420344 0.466284 -0.288768 1.297330 1.689017 1.567153 1.185252 0.260951 0.236638 1.431783 0.599599 1.509650 0.653104 0.899471 1.457027 1.068607 0.961380 1.256645 0.033616 -0.139517 0.092125 1.417841 1.213189 1.821992 1.761054 0.238734 0.417918 0.642844 -0.104823 0.081427 0.065359 0.670607 1.054994 1.082441 -0.176585 1.119180 -0.224101 0.108660 -0.203752 0.470242 1.351870)
+ 11.519858 #r(0.000000 0.011378 1.753896 1.437136 0.631135 0.114781 0.660482 1.334498 0.581894 0.089402 1.905979 0.990187 0.248688 0.037998 1.898481 0.142274 0.776484 1.706556 0.191753 0.338054 1.318431 0.126497 0.601712 -0.255350 -0.163162 0.402669 1.476694 -0.235785 0.342102 -0.362582 1.698550 0.968284 0.940716 1.711626 1.326298 1.313163 0.329811 1.359487 0.105165 0.702440 0.022566 -0.069577 1.342187 0.008210 1.716840 0.240520 -0.171785 1.502743 1.676402 1.248370 0.723049 1.865376 0.001307 0.034537 0.684465 1.516715 0.492834 1.116078 0.672438 1.182471 0.641149 0.373795 0.379475 0.145636 0.762178 0.433641 0.347370 0.948832 -0.132296 -0.133379 1.190338 1.266604 1.009701 0.238209 0.752479 1.596905 -0.296398 -0.192578 0.605136 0.075081 1.420344 0.466284 -0.288768 1.297330 1.689017 1.567153 1.185252 0.260951 0.236638 1.431783 0.599599 1.509650 0.653104 0.899471 1.457027 1.068607 0.961380 1.256645 0.033616 -0.139517 0.092125 1.417841 1.213189 1.821992 1.761054 0.238734 0.417918 0.642844 -0.104823 0.081427 0.065359 0.670607 1.054994 1.082441 -0.176585 1.119180 -0.224101 0.108660 -0.203752 0.470242 1.351870)
)
;;; 122 even --------------------------------------------------------------------------------
-(vector 122 15.057187309653 #(0 0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 0 1 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1)
+(vector 122 15.057187309653 #r(0 0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 0 1 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1)
;; ce:
- 11.608575 #(0.000000 0.491043 0.007498 0.791398 0.660542 0.960014 1.233279 1.608131 1.227878 1.325414 0.833262 0.826707 1.074054 0.805872 0.453534 0.680408 0.163876 1.857437 1.971814 1.942244 1.528127 1.170281 1.451447 1.612886 0.379280 0.469353 0.748640 0.861019 0.289879 1.554726 0.245277 0.578277 0.944303 0.525039 0.312641 0.462849 0.710444 0.524042 0.736659 1.743905 0.289146 1.405383 1.146345 1.959424 1.266837 0.105168 0.264372 0.716079 0.180416 0.676462 1.349909 0.242201 1.112324 1.903652 0.096097 0.298665 1.938506 0.907637 0.445138 0.676772 1.018566 1.538692 1.890411 1.037889 1.754475 0.454828 0.375080 1.028535 1.584256 0.107387 0.732227 1.941438 0.410085 0.465514 0.392267 1.461968 0.104792 1.428078 0.866762 0.928264 0.963879 0.060101 0.001979 1.538408 1.110694 0.832374 1.363340 1.030944 1.856655 0.680542 1.663245 1.268139 0.925891 1.913766 1.292282 1.484272 0.663172 0.251878 0.695143 1.443461 0.967688 0.177908 1.246199 1.066133 0.923551 1.951433 0.308206 1.532986 1.662559 1.880618 0.612432 0.084712 1.836918 1.410469 0.509104 0.078690 0.955183 1.487132 0.007102 1.473132 0.898543 1.722166)
+ 11.608575 #r(0.000000 0.491043 0.007498 0.791398 0.660542 0.960014 1.233279 1.608131 1.227878 1.325414 0.833262 0.826707 1.074054 0.805872 0.453534 0.680408 0.163876 1.857437 1.971814 1.942244 1.528127 1.170281 1.451447 1.612886 0.379280 0.469353 0.748640 0.861019 0.289879 1.554726 0.245277 0.578277 0.944303 0.525039 0.312641 0.462849 0.710444 0.524042 0.736659 1.743905 0.289146 1.405383 1.146345 1.959424 1.266837 0.105168 0.264372 0.716079 0.180416 0.676462 1.349909 0.242201 1.112324 1.903652 0.096097 0.298665 1.938506 0.907637 0.445138 0.676772 1.018566 1.538692 1.890411 1.037889 1.754475 0.454828 0.375080 1.028535 1.584256 0.107387 0.732227 1.941438 0.410085 0.465514 0.392267 1.461968 0.104792 1.428078 0.866762 0.928264 0.963879 0.060101 0.001979 1.538408 1.110694 0.832374 1.363340 1.030944 1.856655 0.680542 1.663245 1.268139 0.925891 1.913766 1.292282 1.484272 0.663172 0.251878 0.695143 1.443461 0.967688 0.177908 1.246199 1.066133 0.923551 1.951433 0.308206 1.532986 1.662559 1.880618 0.612432 0.084712 1.836918 1.410469 0.509104 0.078690 0.955183 1.487132 0.007102 1.473132 0.898543 1.722166)
)
;;; 123 even --------------------------------------------------------------------------------
-(vector 123 15.156582832336 #(0 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 1 1 1 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 1 0 1 1 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0 1 0 1 1 1 0 0 1 0 0 0 0 1 1 0 1 0 0 0 1 1 0 1 1 1 0)
+(vector 123 15.156582832336 #r(0 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 1 1 1 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 1 0 1 1 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0 1 0 1 1 1 0 0 1 0 0 0 0 1 1 0 1 0 0 0 1 1 0 1 1 1 0)
;; ce:
- 11.636238 #(0.000000 -0.006745 1.718129 0.124324 0.694087 1.248162 1.264742 -0.205335 0.401180 1.175941 1.275199 0.664232 1.306473 1.775017 0.032088 1.172990 1.182530 1.684652 1.496052 1.018965 1.419875 1.724105 0.881080 0.365436 1.623371 0.118184 1.144470 1.090686 0.455215 1.110091 1.537843 1.409976 0.722528 0.766713 0.291253 1.154526 0.688621 0.079128 0.455767 1.072502 0.449509 1.072583 0.529271 0.933123 1.665962 0.456257 0.965966 0.378656 1.446789 1.599052 -0.405591 0.510787 1.741784 0.047873 1.179439 0.534603 0.738060 1.583394 -0.036662 0.033912 0.990276 0.359185 -0.041714 1.309428 0.206155 0.615264 1.013822 0.916642 1.092385 1.276567 0.943657 1.397941 1.325784 1.841099 0.255550 0.983848 0.698027 0.630229 0.444618 1.485280 0.538087 1.172707 0.510703 0.139282 1.060931 1.974722 0.748366 1.241445 1.282543 1.643915 -0.055670 1.226488 1.259535 1.054944 0.867004 1.180445 0.871590 -0.304557 0.449098 0.105044 0.415180 1.325658 1.915647 1.593801 1.274805 -0.206650 -0.888906 0.385364 0.203928 0.267603 1.679470 1.529346 0.775016 1.650475 0.752800 0.231942 -0.128889 1.695246 -0.352686 0.872132 -0.113288 1.107634 0.969190)
+ 11.636238 #r(0.000000 -0.006745 1.718129 0.124324 0.694087 1.248162 1.264742 -0.205335 0.401180 1.175941 1.275199 0.664232 1.306473 1.775017 0.032088 1.172990 1.182530 1.684652 1.496052 1.018965 1.419875 1.724105 0.881080 0.365436 1.623371 0.118184 1.144470 1.090686 0.455215 1.110091 1.537843 1.409976 0.722528 0.766713 0.291253 1.154526 0.688621 0.079128 0.455767 1.072502 0.449509 1.072583 0.529271 0.933123 1.665962 0.456257 0.965966 0.378656 1.446789 1.599052 -0.405591 0.510787 1.741784 0.047873 1.179439 0.534603 0.738060 1.583394 -0.036662 0.033912 0.990276 0.359185 -0.041714 1.309428 0.206155 0.615264 1.013822 0.916642 1.092385 1.276567 0.943657 1.397941 1.325784 1.841099 0.255550 0.983848 0.698027 0.630229 0.444618 1.485280 0.538087 1.172707 0.510703 0.139282 1.060931 1.974722 0.748366 1.241445 1.282543 1.643915 -0.055670 1.226488 1.259535 1.054944 0.867004 1.180445 0.871590 -0.304557 0.449098 0.105044 0.415180 1.325658 1.915647 1.593801 1.274805 -0.206650 -0.888906 0.385364 0.203928 0.267603 1.679470 1.529346 0.775016 1.650475 0.752800 0.231942 -0.128889 1.695246 -0.352686 0.872132 -0.113288 1.107634 0.969190)
)
;;; 124 even --------------------------------------------------------------------------------
-(vector 124 15.192802705519 #(0 1 0 1 0 0 0 0 0 1 1 0 0 0 0 1 0 1 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 0 1 0 1 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 1 1 0 0 1 0 0 1 1 1 0 1 0 1 1 1 1 0 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 0 0 1 0)
+(vector 124 15.192802705519 #r(0 1 0 1 0 0 0 0 0 1 1 0 0 0 0 1 0 1 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 0 1 0 1 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 1 1 0 0 1 0 0 1 1 1 0 1 0 1 1 1 1 0 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 0 0 1 0)
;; ce:
- 11.657070 #(0.000000 -0.014444 0.618588 1.072923 1.770483 0.269156 0.799491 1.415133 0.042486 0.667402 1.107625 1.860582 0.629761 1.228415 0.069647 0.757140 1.477152 0.235584 0.874179 1.620964 0.498598 1.283127 0.032336 0.931298 1.753048 0.690202 1.655180 0.637473 1.388106 0.380043 1.352876 0.417570 1.513619 0.398780 1.331736 0.297986 1.356056 0.723808 1.880303 1.075552 0.270324 1.454538 0.409485 1.419750 0.727467 0.088163 1.085380 0.180158 1.411841 0.476674 0.009315 1.487690 0.712294 -0.024891 1.362496 0.659010 -0.191074 1.370827 0.842745 0.281346 1.600375 1.056928 0.756127 0.303601 1.748097 1.271638 0.793604 0.293922 -0.112046 1.276835 1.265355 0.825565 0.530280 0.127474 1.794406 1.661127 1.499821 1.002415 0.662420 0.351459 0.106647 -0.108853 1.731304 1.778120 1.591760 1.488839 1.111393 1.249609 0.941574 1.119732 0.633391 0.859266 0.602796 0.706230 0.723444 0.862387 0.960018 1.160855 0.914474 1.092081 1.010153 1.292261 1.124565 1.486704 1.752791 1.765950 0.121592 0.301316 0.732598 0.775797 0.931505 1.227451 1.354358 1.806530 0.301686 0.668653 0.912777 1.521847 -0.005389 0.243631 0.695894 1.356048 1.421601 -0.009388)
+ 11.657070 #r(0.000000 -0.014444 0.618588 1.072923 1.770483 0.269156 0.799491 1.415133 0.042486 0.667402 1.107625 1.860582 0.629761 1.228415 0.069647 0.757140 1.477152 0.235584 0.874179 1.620964 0.498598 1.283127 0.032336 0.931298 1.753048 0.690202 1.655180 0.637473 1.388106 0.380043 1.352876 0.417570 1.513619 0.398780 1.331736 0.297986 1.356056 0.723808 1.880303 1.075552 0.270324 1.454538 0.409485 1.419750 0.727467 0.088163 1.085380 0.180158 1.411841 0.476674 0.009315 1.487690 0.712294 -0.024891 1.362496 0.659010 -0.191074 1.370827 0.842745 0.281346 1.600375 1.056928 0.756127 0.303601 1.748097 1.271638 0.793604 0.293922 -0.112046 1.276835 1.265355 0.825565 0.530280 0.127474 1.794406 1.661127 1.499821 1.002415 0.662420 0.351459 0.106647 -0.108853 1.731304 1.778120 1.591760 1.488839 1.111393 1.249609 0.941574 1.119732 0.633391 0.859266 0.602796 0.706230 0.723444 0.862387 0.960018 1.160855 0.914474 1.092081 1.010153 1.292261 1.124565 1.486704 1.752791 1.765950 0.121592 0.301316 0.732598 0.775797 0.931505 1.227451 1.354358 1.806530 0.301686 0.668653 0.912777 1.521847 -0.005389 0.243631 0.695894 1.356048 1.421601 -0.009388)
)
;;; 125 even --------------------------------------------------------------------------------
-(vector 125 15.340427254326 #(0 1 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 0 1 1 1 1 1 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 0 0 1 0 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 0 1 1 1 1 0 1 1 0 0 0 1 0 1 0 1 0 0 0)
+(vector 125 15.340427254326 #r(0 1 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 0 1 1 1 1 1 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 0 0 1 0 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 0 1 1 1 1 0 1 1 0 0 0 1 0 1 0 1 0 0 0)
;; ce:
- 11.726117 #(0.000000 -0.030799 0.144449 1.728737 0.676919 0.980768 0.920869 0.523856 0.255848 1.651421 0.139364 0.110259 -0.007857 -0.065476 0.898902 0.948218 0.041888 0.431499 0.955394 1.279597 0.899810 0.236632 1.338434 0.051979 0.022413 1.076247 0.455727 1.395710 0.537276 1.454562 -0.640673 1.646766 0.563227 0.468669 0.349014 0.207631 1.436456 -0.313434 1.039871 1.394849 1.334026 0.410015 0.714625 0.314535 0.295044 0.730112 0.878789 0.469330 0.349941 1.427732 0.501996 1.482747 1.311352 1.023386 -0.133711 0.934640 1.777275 0.139714 0.307620 0.411617 0.680605 1.805628 0.987833 -0.006267 1.325295 0.129226 0.029571 -0.131946 1.571497 0.134896 1.855074 0.957063 1.276873 0.033353 0.738862 1.196621 0.702473 1.212401 0.334974 0.594964 -0.391144 1.491428 1.659733 1.324319 0.593336 1.121378 1.836235 -0.494188 -0.410122 0.669230 1.852484 1.550441 0.612411 1.088978 0.233243 0.429977 0.213254 1.111633 0.529727 1.280152 1.687453 0.208804 0.661537 0.543046 1.373269 -0.302027 0.236049 0.167939 1.751438 0.754446 0.306753 -0.393681 0.981979 0.613716 0.543141 0.783701 1.211717 0.696576 0.743400 0.902651 1.308022 0.648265 1.051117 0.596115 0.465417)
+ 11.726117 #r(0.000000 -0.030799 0.144449 1.728737 0.676919 0.980768 0.920869 0.523856 0.255848 1.651421 0.139364 0.110259 -0.007857 -0.065476 0.898902 0.948218 0.041888 0.431499 0.955394 1.279597 0.899810 0.236632 1.338434 0.051979 0.022413 1.076247 0.455727 1.395710 0.537276 1.454562 -0.640673 1.646766 0.563227 0.468669 0.349014 0.207631 1.436456 -0.313434 1.039871 1.394849 1.334026 0.410015 0.714625 0.314535 0.295044 0.730112 0.878789 0.469330 0.349941 1.427732 0.501996 1.482747 1.311352 1.023386 -0.133711 0.934640 1.777275 0.139714 0.307620 0.411617 0.680605 1.805628 0.987833 -0.006267 1.325295 0.129226 0.029571 -0.131946 1.571497 0.134896 1.855074 0.957063 1.276873 0.033353 0.738862 1.196621 0.702473 1.212401 0.334974 0.594964 -0.391144 1.491428 1.659733 1.324319 0.593336 1.121378 1.836235 -0.494188 -0.410122 0.669230 1.852484 1.550441 0.612411 1.088978 0.233243 0.429977 0.213254 1.111633 0.529727 1.280152 1.687453 0.208804 0.661537 0.543046 1.373269 -0.302027 0.236049 0.167939 1.751438 0.754446 0.306753 -0.393681 0.981979 0.613716 0.543141 0.783701 1.211717 0.696576 0.743400 0.902651 1.308022 0.648265 1.051117 0.596115 0.465417)
)
;;; 126 even --------------------------------------------------------------------------------
-(vector 126 15.28212621738 #(0 1 0 1 1 0 1 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 0 1 1 1 1 1 0 0 0 1 1 1 1 0 0 1 1 1 0 1 0 1 1 0 0 1 1 1 1 1 1 1 0 0 0 0 0 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 1 1)
+(vector 126 15.28212621738 #r(0 1 0 1 1 0 1 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 0 1 1 1 1 1 0 0 0 1 1 1 1 0 0 1 1 1 0 1 0 1 1 0 0 1 1 1 1 1 1 1 0 0 0 0 0 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 1 1)
;; ce:
- 11.728732 #(0.000000 0.080423 0.859652 1.251285 0.001006 0.708480 1.329479 1.910986 0.575680 1.212005 1.941153 0.634379 1.324750 0.149467 1.036506 1.708281 0.612012 1.577838 0.338405 1.197595 0.029554 0.897812 1.895059 0.811840 1.778431 0.660286 1.607791 0.800800 1.947497 0.840295 1.874911 0.873100 1.809637 0.999296 0.039834 1.184996 0.352552 1.522062 0.693733 0.018959 1.247028 0.457540 1.699479 1.003229 -0.011631 1.387625 0.675778 1.873479 1.137263 0.739657 0.006673 1.350424 0.946270 0.348539 1.590673 1.018988 0.508851 1.844396 1.236918 0.897127 0.426111 1.973108 1.634669 1.217265 0.734120 0.464551 1.899258 1.421045 1.113676 0.840738 0.386615 0.153879 1.864697 1.811230 1.560296 1.258544 1.008246 0.775514 0.569961 0.379626 0.120794 0.073632 1.824999 1.979635 1.804273 1.934045 1.809824 1.823348 1.667350 1.525160 1.703620 1.223510 1.668539 1.353060 1.680931 1.768624 1.959157 0.014225 0.272244 0.168722 0.385113 0.365860 0.784448 0.739738 0.967615 1.309874 1.705334 0.092760 0.302680 0.844130 0.978941 1.342601 1.583162 1.784704 0.228093 0.608194 1.171628 1.840667 0.207453 0.811900 1.464070 1.557525 0.111382 0.715963 1.219826 1.691486)
+ 11.728732 #r(0.000000 0.080423 0.859652 1.251285 0.001006 0.708480 1.329479 1.910986 0.575680 1.212005 1.941153 0.634379 1.324750 0.149467 1.036506 1.708281 0.612012 1.577838 0.338405 1.197595 0.029554 0.897812 1.895059 0.811840 1.778431 0.660286 1.607791 0.800800 1.947497 0.840295 1.874911 0.873100 1.809637 0.999296 0.039834 1.184996 0.352552 1.522062 0.693733 0.018959 1.247028 0.457540 1.699479 1.003229 -0.011631 1.387625 0.675778 1.873479 1.137263 0.739657 0.006673 1.350424 0.946270 0.348539 1.590673 1.018988 0.508851 1.844396 1.236918 0.897127 0.426111 1.973108 1.634669 1.217265 0.734120 0.464551 1.899258 1.421045 1.113676 0.840738 0.386615 0.153879 1.864697 1.811230 1.560296 1.258544 1.008246 0.775514 0.569961 0.379626 0.120794 0.073632 1.824999 1.979635 1.804273 1.934045 1.809824 1.823348 1.667350 1.525160 1.703620 1.223510 1.668539 1.353060 1.680931 1.768624 1.959157 0.014225 0.272244 0.168722 0.385113 0.365860 0.784448 0.739738 0.967615 1.309874 1.705334 0.092760 0.302680 0.844130 0.978941 1.342601 1.583162 1.784704 0.228093 0.608194 1.171628 1.840667 0.207453 0.811900 1.464070 1.557525 0.111382 0.715963 1.219826 1.691486)
)
;;; 127 even --------------------------------------------------------------------------------
-(vector 127 15.237931718393 #(0 0 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0)
+(vector 127 15.237931718393 #r(0 0 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0)
;; ce:
- 11.791982 #(0.000000 -0.006501 0.895946 0.390502 1.267039 0.777220 0.845244 1.619366 1.738905 1.963883 0.834239 -0.095420 1.729892 0.328487 0.839467 -0.107042 0.077371 1.006289 0.934388 1.316468 0.399445 1.446071 0.867321 0.749721 0.310809 0.608045 0.928981 0.860186 0.132975 0.107680 0.035103 0.310673 1.698683 1.209244 1.219344 1.008158 0.868768 0.774429 0.524607 1.259150 0.968654 0.225551 0.670254 0.584349 1.206486 0.849939 0.881353 1.316256 1.223028 -0.051550 1.266841 0.533270 0.307133 0.871408 0.135067 0.350791 1.392175 1.398704 1.054665 1.094835 0.720758 1.235433 1.111126 1.315441 0.540735 1.759697 1.421149 1.220945 1.416174 0.271820 0.476065 0.346906 0.599580 1.865670 -0.010232 0.873428 0.191144 -0.138143 0.473276 0.793750 0.140345 0.466125 0.753788 0.166751 0.509961 1.311817 1.848999 0.485052 0.151803 1.266182 1.022497 -0.055512 1.662000 1.747291 0.161074 0.983665 1.511467 0.958919 1.602506 1.536897 -0.682895 0.108054 0.153831 0.495344 -0.168193 1.039701 1.035352 0.840794 0.198694 1.029171 0.222780 1.379441 0.220019 1.296462 0.080553 0.616328 1.212980 -0.006268 1.810129 0.820776 0.816381 1.107475 0.666818 -0.087937 0.128508 1.246653 0.713705)
+ 11.791982 #r(0.000000 -0.006501 0.895946 0.390502 1.267039 0.777220 0.845244 1.619366 1.738905 1.963883 0.834239 -0.095420 1.729892 0.328487 0.839467 -0.107042 0.077371 1.006289 0.934388 1.316468 0.399445 1.446071 0.867321 0.749721 0.310809 0.608045 0.928981 0.860186 0.132975 0.107680 0.035103 0.310673 1.698683 1.209244 1.219344 1.008158 0.868768 0.774429 0.524607 1.259150 0.968654 0.225551 0.670254 0.584349 1.206486 0.849939 0.881353 1.316256 1.223028 -0.051550 1.266841 0.533270 0.307133 0.871408 0.135067 0.350791 1.392175 1.398704 1.054665 1.094835 0.720758 1.235433 1.111126 1.315441 0.540735 1.759697 1.421149 1.220945 1.416174 0.271820 0.476065 0.346906 0.599580 1.865670 -0.010232 0.873428 0.191144 -0.138143 0.473276 0.793750 0.140345 0.466125 0.753788 0.166751 0.509961 1.311817 1.848999 0.485052 0.151803 1.266182 1.022497 -0.055512 1.662000 1.747291 0.161074 0.983665 1.511467 0.958919 1.602506 1.536897 -0.682895 0.108054 0.153831 0.495344 -0.168193 1.039701 1.035352 0.840794 0.198694 1.029171 0.222780 1.379441 0.220019 1.296462 0.080553 0.616328 1.212980 -0.006268 1.810129 0.820776 0.816381 1.107475 0.666818 -0.087937 0.128508 1.246653 0.713705)
)
;;; 128 even --------------------------------------------------------------------------------
-(vector 128 15.651492555885 #(0 0 0 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0)
+(vector 128 15.651492555885 #r(0 0 0 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0)
;; ce:
- 11.856765 #(0.000000 0.002702 1.085974 1.244165 0.302147 1.259231 0.307623 1.789071 0.248647 1.161010 1.314907 0.079451 1.835817 1.698549 1.371220 1.062438 -0.405684 -0.007858 1.415666 0.290877 1.615872 1.200022 1.723864 1.253269 0.379007 0.343005 0.128516 0.302246 -0.164454 0.039402 1.245595 0.229693 0.371762 0.212878 1.130208 0.211997 1.630376 0.731113 -0.271994 0.633039 1.003806 0.078215 0.728092 1.810709 1.419272 0.630789 0.702176 0.258274 1.627944 0.906125 1.142708 1.149739 0.327453 0.775766 1.891018 0.949407 1.868463 0.197100 0.436054 0.455859 1.396494 1.235603 1.184602 0.213251 0.192580 1.964426 0.843243 1.673738 -0.209417 -0.268734 0.946608 0.413048 1.382483 0.177431 0.571412 0.488003 0.422161 0.038021 -0.036166 0.871695 -0.124327 0.115262 1.774007 1.705740 -0.048183 0.114070 0.284773 0.198720 1.083200 1.095261 1.210900 1.153612 1.411655 -0.216841 0.226895 0.871232 1.590562 1.732972 1.482631 1.243964 0.261758 -0.017247 1.413734 0.786022 0.083529 1.333636 0.641441 1.707810 0.335402 0.567273 1.111144 1.682879 0.513761 1.029576 1.342257 1.314503 1.650528 0.559848 0.478412 -0.031753 0.050313 0.117019 1.542665 0.315940 1.287375 1.423028 0.248383 1.516714)
+ 11.856765 #r(0.000000 0.002702 1.085974 1.244165 0.302147 1.259231 0.307623 1.789071 0.248647 1.161010 1.314907 0.079451 1.835817 1.698549 1.371220 1.062438 -0.405684 -0.007858 1.415666 0.290877 1.615872 1.200022 1.723864 1.253269 0.379007 0.343005 0.128516 0.302246 -0.164454 0.039402 1.245595 0.229693 0.371762 0.212878 1.130208 0.211997 1.630376 0.731113 -0.271994 0.633039 1.003806 0.078215 0.728092 1.810709 1.419272 0.630789 0.702176 0.258274 1.627944 0.906125 1.142708 1.149739 0.327453 0.775766 1.891018 0.949407 1.868463 0.197100 0.436054 0.455859 1.396494 1.235603 1.184602 0.213251 0.192580 1.964426 0.843243 1.673738 -0.209417 -0.268734 0.946608 0.413048 1.382483 0.177431 0.571412 0.488003 0.422161 0.038021 -0.036166 0.871695 -0.124327 0.115262 1.774007 1.705740 -0.048183 0.114070 0.284773 0.198720 1.083200 1.095261 1.210900 1.153612 1.411655 -0.216841 0.226895 0.871232 1.590562 1.732972 1.482631 1.243964 0.261758 -0.017247 1.413734 0.786022 0.083529 1.333636 0.641441 1.707810 0.335402 0.567273 1.111144 1.682879 0.513761 1.029576 1.342257 1.314503 1.650528 0.559848 0.478412 -0.031753 0.050313 0.117019 1.542665 0.315940 1.287375 1.423028 0.248383 1.516714)
)
;;; 256 even --------------------------------------------------------------------------------
-(vector 256 24.434719362486 #(0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 1 0 1 0 1 1 1 1 0 1 0 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 1 1 0 0 0 0 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 1 1 1 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 1 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 1 1 0 0 1 0 1 0 0 1 0 0 1 0 0 0 0 1 1 0 1 1 1)
+(vector 256 24.434719362486 #r(0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 1 0 1 0 1 1 1 1 0 1 0 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 1 1 0 0 0 0 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 1 1 1 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 1 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 1 1 0 0 1 0 1 0 0 1 0 0 1 0 0 0 0 1 1 0 1 1 1)
;; ce:
- 16.895858 #(0.000000 -0.009189 0.902358 0.365887 -0.111323 -0.780998 -0.023618 -0.522343 0.279380 0.055265 -0.008058 0.474170 0.130008 0.951121 -0.734333 0.844285 0.824339 -0.107239 0.507621 0.164958 -0.496056 -0.789687 0.259333 -0.449818 0.843661 -0.030179 -0.474099 0.774618 -0.182868 0.024412 0.577418 -0.074812 -0.020675 0.192634 -0.599606 -0.070169 -0.948055 -0.992660 0.778395 -0.043578 -0.432579 -0.186685 -0.510874 -0.014069 -0.480270 0.346549 0.508024 0.846868 -0.259984 -0.239547 -0.834355 0.758428 0.757435 0.373609 -0.602450 0.574091 0.372351 0.871018 -1.004894 0.279914 0.796533 0.315579 -0.170724 -0.162430 -0.867211 -0.645076 0.714848 -0.271719 0.114112 0.067143 0.832100 -0.116990 -0.262191 -0.281235 -0.535795 0.830911 -0.182047 0.489779 0.867411 0.246384 -0.008329 -0.604672 0.770953 -0.982833 0.931441 -0.618590 -0.552932 0.209497 -0.183212 0.365740 0.769646 0.703588 -0.289040 -0.817528 -0.369365 0.293481 0.472048 0.790519 -0.426911 0.891352 -0.538143 -0.944128 -0.920976 0.221321 -0.509927 -0.348596 -0.644560 -0.213342 -0.745624 -0.706666 0.930922 -0.848273 -0.242448 -0.036301 0.898791 -0.590640 0.780449 -0.061417 0.458673 -0.691004 -0.831524 0.551686 0.225320 0.474068 0.953196 -0.781398 0.825342 0.760168 0.391595 0.124100 0.860713 -0.055973 0.585971 -0.869796 1.059960 -0.289476 -0.119142 0.020537 -0.912617 0.156202 0.608148 0.008605 -0.492103 -0.103742 0.428971 0.411193 -0.565692 0.935156 -0.112585 0.617223 -0.155032 0.327195 0.230999 -0.493871 -0.157653 0.741876 0.652071 0.725265 -0.509926 -0.435321 0.803678 0.422316 0.647203 -0.330251 -0.717114 -0.003821 -0.171433 0.905326 -0.870296 -0.075782 -0.123811 -0.827857 0.305695 -0.297883 0.361037 0.368875 0.307670 -0.861180 0.111296 0.743619 -0.505788 0.890369 -0.751559 0.768455 0.001867 -0.755119 0.593706 0.249715 0.003021 0.017365 -0.006817 0.077961 0.209405 -0.908703 -0.016914 0.016411 -0.745949 -0.862316 0.805206 -0.373876 -0.644818 0.552974 -0.723400 0.564147 0.221354 0.241461 -0.891285 0.457125 0.981689 -0.591672 -0.034527 -0.765054 -0.120687 0.438528 0.848881 -0.507062 0.069395 0.639313 -0.825275 0.641684 -0.188946 0.565634 -0.791635 -0.287596 -0.132874 -0.202513 0.559214 0.080018 0.796540 0.338441 0.210736 0.641999 0.009248 0.322360 -0.028925 0.697480 0.479428 0.122723 0.885702 -0.174527 0.157389 0.019802 0.207762 -0.007817 -0.188184 0.284891 0.769384 -0.699713 -0.860470 0.816560 0.661637 0.821235 0.090760 0.680062 0.906877 -0.017234)
+ 16.895858 #r(0.000000 -0.009189 0.902358 0.365887 -0.111323 -0.780998 -0.023618 -0.522343 0.279380 0.055265 -0.008058 0.474170 0.130008 0.951121 -0.734333 0.844285 0.824339 -0.107239 0.507621 0.164958 -0.496056 -0.789687 0.259333 -0.449818 0.843661 -0.030179 -0.474099 0.774618 -0.182868 0.024412 0.577418 -0.074812 -0.020675 0.192634 -0.599606 -0.070169 -0.948055 -0.992660 0.778395 -0.043578 -0.432579 -0.186685 -0.510874 -0.014069 -0.480270 0.346549 0.508024 0.846868 -0.259984 -0.239547 -0.834355 0.758428 0.757435 0.373609 -0.602450 0.574091 0.372351 0.871018 -1.004894 0.279914 0.796533 0.315579 -0.170724 -0.162430 -0.867211 -0.645076 0.714848 -0.271719 0.114112 0.067143 0.832100 -0.116990 -0.262191 -0.281235 -0.535795 0.830911 -0.182047 0.489779 0.867411 0.246384 -0.008329 -0.604672 0.770953 -0.982833 0.931441 -0.618590 -0.552932 0.209497 -0.183212 0.365740 0.769646 0.703588 -0.289040 -0.817528 -0.369365 0.293481 0.472048 0.790519 -0.426911 0.891352 -0.538143 -0.944128 -0.920976 0.221321 -0.509927 -0.348596 -0.644560 -0.213342 -0.745624 -0.706666 0.930922 -0.848273 -0.242448 -0.036301 0.898791 -0.590640 0.780449 -0.061417 0.458673 -0.691004 -0.831524 0.551686 0.225320 0.474068 0.953196 -0.781398 0.825342 0.760168 0.391595 0.124100 0.860713 -0.055973 0.585971 -0.869796 1.059960 -0.289476 -0.119142 0.020537 -0.912617 0.156202 0.608148 0.008605 -0.492103 -0.103742 0.428971 0.411193 -0.565692 0.935156 -0.112585 0.617223 -0.155032 0.327195 0.230999 -0.493871 -0.157653 0.741876 0.652071 0.725265 -0.509926 -0.435321 0.803678 0.422316 0.647203 -0.330251 -0.717114 -0.003821 -0.171433 0.905326 -0.870296 -0.075782 -0.123811 -0.827857 0.305695 -0.297883 0.361037 0.368875 0.307670 -0.861180 0.111296 0.743619 -0.505788 0.890369 -0.751559 0.768455 0.001867 -0.755119 0.593706 0.249715 0.003021 0.017365 -0.006817 0.077961 0.209405 -0.908703 -0.016914 0.016411 -0.745949 -0.862316 0.805206 -0.373876 -0.644818 0.552974 -0.723400 0.564147 0.221354 0.241461 -0.891285 0.457125 0.981689 -0.591672 -0.034527 -0.765054 -0.120687 0.438528 0.848881 -0.507062 0.069395 0.639313 -0.825275 0.641684 -0.188946 0.565634 -0.791635 -0.287596 -0.132874 -0.202513 0.559214 0.080018 0.796540 0.338441 0.210736 0.641999 0.009248 0.322360 -0.028925 0.697480 0.479428 0.122723 0.885702 -0.174527 0.157389 0.019802 0.207762 -0.007817 -0.188184 0.284891 0.769384 -0.699713 -0.860470 0.816560 0.661637 0.821235 0.090760 0.680062 0.906877 -0.017234)
)
;;; 512 even --------------------------------------------------------------------------------
-(vector 512 35.776 #(0 0 1 1 0 1 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 0 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 0 0 1 1 1 1 0 1 0 1 0 0 0 1 1 0 1 1 0 0 1 1 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 1 0 1 1 0 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 1 1 0 0 1 1 1 1 1 1 1 0 0 1 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 0 0 1 0 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 1 1 1 0 0 1 0 1 1 0 0 1 1 1 0 1 1 0 0 1 0 0 0 1 1 0 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 1 1 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 1 0 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 0 1 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 0 0 0 0 1 1 0 1 1 1 0 0 1 0 1 1 1 1 0 1 1 0 0 1 1 1 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 1 0 0 0 1 1 0 1 1 1 1 1 1 0 0 1)
+(vector 512 35.776 #r(0 0 1 1 0 1 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 0 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 0 0 1 1 1 1 0 1 0 1 0 0 0 1 1 0 1 1 0 0 1 1 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 1 0 1 1 0 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 1 1 0 0 1 1 1 1 1 1 1 0 0 1 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 0 0 1 0 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 1 1 1 0 0 1 0 1 1 0 0 1 1 1 0 1 1 0 0 1 0 0 0 1 1 0 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 1 1 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 1 0 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 0 1 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 0 0 0 0 1 1 0 1 1 1 0 0 1 0 1 1 1 1 0 1 1 0 0 1 1 1 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 1 0 0 0 1 1 0 1 1 1 1 1 1 0 0 1)
;; from (try-all :even 512 513 0.0057725498034576 0.26769012113045) = 29.0733
;; ce:
- 24.510365 #(0.000000 -0.019547 0.424156 1.640830 1.364680 1.818776 1.105842 0.737080 1.188869 0.460419 0.154877 0.614397 1.827954 1.526781 0.018169 1.203682 0.956144 1.444331 0.584264 0.344508 0.856804 -0.002275 1.790988 0.291010 1.439116 1.211881 1.741084 0.845603 0.707294 1.180635 0.339890 0.164786 0.645301 1.820612 1.656940 0.157290 1.307936 1.130965 1.686613 0.833679 0.620052 1.209627 0.322209 0.138398 0.734419 1.838268 1.653494 0.235420 1.341020 1.194471 1.729004 0.905361 0.771623 1.262727 0.487832 0.366383 0.843119 0.069579 1.963835 0.460118 1.649699 1.520680 0.055018 1.185740 1.101098 1.643899 0.752530 0.667948 1.169078 0.382792 0.269771 0.820501 0.061364 1.929744 0.493658 1.740499 1.549752 0.138458 1.334798 1.217842 1.724754 0.932476 0.823652 1.326258 0.605394 0.510375 1.024728 0.340933 0.185795 0.774497 0.036705 1.862931 0.456043 1.668642 1.590302 0.139925 1.318436 1.326961 1.864132 1.011509 1.051965 1.624689 0.808072 0.775618 1.339118 0.606082 0.484361 1.076072 0.379297 0.250899 0.852275 0.110682 0.007792 0.595200 1.830378 1.789905 0.359788 1.659536 1.611286 0.154864 1.497402 1.399711 1.998779 1.270070 1.199870 1.801564 1.085483 1.010139 1.613933 0.921049 0.862702 1.434888 0.750644 0.728545 1.284532 0.570978 0.570652 1.118882 0.422457 0.414420 0.977086 0.320768 0.330042 0.881914 0.218609 0.199085 0.805391 0.088964 0.043485 0.695205 -0.000491 1.966513 0.612316 1.930538 1.950727 0.563038 1.854742 1.879285 0.451929 1.795108 1.794421 0.370361 1.783471 1.745602 0.399279 1.738776 1.661161 0.350902 1.625174 1.614568 0.302843 1.577093 1.678861 0.313770 1.663823 1.660571 0.328157 1.709209 1.610846 0.310206 1.720381 1.669108 0.335355 1.656296 1.693491 0.346281 1.654195 1.699773 0.373651 1.773772 1.752470 0.473140 1.826907 1.822715 0.581620 1.832675 1.919552 0.622630 1.929526 0.005176 0.677897 0.085092 0.090877 0.761048 0.206124 0.205634 0.890197 0.304835 0.339949 1.002646 0.395940 0.448746 1.152273 0.561345 0.581101 1.310704 0.737714 0.744961 1.486545 0.848210 0.931544 1.627529 1.007712 1.110684 1.778206 1.199087 1.278685 -0.040639 1.383705 1.405450 0.148513 1.511196 1.633778 0.391073 1.740722 1.849679 0.658438 0.031218 0.137149 0.870371 0.331222 0.296051 1.070588 0.528400 0.591834 1.345092 0.751955 0.829846 1.642139 1.030239 1.201544 1.943718 1.298486 1.407002 0.143893 1.607481 1.695116 0.415675 1.905744 -0.027620 0.742513 0.206291 0.320377 1.123679 0.506496 0.647078 1.425059 0.880594 0.962991 1.736110 1.225483 1.369479 0.064842 1.600531 1.706861 0.517054 1.973656 0.069623 0.837048 0.295925 0.404900 1.263222 0.684812 0.775618 1.577141 1.057937 1.264522 0.064638 1.531997 1.682245 0.471443 1.922985 0.104388 0.897292 0.423113 0.526550 1.412335 0.758158 0.917306 1.736464 1.285171 1.451805 0.278569 1.745150 1.879876 0.677038 0.183709 0.366812 1.118883 0.736257 0.864386 1.688806 1.159516 1.253423 0.100375 1.645658 1.871576 0.762011 0.249411 0.395560 1.273133 0.699592 0.948774 1.805372 1.338330 1.530595 0.294092 1.900787 0.034538 0.923012 0.390364 0.586314 1.386265 1.030145 1.202559 0.071001 1.609371 1.743831 0.671235 0.194183 0.391537 1.251984 0.751826 1.009573 1.860932 1.448367 1.525073 0.422286 -0.073409 0.262981 1.099563 0.626545 0.818453 1.723102 1.361444 1.531582 0.390953 1.909101 0.215438 1.139977 0.737652 0.881882 1.821234 1.380301 1.618894 0.473317 0.045322 0.250969 1.146414 0.800355 0.959156 1.857842 1.429019 1.673847 0.622261 0.184525 0.502145 1.323715 0.914639 1.172552 0.096636 1.761155 1.977345 0.871966 0.396190 0.668483 1.677724 1.221155 1.466337 0.368967 0.009966 0.302335 1.180746 0.786475 1.025502 -0.022711 1.584463 1.830638 0.746555 0.413840 0.650268 1.656745 1.224810 1.557055 0.513491 0.173029 0.435007 1.290629 0.926051 1.263115 0.272344 1.896521 0.084566 1.048863 0.725520 0.987362 -0.027617 1.571108 1.900984 0.869809 0.386916 0.758635 1.730437 1.409025 1.672233 0.588812 0.243929 0.511763 1.494695 1.169935 1.437757 0.431437 0.111507 0.458811 1.437247 1.136523 1.434884 0.401589 0.040030 0.372128 1.370962 0.999488 1.378913 0.377301 -0.009324 0.355264 1.331258 1.008855 1.339035 0.373593 0.044480 0.312196 1.329497 1.000220 1.342701 0.417261 0.083063 0.411303 1.346062 1.090657 1.409862 0.373501 0.211768 0.447452 1.458597 1.131955 1.458774 0.553807 0.205989 0.569249 1.645656 1.188483 1.668112 0.674809 0.371651 0.732131 1.751447 1.522458 1.904784 0.884407 0.617430 0.990830 0.073047 1.730004 0.133217 1.189522 0.869836 1.203019 0.328634 0.051596 0.424552 1.471161 1.210755 1.549745 0.605989 0.343260 0.768857 1.816839 1.581320 1.934635 1.014299 0.737558 1.116115 0.236955 0.018173 0.380416 1.539634 1.251595 1.652099 0.829587 0.536746 0.936033)
+ 24.510365 #r(0.000000 -0.019547 0.424156 1.640830 1.364680 1.818776 1.105842 0.737080 1.188869 0.460419 0.154877 0.614397 1.827954 1.526781 0.018169 1.203682 0.956144 1.444331 0.584264 0.344508 0.856804 -0.002275 1.790988 0.291010 1.439116 1.211881 1.741084 0.845603 0.707294 1.180635 0.339890 0.164786 0.645301 1.820612 1.656940 0.157290 1.307936 1.130965 1.686613 0.833679 0.620052 1.209627 0.322209 0.138398 0.734419 1.838268 1.653494 0.235420 1.341020 1.194471 1.729004 0.905361 0.771623 1.262727 0.487832 0.366383 0.843119 0.069579 1.963835 0.460118 1.649699 1.520680 0.055018 1.185740 1.101098 1.643899 0.752530 0.667948 1.169078 0.382792 0.269771 0.820501 0.061364 1.929744 0.493658 1.740499 1.549752 0.138458 1.334798 1.217842 1.724754 0.932476 0.823652 1.326258 0.605394 0.510375 1.024728 0.340933 0.185795 0.774497 0.036705 1.862931 0.456043 1.668642 1.590302 0.139925 1.318436 1.326961 1.864132 1.011509 1.051965 1.624689 0.808072 0.775618 1.339118 0.606082 0.484361 1.076072 0.379297 0.250899 0.852275 0.110682 0.007792 0.595200 1.830378 1.789905 0.359788 1.659536 1.611286 0.154864 1.497402 1.399711 1.998779 1.270070 1.199870 1.801564 1.085483 1.010139 1.613933 0.921049 0.862702 1.434888 0.750644 0.728545 1.284532 0.570978 0.570652 1.118882 0.422457 0.414420 0.977086 0.320768 0.330042 0.881914 0.218609 0.199085 0.805391 0.088964 0.043485 0.695205 -0.000491 1.966513 0.612316 1.930538 1.950727 0.563038 1.854742 1.879285 0.451929 1.795108 1.794421 0.370361 1.783471 1.745602 0.399279 1.738776 1.661161 0.350902 1.625174 1.614568 0.302843 1.577093 1.678861 0.313770 1.663823 1.660571 0.328157 1.709209 1.610846 0.310206 1.720381 1.669108 0.335355 1.656296 1.693491 0.346281 1.654195 1.699773 0.373651 1.773772 1.752470 0.473140 1.826907 1.822715 0.581620 1.832675 1.919552 0.622630 1.929526 0.005176 0.677897 0.085092 0.090877 0.761048 0.206124 0.205634 0.890197 0.304835 0.339949 1.002646 0.395940 0.448746 1.152273 0.561345 0.581101 1.310704 0.737714 0.744961 1.486545 0.848210 0.931544 1.627529 1.007712 1.110684 1.778206 1.199087 1.278685 -0.040639 1.383705 1.405450 0.148513 1.511196 1.633778 0.391073 1.740722 1.849679 0.658438 0.031218 0.137149 0.870371 0.331222 0.296051 1.070588 0.528400 0.591834 1.345092 0.751955 0.829846 1.642139 1.030239 1.201544 1.943718 1.298486 1.407002 0.143893 1.607481 1.695116 0.415675 1.905744 -0.027620 0.742513 0.206291 0.320377 1.123679 0.506496 0.647078 1.425059 0.880594 0.962991 1.736110 1.225483 1.369479 0.064842 1.600531 1.706861 0.517054 1.973656 0.069623 0.837048 0.295925 0.404900 1.263222 0.684812 0.775618 1.577141 1.057937 1.264522 0.064638 1.531997 1.682245 0.471443 1.922985 0.104388 0.897292 0.423113 0.526550 1.412335 0.758158 0.917306 1.736464 1.285171 1.451805 0.278569 1.745150 1.879876 0.677038 0.183709 0.366812 1.118883 0.736257 0.864386 1.688806 1.159516 1.253423 0.100375 1.645658 1.871576 0.762011 0.249411 0.395560 1.273133 0.699592 0.948774 1.805372 1.338330 1.530595 0.294092 1.900787 0.034538 0.923012 0.390364 0.586314 1.386265 1.030145 1.202559 0.071001 1.609371 1.743831 0.671235 0.194183 0.391537 1.251984 0.751826 1.009573 1.860932 1.448367 1.525073 0.422286 -0.073409 0.262981 1.099563 0.626545 0.818453 1.723102 1.361444 1.531582 0.390953 1.909101 0.215438 1.139977 0.737652 0.881882 1.821234 1.380301 1.618894 0.473317 0.045322 0.250969 1.146414 0.800355 0.959156 1.857842 1.429019 1.673847 0.622261 0.184525 0.502145 1.323715 0.914639 1.172552 0.096636 1.761155 1.977345 0.871966 0.396190 0.668483 1.677724 1.221155 1.466337 0.368967 0.009966 0.302335 1.180746 0.786475 1.025502 -0.022711 1.584463 1.830638 0.746555 0.413840 0.650268 1.656745 1.224810 1.557055 0.513491 0.173029 0.435007 1.290629 0.926051 1.263115 0.272344 1.896521 0.084566 1.048863 0.725520 0.987362 -0.027617 1.571108 1.900984 0.869809 0.386916 0.758635 1.730437 1.409025 1.672233 0.588812 0.243929 0.511763 1.494695 1.169935 1.437757 0.431437 0.111507 0.458811 1.437247 1.136523 1.434884 0.401589 0.040030 0.372128 1.370962 0.999488 1.378913 0.377301 -0.009324 0.355264 1.331258 1.008855 1.339035 0.373593 0.044480 0.312196 1.329497 1.000220 1.342701 0.417261 0.083063 0.411303 1.346062 1.090657 1.409862 0.373501 0.211768 0.447452 1.458597 1.131955 1.458774 0.553807 0.205989 0.569249 1.645656 1.188483 1.668112 0.674809 0.371651 0.732131 1.751447 1.522458 1.904784 0.884407 0.617430 0.990830 0.073047 1.730004 0.133217 1.189522 0.869836 1.203019 0.328634 0.051596 0.424552 1.471161 1.210755 1.549745 0.605989 0.343260 0.768857 1.816839 1.581320 1.934635 1.014299 0.737558 1.116115 0.236955 0.018173 0.380416 1.539634 1.251595 1.652099 0.829587 0.536746 0.936033)
)
;;; 1024 even --------------------------------------------------------------------------------
-(vector 1024 51.895 #(0 1 0 0 0 1 1 0 0 0 0 1 0 1 0 1 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 1 1 0 1 1 0 0 1 0 1 1 1 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 0 1 1 1 1 0 1 0 1 1 1 0 1 0 1 0 1 1 0 0 0 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 1 0 1 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 0 0 0 0 0 1 1 0 0 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 0 1 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 1 0 0 0 0 1 0 0 1 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 0 1 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 1 0 0 0 1 0 1 1 1 0 0 1 1 0 1 1 0 1 1 1 1 0 0 1 0 0 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 1 0 1 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 0 0 0 1 0 0 1 0 0 0 0 1 1 1 1 1 1 0 0 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 1 0 1 1 1 0 0 0 1 1 1 0 1 0 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 0 1 1 0 1 1 1 1 0 1 0 0 0 0 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 1 0 1 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 1 0 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 0 1 0 0 0 0 1 1 1 0 1 1 1 1 1 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 1 0 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 0 0 0 1 0 0 1 0 1 1 0 1 0 0 0 1 0 1 0 1 0 0 0 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 0 0 1 0 0 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 1 0 1 1 1 0 1 0 1 1 0 0 1 1 1 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 0 1 0 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 0 0 1 1 1 1 0 0)
+(vector 1024 51.895 #r(0 1 0 0 0 1 1 0 0 0 0 1 0 1 0 1 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 1 1 0 1 1 0 0 1 0 1 1 1 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 0 1 1 1 1 0 1 0 1 1 1 0 1 0 1 0 1 1 0 0 0 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 1 0 1 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 0 0 0 0 0 1 1 0 0 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 0 1 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 1 0 0 0 0 1 0 0 1 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 0 1 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 1 0 0 0 1 0 1 1 1 0 0 1 1 0 1 1 0 1 1 1 1 0 0 1 0 0 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 1 0 1 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 0 0 0 1 0 0 1 0 0 0 0 1 1 1 1 1 1 0 0 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 1 0 1 1 1 0 0 0 1 1 1 0 1 0 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 0 1 1 0 1 1 1 1 0 1 0 0 0 0 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 1 0 1 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 1 0 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 0 1 0 0 0 0 1 1 1 0 1 1 1 1 1 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 1 0 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 0 0 0 1 0 0 1 0 1 1 0 1 0 0 0 1 0 1 0 1 0 0 0 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 0 0 1 0 0 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 1 0 1 1 1 0 1 0 1 1 0 0 1 1 1 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 0 1 0 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 0 0 1 1 1 1 0 0)
;; ce:
- 34.486667 #(0.000000 0.010065 0.257552 0.593803 0.986349 1.354691 1.689002 0.065945 0.448419 0.795563 1.178916 1.585370 1.936149 0.310262 0.750710 1.056729 1.463725 1.825064 0.240816 0.539819 0.934214 1.340840 1.748800 0.092213 0.555713 0.915825 1.311840 1.650847 0.107697 0.477455 0.875194 1.288435 1.748432 0.197793 0.591516 1.015839 1.387092 1.854496 0.260210 0.614591 1.088807 1.497165 1.960609 0.347241 0.837150 1.265241 1.711792 0.103196 0.588662 1.043276 1.427385 1.898809 0.315073 0.790510 1.283232 1.726769 0.124226 0.582532 1.048754 1.444755 1.928781 0.425680 0.899080 1.335881 1.855991 0.327701 0.850115 1.267294 1.746464 0.254433 0.681023 1.221402 1.713475 0.176608 0.633457 1.170011 1.638469 0.136940 0.628672 1.079274 1.611588 0.107068 0.579047 1.125534 1.649825 0.159484 0.714499 1.195717 1.694762 0.283005 0.777095 1.317639 1.818676 0.294685 0.848021 1.366508 1.912960 0.442114 0.974399 1.491097 0.046085 0.607725 1.172318 1.701676 0.262890 0.804042 1.333049 1.847711 0.428372 0.986686 1.556422 0.120990 0.632701 1.249707 1.826221 0.398395 0.969062 1.507301 0.132868 0.725711 1.273823 1.851630 0.403540 1.046615 1.591703 0.182065 0.801530 1.386897 0.003430 0.562296 1.182148 1.798000 0.384640 0.992083 1.618128 0.211791 0.774713 1.389562 -0.001657 0.608366 1.236020 1.865011 0.529780 1.135532 1.738754 0.419570 1.019563 1.624992 0.265061 0.904049 1.533452 0.168181 0.865137 1.479101 0.127557 0.777817 1.390745 0.031342 0.661481 1.347873 -0.028252 0.673301 1.341813 0.012139 0.723533 1.359095 0.015081 0.667348 1.354810 -0.010820 0.651242 1.361901 0.014799 0.676361 1.414902 0.077676 0.777314 1.483046 0.156058 0.835487 1.534362 0.214249 0.944327 1.656367 0.337182 1.061518 1.736952 0.487837 1.221677 1.941805 0.641987 1.334519 0.012624 0.761615 1.493616 0.235055 0.987696 1.681644 0.449481 1.152512 1.880553 0.557489 1.300096 0.093548 0.829304 1.606739 0.333558 1.038662 1.817653 0.564596 1.346595 0.088231 0.789038 1.556219 0.364445 1.109277 1.894547 0.648472 1.394876 0.167696 0.927734 1.744135 0.473122 1.327580 0.053170 0.846408 1.630482 0.424396 1.252576 0.026366 0.794678 1.571738 0.353780 1.148629 -0.009061 0.802059 1.560730 0.388025 1.189760 -0.020908 0.838019 1.634252 0.450483 1.274303 0.061988 0.909080 1.739029 0.567344 1.395698 0.191004 1.056594 1.900321 0.701479 1.570664 0.420443 1.216101 0.035038 0.906051 1.794894 0.619739 1.485033 0.319328 1.177367 0.049998 0.912455 1.796694 0.663275 1.464877 0.322458 1.201076 0.079874 0.975135 1.812753 0.671629 1.550884 0.438265 1.308416 0.227568 1.107771 0.008272 0.852340 1.757258 0.665419 1.573359 0.450697 1.364674 0.288498 1.149330 0.046861 0.927672 1.818815 0.731499 1.703383 0.640630 1.515945 0.404842 1.338883 0.309581 1.223075 0.140786 1.078108 -0.017158 0.933921 1.856585 0.819946 1.718757 0.674573 1.629213 0.552624 1.480565 0.473092 1.440553 0.370780 1.316286 0.261652 1.233065 0.181284 1.136614 0.128844 1.063581 0.043473 0.988622 -0.007730 0.942926 1.896166 0.930670 1.890388 0.822783 1.839642 0.888701 1.829032 0.748117 1.787911 0.785711 1.793168 0.753464 1.768597 0.785917 1.789379 0.746424 1.769933 0.789526 1.789893 0.806228 1.806824 0.845014 1.858918 0.876599 1.887462 0.916183 -0.011424 0.947836 0.026544 1.052806 0.074297 1.092552 0.117837 1.145621 0.172062 1.271069 0.265950 1.343262 0.368273 1.426940 0.471985 1.600258 0.591440 1.643063 0.779963 1.778002 0.823172 1.887460 0.980164 0.056312 1.104881 0.194563 1.270671 0.317598 1.432357 0.527173 1.586831 0.679001 1.710986 0.856576 1.952932 1.034214 0.168860 1.247239 0.332452 1.455153 0.496571 1.598578 0.746454 1.841506 0.980194 0.065850 1.191729 0.313463 1.362280 0.540259 1.674133 0.807281 1.901298 1.046989 0.152754 1.296905 0.437367 1.599457 0.712142 1.832022 1.021052 0.159471 1.255226 0.399699 1.567354 0.776219 1.903366 1.055241 0.221691 1.359842 0.508090 1.682588 0.830923 0.010406 1.164777 0.321654 1.495630 0.648746 1.854778 1.028798 0.224012 1.437178 0.587301 1.746745 0.969426 0.124185 1.311647 0.558251 1.730677 0.926291 0.114111 1.341596 0.557527 1.745728 0.936491 0.127337 1.383134 0.617625 1.786691 1.023246 0.229459 1.472437 0.676585 1.907197 1.123237 0.355057 1.633938 0.880784 0.058692 1.279872 0.552335 1.779394 1.011586 0.276736 1.508029 0.759625 0.024536 1.276380 0.493761 1.728419 1.013811 0.266997 1.523472 0.795713 0.046243 1.307283 0.623236 1.877970 1.148383 0.427672 1.683629 1.001954 0.298274 1.554589 0.835462 0.173731 1.457407 0.693880 -0.034472 1.275602 0.593467 1.866633 1.210093 0.521728 1.772084 1.113712 0.385701 1.695457 1.069859 0.333163 1.607126 0.969652 0.282736 1.586932 0.934788 0.272131 1.571926 0.921386 0.293345 1.575513 0.936770 0.269737 1.574193 0.968165 0.284669 1.613899 0.986360 0.310459 1.654676 0.993511 0.432366 1.747611 1.058842 0.426357 1.800267 1.182611 0.576028 1.923944 1.270340 0.656610 0.044384 1.408707 0.752047 0.170780 1.558617 0.971026 0.315606 1.679451 1.091283 0.469917 1.819954 1.288114 0.668750 0.054741 1.461129 0.888977 0.275646 1.712213 1.100500 0.539170 1.932708 1.357198 0.750588 0.169930 1.599158 1.015737 0.433884 1.847466 1.290316 0.699471 0.106715 1.618980 1.039270 0.483584 1.877301 1.355281 0.739383 0.283415 1.680260 1.142458 0.582946 0.025158 1.503785 0.917235 0.402386 1.888910 1.374775 0.801742 0.267251 1.729725 1.190453 0.690588 0.170200 1.607615 1.116870 0.626944 0.099949 1.558114 1.042989 0.565792 0.001984 1.534796 0.981050 0.506989 0.024697 1.512493 1.045167 0.509838 0.035449 1.540981 1.040413 0.579777 0.067009 1.583544 1.092800 0.643044 0.165297 1.660919 1.190925 0.750261 0.244662 1.789497 1.303951 0.852702 0.402882 1.925637 1.511267 0.983904 0.525287 0.093612 1.625678 1.236625 0.751894 0.317275 1.862598 1.434730 1.003450 0.590395 0.130259 1.632064 1.251831 0.793529 0.395744 1.982905 1.518992 1.185899 0.724078 0.280841 1.851085 1.414649 1.036031 0.628024 0.190307 1.817967 1.407380 0.997638 0.626750 0.187117 1.827944 1.364014 1.005368 0.643575 0.271950 1.870132 1.455625 1.102716 0.663688 0.366474 1.947786 1.531948 1.165389 0.820292 0.417060 0.106203 1.736409 1.349795 1.017056 0.602019 0.247808 1.904232 1.522798 1.168173 0.822339 0.502122 0.190982 1.830461 1.503095 1.146005 0.824132 0.425448 0.163732 1.809535 1.439358 1.134762 0.787451 0.444950 0.125696 1.859821 1.507864 1.225427 0.898766 0.552383 0.249459 1.921771 1.641843 1.335828 1.036153 0.712405 0.407286 0.113814 1.810275 1.573082 1.216807 0.937380 0.622140 0.413886 0.065441 1.811766 1.479615 1.239853 0.962208 0.676221 0.428567 0.149787 1.861526 1.595913 1.378366 1.072254 0.858051 0.546952 0.352387 0.048977 1.781409 1.500802 1.320643 1.034780 0.814060 0.561026 0.270289 0.105077 1.781981 1.587128 1.356228 1.096895 0.899561 0.695426 0.422635 0.191053 0.015040 1.742763 1.540766 1.372440 1.135422 0.929280 0.712972 0.501615 0.300048 0.059338 1.847659 1.743466 1.446302 1.288333 1.097146 0.896394 0.693469 0.504749 0.273709 0.134422 -0.008122 1.752436 1.590209 1.416861 1.263443 1.015309 0.919786 0.724562 0.550733 0.413427 0.220154 0.085059 1.972253 1.758570 1.618664 1.418349 1.309492 1.092633 0.962125 0.822521 0.683138 0.548516 0.433745 0.271343 0.157018 -0.024488 1.878961 1.706051 1.633364 1.472286 1.423267 1.197350 1.130839 0.991815 0.864748 0.717411 0.656940 0.500335 0.378398 0.306249 0.174522 0.042370 1.957239 1.876551 1.787343 1.657177 1.630866 1.501218 1.454476 1.399481 1.281728 1.174679 1.094880 1.013897 0.872646 0.836534 0.733703 0.745572 0.645048 0.520901 0.517442 0.446338 0.403105 0.220915 0.272964 0.177893 0.121891 0.010365 -0.003026 -0.000541 1.946558 1.858421 1.798242 1.770282 1.765566 1.731024 1.646864 1.612063 1.606047 1.594080 1.512626 1.534901 1.459982 1.452555 1.426312 1.441887 1.450640 1.394928 1.401770 1.413824 1.398282 1.361199 1.386696 1.351788 1.315050 1.337782 1.369731 1.375462 1.382434 1.387327 1.390480 1.425063 1.472649 1.428947 1.444989 1.479959 1.454545 1.459856 1.514843 1.537769 1.564144 1.568551 1.669900 1.683717 1.723822 1.813102 1.823001 1.907890 1.890197 1.964939 -1.797036 0.049327 0.116611 0.169727 0.229816 0.312230 0.322585 0.436099 0.459978 0.494355 0.617621 0.657990 0.713966 0.784856 0.873687 0.939607 1.031179 1.056185 1.173421 1.311953 1.410978 1.454966 1.612093 1.676857 1.761378 1.862190 1.974384 0.042558 0.158632 0.245595 0.350975 0.483237 0.594289 0.729058 0.805700 0.959748 1.072984 1.213228 1.313277 1.445492 1.585944 1.673320 1.810642 1.960761 0.110169 0.205253 0.318753 0.449203 0.638254 0.764806 0.903920 1.064434 1.168013 1.366785 1.485581 1.644159 1.803584 -0.028237 0.153100 0.380114 0.509401 0.641451 0.849001 1.016399 1.215481 1.423241 1.573069 1.764733 1.942264 0.047242 0.295850 0.470228 0.640443 0.830347 1.055180 1.227983 1.357851 1.599606 1.739714 -0.029549 0.205220 0.379610 0.585030 0.816103 1.019847 1.251050 1.461935 1.647821 1.868576 0.147180 0.369132 0.579279 0.840715 1.094368 1.320093 1.565710 1.787983 -1.714361 0.195527 0.507750 0.710357 0.949912 1.153061 1.372724 1.700420 1.865502 0.178913 0.436041 0.694461 0.986729 1.187621 1.476665 1.752454 0.027539 0.321199 0.550142 0.802831 1.077337 1.362471 1.620159 1.900867 0.213014 0.446588 0.803703 1.113716 1.403572 1.697697 0.018021 0.315688 0.615559 0.932639 1.205074 1.541734 1.854009 0.125499 0.502519 0.744264 1.071360 1.395926 1.658298 -0.006671 0.333250 0.704886 1.026706 1.348527 1.693526)
+ 34.486667 #r(0.000000 0.010065 0.257552 0.593803 0.986349 1.354691 1.689002 0.065945 0.448419 0.795563 1.178916 1.585370 1.936149 0.310262 0.750710 1.056729 1.463725 1.825064 0.240816 0.539819 0.934214 1.340840 1.748800 0.092213 0.555713 0.915825 1.311840 1.650847 0.107697 0.477455 0.875194 1.288435 1.748432 0.197793 0.591516 1.015839 1.387092 1.854496 0.260210 0.614591 1.088807 1.497165 1.960609 0.347241 0.837150 1.265241 1.711792 0.103196 0.588662 1.043276 1.427385 1.898809 0.315073 0.790510 1.283232 1.726769 0.124226 0.582532 1.048754 1.444755 1.928781 0.425680 0.899080 1.335881 1.855991 0.327701 0.850115 1.267294 1.746464 0.254433 0.681023 1.221402 1.713475 0.176608 0.633457 1.170011 1.638469 0.136940 0.628672 1.079274 1.611588 0.107068 0.579047 1.125534 1.649825 0.159484 0.714499 1.195717 1.694762 0.283005 0.777095 1.317639 1.818676 0.294685 0.848021 1.366508 1.912960 0.442114 0.974399 1.491097 0.046085 0.607725 1.172318 1.701676 0.262890 0.804042 1.333049 1.847711 0.428372 0.986686 1.556422 0.120990 0.632701 1.249707 1.826221 0.398395 0.969062 1.507301 0.132868 0.725711 1.273823 1.851630 0.403540 1.046615 1.591703 0.182065 0.801530 1.386897 0.003430 0.562296 1.182148 1.798000 0.384640 0.992083 1.618128 0.211791 0.774713 1.389562 -0.001657 0.608366 1.236020 1.865011 0.529780 1.135532 1.738754 0.419570 1.019563 1.624992 0.265061 0.904049 1.533452 0.168181 0.865137 1.479101 0.127557 0.777817 1.390745 0.031342 0.661481 1.347873 -0.028252 0.673301 1.341813 0.012139 0.723533 1.359095 0.015081 0.667348 1.354810 -0.010820 0.651242 1.361901 0.014799 0.676361 1.414902 0.077676 0.777314 1.483046 0.156058 0.835487 1.534362 0.214249 0.944327 1.656367 0.337182 1.061518 1.736952 0.487837 1.221677 1.941805 0.641987 1.334519 0.012624 0.761615 1.493616 0.235055 0.987696 1.681644 0.449481 1.152512 1.880553 0.557489 1.300096 0.093548 0.829304 1.606739 0.333558 1.038662 1.817653 0.564596 1.346595 0.088231 0.789038 1.556219 0.364445 1.109277 1.894547 0.648472 1.394876 0.167696 0.927734 1.744135 0.473122 1.327580 0.053170 0.846408 1.630482 0.424396 1.252576 0.026366 0.794678 1.571738 0.353780 1.148629 -0.009061 0.802059 1.560730 0.388025 1.189760 -0.020908 0.838019 1.634252 0.450483 1.274303 0.061988 0.909080 1.739029 0.567344 1.395698 0.191004 1.056594 1.900321 0.701479 1.570664 0.420443 1.216101 0.035038 0.906051 1.794894 0.619739 1.485033 0.319328 1.177367 0.049998 0.912455 1.796694 0.663275 1.464877 0.322458 1.201076 0.079874 0.975135 1.812753 0.671629 1.550884 0.438265 1.308416 0.227568 1.107771 0.008272 0.852340 1.757258 0.665419 1.573359 0.450697 1.364674 0.288498 1.149330 0.046861 0.927672 1.818815 0.731499 1.703383 0.640630 1.515945 0.404842 1.338883 0.309581 1.223075 0.140786 1.078108 -0.017158 0.933921 1.856585 0.819946 1.718757 0.674573 1.629213 0.552624 1.480565 0.473092 1.440553 0.370780 1.316286 0.261652 1.233065 0.181284 1.136614 0.128844 1.063581 0.043473 0.988622 -0.007730 0.942926 1.896166 0.930670 1.890388 0.822783 1.839642 0.888701 1.829032 0.748117 1.787911 0.785711 1.793168 0.753464 1.768597 0.785917 1.789379 0.746424 1.769933 0.789526 1.789893 0.806228 1.806824 0.845014 1.858918 0.876599 1.887462 0.916183 -0.011424 0.947836 0.026544 1.052806 0.074297 1.092552 0.117837 1.145621 0.172062 1.271069 0.265950 1.343262 0.368273 1.426940 0.471985 1.600258 0.591440 1.643063 0.779963 1.778002 0.823172 1.887460 0.980164 0.056312 1.104881 0.194563 1.270671 0.317598 1.432357 0.527173 1.586831 0.679001 1.710986 0.856576 1.952932 1.034214 0.168860 1.247239 0.332452 1.455153 0.496571 1.598578 0.746454 1.841506 0.980194 0.065850 1.191729 0.313463 1.362280 0.540259 1.674133 0.807281 1.901298 1.046989 0.152754 1.296905 0.437367 1.599457 0.712142 1.832022 1.021052 0.159471 1.255226 0.399699 1.567354 0.776219 1.903366 1.055241 0.221691 1.359842 0.508090 1.682588 0.830923 0.010406 1.164777 0.321654 1.495630 0.648746 1.854778 1.028798 0.224012 1.437178 0.587301 1.746745 0.969426 0.124185 1.311647 0.558251 1.730677 0.926291 0.114111 1.341596 0.557527 1.745728 0.936491 0.127337 1.383134 0.617625 1.786691 1.023246 0.229459 1.472437 0.676585 1.907197 1.123237 0.355057 1.633938 0.880784 0.058692 1.279872 0.552335 1.779394 1.011586 0.276736 1.508029 0.759625 0.024536 1.276380 0.493761 1.728419 1.013811 0.266997 1.523472 0.795713 0.046243 1.307283 0.623236 1.877970 1.148383 0.427672 1.683629 1.001954 0.298274 1.554589 0.835462 0.173731 1.457407 0.693880 -0.034472 1.275602 0.593467 1.866633 1.210093 0.521728 1.772084 1.113712 0.385701 1.695457 1.069859 0.333163 1.607126 0.969652 0.282736 1.586932 0.934788 0.272131 1.571926 0.921386 0.293345 1.575513 0.936770 0.269737 1.574193 0.968165 0.284669 1.613899 0.986360 0.310459 1.654676 0.993511 0.432366 1.747611 1.058842 0.426357 1.800267 1.182611 0.576028 1.923944 1.270340 0.656610 0.044384 1.408707 0.752047 0.170780 1.558617 0.971026 0.315606 1.679451 1.091283 0.469917 1.819954 1.288114 0.668750 0.054741 1.461129 0.888977 0.275646 1.712213 1.100500 0.539170 1.932708 1.357198 0.750588 0.169930 1.599158 1.015737 0.433884 1.847466 1.290316 0.699471 0.106715 1.618980 1.039270 0.483584 1.877301 1.355281 0.739383 0.283415 1.680260 1.142458 0.582946 0.025158 1.503785 0.917235 0.402386 1.888910 1.374775 0.801742 0.267251 1.729725 1.190453 0.690588 0.170200 1.607615 1.116870 0.626944 0.099949 1.558114 1.042989 0.565792 0.001984 1.534796 0.981050 0.506989 0.024697 1.512493 1.045167 0.509838 0.035449 1.540981 1.040413 0.579777 0.067009 1.583544 1.092800 0.643044 0.165297 1.660919 1.190925 0.750261 0.244662 1.789497 1.303951 0.852702 0.402882 1.925637 1.511267 0.983904 0.525287 0.093612 1.625678 1.236625 0.751894 0.317275 1.862598 1.434730 1.003450 0.590395 0.130259 1.632064 1.251831 0.793529 0.395744 1.982905 1.518992 1.185899 0.724078 0.280841 1.851085 1.414649 1.036031 0.628024 0.190307 1.817967 1.407380 0.997638 0.626750 0.187117 1.827944 1.364014 1.005368 0.643575 0.271950 1.870132 1.455625 1.102716 0.663688 0.366474 1.947786 1.531948 1.165389 0.820292 0.417060 0.106203 1.736409 1.349795 1.017056 0.602019 0.247808 1.904232 1.522798 1.168173 0.822339 0.502122 0.190982 1.830461 1.503095 1.146005 0.824132 0.425448 0.163732 1.809535 1.439358 1.134762 0.787451 0.444950 0.125696 1.859821 1.507864 1.225427 0.898766 0.552383 0.249459 1.921771 1.641843 1.335828 1.036153 0.712405 0.407286 0.113814 1.810275 1.573082 1.216807 0.937380 0.622140 0.413886 0.065441 1.811766 1.479615 1.239853 0.962208 0.676221 0.428567 0.149787 1.861526 1.595913 1.378366 1.072254 0.858051 0.546952 0.352387 0.048977 1.781409 1.500802 1.320643 1.034780 0.814060 0.561026 0.270289 0.105077 1.781981 1.587128 1.356228 1.096895 0.899561 0.695426 0.422635 0.191053 0.015040 1.742763 1.540766 1.372440 1.135422 0.929280 0.712972 0.501615 0.300048 0.059338 1.847659 1.743466 1.446302 1.288333 1.097146 0.896394 0.693469 0.504749 0.273709 0.134422 -0.008122 1.752436 1.590209 1.416861 1.263443 1.015309 0.919786 0.724562 0.550733 0.413427 0.220154 0.085059 1.972253 1.758570 1.618664 1.418349 1.309492 1.092633 0.962125 0.822521 0.683138 0.548516 0.433745 0.271343 0.157018 -0.024488 1.878961 1.706051 1.633364 1.472286 1.423267 1.197350 1.130839 0.991815 0.864748 0.717411 0.656940 0.500335 0.378398 0.306249 0.174522 0.042370 1.957239 1.876551 1.787343 1.657177 1.630866 1.501218 1.454476 1.399481 1.281728 1.174679 1.094880 1.013897 0.872646 0.836534 0.733703 0.745572 0.645048 0.520901 0.517442 0.446338 0.403105 0.220915 0.272964 0.177893 0.121891 0.010365 -0.003026 -0.000541 1.946558 1.858421 1.798242 1.770282 1.765566 1.731024 1.646864 1.612063 1.606047 1.594080 1.512626 1.534901 1.459982 1.452555 1.426312 1.441887 1.450640 1.394928 1.401770 1.413824 1.398282 1.361199 1.386696 1.351788 1.315050 1.337782 1.369731 1.375462 1.382434 1.387327 1.390480 1.425063 1.472649 1.428947 1.444989 1.479959 1.454545 1.459856 1.514843 1.537769 1.564144 1.568551 1.669900 1.683717 1.723822 1.813102 1.823001 1.907890 1.890197 1.964939 -1.797036 0.049327 0.116611 0.169727 0.229816 0.312230 0.322585 0.436099 0.459978 0.494355 0.617621 0.657990 0.713966 0.784856 0.873687 0.939607 1.031179 1.056185 1.173421 1.311953 1.410978 1.454966 1.612093 1.676857 1.761378 1.862190 1.974384 0.042558 0.158632 0.245595 0.350975 0.483237 0.594289 0.729058 0.805700 0.959748 1.072984 1.213228 1.313277 1.445492 1.585944 1.673320 1.810642 1.960761 0.110169 0.205253 0.318753 0.449203 0.638254 0.764806 0.903920 1.064434 1.168013 1.366785 1.485581 1.644159 1.803584 -0.028237 0.153100 0.380114 0.509401 0.641451 0.849001 1.016399 1.215481 1.423241 1.573069 1.764733 1.942264 0.047242 0.295850 0.470228 0.640443 0.830347 1.055180 1.227983 1.357851 1.599606 1.739714 -0.029549 0.205220 0.379610 0.585030 0.816103 1.019847 1.251050 1.461935 1.647821 1.868576 0.147180 0.369132 0.579279 0.840715 1.094368 1.320093 1.565710 1.787983 -1.714361 0.195527 0.507750 0.710357 0.949912 1.153061 1.372724 1.700420 1.865502 0.178913 0.436041 0.694461 0.986729 1.187621 1.476665 1.752454 0.027539 0.321199 0.550142 0.802831 1.077337 1.362471 1.620159 1.900867 0.213014 0.446588 0.803703 1.113716 1.403572 1.697697 0.018021 0.315688 0.615559 0.932639 1.205074 1.541734 1.854009 0.125499 0.502519 0.744264 1.071360 1.395926 1.658298 -0.006671 0.333250 0.704886 1.026706 1.348527 1.693526)
)
;;; 2048 even --------------------------------------------------------------------------------
-(vector 2048 87.471149563312 #(0 0 1 0 1 1 0 0 0 0 1 0 1 1 1 1 0 1 0 1 1 1 1 0 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 0 1 0 1 0 1 0 0 1 1 1 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 0 0 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 0 1 1 1 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 0 1 0 0 0 1 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 1 1 0 0 0 1 0 1 1 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 1 0 1 0 0 1 0 0 0 1 1 1 0 1 1 1 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 1 0 0 0 1 1 1 1 1 0 0 0 0 0 0 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 0 0 1 0 1 0 0 0 1 0 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 0 1 0 0 0 0 1 1 1 0 0 0 1 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 1 1 1 0 0 1 1 1 1 1 1 0 0 1 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 1 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 1 0 1 0 1 0 1 1 0 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 0 0 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 0 1 1 0 0 0 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 0 1 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 0 1 1 1 0 1 1 0 0 1 1 1 0 1 1 0 1 1 1 0 0 1 0 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 0 1 0 1 0 1 0 0 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0 1 0 0 1 0 1 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 0 0 1 0 1 0 1 0 1 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 0 0 0 1 1 0 0 1 0 1 1 1 0 0 0 0 1 0 1 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 1 0 1 0 1 0 1 0 0 1 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 1 1 0 1 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 0 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1 0 1 1 1 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 1 1 1 0 1 0 1 1 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 0 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 1 0 1 1 0 1 0 1 1 0 0 0 1 1 0 0 1 1 0 0 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 0 1 0 0 0 1 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 1 0 1 1 0 0 1 1 1 0 0 0 0 1 0 0 0 1 1 0 1 0 0 1 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 1 1 0 0 1 0 0 1 1 0 1 0 0 0 1 0 0 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 1 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 1 1 0 1 0 0 0 1 0 0 1 1 1 1 1 0 1 1 0 0 1 1 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 0 1 0 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 1 0 1 0 0 1 1 0 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 1 0 1 1 1 0 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 1 0 0 0 1 1 0 0 1 0 1 0 0 0 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 0 1 1 0 0 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 0 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 1 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 0 1 0 0 1 1)
+(vector 2048 87.471149563312 #r(0 0 1 0 1 1 0 0 0 0 1 0 1 1 1 1 0 1 0 1 1 1 1 0 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 0 1 0 1 0 1 0 0 1 1 1 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 0 0 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 0 1 1 1 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 0 1 0 0 0 1 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 1 1 0 0 0 1 0 1 1 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 1 0 1 0 0 1 0 0 0 1 1 1 0 1 1 1 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 1 0 0 0 1 1 1 1 1 0 0 0 0 0 0 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 0 0 1 0 1 0 0 0 1 0 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 0 1 0 0 0 0 1 1 1 0 0 0 1 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 1 1 1 0 0 1 1 1 1 1 1 0 0 1 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 1 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 1 0 1 0 1 0 1 1 0 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 0 0 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 0 1 1 0 0 0 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 0 1 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 0 1 1 1 0 1 1 0 0 1 1 1 0 1 1 0 1 1 1 0 0 1 0 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 0 1 0 1 0 1 0 0 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0 1 0 0 1 0 1 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 0 0 1 0 1 0 1 0 1 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 0 0 0 1 1 0 0 1 0 1 1 1 0 0 0 0 1 0 1 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 1 0 1 0 1 0 1 0 0 1 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 1 1 0 1 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 0 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1 0 1 1 1 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 1 1 1 0 1 0 1 1 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 0 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 1 0 1 1 0 1 0 1 1 0 0 0 1 1 0 0 1 1 0 0 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 0 1 0 0 0 1 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 1 0 1 1 0 0 1 1 1 0 0 0 0 1 0 0 0 1 1 0 1 0 0 1 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 1 1 0 0 1 0 0 1 1 0 1 0 0 0 1 0 0 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 1 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 1 1 0 1 0 0 0 1 0 0 1 1 1 1 1 0 1 1 0 0 1 1 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 0 1 0 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 1 0 1 0 0 1 1 0 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 1 0 1 1 1 0 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 1 0 0 0 1 1 0 0 1 0 1 0 0 0 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 0 1 1 0 0 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 0 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 1 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 0 1 0 0 1 1)
;; (try-all :even 2048 2049 0.0014328746687631 0.51217918249646) = 56.93601 start for next
;; ce:
- 50.887273 #(0.000000 -0.001703 0.433172 1.590778 1.336810 1.796101 0.945990 0.630649 1.068973 0.276030 0.019619 0.418921 1.642205 1.314880 1.815562 0.937954 0.690335 1.166456 0.260174 0.033467 0.534551 1.577952 1.359691 1.855935 0.978115 0.778145 1.214744 0.305514 0.073250 0.585950 1.700979 1.456846 1.891326 1.051448 0.870291 1.262779 0.419868 0.209104 0.667538 1.764244 1.534253 0.022691 1.157333 0.886455 1.397513 0.522770 0.305417 0.791572 1.882641 1.706581 0.124613 1.245754 1.016938 1.507704 0.621789 0.423116 0.882723 0.034318 1.775279 0.266045 1.420137 1.176158 1.620182 0.842558 0.553079 1.037944 0.182615 0.005162 0.432646 1.577593 1.375077 1.777427 0.999839 0.726166 1.218120 0.366911 0.123723 0.662290 1.808464 1.555557 0.050943 1.161441 0.961088 1.469391 0.581778 0.421014 0.869182 1.964711 1.782785 0.217679 1.412311 1.228590 1.681851 0.818320 0.617489 1.120821 0.226824 0.041870 0.539030 1.644423 1.496409 1.937912 1.088438 0.861771 1.374952 0.504902 0.301816 0.831900 1.946273 1.700988 0.237333 1.351841 1.174113 1.697709 0.766188 0.601502 1.097799 0.223664 0.073707 0.490731 1.705779 1.529713 0.004900 1.114151 0.927806 1.413217 0.593263 0.370397 0.876728 0.024219 1.840075 0.345172 1.498140 1.311278 1.774455 0.911735 0.779474 1.231046 0.351370 0.170176 0.732535 1.828332 1.647912 0.151754 1.304922 1.134715 1.583698 0.773654 0.612595 1.042987 0.199634 0.036653 0.549756 1.681847 1.475587 0.005194 1.173802 0.977842 1.470305 0.643755 0.476622 0.917721 0.111850 1.936419 0.450243 1.616355 1.416777 1.915014 1.098462 0.907664 1.447783 0.570918 0.405291 0.889269 0.066991 1.881365 0.373330 1.508358 1.402579 1.870612 1.085131 0.920739 1.348392 0.568783 0.336415 0.843225 0.063446 1.926774 0.418106 1.565445 1.379520 1.897103 1.050320 0.891564 1.380927 0.530987 0.385626 0.908446 0.068664 1.943935 0.430612 1.518729 1.398232 1.924184 1.103625 0.924587 1.417433 0.610522 0.456479 0.953409 0.112059 0.013043 0.495872 1.633744 1.493163 0.038519 1.187544 1.048687 1.588579 0.748576 0.532785 1.100237 0.281535 0.104911 0.635452 1.811612 1.634030 0.184177 1.345558 1.153862 1.750039 0.857060 0.732788 1.250092 0.418042 0.246015 0.725057 1.972355 1.807991 0.351695 1.540788 1.347415 1.848165 1.067747 0.908528 1.413312 0.618180 0.467879 0.991799 0.190738 0.053795 0.507730 1.744900 1.620134 0.124619 1.318661 1.152397 1.685590 0.894836 0.688791 1.239521 0.488835 0.282246 0.831794 -0.015794 1.883123 0.431031 1.583860 1.447618 1.964025 1.125655 1.064343 1.569856 0.748855 0.603708 1.107653 0.309052 0.196774 0.696407 1.871049 1.742283 0.240318 1.473905 1.321207 1.881514 1.047815 0.924156 1.493868 0.689863 0.543896 1.026203 0.246976 0.140944 0.678125 1.870899 1.706720 0.276250 1.408196 1.319078 1.889412 1.061123 0.937583 1.451370 0.684034 0.567548 1.075578 0.293854 0.180105 0.705838 1.911360 1.764817 0.292975 1.493988 1.411105 1.895989 1.081687 1.012629 1.575334 0.718344 0.628406 1.174951 0.386415 0.230260 0.768066 -0.015753 1.886981 0.454216 1.616098 1.441778 0.077596 1.316514 1.144927 1.696140 0.867400 0.757625 1.309429 0.563210 0.364175 0.954929 0.137349 0.057751 0.597415 1.789122 1.677288 0.252684 1.417924 1.313555 1.862237 1.126315 1.015807 1.510443 0.802206 0.652057 1.184565 0.404523 0.277585 0.843687 0.148971 1.933489 0.514414 1.743011 1.592866 0.129290 1.346399 1.259419 1.817805 1.029171 0.962338 1.475532 0.708188 0.633076 1.151811 0.395581 0.307725 0.834201 0.078405 1.959228 0.466843 1.769721 1.650538 0.159441 1.402559 1.321215 1.914285 1.128095 1.014297 1.571134 0.803693 0.677208 1.246457 0.469701 0.356795 0.908733 0.149102 0.035900 0.615966 1.826481 1.708851 0.339243 1.554134 1.413247 -0.028956 1.251019 1.106816 1.704569 0.926586 0.827768 1.430366 0.655894 0.524343 1.153832 0.363573 0.234391 0.825975 0.037037 1.955590 0.487803 1.776970 1.679179 0.270247 1.494959 1.379330 1.956206 1.186819 1.071982 1.644518 0.897716 0.759160 1.349574 0.601679 0.512657 1.067152 0.367997 0.259056 0.818805 0.070970 1.979460 0.551129 1.797928 1.685198 0.237267 1.508404 1.457352 0.047420 1.261021 1.192815 1.789893 0.995526 0.930294 1.496757 0.778086 0.636312 1.222185 0.505076 0.392642 1.016934 0.236492 0.140361 0.774022 0.001411 1.961469 0.498526 1.750119 1.648169 0.240766 1.450209 1.419896 0.004281 1.237513 1.195486 1.793570 1.030159 0.946491 1.529067 0.769460 0.726220 1.269159 0.564615 0.472841 1.084479 0.322182 0.217540 0.870218 0.092806 0.039652 0.580465 1.871900 1.768958 0.330755 1.643083 1.574291 0.148815 1.382016 1.330434 1.953984 1.191904 1.113085 1.729795 0.935173 0.941506 1.487573 0.777735 0.706146 1.300602 0.552074 0.471965 1.086702 0.368313 0.238388 0.870358 0.129144 0.034415 0.647185 1.956907 1.855191 0.450494 1.695322 1.674270 0.277115 1.525710 1.462245 0.090299 1.329096 1.259635 1.870782 1.128184 1.069973 1.694787 0.953585 0.907980 1.546930 0.802555 0.747675 1.322734 0.664094 0.527920 1.163169 0.460332 0.399285 0.970040 0.217204 0.171752 0.769371 0.047350 -0.025234 0.632915 1.894302 1.830249 0.455254 1.760595 1.701533 0.321139 1.541634 1.515918 0.102674 1.367783 1.346029 1.941486 1.223287 1.213347 1.782946 1.029999 1.005092 1.692642 0.911840 0.875191 1.494140 0.757479 0.727400 1.310293 0.611635 0.559689 1.154763 0.453641 0.402989 1.051223 0.342693 0.309148 0.919084 0.199108 0.132609 0.759042 0.053229 -0.033954 0.648811 1.906240 1.894740 0.483288 1.798246 1.730147 0.369025 1.616846 1.576788 0.217080 1.494201 1.461719 0.088483 1.386902 1.325078 1.982480 1.249756 1.217589 1.872681 1.143670 1.127132 1.742603 1.001258 0.969685 1.653400 0.948140 0.903244 1.474757 0.844045 0.804740 1.381313 0.669059 0.696990 1.287624 0.590259 0.542974 1.139086 0.529408 0.444238 1.060949 0.381119 0.387330 0.982887 0.274265 0.262799 0.892622 0.182183 0.155238 0.802580 0.125716 0.062385 0.697970 -0.029110 -0.005740 0.631814 1.935506 1.905147 0.526743 1.805035 1.822539 0.427610 1.754204 1.769095 0.334244 1.671094 1.648758 0.313430 1.604455 1.580989 0.249732 1.534106 1.501925 0.141332 1.456591 1.376333 0.087064 1.395898 1.349285 -0.007846 1.309141 1.324784 1.926752 1.235223 1.257013 1.870695 1.183965 1.196890 1.833185 1.161076 1.134259 1.737981 1.066217 1.029285 1.761061 1.046404 1.003567 1.669085 1.015282 0.945700 1.628153 0.957401 0.910198 1.578015 0.892702 0.920061 1.560411 0.892643 0.883270 1.499087 0.881141 0.786754 1.465346 0.814870 0.806704 1.420951 0.745568 0.748981 1.428779 0.724569 0.722331 1.414318 0.735199 0.680304 1.412191 0.642055 0.663317 1.362918 0.692620 0.652852 1.255275 0.655029 0.616540 1.306668 0.607368 0.596378 1.278318 0.605729 0.626127 1.248672 0.605969 0.598531 1.270199 0.590247 0.604018 1.248420 0.564539 0.573991 1.243120 0.541247 0.581568 1.247013 0.548311 0.583389 1.254363 0.570054 0.592870 1.314918 0.584147 0.601170 1.285128 0.585385 0.636800 1.268157 0.564860 0.618673 1.241680 0.593206 0.649499 1.294308 0.619335 0.690828 1.290074 0.662251 0.659564 1.319465 0.684267 0.676527 1.346573 0.684074 0.749941 1.376399 0.760563 0.735778 1.409735 0.781193 0.776861 1.424608 0.803012 0.794890 1.482330 0.849249 0.820388 1.516581 0.910615 0.864461 1.540065 0.895368 0.913334 1.630286 0.950361 0.962747 1.686669 0.985439 1.020247 1.674781 0.998529 1.106931 1.784420 1.109819 1.080550 1.792617 1.141848 1.167488 1.815820 1.225904 1.216862 1.932151 1.308230 1.267897 -0.026968 1.330184 1.385176 0.022707 1.458233 1.415333 0.128552 1.487923 1.523242 0.191001 1.550003 1.584242 0.283355 1.596921 1.662782 0.308217 1.689429 1.701664 0.432683 1.765615 1.799785 0.477706 1.814969 1.847473 0.536692 1.956606 -0.125001 0.671687 0.021081 0.062099 0.778322 0.143122 0.195164 0.870404 0.217515 0.248340 0.992771 0.296311 0.393796 1.036703 0.444136 0.428455 1.144392 0.545916 0.532816 1.274635 0.638559 0.682382 1.366079 0.738438 0.791235 1.469530 0.832133 0.861591 1.597033 0.965134 0.975949 1.660906 1.074595 1.121780 1.850802 1.205711 1.200292 1.955639 1.297951 1.320764 0.075418 1.456186 1.481933 0.158684 1.566840 1.641287 0.359580 1.677476 1.730799 0.448508 1.815321 1.873655 0.540161 1.931330 1.974330 0.742536 0.063433 0.156314 0.825290 0.223991 0.306298 0.962765 0.360970 0.418863 1.127740 0.516243 0.542975 1.312005 0.652439 0.710545 1.452213 0.776568 0.871797 1.548353 0.973587 1.004549 1.725321 1.089618 1.233086 1.882229 1.280829 1.345266 0.036253 1.417172 1.451706 0.202998 1.622238 1.674924 0.340016 1.728728 1.833591 0.567298 1.946042 0.023405 0.702356 0.135275 0.153799 0.884198 0.265400 0.340889 1.099730 0.493458 0.526956 1.267239 0.676407 0.690082 1.422573 0.812500 0.926029 1.644040 1.074851 1.097114 1.811626 1.221109 1.268846 0.019885 1.418865 1.465834 0.226550 1.602283 1.642652 0.409600 1.782663 1.847764 0.612518 -0.014414 0.080272 0.793644 0.189642 0.287941 1.015956 0.430798 0.498270 1.212055 0.606553 0.678263 1.458990 0.847157 0.901708 1.629236 1.030896 1.120792 1.854770 1.260369 1.292084 0.058109 1.472251 1.530032 0.298666 1.686445 1.750885 0.465407 1.926615 -0.015762 0.736186 0.179728 0.219514 0.995121 0.367989 0.459496 1.186779 0.640597 0.690551 1.458450 0.858324 0.911511 1.699195 1.068188 1.186092 1.897316 1.337175 1.402416 0.144009 1.638297 1.673138 0.373403 1.812913 1.888979 0.630635 0.080370 0.169331 0.914815 0.273060 0.393754 1.122091 0.596144 0.640794 1.390765 0.839105 0.918214 1.680880 1.131151 1.205710 1.974811 1.393861 1.452322 0.156477 1.645144 1.718367 0.451059 1.878144 0.022469 0.716191 0.203622 0.204052 1.000934 0.419218 0.531168 1.297295 0.702318 0.799989 1.534195 0.962961 1.059623 1.864764 1.322381 1.390676 0.140300 1.535535 1.653796 0.423232 1.846167 1.958815 0.705134 0.115159 0.251430 1.006465 0.470237 0.504026 1.267250 0.734232 0.836445 1.549915 1.039694 1.136664 1.905550 1.321296 1.400727 0.208474 1.633666 1.709003 0.486386 1.940896 0.025205 0.789590 0.229116 0.395199 1.113150 0.560152 0.653681 1.459139 0.830910 0.975236 1.738577 1.210343 1.308624 0.093706 1.493739 1.620053 0.424641 1.828846 1.940485 0.729339 0.163547 0.294790 1.029106 0.522695 0.623772 1.363366 0.795679 0.991955 1.735746 1.166232 1.233433 0.033448 1.517164 1.590656 0.407889 1.837549 1.928075 0.698672 0.187906 0.288583 1.089091 0.525365 0.646727 1.419503 0.847075 1.003035 1.770682 1.222701 1.368528 0.132834 1.552702 1.702988 0.486356 1.942867 0.028321 0.834453 0.305865 0.427874 1.193367 0.646670 0.777994 1.535326 0.959127 1.141152 1.974723 1.386313 1.482039 0.241727 1.733430 1.907279 0.652190 0.113225 0.233654 1.053634 0.521015 0.606360 1.407458 0.868195 0.979596 1.802838 1.252544 1.387190 0.144685 1.620697 1.765258 0.551267 0.016634 0.102630 0.966227 0.379774 0.557760 1.339080 0.772792 0.943942 1.714448 1.227165 1.340588 0.135412 1.553794 1.733262 0.505137 0.052411 0.115242 0.903954 0.369383 0.566147 1.338694 0.822997 0.955372 1.767911 1.219397 1.351801 0.123533 1.574789 1.767438 0.582707 0.059344 0.173569 0.987297 0.434401 0.616641 1.368611 0.898977 1.018679 1.815949 1.269299 1.423987 0.244273 1.756592 1.844278 0.628834 0.156429 0.267440 1.098495 0.557657 0.757430 1.527200 1.032316 1.157667 1.941839 1.435329 1.592128 0.417339 1.857219 0.027921 0.825078 0.326257 0.472209 1.266409 0.776877 0.907550 1.713542 1.197483 1.352897 0.148954 1.643699 1.805895 0.598148 0.109639 0.271416 1.099053 0.556356 0.664165 1.505314 0.973330 1.224262 1.958351 1.490436 1.656174 0.418476 1.960327 0.146807 0.899660 0.444751 0.550436 1.400125 0.831060 1.011690 1.850969 1.328814 1.486005 0.311620 1.812294 -0.006342 0.797723 0.305173 0.491901 1.322423 0.745375 0.923548 1.782732 1.275234 1.378532 0.222379 1.713386 1.920722 0.741433 0.280929 0.401426 1.209280 0.698837 0.886341 1.726784 1.225163 1.413939 0.172159 1.726536 1.893106 0.754636 0.203236 0.351446 1.190416 0.680791 0.829406 1.684757 1.210208 1.371232 0.224484 1.699825 1.891292 0.738873 0.258642 0.425836 1.243225 0.713196 0.891190 1.771850 1.235681 1.368819 0.270358 1.784768 1.928168 0.781510 0.284144 0.430703 1.331232 0.807861 0.993486 1.852203 1.325750 1.549374 0.376307 1.889520 0.034521 0.884377 0.427788 0.583618 1.373059 0.934920 1.074386 1.964373 1.419552 1.645249 0.489767 0.008746 0.185928 1.061283 0.556624 0.715745 1.608195 1.103831 1.267216 0.164802 1.613900 1.850921 0.624698 0.161160 0.408839 1.261772 0.735470 0.975590 1.782335 1.311907 1.475716 0.390097 1.869546 0.060780 0.873934 0.410643 0.589799 1.451558 0.998661 1.152970 0.054633 1.557268 1.731872 0.575393 0.117821 0.307307 1.198887 0.683313 0.897819 1.753607 1.284857 1.473685 0.314273 1.836871 0.060820 0.932547 0.420398 0.613590 1.461860 1.038061 1.203207 0.095116 1.584547 1.810340 0.624226 0.177690 0.397754 1.253072 0.802314 0.987311 1.879162 1.342549 1.566135 0.442620 1.908917 0.137619 1.011650 0.599336 0.755517 1.642027 1.174961 1.369054 0.211942 1.782659 -0.010486 0.840251 0.357521 0.581790 1.461271 1.014049 1.200403 0.044641 1.613689 1.808581 0.690100 0.250270 0.388899 1.294231 0.842257 1.021201 1.901029 1.462877 1.641210 0.546531 0.075531 0.291167 1.142643 0.703128 0.915213 1.799433 1.361706 1.526251 0.463549 1.971569 0.185024 1.029933 0.578985 0.824751 1.713096 1.250117 1.463497 0.301505 1.881822 0.143407 0.962817 0.507734 0.729352 1.590586 1.169240 1.393909 0.249757 1.802780 0.053110 0.895331 0.464179 0.669201 1.582612 1.097231 1.355127 0.231353 1.735403 0.021720 0.880348 0.431395 0.697354 1.573165 1.060767 1.347507 0.185124 1.772265 1.983494 0.879718 0.443530 0.687541 1.535902 1.151743 1.322419 0.212153 1.745041 -0.024853 0.929578 0.461659 0.706048 1.575808 1.122374 1.345663 0.241665 1.798693 0.038133 0.893828 0.497759 0.738405 1.619233 1.230529 1.391018 0.311367 1.875986 0.111417 0.982712 0.552692 0.779545 1.673926 1.277817 1.495634 0.424964 1.933807 0.193663 1.085748 0.635034 0.877002 1.797408 1.324014 1.603040 0.515913 0.114700 0.279027 1.230954 0.738758 0.971164 1.923699 1.522824 1.758904 0.629325 0.199968 0.431971 1.357304 0.920686 1.144660 0.047634 1.638457 1.887367 0.770386 0.339803 0.608798 1.474763 1.082399 1.336813 0.240373 1.815488 0.071521 0.978055 0.575127 0.812951 1.691650 1.236419 1.523987 0.428018 -0.014053 0.227398 1.211471 0.739843 1.033454 1.889876 1.490608 1.764875 0.650358 0.197774 0.479040 1.394298 0.990877 1.266721 0.153708 1.743738 1.993903 0.889105 0.452779 0.717556 1.641719 1.258531 1.472505 0.400527 0.003181 0.277816 1.190582 0.720088 1.018145 1.947482 1.529759 1.763205 0.679772 0.305019 0.551595 1.459782 1.056328 1.376741 0.254961 1.837237 0.083779 1.033490 0.597121 0.863372 1.752800 1.369817 1.661724 0.554009 0.132249 0.412929 1.366488 0.929237 1.205521 0.153686 1.780997 0.028187 0.910073 0.518459 0.747299 1.736440 1.285832 1.584544 0.515963 0.139650 0.379555 1.267964 0.869992 1.153100 0.094361 1.717865 1.955775 0.900339 0.490824 0.754072 1.676728 1.277159 1.570274 0.491155 0.127499 0.354589 1.327580 0.971916 1.203157 0.189781 1.749254 -0.000141 0.971242 0.569275 0.834995 1.792334 1.386324 1.620367 0.641313 0.177512 0.493821 1.395372 1.027112 1.276574 0.195767 1.840052 0.118782 1.057366 0.655353 0.981627 1.889857 1.497516 1.809949 0.727076 0.311895 0.619859 1.589373 1.177776 1.446089 0.402884 -0.013138 0.323859 1.242590 0.872932 1.139811 0.103389 1.705727 0.012476 0.932654 0.580713 0.844428 1.776557 1.375650 1.683357 0.653489 0.286018 0.530346 1.477873 1.102629 1.446550 0.391220 0.013493 0.315912 1.191737 0.889652 1.135899 0.064317 1.726753 0.008311 0.973187 0.561368 0.881325 1.835182 1.452878 1.728216 0.640203 0.296506 0.611465 1.537761 1.163681 1.521594 0.455106 0.113603 0.376193 1.335690 0.990813 1.252928 0.217355 1.798201 0.130538 1.099312 0.694187 1.042508 1.990873 1.625313 1.908796 0.833102 0.534393 0.775983 1.784275 1.381831 1.684754 0.630094 0.272616 0.575688 1.559911 1.184625 1.453679 0.491431 0.104067 0.400708 1.342106 0.977889 1.261797 0.248038 1.904884 0.237792 1.209205 0.805676 1.119936 0.155727 1.752922 0.098394 1.023110 0.709066 0.956558 1.945167 1.621782 1.885544 0.851378 0.511350 0.815303 1.752479 1.417551 1.712996 0.651328 0.341725 0.648800 1.652874 1.229749 1.564655 0.595314 0.162557 0.496357 1.536686 1.115189 1.443475 0.423294 0.108662 0.395018 1.332526 0.999816 1.352353 0.328398 1.960089 0.256657 1.276205 0.950110 1.251154 0.223763 1.856947 0.198310 1.202811 0.823347 1.139257 0.137493 1.791954 0.126818 1.077613 0.742716 1.034617 0.042667 1.702855 0.035869 0.942965 0.683955 0.962192 1.957952 1.636826 1.953521 0.904062 0.576569 0.908521 1.946168 1.527121 1.835900 0.915076 0.530360 0.860954 1.848124 1.476416 1.825816 0.801278 0.498232 0.791951 1.825898 1.460369 1.801238 0.807022 0.470147 0.775520 1.782957 1.421022 1.758922 0.747391 0.412834 0.729983 1.748458 1.430447 1.754281 0.725069 0.444203 0.754125 1.805117 1.457795 1.776284 0.724624 0.428724 0.744488 1.781494 1.483810 1.771396 0.825589 0.485350 0.772930 1.812210 1.489700 1.842892 0.808972 0.497919 0.826699 1.849758 1.501581 1.863781 0.830698 0.510646 0.856199 1.880392 1.487637 1.841337 0.883565 0.587660 0.933592 1.879899 1.575694 1.912690 0.882053 0.596355 0.876449 1.942318 1.604954 1.957913 0.991402 0.632658 0.965194 -0.031486 1.680264 0.039739 1.057207 0.660079 1.072774 0.084190 1.760660 0.122642 1.146243 0.783356 1.166710 0.158916 1.820281 0.220718 1.231907 0.956518 1.285669 0.300669 1.936753 0.315132 1.335110 1.060246 1.374454 0.394758 0.082667 0.417144 1.497357 1.121455 1.497524 0.558460 0.253594 0.585079 1.609798 1.353184 1.698378 0.628590 0.358364 0.702657 1.718959 1.448521 1.778728 0.811121 0.552978 0.858398 1.901305 1.551915 1.964990 1.006942 0.659821 0.990952 0.063543 1.773494 0.063737 1.160916 0.874963 1.254235 0.227903 1.909287 0.327897 1.310953 0.994777 1.331010 0.411728 0.136015 0.418712 1.516878 1.254075 1.541807 0.597800 0.341732 0.654709 1.684819 1.408026 1.806837 0.819367 0.523512 0.857369 1.895100 1.607979 1.949425 0.987941 0.703347 1.084034 0.136539 1.830122 0.250645 1.285193 0.947170 1.289548 0.328696 0.029933 0.461597 1.469311 1.207559 1.503925 0.619432 0.268080 0.678945 1.716381 1.398922 1.858266 0.884402 0.579547 0.942855 -0.007780 1.697643 0.060832 1.147089 0.859119 1.243156 0.279683 1.948552 0.303518 1.436858 1.120717 1.478393 0.523558 0.237367 0.599745 1.706188 1.421576 1.811698 0.850440 0.556037 0.945518 -0.871745 1.728994 0.072385 1.111766 0.835570 1.223297 0.269709 0.056622 0.355706 1.422876 1.147014 1.551471 0.600627 0.344660 0.724082 1.763987 1.516159 1.882823 0.942715 0.661410 1.033320 0.094097 1.855748 0.231455 1.280646 1.044202 1.442450 0.460350 0.194810 0.625856 1.678168 1.370560 1.773190 0.847696 0.600688 1.001562 0.035016 1.824811 0.145896 1.197674 0.963152 1.364275 0.436987 0.180547 0.564604 1.641854 1.399407 1.733896 0.850418 0.609483 0.927674)
+ 50.887273 #r(0.000000 -0.001703 0.433172 1.590778 1.336810 1.796101 0.945990 0.630649 1.068973 0.276030 0.019619 0.418921 1.642205 1.314880 1.815562 0.937954 0.690335 1.166456 0.260174 0.033467 0.534551 1.577952 1.359691 1.855935 0.978115 0.778145 1.214744 0.305514 0.073250 0.585950 1.700979 1.456846 1.891326 1.051448 0.870291 1.262779 0.419868 0.209104 0.667538 1.764244 1.534253 0.022691 1.157333 0.886455 1.397513 0.522770 0.305417 0.791572 1.882641 1.706581 0.124613 1.245754 1.016938 1.507704 0.621789 0.423116 0.882723 0.034318 1.775279 0.266045 1.420137 1.176158 1.620182 0.842558 0.553079 1.037944 0.182615 0.005162 0.432646 1.577593 1.375077 1.777427 0.999839 0.726166 1.218120 0.366911 0.123723 0.662290 1.808464 1.555557 0.050943 1.161441 0.961088 1.469391 0.581778 0.421014 0.869182 1.964711 1.782785 0.217679 1.412311 1.228590 1.681851 0.818320 0.617489 1.120821 0.226824 0.041870 0.539030 1.644423 1.496409 1.937912 1.088438 0.861771 1.374952 0.504902 0.301816 0.831900 1.946273 1.700988 0.237333 1.351841 1.174113 1.697709 0.766188 0.601502 1.097799 0.223664 0.073707 0.490731 1.705779 1.529713 0.004900 1.114151 0.927806 1.413217 0.593263 0.370397 0.876728 0.024219 1.840075 0.345172 1.498140 1.311278 1.774455 0.911735 0.779474 1.231046 0.351370 0.170176 0.732535 1.828332 1.647912 0.151754 1.304922 1.134715 1.583698 0.773654 0.612595 1.042987 0.199634 0.036653 0.549756 1.681847 1.475587 0.005194 1.173802 0.977842 1.470305 0.643755 0.476622 0.917721 0.111850 1.936419 0.450243 1.616355 1.416777 1.915014 1.098462 0.907664 1.447783 0.570918 0.405291 0.889269 0.066991 1.881365 0.373330 1.508358 1.402579 1.870612 1.085131 0.920739 1.348392 0.568783 0.336415 0.843225 0.063446 1.926774 0.418106 1.565445 1.379520 1.897103 1.050320 0.891564 1.380927 0.530987 0.385626 0.908446 0.068664 1.943935 0.430612 1.518729 1.398232 1.924184 1.103625 0.924587 1.417433 0.610522 0.456479 0.953409 0.112059 0.013043 0.495872 1.633744 1.493163 0.038519 1.187544 1.048687 1.588579 0.748576 0.532785 1.100237 0.281535 0.104911 0.635452 1.811612 1.634030 0.184177 1.345558 1.153862 1.750039 0.857060 0.732788 1.250092 0.418042 0.246015 0.725057 1.972355 1.807991 0.351695 1.540788 1.347415 1.848165 1.067747 0.908528 1.413312 0.618180 0.467879 0.991799 0.190738 0.053795 0.507730 1.744900 1.620134 0.124619 1.318661 1.152397 1.685590 0.894836 0.688791 1.239521 0.488835 0.282246 0.831794 -0.015794 1.883123 0.431031 1.583860 1.447618 1.964025 1.125655 1.064343 1.569856 0.748855 0.603708 1.107653 0.309052 0.196774 0.696407 1.871049 1.742283 0.240318 1.473905 1.321207 1.881514 1.047815 0.924156 1.493868 0.689863 0.543896 1.026203 0.246976 0.140944 0.678125 1.870899 1.706720 0.276250 1.408196 1.319078 1.889412 1.061123 0.937583 1.451370 0.684034 0.567548 1.075578 0.293854 0.180105 0.705838 1.911360 1.764817 0.292975 1.493988 1.411105 1.895989 1.081687 1.012629 1.575334 0.718344 0.628406 1.174951 0.386415 0.230260 0.768066 -0.015753 1.886981 0.454216 1.616098 1.441778 0.077596 1.316514 1.144927 1.696140 0.867400 0.757625 1.309429 0.563210 0.364175 0.954929 0.137349 0.057751 0.597415 1.789122 1.677288 0.252684 1.417924 1.313555 1.862237 1.126315 1.015807 1.510443 0.802206 0.652057 1.184565 0.404523 0.277585 0.843687 0.148971 1.933489 0.514414 1.743011 1.592866 0.129290 1.346399 1.259419 1.817805 1.029171 0.962338 1.475532 0.708188 0.633076 1.151811 0.395581 0.307725 0.834201 0.078405 1.959228 0.466843 1.769721 1.650538 0.159441 1.402559 1.321215 1.914285 1.128095 1.014297 1.571134 0.803693 0.677208 1.246457 0.469701 0.356795 0.908733 0.149102 0.035900 0.615966 1.826481 1.708851 0.339243 1.554134 1.413247 -0.028956 1.251019 1.106816 1.704569 0.926586 0.827768 1.430366 0.655894 0.524343 1.153832 0.363573 0.234391 0.825975 0.037037 1.955590 0.487803 1.776970 1.679179 0.270247 1.494959 1.379330 1.956206 1.186819 1.071982 1.644518 0.897716 0.759160 1.349574 0.601679 0.512657 1.067152 0.367997 0.259056 0.818805 0.070970 1.979460 0.551129 1.797928 1.685198 0.237267 1.508404 1.457352 0.047420 1.261021 1.192815 1.789893 0.995526 0.930294 1.496757 0.778086 0.636312 1.222185 0.505076 0.392642 1.016934 0.236492 0.140361 0.774022 0.001411 1.961469 0.498526 1.750119 1.648169 0.240766 1.450209 1.419896 0.004281 1.237513 1.195486 1.793570 1.030159 0.946491 1.529067 0.769460 0.726220 1.269159 0.564615 0.472841 1.084479 0.322182 0.217540 0.870218 0.092806 0.039652 0.580465 1.871900 1.768958 0.330755 1.643083 1.574291 0.148815 1.382016 1.330434 1.953984 1.191904 1.113085 1.729795 0.935173 0.941506 1.487573 0.777735 0.706146 1.300602 0.552074 0.471965 1.086702 0.368313 0.238388 0.870358 0.129144 0.034415 0.647185 1.956907 1.855191 0.450494 1.695322 1.674270 0.277115 1.525710 1.462245 0.090299 1.329096 1.259635 1.870782 1.128184 1.069973 1.694787 0.953585 0.907980 1.546930 0.802555 0.747675 1.322734 0.664094 0.527920 1.163169 0.460332 0.399285 0.970040 0.217204 0.171752 0.769371 0.047350 -0.025234 0.632915 1.894302 1.830249 0.455254 1.760595 1.701533 0.321139 1.541634 1.515918 0.102674 1.367783 1.346029 1.941486 1.223287 1.213347 1.782946 1.029999 1.005092 1.692642 0.911840 0.875191 1.494140 0.757479 0.727400 1.310293 0.611635 0.559689 1.154763 0.453641 0.402989 1.051223 0.342693 0.309148 0.919084 0.199108 0.132609 0.759042 0.053229 -0.033954 0.648811 1.906240 1.894740 0.483288 1.798246 1.730147 0.369025 1.616846 1.576788 0.217080 1.494201 1.461719 0.088483 1.386902 1.325078 1.982480 1.249756 1.217589 1.872681 1.143670 1.127132 1.742603 1.001258 0.969685 1.653400 0.948140 0.903244 1.474757 0.844045 0.804740 1.381313 0.669059 0.696990 1.287624 0.590259 0.542974 1.139086 0.529408 0.444238 1.060949 0.381119 0.387330 0.982887 0.274265 0.262799 0.892622 0.182183 0.155238 0.802580 0.125716 0.062385 0.697970 -0.029110 -0.005740 0.631814 1.935506 1.905147 0.526743 1.805035 1.822539 0.427610 1.754204 1.769095 0.334244 1.671094 1.648758 0.313430 1.604455 1.580989 0.249732 1.534106 1.501925 0.141332 1.456591 1.376333 0.087064 1.395898 1.349285 -0.007846 1.309141 1.324784 1.926752 1.235223 1.257013 1.870695 1.183965 1.196890 1.833185 1.161076 1.134259 1.737981 1.066217 1.029285 1.761061 1.046404 1.003567 1.669085 1.015282 0.945700 1.628153 0.957401 0.910198 1.578015 0.892702 0.920061 1.560411 0.892643 0.883270 1.499087 0.881141 0.786754 1.465346 0.814870 0.806704 1.420951 0.745568 0.748981 1.428779 0.724569 0.722331 1.414318 0.735199 0.680304 1.412191 0.642055 0.663317 1.362918 0.692620 0.652852 1.255275 0.655029 0.616540 1.306668 0.607368 0.596378 1.278318 0.605729 0.626127 1.248672 0.605969 0.598531 1.270199 0.590247 0.604018 1.248420 0.564539 0.573991 1.243120 0.541247 0.581568 1.247013 0.548311 0.583389 1.254363 0.570054 0.592870 1.314918 0.584147 0.601170 1.285128 0.585385 0.636800 1.268157 0.564860 0.618673 1.241680 0.593206 0.649499 1.294308 0.619335 0.690828 1.290074 0.662251 0.659564 1.319465 0.684267 0.676527 1.346573 0.684074 0.749941 1.376399 0.760563 0.735778 1.409735 0.781193 0.776861 1.424608 0.803012 0.794890 1.482330 0.849249 0.820388 1.516581 0.910615 0.864461 1.540065 0.895368 0.913334 1.630286 0.950361 0.962747 1.686669 0.985439 1.020247 1.674781 0.998529 1.106931 1.784420 1.109819 1.080550 1.792617 1.141848 1.167488 1.815820 1.225904 1.216862 1.932151 1.308230 1.267897 -0.026968 1.330184 1.385176 0.022707 1.458233 1.415333 0.128552 1.487923 1.523242 0.191001 1.550003 1.584242 0.283355 1.596921 1.662782 0.308217 1.689429 1.701664 0.432683 1.765615 1.799785 0.477706 1.814969 1.847473 0.536692 1.956606 -0.125001 0.671687 0.021081 0.062099 0.778322 0.143122 0.195164 0.870404 0.217515 0.248340 0.992771 0.296311 0.393796 1.036703 0.444136 0.428455 1.144392 0.545916 0.532816 1.274635 0.638559 0.682382 1.366079 0.738438 0.791235 1.469530 0.832133 0.861591 1.597033 0.965134 0.975949 1.660906 1.074595 1.121780 1.850802 1.205711 1.200292 1.955639 1.297951 1.320764 0.075418 1.456186 1.481933 0.158684 1.566840 1.641287 0.359580 1.677476 1.730799 0.448508 1.815321 1.873655 0.540161 1.931330 1.974330 0.742536 0.063433 0.156314 0.825290 0.223991 0.306298 0.962765 0.360970 0.418863 1.127740 0.516243 0.542975 1.312005 0.652439 0.710545 1.452213 0.776568 0.871797 1.548353 0.973587 1.004549 1.725321 1.089618 1.233086 1.882229 1.280829 1.345266 0.036253 1.417172 1.451706 0.202998 1.622238 1.674924 0.340016 1.728728 1.833591 0.567298 1.946042 0.023405 0.702356 0.135275 0.153799 0.884198 0.265400 0.340889 1.099730 0.493458 0.526956 1.267239 0.676407 0.690082 1.422573 0.812500 0.926029 1.644040 1.074851 1.097114 1.811626 1.221109 1.268846 0.019885 1.418865 1.465834 0.226550 1.602283 1.642652 0.409600 1.782663 1.847764 0.612518 -0.014414 0.080272 0.793644 0.189642 0.287941 1.015956 0.430798 0.498270 1.212055 0.606553 0.678263 1.458990 0.847157 0.901708 1.629236 1.030896 1.120792 1.854770 1.260369 1.292084 0.058109 1.472251 1.530032 0.298666 1.686445 1.750885 0.465407 1.926615 -0.015762 0.736186 0.179728 0.219514 0.995121 0.367989 0.459496 1.186779 0.640597 0.690551 1.458450 0.858324 0.911511 1.699195 1.068188 1.186092 1.897316 1.337175 1.402416 0.144009 1.638297 1.673138 0.373403 1.812913 1.888979 0.630635 0.080370 0.169331 0.914815 0.273060 0.393754 1.122091 0.596144 0.640794 1.390765 0.839105 0.918214 1.680880 1.131151 1.205710 1.974811 1.393861 1.452322 0.156477 1.645144 1.718367 0.451059 1.878144 0.022469 0.716191 0.203622 0.204052 1.000934 0.419218 0.531168 1.297295 0.702318 0.799989 1.534195 0.962961 1.059623 1.864764 1.322381 1.390676 0.140300 1.535535 1.653796 0.423232 1.846167 1.958815 0.705134 0.115159 0.251430 1.006465 0.470237 0.504026 1.267250 0.734232 0.836445 1.549915 1.039694 1.136664 1.905550 1.321296 1.400727 0.208474 1.633666 1.709003 0.486386 1.940896 0.025205 0.789590 0.229116 0.395199 1.113150 0.560152 0.653681 1.459139 0.830910 0.975236 1.738577 1.210343 1.308624 0.093706 1.493739 1.620053 0.424641 1.828846 1.940485 0.729339 0.163547 0.294790 1.029106 0.522695 0.623772 1.363366 0.795679 0.991955 1.735746 1.166232 1.233433 0.033448 1.517164 1.590656 0.407889 1.837549 1.928075 0.698672 0.187906 0.288583 1.089091 0.525365 0.646727 1.419503 0.847075 1.003035 1.770682 1.222701 1.368528 0.132834 1.552702 1.702988 0.486356 1.942867 0.028321 0.834453 0.305865 0.427874 1.193367 0.646670 0.777994 1.535326 0.959127 1.141152 1.974723 1.386313 1.482039 0.241727 1.733430 1.907279 0.652190 0.113225 0.233654 1.053634 0.521015 0.606360 1.407458 0.868195 0.979596 1.802838 1.252544 1.387190 0.144685 1.620697 1.765258 0.551267 0.016634 0.102630 0.966227 0.379774 0.557760 1.339080 0.772792 0.943942 1.714448 1.227165 1.340588 0.135412 1.553794 1.733262 0.505137 0.052411 0.115242 0.903954 0.369383 0.566147 1.338694 0.822997 0.955372 1.767911 1.219397 1.351801 0.123533 1.574789 1.767438 0.582707 0.059344 0.173569 0.987297 0.434401 0.616641 1.368611 0.898977 1.018679 1.815949 1.269299 1.423987 0.244273 1.756592 1.844278 0.628834 0.156429 0.267440 1.098495 0.557657 0.757430 1.527200 1.032316 1.157667 1.941839 1.435329 1.592128 0.417339 1.857219 0.027921 0.825078 0.326257 0.472209 1.266409 0.776877 0.907550 1.713542 1.197483 1.352897 0.148954 1.643699 1.805895 0.598148 0.109639 0.271416 1.099053 0.556356 0.664165 1.505314 0.973330 1.224262 1.958351 1.490436 1.656174 0.418476 1.960327 0.146807 0.899660 0.444751 0.550436 1.400125 0.831060 1.011690 1.850969 1.328814 1.486005 0.311620 1.812294 -0.006342 0.797723 0.305173 0.491901 1.322423 0.745375 0.923548 1.782732 1.275234 1.378532 0.222379 1.713386 1.920722 0.741433 0.280929 0.401426 1.209280 0.698837 0.886341 1.726784 1.225163 1.413939 0.172159 1.726536 1.893106 0.754636 0.203236 0.351446 1.190416 0.680791 0.829406 1.684757 1.210208 1.371232 0.224484 1.699825 1.891292 0.738873 0.258642 0.425836 1.243225 0.713196 0.891190 1.771850 1.235681 1.368819 0.270358 1.784768 1.928168 0.781510 0.284144 0.430703 1.331232 0.807861 0.993486 1.852203 1.325750 1.549374 0.376307 1.889520 0.034521 0.884377 0.427788 0.583618 1.373059 0.934920 1.074386 1.964373 1.419552 1.645249 0.489767 0.008746 0.185928 1.061283 0.556624 0.715745 1.608195 1.103831 1.267216 0.164802 1.613900 1.850921 0.624698 0.161160 0.408839 1.261772 0.735470 0.975590 1.782335 1.311907 1.475716 0.390097 1.869546 0.060780 0.873934 0.410643 0.589799 1.451558 0.998661 1.152970 0.054633 1.557268 1.731872 0.575393 0.117821 0.307307 1.198887 0.683313 0.897819 1.753607 1.284857 1.473685 0.314273 1.836871 0.060820 0.932547 0.420398 0.613590 1.461860 1.038061 1.203207 0.095116 1.584547 1.810340 0.624226 0.177690 0.397754 1.253072 0.802314 0.987311 1.879162 1.342549 1.566135 0.442620 1.908917 0.137619 1.011650 0.599336 0.755517 1.642027 1.174961 1.369054 0.211942 1.782659 -0.010486 0.840251 0.357521 0.581790 1.461271 1.014049 1.200403 0.044641 1.613689 1.808581 0.690100 0.250270 0.388899 1.294231 0.842257 1.021201 1.901029 1.462877 1.641210 0.546531 0.075531 0.291167 1.142643 0.703128 0.915213 1.799433 1.361706 1.526251 0.463549 1.971569 0.185024 1.029933 0.578985 0.824751 1.713096 1.250117 1.463497 0.301505 1.881822 0.143407 0.962817 0.507734 0.729352 1.590586 1.169240 1.393909 0.249757 1.802780 0.053110 0.895331 0.464179 0.669201 1.582612 1.097231 1.355127 0.231353 1.735403 0.021720 0.880348 0.431395 0.697354 1.573165 1.060767 1.347507 0.185124 1.772265 1.983494 0.879718 0.443530 0.687541 1.535902 1.151743 1.322419 0.212153 1.745041 -0.024853 0.929578 0.461659 0.706048 1.575808 1.122374 1.345663 0.241665 1.798693 0.038133 0.893828 0.497759 0.738405 1.619233 1.230529 1.391018 0.311367 1.875986 0.111417 0.982712 0.552692 0.779545 1.673926 1.277817 1.495634 0.424964 1.933807 0.193663 1.085748 0.635034 0.877002 1.797408 1.324014 1.603040 0.515913 0.114700 0.279027 1.230954 0.738758 0.971164 1.923699 1.522824 1.758904 0.629325 0.199968 0.431971 1.357304 0.920686 1.144660 0.047634 1.638457 1.887367 0.770386 0.339803 0.608798 1.474763 1.082399 1.336813 0.240373 1.815488 0.071521 0.978055 0.575127 0.812951 1.691650 1.236419 1.523987 0.428018 -0.014053 0.227398 1.211471 0.739843 1.033454 1.889876 1.490608 1.764875 0.650358 0.197774 0.479040 1.394298 0.990877 1.266721 0.153708 1.743738 1.993903 0.889105 0.452779 0.717556 1.641719 1.258531 1.472505 0.400527 0.003181 0.277816 1.190582 0.720088 1.018145 1.947482 1.529759 1.763205 0.679772 0.305019 0.551595 1.459782 1.056328 1.376741 0.254961 1.837237 0.083779 1.033490 0.597121 0.863372 1.752800 1.369817 1.661724 0.554009 0.132249 0.412929 1.366488 0.929237 1.205521 0.153686 1.780997 0.028187 0.910073 0.518459 0.747299 1.736440 1.285832 1.584544 0.515963 0.139650 0.379555 1.267964 0.869992 1.153100 0.094361 1.717865 1.955775 0.900339 0.490824 0.754072 1.676728 1.277159 1.570274 0.491155 0.127499 0.354589 1.327580 0.971916 1.203157 0.189781 1.749254 -0.000141 0.971242 0.569275 0.834995 1.792334 1.386324 1.620367 0.641313 0.177512 0.493821 1.395372 1.027112 1.276574 0.195767 1.840052 0.118782 1.057366 0.655353 0.981627 1.889857 1.497516 1.809949 0.727076 0.311895 0.619859 1.589373 1.177776 1.446089 0.402884 -0.013138 0.323859 1.242590 0.872932 1.139811 0.103389 1.705727 0.012476 0.932654 0.580713 0.844428 1.776557 1.375650 1.683357 0.653489 0.286018 0.530346 1.477873 1.102629 1.446550 0.391220 0.013493 0.315912 1.191737 0.889652 1.135899 0.064317 1.726753 0.008311 0.973187 0.561368 0.881325 1.835182 1.452878 1.728216 0.640203 0.296506 0.611465 1.537761 1.163681 1.521594 0.455106 0.113603 0.376193 1.335690 0.990813 1.252928 0.217355 1.798201 0.130538 1.099312 0.694187 1.042508 1.990873 1.625313 1.908796 0.833102 0.534393 0.775983 1.784275 1.381831 1.684754 0.630094 0.272616 0.575688 1.559911 1.184625 1.453679 0.491431 0.104067 0.400708 1.342106 0.977889 1.261797 0.248038 1.904884 0.237792 1.209205 0.805676 1.119936 0.155727 1.752922 0.098394 1.023110 0.709066 0.956558 1.945167 1.621782 1.885544 0.851378 0.511350 0.815303 1.752479 1.417551 1.712996 0.651328 0.341725 0.648800 1.652874 1.229749 1.564655 0.595314 0.162557 0.496357 1.536686 1.115189 1.443475 0.423294 0.108662 0.395018 1.332526 0.999816 1.352353 0.328398 1.960089 0.256657 1.276205 0.950110 1.251154 0.223763 1.856947 0.198310 1.202811 0.823347 1.139257 0.137493 1.791954 0.126818 1.077613 0.742716 1.034617 0.042667 1.702855 0.035869 0.942965 0.683955 0.962192 1.957952 1.636826 1.953521 0.904062 0.576569 0.908521 1.946168 1.527121 1.835900 0.915076 0.530360 0.860954 1.848124 1.476416 1.825816 0.801278 0.498232 0.791951 1.825898 1.460369 1.801238 0.807022 0.470147 0.775520 1.782957 1.421022 1.758922 0.747391 0.412834 0.729983 1.748458 1.430447 1.754281 0.725069 0.444203 0.754125 1.805117 1.457795 1.776284 0.724624 0.428724 0.744488 1.781494 1.483810 1.771396 0.825589 0.485350 0.772930 1.812210 1.489700 1.842892 0.808972 0.497919 0.826699 1.849758 1.501581 1.863781 0.830698 0.510646 0.856199 1.880392 1.487637 1.841337 0.883565 0.587660 0.933592 1.879899 1.575694 1.912690 0.882053 0.596355 0.876449 1.942318 1.604954 1.957913 0.991402 0.632658 0.965194 -0.031486 1.680264 0.039739 1.057207 0.660079 1.072774 0.084190 1.760660 0.122642 1.146243 0.783356 1.166710 0.158916 1.820281 0.220718 1.231907 0.956518 1.285669 0.300669 1.936753 0.315132 1.335110 1.060246 1.374454 0.394758 0.082667 0.417144 1.497357 1.121455 1.497524 0.558460 0.253594 0.585079 1.609798 1.353184 1.698378 0.628590 0.358364 0.702657 1.718959 1.448521 1.778728 0.811121 0.552978 0.858398 1.901305 1.551915 1.964990 1.006942 0.659821 0.990952 0.063543 1.773494 0.063737 1.160916 0.874963 1.254235 0.227903 1.909287 0.327897 1.310953 0.994777 1.331010 0.411728 0.136015 0.418712 1.516878 1.254075 1.541807 0.597800 0.341732 0.654709 1.684819 1.408026 1.806837 0.819367 0.523512 0.857369 1.895100 1.607979 1.949425 0.987941 0.703347 1.084034 0.136539 1.830122 0.250645 1.285193 0.947170 1.289548 0.328696 0.029933 0.461597 1.469311 1.207559 1.503925 0.619432 0.268080 0.678945 1.716381 1.398922 1.858266 0.884402 0.579547 0.942855 -0.007780 1.697643 0.060832 1.147089 0.859119 1.243156 0.279683 1.948552 0.303518 1.436858 1.120717 1.478393 0.523558 0.237367 0.599745 1.706188 1.421576 1.811698 0.850440 0.556037 0.945518 -0.871745 1.728994 0.072385 1.111766 0.835570 1.223297 0.269709 0.056622 0.355706 1.422876 1.147014 1.551471 0.600627 0.344660 0.724082 1.763987 1.516159 1.882823 0.942715 0.661410 1.033320 0.094097 1.855748 0.231455 1.280646 1.044202 1.442450 0.460350 0.194810 0.625856 1.678168 1.370560 1.773190 0.847696 0.600688 1.001562 0.035016 1.824811 0.145896 1.197674 0.963152 1.364275 0.436987 0.180547 0.564604 1.641854 1.399407 1.733896 0.850418 0.609483 0.927674)
)
))
@@ -4465,7 +4464,7 @@
(incr 0.0001)
(mx 0.0)
(loc 0.0)
- (x 0.0 (+ x incr)))
+ (x 0.0))
((> x (* 2 pi))
(list mx loc))
(do ((val 0.0)
@@ -4475,7 +4474,8 @@
(when (> (abs val) mx)
(set! mx (abs val))
(set! loc x)))
- (set! val (+ val (sin (+ (* j x) (* pi (phs k)))))))))
+ (set! val (+ val (sin (+ (* j x) (* pi (phs k)))))))
+ (set! x (+ x incr))))
(define (tstoddderiv x phs)
@@ -4493,7 +4493,7 @@
(incr 0.0001)
(mx 0.0)
(loc 0.0)
- (x 0.0 (+ x incr)))
+ (x 0.0))
((> x (* 2 pi))
(list mx loc))
(do ((val 0.0)
@@ -4503,14 +4503,15 @@
(when (> (abs val) mx)
(set! mx (abs val))
(set! loc x)))
- (set! val (+ val (sin (+ (* j x) (* pi (phs k)))))))))
+ (set! val (+ val (sin (+ (* j x) (* pi (phs k)))))))
+ (set! x (+ x incr))))
(define (tstallf mult phs)
(do ((len (length phs))
(incr 0.0001)
(mx 0.0)
(loc 0.0)
- (x 0.0 (+ x incr)))
+ (x 0.0))
((> x (* 2 pi))
(list mx loc))
(do ((val 0.0)
@@ -4522,14 +4523,15 @@
(set! loc x)))
(set! val (+ val (if (= k (- len 1))
(* mult (sin (+ (* j x) (* pi (phs k)))))
- (sin (+ (* j x) (* pi (phs k))))))))))
+ (sin (+ (* j x) (* pi (phs k))))))))
+ (set! x (+ x incr))))
(define (tsteven phs)
(do ((len (length phs))
(incr 0.0001)
(mx 0.0)
(loc 0.0)
- (x 0.0 (+ x incr)))
+ (x 0.0))
((> x (* 2 pi))
(list mx loc))
(do ((val 0.0)
@@ -4538,14 +4540,15 @@
(when (> (abs val) mx)
(set! mx (abs val))
(set! loc x)))
- (set! val (+ val (sin (+ (* (max (* 2 k) 1) x) (* pi (phs k)))))))))
+ (set! val (+ val (sin (+ (* (max (* 2 k) 1) x) (* pi (phs k)))))))
+ (set! x (+ x incr))))
(define (tstprime phs)
(do ((len (length phs))
(incr 0.0001)
(mx 0.0)
(loc 0.0)
- (x 0.0 (+ x incr)))
+ (x 0.0))
((> x (* 2 pi))
(list mx loc))
(do ((val 0.0)
@@ -4554,7 +4557,8 @@
(when (> (abs val) mx)
(set! mx (abs val))
(set! loc x)))
- (set! val (+ val (sin (+ (* (primes k) x) (* pi (phs k)))))))))
+ (set! val (+ val (sin (+ (* (primes k) x) (* pi (phs k)))))))
+ (set! x (+ x incr))))
(define (tstallderiv x phs)
(do ((sum 0.0)
@@ -4607,25 +4611,27 @@
(mx (car phs-data))
(v (make-float-vector (ceiling (+ (* pi 2000) 2))))
(incr 0.001)
- (x 0.0 (+ x incr))
+ (x 0.0)
(i 0 (+ i 1)))
((> x (* 2 pi))
(new-sound)
(float-vector->channel v)
(set! (y-bounds) (list (- mx) mx)))
- (sum-sines v i x len phs))))
+ (sum-sines v i x len phs)
+ (set! x (+ x incr)))))
(define (showphases mx phs)
(do ((v (make-float-vector (ceiling (+ (* pi 2000) 2))))
(incr 0.001)
(len (length phs))
- (x 0.0 (+ x incr))
+ (x 0.0)
(i 0 (+ i 1)))
((> x (* 2 pi))
(new-sound)
(float-vector->channel v)
(set! (y-bounds) (list (- mx) mx)))
- (sum-sines v i x len phs)))
+ (sum-sines v i x len phs)
+ (set! x (+ x incr))))
(define (showodd len)
(let ((phs-data (get-best :odd len)))
@@ -4633,13 +4639,14 @@
(mx (car phs-data))
(v (make-float-vector (ceiling (+ (* pi 2000) 2))))
(incr 0.001)
- (x 0.0 (+ x incr))
+ (x 0.0)
(i 0 (+ i 1)))
((> x (* 2 pi))
(new-sound)
(float-vector->channel v)
(set! (y-bounds) (list (- mx) mx)))
- (sum-sines v i x len phs))))
+ (sum-sines v i x len phs)
+ (set! x (+ x incr)))))
(define (showdiff n1 n2)
(let ((len (length n1)))
@@ -4708,10 +4715,10 @@
results
))
-;;; :(find-other-mins (car (tstall #(0.0 0.1 0.2 0.3))) #(0.0 0.1 0.2 0.3))
-;;; 3.49630991 #(0.0 1.1 0.2 1.3)
-;;; 3.49630680 #(0.0 1.9 1.8 1.7)
-;;; 3.49630979 #(0.0 0.9 1.8 0.7)
+;;; :(find-other-mins (car (tstall #r(0.0 0.1 0.2 0.3))) #r(0.0 0.1 0.2 0.3))
+;;; 3.49630991 #r(0.0 1.1 0.2 1.3)
+;;; 3.49630680 #r(0.0 1.9 1.8 1.7)
+;;; 3.49630979 #r(0.0 0.9 1.8 0.7)
@@ -4746,7 +4753,7 @@
(let ((new-peak (car new-peak-info)))
(if (> (abs (- new-peak old-peak)) .001)
(format *stderr* "oops: ~D: ~A ~A~%" i old-peak new-peak))
- (format p "(vector ~D ~,6F #(" i new-peak))
+ (format p "(vector ~D ~,6F #r(" i new-peak))
(do ((k 1 (+ k 1)))
((= k i))
(format p "~,6F " (phases (- k 1))))
@@ -4756,7 +4763,7 @@
;; this is slow because we call tstall on each one
(call-with-output-file "pp4.scm"
(lambda (p)
- (format p "(define noid-min-peak-phases (vector~%~%(vector 1 1.0 #(0))~%(vector 2 1.76 #(0 0))~%~%")
+ (format p "(define noid-min-peak-phases (vector~%~%(vector 1 1.0 #r(0))~%(vector 2 1.76 #r(0 0))~%~%")
(do ((i 3 (+ i 1)))
((> i 128))
(format *stderr* "~D " i)
diff --git a/profile.scm b/profile.scm
index 3971936..3e19e41 100644
--- a/profile.scm
+++ b/profile.scm
@@ -2,25 +2,34 @@
(let ((info (*s7* 'profile-info)))
(if (null? info)
(format *stderr* "no profiling data!~%")
- (let ((vect (make-vector (hash-table-entries info))))
+ (let* ((entries (hash-table-entries info))
+ (vect (make-vector entries)))
+
(copy info vect)
(set! vect (sort! vect (lambda (a b) (> (cadr a) (cadr b)))))
- (set! n (min n (length vect)))
+
+ (do ((total 0)
+ (i 0 (+ i 1)))
+ ((= i entries)
+ (format *stderr* "total calls: ~A~%" total))
+ (set! total (+ total (cadr (vector-ref vect i)))))
+
+ (set! n (min n entries))
(do ((i 0 (+ i 1)))
- ((= i n) (newline *stderr*))
- (let* ((data (vect i))
- (expr (cddr data)))
- (let ((key (car data))
+ ((= i n)
+ (newline *stderr*))
+ (let ((data (vect i)))
+ (let ((expr (cddr data))
(count (cadr data))
- (file (pair-filename expr))
- (line (pair-line-number expr)))
- (if (> (ash key -20) 0)
- (format *stderr* "~A[~A]: ~A~30T~A~%"
- file line count
- (let ((val (object->string expr)))
- (if (> (length val) 60)
- (string-append (substring val 0 56) " ...")
- val)))))))))))
+ (key (car data)))
+ (let ((file (profile-filename key))
+ (line (profile-line-number key)))
+ (if (> line 0)
+ (format *stderr* "~A[~A]: ~A ~30T~A~%"
+ file line count
+ (if (> (length expr) 60)
+ (string-append (substring expr 0 56) " ...")
+ expr)))))))))))
#|
(define old-version s7-version)
diff --git a/pvoc.scm b/pvoc.scm
index 11d9640..77cdd06 100644
--- a/pvoc.scm
+++ b/pvoc.scm
@@ -75,86 +75,85 @@
(do ((i 0 (+ i 1)))
((= i len))
(set! sum (+ sum (* (amps i) (sin (phases i))))))
- sum))))
+ sum)))
+ (pi2 (* 2.0 pi)))
(lambda (pv input)
- (let ((pi2 (* 2.0 pi)))
-
- (when (>= (pvoc-output pv) (pvoc-interp pv))
- ;; get next block of amp/phase info
- (let ((N (pvoc-N pv))
- (D (pvoc-D pv))
- (amps (pvoc-ampinc pv))
- (freqs (pvoc-freqs pv))
- (filptr (pvoc-filptr pv)))
-
- (if (pvoc-analyze pv)
- ((pvoc-analyze pv) pv input)
- ;; if no analysis func:
- (begin
- (fill! freqs 0.0)
- (set-pvoc-output pv 0)
- (if (not (pvoc-in-data pv))
+ (when (>= (pvoc-output pv) (pvoc-interp pv))
+ ;; get next block of amp/phase info
+ (let ((N (pvoc-N pv))
+ (D (pvoc-D pv))
+ (amps (pvoc-ampinc pv))
+ (freqs (pvoc-freqs pv))
+ (filptr (pvoc-filptr pv)))
+
+ (if (pvoc-analyze pv)
+ ((pvoc-analyze pv) pv input)
+ ;; if no analysis func:
+ (begin
+ (fill! freqs 0.0)
+ (set-pvoc-output pv 0)
+ (if (not (pvoc-in-data pv))
+ (begin
+ (set-pvoc-in-data pv (make-float-vector N))
+ (do ((i 0 (+ i 1)))
+ ((= i N))
+ (set! ((pvoc-in-data pv) i) (input))))
+ (let ((indat (pvoc-in-data pv)))
+ ;; extra loop here since I find the optimized case confusing (we could dispense with the data move)
+ (float-vector-move! indat 0 D)
+ (do ((i (- N D) (+ i 1)))
+ ((= i N))
+ (set! (indat i) (input)))))
+ (let ((buf (modulo filptr N)))
+ (if (= buf 0)
(begin
- (set-pvoc-in-data pv (make-float-vector N))
- (do ((i 0 (+ i 1)))
- ((= i N))
- (set! ((pvoc-in-data pv) i) (input))))
- (let ((indat (pvoc-in-data pv)))
- ;; extra loop here since I find the optimized case confusing (we could dispense with the data move)
- (float-vector-move! indat 0 D)
- (do ((i (- N D) (+ i 1)))
- ((= i N))
- (set! (indat i) (input)))))
- (let ((buf (modulo filptr N)))
- (if (= buf 0)
- (begin
- (fill! amps 0.0)
- (float-vector-add! amps (pvoc-in-data pv))
- (float-vector-multiply! amps (pvoc-window pv)))
- (do ((k 0 (+ k 1)))
- ((= k N))
- (set! (amps buf) (* ((pvoc-window pv) k) ((pvoc-in-data pv) k)))
- (set! buf (+ 1 buf))
- (if (= buf N) (set! buf 0)))))
- (set-pvoc-filptr pv (+ filptr D))
- (mus-fft amps freqs N 1)
- (rectangular->polar amps freqs)))
-
- (if (pvoc-edit pv)
- ((pvoc-edit pv) pv)
- (let ((lp (pvoc-lastphase pv))
- (pscl (/ 1.0 D))
- (kscl (/ pi2 N))
- (lim (floor (/ N 2))))
- ;; if no editing func:
- (do ((k 0 (+ k 1)))
- ((= k lim))
- (let ((phasediff (remainder (- (freqs k) (lp k)) pi2)))
- (float-vector-set! lp k (freqs k))
- (if (> phasediff pi) (set! phasediff (- phasediff pi2))
- (if (< phasediff (- pi)) (set! phasediff (+ phasediff pi2))))
- (set! (freqs k) (+ (* pscl phasediff) (* k kscl)))))))
-
- (let ((scl (/ 1.0 (pvoc-interp pv))))
- (float-vector-subtract! amps (pvoc-amps pv))
- (float-vector-subtract! freqs (pvoc-phaseinc pv))
- (float-vector-scale! amps scl)
- (float-vector-scale! freqs scl)
- )))
-
- (set-pvoc-output pv (+ 1 (pvoc-output pv)))
-
- (if (pvoc-synthesize pv)
- ((pvoc-synthesize pv) pv)
- ;; if no synthesis func:
- ;; synthesize next sample
- (begin
- (float-vector-add! (pvoc-amps pv) (pvoc-ampinc pv))
- (float-vector-add! (pvoc-phaseinc pv) (pvoc-freqs pv))
- (float-vector-add! (pvoc-phases pv) (pvoc-phaseinc pv))
- (sine-bank (pvoc-amps pv) (pvoc-phases pv))))
- ))))
+ (fill! amps 0.0)
+ (float-vector-add! amps (pvoc-in-data pv))
+ (float-vector-multiply! amps (pvoc-window pv)))
+ (do ((k 0 (+ k 1)))
+ ((= k N))
+ (set! (amps buf) (* ((pvoc-window pv) k) ((pvoc-in-data pv) k)))
+ (set! buf (+ 1 buf))
+ (if (= buf N) (set! buf 0)))))
+ (set-pvoc-filptr pv (+ filptr D))
+ (mus-fft amps freqs N 1)
+ (rectangular->polar amps freqs)))
+
+ (if (pvoc-edit pv)
+ ((pvoc-edit pv) pv)
+ (let ((lp (pvoc-lastphase pv))
+ (pscl (/ 1.0 D))
+ (kscl (/ pi2 N))
+ (lim (floor (/ N 2))))
+ ;; if no editing func:
+ (do ((k 0 (+ k 1)))
+ ((= k lim))
+ (let ((phasediff (remainder (- (freqs k) (lp k)) pi2)))
+ (float-vector-set! lp k (freqs k))
+ (if (> phasediff pi) (set! phasediff (- phasediff pi2))
+ (if (< phasediff (- pi)) (set! phasediff (+ phasediff pi2))))
+ (set! (freqs k) (+ (* pscl phasediff) (* k kscl)))))))
+
+ (let ((scl (/ 1.0 (pvoc-interp pv))))
+ (float-vector-subtract! amps (pvoc-amps pv))
+ (float-vector-subtract! freqs (pvoc-phaseinc pv))
+ (float-vector-scale! amps scl)
+ (float-vector-scale! freqs scl)
+ )))
+
+ (set-pvoc-output pv (+ 1 (pvoc-output pv)))
+
+ (if (pvoc-synthesize pv)
+ ((pvoc-synthesize pv) pv)
+ ;; if no synthesis func:
+ ;; synthesize next sample
+ (begin
+ (float-vector-add! (pvoc-amps pv) (pvoc-ampinc pv))
+ (float-vector-add! (pvoc-phaseinc pv) (pvoc-freqs pv))
+ (float-vector-add! (pvoc-phases pv) (pvoc-phaseinc pv))
+ (sine-bank (pvoc-amps pv) (pvoc-phases pv))))
+ )))
#|
(let* ((ind (open-sound "oboe.snd"))
@@ -231,7 +230,8 @@
algorithm to the current sound (i.e. fft analysis, oscil bank resynthesis). 'pitch'
specifies the pitch transposition ratio, 'time' - specifies the time dilation ratio,
'gate' specifies a resynthesis gate in dB (partials with amplitudes lower than
- the gate value will not be synthesized), 'hoffset is a pitch offset in Hz."))
+ the gate value will not be synthesized), 'hoffset is a pitch offset in Hz.")
+ (pi2 (* 2.0 pi)))
(lambda* ((fftsize 512) (overlap 4) (time 1.0)
(pitch 1.0) (gate 0.0) (hoffset 0.0)
@@ -242,7 +242,6 @@
(in-data (channel->float-vector 0 (* fftsize 2) snd chn)))
(let ((lastamp (make-float-vector N2))
(lastfreq (make-float-vector N2))
- (pi2 (* 2 pi))
(outlen (floor (* time len)))
(interp (* (floor (/ fftsize overlap)) time)))
(let ((obank (make-oscil-bank lastfreq (make-float-vector N2) lastamp))
@@ -327,4 +326,4 @@
(float-vector-add! lastfreq freqinc)
(float-vector-set! out-data i (oscil-bank obank))
(set! output (+ 1 output)))
- (float-vector->channel out-data 0 (max len outlen))))))))
\ No newline at end of file
+ (float-vector->channel out-data 0 (max len outlen))))))))
diff --git a/repl.scm b/repl.scm
index d1f1a59..3490774 100644
--- a/repl.scm
+++ b/repl.scm
@@ -415,8 +415,10 @@
;; disable: (format *stderr* "~C[?9l" #\escape)
;; while enabled, mouse selection instead sends coords to repl (so it's annoying)
;; also it's sticky! exit repl does not clear this flag so mouse is effectively dead
- ;; upon click, we get ESC [ M bxy -- need to poll for this?
-
+ ;; upon click, we get ESC [ M b x y (b = button info, x/y are coords starting at 32=0 -- 6 chars received)
+ ;; to trap C-C (define (sigcatch no) (tty-reset) (#_exit)) (if (equal? (signal SIGINT sigcatch) SIG_ERR) (#_exit))
+ ;; to see click, add a meta-key for M
+ ;; all this apparently only works in xterm, so I hesitate to build on it here.
;; -------- display --------
(define (display-prompt)
@@ -1137,7 +1139,9 @@
(set! max-cols (max max-cols (- pos start)))
(set! start pos)))
(if (< (+ old-pos 1) (length str))
- (set! cur-line (string-append cur-line (substring str (+ old-pos 1)))))
+ (if (zero? old-pos)
+ (set! cur-line (copy str))
+ (set! cur-line (string-append cur-line (substring str (+ old-pos 1))))))
;; if the line is too long, the cursor gets confused, so try to reformat long strings
;; this still messes up sometimes
diff --git a/rubber.scm b/rubber.scm
index 691e22d..dcf0173 100644
--- a/rubber.scm
+++ b/rubber.scm
@@ -196,28 +196,27 @@
(mult 1)
(curs 0)
(edits (make-float-vector weights)))
- (do ()
+ (do ((best-mark -1 -1)
+ (old-handled handled handled))
((or (= curs weights) (>= handled needed-samps)))
;; need to find (more than) enough splice points to delete samps
- (let ((best-mark -1)
- (old-handled handled))
- (let ((cur 0)
- (curmin (cross-weights 0))
- (len (length cross-weights)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (if (< (cross-weights i) curmin)
- (begin
- (set! cur i)
- (set! curmin (cross-weights i)))))
- (set! best-mark cur))
- (set! handled (+ handled (floor (cross-periods best-mark))))
- (if (or (< handled needed-samps)
- (< (- handled needed-samps) (- needed-samps old-handled)))
- (begin
- (set! (edits curs) best-mark)
- (set! curs (+ 1 curs))))
- (set! (cross-weights best-mark) 1000.0)))
+ (let ((cur 0)
+ (curmin (cross-weights 0))
+ (len (length cross-weights)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (if (< (cross-weights i) curmin)
+ (begin
+ (set! cur i)
+ (set! curmin (cross-weights i)))))
+ (set! best-mark cur))
+ (set! handled (+ handled (floor (cross-periods best-mark))))
+ (if (or (< handled needed-samps)
+ (< (- handled needed-samps) (- needed-samps old-handled)))
+ (begin
+ (set! (edits curs) best-mark)
+ (set! curs (+ 1 curs))))
+ (set! (cross-weights best-mark) 1000.0))
(if (>= curs weights)
(set! mult (ceiling (/ needed-samps handled))))
@@ -272,4 +271,4 @@
(snd-print (format #f "~A -> ~A (~A)~%" (framples snd chn 0) (framples snd chn) (floor (* stretch (framples snd chn 0))))))
) ; end of as-one-edit thunk
(format #f "rubber-sound ~A" stretch)))))
-
\ No newline at end of file
+
diff --git a/s7.c b/s7.c
index db83481..979151d 100644
--- a/s7.c
+++ b/s7.c
@@ -68,6 +68,7 @@
* generic length, copy, reverse, fill!, append
* error handlers
* sundry leftovers
+ * the optimizers
* multiple-values, quasiquote
* eval
* multiprecision arithmetic
@@ -128,7 +129,7 @@
* in openBSD I think you need to include -ftrampolines in CFLAGS.
* if you want this file to compile into a stand-alone interpreter, define WITH_MAIN
*
- * -O3 is sometimes slower, sometimes faster
+ * -O3 is often slower, sometimes faster (at least according to callgrind), similarly for -finline-functions and -ftree-vectorize
* -march=native -fomit-frame-pointer -m64 -funroll-loops gains about .1%
* -ffast-math makes a mess of NaNs, and does not appear to be faster
* for timing tests, I use: -O2 -DINITIAL_HEAP_SIZE=1024000 -march=native -fomit-frame-pointer -funroll-loops
@@ -185,9 +186,7 @@
*/
#endif
-#if WITH_GMP
- #define DEFAULT_BIGNUM_PRECISION 128
-#endif
+#define DEFAULT_BIGNUM_PRECISION 128
#ifndef WITH_PURE_S7
#define WITH_PURE_S7 0
@@ -218,11 +217,15 @@
#endif
#ifndef WITH_C_LOADER
- #define WITH_C_LOADER WITH_GCC
+ #if (defined(__GNUC__) || defined(__clang__))
+ #define WITH_C_LOADER 1
/* (load file.so [e]) looks for (e 'init_func) and if found, calls it
* as the shared object init function. If WITH_SYSTEM_EXTRAS is 0, the caller
* needs to supply system and delete-file so that cload.scm works.
*/
+ #else
+ #define WITH_C_LOADER 0
+ #endif
#endif
#ifndef WITH_HISTORY
@@ -240,8 +243,11 @@
/* this includes profiling data collection accessible from scheme via the hash-table (*s7* 'profile-info) */
#endif
-
-#define WITH_GCC (defined(__GNUC__) || defined(__clang__))
+#if (defined(__GNUC__) || defined(__clang__))
+ #define WITH_GCC 1
+#else
+ #define WITH_GCC 0
+#endif
/* in case mus-config.h forgets these */
#ifdef _MSC_VER
@@ -268,6 +274,11 @@
/* -------------------------------------------------------------------------------- */
+#ifndef WITH_MULTITHREAD_CHECKS
+ #define WITH_MULTITHREAD_CHECKS 0
+ /* debugging aid if using s7 in a multithreaded program -- this code courtesy of Kjetil Matheussen */
+#endif
+
#ifndef DEBUGGING
#define DEBUGGING 0
#endif
@@ -275,8 +286,6 @@
#define OP_NAMES 0
#endif
-#define WITH_ADD_PF 0
-
#ifndef _MSC_VER
#include <unistd.h>
#include <sys/param.h>
@@ -306,6 +315,10 @@
#include <stdarg.h>
#include <stddef.h>
+#if WITH_MULTITHREAD_CHECKS
+ #include <pthread.h>
+#endif
+
#if __cplusplus
#include <cmath>
#else
@@ -330,10 +343,15 @@
#endif
#endif
+#ifdef __MINGW32__
+ #include <inttypes.h>
+#endif
+
#include <setjmp.h>
#include "s7.h"
+
enum {NO_JUMP, CALL_WITH_EXIT_JUMP, THROW_JUMP, CATCH_JUMP, ERROR_JUMP, ERROR_QUIT_JUMP};
enum {NO_SET_JUMP, READ_SET_JUMP, LOAD_SET_JUMP, DYNAMIC_WIND_SET_JUMP, S7_CALL_SET_JUMP, EVAL_SET_JUMP};
@@ -362,31 +380,38 @@ static int 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)
+#ifdef __MINGW32__
+ #define LL_U "PRIu64"
+ #define LL_D "PRId64"
+#else
+ #define LL_U "llu"
+ #define LL_D "lld"
+#endif
+
+#define PRINT_NAME_PADDING 16
#if (((defined(SIZEOF_VOID_P)) && (SIZEOF_VOID_P == 4)) || ((defined(__SIZEOF_POINTER__)) && (__SIZEOF_POINTER__ == 4)))
#define opcode_t unsigned int
- #define PRINT_NAME_PADDING 8
- #define PRINT_NAME_SIZE (20 - PRINT_NAME_PADDING - 2)
#define ptr_int unsigned int
#define INT_FORMAT "%u"
- #ifndef WITH_OPTIMIZATION
- #define WITH_OPTIMIZATION 0
- /* 32-bit optimized case gets inexplicable NaNs in float-vector ops.
- * only the rf cases are faulty, so it is possible to set this flag to 1, then make s7_rf_set_function a no-op,
- * and comment out the 2 syntax_rp cases.
- * In standard scheme code, this flag does not matter much, but it makes CLM run about 3 times as fast.
- */
- #endif
+ #define PD_U "%u"
+ /* 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 unsigned long long int
#define ptr_int unsigned long long int
- #define INT_FORMAT "%llu"
- #define PRINT_NAME_PADDING 16
- #define PRINT_NAME_SIZE (40 - PRINT_NAME_PADDING - 2)
- #ifndef WITH_OPTIMIZATION
- #define WITH_OPTIMIZATION 1
+ #define INT_FORMAT "%" LL_U
+ #ifdef __MINGW32__
+ #define PD_U "%" LL_U
+ #else
+ #define PD_U "%lu"
#endif
+ #define PRINT_NAME_SIZE (40 - PRINT_NAME_PADDING - 2)
+ #define POINTER_32 false
#endif
@@ -394,67 +419,69 @@ static int float_format_precision = WRITE_REAL_PRECISION;
#define T_FREE 0
#define T_PAIR 1
#define T_NIL 2
-#define T_UNIQUE 3
+#define T_UNDEFINED 3
#define T_UNSPECIFIED 4
-#define T_BOOLEAN 5
-#define T_CHARACTER 6
-#define T_SYMBOL 7
-#define T_SYNTAX 8
-
-#define T_INTEGER 9
-#define T_RATIO 10
-#define T_REAL 11
-#define T_COMPLEX 12
-
-#define T_BIG_INTEGER 13 /* these four used only if WITH_GMP -- order matters */
-#define T_BIG_RATIO 14
-#define T_BIG_REAL 15
-#define T_BIG_COMPLEX 16
-
-#define T_STRING 17
-#define T_C_OBJECT 18
-#define T_VECTOR 19
-#define T_INT_VECTOR 20
-#define T_FLOAT_VECTOR 21
-
-#define T_CATCH 22
-#define T_DYNAMIC_WIND 23
-#define T_HASH_TABLE 24
-#define T_LET 25
-#define T_ITERATOR 26
-#define T_STACK 27
-#define T_COUNTER 28
-#define T_SLOT 29
-#define T_C_POINTER 30
-#define T_OUTPUT_PORT 31
-#define T_INPUT_PORT 32
-#define T_BAFFLE 33
-#define T_RANDOM_STATE 34
-
-#define T_GOTO 35
-#define T_CONTINUATION 36
-#define T_CLOSURE 37
-#define T_CLOSURE_STAR 38
-#define T_C_MACRO 39
-#define T_MACRO 40
-#define T_MACRO_STAR 41
-#define T_BACRO 42
-#define T_BACRO_STAR 43
-#define T_C_FUNCTION_STAR 44
-#define T_C_FUNCTION 45
-#define T_C_ANY_ARGS_FUNCTION 46
-#define T_C_OPT_ARGS_FUNCTION 47
-#define T_C_RST_ARGS_FUNCTION 48
-
-#define NUM_TYPES 49
-
-/* T_STACK, T_SLOT, T_BAFFLE, T_DYNAMIC_WIND, and T_COUNTER are internal
+#define T_EOF_OBJECT 5
+#define T_BOOLEAN 6
+#define T_CHARACTER 7
+#define T_SYMBOL 8
+#define T_SYNTAX 9
+
+#define T_INTEGER 10
+#define T_RATIO 11
+#define T_REAL 12
+#define T_COMPLEX 13
+
+#define T_BIG_INTEGER 14 /* these four used only if WITH_GMP -- order matters */
+#define T_BIG_RATIO 15
+#define T_BIG_REAL 16
+#define T_BIG_COMPLEX 17
+
+#define T_STRING 18
+#define T_C_OBJECT 19
+#define T_VECTOR 20
+#define T_INT_VECTOR 21
+#define T_FLOAT_VECTOR 22
+
+#define T_CATCH 23
+#define T_DYNAMIC_WIND 24
+#define T_HASH_TABLE 25
+#define T_LET 26
+#define T_ITERATOR 27
+#define T_STACK 28
+#define T_COUNTER 29
+#define T_SLOT 30
+#define T_C_POINTER 31
+#define T_OUTPUT_PORT 32
+#define T_INPUT_PORT 33
+#define T_BAFFLE 34
+#define T_RANDOM_STATE 35
+#define T_OPTLIST 36
+
+#define T_GOTO 37
+#define T_CONTINUATION 38
+#define T_CLOSURE 39
+#define T_CLOSURE_STAR 40
+#define T_C_MACRO 41
+#define T_MACRO 42
+#define T_MACRO_STAR 43
+#define T_BACRO 44
+#define T_BACRO_STAR 45
+#define T_C_FUNCTION_STAR 46
+#define T_C_FUNCTION 47
+#define T_C_ANY_ARGS_FUNCTION 48
+#define T_C_OPT_ARGS_FUNCTION 49
+#define T_C_RST_ARGS_FUNCTION 50
+
+#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!
*/
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,
- TOKEN_VECTOR, TOKEN_BYTE_VECTOR} token_t;
+ TOKEN_VECTOR, TOKEN_BYTE_VECTOR, TOKEN_INT_VECTOR, TOKEN_FLOAT_VECTOR} token_t;
typedef enum {FILE_PORT, STRING_PORT, FUNCTION_PORT} port_type_t;
@@ -482,6 +509,12 @@ typedef struct {
} port_t;
+typedef struct opt_funcs {
+ int typ;
+ void *func;
+ struct opt_funcs *next;
+} opt_funcs;
+
typedef struct {
const char *name;
int name_length;
@@ -489,18 +522,16 @@ typedef struct {
char *doc;
s7_pointer generic_ff;
s7_pointer signature;
- s7_pointer (*chooser)(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr);
+ s7_pointer (*chooser)(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops);
s7_pointer *arg_defaults, *arg_names;
s7_pointer call_args;
- s7_rp_t rp;
- s7_ip_t ip;
- s7_pp_t pp, gp;
+ opt_funcs *opt_data;
} c_proc_t;
typedef struct { /* call/cc */
unsigned int stack_size, op_stack_loc, op_stack_size;
- int local_key; /* for with-baffle */
+ int local_key; /* for with-baffle */
} continuation_t;
@@ -530,8 +561,6 @@ typedef struct {
char *(*print_readably)(s7_scheme *sc, void *value);
s7_pointer (*direct_ref)(s7_scheme *sc, s7_pointer obj, s7_int index);
s7_pointer (*direct_set)(s7_scheme *sc, s7_pointer obj, s7_int index, s7_pointer val);
- s7_ip_t ip, set_ip;
- s7_rp_t rp, set_rp;
} c_object_t;
@@ -545,6 +574,63 @@ typedef unsigned int (*hash_map_t)(s7_scheme *sc, s7_pointer table, s7_pointer k
typedef hash_entry_t *(*hash_check_t)(s7_scheme *sc, s7_pointer table, s7_pointer key); /* hash-table object equality function */
static hash_map_t *default_hash_map;
+typedef union {
+ s7_int i;
+ s7_double x;
+ s7_pointer p;
+ void *obj;
+ s7_function cf;
+ s7_double (*d_f)(void);
+ s7_double (*d_d_f)(s7_double x);
+ s7_double (*d_dd_f)(s7_double x1, s7_double x2);
+ s7_double (*d_ddd_f)(s7_double x1, s7_double x2, s7_double x3);
+ s7_double (*d_dddd_f)(s7_double x1, s7_double x2, s7_double x3, s7_double x4);
+ s7_double (*d_v_f)(void *obj);
+ s7_double (*d_vd_f)(void *obj, s7_double fm);
+ s7_double (*d_vdd_f)(void *obj, s7_double x1, s7_double x2);
+ s7_double (*d_vid_f)(void *obj, s7_int i, s7_double fm);
+ s7_double (*d_id_f)(s7_int i, s7_double fm);
+ s7_double (*d_pi_f)(s7_pointer obj, s7_int i1);
+ s7_double (*d_ip_f)(s7_int i1, s7_pointer p);
+ s7_double (*d_pd_f)(s7_pointer obj, s7_double x);
+ s7_double (*d_pid_f)(s7_pointer obj, s7_int i1, s7_double x);
+ s7_double (*d_p_f)(s7_pointer p);
+ s7_int (*i_d_f)(s7_double i1);
+ s7_int (*i_i_f)(s7_int i1);
+ s7_int (*i_ii_f)(s7_int i1, s7_int i2);
+ s7_int (*i_iii_f)(s7_int i1, s7_int i2, s7_int i3);
+ s7_int (*i_p_f)(s7_pointer p);
+ s7_int (*i_pi_f)(s7_pointer p, s7_int i1);
+ s7_int (*i_pii_f)(s7_pointer p, s7_int i1, s7_int i2);
+ bool (*b_i_f)(s7_int p);
+ bool (*b_d_f)(s7_double p);
+ bool (*b_p_f)(s7_pointer p);
+ bool (*b_pp_f)(s7_pointer p1, s7_pointer p2);
+ bool (*b_pi_f)(s7_pointer p1, s7_int i2);
+ bool (*b_ii_f)(s7_int i1, s7_int i2);
+ bool (*b_dd_f)(s7_double x1, s7_double x2);
+ s7_pointer (*p_f)(void);
+ s7_pointer (*p_p_f)(s7_pointer p);
+ s7_pointer (*p_pp_f)(s7_pointer p1, s7_pointer p2);
+ s7_pointer (*p_ppp_f)(s7_pointer p, s7_pointer p2, s7_pointer p3);
+ s7_pointer (*p_pi_f)(s7_pointer p1, s7_int i1);
+ s7_pointer (*p_ppi_f)(s7_pointer p1, s7_pointer p2, s7_int i1);
+ s7_pointer (*p_pip_f)(s7_pointer p1, s7_int i1, s7_pointer p2);
+ s7_pointer (*p_ii_f)(s7_int x1, s7_int x2);
+ s7_pointer (*all_f)(s7_scheme *sc, s7_pointer expr);
+ s7_double (*fd)(void *o);
+ s7_int (*fi)(void *o);
+ bool (*fb)(void *o);
+ s7_pointer (*fp)(void *o);
+} vunion;
+
+typedef struct {
+ vunion v1, v2, v3, v4, v5, v6, v7, v8;
+#if DEBUGGING
+ s7_pointer expr;
+#endif
+} opt_info;
+
/* cell structure */
typedef struct s7_cell {
@@ -556,7 +642,7 @@ typedef struct s7_cell {
int hloc;
union {
- union {
+ union { /* integers, floats */
s7_int integer_value;
s7_double real_value;
@@ -565,21 +651,21 @@ typedef struct s7_cell {
char name[PRINT_NAME_SIZE + 2];
} pval;
- struct {
+ struct { /* ratios */
s7_int numerator;
s7_int denominator;
} fraction_value;
- struct {
+ struct { /* complex numbers */
s7_double rl;
s7_double im;
} complex_value;
- unsigned long ul_value; /* these two are not used by s7 in any way */
+ unsigned long ul_value; /* these two are not used by s7 in any way */
unsigned long long ull_value;
#if WITH_GMP
- mpz_t big_integer;
+ mpz_t big_integer; /* bignums */
mpq_t big_ratio;
mpfr_t big_real;
mpc_t big_complex;
@@ -591,27 +677,27 @@ typedef struct s7_cell {
#endif
} number;
- struct {
+ struct { /* ports */
port_t *port;
unsigned char *data;
- unsigned int size, point; /* these limit the in-core portion of a string-port to 2^31 bytes */
+ unsigned int size, point; /* these limit the in-core portion of a string-port to 2^31 bytes */
unsigned int line_number, file_number;
bool is_closed;
port_type_t ptype;
} prt;
- struct{
+ struct{ /* characters */
unsigned char c, up_c;
int length;
bool alpha_c, digit_c, space_c, upper_c, lower_c;
char c_name[12];
} chr;
- void *c_pointer;
+ void *c_pointer; /* c-pointers */
- int baffle_key;
+ int baffle_key; /* baffles */
- struct {
+ struct { /* vectors */
s7_int length;
union {
s7_pointer *objects;
@@ -623,14 +709,14 @@ typedef struct s7_cell {
s7_pointer (*vset)(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val);
} vector;
- struct {
+ struct { /* stacks (internal) */
s7_int length;
s7_pointer *objects;
vdims_t *dim_info;
int top;
} stk;
- struct {
+ struct { /* hash-tables */
unsigned int mask, entries;
hash_entry_t **elements;
hash_check_t hash_func;
@@ -638,7 +724,7 @@ typedef struct s7_cell {
s7_pointer dproc;
} hasher;
- struct {
+ struct { /* iterators */
s7_pointer obj, cur;
union {
s7_int loc;
@@ -653,30 +739,35 @@ typedef struct s7_cell {
} iter;
struct {
- c_proc_t *c_proc; /* C functions, macros */
+ c_proc_t *c_proc; /* C functions, macros */
s7_function ff;
s7_pointer setter;
unsigned int required_args, optional_args, all_args;
bool rest_arg;
} fnc;
- struct { /* pairs */
+ struct { /* pairs */
s7_pointer car, cdr, opt1, opt2, opt3;
} cons;
- struct {
- s7_pointer sym_car, sym_cdr;
+ struct { /* special purpose pairs (symbol-table etc) */
+ s7_pointer unused_car, unused_cdr;
unsigned long long int hash;
const char *fstr;
- unsigned int op, line;
+ unsigned int op, line; /* op=optimize_op, line=pair_line or saved symbol_ctr */
} sym_cons;
- struct {
- s7_pointer args, body, env, setter;
- int arity;
+ struct { /* scheme functions */
+ s7_pointer args, body, env, setter; /* args can be a symbol, as well as a list */
+ int arity, opt_addr;
} func;
- struct {
+ struct { /* optlist (internal) */
+ int num_exprs, num_args, len, addr, pc;
+ opt_info *opts;
+ } opt;
+
+ struct { /* strings */
unsigned int length;
union {
bool needs_free;
@@ -684,7 +775,7 @@ typedef struct s7_cell {
int temp_len;
} str_ext;
char *svalue;
- unsigned long long int hash; /* string hash-index */
+ unsigned long long int hash; /* string hash-index */
s7_pointer initial_slot;
union {
char *documentation;
@@ -695,23 +786,20 @@ typedef struct s7_cell {
struct { /* symbols */
s7_pointer name, global_slot, local_slot;
long long int id;
- unsigned int op, tag;
+ unsigned int ctr, tag;
} sym;
struct { /* syntax */
s7_pointer symbol;
int op;
short min_args, max_args;
- s7_rp_t rp;
- s7_ip_t ip;
- s7_pp_t pp;
} syn;
struct { /* slots (bindings) */
s7_pointer sym, val, nxt, pending_value, expr;
} slt;
- struct { /* environments (frames) */
+ struct { /* environments (frames, lets) */
s7_pointer slots, nxt;
long long int id; /* id of rootlet is -1 */
union {
@@ -729,7 +817,7 @@ typedef struct s7_cell {
} edat;
} envr;
- struct {
+ struct { /* special stuff like #<unspecified> */
/* these 3 are just place-holders */
s7_pointer unused_slots, unused_nxt;
long long int unused_id;
@@ -740,10 +828,10 @@ typedef struct s7_cell {
struct { /* counter (internal) */
s7_pointer result, list, env, slots; /* env = counter_let (curlet after map/for-each frame created) */
- unsigned long long int cap; /* sc->capture_let_counter for frame reuse */
+ unsigned long long int cap; /* sc->capture_let_counter for frame reuse */
} ctr;
- struct {
+ struct { /* random-state */
#if WITH_GMP
gmp_randstate_t state;
#else
@@ -751,38 +839,41 @@ typedef struct s7_cell {
#endif
} rng;
- struct { /* additional object types (C) */
+ struct { /* additional object types (C) */
int type;
- void *value; /* the value the caller associates with the object */
- s7_pointer e; /* the method list, if any (openlet) */
+ 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);
} c_obj;
- struct {
+ struct { /* continuations */
continuation_t *continuation;
s7_pointer stack;
s7_pointer *stack_start, *stack_end, *op_stack;
} cwcc;
- struct { /* call-with-exit */
+ struct { /* call-with-exit */
unsigned int goto_loc, op_stack_loc;
bool active;
} rexit;
- struct { /* catch */
+ struct { /* catch */
unsigned int 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;
unsigned int state;
} winder;
} object;
+#if WITH_PROFILE
+ int file_and_line;
+#endif
#if DEBUGGING
- int current_alloc_line, previous_alloc_line, current_alloc_type, previous_alloc_type, debugger_bits, gc_line, clear_line, alloc_line, uses;
+ int current_alloc_line, previous_alloc_line, current_alloc_type, previous_alloc_type, debugger_bits, gc_line, alloc_line, uses;
const char *current_alloc_func, *previous_alloc_func, *gc_func, *alloc_func;
#endif
@@ -811,15 +902,6 @@ typedef struct gc_obj {
} gc_obj;
-typedef struct xf_t {
- s7_pointer *data, *cur, *end;
- s7_pointer e;
- int size;
- gc_obj *gc_list;
- struct xf_t *next;
-} xf_t;
-
-
static s7_pointer *small_ints, *chars;
static s7_pointer real_zero, real_NaN, real_pi, real_one, arity_not_set, max_arity, real_infinity, real_minus_infinity, minus_one, minus_two;
@@ -842,11 +924,6 @@ struct s7_scheme {
s7_cell **heap, **free_heap, **free_heap_top, **free_heap_trigger, **previous_free_heap_top;
unsigned int heap_size;
int gc_freed;
-
-#if WITH_HISTORY
- s7_pointer eval_history1, eval_history2, error_history;
- bool using_history1;
-#endif
/* "int" or "unsigned int" seems safe here:
* sizeof(s7_cell) = 48 bytes
* so to get more than 2^32 actual objects would require ca 206 GBytes RAM
@@ -854,6 +931,16 @@ struct s7_scheme {
* we need ca 38 GBytes RAM (8 bytes per pointer).
*/
+#if WITH_HISTORY
+ s7_pointer eval_history1, eval_history2, error_history;
+ bool using_history1;
+#endif
+
+#if WITH_MULTITHREAD_CHECKS
+ int lock_count;
+ pthread_mutex_t lock;
+#endif
+
gc_obj *permanent_objects;
s7_pointer protected_objects, protected_accessors; /* a vector of gc-protected objects */
@@ -868,7 +955,6 @@ struct s7_scheme {
s7_pointer undefined; /* #<undefined> */
s7_pointer unspecified; /* #<unspecified> */
s7_pointer no_value; /* the (values) value */
- s7_pointer else_object; /* else */
s7_pointer gc_nil; /* a marker for an unoccupied slot in sc->protected_objects (and other similar stuff) */
s7_pointer symbol_table; /* symbol table */
@@ -896,10 +982,10 @@ struct s7_scheme {
unsigned int gensym_counter, cycle_counter, f_class, add_class, multiply_class, subtract_class, equal_class;
int format_column;
unsigned long long int capture_let_counter;
- bool symbol_table_is_locked, short_print, is_autoloading;
+ bool short_print, is_autoloading;
long long int let_number;
double default_rationalize_error, morally_equal_float_epsilon, hash_table_float_epsilon;
- s7_int default_hash_table_length, initial_string_port_length, print_length, history_size, true_history_size;
+ s7_int default_hash_table_length, initial_string_port_length, print_length, objstr_max_len, history_size, true_history_size;
s7_int max_vector_length, max_string_length, max_list_length, max_vector_dimensions;
s7_pointer stacktrace_defaults;
vdims_t *wrap_only;
@@ -931,6 +1017,9 @@ struct s7_scheme {
s7_pointer d1, d2, d3, d4;
s7_pointer t1_1, t2_1, t2_2, t3_1, t3_2, t3_3, z2_1, z2_2;
s7_pointer a1_1, a2_1, a2_2, a3_1, a3_2, a3_3, a4_1, a4_2, a4_3, a4_4;
+ #define T_TEMPS_SIZE 32
+ s7_pointer t_temps[T_TEMPS_SIZE]; /* more eval temps */
+ int t_temp_ctr;
jmp_buf goto_start;
bool longjmp_ok;
@@ -944,18 +1033,24 @@ struct s7_scheme {
shared_info *circle_info;
format_data **fdats;
int num_fdats;
- s7_pointer elist_1, elist_2, elist_3, elist_4, elist_5, plist_1, plist_2, plist_3;
+ s7_pointer elist_1, elist_2, elist_3, elist_4, elist_5, plist_1, plist_2, plist_3, qlist_2;
+
+ s7_pointer *strings, *strings1, *vectors, *input_ports, *output_ports, *continuations;
+ s7_pointer *c_objects, *hash_tables, *gensyms, *setters, *optlists;
+ unsigned int strings_size, strings1_size, vectors_size, input_ports_size, output_ports_size;
+ unsigned int continuations_size, c_objects_size, hash_tables_size, gensyms_size, setters_size, optlists_size;
+ unsigned int strings_loc, strings1_loc, vectors_loc, input_ports_loc, output_ports_loc;
+ unsigned int continuations_loc, c_objects_loc, hash_tables_loc, gensyms_loc, setters_loc, optlists_loc;
- s7_pointer *strings, *vectors, *input_ports, *output_ports, *continuations, *c_objects, *hash_tables, *gensyms, *setters;
- unsigned int strings_size, vectors_size, input_ports_size, output_ports_size, continuations_size, c_objects_size, hash_tables_size, gensyms_size, setters_size;
- unsigned int strings_loc, vectors_loc, input_ports_loc, output_ports_loc, continuations_loc, c_objects_loc, hash_tables_loc, gensyms_loc, setters_loc;
+ char ***string_lists;
+ int *string_locs, *string_sizes, *string_max_sizes;
unsigned int syms_tag;
int ht_iter_tag, baffle_ctr, bignum_precision;
s7_pointer default_rng;
/* these symbols are primarily for the generic function search */
- s7_pointer abs_symbol, acos_symbol, acosh_symbol, add_symbol, angle_symbol, append_symbol, apply_symbol, arity_symbol,
+ s7_pointer abs_symbol, acos_symbol, acosh_symbol, add_symbol, angle_symbol, append_symbol, apply_symbol, apply_values_symbol, arity_symbol,
ash_symbol, asin_symbol, asinh_symbol, assoc_symbol, assq_symbol, assv_symbol, atan_symbol, atanh_symbol,
autoload_symbol, autoloader_symbol,
byte_vector_symbol, byte_vector_ref_symbol, byte_vector_set_symbol,
@@ -968,14 +1063,13 @@ struct s7_scheme {
ceiling_symbol, char_downcase_symbol, char_eq_symbol, char_geq_symbol, char_gt_symbol, char_leq_symbol, char_lt_symbol,
char_position_symbol, char_to_integer_symbol, char_upcase_symbol, cload_directory_symbol, close_input_port_symbol,
close_output_port_symbol, complex_symbol, cons_symbol, copy_symbol, cos_symbol, cosh_symbol, coverlet_symbol,
- curlet_symbol, current_error_port_symbol, current_input_port_symbol, current_output_port_symbol, cutlet_symbol,
+ curlet_symbol, current_error_port_symbol, current_input_port_symbol, current_output_port_symbol, cutlet_symbol, cyclic_sequences_symbol,
denominator_symbol, dilambda_symbol, display_symbol, divide_symbol, dynamic_wind_symbol,
- eq_symbol, error_symbol, eval_string_symbol, eval_symbol, exact_to_inexact_symbol, exp_symbol, expt_symbol,
+ eq_symbol, error_symbol, eval_string_symbol, eval_symbol, exact_to_inexact_symbol, exit_symbol, exp_symbol, expt_symbol,
features_symbol, fill_symbol, float_vector_ref_symbol, float_vector_set_symbol, float_vector_symbol, floor_symbol,
flush_output_port_symbol, for_each_symbol, format_symbol, funclet_symbol,
gc_symbol, gcd_symbol, gensym_symbol, geq_symbol, get_output_string_symbol, gt_symbol,
- hash_table_entries_symbol, hash_table_ref_symbol, hash_table_set_symbol, hash_table_star_symbol, hash_table_symbol,
- help_symbol,
+ hash_table_entries_symbol, hash_table_ref_symbol, hash_table_set_symbol, hash_table_star_symbol, hash_table_symbol, help_symbol,
imag_part_symbol, inexact_to_exact_symbol, inlet_symbol, int_vector_ref_symbol, int_vector_set_symbol, int_vector_symbol,
integer_decode_float_symbol, integer_to_char_symbol, is_aritable_symbol, is_boolean_symbol, is_byte_vector_symbol,
is_c_object_symbol, is_c_pointer_symbol, is_char_alphabetic_symbol, is_char_lower_case_symbol, is_char_numeric_symbol,
@@ -986,20 +1080,19 @@ struct s7_scheme {
is_keyword_symbol, is_let_symbol, is_list_symbol, is_macro_symbol, is_morally_equal_symbol, is_nan_symbol, is_negative_symbol,
is_null_symbol, is_number_symbol, is_odd_symbol, is_openlet_symbol, is_output_port_symbol, is_pair_symbol,
is_port_closed_symbol, is_positive_symbol, is_procedure_symbol, is_proper_list_symbol, is_provided_symbol,
- is_random_state_symbol, is_rational_symbol, is_real_symbol, is_sequence_symbol, is_string_symbol, is_symbol_symbol,
+ is_random_state_symbol, is_rational_symbol, is_real_symbol, is_sequence_symbol, is_string_symbol, is_symbol_symbol, is_syntax_symbol,
is_vector_symbol, is_zero_symbol, iterate_symbol, iterator_is_at_end_symbol, iterator_sequence_symbol,
- is_float_symbol, is_integer_or_real_at_end_symbol, is_integer_or_any_at_end_symbol, is_unspecified_symbol,
+ is_float_symbol, is_integer_or_real_at_end_symbol, is_integer_or_any_at_end_symbol, is_unspecified_symbol, is_undefined_symbol,
keyword_to_symbol_symbol,
lcm_symbol, length_symbol, leq_symbol, let_ref_fallback_symbol, let_ref_symbol, let_set_fallback_symbol,
- let_set_symbol, list_ref_symbol, list_set_symbol, list_symbol, list_tail_symbol, load_path_symbol,
- load_symbol, log_symbol, logand_symbol, logbit_symbol, logior_symbol, lognot_symbol, logxor_symbol, lt_symbol,
+ let_set_symbol, let_temporarily_symbol, list_ref_symbol, list_set_symbol, list_symbol, list_tail_symbol, list_values_symbol,
+ load_path_symbol, load_symbol, log_symbol, logand_symbol, logbit_symbol, logior_symbol, lognot_symbol, logxor_symbol, lt_symbol,
magnitude_symbol, make_byte_vector_symbol, make_float_vector_symbol, make_hash_table_symbol, make_int_vector_symbol,
make_iterator_symbol, string_to_keyword_symbol, make_list_symbol, make_shared_vector_symbol, make_string_symbol,
- make_vector_symbol, map_symbol, max_symbol, member_symbol, memq_symbol, memv_symbol, min_symbol, modulo_symbol,
- multiply_symbol,
+ make_vector_symbol, map_symbol, max_symbol, member_symbol, memq_symbol, memv_symbol, min_symbol, modulo_symbol, multiply_symbol,
newline_symbol, not_symbol, number_to_string_symbol, numerator_symbol,
object_to_string_symbol, object_to_let_symbol, open_input_file_symbol, open_input_string_symbol, open_output_file_symbol,
- openlet_symbol, outlet_symbol, owlet_symbol,
+ open_output_string_symbol, openlet_symbol, outlet_symbol, owlet_symbol,
pair_filename_symbol, pair_line_number_symbol, peek_char_symbol, pi_symbol, port_filename_symbol, port_line_number_symbol,
procedure_documentation_symbol, procedure_signature_symbol, procedure_source_symbol, provide_symbol,
quotient_symbol,
@@ -1011,8 +1104,8 @@ struct s7_scheme {
string_geq_symbol, string_gt_symbol, string_leq_symbol, string_lt_symbol, string_position_symbol, string_ref_symbol,
string_set_symbol, string_symbol, string_to_number_symbol, string_to_symbol_symbol, string_upcase_symbol,
sublet_symbol, substring_symbol, subtract_symbol, symbol_access_symbol, symbol_symbol, symbol_to_dynamic_value_symbol,
- symbol_to_keyword_symbol, symbol_to_string_symbol, symbol_to_value_symbol,
- tan_symbol, tanh_symbol, throw_symbol, string_to_byte_vector_symbol, truncate_symbol,
+ symbol_to_keyword_symbol, symbol_to_string_symbol, symbol_to_value_symbol, s7_version_symbol,
+ tan_symbol, tanh_symbol, throw_symbol, string_to_byte_vector_symbol, truncate_symbol, type_of_symbol,
unlet_symbol,
values_symbol, varlet_symbol, vector_append_symbol, vector_dimensions_symbol, vector_fill_symbol, vector_ref_symbol,
vector_set_symbol, vector_symbol,
@@ -1027,15 +1120,15 @@ struct s7_scheme {
make_rectangular_symbol;
#endif
- /* s7 env symbols */
- s7_pointer stack_top_symbol, symbol_table_is_locked_symbol, heap_size_symbol, gc_freed_symbol, gc_protected_objects_symbol,
+ /* *s7* fields */
+ s7_pointer stack_top_symbol, heap_size_symbol, gc_freed_symbol, gc_protected_objects_symbol,
free_heap_size_symbol, file_names_symbol, symbol_table_symbol, cpu_time_symbol, c_objects_symbol, float_format_precision_symbol,
stack_size_symbol, rootlet_size_symbol, c_types_symbol, safety_symbol, max_stack_size_symbol, gc_stats_symbol, autoloading_symbol,
strings_symbol, vectors_symbol, input_ports_symbol, output_ports_symbol, continuations_symbol, hash_tables_symbol, gensyms_symbol,
catches_symbol, exits_symbol, stack_symbol, default_rationalize_error_symbol, max_string_length_symbol, default_random_state_symbol,
max_list_length_symbol, max_vector_length_symbol, max_vector_dimensions_symbol, default_hash_table_length_symbol, profile_info_symbol,
hash_table_float_epsilon_symbol, morally_equal_float_epsilon_symbol, initial_string_port_length_symbol, memory_usage_symbol,
- undefined_identifier_warnings_symbol, print_length_symbol, bignum_precision_symbol, stacktrace_defaults_symbol, history_size_symbol;
+ undefined_identifier_warnings_symbol, print_length_symbol, bignum_precision_symbol, stacktrace_defaults_symbol, history_symbol, history_size_symbol;
/* syntax symbols et al */
s7_pointer else_symbol, lambda_symbol, lambda_star_symbol, let_symbol, quote_symbol, unquote_symbol, macroexpand_symbol,
@@ -1046,39 +1139,65 @@ struct s7_scheme {
let_star_symbol, key_rest_symbol, key_allow_other_keys_symbol, key_readable_symbol, value_symbol, type_symbol,
baffled_symbol, __func___symbol, set_symbol, body_symbol, class_name_symbol, feed_to_symbol, format_error_symbol,
wrong_number_of_args_symbol, read_error_symbol, string_read_error_symbol, syntax_error_symbol, division_by_zero_symbol,
- no_catch_symbol, io_error_symbol, invalid_escape_function_symbol, wrong_type_arg_symbol, out_of_range_symbol;
+ no_catch_symbol, io_error_symbol, invalid_escape_function_symbol, wrong_type_arg_symbol, out_of_range_symbol, missing_method_symbol;
/* optimizer symbols */
- s7_pointer and_p2_symbol, and_p_symbol, and_unchecked_symbol, begin_unchecked_symbol, case_simple_symbol, case_simpler_1_symbol, case_else_symbol,
- case_simpler_ss_symbol, case_simpler_symbol, case_simplest_ss_symbol, case_simplest_symbol, case_unchecked_symbol,
- cond_all_x_2_symbol, cond_all_x_symbol, cond_s_symbol, cond_simple_symbol, cond_unchecked_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, if_a_p_p_symbol, if_a_p_symbol, if_and2_p_p_symbol, if_and2_p_symbol,
- if_andp_p_p_symbol, if_andp_p_symbol, if_cc_p_p_symbol, if_cc_p_symbol, if_cs_p_p_symbol, if_cs_p_symbol, if_csc_p_p_symbol,
- if_csc_p_symbol, if_csq_p_p_symbol, if_csq_p_symbol, if_css_p_p_symbol, if_css_p_symbol, if_is_pair_p_p_symbol,
- if_is_pair_p_symbol, if_is_symbol_p_p_symbol, if_is_symbol_p_symbol, if_not_s_p_p_symbol, if_not_s_p_symbol,
- if_opssq_p_p_symbol, if_opssq_p_symbol, if_orp_p_p_symbol, if_orp_p_symbol, if_p_feed_symbol, if_p_p_p_symbol,
- if_p_p_symbol, if_s_opcq_p_p_symbol, if_s_opcq_p_symbol, if_s_p_p_symbol, if_s_p_symbol, if_unchecked_symbol,
- if_z_p_p_symbol, if_z_p_symbol, increment_1_symbol, increment_sa_symbol, increment_saa_symbol, increment_ss_symbol,
+ 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,
+ 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,
+ if_unchecked_symbol,
+
+ case_a_e_s_symbol, case_a_i_s_symbol, case_a_g_s_symbol, case_a_e_g_symbol, case_a_g_g_symbol,
+ case_s_e_s_symbol, case_s_i_s_symbol, case_s_g_s_symbol, case_s_e_g_symbol, case_s_g_g_symbol,
+ case_p_e_s_symbol, case_p_i_s_symbol, case_p_g_s_symbol, case_p_e_g_symbol, case_p_g_g_symbol,
+
+ if_a_p_p_symbol, if_a_p_symbol, if_a_r_symbol, if_a_n_n_symbol, if_a_n_symbol,
+ if_c_p_p_symbol, if_c_p_symbol, if_c_r_symbol, if_c_n_n_symbol, if_c_n_symbol,
+ if_cs_p_p_symbol, if_cs_p_symbol, if_cs_r_symbol, if_cs_n_n_symbol, if_cs_n_symbol,
+ 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_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_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,
+ if_p_p_p_symbol, if_p_p_symbol, if_p_r_symbol, if_p_n_n_symbol, if_p_n_symbol,
+ 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,
let_all_opsq_symbol, let_all_s_symbol, let_all_x_symbol, let_c_symbol, let_no_vars_symbol, let_one_symbol,
- let_opcq_symbol, let_opsq_p_symbol, let_opsq_symbol, let_opssq_symbol, let_s_symbol, let_star2_symbol,
+ let_opcq_symbol, let_opsq_p_symbol, let_opsq_symbol, let_car_symbol, let_opssq_symbol, let_opssq_e_symbol, let_opassq_e_symbol,
+ let_s_symbol, let_s_z_symbol, let_star2_symbol, let_a_symbol, let_a_z_symbol,
let_star_all_x_symbol, let_star_unchecked_symbol, let_unchecked_symbol, let_z_symbol, letrec_star_unchecked_symbol,
- letrec_unchecked_symbol, named_let_no_vars_symbol, named_let_star_symbol, named_let_symbol, or_p2_symbol, or_p_symbol,
+ letrec_unchecked_symbol, named_let_no_vars_symbol, named_let_star_symbol, named_let_symbol, let_temporarily_unchecked_symbol,
+
+ or_ap_symbol, or_az_symbol, or_p_symbol, or_safe_aa_symbol, or_safe_p_symbol,
or_unchecked_symbol, quote_unchecked_symbol, safe_do_symbol, safe_dotimes_symbol, set_cons_symbol, set_let_all_x_symbol,
set_let_s_symbol, set_normal_symbol, set_pair_a_symbol, set_pair_c_p_symbol, set_pair_c_symbol, set_pair_p_symbol,
- set_pair_symbol, set_pair_z_symbol, set_pair_za_symbol, set_pws_symbol, set_symbol_a_symbol, set_symbol_c_symbol,
+ set_pair_symbol, set_dilambda_symbol, set_dilambda_z_symbol, set_pair_z_symbol, set_pair_za_symbol,
+ set_pws_symbol, set_symbol_a_symbol, set_symbol_c_symbol,
set_symbol_opcq_symbol, set_symbol_opsq_symbol, set_symbol_opssq_symbol, set_symbol_opsssq_symbol, set_symbol_p_symbol,
- set_symbol_q_symbol, set_symbol_s_symbol, set_symbol_z_symbol, set_unchecked_symbol, simple_do_a_symbol,
- simple_do_e_symbol, simple_do_p_symbol, simple_do_symbol, unless_s_symbol, unless_unchecked_symbol, when_s_symbol,
- when_unchecked_symbol, with_baffle_unchecked_symbol, with_let_s_symbol, with_let_unchecked_symbol,
- dox_slot_symbol;
+ set_symbol_q_symbol, set_symbol_s_symbol, set_symbol_l_symbol, set_symbol_z_symbol, set_unchecked_symbol,
+ simple_do_symbol, unless_s_symbol, unless_a_symbol, unless_unchecked_symbol,
+ when_s_symbol, when_a_symbol, when_p_symbol, when_unchecked_symbol,
+ with_baffle_unchecked_symbol, with_let_s_symbol, with_let_unchecked_symbol,
+ dox_slot_symbol,
+ do_no_vars_symbol, do_no_vars_no_opt_symbol, dotimes_one_step_symbol;
#if WITH_GMP
s7_pointer bignum_symbol, is_bignum_symbol;
s7_pointer *bigints, *bigratios, *bigreals, *bignumbers;
- int bigints_size, bigratios_size, bigreals_size, bignumbers_size;
- int bigints_loc, bigratios_loc, bigreals_loc, bignumbers_loc;
+ unsigned int bigints_size, bigratios_size, bigreals_size, bignumbers_size;
+ unsigned int bigints_loc, bigratios_loc, bigreals_loc, bignumbers_loc;
#endif
#if WITH_SYSTEM_EXTRAS
@@ -1087,12 +1206,15 @@ struct s7_scheme {
/* setter and quasiquote functions */
s7_pointer vector_set_function, string_set_function, list_set_function, hash_table_set_function, let_set_function, object_set_function,
- qq_list_function, qq_apply_values_function, qq_append_function, multivector_function,
- apply_function, vector_function;
+ apply_values_function, multivector_function, apply_function, vector_function, last_function;
s7_pointer wrong_type_arg_info, out_of_range_info, simple_wrong_type_arg_info, simple_out_of_range_info;
- s7_pointer too_many_arguments_string, not_enough_arguments_string, division_by_zero_error_string;
- s7_pointer *safe_lists, *syn_docs; /* prebuilt evaluator arg lists, syntax doc strings */
+ s7_pointer err_wrap1, err_wrap2;
+ s7_pointer too_many_arguments_string, not_enough_arguments_string, division_by_zero_error_string, missing_method_string;
+ s7_pointer *syn_docs; /* prebuilt evaluator arg lists, syntax doc strings */
+ #define NUM_SAFE_LISTS 64
+ s7_pointer safe_lists[NUM_SAFE_LISTS];
+ int current_safe_list;
s7_pointer autoload_table, libraries, profile_info;
const char ***autoload_names;
@@ -1105,29 +1227,38 @@ struct s7_scheme {
int slash_str_size;
char *slash_str;
- xf_t *cur_rf;
- xf_t *rf_free_list, *rf_stack;
bool undefined_identifier_warnings;
+ hash_entry_t *optimizer_fixups;
+
+ opt_info *free_opts;
+ jmp_buf opt_exit;
+ int pc, funcalls, unwraps;
+ #define OPTS_SIZE 128 /* 128 overflows twice in s7test, 64 overflows 4 times in s7test, once in tall! */
+ opt_info *opts[OPTS_SIZE]; /* this form is a lot faster than opt_info**! */
};
+/* (*s7* 'safety) settings */
+#define NO_SAFETY 0
+#define CLM_OPTIMIZATION_SAFETY 1
+#define ALL_OPTIMIZATION_SAFETY 2
+#define IMMUTABLE_VECTOR_SAFETY 3
+
typedef enum {USE_DISPLAY, USE_WRITE, USE_READABLE_WRITE, USE_WRITE_WRONG} use_write_t;
-#define NUM_SAFE_LISTS 16
#define INITIAL_AUTOLOAD_NAMES_SIZE 4
+#define INITIAL_STORED_OPTLISTS_SIZE 8
+static s7_pointer *stored_optlists = NULL;
+static int stored_optlists_size, stofl_loc = -1;
+static int *stofl = NULL;
static s7_pointer prepackaged_type_names[NUM_TYPES];
-static bool t_number_p[NUM_TYPES], t_real_p[NUM_TYPES], t_rational_p[NUM_TYPES];
-static bool t_simple_p[NUM_TYPES];
-static bool t_big_number_p[NUM_TYPES];
-static bool t_structure_p[NUM_TYPES];
-static bool t_any_macro_p[NUM_TYPES];
-static bool t_any_closure_p[NUM_TYPES];
-static bool t_has_closure_let[NUM_TYPES];
-static bool t_sequence_p[NUM_TYPES];
-static bool t_vector_p[NUM_TYPES];
-static bool t_applicable_p[NUM_TYPES];
+static bool t_number_p[NUM_TYPES], t_real_p[NUM_TYPES], t_rational_p[NUM_TYPES], t_big_number_p[NUM_TYPES];
+static bool t_simple_p[NUM_TYPES], t_structure_p[NUM_TYPES];
+static bool t_any_macro_p[NUM_TYPES], t_any_closure_p[NUM_TYPES], t_has_closure_let[NUM_TYPES];
+static bool t_mappable_p[NUM_TYPES], t_sequence_p[NUM_TYPES], t_vector_p[NUM_TYPES];
+static bool t_procedure_p[NUM_TYPES], t_applicable_p[NUM_TYPES];
static void init_types(void)
{
@@ -1143,8 +1274,10 @@ static void init_types(void)
t_any_closure_p[i] = false;
t_has_closure_let[i] = false;
t_sequence_p[i] = false;
+ t_mappable_p[i] = false;
t_vector_p[i] = false;
t_applicable_p[i] = false;
+ t_procedure_p[i] = false;
}
t_number_p[T_INTEGER] = true;
t_number_p[T_RATIO] = true;
@@ -1180,6 +1313,23 @@ static void init_types(void)
t_sequence_p[T_LET] = true;
t_sequence_p[T_C_OBJECT] = true;
+ t_mappable_p[T_PAIR] = true;
+ t_mappable_p[T_STRING] = true;
+ t_mappable_p[T_VECTOR] = true;
+ t_mappable_p[T_INT_VECTOR] = true;
+ t_mappable_p[T_FLOAT_VECTOR] = true;
+ t_mappable_p[T_HASH_TABLE] = true;
+ t_mappable_p[T_LET] = true;
+ t_mappable_p[T_C_OBJECT] = true;
+ t_mappable_p[T_ITERATOR] = true;
+ t_mappable_p[T_C_MACRO] = true;
+ t_mappable_p[T_MACRO] = true;
+ t_mappable_p[T_BACRO] = true;
+ t_mappable_p[T_MACRO_STAR] = true;
+ t_mappable_p[T_BACRO_STAR] = true;
+ t_mappable_p[T_CLOSURE] = true;
+ t_mappable_p[T_CLOSURE_STAR] = true;
+
t_vector_p[T_VECTOR] = true;
t_vector_p[T_INT_VECTOR] = true;
t_vector_p[T_FLOAT_VECTOR] = true;
@@ -1209,6 +1359,17 @@ static void init_types(void)
t_applicable_p[T_GOTO] = true;
t_applicable_p[T_CONTINUATION] = true;
+ /* t_procedure_p[T_C_OBJECT] = true; */
+ t_procedure_p[T_C_FUNCTION] = true;
+ t_procedure_p[T_C_FUNCTION_STAR] = true;
+ t_procedure_p[T_C_ANY_ARGS_FUNCTION] = true;
+ t_procedure_p[T_C_OPT_ARGS_FUNCTION] = true;
+ t_procedure_p[T_C_RST_ARGS_FUNCTION] = true;
+ t_procedure_p[T_CLOSURE] = true;
+ t_procedure_p[T_CLOSURE_STAR] = true;
+ t_procedure_p[T_GOTO] = true;
+ t_procedure_p[T_CONTINUATION] = true;
+
t_any_macro_p[T_C_MACRO] = true;
t_any_macro_p[T_MACRO] = true;
t_any_macro_p[T_BACRO] = true;
@@ -1226,7 +1387,8 @@ static void init_types(void)
t_has_closure_let[T_CLOSURE_STAR] = true;
t_simple_p[T_NIL] = true;
- t_simple_p[T_UNIQUE] = true;
+ t_simple_p[T_UNDEFINED] = true;
+ t_simple_p[T_EOF_OBJECT] = true;
t_simple_p[T_BOOLEAN] = true;
t_simple_p[T_CHARACTER] = true;
t_simple_p[T_SYMBOL] = true;
@@ -1244,19 +1406,19 @@ static void init_types(void)
}
#if WITH_HISTORY
-#define current_code(Sc) car(Sc->cur_code)
+#define current_code(Sc) car(Sc->cur_code)
#define set_current_code(Sc, Code) do {Sc->cur_code = cdr(Sc->cur_code); set_car(Sc->cur_code, Code);} while (0)
-#define mark_current_code(Sc) do {int i; s7_pointer p; for (p = Sc->cur_code, i = 0; i < sc->history_size; i++, p = cdr(p)) S7_MARK(car(p));} while (0)
+#define mark_current_code(Sc) do {int i; s7_pointer p; for (p = Sc->cur_code, i = 0; i < sc->history_size; i++, p = cdr(p)) S7_MARK(car(p));} while (0)
#else
-#define current_code(Sc) Sc->cur_code
+#define current_code(Sc) Sc->cur_code
#define set_current_code(Sc, Code) Sc->cur_code = Code
-#define mark_current_code(Sc) S7_MARK(Sc->cur_code)
+#define mark_current_code(Sc) S7_MARK(Sc->cur_code)
#endif
#define typeflag(p) ((p)->tf.flag)
#define typesflag(p) ((p)->tf.sflag)
-static s7_scheme *hidden_sc = NULL;
+static s7_scheme *cur_sc = NULL;
#if DEBUGGING
static const char *check_name(int typ);
@@ -1273,6 +1435,7 @@ static s7_scheme *hidden_sc = NULL;
static s7_pointer check_ref10(s7_pointer p, const char *func, int line);
static s7_pointer check_ref11(s7_pointer p, const char *func, int line);
static s7_pointer check_nref(s7_pointer p, const char *func, int line);
+ static s7_pointer check_cell(s7_pointer p, const char *func, int line);
static void print_gc_info(s7_pointer obj, int line);
static s7_pointer opt1_1(s7_scheme *sc, s7_pointer p, unsigned int role, const char *func, int line);
@@ -1306,21 +1469,19 @@ static s7_scheme *hidden_sc = NULL;
p->current_alloc_line = __LINE__; \
p->current_alloc_func = __func__; \
p->current_alloc_type = f; \
- p->uses++; p->clear_line = 0; \
+ p->uses++; \
if ((((f) & 0xff) == T_FREE) || (((f) & 0xff) >= NUM_TYPES)) \
fprintf(stderr, "%d: set free %p type to %x\n", __LINE__, p, f); \
else \
{ \
if (((typeflag(p) & T_IMMUTABLE) != 0) && ((typeflag(p) != (f)))) \
- fprintf(stderr, "%d: set immutable %p type %x to %x\n", __LINE__, p, unchecked_type(p), f); \
+ {fprintf(stderr, "%s[%d]: set immutable %p type %d to %d\n", __func__, __LINE__, p, unchecked_type(p), f); abort();} \
if (((typeflag(p) & T_LINE_NUMBER) != 0) && (((typeflag(p)) & 0xff) == T_PAIR) && (((f) & T_LINE_NUMBER) == 0)) \
fprintf(stderr, "%d unsets line_number\n", __LINE__); \
} \
typeflag(p) = f; \
} while (0)
- #define clear_type(p) do {p->clear_line = __LINE__; typeflag(p) = T_FREE;} while (0)
-
/* these check most s7cell field references (and many type bits) for consistency */
#define _TI(P) check_ref(P, T_INTEGER, __func__, __LINE__, NULL, NULL)
#define _TR(P) check_ref(P, T_REAL, __func__, __LINE__, NULL, NULL)
@@ -1333,6 +1494,7 @@ static s7_scheme *hidden_sc = NULL;
#define _TChr(P) check_ref(P, T_CHARACTER, __func__, __LINE__, NULL, NULL)
#define _TCtr(P) check_ref(P, T_COUNTER, __func__, __LINE__, NULL, NULL)
+ #define _TOpt(P) check_ref(P, T_OPTLIST, __func__, __LINE__, "free_optlist", NULL)
#define _TPtr(P) check_ref(P, T_C_POINTER, __func__, __LINE__, NULL, NULL)
#define _TBfl(P) check_ref(P, T_BAFFLE, __func__, __LINE__, NULL, NULL)
#define _TGot(P) check_ref(P, T_GOTO, __func__, __LINE__, NULL, NULL)
@@ -1343,7 +1505,7 @@ static s7_scheme *hidden_sc = NULL;
#define _TSlt(P) check_ref(P, T_SLOT, __func__, __LINE__, NULL, NULL)
#define _TSlp(P) check_ref2(P, T_SLOT, T_PAIR, __func__, __LINE__, NULL, NULL)
#define _TSln(P) check_ref2(P, T_SLOT, T_NIL, __func__, __LINE__, NULL, NULL)
- #define _TSld(P) check_ref2(P, T_SLOT, T_UNIQUE, __func__, __LINE__, NULL, NULL)
+ #define _TSld(P) check_ref2(P, T_SLOT, T_UNDEFINED,__func__, __LINE__, NULL, NULL)
#define _TSyn(P) check_ref(P, T_SYNTAX, __func__, __LINE__, NULL, NULL)
#define _TMac(P) check_ref(P, T_C_MACRO, __func__, __LINE__, NULL, NULL)
#define _TLet(P) check_ref(P, T_LET, __func__, __LINE__, NULL, NULL)
@@ -1358,6 +1520,7 @@ static s7_scheme *hidden_sc = NULL;
#define _TFvc(P) check_ref(P, T_FLOAT_VECTOR, __func__, __LINE__, "sweep", NULL)
#define _TIvc(P) check_ref(P, T_INT_VECTOR, __func__, __LINE__, "sweep", NULL)
#define _TSym(P) check_ref(P, T_SYMBOL, __func__, __LINE__, "sweep", "remove_gensym_from_symbol_table")
+ #define _TExp(P) check_ref2(P, T_MACRO, T_SYMBOL, __func__, __LINE__, NULL, NULL)
#define _TPrt(P) check_ref3(P, __func__, __LINE__) /* input|output_port, or free */
#define _TVec(P) check_ref4(P, __func__, __LINE__) /* any vector or free */
@@ -1369,13 +1532,13 @@ static s7_scheme *hidden_sc = NULL;
#define _TArg(P) check_ref10(P, __func__, __LINE__) /* closure arg (list, symbol) */
#define _TApp(P) check_ref11(P, __func__, __LINE__) /* setter (any_procedure or #f) */
#define _NFre(P) check_nref(P, __func__, __LINE__) /* not free */
+ #define _Cell(P) check_cell(P, __func__, __LINE__) /* any cell */
#define _TSet(P) check_seti(sc, P, __func__, __LINE__) /* set of immutable value */
#else
#define unchecked_type(p) ((p)->tf.type_field)
#define type(p) ((p)->tf.type_field)
#define set_type(p, f) typeflag(p) = f
- #define clear_type(p) typeflag(p) = T_FREE
#define _TSet(P) P
#define _TI(P) P
#define _TR(P) P
@@ -1390,6 +1553,7 @@ static s7_scheme *hidden_sc = NULL;
#define _TChr(P) P
#define _TObj(P) P
#define _TCtr(P) P
+ #define _TOpt(P) P
#define _THsh(P) P
#define _TItr(P) P
#define _TPtr(P) P
@@ -1421,7 +1585,9 @@ static s7_scheme *hidden_sc = NULL;
#define _TMac(P) P
#define _TArg(P) P
#define _TApp(P) P
+ #define _TExp(P) P
#define _NFre(P) P
+ #define _Cell(P) P
#endif
#define is_number(P) t_number_p[type(P)]
@@ -1437,6 +1603,7 @@ static s7_scheme *hidden_sc = NULL;
#define is_t_big_ratio(p) (type(p) == T_BIG_RATIO)
#define is_t_big_real(p) (type(p) == T_BIG_REAL)
#define is_t_big_complex(p) (type(p) == T_BIG_COMPLEX)
+#define is_float(p) ((is_real(p)) && (!is_rational(p)))
#define is_free(p) (type(p) == T_FREE)
#define is_free_and_clear(p) (typeflag(p) == T_FREE)
@@ -1445,19 +1612,19 @@ static s7_scheme *hidden_sc = NULL;
#define is_any_macro(P) t_any_macro_p[type(P)]
#define is_any_closure(P) t_any_closure_p[type(P)]
-#define is_procedure_or_macro(P) ((t_any_macro_p[type(P)]) || ((typeflag(P) & T_PROCEDURE) != 0))
+#define is_procedure_or_macro(P) ((t_procedure_p[type(P)]) || (t_any_macro_p[type(P)]))
#define is_any_procedure(P) (type(P) >= T_CLOSURE)
#define has_closure_let(P) t_has_closure_let[type(P)]
#define is_simple_sequence(P) (t_sequence_p[type(P)])
#define is_sequence(P) ((t_sequence_p[type(P)]) || (has_methods(P)))
+#define is_mappable(P) (t_mappable_p[type(P)])
#define is_applicable(P) (t_applicable_p[type(P)])
/* this misses #() which actually is not applicable to anything, probably "" also, and inapplicable c-objects like random-state */
+#define is_procedure(p) ((t_procedure_p[type(p)]) || ((is_c_object(p)) && (is_safe_procedure(p))))
-/* the layout of these bits does matter in several cases -- in particular, don't use the second byte for anything
- * that might shadow SYNTACTIC_PAIR and OPTIMIZED_PAIR.
- */
+/* the layout of these bits does matter in several cases -- don't shadow SYNTACTIC_PAIR and OPTIMIZED_PAIR */
#define TYPE_BITS 8
#define T_KEYWORD (1 << (TYPE_BITS + 0))
@@ -1472,21 +1639,24 @@ static s7_scheme *hidden_sc = NULL;
#define SYNTACTIC_TYPE (unsigned short)(T_SYMBOL | T_DONT_EVAL_ARGS | T_SYNTACTIC)
#define SYNTACTIC_PAIR (unsigned short)(T_PAIR | T_SYNTACTIC)
/* this marks symbols that represent syntax objects, it should be in the second byte */
-#define set_syntactic_pair(p) typeflag(p) = (SYNTACTIC_PAIR | (typeflag(p) & 0xffff0000))
+#define set_syntactic_pair(p) typeflag(_TPair(p)) = (SYNTACTIC_PAIR | (typeflag(p) & 0xffff0000))
-#define T_PROCEDURE (1 << (TYPE_BITS + 2))
-#define is_procedure(p) ((typesflag(_NFre(p)) & T_PROCEDURE) != 0)
-/* closure, c_function, applicable object, goto or continuation, should be in second byte */
+/* bit 2 currently unused */
#define T_OPTIMIZED (1 << (TYPE_BITS + 3))
#define set_optimized(p) typesflag(_TPair(p)) |= T_OPTIMIZED
-#define clear_optimized(p) typesflag(_TPair(p)) &= (~T_OPTIMIZED)
+#define clear_optimized(p) typeflag(_TPair(p)) &= (~(T_OPTIMIZED | T_OVERLAY | T_SYNTACTIC | T_HAS_ALL_X))
#define OPTIMIZED_PAIR (unsigned short)(T_PAIR | T_OPTIMIZED)
#define is_optimized(p) (typesflag(p) == OPTIMIZED_PAIR)
+#define unoptimize(p) typesflag(_TPair(p)) &= (~T_OPTIMIZED)
/* this is faster than the bit extraction above and the same speed as xor */
/* optimizer flag for an expression that has optimization info, it should be in the second byte
*/
+#define T_SCOPE_SAFE T_OPTIMIZED
+#define is_scope_safe(p) ((typeflag(_TFnc(p)) & T_SCOPE_SAFE) != 0)
+#define set_scope_safe(p) typeflag(_TFnc(p)) |= T_SCOPE_SAFE
+
#define T_SAFE_CLOSURE (1 << (TYPE_BITS + 4))
#define is_safe_closure(p) ((typesflag(_NFre(p)) & T_SAFE_CLOSURE) != 0)
#define set_safe_closure(p) typesflag(p) |= T_SAFE_CLOSURE
@@ -1495,6 +1665,9 @@ static s7_scheme *hidden_sc = NULL;
* set_safe_closure happens only in optimize_lambda, clear only in procedure_source, bits only here
* this has to be separate from T_SAFE_PROCEDURE, and should be in the second byte.
* It can be set on either the body (a pair) or the closure itself.
+ * define -> optimize_lambda sets safe -> define_funchecked -> make_funclet for the frame
+ * similarly, named let -> optimize_lambda, then let creates the frame if safe
+ * thereafter, optimizer uses OP_SAFE_CLOSURE* which calls old_frame*
*/
#define T_DONT_EVAL_ARGS (1 << (TYPE_BITS + 5))
@@ -1502,9 +1675,9 @@ static s7_scheme *hidden_sc = NULL;
/* this marks things that don't evaluate their arguments */
#define T_EXPANSION (1 << (TYPE_BITS + 6))
-#define is_expansion(p) ((typesflag(_NFre(p)) & T_EXPANSION) != 0)
+#define is_expansion(p) ((typesflag(_TExp(p)) & T_EXPANSION) != 0)
#define clear_expansion(p) typesflag(_TSym(p)) &= (~T_EXPANSION)
-/* this marks the symbol associated with a run-time macro and distinguishes the value from an ordinary macro */
+/* this marks the symbol and its run-time macro value, distinguishing it from an ordinary macro */
#define T_MULTIPLE_VALUE (1 << (TYPE_BITS + 7))
#define is_multiple_value(p) ((typesflag(_NFre(p)) & T_MULTIPLE_VALUE) != 0)
@@ -1526,7 +1699,7 @@ static s7_scheme *hidden_sc = NULL;
#define T_GLOBAL (1 << (TYPE_BITS + 8))
#define is_global(p) ((typeflag(_TSym(p)) & T_GLOBAL) != 0)
-#define set_global(p) typeflag(_TSym(p)) |= T_GLOBAL
+#define set_global(p) do {if (!is_local(p)) typeflag(_TSym(p)) |= T_GLOBAL;} while (0)
#if 0
/* to find who is stomping on our symbols: */
static char *object_to_truncated_string(s7_scheme *sc, s7_pointer p, int len);
@@ -1539,16 +1712,14 @@ static s7_scheme *hidden_sc = NULL;
}
#define set_local(Symbol) set_local_1(sc, Symbol, __func__, __LINE__)
#else
-#define set_local(p) typeflag(_TSym(p)) &= ~(T_DONT_EVAL_ARGS | T_GLOBAL | T_SYNTACTIC)
+#define set_local(p) typeflag(_TSym(p)) = ((typeflag(p) | T_LOCAL) & ~(T_DONT_EVAL_ARGS | T_GLOBAL | T_SYNTACTIC))
#endif
/* this (T_GLOBAL) marks something defined (bound) at the top-level, and never defined locally */
#define T_UNSAFE_DO T_GLOBAL
#define is_unsafe_do(p) ((typeflag(_TPair(p)) & T_UNSAFE_DO) != 0)
#define set_unsafe_do(p) typeflag(_TPair(p)) |= T_UNSAFE_DO
-#define is_unsafe_sort(p) is_unsafe_do(p)
-#define set_unsafe_sort(p) set_unsafe_do(p)
-/* marks do-loops (and sort functions) that resist optimization */
+/* marks do-loops that resist optimization */
#define T_COLLECTED (1 << (TYPE_BITS + 9))
#define is_collected(p) ((typeflag(_TSeq(p)) & T_COLLECTED) != 0)
@@ -1592,16 +1763,22 @@ static s7_scheme *hidden_sc = NULL;
#define T_SHARED (1 << (TYPE_BITS + 11))
#define is_shared(p) ((typeflag(_TSeq(p)) & T_SHARED) != 0)
#define set_shared(p) typeflag(_TSeq(p)) |= T_SHARED
-/* #define clear_shared(p) typeflag(_TSeq(p)) &= (~T_SHARED) */
#define clear_collected_and_shared(p) typeflag(p) &= (~(T_COLLECTED | T_SHARED)) /* this can clear free cells = calloc */
+#define is_collected_or_shared(p) ((typeflag(p) & (T_COLLECTED | T_SHARED)) != 0)
#define T_OVERLAY (1 << (TYPE_BITS + 12))
#define set_overlay(p) typeflag(_TPair(p)) |= T_OVERLAY
#define is_overlaid(p) ((typeflag(_TPair(p)) & T_OVERLAY) != 0)
+#define clear_overlay(p) typeflag(_TPair(p)) &= (~T_OVERLAY)
/* optimizer flag that marks a cell whose opt_back [ie opt1] points to the previous cell in a list */
+#define T_LOCAL T_OVERLAY
+#define is_local(p) ((typeflag(_TSym(p)) & T_LOCAL) != 0)
+/* marks a symbol that has been used locally (needed to protect against incorrect set_globals later) */
+
#define T_SAFE_PROCEDURE (1 << (TYPE_BITS + 13))
#define is_safe_procedure(p) ((typeflag(_NFre(p)) & T_SAFE_PROCEDURE) != 0)
+#define is_scope_safe_procedure(p) ((typeflag(_TFnc(p)) & (T_SCOPE_SAFE | T_SAFE_PROCEDURE)) != 0)
/* applicable objects that do not return or modify their arg list directly (no :rest arg in particular),
* and that can't call apply themselves either directly or via s7_call, and that don't mess with the stack.
*/
@@ -1610,15 +1787,13 @@ static s7_scheme *hidden_sc = NULL;
#define set_checked(p) typeflag(_TPair(p)) |= T_CHECKED
#define is_checked(p) ((typeflag(_TPair(p)) & T_CHECKED) != 0)
#define clear_checked(p) typeflag(_TPair(p)) &= (~T_CHECKED)
-
#define set_checked_slot(p) typeflag(_TSlt(p)) |= T_CHECKED
#define is_checked_slot(p) ((typeflag(_TSlt(p)) & T_CHECKED) != 0)
#define is_not_checked_slot(p) ((typeflag(_TSlt(p)) & T_CHECKED) == 0)
-
#define T_UNSAFE (1 << (TYPE_BITS + 15))
#define set_unsafe(p) typeflag(_TPair(p)) |= T_UNSAFE
-#define set_unsafely_optimized(p) typeflag(_TPair(p)) |= (T_UNSAFE | T_OPTIMIZED)
+#define set_unsafely_optimized(p) typeflag(_TPair(p)) = (typeflag(p) & (~T_OVERLAY)) | (T_UNSAFE | T_OPTIMIZED)
#define is_unsafe(p) ((typeflag(_TPair(p)) & T_UNSAFE) != 0)
#define clear_unsafe(p) typeflag(_TPair(p)) &= (~T_UNSAFE)
#define is_safely_optimized(p) ((typeflag(p) & (T_OPTIMIZED | T_UNSAFE)) == T_OPTIMIZED)
@@ -1629,13 +1804,18 @@ static s7_scheme *hidden_sc = NULL;
#define set_clean_symbol(p) typeflag(_TSym(p)) |= T_CLEAN_SYMBOL
/* set if we know the symbol name can be printed without quotes (slashification) */
+#define T_HAS_STEPPER T_UNSAFE
+#define has_stepper(p) ((typeflag(_TSlt(p)) & T_HAS_STEPPER) != 0)
+#define set_has_stepper(p) typeflag(_TSlt(p)) |= T_HAS_STEPPER
+
#define T_IMMUTABLE (1 << (TYPE_BITS + 16))
#define is_immutable(p) ((typeflag(_NFre(p)) & T_IMMUTABLE) != 0)
+#define set_immutable(p) typeflag(_NFre(p)) |= T_IMMUTABLE
#define is_immutable_port(p) ((typeflag(_TPrt(p)) & T_IMMUTABLE) != 0)
#define is_immutable_symbol(p) ((typeflag(_TSym(p)) & T_IMMUTABLE) != 0)
-#define is_immutable_integer(p) ((typeflag(_TI(p)) & T_IMMUTABLE) != 0)
-#define is_immutable_real(p) ((typeflag(_TR(p)) & T_IMMUTABLE) != 0)
-#define set_immutable(p) typeflag(_TSym(p)) |= T_IMMUTABLE
+#define is_immutable_pair(p) ((typeflag(_TPair(p)) & T_IMMUTABLE) != 0)
+#define is_immutable_vector(p) ((typeflag(_TVec(p)) & T_IMMUTABLE) != 0)
+#define is_immutable_string(p) ((typeflag(_TStr(p)) & T_IMMUTABLE) != 0)
/* immutable means the value can't be changed via set! or bind -- this is separate from the symbol access stuff
* this bit can't be in the second byte -- with-let, for example, is immutable, but we use SYNTACTIC_TYPE to
* recognize syntax in do loop optimizations.
@@ -1653,31 +1833,77 @@ static s7_scheme *hidden_sc = NULL;
* (define* (f :allow-other-keys)...) because there's only one nil, and besides, it does say "other".
*/
+/* this bit is already in use on pairs, but the contexts never overlap, I hope... I need more bits. */
+#define T_HAS_ALL_X T_SETTER
+#define set_has_all_x(p) typeflag(_TPair(p)) |= T_HAS_ALL_X
+#define has_all_x(p) ((typeflag(_TPair(p)) & T_HAS_ALL_X) != 0)
+#define clear_has_all_x(p) typeflag(_TPair(p)) &= (~T_HAS_ALL_X)
+
+/* closure stored optlists */
+#define T_HAS_OPTLIST T_SETTER
+#define has_optlist(p) ((typeflag(_TClo(p)) & T_HAS_OPTLIST) != 0)
+#define set_has_optlist(p) typeflag(_TClo(p)) |= T_HAS_OPTLIST
+#define clear_has_optlist(p) typeflag(_TClo(p)) &= (~T_HAS_OPTLIST)
+
+#define T_HASH_REMOVED T_SETTER
+#define hash_table_set_removed(p) typeflag(_THsh(p)) |= T_HASH_REMOVED
+#define hash_table_removed(p) ((typeflag(_THsh(p)) & T_HASH_REMOVED) != 0)
+
+#define T_LET_REMOVED T_SETTER
+#define let_set_removed(p) typeflag(_TLet(p)) |= T_LET_REMOVED
+#define let_removed(p) ((typeflag(_TLet(p)) & T_LET_REMOVED) != 0)
+/* these mark objects that have been removed from the heap or checked for that possibility */
+
#define T_MUTABLE (1 << (TYPE_BITS + 18))
#define is_mutable(p) ((typeflag(_TNum(p)) & T_MUTABLE) != 0)
/* #define set_mutable(p) typeflag(_TNum(p)) |= T_MUTABLE */
/* used for mutable numbers */
+#define T_HAS_KEYWORD T_MUTABLE
+#define has_keyword(p) ((typeflag(_TSym(p)) & T_HAS_KEYWORD) != 0)
+#define set_has_keyword(p) typeflag(_TSym(p)) |= T_HAS_KEYWORD
+
#define T_MARK_SEQ T_MUTABLE
#define is_mark_seq(p) ((typeflag(_TItr(p)) & T_MARK_SEQ) != 0)
#define set_mark_seq(p) typeflag(_TItr(p)) |= T_MARK_SEQ
/* used in iterators for GC mark of sequence */
#define T_BYTE_VECTOR T_MUTABLE
-#define is_byte_vector(p) ((typeflag(_TStr(p)) & T_BYTE_VECTOR) != 0)
+#define is_byte_vector(p) ((is_string(p)) && ((typeflag(p) & T_BYTE_VECTOR) != 0))
#define set_byte_vector(p) typeflag(_TStr(p)) |= T_BYTE_VECTOR
/* marks a string that the caller considers a byte_vector */
-#define T_STEPPER T_MUTABLE
-#define is_stepper(p) ((typeflag(_TSlt(p)) & T_STEPPER) != 0)
-#define set_stepper(p) typeflag(_TSlt(p)) |= T_STEPPER
-bool s7_is_stepper(s7_pointer p) {return(is_stepper(p));}
-/* marks a slot that holds a do-loop's step variable (if int, can be numerator=current, denominator=end) */
+#define T_STEP_END T_MUTABLE
+#define is_step_end(p) ((typeflag(_TSlt(p)) & T_STEP_END) != 0)
+#define set_step_end(p) typeflag(_TSlt(p)) |= T_STEP_END
+/* marks a slot that holds a do-loop's step-or-end variable, numerator=current, denominator=end */
+
+
+#define T_PAIR_NO_OPT T_MUTABLE
+#define set_pair_no_opt(p) typeflag(_TPair(p)) |= T_PAIR_NO_OPT
+#define pair_no_opt(p) ((typeflag(_TPair(p)) & T_PAIR_NO_OPT) != 0)
+
+#define T_CLOSURE_NO_OPT T_MUTABLE
+#define set_closure_no_opt(p) typeflag(_TClo(p)) |= T_CLOSURE_NO_OPT
+#define closure_no_opt(p) ((typeflag(_TClo(p)) & T_CLOSURE_NO_OPT) != 0)
+
+#define T_NO_INT_OPT T_SETTER
+#define set_no_int_opt(p) typeflag(_TPair(p)) |= T_NO_INT_OPT
+#define no_int_opt(p) ((typeflag(_TPair(p)) & T_NO_INT_OPT) != 0)
+
+#define T_NO_FLOAT_OPT T_UNSAFE
+#define set_no_float_opt(p) typeflag(_TPair(p)) |= T_NO_FLOAT_OPT
+#define no_float_opt(p) ((typeflag(_TPair(p)) & T_NO_FLOAT_OPT) != 0)
+
+#define T_NO_BOOL_OPT T_SAFE_STEPPER
+#define set_no_bool_opt(p) typeflag(_TPair(p)) |= T_NO_BOOL_OPT
+#define no_bool_opt(p) ((typeflag(_TPair(p)) & T_NO_BOOL_OPT) != 0)
+
#define T_SAFE_STEPPER (1 << (TYPE_BITS + 19))
#define is_safe_stepper(p) ((typeflag(_TSlp(p)) & T_SAFE_STEPPER) != 0)
#define set_safe_stepper(p) typeflag(_TSlp(p)) |= T_SAFE_STEPPER
-#define is_unsafe_stepper(p) ((typeflag(_TSlp(p)) & (T_STEPPER | T_SAFE_STEPPER)) == T_STEPPER)
+#define clear_safe_stepper(p) typeflag(p) &= (~T_SAFE_STEPPER)
/* an experiment */
#define T_PRINT_NAME T_SAFE_STEPPER
@@ -1685,10 +1911,9 @@ bool s7_is_stepper(s7_pointer p) {return(is_stepper(p));}
#define set_has_print_name(p) typeflag(_TNum(p)) |= T_PRINT_NAME
/* marks numbers that have a saved version of their string representation */
-#define T_POSSIBLY_SAFE T_SAFE_STEPPER
-#define is_possibly_safe(p) ((typeflag(_TFnc(p)) & T_POSSIBLY_SAFE) != 0)
-#define set_is_possibly_safe(p) typeflag(_TFnc(p)) |= T_POSSIBLY_SAFE
-/* marks c_functions that are not always unsafe -- this bit didn't work out as intended */
+#define T_MAYBE_SAFE T_SAFE_STEPPER
+#define is_maybe_safe(p) ((typeflag(_TFnc(p)) & T_MAYBE_SAFE) != 0)
+#define set_maybe_safe(p) typeflag(_TFnc(p)) |= T_MAYBE_SAFE
#define T_HAS_SET_FALLBACK T_SAFE_STEPPER
#define T_HAS_REF_FALLBACK T_MUTABLE
@@ -1702,13 +1927,18 @@ bool s7_is_stepper(s7_pointer p) {return(is_stepper(p));}
#define needs_copied_args(p) ((typeflag(_NFre(p)) & T_COPY_ARGS) != 0)
/* this marks something that might mess with its argument list, it should not be in the second byte */
+#define T_LOCAL_SYMBOL T_COPY_ARGS
+#define is_local_symbol(p) ((typeflag(_NFre(p)) & T_LOCAL_SYMBOL) != 0)
+#define set_local_symbol(p) typeflag(_TPair(p)) |= T_LOCAL_SYMBOL
+
+
#define T_GENSYM (1 << (TYPE_BITS + 21))
#define is_gensym(p) ((typeflag(_TSym(p)) & T_GENSYM) != 0)
/* symbol is from gensym (GC-able etc) */
-#define T_SIMPLE_ARGS T_GENSYM
-#define has_simple_args(p) ((typeflag(_TPair(p)) & T_SIMPLE_ARGS) != 0)
-#define set_simple_args(p) typeflag(_TPair(p)) |= T_SIMPLE_ARGS
+#define T_SIMPLE_ARG_DEFAULTS T_GENSYM
+#define has_simple_arg_defaults(p) ((typeflag(_TPair(p)) & T_SIMPLE_ARG_DEFAULTS) != 0)
+#define set_simple_arg_defaults(p) typeflag(_TPair(p)) |= T_SIMPLE_ARG_DEFAULTS
/* are all lambda* default values simple? */
#define T_LIST_IN_USE T_GENSYM
@@ -1717,9 +1947,9 @@ bool s7_is_stepper(s7_pointer p) {return(is_stepper(p));}
#define clear_list_in_use(p) typeflag(_TPair(p)) &= (~T_LIST_IN_USE)
/* these could all be one permanent list, indexed from inside, and this bit is never actually protecting anything across a call */
-#define T_FUNCTION_ENV T_GENSYM
-#define is_function_env(p) ((typeflag(_TLet(p)) & T_FUNCTION_ENV) != 0)
-#define set_function_env(p) typeflag(_TLet(p)) |= T_FUNCTION_ENV
+#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_DOCUMENTED T_GENSYM
@@ -1741,13 +1971,13 @@ bool s7_is_stepper(s7_pointer p) {return(is_stepper(p));}
#define clear_mark(p) typeflag(p) &= (~T_GC_MARK)
/* using bit 23 for this makes a big difference in the GC */
-
static int 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)
#define unheap(p) (p)->hloc = not_heap--
-#define is_eof(p) (_NFre(p) == sc->eof_object)
+#define is_eof(p) ((_NFre(p)) == sc->eof_object)
#define is_true(Sc, p) ((_NFre(p)) != Sc->F)
#define is_false(Sc, p) ((_NFre(p)) == Sc->F)
@@ -1763,6 +1993,7 @@ static int not_heap = -1;
#define is_null(p) ((_NFre(p)) == sc->nil)
#define is_not_null(p) ((_NFre(p)) != sc->nil)
+#define raw_opt1(p) ((p)->object.cons.opt1)
#if (!DEBUGGING)
@@ -1772,6 +2003,7 @@ static int not_heap = -1;
#define set_opt2(p, x, r) (p)->object.cons.opt2 = (s7_pointer)(x)
#define opt3(p, r) ((p)->object.cons.opt3)
#define set_opt3(p, x, r) do {(p)->object.cons.opt3 = x; typeflag(p) &= ~(T_OPTIMIZED | T_LINE_NUMBER);} while (0)
+/* turn off optimized because it collides with pair_syntax_op */
#define pair_line(p) (p)->object.sym_cons.line
#define pair_set_line(p, X) (p)->object.sym_cons.line = X
@@ -1782,7 +2014,8 @@ static int not_heap = -1;
#define pair_raw_name(p) (p)->object.sym_cons.fstr
#define pair_set_raw_name(p, X) (p)->object.sym_cons.fstr = X
-/* opt1 == raw_hash, opt2 == raw_name, opt3 == line+op|len, but hash/name/len only apply to the symbol table so there's no collision */
+/* opt1 == raw_hash, opt2 == raw_name, opt3 == line|ctr + op|len, but hash/name/len only apply to the symbol table so there's no collision
+ */
#else
@@ -1790,65 +2023,65 @@ static int not_heap = -1;
* the bits and funcs here try to track each such use, and report any cross-talk or collisions.
* all of this machinery vanishes if debugging is turned off.
*/
-#define S_NAME (1 << 26)
-#define S_HASH (1 << 27)
-#define S_OP (1 << 28)
-#define S_LINE (1 << 29)
-#define S_LEN (1 << 30)
-#define S_SYNOP 0x80000000 /* (1 << 31) */
+#define S_NAME (1 << 25)
+#define S_HASH (1 << 26)
+#define S_OP (1 << 27)
+#define S_LINE (1 << 28)
+#define S_LEN (1 << 29)
+#define S_SYNOP (1 << 30) /* 0x80000000 *//* (1 << 31) */
#define E_SET (1 << 0)
-#define E_FAST (1 << 6) /* fast list in member/assoc circular list check */
-#define E_CFUNC (1 << 7) /* c-function */
-#define E_CLAUSE (1 << 8) /* case clause */
-#define E_BACK (1 << 9) /* back pointer for doubly-linked list */
-#define E_LAMBDA (1 << 10) /* lambda(*) */
-#define E_SYM (1 << 11) /* symbol */
-#define E_PAIR (1 << 12) /* pair */
-#define E_CON (1 << 13) /* constant from eval's point of view */
-#define E_GOTO (1 << 14) /* call-with-exit exit func */
-#define E_VECTOR (1 << 15) /* vector (any kind) */
+#define E_FAST (1 << 7) /* fast list in member/assoc circular list check */
+#define E_CFUNC (1 << 8) /* c-function */
+#define E_CLAUSE (1 << 9) /* case clause */
+#define E_BACK (1 << 10) /* back pointer for doubly-linked list */
+#define E_LAMBDA (1 << 11) /* lambda(*) */
+#define E_SYM (1 << 12) /* symbol */
+#define E_PAIR (1 << 13) /* pair */
+#define E_CON (1 << 14) /* constant from eval's point of view */
+#define E_GOTO (1 << 15) /* call-with-exit exit func */
#define E_ANY (1 << 16) /* anything -- deliberate unchecked case */
#define E_SLOT (1 << 17) /* slot */
-#define E_MASK (E_FAST | E_CFUNC | E_CLAUSE | E_BACK | E_LAMBDA | E_SYM | E_PAIR | E_CON | E_GOTO | E_VECTOR | E_ANY | E_SLOT | S_HASH)
+#define E_MASK (E_FAST | E_CFUNC | E_CLAUSE | E_BACK | E_LAMBDA | E_SYM | E_PAIR | E_CON | E_GOTO | E_ANY | E_SLOT | S_HASH)
#define opt1_is_set(p) (((p)->debugger_bits & E_SET) != 0)
#define set_opt1_is_set(p) (p)->debugger_bits |= E_SET
#define opt1_role_matches(p, Role) (((p)->debugger_bits & E_MASK) == Role)
#define set_opt1_role(p, Role) (p)->debugger_bits = (Role | ((p)->debugger_bits & ~E_MASK))
-#define opt1(p, Role) opt1_1(hidden_sc, _TPair(p), Role, __func__, __LINE__)
-#define set_opt1(p, x, Role) set_opt1_1(hidden_sc, _TPair(p), x, Role, __func__, __LINE__)
-
-#define F_SET (1 << 1) /* bit 18 is free */
-#define F_KEY (1 << 19) /* case key */
-#define F_SLOW (1 << 20) /* slow list in member/assoc circular list check */
-#define F_SYM (1 << 21) /* symbol */
-#define F_PAIR (1 << 22) /* pair */
-#define F_CON (1 << 23) /* constant as above */
-#define F_CALL (1 << 24) /* c-func */
-#define F_LAMBDA (1 << 25) /* lambda form */
+#define opt1(p, Role) opt1_1(cur_sc, _TPair(p), Role, __func__, __LINE__)
+#define set_opt1(p, x, Role) set_opt1_1(cur_sc, _TPair(p), x, Role, __func__, __LINE__)
+
+#define F_SET (1 << 1)
+#define F_KEY (1 << 18) /* case key */
+#define F_SLOW (1 << 19) /* slow list in member/assoc circular list check */
+#define F_SYM (1 << 20) /* symbol */
+#define F_PAIR (1 << 21) /* pair */
+#define F_CON (1 << 22) /* constant as above */
+#define F_CALL (1 << 23) /* c-func */
+#define F_LAMBDA (1 << 24) /* lambda form */
#define F_MASK (F_KEY | F_SLOW | F_SYM | F_PAIR | F_CON | F_CALL | F_LAMBDA | S_NAME)
#define opt2_is_set(p) (((p)->debugger_bits & F_SET) != 0)
#define set_opt2_is_set(p) (p)->debugger_bits |= F_SET
#define opt2_role_matches(p, Role) (((p)->debugger_bits & F_MASK) == Role)
#define set_opt2_role(p, Role) (p)->debugger_bits = (Role | ((p)->debugger_bits & ~F_MASK))
-#define opt2(p, Role) opt2_1(hidden_sc, _TPair(p), Role, __func__, __LINE__)
-#define set_opt2(p, x, Role) set_opt2_1(hidden_sc, _TPair(p), (s7_pointer)x, Role, __func__, __LINE__)
+#define opt2(p, Role) opt2_1(cur_sc, _TPair(p), Role, __func__, __LINE__)
+#define set_opt2(p, x, Role) set_opt2_1(cur_sc, _TPair(p), (s7_pointer)x, Role, __func__, __LINE__)
/* opt3 collides with optimization and line number stuff (T_LINE_NUMBER, T_OPTIMIZED) */
#define G_SET (1 << 2)
#define G_ARGLEN (1 << 3) /* arglist length */
#define G_SYM (1 << 4) /* expression symbol access */
#define G_AND (1 << 5) /* and second clause */
-#define G_MASK (G_ARGLEN | G_SYM | G_AND | S_OP | S_LINE | S_LEN | S_SYNOP)
+#define G_CTR (1 << 6) /* saved symbol ctr -- currently unused */
+#define G_MASK (G_ARGLEN | G_SYM | G_AND | S_OP | S_LINE | S_LEN | S_SYNOP | G_CTR)
#define opt3_is_set(p) (((p)->debugger_bits & G_SET) != 0)
#define set_opt3_is_set(p) (p)->debugger_bits |= G_SET
#define opt3_role_matches(p, Role) (((p)->debugger_bits & G_MASK) == Role)
#define set_opt3_role(p, Role) (p)->debugger_bits = (Role | ((p)->debugger_bits & ~G_MASK))
-#define opt3(p, Role) opt3_1(hidden_sc, _TPair(p), Role, __func__, __LINE__)
-#define set_opt3(p, x, Role) set_opt3_1(hidden_sc, _TPair(p), x, Role, __func__, __LINE__)
+#define opt3(p, Role) opt3_1(cur_sc, _TPair(p), Role, __func__, __LINE__)
+#define set_opt3(p, x, Role) set_opt3_1(cur_sc, _TPair(p), x, Role, __func__, __LINE__)
/* opt1 == s_hash, opt2 == s_fstr, opt3 == s_op|len|line and op==len so they are contradictory (but only op/line|opt3 actually collide)
* line|len|op: unsigned int set G_SET and S_* if S_LEN -> not op and vice versa
@@ -1863,22 +2096,21 @@ static int not_heap = -1;
#define pair_set_raw_len(p, X) set_s_len_1(sc, _TPair(p), X, __func__, __LINE__)
#define pair_raw_name(p) s_name_1(sc, _TPair(p), __func__, __LINE__)
#define pair_set_raw_name(p, X) set_s_name_1(sc, _TPair(p), X, __func__, __LINE__)
+
#endif
#define opt_fast(P) _TLst(opt1(P, E_FAST))
-#define set_opt_fast(P, X) set_opt1(P, _TPair(X), E_FAST)
-#define opt_back(P) _TPair(opt1(P, E_BACK))
-#define set_opt_back(P) set_opt1(cdr(P), _TPair(P), E_BACK)
+#define set_opt_fast(P, X) set_opt1(P, _TPair(X), E_FAST)
+#define opt_back(P) _TPair(opt1(P, E_BACK))
+#define set_opt_back(P) set_opt1(cdr(P), _TPair(P),E_BACK)
#define has_opt_back(P) (cdr(opt_back(P)) == P )
#define opt_cfunc(P) _NFre(opt1(P, E_CFUNC))
#define set_opt_cfunc(P, X) set_opt1(P, _NFre(X), E_CFUNC)
-#define opt_lambda_unchecked(P) _NFre(opt1(P, E_LAMBDA))
+#define opt_lambda_unchecked(P) opt1(P, E_LAMBDA) /* can be free/null? from s7_call? */
#define opt_lambda(P) _TClo(opt1(P, E_LAMBDA))
#define set_opt_lambda(P, X) set_opt1(P, _NFre(X), E_LAMBDA)
#define opt_goto(P) _TGot(opt1(P, E_GOTO))
#define set_opt_goto(P, X) set_opt1(P, _TGot(X), E_GOTO)
-#define opt_vector(P) _TVec(opt1(P, E_VECTOR))
-#define set_opt_vector(P, X) set_opt1(P, _TVec(X), E_VECTOR)
#define opt_clause(P) _NFre(opt1(P, E_CLAUSE))
#define set_opt_clause(P, X) set_opt1(P, _NFre(X), E_CLAUSE)
#define opt_sym1(P) _TSym(opt1(P, E_SYM))
@@ -1887,13 +2119,23 @@ static int not_heap = -1;
#define set_opt_pair1(P, X) set_opt1(P, _TLst(X), E_PAIR)
#define opt_con1(P) _NFre(opt1(P, E_CON))
#define set_opt_con1(P, X) set_opt1(P, _NFre(X), E_CON)
-#define opt_any1(P) opt1(P, E_ANY) /* can be free in closure_is_ok */
+#define opt_any1(P) opt1(P, E_ANY) /* can be free in closure_is_ok */
#define opt_slot1(P) _TSlt(opt1(P, E_SLOT))
#define set_opt_slot1(P, X) set_opt1(P, _TSlt(X), E_SLOT)
#define c_callee(f) ((s7_function)opt2(f, F_CALL))
#define c_call(f) ((s7_function)opt2(f, F_CALL))
-#define set_c_call(f, X) set_opt2(f, (s7_pointer)X, F_CALL)
+#if DEBUGGING
+ #define set_c_call(f, X) do {if (!(X)) fprintf(stderr, "%s[%d] c_call null\n", __func__, __LINE__); set_opt2(f, (s7_pointer)(X), F_CALL);} while (0)
+ #define set_x_call_checked(f, X) do {if ((!(X)) && (strcmp(__func__, "check_and") != 0) && (strcmp(__func__, "check_or") != 0)) fprintf(stderr, "%s[%d] x_call null\n", __func__, __LINE__); set_opt2(f, (s7_pointer)(X), F_CALL); if (X) set_has_all_x(f); else clear_has_all_x(f);} while (0)
+ #define set_x_call(f, X) do {if (!(X)) fprintf(stderr, "%s[%d] x_call null\n", __func__, __LINE__); set_opt2(f, (s7_pointer)(X), F_CALL); if (X) set_has_all_x(f); else clear_has_all_x(f);} while (0)
+#else
+ #define set_c_call(f, X) set_opt2(f, (s7_pointer)(X), F_CALL)
+ #define set_x_call(f, X) do {set_opt2(f, (s7_pointer)(X), F_CALL); set_has_all_x(f);} while (0)
+ #define set_x_call_checked(f, X) do {set_opt2(f, (s7_pointer)(X), F_CALL); if (X) set_has_all_x(f); else clear_has_all_x(f);} while (0)
+#endif
+#define set_x_call_direct(f, X) do {set_opt2(f, (s7_pointer)(X), F_CALL); set_has_all_x(f);} while (0)
+
#define opt_key(P) _NFre(opt2(P, F_KEY))
#define set_opt_key(P, X) set_opt2(P, _NFre(X), F_KEY)
#define opt_slow(P) _TLst(opt2(P, F_SLOW))
@@ -1913,6 +2155,8 @@ static int not_heap = -1;
#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 car(p) (_TLst(p))->object.cons.car
@@ -1920,7 +2164,6 @@ static int not_heap = -1;
#define cdr(p) (_TLst(p))->object.cons.cdr
#define set_cdr(p, Val) (_TLst(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))
@@ -1958,7 +2201,7 @@ static int not_heap = -1;
#if WITH_GCC
/* slightly tricky because cons can be called recursively */
- #define cons(Sc, A, B) ({s7_pointer _X_, _A_, _B_; _A_ = A; _B_ = B; new_cell(sc, _X_, T_PAIR | T_SAFE_PROCEDURE); set_car(_X_, _A_); set_cdr(_X_, _B_); _X_;})
+ #define cons(Sc, A, B) ({s7_pointer _X_, _A_, _B_; _A_ = A; _B_ = B; new_cell(Sc, _X_, T_PAIR | T_SAFE_PROCEDURE); set_car(_X_, _A_); set_cdr(_X_, _B_); _X_;})
#else
#define cons(Sc, A, B) s7_cons(Sc, A, B)
#endif
@@ -1993,8 +2236,8 @@ static int not_heap = -1;
#define optimize_op(p) (_TPair(p))->object.sym_cons.op
#define set_optimize_op(P, Op) optimize_op(P) = Op
#else
- #define optimize_op(p) s_op_1(hidden_sc, _TPair(p), __func__, __LINE__)
- #define set_optimize_op(p, Op) set_s_op_1(hidden_sc, _TPair(p), Op, __func__, __LINE__)
+ #define optimize_op(p) s_op_1(cur_sc, _TPair(p), __func__, __LINE__)
+ #define set_optimize_op(p, Op) set_s_op_1(cur_sc, _TPair(p), Op, __func__, __LINE__)
#endif
#define optimize_op_match(P, Q) ((is_optimized(P)) && ((optimize_op(P) & 0xfffe) == Q))
@@ -2005,6 +2248,7 @@ static int not_heap = -1;
#define set_unsafe_optimize_op(P, Q) do {set_unsafely_optimized(P); set_optimize_op(P, Q);} while (0)
#define is_symbol(p) (type(p) == T_SYMBOL)
+#define is_safe_symbol(p) ((is_symbol(p)) && (is_slot(find_symbol(sc, p))))
#define symbol_name_cell(p) _TStr((_TSym(p))->object.sym.name)
#define symbol_set_name_cell(p, S) (_TSym(p))->object.sym.name = _TStr(S)
#define symbol_name(p) string_value(symbol_name_cell(p))
@@ -2016,7 +2260,7 @@ static int not_heap = -1;
/* we need 64-bits here, since we don't want this thing to wrap around, and frames are created at a great rate
* callgrind says this is faster than an unsigned int!
*/
-#define symbol_syntax_op(p) (_TSym(p))->object.sym.op
+#define symbol_syntax_op(p) syntax_opcode(slot_value(global_slot(p)))
#define global_slot(p) (_TSym(p))->object.sym.global_slot
#define set_global_slot(p, Val) (_TSym(p))->object.sym.global_slot = _TSld(Val)
@@ -2027,12 +2271,16 @@ static int not_heap = -1;
#define keyword_symbol(p) (symbol_name_cell(p))->object.string.doc.ksym
#define keyword_set_symbol(p, Val) (symbol_name_cell(p))->object.string.doc.ksym = _TSym(Val)
#define symbol_help(p) (symbol_name_cell(p))->object.string.doc.documentation
+#define symbol_set_help(p, Doc) (symbol_name_cell(p))->object.string.doc.documentation = Doc
#define symbol_tag(p) (_TSym(p))->object.sym.tag
#define symbol_set_tag(p, Val) (_TSym(p))->object.sym.tag = Val
+#define symbol_ctr(p) (_TSym(p))->object.sym.ctr
+#define symbol_set_ctr(p, Val) (_TSym(p))->object.sym.ctr = Val
+#define symbol_increment_ctr(p) (_TSym(p))->object.sym.ctr++
#define symbol_has_help(p) (is_documented(symbol_name_cell(p)))
#define symbol_set_has_help(p) set_documented(symbol_name_cell(p))
-#define symbol_set_local(Symbol, Id, Slot) do {set_local_slot(Symbol, Slot); symbol_set_id(Symbol, Id);} while (0)
+#define symbol_set_local(Symbol, Id, Slot) do {set_local_slot(Symbol, Slot); symbol_set_id(Symbol, Id); symbol_increment_ctr(Symbol);} while (0)
/* set slot before id in case Slot is an expression that tries to find the current Symbol slot (using its old Id obviously) */
#define is_slot(p) (type(p) == T_SLOT)
@@ -2051,6 +2299,12 @@ static int not_heap = -1;
#define slot_accessor(p) slot_expression(p)
#define slot_set_accessor(p, Val) slot_expression(p) = _TApp(Val)
+#if DEBUGGING
+ #define local_symbol_value(Sym) check_sym(sc, _TSym(Sym))
+#else
+ #define local_symbol_value(Sym) slot_value(local_slot(Sym))
+#endif
+
#define is_syntax(p) (type(p) == T_SYNTAX)
#define syntax_symbol(p) _TSym((_TSyn(p))->object.syn.symbol)
#define syntax_set_symbol(p, Sym) (_TSyn(p))->object.syn.symbol = _TSym(Sym)
@@ -2058,19 +2312,16 @@ static int not_heap = -1;
#define syntax_min_args(p) (_TSyn(p))->object.syn.min_args
#define syntax_max_args(p) (_TSyn(p))->object.syn.max_args
#define syntax_documentation(p) sc->syn_docs[syntax_opcode(p)]
-#define syntax_rp(p) (_TSyn(p))->object.syn.rp
-#define syntax_ip(p) (_TSyn(p))->object.syn.ip
-#define syntax_pp(p) (_TSyn(p))->object.syn.pp
#if (!DEBUGGING)
#define pair_syntax_op(p) (p)->object.sym_cons.op
- #define pair_set_syntax_op(p, X) (p)->object.sym_cons.op = X
+ #define pair_set_syntax_op(p, X) do {unoptimize(p); (p)->object.sym_cons.op = X;} while (0)
#else
- #define pair_syntax_op(p) s_syn_op_1(hidden_sc, _TPair(p), __func__, __LINE__)
- #define pair_set_syntax_op(p, Op) set_s_syn_op_1(hidden_sc, _TPair(p), Op, __func__, __LINE__)
+ #define pair_syntax_op(p) s_syn_op_1(cur_sc, _TPair(p), __func__, __LINE__)
+ #define pair_set_syntax_op(p, Op) do {unoptimize(p); set_s_syn_op_1(cur_sc, _TPair(p), Op, __func__, __LINE__);} while (0)
#endif
#define pair_syntax_symbol(P) car(opt_back(P))
-static void pair_set_syntax_symbol(s7_pointer p, s7_pointer op) {set_car(opt_back(p), op); pair_set_syntax_op(opt_back(p), symbol_syntax_op(op));}
+#define pair_set_syntax_symbol(p, op) do {set_car(opt_back(p), op); pair_set_syntax_op(opt_back(p), symbol_syntax_op(op));} while (0)
#define ROOTLET_SIZE 512
#define let_id(p) (_TLid(p))->object.envr.id
@@ -2089,10 +2340,13 @@ static void pair_set_syntax_symbol(s7_pointer p, s7_pointer op) {set_car(opt_bac
#define dox_set_slot1(p, S) (_TLet(p))->object.envr.edat.dox.dox1 = _TSlt(S)
#define dox_slot2(p) _TSlt((_TLet(p))->object.envr.edat.dox.dox2)
#define dox_set_slot2(p, S) (_TLet(p))->object.envr.edat.dox.dox2 = _TSlt(S)
+#define dox_slot2_unchecked(p) _TLet(p)->object.envr.edat.dox.dox2
+#define dox_set_slot2_unchecked(p, S) _TLet(p)->object.envr.edat.dox.dox2 = (S)
#define unique_name(p) (p)->object.unq.name
#define unique_name_length(p) (p)->object.unq.len
#define is_unspecified(p) (type(p) == T_UNSPECIFIED)
+#define unique_car(p) (p)->object.unq.unused_slots
#define unique_cdr(p) (p)->object.unq.unused_nxt
#define vector_length(p) ((p)->object.vector.length)
@@ -2203,11 +2457,8 @@ static void pair_set_syntax_symbol(s7_pointer p, s7_pointer op) {set_car(opt_bac
#define c_function_arg_defaults(f) c_function_data(f)->arg_defaults
#define c_function_call_args(f) c_function_data(f)->call_args
#define c_function_arg_names(f) c_function_data(f)->arg_names
-#define c_function_rp(f) c_function_data(f)->rp
-#define c_function_ip(f) c_function_data(f)->ip
-#define c_function_pp(f) c_function_data(f)->pp
-#define c_function_gp(f) c_function_data(f)->gp
-#define set_c_function(f, X) do {set_opt_cfunc(f, X); set_c_call(f, c_function_call(opt_cfunc(f)));} while (0)
+#define set_c_function(X, f) do {set_opt_cfunc(X, f); set_c_call(X, c_function_call(f));} while (0)
+#define c_function_opt_data(f) c_function_data(f)->opt_data
#define is_c_macro(p) (type(p) == T_C_MACRO)
#define c_macro_data(f) (_TMac(f))->object.fnc.c_proc
@@ -2264,11 +2515,26 @@ static void pair_set_syntax_symbol(s7_pointer p, s7_pointer op) {set_car(opt_bac
#define closure_setter(p) _TApp((_TClo(p))->object.func.setter)
#define closure_set_setter(p, Val) (_TClo(p))->object.func.setter = _TApp(Val)
#define closure_arity(p) (_TClo(p))->object.func.arity
+#define closure_optlist_addr(p) (_TClo(p))->object.func.opt_addr
+#define closure_set_optlist_addr(p, addr) (_TClo(p))->object.func.opt_addr = addr
+#define closure_optlist(p) stored_optlists[closure_optlist_addr(p)]
#define CLOSURE_ARITY_NOT_SET 0x40000000
#define MAX_ARITY 0x20000000
#define closure_arity_unknown(p) (closure_arity(p) == CLOSURE_ARITY_NOT_SET)
#define is_thunk(Sc, Fnc) ((type(Fnc) >= T_GOTO) && (s7_is_aritable(Sc, Fnc, 0)))
+#define is_optlist(p) (type(p) == T_OPTLIST)
+#define optlist_num_exprs(p) (_TOpt(p))->object.opt.num_exprs
+#define optlist_set_num_exprs(p, Val) (_TOpt(p))->object.opt.num_exprs = Val
+#define optlist_addr(p) (_TOpt(p))->object.opt.addr
+#define optlist_pc(p) (_TOpt(p))->object.opt.pc
+#define optlist_set_pc(p, Val) (_TOpt(p))->object.opt.pc = Val
+#define optlist_num_args(p) (_TOpt(p))->object.opt.num_args
+#define optlist_set_num_args(p, Val) (_TOpt(p))->object.opt.num_args = Val
+#define optlist_len(p) (_TOpt(p))->object.opt.len
+#define optlist_set_len(p, Val) (_TOpt(p))->object.opt.len = Val
+#define optlist_opts(p) (_TOpt(p))->object.opt.opts
+
#define hook_has_functions(p) (is_pair(s7_hook_functions(sc, _TClo(p))))
#define catch_tag(p) (_TCat(p))->object.rcatch.tag
@@ -2314,10 +2580,6 @@ static int num_object_types = 0;
#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_ip(p) c_object_info(p)->ip
-#define c_object_rp(p) c_object_info(p)->rp
-#define c_object_set_ip(p) c_object_info(p)->set_ip
-#define c_object_set_rp(p) c_object_info(p)->set_rp
#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 */
@@ -2386,17 +2648,14 @@ static void set_print_name(s7_pointer p, const char *name, int len)
}
#if WITH_GCC
-#define make_integer(Sc, N) \
- ({ s7_int _N_; _N_ = (N); (is_small(_N_) ? small_int(_N_) : ({ s7_pointer _X_; new_cell(Sc, _X_, T_INTEGER); integer(_X_) = _N_; _X_;}) ); })
+#define make_integer(Sc, N) ({ s7_int _N_; _N_ = (N); (is_small(_N_) ? small_int(_N_) : ({ s7_pointer _X_; new_cell(Sc, _X_, T_INTEGER); integer(_X_) = _N_; _X_;}) ); })
-#define make_real(Sc, X) \
- ({ s7_double _N_ = (X); ((_N_ == 0.0) ? real_zero : ({ s7_pointer _X_; new_cell(Sc, _X_, T_REAL); set_real(_X_, _N_); _X_;}) ); })
- /* the x == 0.0 check saves more than it costs */
+#define make_real(Sc, X) ({ s7_pointer _X_; s7_double _N_ = (X); new_cell(Sc, _X_, T_REAL); set_real(_X_, _N_); _X_;})
#define make_complex(Sc, R, I) \
({ s7_double im; im = (I); ((im == 0.0) ? make_real(Sc, R) : ({ s7_pointer _X_; new_cell(Sc, _X_, T_COMPLEX); set_real_part(_X_, R); set_imag_part(_X_, im); _X_;}) ); })
-#define real_to_double(Sc, X, Caller) ({ s7_pointer _x_; _x_ = (X); ((type(_x_) == T_REAL) ? real(_x_) : s7_number_to_real_with_caller(sc, _x_, Caller)); })
+#define real_to_double(Sc, X, Caller) ({ s7_pointer _x_; _x_ = (X); ((type(_x_) == T_REAL) ? real(_x_) : s7_number_to_real_with_caller(Sc, _x_, Caller)); })
#define rational_to_double(Sc, X) ({ s7_pointer _x_; _x_ = (X); ((type(_x_) == T_INTEGER) ? (s7_double)integer(_x_) : fraction(_x_)); })
#else
@@ -2482,8 +2741,8 @@ static char *copy_string_with_length(const char *str, int len)
char *newstr;
newstr = (char *)malloc((len + 1) * sizeof(char));
if (len != 0)
- memcpy((void *)newstr, (void *)str, len + 1);
- else newstr[0] = 0;
+ memcpy((void *)newstr, (void *)str, len);
+ newstr[len] = '\0';
return(newstr);
}
@@ -2564,14 +2823,36 @@ static bool local_strncmp(const char *s1, const char *s2, unsigned int n)
}
+#define SHOW_DEBUG_HISTORY 0
+#if DEBUGGING && SHOW_DEBUG_HISTORY
+ #define DEBUG_HISTORY_SIZE 16
+ static char *debug_history[DEBUG_HISTORY_SIZE];
+ static int debug_history_loc = 0;
+ static void add_debug_history(char *str)
+ {
+ if (debug_history[debug_history_loc])
+ free(debug_history[debug_history_loc]);
+ debug_history[debug_history_loc++] = copy_string(str);
+ if (debug_history_loc >= DEBUG_HISTORY_SIZE)
+ debug_history_loc = 0;
+ }
+ static void show_debug_history(void)
+ {
+ int i;
+ for (i = debug_history_loc; i < DEBUG_HISTORY_SIZE; i++)
+ fprintf(stderr, "%s\n", debug_history[i]);
+ for (i = 0; i < debug_history_loc; i++)
+ fprintf(stderr, "%s\n", debug_history[i]);
+ fprintf(stderr, "\n");
+ }
+#endif
+
+
/* ---------------- forward decls ---------------- */
static char *number_to_string_base_10(s7_pointer obj, int width, int precision, char float_choice, int *nlen, use_write_t choice);
static bool is_proper_list(s7_scheme *sc, s7_pointer lst);
static s7_pointer iterator_finished(s7_scheme *sc, s7_pointer iterator);
-static bool is_all_x_safe(s7_scheme *sc, s7_pointer p);
-static void annotate_args(s7_scheme *sc, s7_pointer args, s7_pointer e);
-static void annotate_arg(s7_scheme *sc, s7_pointer arg, s7_pointer e);
static s7_pointer eval(s7_scheme *sc, opcode_t first_op);
static s7_pointer division_by_zero_error(s7_scheme *sc, s7_pointer caller, s7_pointer arg);
static s7_pointer file_error(s7_scheme *sc, const char *caller, const char *descr, const char *name);
@@ -2599,10 +2880,20 @@ static s7_pointer implicit_index(s7_scheme *sc, s7_pointer obj, s7_pointer indic
static bool s7_is_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y);
static void remove_gensym_from_symbol_table(s7_scheme *sc, s7_pointer sym);
static s7_pointer unbound_variable(s7_scheme *sc, s7_pointer sym);
-static s7_pointer optimize_lambda(s7_scheme *sc, bool unstarred_lambda, s7_pointer func, s7_pointer args, s7_pointer body);
-static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_pointer e);
-static s7_pointer optimize(s7_scheme *sc, s7_pointer code, int hop, s7_pointer e);
static void free_hash_table(s7_pointer table);
+void s7_show_let(s7_scheme *sc);
+static s7_pointer g_cdr(s7_scheme *sc, s7_pointer args);
+
+static bool is_all_x_safe(s7_scheme *sc, s7_pointer p);
+static void annotate_args(s7_scheme *sc, s7_pointer args, s7_pointer e);
+static void annotate_arg(s7_scheme *sc, s7_pointer arg, s7_pointer e);
+static bool float_optimize(s7_scheme *sc, s7_pointer expr);
+static bool int_optimize(s7_scheme *sc, s7_pointer expr);
+static bool bool_optimize(s7_scheme *sc, s7_pointer expr);
+static bool bool_optimize_nw(s7_scheme *sc, s7_pointer expr);
+static bool cell_optimize(s7_scheme *sc, s7_pointer expr);
+static void pc_fallback(s7_scheme *sc, int new_pc);
+
#if WITH_GMP
static s7_int big_integer_to_s7_int(mpz_t n);
@@ -2615,8 +2906,9 @@ static double next_random(s7_pointer r);
#define find_symbol_unchecked(Sc, Sym) check_null_sym(Sc, find_symbol_unchecked_1(Sc, Sym), Sym, __LINE__, __func__)
static s7_pointer check_null_sym(s7_scheme *sc, s7_pointer p, s7_pointer sym, int line, const char *func);
#define find_symbol_unexamined(Sc, Sym) find_symbol_unchecked_1(Sc, Sym)
+ static s7_pointer check_sym(s7_scheme *sc, s7_pointer sym);
#else
- static s7_pointer find_symbol_unchecked(s7_scheme *sc, s7_pointer symbol);
+ static inline s7_pointer find_symbol_unchecked(s7_scheme *sc, s7_pointer symbol);
#define find_symbol_unexamined(Sc, Sym) find_symbol_unchecked(Sc, Sym)
#endif
@@ -2645,16 +2937,16 @@ static s7_pointer simple_out_of_range_error_prepackaged(s7_scheme *sc, s7_pointe
* for gcc to speed up the functions that call these as tail-calls. 1-2% overall speedup!
*/
#define simple_wrong_type_argument(Sc, Caller, Arg, Desired_Type) \
- simple_wrong_type_arg_error_prepackaged(Sc, symbol_name_cell(Caller), Arg, sc->gc_nil, prepackaged_type_names[Desired_Type])
+ simple_wrong_type_arg_error_prepackaged(Sc, symbol_name_cell(Caller), Arg, Sc->gc_nil, prepackaged_type_names[Desired_Type])
#define wrong_type_argument(Sc, Caller, Num, Arg, Desired_Type) \
- wrong_type_arg_error_prepackaged(Sc, symbol_name_cell(Caller), make_integer(Sc, Num), Arg, sc->gc_nil, prepackaged_type_names[Desired_Type])
+ wrong_type_arg_error_prepackaged(Sc, symbol_name_cell(Caller), make_integer(Sc, Num), Arg, Sc->gc_nil, prepackaged_type_names[Desired_Type])
#define simple_wrong_type_argument_with_type(Sc, Caller, Arg, Type) \
- simple_wrong_type_arg_error_prepackaged(Sc, symbol_name_cell(Caller), Arg, sc->gc_nil, Type)
+ simple_wrong_type_arg_error_prepackaged(Sc, symbol_name_cell(Caller), Arg, Sc->gc_nil, Type)
#define wrong_type_argument_with_type(Sc, Caller, Num, Arg, Type) \
- wrong_type_arg_error_prepackaged(Sc, symbol_name_cell(Caller), make_integer(Sc, Num), Arg, sc->gc_nil, Type)
+ wrong_type_arg_error_prepackaged(Sc, symbol_name_cell(Caller), make_integer(Sc, Num), Arg, Sc->gc_nil, Type)
#define simple_out_of_range(Sc, Caller, Arg, Description) \
@@ -2670,7 +2962,7 @@ static s7_pointer car_a_list_string, cdr_a_list_string, caar_a_list_string, cadr
an_association_list_string, an_output_port_string, an_input_port_string, an_open_port_string,
a_normal_real_string, a_rational_string, a_boolean_string, a_number_string, a_let_string,
a_procedure_string, a_proper_list_string, a_thunk_string, something_applicable_string, a_symbol_string,
- a_non_negative_integer_string, a_format_port_string, an_unsigned_byte_string, a_binding_string,
+ a_non_negative_integer_string, a_format_port_string, an_unsigned_byte_string, value_is_missing_string,
a_non_constant_symbol_string, an_eq_func_string, a_sequence_string, its_too_small_string,
a_normal_procedure_string, its_too_large_string, its_negative_string, result_is_too_large_string,
its_nan_string, its_infinite_string, too_many_indices_string, a_valid_radix_string, an_input_string_port_string,
@@ -2683,19 +2975,22 @@ static s7_pointer no_complex_numbers_string;
/* ---------------- evaluator ops ---------------- */
-enum {OP_NO_OP,
+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_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, OP_COND, OP_COND1, OP_COND1_1, OP_COND_SIMPLE, OP_COND1_SIMPLE,
+ OP_LETREC, OP_LETREC1, OP_LETREC_STAR, OP_LETREC_STAR1,
+ OP_LET_TEMPORARILY, OP_LET_TEMP_UNCHECKED, OP_LET_TEMP_INIT1, OP_LET_TEMP_INIT2, OP_LET_TEMP_DONE, OP_LET_TEMP_DONE1,
+ OP_COND, OP_COND1, OP_COND1_1, OP_COND_SIMPLE, OP_COND1_SIMPLE, OP_COND_UNCHECKED_Z,
OP_AND, OP_AND1, OP_OR, OP_OR1,
OP_DEFINE_MACRO, OP_DEFINE_MACRO_STAR, OP_DEFINE_EXPANSION,
- OP_CASE, OP_CASE1, OP_READ_LIST, OP_READ_NEXT, OP_READ_DOT, OP_READ_QUOTE,
+ OP_CASE,
+ OP_READ_LIST, OP_READ_NEXT, OP_READ_DOT, OP_READ_QUOTE,
OP_READ_QUASIQUOTE, OP_READ_UNQUOTE, OP_READ_APPLY_VALUES,
- OP_READ_VECTOR, OP_READ_BYTE_VECTOR, OP_READ_DONE,
+ OP_READ_VECTOR, OP_READ_BYTE_VECTOR, OP_READ_INT_VECTOR, OP_READ_FLOAT_VECTOR, OP_READ_DONE,
OP_LOAD_RETURN_IF_EOF, OP_LOAD_CLOSE_AND_POP_IF_EOF, OP_EVAL_DONE,
OP_CATCH, OP_DYNAMIC_WIND, OP_DEFINE_CONSTANT, OP_DEFINE_CONSTANT1,
OP_DO, OP_DO_END, OP_DO_END1, OP_DO_STEP, OP_DO_STEP2, OP_DO_INIT,
@@ -2714,9 +3009,9 @@ enum {OP_NO_OP,
OP_QUOTE_UNCHECKED, OP_LAMBDA_UNCHECKED, OP_LET_UNCHECKED, OP_CASE_UNCHECKED, OP_WHEN_UNCHECKED, OP_UNLESS_UNCHECKED,
- OP_SET_UNCHECKED, OP_SET_SYMBOL_C, OP_SET_SYMBOL_S, OP_SET_SYMBOL_Q, OP_SET_SYMBOL_P, OP_SET_SYMBOL_Z, OP_SET_SYMBOL_A,
+ OP_SET_UNCHECKED, OP_SET_SYMBOL_C, OP_SET_SYMBOL_L, OP_SET_SYMBOL_S, OP_SET_SYMBOL_Q, OP_SET_SYMBOL_P, OP_SET_SYMBOL_Z, OP_SET_SYMBOL_A,
OP_SET_SYMBOL_opSq, OP_SET_SYMBOL_opCq, OP_SET_SYMBOL_opSSq, OP_SET_SYMBOL_opSSSq,
- OP_SET_NORMAL, OP_SET_PAIR, OP_SET_PAIR_Z, OP_SET_PAIR_A, OP_SET_PAIR_P, OP_SET_PAIR_ZA,
+ OP_SET_NORMAL, OP_SET_PAIR, OP_SET_DILAMBDA, OP_SET_DILAMBDA_Z, OP_SET_DILAMBDA_Z_1, OP_SET_PAIR_Z, OP_SET_PAIR_A, OP_SET_PAIR_P, OP_SET_PAIR_ZA,
OP_SET_PAIR_P_1, OP_SET_WITH_ACCESSOR, OP_SET_PWS, OP_SET_LET_S, OP_SET_LET_ALL_X,
OP_SET_PAIR_C, OP_SET_PAIR_C_P, OP_SET_PAIR_C_P_1, OP_SET_SAFE,
OP_INCREMENT_1, OP_DECREMENT_1, OP_SET_CONS,
@@ -2727,36 +3022,61 @@ enum {OP_NO_OP,
OP_DEFINE_WITH_ACCESSOR, OP_DEFINE_MACRO_WITH_ACCESSOR,
OP_LET_NO_VARS, OP_NAMED_LET, OP_NAMED_LET_NO_VARS, OP_NAMED_LET_STAR,
- OP_LET_C, OP_LET_S, OP_LET_ALL_C, OP_LET_ALL_S, OP_LET_ALL_X,
- OP_LET_STAR_ALL_X, OP_LET_opCq, OP_LET_opSSq,
- OP_LET_opSq, OP_LET_ALL_opSq, OP_LET_opSq_P, OP_LET_ONE, OP_LET_ONE_1, OP_LET_Z, OP_LET_Z_1,
-
- OP_CASE_SIMPLE, OP_CASE_SIMPLER, OP_CASE_SIMPLER_1, OP_CASE_SIMPLER_SS, OP_CASE_SIMPLEST, OP_CASE_SIMPLEST_SS, OP_CASE_ELSE, OP_CASE_ELSE_1,
- OP_IF_UNCHECKED, OP_AND_UNCHECKED, OP_AND_P, OP_AND_P1, OP_AND_P2, OP_OR_UNCHECKED, OP_OR_P, OP_OR_P1, OP_OR_P2,
- OP_IF_P_FEED, OP_IF_P_FEED_1, OP_WHEN_S, OP_UNLESS_S,
-
- OP_IF_S_P, OP_IF_S_P_P, OP_IF_NOT_S_P, OP_IF_NOT_S_P_P, OP_IF_CC_P, OP_IF_CC_P_P,
- OP_IF_CS_P, OP_IF_CS_P_P, OP_IF_CSQ_P, OP_IF_CSQ_P_P, OP_IF_CSS_P, OP_IF_CSS_P_P,
- OP_IF_CSC_P, OP_IF_CSC_P_P, OP_IF_IS_PAIR_P, OP_IF_IS_PAIR_P_P, OP_IF_opSSq_P, OP_IF_opSSq_P_P, OP_IF_S_opCq_P, OP_IF_S_opCq_P_P,
- OP_IF_IS_SYMBOL_P, OP_IF_IS_SYMBOL_P_P, OP_IF_A_P, OP_IF_A_P_P, OP_IF_AND2_P, OP_IF_AND2_P_P,
- OP_IF_Z_P, OP_IF_Z_P_P, OP_IF_P_P_P, OP_IF_P_P, OP_IF_ANDP_P, OP_IF_ANDP_P_P, OP_IF_ORP_P, OP_IF_ORP_P_P,
- OP_IF_PPP, OP_IF_PP,
-
- OP_CATCH_1, OP_CATCH_2, OP_CATCH_ALL, OP_COND_ALL_X, OP_COND_ALL_X_2, OP_COND_S,
- 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_DOTIMES_STEP_A,
- OP_SAFE_DO, OP_SAFE_DO_STEP, OP_SIMPLE_DO_P, OP_SIMPLE_DO_STEP_P, OP_DOX, OP_DOX_STEP, OP_DOX_STEP_P,
- OP_DOTIMES_P, OP_DOTIMES_STEP_P, OP_SIMPLE_DO_A, OP_SIMPLE_DO_STEP_A, OP_SIMPLE_DO_E, OP_SIMPLE_DO_STEP_E,
+ OP_LET_C, OP_LET_S, OP_LET_S_Z, OP_LET_ALL_C, OP_LET_ALL_S, OP_LET_ALL_X,
+ OP_LET_STAR_ALL_X, OP_LET_opCq, OP_LET_opSSq, OP_LET_opSSq_E, OP_LET_opaSSq_E,
+ OP_LET_opSq, OP_LET_ALL_opSq, OP_LET_opSq_P, OP_LET_CAR, OP_LET_ONE, OP_LET_ONE_1, OP_LET_Z, OP_LET_Z_1, OP_LET_A, OP_LET_A_Z,
+
+ OP_CASE_A_E_S, OP_CASE_A_I_S, OP_CASE_A_G_S, OP_CASE_A_E_G, OP_CASE_A_G_G,
+ OP_CASE_S_E_S, OP_CASE_S_I_S, OP_CASE_S_G_S, OP_CASE_S_E_G, OP_CASE_S_G_G,
+ OP_CASE_P_E_S, OP_CASE_P_I_S, OP_CASE_P_G_S, OP_CASE_P_E_G, OP_CASE_P_G_G,
+ OP_CASE_E_S, OP_CASE_I_S, OP_CASE_G_S, OP_CASE_E_G, OP_CASE_G_G,
+
+ OP_IF_UNCHECKED, OP_AND_UNCHECKED, OP_AND_P, OP_AND_P1, OP_AND_AP, OP_AND_AZ, OP_AND_SAFE_P, OP_AND_SAFE_AA,
+ OP_OR_UNCHECKED, OP_OR_P, OP_OR_P1, OP_OR_AP, OP_OR_AZ, OP_OR_SAFE_P, OP_OR_SAFE_AA,
+ OP_COND_FEED, OP_COND_FEED_1, OP_WHEN_S, OP_WHEN_A, OP_WHEN_P, OP_UNLESS_S, OP_UNLESS_A,
+
+ OP_IF_S_P, OP_IF_S_P_P, OP_IF_S_R, OP_IF_S_N, OP_IF_S_N_N,
+ OP_IF_C_P, OP_IF_C_P_P, OP_IF_C_R, OP_IF_C_N, OP_IF_C_N_N,
+ OP_IF_CS_P, OP_IF_CS_P_P, OP_IF_CS_R, OP_IF_CS_N, OP_IF_CS_N_N,
+ 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_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_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,
+ OP_IF_ORP_P, OP_IF_ORP_P_P, OP_IF_ORP_R, OP_IF_ORP_N, OP_IF_ORP_N_N,
+ OP_IF_OR2_P, OP_IF_OR2_P_P, OP_IF_OR2_R, OP_IF_OR2_N, OP_IF_OR2_N_N,
+
+ OP_IF_PPP, OP_IF_PP, OP_IF_PR, OP_IF_PRR,
+ OP_WHEN_PP,
+
+ OP_CATCH_1, OP_CATCH_2, OP_CATCH_ALL, OP_COND_ALL_X, OP_COND_ALL_X_2, OP_COND_ALL_X_Z,
+ 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_EVAL_ARGS_SSP_1, OP_EVAL_ARGS_SSP_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_SP_1, OP_C_SP_2,
- OP_CLOSURE_P_1, OP_CLOSURE_P_2, OP_SAFE_CLOSURE_P_1,
+ 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_CLOSURE_AP_1, OP_CLOSURE_PA_1,
+ OP_CLOSURE_P_MV, OP_CLOSURE_AP_MV, OP_CLOSURE_PA_MV,
OP_SET_WITH_LET_1, OP_SET_WITH_LET_2,
OP_MAX_DEFINED_1};
@@ -2765,20 +3085,25 @@ enum {OP_NO_OP,
typedef enum{E_C_P, E_C_PP, E_C_CP, E_C_SP, E_C_PC, E_C_PS} combine_op_t;
-enum {OP_SAFE_C_C, HOP_SAFE_C_C, OP_SAFE_C_S, HOP_SAFE_C_S,
+enum {OP_SAFE_C_C, HOP_SAFE_C_C,
+ OP_SAFE_C_AND2, HOP_SAFE_C_AND2, OP_SAFE_C_OR2, HOP_SAFE_C_OR2,
+ OP_SAFE_C_S, HOP_SAFE_C_S, OP_SAFE_C_L, HOP_SAFE_C_L,
+ OP_SAFE_CAR_S, HOP_SAFE_CAR_S, OP_SAFE_CDR_S, HOP_SAFE_CDR_S, OP_SAFE_CADR_S, HOP_SAFE_CADR_S,
+ OP_SAFE_IS_PAIR_S, HOP_SAFE_IS_PAIR_S, OP_SAFE_IS_NULL_S, HOP_SAFE_IS_NULL_S, OP_SAFE_IS_SYMBOL_S, HOP_SAFE_IS_SYMBOL_S, /* order matters here */
OP_SAFE_C_SS, HOP_SAFE_C_SS, OP_SAFE_C_SC, HOP_SAFE_C_SC, OP_SAFE_C_CS, HOP_SAFE_C_CS,
- OP_SAFE_C_Q, HOP_SAFE_C_Q, OP_SAFE_C_SQ, HOP_SAFE_C_SQ, OP_SAFE_C_QS, HOP_SAFE_C_QS, OP_SAFE_C_QQ, HOP_SAFE_C_QQ,
+ OP_SAFE_C_SQ, HOP_SAFE_C_SQ, OP_SAFE_C_QS, HOP_SAFE_C_QS, OP_SAFE_C_QQ, HOP_SAFE_C_QQ,
OP_SAFE_C_CQ, HOP_SAFE_C_CQ, OP_SAFE_C_QC, HOP_SAFE_C_QC,
OP_SAFE_C_SSS, HOP_SAFE_C_SSS, OP_SAFE_C_SCS, HOP_SAFE_C_SCS, OP_SAFE_C_SSC, HOP_SAFE_C_SSC, OP_SAFE_C_CSS, HOP_SAFE_C_CSS,
OP_SAFE_C_SCC, HOP_SAFE_C_SCC, OP_SAFE_C_CSC, HOP_SAFE_C_CSC,
OP_SAFE_C_ALL_S, HOP_SAFE_C_ALL_S, OP_SAFE_C_ALL_X, HOP_SAFE_C_ALL_X, OP_SAFE_C_SSA, HOP_SAFE_C_SSA, OP_SAFE_C_SAS, HOP_SAFE_C_SAS,
- OP_SAFE_C_CSA, HOP_SAFE_C_CSA, OP_SAFE_C_SCA, HOP_SAFE_C_SCA, OP_SAFE_C_CAS, HOP_SAFE_C_CAS,
+ OP_SAFE_C_CSA, HOP_SAFE_C_CSA, OP_SAFE_C_SCA, HOP_SAFE_C_SCA,
OP_SAFE_C_A, HOP_SAFE_C_A, OP_SAFE_C_AA, HOP_SAFE_C_AA, OP_SAFE_C_AAA, HOP_SAFE_C_AAA, OP_SAFE_C_AAAA, HOP_SAFE_C_AAAA,
OP_SAFE_C_SQS, HOP_SAFE_C_SQS, OP_SAFE_C_opAq, HOP_SAFE_C_opAq, OP_SAFE_C_opAAq, HOP_SAFE_C_opAAq, OP_SAFE_C_opAAAq, HOP_SAFE_C_opAAAq,
OP_SAFE_C_S_opAq, HOP_SAFE_C_S_opAq, OP_SAFE_C_S_opAAq, HOP_SAFE_C_S_opAAq, OP_SAFE_C_S_opAAAq, HOP_SAFE_C_S_opAAAq,
OP_SAFE_C_opCq, HOP_SAFE_C_opCq, OP_SAFE_C_opSq, HOP_SAFE_C_opSq,
- OP_SAFE_C_opSSq, HOP_SAFE_C_opSSq, OP_SAFE_C_opSCq, HOP_SAFE_C_opSCq, OP_SAFE_C_opSQq, HOP_SAFE_C_opSQq,
+ OP_SAFE_C_opCq_opSq, HOP_SAFE_C_opCq_opSq, OP_SAFE_C_opSq_opCq, HOP_SAFE_C_opSq_opCq,
+ OP_SAFE_C_opSSq, HOP_SAFE_C_opSSq, OP_SAFE_C_opSCq, HOP_SAFE_C_opSCq, OP_SAFE_C_opSQq, HOP_SAFE_C_opSQq, OP_SAFE_C_opQSq, HOP_SAFE_C_opQSq,
OP_SAFE_C_opCSq, HOP_SAFE_C_opCSq, OP_SAFE_C_S_opSq, HOP_SAFE_C_S_opSq,
OP_SAFE_C_C_opSCq, HOP_SAFE_C_C_opSCq,
OP_SAFE_C_S_opSCq, HOP_SAFE_C_S_opSCq, OP_SAFE_C_S_opCSq, HOP_SAFE_C_S_opCSq,
@@ -2792,16 +3117,19 @@ enum {OP_SAFE_C_C, HOP_SAFE_C_C, OP_SAFE_C_S, HOP_SAFE_C_S,
OP_SAFE_C_opSSq_opCq, HOP_SAFE_C_opSSq_opCq, OP_SAFE_C_opSSq_opSq, HOP_SAFE_C_opSSq_opSq, OP_SAFE_C_opSq_opSSq, HOP_SAFE_C_opSq_opSSq,
OP_SAFE_C_opSSq_S, HOP_SAFE_C_opSSq_S, OP_SAFE_C_opSCq_S, HOP_SAFE_C_opSCq_S, OP_SAFE_C_opCSq_S, HOP_SAFE_C_opCSq_S,
OP_SAFE_C_opSCq_C, HOP_SAFE_C_opSCq_C, OP_SAFE_C_opCq_opSSq, HOP_SAFE_C_opCq_opSSq,
- OP_SAFE_C_S_op_opSSq_Sq, HOP_SAFE_C_S_op_opSSq_Sq, OP_SAFE_C_S_op_S_opSSqq, HOP_SAFE_C_S_op_S_opSSqq,
+ OP_SAFE_C_S_op_opSSq_Sq, HOP_SAFE_C_S_op_opSSq_Sq, OP_SAFE_C_S_op_S_opSSqq, HOP_SAFE_C_S_op_S_opSSqq, OP_SAFE_C_S_op_S_opSqq, HOP_SAFE_C_S_op_S_opSqq,
OP_SAFE_C_op_opSSq_q_C, HOP_SAFE_C_op_opSSq_q_C, OP_SAFE_C_op_opSq_q_C, HOP_SAFE_C_op_opSq_q_C,
OP_SAFE_C_op_opSSq_q_S, HOP_SAFE_C_op_opSSq_q_S, OP_SAFE_C_op_opSq_q_S, HOP_SAFE_C_op_opSq_q_S,
OP_SAFE_C_S_op_opSSq_opSSqq, HOP_SAFE_C_S_op_opSSq_opSSqq,
- OP_SAFE_C_op_opSq_q, HOP_SAFE_C_op_opSq_q, OP_SAFE_C_C_op_S_opCqq, HOP_SAFE_C_C_op_S_opCqq,
- OP_SAFE_C_op_S_opSq_q, HOP_SAFE_C_op_S_opSq_q,
- OP_SAFE_C_opSq_Q, HOP_SAFE_C_opSq_Q, OP_SAFE_C_opSq_Q_S, HOP_SAFE_C_opSq_Q_S,
+ OP_SAFE_C_op_opSq_q, HOP_SAFE_C_op_opSq_q,
+ OP_SAFE_C_C_op_S_opCqq, HOP_SAFE_C_C_op_S_opCqq,
+ OP_SAFE_C_op_S_opSq_q, HOP_SAFE_C_op_S_opSq_q, OP_SAFE_C_op_opSq_S_q, HOP_SAFE_C_op_opSq_S_q,
+ OP_SAFE_C_opSq_Q, HOP_SAFE_C_opSq_Q, OP_SAFE_C_opSq_QS, HOP_SAFE_C_opSq_QS,
+
+ OP_SAFE_IFA_SS_A, HOP_SAFE_IFA_SS_A, OP_SAFE_C_P, HOP_SAFE_C_P,
OP_SAFE_C_Z, HOP_SAFE_C_Z, OP_SAFE_C_ZZ, HOP_SAFE_C_ZZ, OP_SAFE_C_SZ, HOP_SAFE_C_SZ, OP_SAFE_C_ZS, HOP_SAFE_C_ZS,
- OP_SAFE_C_CZ, HOP_SAFE_C_CZ, OP_SAFE_C_ZC, HOP_SAFE_C_ZC,
+ 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,
@@ -2809,45 +3137,48 @@ enum {OP_SAFE_C_C, HOP_SAFE_C_C, OP_SAFE_C_S, HOP_SAFE_C_S,
OP_SAFE_C_ZZZ, HOP_SAFE_C_ZZZ,
OP_THUNK, HOP_THUNK,
- OP_CLOSURE_S, HOP_CLOSURE_S, OP_CLOSURE_C, HOP_CLOSURE_C, OP_CLOSURE_Q, HOP_CLOSURE_Q,
- OP_CLOSURE_SS, HOP_CLOSURE_SS, OP_CLOSURE_SC, HOP_CLOSURE_SC, OP_CLOSURE_CS, HOP_CLOSURE_CS,
- OP_CLOSURE_A, HOP_CLOSURE_A, OP_CLOSURE_AA, HOP_CLOSURE_AA,
- OP_CLOSURE_ALL_X, HOP_CLOSURE_ALL_X, OP_CLOSURE_ALL_S, HOP_CLOSURE_ALL_S,
-
- OP_GLOSURE_A, HOP_GLOSURE_A, OP_GLOSURE_S, HOP_GLOSURE_S, OP_GLOSURE_P, HOP_GLOSURE_P,
-
- OP_CLOSURE_STAR_S, HOP_CLOSURE_STAR_S, OP_CLOSURE_STAR_SX, HOP_CLOSURE_STAR_SX,
- OP_CLOSURE_STAR, HOP_CLOSURE_STAR, OP_CLOSURE_STAR_ALL_X, HOP_CLOSURE_STAR_ALL_X,
-
- OP_SAFE_THUNK, HOP_SAFE_THUNK, OP_SAFE_THUNK_E, HOP_SAFE_THUNK_E, OP_SAFE_THUNK_P, HOP_SAFE_THUNK_P,
- OP_SAFE_CLOSURE_S, HOP_SAFE_CLOSURE_S, OP_SAFE_CLOSURE_C, HOP_SAFE_CLOSURE_C, OP_SAFE_CLOSURE_Q, HOP_SAFE_CLOSURE_Q,
+ OP_CLOSURE_S, HOP_CLOSURE_S, OP_CLOSURE_C, HOP_CLOSURE_C, OP_CLOSURE_P, HOP_CLOSURE_P,
+ OP_CLOSURE_SS, HOP_CLOSURE_SS, OP_CLOSURE_SS_P, HOP_CLOSURE_SS_P,
+ OP_CLOSURE_SC, HOP_CLOSURE_SC, OP_CLOSURE_CS, HOP_CLOSURE_CS,
+ OP_CLOSURE_A, HOP_CLOSURE_A, OP_CLOSURE_AA, HOP_CLOSURE_AA, OP_CLOSURE_A_P, HOP_CLOSURE_A_P,
+ OP_CLOSURE_ALL_X, HOP_CLOSURE_ALL_X, OP_CLOSURE_ALL_S, HOP_CLOSURE_ALL_S, OP_CLOSURE_ALL_S_P, HOP_CLOSURE_ALL_S_P,
+ OP_CLOSURE_FA, HOP_CLOSURE_FA,
+ OP_CLOSURE_AP, HOP_CLOSURE_AP, OP_CLOSURE_PA, HOP_CLOSURE_PA,
+
+ OP_CLOSURE_STAR_A, HOP_CLOSURE_STAR_A, OP_CLOSURE_STAR_AA, HOP_CLOSURE_STAR_AA, OP_CLOSURE_STAR_ALL_X, HOP_CLOSURE_STAR_ALL_X,
+
+ OP_SAFE_THUNK, HOP_SAFE_THUNK,
+ OP_SAFE_THUNK_E, HOP_SAFE_THUNK_E,
+ OP_SAFE_THUNK_P, HOP_SAFE_THUNK_P, OP_SAFE_LTHUNK_P, HOP_SAFE_LTHUNK_P,
+
+ OP_SAFE_CLOSURE_S, HOP_SAFE_CLOSURE_S, OP_SAFE_LCLOSURE_L, HOP_SAFE_LCLOSURE_L,
+ 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_A, HOP_SAFE_CLOSURE_A, OP_SAFE_CLOSURE_SA, HOP_SAFE_CLOSURE_SA, OP_SAFE_CLOSURE_S_P, HOP_SAFE_CLOSURE_S_P,
- OP_SAFE_CLOSURE_SAA, HOP_SAFE_CLOSURE_SAA,
+ OP_SAFE_CLOSURE_A, HOP_SAFE_CLOSURE_A, OP_SAFE_LCLOSURE_A, HOP_SAFE_LCLOSURE_A,
+ 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,
+ OP_SAFE_CLOSURE_SAA, HOP_SAFE_CLOSURE_SAA, OP_SAFE_CLOSURE_S_C, HOP_SAFE_CLOSURE_S_C,
+ OP_SAFE_CLOSURE_A_C, HOP_SAFE_CLOSURE_A_C,
OP_SAFE_CLOSURE_ALL_X, HOP_SAFE_CLOSURE_ALL_X, OP_SAFE_CLOSURE_AA, HOP_SAFE_CLOSURE_AA,
+ OP_SAFE_CLOSURE_AP, HOP_SAFE_CLOSURE_AP, OP_SAFE_CLOSURE_PA, HOP_SAFE_CLOSURE_PA,
- OP_SAFE_GLOSURE_A, HOP_SAFE_GLOSURE_A, OP_SAFE_GLOSURE_S, HOP_SAFE_GLOSURE_S, OP_SAFE_GLOSURE_S_E, HOP_SAFE_GLOSURE_S_E,
- OP_SAFE_GLOSURE_P, HOP_SAFE_GLOSURE_P,
-
- OP_SAFE_CLOSURE_STAR_S, HOP_SAFE_CLOSURE_STAR_S, OP_SAFE_CLOSURE_STAR_SS, HOP_SAFE_CLOSURE_STAR_SS,
- OP_SAFE_CLOSURE_STAR_SC, HOP_SAFE_CLOSURE_STAR_SC, OP_SAFE_CLOSURE_STAR_SA, HOP_SAFE_CLOSURE_STAR_SA, OP_SAFE_CLOSURE_STAR_S0, HOP_SAFE_CLOSURE_STAR_S0,
- OP_SAFE_CLOSURE_STAR, HOP_SAFE_CLOSURE_STAR, OP_SAFE_CLOSURE_STAR_ALL_X, HOP_SAFE_CLOSURE_STAR_ALL_X,
+ OP_SAFE_CLOSURE_STAR_A, HOP_SAFE_CLOSURE_STAR_A, OP_SAFE_CLOSURE_STAR_AA, HOP_SAFE_CLOSURE_STAR_AA,
+ OP_SAFE_CLOSURE_STAR_S0, HOP_SAFE_CLOSURE_STAR_S0, OP_SAFE_CLOSURE_STAR_ALL_X, HOP_SAFE_CLOSURE_STAR_ALL_X,
/* these can't be embedded, and have to be the last thing called */
- OP_APPLY_SS, HOP_APPLY_SS,
- OP_C_ALL_X, HOP_C_ALL_X, OP_CALL_WITH_EXIT, HOP_CALL_WITH_EXIT, OP_C_CATCH, HOP_C_CATCH, OP_C_CATCH_ALL, HOP_C_CATCH_ALL,
+ OP_APPLY_SS, HOP_APPLY_SS,
+ OP_C_ALL_X, HOP_C_ALL_X, OP_CALL_WITH_EXIT, HOP_CALL_WITH_EXIT,
+ OP_C_CATCH, HOP_C_CATCH, OP_C_CATCH_ALL, HOP_C_CATCH_ALL, OP_C_CATCH_ALL_Z, HOP_C_CATCH_ALL_Z,
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_SP, HOP_C_SP,
- OP_C_SZ, HOP_C_SZ, OP_C_A, HOP_C_A, OP_C_SCS, HOP_C_SCS,
+ 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_GOTO, HOP_GOTO, OP_GOTO_C, HOP_GOTO_C, OP_GOTO_S, HOP_GOTO_S, OP_GOTO_A, HOP_GOTO_A,
-
- OP_VECTOR_C, HOP_VECTOR_C, OP_VECTOR_S, HOP_VECTOR_S, OP_VECTOR_A, HOP_VECTOR_A, OP_VECTOR_CC, HOP_VECTOR_CC,
- OP_STRING_C, HOP_STRING_C, OP_STRING_S, HOP_STRING_S, OP_STRING_A, HOP_STRING_A,
- OP_C_OBJECT, HOP_C_OBJECT, OP_C_OBJECT_C, HOP_C_OBJECT_C, OP_C_OBJECT_S, HOP_C_OBJECT_S, OP_C_OBJECT_A, HOP_C_OBJECT_A,
- OP_PAIR_C, HOP_PAIR_C, OP_PAIR_S, HOP_PAIR_S, OP_PAIR_A, HOP_PAIR_A,
- OP_HASH_TABLE_C, HOP_HASH_TABLE_C, OP_HASH_TABLE_S, HOP_HASH_TABLE_S, OP_HASH_TABLE_A, HOP_HASH_TABLE_A,
- OP_ENVIRONMENT_S, HOP_ENVIRONMENT_S, OP_ENVIRONMENT_Q, HOP_ENVIRONMENT_Q, OP_ENVIRONMENT_A, HOP_ENVIRONMENT_A, OP_ENVIRONMENT_C, HOP_ENVIRONMENT_C,
+ OP_ITERATE, HOP_ITERATE,
+ OP_VECTOR_A, HOP_VECTOR_A, OP_STRING_A, HOP_STRING_A,
+ OP_C_OBJECT_A, HOP_C_OBJECT_A, OP_PAIR_A, HOP_PAIR_A, OP_HASH_TABLE_A, HOP_HASH_TABLE_A,
+ OP_ENVIRONMENT_Q, HOP_ENVIRONMENT_Q, OP_ENVIRONMENT_A, HOP_ENVIRONMENT_A,
OP_UNKNOWN, HOP_UNKNOWN, OP_UNKNOWN_ALL_S, HOP_UNKNOWN_ALL_S, OP_UNKNOWN_ALL_X, HOP_UNKNOWN_ALL_X,
OP_UNKNOWN_G, HOP_UNKNOWN_G, OP_UNKNOWN_GG, HOP_UNKNOWN_GG, OP_UNKNOWN_A, HOP_UNKNOWN_A, OP_UNKNOWN_AA, HOP_UNKNOWN_AA,
@@ -2863,19 +3194,21 @@ enum {OP_SAFE_C_C, HOP_SAFE_C_C, OP_SAFE_C_S, HOP_SAFE_C_S,
#if DEBUGGING || OP_NAMES
static const char *op_names[OP_MAX_DEFINED_1] = {
- "no_op",
+ "no_op", "gc_protect",
"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",
"if", "if1", "when", "when1", "unless", "unless1", "set", "set1", "set2",
"let", "let1", "let_star", "let_star1", "let_star2",
- "letrec", "letrec1", "letrec_star", "letrec_star1", "cond", "cond1", "cond1_1", "cond_simple", "cond1_simple",
+ "letrec", "letrec1", "letrec_star", "letrec_star1",
+ "let_temporarily", "let_temp_unchecked", "let_temp_init1", "let_temp_init2", "let_temp_done", "let_temp_done1",
+ "cond", "cond1", "cond1_1", "cond_simple", "cond1_simple", "cond_unchecked_z",
"and", "and1", "or", "or1",
"define_macro", "define_macro_star", "define_expansion",
- "case", "case1", "read_list", "read_next", "read_dot", "read_quote",
+ "case", "read_list", "read_next", "read_dot", "read_quote",
"read_quasiquote", "read_unquote", "read_apply_values",
- "read_vector", "read_byte_vector", "read_done",
+ "read_vector", "read_byte_vector", "read_int_vector", "read_float_vector", "read_done",
"load_return_if_eof", "load_close_and_pop_if_eof", "eval_done",
"catch", "dynamic_wind", "define_constant", "define_constant1",
"do", "do_end", "do_end1", "do_step", "do_step2", "do_init",
@@ -2894,9 +3227,10 @@ static const char *op_names[OP_MAX_DEFINED_1] = {
"quote_unchecked", "lambda_unchecked", "let_unchecked", "case_unchecked", "when_unchecked", "unless_unchecked",
- "set_unchecked", "set_symbol_c", "set_symbol_s", "set_symbol_q", "set_symbol_p", "set_symbol_z", "set_symbol_a",
+ "set_unchecked", "set_symbol_c", "set_symbol_l", "set_symbol_s", "set_symbol_q", "set_symbol_p", "set_symbol_z", "set_symbol_a",
"set_symbol_opsq", "set_symbol_opcq", "set_symbol_opssq", "set_symbol_opsssq",
- "set_normal", "set_pair", "set_pair_z", "set_pair_a", "set_pair_p", "set_pair_za",
+ "set_normal", "set_pair", "set_dilambda", "set_dilambda_z", "set_dilambda_z_1",
+ "set_pair_z", "set_pair_a", "set_pair_p", "set_pair_za",
"set_pair_p_1", "set_with_accessor", "set_pws", "set_let_s", "set_let_all_x",
"set_pair_c", "set_pair_c_p", "set_pair_c_p_1", "set_safe",
"increment_1", "decrement_1", "set_cons",
@@ -2907,56 +3241,86 @@ static const char *op_names[OP_MAX_DEFINED_1] = {
"define_with_accessor", "define_macro_with_accessor",
"let_no_vars", "named_let", "named_let_no_vars", "named_let_star",
- "let_c", "let_s", "let_all_c", "let_all_s", "let_all_x",
- "let_star_all_x", "let_opcq", "let_opssq",
- "let_opsq", "let_all_opsq", "let_opsq_p", "let_one", "let_one_1", "let_z", "let_z_1",
-
- "case_simple", "case_simpler", "case_simpler_1", "case_simpler_ss", "case_simplest", "case_simplest_ss", "case_else", "case_else_1",
- "if_unchecked", "and_unchecked", "and_p", "and_p1", "and_p2", "or_unchecked", "or_p", "or_p1", "or_p2",
- "if_p_feed", "if_p_feed_1", "when_s", "unless_s",
-
- "if_s_p", "if_s_p_p", "if_not_s_p", "if_not_s_p_p", "if_cc_p", "if_cc_p_p",
- "if_cs_p", "if_cs_p_p", "if_csq_p", "if_csq_p_p", "if_css_p", "if_css_p_p",
- "if_csc_p", "if_csc_p_p", "if_is_pair_p", "if_is_pair_p_p", "if_opssq_p", "if_opssq_p_p", "if_s_opcq_p", "if_s_opcq_p_p",
- "if_is_symbol_p", "if_is_symbol_p_p", "if_a_p", "if_a_p_p", "if_and2_p", "if_and2_p_p",
- "if_z_p", "if_z_p_p", "if_p_p_p", "if_p_p", "if_andp_p", "if_andp_p_p", "if_orp_p", "if_orp_p_p",
- "if_ppp", "if_pp",
-
- "catch_1", "catch_2", "catch_all", "cond_all_x", "cond_all_x_2", "cond_s",
- "simple_do", "simple_do_step", "safe_dotimes", "safe_dotimes_step", "safe_dotimes_step_p", "safe_dotimes_step_o", "safe_dotimes_step_a",
- "safe_do", "safe_do_step", "simple_do_p", "simple_do_step_p", "dox", "dox_step", "dox_step_p",
- "dotimes_p", "dotimes_step_p", "simple_do_a", "simple_do_step_a", "simple_do_e", "simple_do_step_e",
+ "let_c", "let_s", "let_s_z", "let_all_c", "let_all_s", "let_all_x",
+ "let_star_all_x", "let_opcq", "let_opssq", "let_opssq_e", "let_opassq_e",
+ "let_opsq", "let_all_opsq", "let_opsq_p", "let_car", "let_one", "let_one_1", "let_z", "let_z_1", "let_a", "let_a_z",
+
+ "case_a_e_s", "case_a_i_s", "case_a_g_s", "case_a_e_g", "case_a_g_g",
+ "case_s_e_s", "case_s_i_s", "case_s_g_s", "case_s_e_g", "case_s_g_g",
+ "case_p_e_s", "case_p_i_s", "case_p_g_s", "case_p_e_g", "case_p_g_g",
+ "case_e_s", "case_i_s", "case_g_s", "case_e_g", "case_g_g",
+
+ "if_unchecked", "and_unchecked", "and_p", "and_p1", "and_ap", "and_az", "and_safe_p", "and_safe_aa",
+ "or_unchecked", "or_p", "or_p1", "or_ap", "or_az", "or_safe_p", "or_safe_aa",
+ "cond_feed", "cond_feed_1", "when_s", "when_a", "when_p", "unless_s", "unless_a",
+
+ "if_s_p", "if_s_p_p", "if_s_r", "if_s_n", "if_s_n_n",
+ "if_c_p", "if_c_p_p", "if_c_r", "if_c_n", "if_c_n_n",
+ "if_cs_p", "if_cs_p_p", "if_cs_r", "if_cs_n", "if_cs_n_n",
+ "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_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_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",
+ "if_orp_p", "if_orp_p_p", "if_orp_r","if_orp_n", "if_orp_n_n",
+ "if_or2_p", "if_or2_p_p", "if_or2_r","if_or2_n", "if_or2_n_n",
+
+ "if_ppp", "if_pp", "if_pr", "if_prr",
+ "when_pp",
+
+ "catch_1", "catch_2", "catch_all", "cond_all_x", "cond_all_x_2", "cond_all_x_z",
+ "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",
+ "eval_args_ssp_1", "eval_args_ssp_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_sp_1", "c_sp_2",
- "closure_p_1", "closure_p_2", "safe_closure_p_1",
+ "safe_c_opsq_p_1", "safe_c_opsq_p_mv", "c_p_1", "c_p_2", "c_ap_1", "c_ap_2", "not_1",
+ "closure_ap_1", "closure_pa_1",
+ "closure_p_mv", "closure_ap_mv", "closure_pa_mv",
- "set-with-let-1", "set-with-let-2",
+ "set_with_let_1", "set_with_let_2",
};
static const char* opt_names[OPT_MAX_DEFINED] =
- {"safe_c_c", "h_safe_c_c", "safe_c_s", "h_safe_c_s",
+ {"safe_c_c", "h_safe_c_c",
+ "safe_c_and2", "h_safe_c_and2", "safe_c_or2", "h_safe_c_or2",
+ "safe_c_s", "h_safe_c_s", "safe_c_l", "h_safe_c_l",
+ "safe_car_s", "h_safe_car_s", "safe_cdr_s", "h_safe_cdr_s", "safe_cadr_s", "h_safe_cadr_s",
+ "safe_is_pair_s", "h_safe_is_pair_s", "safe_is_null_s", "h_safe_is_null_s", "safe_is_symbol_s", "h_safe_is_symbol_s",
"safe_c_ss", "h_safe_c_ss", "safe_c_sc", "h_safe_c_sc", "safe_c_cs", "h_safe_c_cs",
- "safe_c_q", "h_safe_c_q", "safe_c_sq", "h_safe_c_sq", "safe_c_qs", "h_safe_c_qs", "safe_c_qq", "h_safe_c_qq",
+ "safe_c_sq", "h_safe_c_sq", "safe_c_qs", "h_safe_c_qs", "safe_c_qq", "h_safe_c_qq",
"safe_c_cq", "h_safe_c_cq", "safe_c_qc", "h_safe_c_qc",
"safe_c_sss", "h_safe_c_sss", "safe_c_scs", "h_safe_c_scs", "safe_c_ssc", "h_safe_c_ssc", "safe_c_css", "h_safe_c_css",
"safe_c_scc", "h_safe_c_scc", "safe_c_csc", "h_safe_c_csc",
"safe_c_all_s", "h_safe_c_all_s", "safe_c_all_x", "h_safe_c_all_x", "safe_c_ssa", "h_safe_c_ssa", "safe_c_sas", "h_safe_c_sas",
- "safe_c_csa", "h_safe_c_csa", "safe_c_sca", "h_safe_c_sca", "safe_c_cas", "h_safe_c_cas",
+ "safe_c_csa", "h_safe_c_csa", "safe_c_sca", "h_safe_c_sca",
"safe_c_a", "h_safe_c_a", "safe_c_aa", "h_safe_c_aa", "safe_c_aaa", "h_safe_c_aaa", "safe_c_aaaa", "h_safe_c_aaaa",
"safe_c_sqs", "h_safe_c_sqs", "safe_c_opaq", "h_safe_c_opaq", "safe_c_opaaq", "h_safe_c_opaaq", "safe_c_opaaaq", "h_safe_c_opaaaq",
"safe_c_s_opaq", "h_safe_c_s_opaq", "safe_c_s_opaaq", "h_safe_c_s_opaaq", "safe_c_s_opaaaq", "h_safe_c_s_opaaaq",
"safe_c_opcq", "h_safe_c_opcq", "safe_c_opsq", "h_safe_c_opsq",
- "safe_c_opssq", "h_safe_c_opssq", "safe_c_opscq", "h_safe_c_opscq", "safe_c_opsqq", "h_safe_c_opsqq",
+ "safe_c_opcq_opsq", "h_safe_c_opcq_opsq", "safe_c_opsq_opcq", "h_safe_c_opsq_opcq",
+ "safe_c_opssq", "h_safe_c_opssq", "safe_c_opscq", "h_safe_c_opscq", "safe_c_opsqq", "h_safe_c_opsqq", "safe_c_opqsq", "h_safe_c_opqsq",
"safe_c_opcsq", "h_safe_c_opcsq", "safe_c_s_opsq", "h_safe_c_s_opsq",
"safe_c_c_opscq", "h_safe_c_c_opscq",
"safe_c_s_opscq", "h_safe_c_s_opscq", "safe_c_s_opcsq", "h_safe_c_s_opcsq",
@@ -2970,16 +3334,19 @@ static const char* opt_names[OPT_MAX_DEFINED] =
"safe_c_opssq_opcq", "h_safe_c_opssq_opcq", "safe_c_opssq_opsq", "h_safe_c_opssq_opsq", "safe_c_opsq_opssq", "h_safe_c_opsq_opssq",
"safe_c_opssq_s", "h_safe_c_opssq_s", "safe_c_opscq_s", "h_safe_c_opscq_s", "safe_c_opcsq_s", "h_safe_c_opcsq_s",
"safe_c_opscq_c", "h_safe_c_opscq_c", "safe_c_opcq_opssq", "h_safe_c_opcq_opssq",
- "safe_c_s_op_opssq_sq", "h_safe_c_s_op_opssq_sq", "safe_c_s_op_s_opssqq", "h_safe_c_s_op_s_opssqq",
+ "safe_c_s_op_opssq_sq", "h_safe_c_s_op_opssq_sq", "safe_c_s_op_s_opssqq", "h_safe_c_s_op_s_opssqq", "safe_c_s_op_s_opsqq", "h_safe_c_s_op_s_opsqq",
"safe_c_op_opssq_q_c", "h_safe_c_op_opssq_q_c", "safe_c_op_opsq_q_c", "h_safe_c_op_opsq_q_c",
"safe_c_op_opssq_q_s", "h_safe_c_op_opssq_q_s", "safe_c_op_opsq_q_s", "h_safe_c_op_opsq_q_s",
"safe_c_s_op_opssq_opssqq", "h_safe_c_s_op_opssq_opssqq",
- "safe_c_op_opsq_q", "h_safe_c_op_opsq_q", "safe_c_c_op_s_opcqq", "h_safe_c_c_op_s_opcqq",
- "safe_c_op_s_opsq_q", "h_safe_c_op_s_opsq_q",
+ "safe_c_op_opsq_q", "h_safe_c_op_opsq_q",
+ "safe_c_c_op_s_opcqq", "h_safe_c_c_op_s_opcqq",
+ "safe_c_op_s_opsq_q", "h_safe_c_op_s_opsq_q", "safe_c_op_opsq_s_q", "h_safe_c_op_opsq_s_q",
"safe_c_opsq_q", "h_safe_c_opsq_q", "safe_c_opsq_q_s", "h_safe_c_opsq_q_s",
+ "safe_ifa_ss_a", "h_safe_ifa_ss_a", "safe_c_p", "h_safe_c_p",
+
"safe_c_z", "h_safe_c_z", "safe_c_zz", "h_safe_c_zz", "safe_c_sz", "h_safe_c_sz", "safe_c_zs", "h_safe_c_zs",
- "safe_c_cz", "h_safe_c_cz", "safe_c_zc", "h_safe_c_zc",
+ "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",
@@ -2987,43 +3354,46 @@ static const char* opt_names[OPT_MAX_DEFINED] =
"safe_c_zzz", "h_safe_c_zzz",
"thunk", "h_thunk",
- "closure_s", "h_closure_s", "closure_c", "h_closure_c", "closure_q", "h_closure_q",
- "closure_ss", "h_closure_ss", "closure_sc", "h_closure_sc", "closure_cs", "h_closure_cs",
- "closure_a", "h_closure_a", "closure_aa", "h_closure_aa",
- "closure_all_x", "h_closure_all_x", "closure_all_s", "h_closure_all_s",
-
- "glosure_a", "h_glosure_a", "glosure_s", "h_glosure_s", "glosure_p", "h_glosure_p",
-
- "closure_star_s", "h_closure_star_s", "closure_star_sx", "h_closure_star_sx",
- "closure_star", "h_closure_star", "closure_star_all_x", "h_closure_star_all_x",
-
- "safe_thunk", "h_safe_thunk", "safe_thunk_e", "h_safe_thunk_e", "safe_thunk_p", "h_safe_thunk_p",
- "safe_closure_s", "h_safe_closure_s", "safe_closure_c", "h_safe_closure_c", "safe_closure_q", "h_safe_closure_q",
+ "closure_s", "h_closure_s", "closure_c", "h_closure_c", "closure_p", "h_closure_p",
+ "closure_ss", "h_closure_ss", "closure_ss_p", "h_closure_ss_p",
+ "closure_sc", "h_closure_sc", "closure_cs", "h_closure_cs",
+ "closure_a", "h_closure_a", "closure_aa", "h_closure_aa", "closure_a_p", "h_closure_a_p",
+ "closure_all_x", "h_closure_all_x", "closure_all_s", "h_closure_all_s", "closure_all_s_p", "h_closure_all_s_p",
+ "closure_fa", "h_closure_fa",
+ "closure_ap", "h_closure_ap", "closure_pa", "h_closure_pa",
+
+ "closure_star_a", "h_closure_star_a", "closure_star_aa", "h_closure_star_aa", "closure_star_all_x", "h_closure_star_all_x",
+
+ "safe_thunk", "h_safe_thunk",
+ "safe_thunk_e", "h_safe_thunk_e",
+ "safe_thunk_p", "h_safe_thunk_p", "safe_lthunk", "h_safe_lthunk",
+ "safe_closure_s", "h_safe_closure_s", "safe_lclosure_l", "h_safe_lclosure_l",
+ "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_a", "h_safe_closure_a", "safe_closure_sa", "h_safe_closure_sa", "safe_closure_s_p", "h_safe_closure_s_p",
- "safe_closure_saa", "h_safe_closure_saa",
+ "safe_closure_a", "h_safe_closure_a", "safe_lclosure_a", "h_safe_lclosure_a",
+ "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",
+ "safe_closure_saa", "h_safe_closure_saa", "safe_closure_s_c", "h_safe_closure_s_c",
+ "safe_closure_a_c", "h_safe_closure_a_c",
"safe_closure_all_x", "h_safe_closure_all_x", "safe_closure_aa", "h_safe_closure_aa",
+ "safe_closure_ap", "h_safe_closure_ap", "safe_closure_pa", "h_safe_closure_pa",
- "safe_glosure_a", "h_safe_glosure_a", "safe_glosure_s", "h_safe_glosure_s", "safe_glosure_s_e", "h_safe_glosure_s_e",
- "safe_glosure_p", "h_safe_glosure_p",
-
- "safe_closure_star_s", "h_safe_closure_star_s", "safe_closure_star_ss", "h_safe_closure_star_ss",
- "safe_closure_star_sc", "h_safe_closure_star_sc", "safe_closure_star_sa", "h_safe_closure_star_sa", "safe_closure_star_s0", "h_safe_closure_star_s0",
- "safe_closure_star", "h_safe_closure_star", "safe_closure_star_all_x", "h_safe_closure_star_all_x",
+ "safe_closure_star_a", "h_safe_closure_star_a", "safe_closure_star_aa", "h_safe_closure_star_aa",
+ "safe_closure_star_s0", "h_safe_closure_star_s0", "safe_closure_star_all_x", "h_safe_closure_star_all_x",
"apply_ss", "h_apply_ss",
- "c_all_x", "h_c_all_x", "call_with_exit", "h_call_with_exit", "c_catch", "h_c_catch", "c_catch_all", "h_c_catch_all",
+ "c_all_x", "h_c_all_x", "call_with_exit", "h_call_with_exit",
+ "c_catch", "h_c_catch", "c_catch_all", "h_c_catch_all", "c_catch_all_z", "h_c_catch_all_z",
"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_sp", "h_c_sp",
- "c_sz", "h_c_sz", "c_a", "h_c_a", "c_scs", "h_c_scs",
+ "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",
"goto", "h_goto", "goto_c", "h_goto_c", "goto_s", "h_goto_s", "goto_a", "h_goto_a",
- "vector_c", "h_vector_c", "vector_s", "h_vector_s", "vector_a", "h_vector_a", "vector_cc", "h_vector_cc",
- "string_c", "h_string_c", "string_s", "h_string_s", "string_a", "h_string_a",
- "c_object", "h_c_object", "c_object_c", "h_c_object_c", "c_object_s", "h_c_object_s", "c_object_a", "h_c_object_a",
- "pair_c", "h_pair_c", "pair_s", "h_pair_s", "pair_a", "h_pair_a",
- "hash_table_c", "h_hash_table_c", "hash_table_s", "h_hash_table_s", "hash_table_a", "h_hash_table_a",
- "environment_s", "h_environment_s", "environment_q", "h_environment_q", "environment_a", "h_environment_a", "environment_c", "h_environment_c",
+ "iterate", "h_iterate",
+ "vector_a", "h_vector_a", "string_a", "h_string_a",
+ "c_object_a", "h_c_object_a", "pair_a", "h_pair_a", "hash_table_a", "h_hash_table_a",
+ "environment_q", "h_environment_q", "environment_a", "h_environment_a",
"unknown", "h_unknown", "unknown_all_s", "h_unknown_all_s", "unknown_all_x", "h_unknown_all_x",
"unknown_g", "h_unknown_g", "unknown_gg", "h_unknown_gg", "unknown_a", "h_unknown_a", "unknown_aa", "h_unknown_aa",
@@ -3036,7 +3406,9 @@ static const char* opt_names[OPT_MAX_DEFINED] =
};
#endif
-#define is_safe_c_op(op) (op < OP_THUNK) /* used only in safe_stepper */
+#define in_reader(Sc) ((Sc->op >= OP_READ_LIST) && (Sc->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))
#define is_callable_c_op(op) ((op < OP_THUNK) || (op > OP_UNKNOWN_AA)) /* used only in check_set */
@@ -3047,9 +3419,9 @@ static bool is_h_optimized(s7_pointer p)
(!is_unknown_op(optimize_op(p))));
}
-#define is_h_safe_c_c(P) ((is_optimized(P)) && (optimize_op(P) == HOP_SAFE_C_C))
-#define is_h_safe_c_s(P) ((is_optimized(P)) && (optimize_op(P) == HOP_SAFE_C_S))
-#define is_safe_c_s(P) ((is_optimized(P)) && (op_no_hop(P) == OP_SAFE_C_S))
+#define is_h_safe_c_c(P) ((is_optimized(P)) && (optimize_op(P) >= HOP_SAFE_C_C) && (optimize_op(P) < OP_SAFE_C_S) && ((optimize_op(P) & 1) != 0))
+#define is_h_safe_c_s(P) ((is_optimized(P)) && (optimize_op(P) >= HOP_SAFE_C_S) && (optimize_op(P) <= HOP_SAFE_IS_SYMBOL_S) && ((optimize_op(P) & 1) != 0))
+#define is_safe_c_s(P) ((is_optimized(P)) && (optimize_op(P) >= HOP_SAFE_C_S) && (optimize_op(P) <= HOP_SAFE_IS_SYMBOL_S))
static int position_of(s7_pointer p, s7_pointer args)
{
@@ -3099,43 +3471,75 @@ static s7_pointer check_values(s7_scheme *sc, s7_pointer obj, s7_pointer args)
* go ahead. It's mostly boilerplate:
*/
+static s7_pointer apply_boolean_method(s7_scheme *sc, s7_pointer obj, s7_pointer method);
+static s7_pointer missing_method_error(s7_scheme *sc, s7_pointer method, s7_pointer obj);
+
#define check_boolean_method(Sc, Checker, Method, Args) \
{ \
s7_pointer p; \
p = car(Args); \
if (Checker(p)) return(Sc->T); \
- check_method(Sc, p, Method, Args); \
- return(Sc->F); \
+ if (!has_methods(p)) return(Sc->F); \
+ return(apply_boolean_method(Sc, p, Method)); \
}
#define check_boolean_not_method(Sc, Checker, Method, Args) \
{ \
- s7_pointer p, func; \
- p = find_symbol_checked(Sc, cadar(Args)); \
+ s7_pointer p; \
+ p = find_symbol_unchecked(sc, cadar(Args)); \
if (Checker(p)) return(Sc->F); \
- if ((has_methods(p)) && ((func = find_method(Sc, find_let(Sc, p), Method)) != Sc->undefined) && \
- (s7_apply_function(Sc, func, list_1(Sc, p)) != Sc->F)) \
- return(Sc->F); \
- return(Sc->T); \
+ if (!has_methods(p)) return(Sc->T); \
+ return((apply_boolean_method(Sc, p, Method) == sc->F) ? sc->T : sc->F); \
}
- #define method_or_bust(Sc, Obj, Method, Args, Type, Num) \
- { \
- s7_pointer func; \
- if ((has_methods(Obj)) && ((func = find_method(Sc, find_let(Sc, Obj), Method)) != Sc->undefined)) \
- return(s7_apply_function(Sc, func, Args)); \
- if (Num == 0) return(simple_wrong_type_argument(Sc, Method, Obj, Type)); \
- return(wrong_type_argument(Sc, Method, Num, Obj, Type)); \
- }
+#define eval_boolean_method(Sc, Checker, Method, Arg) \
+ if (Checker(Arg)) \
+ Sc->value = Sc->T; \
+ else \
+ { \
+ s7_pointer func; \
+ if ((has_methods(Arg)) && ((func = find_method(Sc, find_let(Sc, Arg), Method)) != Sc->undefined)) \
+ Sc->value = s7_apply_function(Sc, func, list_1(Sc, Arg)); \
+ else Sc->value = Sc->F; \
+ }
+
+static s7_pointer find_and_apply_method(s7_scheme *sc, s7_pointer lt, s7_pointer sym, s7_pointer args)
+{
+ s7_pointer func;
+ func = find_method(sc, lt, sym);
+ if (func != sc->undefined)
+ return(s7_apply_function(sc, func, args));
+ return(missing_method_error(sc, sym, lt));
+}
+
+#define method_or_bust(Sc, Obj, Method, Args, Type, Num) \
+ do { \
+ if (has_methods(Obj)) \
+ return(find_and_apply_method(Sc, find_let(Sc, Obj), Method, Args)); \
+ return(wrong_type_argument(Sc, Method, Num, Obj, Type)); \
+ } while (0)
+
+#define method_or_bust_one_arg(Sc, Obj, Method, Args, Type) \
+ do { \
+ if (has_methods(Obj)) \
+ return(find_and_apply_method(Sc, find_let(Sc, Obj), Method, Args));\
+ return(simple_wrong_type_argument(Sc, Method, Obj, Type)); \
+ } while (0)
+
#define method_or_bust_with_type(Sc, Obj, Method, Args, Type, Num) \
- { \
- s7_pointer func; \
- if ((has_methods(Obj)) && ((func = find_method(Sc, find_let(Sc, Obj), Method)) != Sc->undefined)) \
- return(s7_apply_function(Sc, func, Args)); \
- if (Num == 0) return(simple_wrong_type_argument_with_type(Sc, Method, Obj, Type)); \
+ do { \
+ if (has_methods(Obj)) \
+ return(find_and_apply_method(Sc, find_let(Sc, Obj), Method, Args));\
return(wrong_type_argument_with_type(Sc, Method, Num, Obj, Type)); \
- }
+ } while (0)
+
+#define method_or_bust_with_type_one_arg(Sc, Obj, Method, Args, Type) \
+ do { \
+ if (has_methods(Obj)) \
+ return(find_and_apply_method(Sc, find_let(Sc, Obj), Method, Args));\
+ return(simple_wrong_type_argument_with_type(Sc, Method, Obj, Type)); \
+ } while (0)
#define eval_error_any(Sc, ErrType, ErrMsg, Obj) \
@@ -3156,8 +3560,6 @@ static s7_pointer check_values(s7_scheme *sc, s7_pointer obj, s7_pointer args)
if (!_Err_) _Err_ = s7_make_permanent_string(ErrMsg); \
return(s7_error(Sc, Sc->syntax_error_symbol, set_elist_3(Sc, _Err_, Caller, Obj)));} while (0)
-static s7_pointer print_truncate(s7_scheme *sc, s7_pointer code);
-
#define eval_error_with_caller_and_print_limit(Sc, ErrMsg, Caller, Obj) \
do {static s7_pointer _Err_ = NULL; \
if (!_Err_) _Err_ = s7_make_permanent_string(ErrMsg); \
@@ -3243,12 +3645,20 @@ static s7_pointer set_plist_2(s7_scheme *sc, s7_pointer x1, s7_pointer x2)
return(sc->plist_2);
}
+static s7_pointer set_qlist_2(s7_scheme *sc, s7_pointer x1, s7_pointer x2)
+{
+ set_car(sc->qlist_2, x1);
+ set_cadr(sc->qlist_2, x2);
+ return(sc->qlist_2);
+}
+
static s7_pointer set_plist_3(s7_scheme *sc, s7_pointer x1, s7_pointer x2, s7_pointer x3)
{
return(set_wlist_3(sc, sc->plist_3, x1, x2, x3));
}
+
/* -------------------------------- constants -------------------------------- */
s7_pointer s7_f(s7_scheme *sc)
@@ -3274,6 +3684,8 @@ bool s7_is_null(s7_scheme *sc, s7_pointer p)
return(is_null(p));
}
+static bool is_null_b(s7_pointer p) {return(type(p) == T_NIL);}
+
s7_pointer s7_undefined(s7_scheme *sc)
{
@@ -3306,6 +3718,8 @@ static s7_pointer g_not(s7_scheme *sc, s7_pointer args)
return(make_boolean(sc, is_false(sc, car(args))));
}
+static bool not_b(s7_pointer p) {return(p == cur_sc->F);}
+
bool s7_boolean(s7_scheme *sc, s7_pointer x)
{
@@ -3338,6 +3752,9 @@ bool s7_is_constant(s7_pointer p)
/* this means "always evaluates to the same thing", sort of, not "evaluates to itself":
* (let ((x 'x)) (and (not (constant? x)) (equal? x (eval x))))
* (and (constant? (list + 1)) (not (equal? (list + 1) (eval (list + 1)))))
+ * but since (constant? (vector 1 2 3)) and (constant? #(1 2 3)) are both #t,
+ * how to tell in scheme that (vector-set! x 0 y) is safe?
+ * see end of this file
*/
return((type(p) != T_SYMBOL) || (is_immutable_symbol(p)));
}
@@ -3351,8 +3768,15 @@ static s7_pointer g_is_constant(s7_scheme *sc, s7_pointer args)
}
+
/* -------------------------------- GC -------------------------------- */
+/* in most code, pairs, lets, and slots dominate the heap -- each about 25% to 40% of the
+ * total cell allocations. In snd-test, reals are 50%. slots need not be in the heap,
+ * but moving them out to their own free list was actually slower because we need (in that
+ * case) to manage them in the sweep process by tracking lets.
+ */
+
unsigned int s7_gc_protect(s7_scheme *sc, s7_pointer x)
{
unsigned int loc;
@@ -3430,12 +3854,24 @@ static void (*mark_function[NUM_TYPES])(s7_pointer p);
#define S7_MARK(Obj) do {s7_pointer _p_; _p_ = Obj; if (!is_marked(_p_)) (*mark_function[unchecked_type(_p_)])(_p_);} while (0)
+static void mark_slot(s7_pointer p)
+{
+ set_mark(p);
+ S7_MARK(slot_value(p));
+ if (slot_has_accessor(p))
+ S7_MARK(slot_accessor(p));
+
+ if (is_gensym(slot_symbol(p))) /* (let () (apply define (gensym) (list 32)) (gc) (gc) (curlet)) */
+ set_mark(slot_symbol(p));
+}
+
static void mark_symbol(s7_pointer p)
{
if (is_gensym(p))
set_mark(p);
/* don't set the mark bit of a normal symbol! It wrecks the check against SYNTACTIC_TYPE,
* slowing everything down by a large amount.
+ * (this comment is obsolete I think)
*/
}
@@ -3463,43 +3899,120 @@ static void free_port(s7_scheme *sc, port_t *p)
}
static void close_output_port(s7_scheme *sc, s7_pointer p);
+static void free_optlist(s7_scheme *sc, s7_pointer p);
+
+#define STRING_LISTS 256
+#define STRING_LIST_INIT_SIZE 2
+
+static void init_string_free_lists(s7_scheme *sc)
+{
+ int i;
+ sc->string_lists = (char ***)calloc(STRING_LISTS, sizeof(char **));
+ sc->string_locs = (int *)calloc(STRING_LISTS, sizeof(int));
+ sc->string_sizes = (int *)malloc(STRING_LISTS * sizeof(int));
+ sc->string_max_sizes = (int *)malloc(STRING_LISTS * sizeof(int));
+ for (i = 0; i < STRING_LISTS; i++)
+ {
+ sc->string_lists[i] = (char **)calloc(STRING_LIST_INIT_SIZE, sizeof(char *));
+ sc->string_sizes[i] = STRING_LIST_INIT_SIZE;
+ if (i < 16)
+ sc->string_max_sizes[i] = 4096;
+ else
+ {
+ if (i < 32)
+ sc->string_max_sizes[i] = 1024;
+ else
+ {
+ if (i < 64)
+ sc->string_max_sizes[i] = 256;
+ else sc->string_max_sizes[i] = 32;
+ }
+ }
+ }
+}
+
+static char *alloc_string(s7_scheme *sc, int len)
+{
+ if ((len < STRING_LISTS) &&
+ (sc->string_locs[len] > 0))
+ return(sc->string_lists[len][--sc->string_locs[len]]);
+ return((char *)malloc((len + 1) * sizeof(char)));
+}
+
+static void string_to_free_list(s7_scheme *sc, char *value, int len)
+{
+ if (len >= STRING_LISTS)
+ free(value);
+ else
+ {
+ if (sc->string_locs[len] >= sc->string_sizes[len])
+ {
+ if (sc->string_sizes[len] >= sc->string_max_sizes[len])
+ {
+ free(value);
+ return;
+ }
+ sc->string_sizes[len] *= 2;
+ sc->string_lists[len] = (char **)realloc((void *)(sc->string_lists[len]), sc->string_sizes[len] * sizeof(char *));
+ }
+ sc->string_lists[len][sc->string_locs[len]++] = value;
+ }
+}
+
static void sweep(s7_scheme *sc)
{
unsigned int i, j;
+ s7_pointer s1;
+
if (sc->strings_loc > 0)
{
/* unrolling this loop is not an improvement */
for (i = 0, j = 0; i < sc->strings_loc; i++)
{
- s7_pointer s1;
s1 = sc->strings[i];
if (is_free_and_clear(s1))
{
if (string_needs_free(s1))
- free(string_value(s1));
+ string_to_free_list(sc, string_value(s1), string_length(s1));
+ }
+ else
+ {
+ /* remove_from_heap can remove a string from the heap; we need to notice that removal
+ * via in_heap, and remove it also from this cache; otherwise it just stays here
+ * forever, slowing down the loop.
+ */
+ if (in_heap(s1)) /* this costs more than it saves */
+ sc->strings[j++] = s1;
}
- else sc->strings[j++] = s1;
}
sc->strings_loc = j;
}
+ if (sc->strings1_loc > 0)
+ {
+ for (i = 0, j = 0; i < sc->strings1_loc; i++)
+ {
+ s1 = sc->strings1[i];
+ if (is_free_and_clear(s1))
+ {
+ if (string_needs_free(s1))
+ free(string_value(s1));
+ }
+ else sc->strings1[j++] = s1;
+ }
+ sc->strings1_loc = j;
+ }
+
if (sc->gensyms_loc > 0)
{
for (i = 0, j = 0; i < sc->gensyms_loc; i++)
{
- s7_pointer s1;
s1 = sc->gensyms[i];
if (is_free_and_clear(s1))
{
remove_gensym_from_symbol_table(sc, s1); /* this uses symbol_name_cell data */
free(symbol_name(s1));
- if ((is_documented(s1)) &&
- (symbol_help(s1)))
- {
- free(symbol_help(s1));
- symbol_help(s1) = NULL;
- }
free(symbol_name_cell(s1));
}
else sc->gensyms[j++] = s1;
@@ -3512,46 +4025,53 @@ static void sweep(s7_scheme *sc)
{
for (i = 0, j = 0; i < sc->c_objects_loc; i++)
{
- if (is_free_and_clear(sc->c_objects[i]))
- free_object(sc->c_objects[i]);
- else sc->c_objects[j++] = sc->c_objects[i];
+ s1 = sc->c_objects[i];
+ if (is_free_and_clear(s1))
+ free_object(s1);
+ else sc->c_objects[j++] = s1;
}
sc->c_objects_loc = j;
}
+ if (sc->optlists_loc > 0)
+ {
+ for (i = 0, j = 0; i < sc->optlists_loc; i++)
+ {
+ s1 = sc->optlists[i];
+ if (is_free_and_clear(s1))
+ free_optlist(sc, s1);
+ else sc->optlists[j++] = s1;
+ }
+ sc->optlists_loc = j;
+ }
+
if (sc->vectors_loc > 0)
{
for (i = 0, j = 0; i < sc->vectors_loc; i++)
{
- if (is_free_and_clear(sc->vectors[i]))
+ s1 = sc->vectors[i];
+ if (is_free_and_clear(s1))
{
- s7_pointer a;
- a = sc->vectors[i];
-
/* a multidimensional empty vector can have dimension info, wrapped vectors always have dimension info */
- if (vector_dimension_info(a))
+ if (vector_dimension_info(s1))
{
- if (vector_dimensions_allocated(a))
+ if (vector_dimensions_allocated(s1))
{
- free(vector_dimensions(a));
- free(vector_offsets(a));
+ free(vector_dimensions(s1));
+ free(vector_offsets(s1));
}
- if (vector_elements_allocated(a))
- free(vector_elements(a)); /* I think this will work for any vector (int/float too) */
- if (vector_dimension_info(a) != sc->wrap_only)
- free(vector_dimension_info(a));
+ if (vector_elements_allocated(s1))
+ free(vector_elements(s1)); /* I think this will work for any vector (int/float too) */
+ if (vector_dimension_info(s1) != sc->wrap_only)
+ free(vector_dimension_info(s1));
}
else
{
- if (vector_length(a) != 0)
- free(vector_elements(a));
+ if (vector_length(s1) != 0)
+ free(vector_elements(s1));
}
}
- else sc->vectors[j++] = sc->vectors[i];
- /* here (in the else branch) if a vector constant in a global function has been removed from the heap,
- * not_in_heap(heap_location(v)), and we'll never see it freed, so if there were a lot of these, they might
- * glom up this loop. Surely not a big deal!?
- */
+ else sc->vectors[j++] = s1;
}
sc->vectors_loc = j;
}
@@ -3560,12 +4080,13 @@ static void sweep(s7_scheme *sc)
{
for (i = 0, j = 0; i < sc->hash_tables_loc; i++)
{
- if (is_free_and_clear(sc->hash_tables[i]))
+ s1 = sc->hash_tables[i];
+ if (is_free_and_clear(s1))
{
- if (hash_table_mask(sc->hash_tables[i]) > 0)
- free_hash_table(sc->hash_tables[i]);
+ if (hash_table_mask(s1) > 0)
+ free_hash_table(s1);
}
- else sc->hash_tables[j++] = sc->hash_tables[i];
+ else sc->hash_tables[j++] = s1;
}
sc->hash_tables_loc = j;
}
@@ -3574,29 +4095,28 @@ static void sweep(s7_scheme *sc)
{
for (i = 0, j = 0; i < sc->input_ports_loc; i++)
{
- if (is_free_and_clear(sc->input_ports[i]))
+ s1 = sc->input_ports[i];
+ if (is_free_and_clear(s1))
{
- s7_pointer a;
- a = sc->input_ports[i];
- if (port_needs_free(a))
+ if (port_needs_free(s1))
{
- if (port_data(a))
+ if (port_data(s1))
{
- free(port_data(a));
- port_data(a) = NULL;
- port_data_size(a) = 0;
+ free(port_data(s1));
+ port_data(s1) = NULL;
+ port_data_size(s1) = 0;
}
- port_needs_free(a) = false;
+ port_needs_free(s1) = false;
}
- if (port_filename(a))
+ if (port_filename(s1))
{
- free(port_filename(a));
- port_filename(a) = NULL;
+ free(port_filename(s1));
+ port_filename(s1) = NULL;
}
- free_port(sc, port_port(a));
+ free_port(sc, port_port(s1));
}
- else sc->input_ports[j++] = sc->input_ports[i];
+ else sc->input_ports[j++] = s1;
}
sc->input_ports_loc = j;
}
@@ -3605,12 +4125,13 @@ static void sweep(s7_scheme *sc)
{
for (i = 0, j = 0; i < sc->output_ports_loc; i++)
{
- if (is_free_and_clear(sc->output_ports[i]))
+ s1 = sc->output_ports[i];
+ if (is_free_and_clear(s1))
{
- close_output_port(sc, sc->output_ports[i]); /* needed for free filename, etc */
- free_port(sc, port_port(sc->output_ports[i]));
+ close_output_port(sc, s1); /* needed for free filename, etc */
+ free_port(sc, port_port(s1));
}
- else sc->output_ports[j++] = sc->output_ports[i];
+ else sc->output_ports[j++] = s1;
}
sc->output_ports_loc = j;
}
@@ -3619,18 +4140,17 @@ static void sweep(s7_scheme *sc)
{
for (i = 0, j = 0; i < sc->continuations_loc; i++)
{
- if (is_free_and_clear(sc->continuations[i]))
+ s1 = sc->continuations[i];
+ if (is_free_and_clear(s1))
{
- s7_pointer c;
- c = sc->continuations[i];
- if (continuation_op_stack(c))
+ if (continuation_op_stack(s1))
{
- free(continuation_op_stack(c));
- continuation_op_stack(c) = NULL;
+ free(continuation_op_stack(s1));
+ continuation_op_stack(s1) = NULL;
}
- free(continuation_data(c));
+ free(continuation_data(s1));
}
- else sc->continuations[j++] = sc->continuations[i];
+ else sc->continuations[j++] = s1;
}
sc->continuations_loc = j;
}
@@ -3691,19 +4211,6 @@ static void sweep(s7_scheme *sc)
}
-static void add_string(s7_scheme *sc, s7_pointer p)
-{
- if (sc->strings_loc == sc->strings_size)
- {
- sc->strings_size *= 2;
- sc->strings = (s7_pointer *)realloc(sc->strings, sc->strings_size * sizeof(s7_pointer));
- }
- sc->strings[sc->strings_loc++] = p;
-}
-
-#define Add_String(Str) if (sc->strings_loc == sc->strings_size) add_string(sc, Str); else sc->strings[sc->strings_loc++] = Str
-
-
static void add_gensym(s7_scheme *sc, s7_pointer p)
{
if (sc->gensyms_loc == sc->gensyms_size)
@@ -3727,6 +4234,17 @@ static void add_c_object(s7_scheme *sc, s7_pointer p)
}
+static void add_optlist(s7_scheme *sc, s7_pointer p)
+{
+ if (sc->optlists_loc == sc->optlists_size)
+ {
+ sc->optlists_size *= 2;
+ sc->optlists = (s7_pointer *)realloc(sc->optlists, sc->optlists_size * sizeof(s7_pointer));
+ }
+ sc->optlists[sc->optlists_loc++] = p;
+}
+
+
static void add_hash_table(s7_scheme *sc, s7_pointer p)
{
if (sc->hash_tables_loc == sc->hash_tables_size)
@@ -3828,16 +4346,19 @@ static void add_bignumber(s7_scheme *sc, s7_pointer p)
#endif
-#define INIT_GC_CACHE_SIZE 64
+#define INIT_GC_CACHE_SIZE 4
static void init_gc_caches(s7_scheme *sc)
{
- sc->strings_size = INIT_GC_CACHE_SIZE * 16;
+ sc->strings_size = INIT_GC_CACHE_SIZE;
sc->strings_loc = 0;
sc->strings = (s7_pointer *)malloc(sc->strings_size * sizeof(s7_pointer));
+ sc->strings1_size = INIT_GC_CACHE_SIZE;
+ sc->strings1_loc = 0;
+ sc->strings1 = (s7_pointer *)malloc(sc->strings1_size * sizeof(s7_pointer));
sc->gensyms_size = INIT_GC_CACHE_SIZE;
sc->gensyms_loc = 0;
sc->gensyms = (s7_pointer *)malloc(sc->gensyms_size * sizeof(s7_pointer));
- sc->vectors_size = INIT_GC_CACHE_SIZE * 8;
+ sc->vectors_size = INIT_GC_CACHE_SIZE;
sc->vectors_loc = 0;
sc->vectors = (s7_pointer *)malloc(sc->vectors_size * sizeof(s7_pointer));
sc->hash_tables_size = INIT_GC_CACHE_SIZE;
@@ -3855,6 +4376,9 @@ static void init_gc_caches(s7_scheme *sc)
sc->c_objects_size = INIT_GC_CACHE_SIZE;
sc->c_objects_loc = 0;
sc->c_objects = (s7_pointer *)malloc(sc->c_objects_size * sizeof(s7_pointer));
+ sc->optlists_size = INIT_GC_CACHE_SIZE;
+ sc->optlists_loc = 0;
+ sc->optlists = (s7_pointer *)malloc(sc->optlists_size * sizeof(s7_pointer));
#if WITH_GMP
sc->bigints_size = INIT_GC_CACHE_SIZE;
sc->bigints_loc = 0;
@@ -3873,7 +4397,7 @@ static void init_gc_caches(s7_scheme *sc)
/* slightly unrelated... */
sc->setters_size = 4;
sc->setters_loc = 0;
- sc->setters = (s7_pointer *)malloc(sc->c_objects_size * sizeof(s7_pointer));
+ sc->setters = (s7_pointer *)malloc(sc->setters_size * sizeof(s7_pointer));
}
@@ -3925,17 +4449,6 @@ static void mark_vector_1(s7_pointer p, s7_int top)
S7_MARK(*tp++);
}
-static void mark_slot(s7_pointer p)
-{
- set_mark(p);
- S7_MARK(slot_value(p));
- if (slot_has_accessor(p))
- S7_MARK(slot_accessor(p));
-
- if (is_gensym(slot_symbol(p))) /* (let () (apply define (gensym) (list 32)) (gc) (gc) (curlet)) */
- set_mark(slot_symbol(p));
-}
-
static void mark_let(s7_pointer env)
{
s7_pointer x;
@@ -3981,7 +4494,7 @@ static void mark_pair(s7_pointer p)
* Now I've already forgotten the rest of the story, and it was just an hour ago! -- the upshot is that temp_cell_2|3
* are not now used as arg list members.
*/
- for (x = cdr(p); is_pair(x) && (!is_marked(x)); x = cdr(x))
+ for (x = cdr(p); (is_pair(x)) && (!is_marked(x)); x = cdr(x))
{
set_mark(x);
S7_MARK(car(x));
@@ -4004,6 +4517,8 @@ static void mark_closure(s7_pointer p)
S7_MARK(closure_body(p));
mark_let(closure_let(p));
S7_MARK(closure_setter(p));
+ if (has_optlist(p))
+ set_mark(closure_optlist(p));
}
static void mark_stack_1(s7_pointer p, s7_int top)
@@ -4108,19 +4623,22 @@ static void mark_hash_table(s7_pointer p)
S7_MARK(hash_table_procedures(p));
if (hash_table_entries(p) > 0)
{
- unsigned int i, len;
- hash_entry_t **entries;
+ unsigned int len;
+ hash_entry_t **entries, **last;
+
entries = hash_table_elements(p);
len = hash_table_mask(p) + 1;
- for (i = 0; i < len; i++)
+ last = (hash_entry_t **)(entries + len);
+
+ while (entries < last)
{
hash_entry_t *xp;
- for (xp = entries[i++]; xp; xp = xp->next)
+ for (xp = *entries++; xp; xp = xp->next)
{
S7_MARK(xp->key);
S7_MARK(xp->value);
}
- for (xp = entries[i]; xp; xp = xp->next)
+ for (xp = *entries++; xp; xp = xp->next)
{
S7_MARK(xp->key);
S7_MARK(xp->value);
@@ -4143,19 +4661,13 @@ static void mark_input_port(s7_pointer p)
set_mark(port_original_input_string(p));
}
-static void gf_mark(s7_scheme *sc)
-{
- gc_obj *p;
- if (sc->cur_rf)
- for (p = sc->cur_rf->gc_list; p; p = p->nxt)
- S7_MARK(p->p);
-}
-
+#define clear_type(p) typeflag(p) = T_FREE
static void init_mark_functions(void)
{
mark_function[T_FREE] = mark_noop;
- mark_function[T_UNIQUE] = mark_noop;
+ mark_function[T_UNDEFINED] = mark_noop;
+ mark_function[T_EOF_OBJECT] = mark_noop;
mark_function[T_UNSPECIFIED] = mark_noop;
mark_function[T_NIL] = mark_noop;
mark_function[T_BOOLEAN] = mark_noop;
@@ -4194,6 +4706,7 @@ static void init_mark_functions(void)
mark_function[T_LET] = mark_let;
mark_function[T_STACK] = mark_stack;
mark_function[T_COUNTER] = mark_counter;
+ mark_function[T_OPTLIST] = just_mark;
mark_function[T_SLOT] = mark_slot;
mark_function[T_BAFFLE] = just_mark;
mark_function[T_C_MACRO] = just_mark;
@@ -4249,7 +4762,7 @@ static void unmark_permanent_objects(s7_scheme *sc)
}
-#ifndef _MSC_VER
+#if (!MS_WINDOWS)
#include <time.h>
#include <sys/time.h>
static struct timeval start_time;
@@ -4278,7 +4791,7 @@ static int gc(s7_scheme *sc)
#if DEBUGGING
#define gc_call(P, Tp) \
p = (*tp++); \
- if (is_marked(p)) \
+ if (is_marked(_Cell(p))) \
clear_mark(p); \
else \
{ \
@@ -4298,7 +4811,7 @@ static int gc(s7_scheme *sc)
#if DEBUGGING
fprintf(stdout, "%s[%d] ", last_gc_func, last_gc_line);
#endif
-#ifndef _MSC_VER
+#if (!MS_WINDOWS)
/* this is apparently deprecated in favor of clock_gettime -- what compile-time switch to use here?
* _POSIX_TIMERS, or perhaps use CLOCK_REALTIME, but clock_gettime requires -lrt -- no thanks.
*/
@@ -4350,8 +4863,10 @@ static int gc(s7_scheme *sc)
S7_MARK(sc->temp9);
S7_MARK(sc->temp10);
S7_MARK(sc->temp11);
- gf_mark(sc);
-
+ {
+ int i;
+ for (i = 0; i < T_TEMPS_SIZE; i++) {S7_MARK(sc->t_temps[i]);}
+ }
set_mark(sc->input_port);
S7_MARK(sc->input_port_stack);
set_mark(sc->output_port);
@@ -4380,12 +4895,16 @@ static int gc(s7_scheme *sc)
S7_MARK(car(sc->plist_3));
S7_MARK(cadr(sc->plist_3));
S7_MARK(caddr(sc->plist_3));
+ S7_MARK(car(sc->qlist_2));
+ S7_MARK(cadr(sc->qlist_2));
{
unsigned int i;
s7_pointer p;
+ /* perhaps: if (sc->current_safe_list > 0) ... but this loop is down in the noise */
for (i = 1; i < NUM_SAFE_LISTS; i++)
- if (list_is_in_use(sc->safe_lists[i]))
+ if ((is_pair(sc->safe_lists[i])) &&
+ (list_is_in_use(sc->safe_lists[i])))
for (p = sc->safe_lists[i]; is_pair(p); p = cdr(p))
S7_MARK(car(p));
for (i = 0; i < sc->setters_loc; i++)
@@ -4441,7 +4960,7 @@ static int gc(s7_scheme *sc)
/* from here down is gc_call, but I wanted one case explicit for readability */
p = (*tp++);
- if (is_marked(p)) /* this order is faster than checking typeflag(p) != T_FREE first */
+ if (is_marked(_Cell(p))) /* this order is faster than checking typeflag(p) != T_FREE first */
clear_mark(p);
else
{
@@ -4507,16 +5026,12 @@ static int gc(s7_scheme *sc)
if (show_gc_stats(sc))
{
-#ifndef _MSC_VER
+#if (!MS_WINDOWS)
struct timeval t0;
double secs;
gettimeofday(&t0, &z0);
secs = (t0.tv_sec - start_time.tv_sec) + 0.000001 * (t0.tv_usec - start_time.tv_usec);
-#if (PRINT_NAME_PADDING == 8)
- fprintf(stdout, "freed %d/%u (free: %d), time: %f\n", sc->gc_freed, sc->heap_size, sc->free_heap_top - sc->free_heap, secs);
-#else
- fprintf(stdout, "freed %d/%u (free: %ld), time: %f\n", sc->gc_freed, sc->heap_size, sc->free_heap_top - sc->free_heap, secs);
-#endif
+ fprintf(stdout, "freed %d/%u (free: " PD_U "), time: %f\n", sc->gc_freed, sc->heap_size, sc->free_heap_top - sc->free_heap, secs);
#else
fprintf(stdout, "freed %d/%u\n", sc->gc_freed, sc->heap_size);
#endif
@@ -4552,6 +5067,7 @@ int s7_gc_freed(s7_scheme *sc) {return(sc->gc_freed);}
* to check it repeatedly after the first such check.
*/
#else
+/* DEBUGGING */
static bool for_any_other_reason(s7_scheme *sc, int line)
{
#if 0
@@ -4562,7 +5078,7 @@ static bool for_any_other_reason(s7_scheme *sc, int line)
{
s7_double x;
x = next_random(sc->default_rng);
- if (x > .995)
+ if (x > .999)
{
ctr = 0;
return(true);
@@ -4575,16 +5091,16 @@ static bool for_any_other_reason(s7_scheme *sc, int line)
#define new_cell(Sc, Obj, Type) \
do { \
- if ((Sc->free_heap_top <= Sc->free_heap_trigger) || (for_any_other_reason(sc, __LINE__))) {last_gc_line = __LINE__; last_gc_func = __func__; try_to_call_gc(Sc);} \
+ if ((Sc->free_heap_top <= Sc->free_heap_trigger) || (for_any_other_reason(Sc, __LINE__))) {last_gc_line = __LINE__; last_gc_func = __func__; try_to_call_gc(Sc);} \
Obj = (*(--(Sc->free_heap_top))); \
- Obj->alloc_line = __LINE__; Obj->alloc_func = __func__; \
+ Obj->alloc_line = __LINE__; Obj->alloc_func = __func__; Obj->debugger_bits = 0; \
set_type(Obj, Type); \
} while (0)
#define new_cell_no_check(Sc, Obj, Type) \
do { \
Obj = (*(--(Sc->free_heap_top))); \
- Obj->alloc_line = __LINE__; Obj->alloc_func = __func__;\
+ Obj->alloc_line = __LINE__; Obj->alloc_func = __func__; Obj->debugger_bits = 0; \
set_type(Obj, Type); \
} while (0)
#endif
@@ -4635,7 +5151,16 @@ static void resize_heap(s7_scheme *sc)
sc->previous_free_heap_top = sc->free_heap_top;
if (show_heap_stats(sc))
- fprintf(stderr, "heap grows to %u\n", sc->heap_size);
+ {
+ fprintf(stderr, "heap grows to %u\n", sc->heap_size);
+#if DEBUGGING
+ if (sc->heap_size > 50000000) /* maybe a max-heap-size? */
+ {
+ s7_show_let(sc);
+ abort();
+ }
+#endif
+ }
}
static void try_to_call_gc(s7_scheme *sc)
@@ -4678,7 +5203,7 @@ Evaluation produces a surprising amount of garbage, so don't leave the GC off fo
if (is_not_null(args))
{
if (!s7_is_boolean(car(args)))
- method_or_bust(sc, car(args), sc->gc_symbol, args, T_BOOLEAN, 0);
+ method_or_bust_one_arg(sc, car(args), sc->gc_symbol, args, T_BOOLEAN);
sc->gc_off = (car(args) == sc->F);
if (sc->gc_off)
return(sc->F);
@@ -4729,7 +5254,6 @@ static void add_permanent_object(s7_scheme *sc, s7_pointer obj)
sc->permanent_objects = g;
}
-
static void free_cell(s7_scheme *sc, s7_pointer p)
{
#if DEBUGGING
@@ -4739,12 +5263,30 @@ static void free_cell(s7_scheme *sc, s7_pointer p)
(*(sc->free_heap_top++)) = p;
}
+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))
+ free_cell(sc, p);
+ }
+}
-static void s7_remove_from_heap(s7_scheme *sc, s7_pointer x)
+static inline s7_pointer petrify(s7_scheme *sc, s7_pointer x, int loc)
{
- int loc;
s7_pointer p;
+ p = alloc_pointer();
+ sc->heap[loc] = p;
+ heap_location(p) = loc;
+ free_cell(sc, p);
+ unheap(x);
+ return(x);
+}
+static void s7_remove_from_heap(s7_scheme *sc, s7_pointer x)
+{
+ int 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
@@ -4772,11 +5314,7 @@ static void s7_remove_from_heap(s7_scheme *sc, s7_pointer x)
switch (type(x))
{
case T_PAIR:
- unheap(x);
- p = alloc_pointer();
- sc->heap[loc] = p;
- (*sc->free_heap_top++) = p;
- heap_location(p) = loc;
+ petrify(sc, x, loc);
#if 0
/* this code fixes the problem above, but at some cost (gc + mark_pair up by about 2% in the worst case (snd-test.scm)) */
if ((car(x) == sc->quote_symbol) &&
@@ -4838,25 +5376,18 @@ static void s7_remove_from_heap(s7_scheme *sc, s7_pointer x)
case T_CLOSURE: case T_CLOSURE_STAR:
case T_MACRO: case T_MACRO_STAR:
case T_BACRO: case T_BACRO_STAR:
- unheap(x);
- p = alloc_pointer();
- free_cell(sc, p);
- sc->heap[loc] = p;
- heap_location(p) = loc;
-
+ petrify(sc, x, loc);
s7_remove_from_heap(sc, closure_args(x));
s7_remove_from_heap(sc, closure_body(x));
+ if (has_optlist(x))
+ s7_remove_from_heap(sc, closure_optlist(x));
return;
default:
break;
}
-
- unheap(x);
- p = alloc_pointer();
- free_cell(sc, p);
- sc->heap[loc] = p;
- heap_location(p) = loc;
+
+ petrify(sc, x, loc);
}
@@ -4928,58 +5459,38 @@ static void resize_op_stack(s7_scheme *sc)
#if DEBUGGING
static void pop_stack(s7_scheme *sc)
{
- opcode_t cur_op;
- cur_op = sc->op;
sc->stack_end -= 4;
if (sc->stack_end < sc->stack_start)
{
fprintf(stderr, "%sstack underflow%s\n", BOLD_TEXT, UNBOLD_TEXT);
if (stop_at_error) abort();
}
- sc->code = sc->stack_end[0];
+ /* here and in push_stack, both code and args might be non-free only because they've been retyped
+ * inline (as in named let) -- they actually don't make sense in these cases, but are ignored,
+ * and are carried around as GC protection in other cases.
+ */
+ sc->code = _NFre(sc->stack_end[0]);
sc->envir = _TLid(sc->stack_end[1]);
- sc->args = sc->stack_end[2];
+ sc->args = _NFre(sc->stack_end[2]);
sc->op = (opcode_t)(sc->stack_end[3]);
if (sc->op > OP_MAX_DEFINED)
{
fprintf(stderr, "%spop_stack[%d] invalid opcode: " INT_FORMAT "%s\n", BOLD_TEXT, __LINE__, sc->op, UNBOLD_TEXT);
if (stop_at_error) abort();
}
- if (unchecked_type(sc->code) == T_FREE)
- {
- fprintf(stderr, "%s%s[%d]: stack code is free, op: %s -> %s%s\n", BOLD_TEXT, __func__, __LINE__, op_names[cur_op], op_names[sc->op], UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
- if (unchecked_type(sc->args) == T_FREE)
- {
- fprintf(stderr, "%s%s[%d]: stack args is free, op: %s -> %s%s\n", BOLD_TEXT, __func__, __LINE__, op_names[cur_op], op_names[sc->op], UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
}
static void pop_stack_no_op(s7_scheme *sc)
{
- opcode_t cur_op;
- cur_op = sc->op;
sc->stack_end -= 4;
if (sc->stack_end < sc->stack_start)
{
fprintf(stderr, "%sstack underflow%s\n", BOLD_TEXT, UNBOLD_TEXT);
if (stop_at_error) abort();
}
- sc->code = sc->stack_end[0];
+ sc->code = _NFre(sc->stack_end[0]);
sc->envir = _TLid(sc->stack_end[1]);
- sc->args = sc->stack_end[2];
- if (unchecked_type(sc->code) == T_FREE)
- {
- fprintf(stderr, "%s%s[%d]: stack code is free, op: %s -> %s%s\n", BOLD_TEXT, __func__, __LINE__, op_names[cur_op], op_names[sc->op], UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
- if (unchecked_type(sc->args) == T_FREE)
- {
- fprintf(stderr, "%s%s[%d]: stack args is free, op: %s -> %s%s\n", BOLD_TEXT, __func__, __LINE__, op_names[cur_op], op_names[sc->op], UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
+ sc->args = _NFre(sc->stack_end[2]);
}
static void push_stack(s7_scheme *sc, opcode_t op, s7_pointer args, s7_pointer code)
@@ -5105,7 +5616,10 @@ static void resize_stack(s7_scheme *sc)
sc->stack_resize_trigger = (s7_pointer *)(sc->stack_start + sc->stack_size / 2);
if (show_stack_stats(sc))
- fprintf(stderr, "stack grows to %u\n", new_size);
+ {
+ fprintf(stderr, "stack grows to %u, %s\n", new_size, DISPLAY_80(sc->code));
+ s7_show_let(sc);
+ }
}
#define check_stack_size(Sc) \
@@ -5146,13 +5660,15 @@ static s7_pointer make_symbol_with_length(s7_scheme *sc, const char *name, unsig
static s7_pointer new_symbol(s7_scheme *sc, const char *name, unsigned int len, unsigned long long int hash, unsigned int location)
{
+ /* name might not be null-terminated */
s7_pointer x, str, p;
unsigned char *base, *val;
- if (sc->symbol_table_is_locked)
- return(s7_error(sc, sc->error_symbol, set_elist_1(sc, make_string_wrapper(sc, "can't make symbol: symbol table is locked!"))));
-
base = (unsigned char *)malloc(sizeof(s7_cell) * 3 + len + 1);
+#if DEBUGGING
+ /* clear at least debugger_bits here and below */
+ memset((void *)base, 0, sizeof(s7_cell) * 3 + len + 1);
+#endif
x = (s7_pointer)base;
str = (s7_pointer)(base + sizeof(s7_cell));
p = (s7_pointer)(base + 2 * sizeof(s7_cell));
@@ -5174,6 +5690,7 @@ static s7_pointer new_symbol(s7_scheme *sc, const char *name, unsigned int len,
set_initial_slot(x, sc->undefined);
symbol_set_local(x, 0LL, sc->nil);
symbol_set_tag(x, 0);
+ symbol_set_ctr(x, 0);
if (symbol_name_length(x) > 1) /* not 0, otherwise : is a keyword */
{
@@ -5181,6 +5698,7 @@ static s7_pointer new_symbol(s7_scheme *sc, const char *name, unsigned int len,
{
typeflag(x) |= (T_IMMUTABLE | T_KEYWORD);
keyword_set_symbol(x, make_symbol_with_length(sc, (char *)(name + 1), len - 1));
+ set_has_keyword(keyword_symbol(x));
set_global_slot(x, s7_make_slot(sc, sc->nil, x, x));
}
else
@@ -5198,6 +5716,7 @@ static s7_pointer new_symbol(s7_scheme *sc, const char *name, unsigned int len,
kstr[klen] = 0;
typeflag(x) |= (T_IMMUTABLE | T_KEYWORD);
keyword_set_symbol(x, make_symbol_with_length(sc, kstr, klen));
+ set_has_keyword(keyword_symbol(x));
set_global_slot(x, s7_make_slot(sc, sc->nil, x, x));
free(kstr);
}
@@ -5255,7 +5774,6 @@ s7_pointer s7_make_symbol(s7_scheme *sc, const char *name)
return(make_symbol_with_length(sc, name, safe_strlen(name)));
}
-
static s7_pointer symbol_table_find_by_name(s7_scheme *sc, const char *name, unsigned long long int hash, unsigned int location)
{
s7_pointer x;
@@ -5452,7 +5970,7 @@ static s7_pointer g_gensym(s7_scheme *sc, s7_pointer args)
s7_pointer name;
name = car(args);
if (!is_string(name))
- method_or_bust(sc, name, sc->gensym_symbol, args, T_STRING, 0);
+ method_or_bust_one_arg(sc, name, sc->gensym_symbol, args, T_STRING);
prefix = string_value(name);
}
else prefix = "gensym";
@@ -5472,7 +5990,11 @@ static s7_pointer g_gensym(s7_scheme *sc, s7_pointer args)
location = hash % SYMBOL_TABLE_SIZE;
/* make-string for symbol name */
- str = (s7_cell *)malloc(sizeof(s7_cell)); /* was calloc? */
+#if DEBUGGING
+ str = (s7_cell *)calloc(1, sizeof(s7_cell));
+#else
+ str = (s7_cell *)malloc(sizeof(s7_cell));
+#endif
unheap(str);
#if DEBUGGING
typeflag(str) = 0;
@@ -5489,9 +6011,14 @@ static s7_pointer g_gensym(s7_scheme *sc, s7_pointer args)
set_global_slot(x, sc->undefined);
set_initial_slot(x, sc->undefined);
symbol_set_local(x, 0LL, sc->nil);
+ symbol_set_ctr(x, 0);
/* place new symbol in symbol-table, but using calloc so we can easily free it (remove it from the table) in GC sweep */
- stc = (s7_cell *)malloc(sizeof(s7_cell)); /* was calloc? */
+#if DEBUGGING
+ stc = (s7_cell *)calloc(1, sizeof(s7_cell));
+#else
+ stc = (s7_cell *)malloc(sizeof(s7_cell));
+#endif
#if DEBUGGING
typeflag(stc) = 0;
#endif
@@ -5515,18 +6042,25 @@ s7_pointer s7_name_to_value(s7_scheme *sc, const char *name)
}
-bool s7_is_symbol(s7_pointer p)
+bool s7_is_syntax(s7_pointer p)
{
- return(is_symbol(p));
+ return(is_syntax(p));
}
-
-bool s7_is_syntax(s7_pointer p)
+static s7_pointer g_is_syntax(s7_scheme *sc, s7_pointer args)
{
- return(is_syntax(p));
+ #define H_is_syntax "(syntax? obj) returns #t if obj is a syntactic value (e.g. lambda)"
+ #define Q_is_syntax pl_bt
+
+ check_boolean_method(sc, is_syntax, sc->is_syntax_symbol, args);
}
+bool s7_is_symbol(s7_pointer p)
+{
+ return(is_symbol(p));
+}
+
static s7_pointer g_is_symbol(s7_scheme *sc, s7_pointer args)
{
#define H_is_symbol "(symbol? obj) returns #t if obj is a symbol"
@@ -5550,7 +6084,7 @@ static s7_pointer g_symbol_to_string(s7_scheme *sc, s7_pointer args)
sym = car(args);
if (!is_symbol(sym))
- method_or_bust(sc, sym, sc->symbol_to_string_symbol, args, T_SYMBOL, 0);
+ method_or_bust_one_arg(sc, sym, sc->symbol_to_string_symbol, args, T_SYMBOL);
/* s7_make_string uses strlen which stops at an embedded null */
return(s7_make_string_with_length(sc, symbol_name(sym), symbol_name_length(sym))); /* return a copy */
}
@@ -5562,7 +6096,25 @@ static s7_pointer g_symbol_to_string_uncopied(s7_scheme *sc, s7_pointer args)
sym = car(args);
if (!is_symbol(sym))
- method_or_bust(sc, sym, sc->symbol_to_string_symbol, args, T_SYMBOL, 0);
+ method_or_bust_one_arg(sc, sym, sc->symbol_to_string_symbol, args, T_SYMBOL);
+ if (is_gensym(sym))
+ return(s7_make_string_with_length(sc, symbol_name(sym), symbol_name_length(sym))); /* return a copy of gensym name (which will be freed) */
+ return(symbol_name_cell(sym));
+}
+
+static s7_pointer symbol_to_string_p(s7_pointer sym)
+{
+ if (!is_symbol(sym))
+ simple_wrong_type_argument(cur_sc, cur_sc->symbol_to_string_symbol, sym, T_SYMBOL);
+ return(s7_make_string_with_length(cur_sc, symbol_name(sym), symbol_name_length(sym)));
+}
+
+static s7_pointer symbol_to_string_uncopied_p(s7_pointer sym)
+{
+ if (!is_symbol(sym))
+ simple_wrong_type_argument(cur_sc, cur_sc->symbol_to_string_symbol, sym, T_SYMBOL);
+ if (is_gensym(sym))
+ return(s7_make_string_with_length(cur_sc, symbol_name(sym), symbol_name_length(sym)));
return(symbol_name_cell(sym));
}
@@ -5570,7 +6122,7 @@ static s7_pointer g_symbol_to_string_uncopied(s7_scheme *sc, s7_pointer args)
static s7_pointer g_string_to_symbol_1(s7_scheme *sc, s7_pointer str, s7_pointer caller)
{
if (!is_string(str))
- method_or_bust(sc, str, caller, list_1(sc, str), T_STRING, 0);
+ method_or_bust_one_arg(sc, str, caller, list_1(sc, str), T_STRING);
if (string_length(str) == 0)
return(simple_wrong_type_argument_with_type(sc, caller, str, make_string_wrapper(sc, "a non-null string")));
@@ -5586,8 +6138,17 @@ static s7_pointer g_string_to_symbol(s7_scheme *sc, s7_pointer args)
return(g_string_to_symbol_1(sc, car(args), sc->string_to_symbol_symbol));
}
+static s7_pointer string_to_symbol_p_p(s7_pointer p)
+{
+ if (!is_string(p))
+ simple_wrong_type_argument(cur_sc, cur_sc->string_to_symbol_symbol, p, T_STRING);
+ if (string_length(p) == 0)
+ simple_wrong_type_argument_with_type(cur_sc, cur_sc->string_to_symbol_symbol, p, make_string_wrapper(cur_sc, "a non-null string"));
+ return(make_symbol_with_length(cur_sc, string_value(p), string_length(p)));
+}
static s7_pointer g_string_append(s7_scheme *sc, s7_pointer args);
+
static s7_pointer g_symbol(s7_scheme *sc, s7_pointer args)
{
#define H_symbol "(symbol str ...) returns its string arguments concatenated and converted to a symbol"
@@ -5598,13 +6159,14 @@ static s7_pointer g_symbol(s7_scheme *sc, s7_pointer args)
}
-static s7_pointer add_sym_to_list(s7_scheme *sc, s7_pointer sym)
+static s7_pointer add_symbol_to_list(s7_scheme *sc, s7_pointer sym)
{
symbol_set_tag(sym, sc->syms_tag);
return(sym);
}
-#define clear_syms_in_list(Sc) Sc->syms_tag++
+#define clear_symbol_list(Sc) Sc->syms_tag++
+#define symbol_is_in_list(Sc, Sym) (symbol_tag(Sym) == Sc->syms_tag)
@@ -5613,10 +6175,10 @@ static s7_pointer add_sym_to_list(s7_scheme *sc, s7_pointer sym)
#define new_frame(Sc, Old_Env, New_Env) \
do { \
s7_pointer _x_; \
- new_cell(Sc, _x_, T_LET); \
+ new_cell(Sc, _x_, T_LET | T_SAFE_PROCEDURE); \
let_id(_x_) = ++sc->let_number; \
let_set_slots(_x_, Sc->nil); \
- set_outlet(_x_, Old_Env); \
+ set_outlet(_x_, Old_Env); \
New_Env = _x_; \
} while (0)
@@ -5625,7 +6187,7 @@ static s7_pointer new_frame_in_env(s7_scheme *sc, s7_pointer old_env)
{
/* return(cons(sc, sc->nil, old_env)); */
s7_pointer x;
- new_cell(sc, x, T_LET);
+ new_cell(sc, x, T_LET | T_SAFE_PROCEDURE);
let_id(x) = ++sc->let_number;
let_set_slots(x, sc->nil);
set_outlet(x, old_env);
@@ -5636,7 +6198,7 @@ static s7_pointer new_frame_in_env(s7_scheme *sc, s7_pointer old_env)
static s7_pointer make_simple_let(s7_scheme *sc)
{
s7_pointer frame;
- new_cell(sc, frame, T_LET);
+ new_cell(sc, frame, T_LET | T_SAFE_PROCEDURE);
let_id(frame) = sc->let_number + 1;
let_set_slots(frame, sc->nil);
set_outlet(frame, sc->envir);
@@ -5677,7 +6239,7 @@ static s7_pointer make_simple_let(s7_scheme *sc)
do { \
s7_pointer _x_, _slot_, _sym_, _val_; \
_sym_ = Symbol; _val_ = Value; \
- new_cell(Sc, _x_, T_LET); \
+ new_cell(Sc, _x_, T_LET | T_SAFE_PROCEDURE); \
let_id(_x_) = ++sc->let_number; \
set_outlet(_x_, Old_Env); \
New_Env = _x_; \
@@ -5695,7 +6257,7 @@ static s7_pointer make_simple_let(s7_scheme *sc)
s7_pointer _x_, _slot_, _sym1_, _val1_, _sym2_, _val2_; \
_sym1_ = Symbol1; _val1_ = Value1; \
_sym2_ = Symbol2; _val2_ = Value2; \
- new_cell(Sc, _x_, T_LET); \
+ new_cell(Sc, _x_, T_LET | T_SAFE_PROCEDURE); \
let_id(_x_) = ++sc->let_number; \
set_outlet(_x_, Old_Env); \
New_Env = _x_; \
@@ -5713,15 +6275,30 @@ static s7_pointer make_simple_let(s7_scheme *sc)
} while (0)
-static s7_pointer old_frame_in_env(s7_scheme *sc, s7_pointer frame, s7_pointer next_frame)
+static s7_pointer reuse_as_let(s7_scheme *sc, s7_pointer frame, s7_pointer next_frame)
{
- set_type(frame, T_LET);
+ /* we're reusing frame here as a let -- it was probably a pair */
+#if DEBUGGING
+ frame->debugger_bits = 0;
+#endif
+ set_type(frame, T_LET | T_SAFE_PROCEDURE);
let_set_slots(frame, sc->nil);
set_outlet(frame, next_frame);
let_id(frame) = ++sc->let_number;
return(frame);
}
+static s7_pointer reuse_as_slot(s7_pointer slot, s7_pointer symbol, s7_pointer value)
+{
+#if DEBUGGING
+ slot->debugger_bits = 0;
+#endif
+ set_type(slot, T_SLOT);
+ slot_set_symbol(slot, symbol);
+ slot_set_value(slot, _NFre(value));
+ return(slot);
+}
+
static s7_pointer old_frame_with_slot(s7_scheme *sc, s7_pointer env, s7_pointer val)
{
@@ -5785,7 +6362,6 @@ static s7_pointer old_frame_with_three_slots(s7_scheme *sc, s7_pointer env, s7_p
return(env);
}
-
static s7_pointer permanent_slot(s7_pointer symbol, s7_pointer value)
{
s7_pointer x;
@@ -5818,43 +6394,30 @@ static s7_pointer find_let(s7_scheme *sc, s7_pointer obj)
}
-static s7_pointer free_let(s7_scheme *sc, s7_pointer e)
-{
- /* currently called only by safe do */
- s7_pointer p;
-#if DEBUGGING
- for (p = let_slots(e); is_slot(p);)
- {
- s7_pointer n;
- n = next_slot(p); /* grab it before we free p, or the type check stuff will complain */
- free_cell(sc, p);
- p = n;
- }
-#else
- for (p = let_slots(e); is_slot(p); p = next_slot(p))
- free_cell(sc, p);
-#endif
-
- free_cell(sc, e);
- return(sc->nil);
-}
-
-
static s7_pointer let_fill(s7_scheme *sc, s7_pointer args)
{
- s7_pointer e, val, p;
+ s7_pointer e, val;
e = car(args);
if (e == sc->rootlet)
return(out_of_range(sc, sc->fill_symbol, small_int(1), e, make_string_wrapper(sc, "can't fill! rootlet")));
if (e == sc->owlet)
return(out_of_range(sc, sc->fill_symbol, small_int(1), e, make_string_wrapper(sc, "can't fill! owlet")));
- if (is_function_env(e))
+ if (is_funclet(e))
return(out_of_range(sc, sc->fill_symbol, small_int(1), e, make_string_wrapper(sc, "can't fill! a funclet")));
val = cadr(args);
- for (p = let_slots(e); is_slot(p); p = next_slot(p))
- slot_set_value(p, val);
+ if (val == sc->undefined)
+ {
+ let_set_slots(e, sc->nil);
+ let_id(e) = ++sc->let_number; /* else previous symbol_id matches! */
+ }
+ else
+ {
+ s7_pointer p;
+ for (p = let_slots(e); is_slot(p); p = next_slot(p))
+ slot_set_value(p, val);
+ }
return(val);
}
@@ -5887,7 +6450,7 @@ static s7_pointer find_method(s7_scheme *sc, s7_pointer env, s7_pointer symbol)
static int let_length(s7_scheme *sc, s7_pointer e)
{
- /* used by length, applicable_length, and some length optimizations */
+ /* used by length, applicable_length, copy, and some length optimizations */
int i;
s7_pointer p;
@@ -5914,11 +6477,7 @@ static int let_length(s7_scheme *sc, s7_pointer e)
static void slot_set_value_with_hook_1(s7_scheme *sc, s7_pointer slot, s7_pointer value)
{
- /* global funcs: 5945 6294 7300 7548 61107 66359 66522
- * global vars: 7136
- * some of these are set!s, not defines.
- * (set! (hook-functions *rootlet-redefinition-hook*) (list (lambda (hook) (format *stderr* "~A ~A~%" (hook 'symbol) (hook 'value)))))
- */
+ /* (set! (hook-functions *rootlet-redefinition-hook*) (list (lambda (hook) (format *stderr* "~A ~A~%" (hook 'symbol) (hook 'value))))) */
s7_pointer symbol;
symbol = slot_symbol(slot);
if ((global_slot(symbol) == slot) &&
@@ -5946,19 +6505,85 @@ static s7_pointer make_slot_1(s7_scheme *sc, s7_pointer env, s7_pointer symbol,
return(slot);
}
+static hash_entry_t *hash_eq(s7_scheme *sc, s7_pointer table, s7_pointer key);
+static s7_pointer hash_table_iterate(s7_scheme *sc, s7_pointer iterator);
-s7_pointer s7_make_slot(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value)
+static void remove_function_from_heap(s7_scheme *sc, s7_pointer value);
+static void remove_let_from_heap(s7_scheme *sc, s7_pointer lt)
{
- if ((!is_let(env)) ||
- (env == sc->rootlet))
+ s7_pointer p;
+ for (p = let_slots(lt); is_slot(p); p = next_slot(p))
{
- s7_pointer ge, slot;
+ s7_pointer val;
+ val = slot_value(p);
+ if ((has_closure_let(val)) &&
+ (heap_location(closure_args(val)) >= 0))
+ remove_function_from_heap(sc, val);
+ else
+ {
+ /* an experiment... */
+ if ((is_hash_table(val)) &&
+ (!hash_table_removed(val)))
+ {
+ s7_pointer iterator, p;
+ unsigned int gc_iter;
+ int i, len;
+
+ len = hash_table_entries(val);
+ iterator = s7_make_iterator(sc, val);
+ gc_iter = s7_gc_protect(sc, iterator);
+ p = cons(sc, sc->F, sc->F);
+ iterator_current(iterator) = p;
+ set_mark_seq(iterator);
+ for (i = 0; i < len; i++)
+ {
+ s7_pointer key_val;
+ key_val = hash_table_iterate(sc, iterator);
+ if ((has_closure_let(cdr(key_val))) &&
+ (heap_location(closure_args(cdr(key_val))) >= 0))
+ remove_function_from_heap(sc, cdr(key_val));
+ }
+ hash_table_set_removed(val);
+ s7_gc_unprotect_at(sc, gc_iter);
+ iterator_current(iterator) = sc->nil;
+ free_cell(sc, p);
+ free_cell(sc, iterator);
+ }
+ }
+ }
+ let_set_removed(lt);
+}
- if ((sc->safety == 0) && (has_closure_let(value)))
+static void remove_function_from_heap(s7_scheme *sc, s7_pointer value)
+{
+ s7_pointer lt;
+ s7_remove_from_heap(sc, closure_args(value));
+ s7_remove_from_heap(sc, closure_body(value));
+
+ /* remove closure if it's local to current func */
+ lt = closure_let(value);
+ if ((is_let(lt)) && (!let_removed(lt)) && (lt != sc->rootlet) && (lt != sc->shadow_rootlet))
+ {
+ lt = outlet(lt);
+ if ((is_let(lt)) && (!let_removed(lt)) && (lt != sc->rootlet) && (lt != sc->shadow_rootlet))
{
- s7_remove_from_heap(sc, closure_args(value));
- s7_remove_from_heap(sc, closure_body(value));
+ remove_let_from_heap(sc, lt);
+ lt = outlet(lt);
+ if ((is_let(lt)) && (!let_removed(lt)) && (lt != sc->rootlet) && (lt != sc->shadow_rootlet))
+ remove_let_from_heap(sc, lt);
}
+ }
+}
+
+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? */
+ {
+ s7_pointer ge, slot;
+ if ((sc->safety == NO_SAFETY) &&
+ (has_closure_let(value)))
+ remove_function_from_heap(sc, value);
/* first look for existing slot -- this is not always checked before calling s7_make_slot */
if (is_slot(global_slot(symbol)))
@@ -5986,6 +6611,7 @@ s7_pointer s7_make_slot(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_poi
if (initial_slot(symbol) == sc->undefined)
set_initial_slot(symbol, permanent_slot(symbol, value));
set_local_slot(symbol, slot);
+ symbol_increment_ctr(symbol);
set_global(symbol);
}
if (is_gensym(symbol))
@@ -6006,7 +6632,6 @@ static s7_pointer make_slot(s7_scheme *sc, s7_pointer variable, s7_pointer value
s7_pointer y;
new_cell(sc, y, T_SLOT);
slot_set_symbol(y, variable);
- if (!is_symbol(variable)) abort();
slot_set_value(y, value);
return(y);
}
@@ -6028,7 +6653,7 @@ static s7_pointer g_is_let(s7_scheme *sc, s7_pointer args)
/* -------------------------------- unlet -------------------------------- */
-#define UNLET_ENTRIES 410 /* 401 if not --disable-deprecated etc */
+#define UNLET_ENTRIES 512 /* 397 if not --disable-deprecated etc */
static void save_unlet(s7_scheme *sc)
{
@@ -6055,9 +6680,13 @@ static void save_unlet(s7_scheme *sc)
{
s7_pointer val;
val = slot_value(initial_slot(sym));
- if ((is_procedure(val)) || (is_syntax(val)))
+ if ((is_c_function(val)) || (is_syntax(val))) /* we're assuming the initial_slots values of these guys need no GC protection */
inits[k++] = initial_slot(sym);
+ /* non-c_functions that are not 'set! (and therefore initial_slot GC) protected by default:
+ * make-hook hook-functions (and deprecated procedure-arity)
+ * if these initial_slot values are added to unlet, they need explicit GC protection.
+ */
/* (let ((begin +)) (with-let (unlet) (begin 1 2))) */
#if DEBUGGING
if (k >= UNLET_ENTRIES)
@@ -6153,23 +6782,39 @@ static s7_pointer g_openlet(s7_scheme *sc, s7_pointer args)
e = car(args);
check_method(sc, e, sc->openlet_symbol, args);
- if (((is_let(e)) && (e != sc->rootlet)) ||
+
+ if (e == sc->rootlet)
+ s7_error(sc, sc->error_symbol, set_elist_1(sc, s7_make_string(sc, "can't openlet rootlet")));
+
+ if ((is_let(e)) ||
(has_closure_let(e)) ||
((is_c_object(e)) && (c_object_let(e) != sc->nil)))
{
set_has_methods(e);
return(e);
}
+
return(simple_wrong_type_argument_with_type(sc, sc->openlet_symbol, e, a_let_string));
}
+
/* -------------------------------- coverlet -------------------------------- */
-static s7_pointer c_coverlet(s7_scheme *sc, s7_pointer e)
+
+static s7_pointer g_coverlet(s7_scheme *sc, s7_pointer args)
{
+ s7_pointer e;
+ #define H_coverlet "(coverlet e) undoes an earlier openlet."
+ #define Q_coverlet pcl_e
+
+ e = car(args);
sc->temp3 = e;
check_method(sc, e, sc->coverlet_symbol, list_1(sc, e));
- if (((is_let(e)) && (e != sc->rootlet)) ||
+
+ 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)))
{
@@ -6179,12 +6824,6 @@ static s7_pointer c_coverlet(s7_scheme *sc, s7_pointer e)
return(simple_wrong_type_argument_with_type(sc, sc->coverlet_symbol, e, a_let_string));
}
-static s7_pointer g_coverlet(s7_scheme *sc, s7_pointer args)
-{
- #define H_coverlet "(coverlet e) undoes an earlier openlet."
- #define Q_coverlet pcl_e
- return(c_coverlet(sc, car(args)));
-}
/* -------------------------------- varlet -------------------------------- */
@@ -6237,7 +6876,7 @@ s7_pointer s7_varlet(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointe
if (is_slot(global_slot(symbol)))
{
if (is_syntax(slot_value(global_slot(symbol))))
- return(wrong_type_argument_with_type(sc, sc->varlet_symbol, 2, symbol, make_string_wrapper(sc, "a non-syntactic keyword")));
+ return(wrong_type_argument_with_type(sc, sc->varlet_symbol, 2, symbol, make_string_wrapper(sc, "a non-syntactic keyword")));
slot_set_value(global_slot(symbol), value);
}
else s7_make_slot(sc, env, symbol, value);
@@ -6276,7 +6915,7 @@ to the environment env, and returns the environment."
sym = keyword_symbol(p);
else sym = p;
if (!is_pair(cdr(x)))
- return(wrong_type_argument_with_type(sc, sc->varlet_symbol, position_of(x, args), p, a_binding_string));
+ s7_error(sc, sc->error_symbol, set_elist_3(sc, value_is_missing_string, sc->varlet_symbol, car(x)));
x = cdr(x);
val = car(x);
break;
@@ -6403,6 +7042,7 @@ static s7_pointer g_cutlet(s7_scheme *sc, s7_pointer args)
static s7_pointer sublet_1(s7_scheme *sc, s7_pointer e, s7_pointer bindings, s7_pointer caller)
{
s7_pointer new_e;
+ /* fprintf(stderr, "%s sublet: %s %s\n", DISPLAY(caller), DISPLAY(e), DISPLAY(bindings)); */
if (e == sc->rootlet)
new_e = new_frame_in_env(sc, sc->nil);
@@ -6414,7 +7054,7 @@ static s7_pointer sublet_1(s7_scheme *sc, s7_pointer e, s7_pointer bindings, s7_
s7_pointer x;
sc->temp3 = new_e;
- for (x = bindings; is_not_null(x); x = cdr(x))
+ for (x = bindings; is_pair(x); x = cdr(x))
{
s7_pointer p, sym, val;
@@ -6426,7 +7066,7 @@ static s7_pointer sublet_1(s7_scheme *sc, s7_pointer e, s7_pointer bindings, s7_
sym = keyword_symbol(p);
else sym = p;
if (!is_pair(cdr(x)))
- return(wrong_type_argument_with_type(sc, caller, position_of(x, bindings), p, a_binding_string));
+ s7_error(sc, sc->error_symbol, set_elist_3(sc, value_is_missing_string, caller, car(x)));
x = cdr(x);
val = car(x);
break;
@@ -6505,6 +7145,64 @@ new environment. (inlet :a 1 :b 2) or (inlet '(a . 1) '(b . 2))"
#define g_inlet s7_inlet
+static s7_pointer simple_inlet;
+static s7_pointer g_simple_inlet(s7_scheme *sc, s7_pointer args)
+{
+ /* here all args are paired with normal symbol/value, no fallbacks, no immutable symbols etc */
+ s7_pointer new_e, x;
+ long long int id;
+ new_e = new_frame_in_env(sc, sc->nil);
+ sc->temp3 = new_e;
+ id = let_id(new_e);
+ for (x = args; is_pair(x); x = cddr(x))
+ {
+ s7_pointer symbol, slot;
+ symbol = car(x);
+ new_cell(sc, slot, T_SLOT);
+ slot_set_symbol(slot, symbol);
+ slot_set_value(slot, cadr(x));
+ set_next_slot(slot, let_slots(new_e));
+ let_set_slots(new_e, slot);
+ set_local(symbol);
+ symbol_set_local(symbol, id, slot);
+ }
+ sc->temp3 = sc->nil;
+ return(new_e);
+}
+
+static bool is_proper_quote(s7_scheme *sc, s7_pointer p)
+{
+ return((is_pair(p)) &&
+ (car(p) == sc->quote_symbol) &&
+ (is_pair(cdr(p))));
+}
+
+static s7_pointer inlet_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
+{
+ if (!ops) return(f);
+ if ((args > 0) &&
+ ((args % 2) == 0))
+ {
+ s7_pointer p;
+ for (p = cdr(expr); is_pair(p); p = cddr(p))
+ {
+ s7_pointer sym;
+ if (!is_proper_quote(sc, car(p)))
+ return(f);
+ sym = cadar(p);
+ if ((!is_symbol(sym)) ||
+ (is_immutable_symbol(sym)) ||
+ (sym == sc->let_ref_fallback_symbol) ||
+ (sym == sc->let_set_fallback_symbol))
+ return(f);
+ }
+ return(simple_inlet);
+ }
+ return(f);
+}
+
+
+
/* -------------------------------- let->list -------------------------------- */
s7_pointer s7_let_to_list(s7_scheme *sc, s7_pointer env)
{
@@ -6584,15 +7282,33 @@ static s7_pointer g_let_to_list(s7_scheme *sc, s7_pointer args)
/* -------------------------------- let-ref -------------------------------- */
-static s7_pointer let_ref_1(s7_scheme *sc, s7_pointer env, s7_pointer symbol)
+
+static s7_pointer g_let_ref(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x, y;
+ #define H_let_ref "(let-ref env sym) returns the value of the symbol sym in the environment env"
+ #define Q_let_ref s7_make_signature(sc, 3, sc->T, sc->is_let_symbol, sc->is_symbol_symbol)
+ s7_pointer env, symbol, x, y;
+
/* (let ((a 1)) ((curlet) 'a))
* ((rootlet) 'abs)
*/
+
+ env = car(args);
+ if (!is_let(env))
+ return(wrong_type_argument_with_type(sc, sc->let_ref_symbol, 1, env, a_let_string));
+
+ symbol = cadr(args);
if (is_keyword(symbol))
symbol = keyword_symbol(symbol);
+ if (!is_symbol(symbol))
+ {
+ check_method(sc, env, sc->let_ref_symbol, args);
+ if (has_ref_fallback(env))
+ check_method(sc, env, sc->let_ref_fallback_symbol, args);
+ return(wrong_type_argument_with_type(sc, sc->let_ref_symbol, 2, symbol, a_symbol_string));
+ }
+
if (env == sc->rootlet)
{
y = global_slot(symbol);
@@ -6615,7 +7331,7 @@ static s7_pointer let_ref_1(s7_scheme *sc, s7_pointer env, s7_pointer symbol)
* get into infinite recursion. So, 'let-ref-fallback...
*/
if (has_ref_fallback(env))
- check_method(sc, env, sc->let_ref_fallback_symbol, sc->w = list_2(sc, env, symbol));
+ 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
@@ -6632,40 +7348,73 @@ static s7_pointer let_ref_1(s7_scheme *sc, s7_pointer env, s7_pointer symbol)
return(sc->undefined);
}
-s7_pointer s7_let_ref(s7_scheme *sc, s7_pointer env, s7_pointer symbol)
+
+static s7_pointer lint_let_ref_1(s7_scheme *sc, s7_pointer lt, s7_pointer sym)
{
- if (!is_let(env))
- return(wrong_type_argument_with_type(sc, sc->let_ref_symbol, 1, env, a_let_string));
-
- if (!is_symbol(symbol))
+ 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))
{
- check_method(sc, env, sc->let_ref_symbol, sc->w = list_2(sc, env, symbol));
- if (has_ref_fallback(env))
- check_method(sc, env, sc->let_ref_fallback_symbol, sc->w = list_2(sc, env, symbol));
- return(wrong_type_argument_with_type(sc, sc->let_ref_symbol, 2, symbol, a_symbol_string));
+ y = global_slot(sym);
+ if (is_slot(y))
+ return(slot_value(y));
}
- return(let_ref_1(sc, env, symbol));
+ return(sc->undefined);
}
-static s7_pointer g_let_ref(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_let_ref(s7_scheme *sc, s7_pointer env, s7_pointer symbol) {return(g_let_ref(sc, set_plist_2(sc, env, symbol)));}
+static s7_pointer let_ref_p_pp(s7_pointer p1, s7_pointer p2) {return(g_let_ref(cur_sc, set_plist_2(cur_sc, p1, p2)));}
+
+static s7_pointer lint_let_ref;
+static s7_pointer g_lint_let_ref(s7_scheme *sc, s7_pointer args)
{
- #define H_let_ref "(let-ref env sym) returns the value of the symbol sym in the environment env"
- #define Q_let_ref s7_make_signature(sc, 3, sc->T, sc->is_let_symbol, sc->is_symbol_symbol)
- s7_pointer e, s;
+ return(lint_let_ref_1(sc, find_symbol_unchecked(sc, cadar(args)), cadadr(args)));
+}
- e = car(args);
- if (!is_let(e))
- return(wrong_type_argument_with_type(sc, sc->let_ref_symbol, 1, e, a_let_string));
+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)));
+}
- s = cadr(args);
- if (!is_symbol(s))
+
+static s7_pointer let_ref_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
+{
+ if (!ops) return(f);
+ if ((is_h_safe_c_c(expr)) &&
+ ((raw_opt1(expr) == lint_let_ref) || /* perhaps check is_safe_c_op(expr) then opt_cfunc(expr) rather than using raw_opt here and in the set case below */
+ (raw_opt1(expr) == local_lint_let_ref)))
+ return(raw_opt1(expr));
+
+ if (optimize_op(expr) == HOP_SAFE_C_opSq_Q)
{
- check_method(sc, e, sc->let_ref_symbol, args);
- if (has_ref_fallback(e))
- check_method(sc, e, sc->let_ref_fallback_symbol, args);
- return(wrong_type_argument_with_type(sc, sc->let_ref_symbol, 2, s, a_symbol_string));
+ s7_pointer arg1, arg2;
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+ if ((car(arg1) == sc->cdr_symbol) &&
+ (is_symbol(cadr(arg2))) &&
+ (!is_immutable_symbol(cadr(arg2))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ if (is_local_symbol(cdr(arg1)))
+ return(local_lint_let_ref);
+ return(lint_let_ref);
+ }
}
- return(let_ref_1(sc, e, s));
+ return(f);
}
@@ -6704,6 +7453,7 @@ static s7_pointer call_accessor(s7_scheme *sc, s7_pointer slot, s7_pointer old_v
static s7_pointer let_set_1(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value)
{
s7_pointer x, y;
+ static s7_pointer err = NULL;
if (is_keyword(symbol))
symbol = keyword_symbol(symbol);
@@ -6720,7 +7470,10 @@ static s7_pointer let_set_1(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7
else slot_set_value(y, value);
return(slot_value(y));
}
- return(sc->undefined);
+
+ if (!err) err = s7_make_permanent_string("let-set! ~A is not defined in ~A");
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, err, symbol, env)));
+ /* return(sc->undefined); */
}
for (x = env; is_let(x); x = outlet(x))
@@ -6747,7 +7500,11 @@ static s7_pointer let_set_1(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7
return(slot_value(y));
}
}
- return(sc->undefined);
+
+ if (!err) err = s7_make_permanent_string("let-set! ~A is not defined in ~A");
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, err, symbol, env)));
+ /* return(sc->undefined); */
+ /* not sure about this -- what's the most useful choice? */
}
s7_pointer s7_let_set(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value)
@@ -6775,6 +7532,101 @@ static s7_pointer g_let_set(s7_scheme *sc, s7_pointer args)
return(s7_let_set(sc, car(args), cadr(args), caddr(args)));
}
+static s7_pointer let_set_p_ppp(s7_pointer p1, s7_pointer p2, s7_pointer p3) {return(s7_let_set(cur_sc, p1, p2, p3));}
+
+static s7_pointer lint_let_set, local_lint_let_set;
+static s7_pointer g_lint_let_set_1(s7_scheme *sc, s7_pointer lt1, s7_pointer sym, s7_pointer val)
+{
+ s7_pointer lt, x, y;
+ static s7_pointer err = NULL;
+
+ lt = (is_pair(lt1)) ? cdr(lt1) : g_cdr(sc, set_plist_1(sc, lt1));
+ if (!is_let(lt))
+ return(wrong_type_argument_with_type(sc, sc->let_set_symbol, 1, lt, a_let_string));
+
+ if (lt == sc->rootlet)
+ {
+ y = global_slot(sym);
+ if (is_slot(y))
+ {
+ if (slot_has_accessor(y))
+ slot_set_value(y, call_accessor(sc, y, val));
+ else slot_set_value(y, val);
+ return(slot_value(y));
+ }
+ if (!err) err = s7_make_permanent_string("let-set! ~A is not defined in ~A");
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, err, sym, 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)
+ {
+ if (slot_has_accessor(y))
+ slot_set_value(y, call_accessor(sc, y, val));
+ else slot_set_value(y, val);
+ 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))
+ {
+ y = global_slot(sym);
+ if (is_slot(y))
+ {
+ if (slot_has_accessor(y))
+ slot_set_value(y, call_accessor(sc, y, val));
+ else slot_set_value(y, val);
+ return(slot_value(y));
+ }
+ }
+ if (!err) err = s7_make_permanent_string("let-set! ~A is not defined in ~A");
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, err, sym, lt)));
+}
+
+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))));
+}
+
+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))));
+}
+
+
+static s7_pointer let_set_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
+{
+ if (!ops) return(f);
+ if ((is_h_safe_c_c(expr)) &&
+ ((raw_opt1(expr) == lint_let_set) ||
+ (raw_opt1(expr) == local_lint_let_set)))
+ return(raw_opt1(expr));
+
+ if (optimize_op(expr) == HOP_SAFE_C_opSq_QS)
+ {
+ s7_pointer arg1, arg2, arg3;
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+ arg3 = cadddr(expr);
+ if ((car(arg1) == sc->cdr_symbol) &&
+ (is_symbol(cadr(arg2))) &&
+ (!is_immutable_symbol(cadr(arg2))) &&
+ (is_symbol(arg3)) &&
+ (!is_immutable_symbol(arg3)))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ if ((is_local_symbol(cdr(arg1))) &&
+ (is_local_symbol(cdddr(expr))))
+ return(local_lint_let_set);
+ return(lint_let_set);
+ }
+ }
+ return(f);
+}
+
static s7_pointer reverse_slots(s7_scheme *sc, s7_pointer list)
{
@@ -6923,7 +7775,7 @@ static s7_pointer g_outlet(s7_scheme *sc, s7_pointer args)
s7_pointer env;
env = car(args);
if (!is_let(env))
- method_or_bust_with_type(sc, env, sc->outlet_symbol, args, a_let_string, 0);
+ method_or_bust_with_type_one_arg(sc, env, sc->outlet_symbol, args, a_let_string);
if ((env == sc->rootlet) ||
(is_null(outlet(env))))
@@ -6931,6 +7783,7 @@ static s7_pointer g_outlet(s7_scheme *sc, s7_pointer args)
return(outlet(env));
}
+
static s7_pointer g_set_outlet(s7_scheme *sc, s7_pointer args)
{
/* (let ((a 1)) (let ((b 2)) (set! (outlet (curlet)) (rootlet)) ((curlet) 'a))) */
@@ -6977,11 +7830,10 @@ static s7_pointer find_symbol(s7_scheme *sc, s7_pointer symbol)
#if WITH_GCC && DEBUGGING
static s7_pointer find_symbol_unchecked_1(s7_scheme *sc, s7_pointer symbol)
#else
-static s7_pointer find_symbol_unchecked(s7_scheme *sc, s7_pointer symbol) /* find_symbol_checked includes the unbound_variable call */
+static inline s7_pointer find_symbol_unchecked(s7_scheme *sc, s7_pointer symbol) /* find_symbol_checked includes the unbound_variable call */
#endif
{
s7_pointer x;
- /* fprintf(stderr, "let_id: %lld, %s id: %lld\n", let_id(sc->envir), DISPLAY(symbol), symbol_id(symbol)); */
if (let_id(sc->envir) == symbol_id(symbol))
return(slot_value(local_slot(symbol)));
@@ -7000,12 +7852,15 @@ static s7_pointer find_symbol_unchecked(s7_scheme *sc, s7_pointer symbol) /* fin
return(slot_value(y));
}
+ /* for a global, the loop above is not hit. If a global is used locally (as a function parameter name for example),
+ * we run the entire search loop -- 10 times slower! So don't use a local variable or parameter named 'car!
+ */
x = global_slot(symbol);
if (is_slot(x))
return(slot_value(x));
#if WITH_GCC
- return(NULL);
+ return(NULL); /* much faster than various alternatives */
#else
return(unbound_variable(sc, symbol));
#endif
@@ -7037,17 +7892,6 @@ void s7_slot_set_real_value(s7_scheme *sc, s7_pointer slot, s7_double value)
}
-s7_double s7_slot_real_value(s7_scheme *sc, s7_pointer slot, const char *caller)
-{
- return(real_to_double(sc, slot_value(slot), caller));
-}
-
-s7_int s7_slot_integer_value(s7_pointer slot)
-{
- return(integer(slot_value(slot)));
-}
-
-
static s7_pointer find_local_symbol(s7_scheme *sc, s7_pointer symbol, s7_pointer e)
{
if (!is_let(e))
@@ -7064,16 +7908,6 @@ static s7_pointer find_local_symbol(s7_scheme *sc, s7_pointer symbol, s7_pointer
}
-static s7_pointer s7_local_slot(s7_scheme *sc, s7_pointer symbol)
-{
- s7_pointer y;
- for (y = let_slots(sc->envir); is_slot(y); y = next_slot(y))
- if (slot_symbol(y) == symbol)
- return(y);
- return(NULL);
-}
-
-
s7_pointer s7_symbol_value(s7_scheme *sc, s7_pointer sym)
{
s7_pointer x;
@@ -7088,12 +7922,21 @@ s7_pointer s7_symbol_value(s7_scheme *sc, s7_pointer sym)
s7_pointer s7_symbol_local_value(s7_scheme *sc, s7_pointer sym, s7_pointer local_env)
{
+ if ((local_env == sc->rootlet) || (is_global(sym)))
+ {
+ if (is_slot(global_slot(sym)))
+ return(slot_value(global_slot(sym)));
+ return(sc->undefined);
+ }
+
if (is_let(local_env))
{
s7_pointer x;
+
for (x = local_env; is_let(x); x = outlet(x))
{
s7_pointer y;
+
for (y = let_slots(x); is_slot(y); y = next_slot(y))
if (slot_symbol(y) == sym)
return(slot_value(y));
@@ -7131,14 +7974,6 @@ symbol sym in the given environment: (let ((x 32)) (symbol->value 'x)) -> 32"
if (!is_let(local_env))
method_or_bust_with_type(sc, local_env, sc->symbol_to_value_symbol, args, a_let_string, 2);
- if (local_env == sc->rootlet)
- {
- s7_pointer x;
- x = global_slot(sym);
- if (is_slot(x))
- return(slot_value(x));
- return(sc->undefined);
- }
return(s7_symbol_local_value(sc, sym, local_env));
}
@@ -7226,23 +8061,18 @@ static s7_pointer g_symbol_to_dynamic_value(s7_scheme *sc, s7_pointer args)
typedef bool (safe_sym_t)(s7_scheme *sc, s7_pointer sym, s7_pointer e);
-static s7_function all_x_eval(s7_scheme *sc, s7_pointer arg, s7_pointer e, safe_sym_t *checker);
+static s7_function all_x_eval(s7_scheme *sc, s7_pointer holder, s7_pointer e, safe_sym_t *checker);
static bool direct_memq(s7_pointer symbol, s7_pointer symbols)
{
s7_pointer x;
- for (x = symbols; is_pair(x); x = unchecked_cdr(x))
- {
- if (car(x) == symbol)
- return(true);
- x = cdr(x);
- if (unchecked_car(x) == symbol)
+ for (x = symbols; is_pair(x); x = cdr(x))
+ if (car(x) == symbol)
return(true);
- }
return(false);
}
-static bool indirect_memq(s7_pointer symbol, s7_pointer symbols)
+static bool direct_assq(s7_pointer symbol, s7_pointer symbols)
{ /* used only below in do_symbol_is_safe */
s7_pointer x;
for (x = symbols; is_pair(x); x = cdr(x))
@@ -7254,7 +8084,7 @@ static bool indirect_memq(s7_pointer symbol, s7_pointer symbols)
static bool do_symbol_is_safe(s7_scheme *sc, s7_pointer sym, s7_pointer e)
{
return((is_slot(global_slot(sym))) ||
- (indirect_memq(sym, e)) ||
+ (direct_assq(sym, e)) ||
(is_slot(find_symbol(sc, sym))));
}
@@ -7265,12 +8095,70 @@ static bool let_symbol_is_safe(s7_scheme *sc, s7_pointer sym, s7_pointer e)
static bool pair_symbol_is_safe(s7_scheme *sc, s7_pointer sym, s7_pointer e)
{
+ /* fprintf(stderr, "%s: %s %d %s\n", DISPLAY(sym), DISPLAY(global_slot(sym)), direct_memq(sym, e), DISPLAY(e)); */
return((is_slot(global_slot(sym))) || (direct_memq(sym, e)));
}
+static s7_pointer collect_variables(s7_scheme *sc, s7_pointer lst, s7_pointer e)
+{
+ /* collect local variable names from let/do (pre-error-check) */
+ s7_pointer p;
+ sc->w = e;
+ for (p = lst; is_pair(p); p = cdr(p))
+ if ((is_pair(car(p))) &&
+ (is_symbol(caar(p))))
+ sc->w = cons(sc, add_symbol_to_list(sc, caar(p)), sc->w);
+ return(sc->w);
+}
+
+static s7_pointer collect_parameters(s7_scheme *sc, s7_pointer lst, s7_pointer e)
+{
+ /* collect local variable names from lambda arglists (pre-error-check) */
+ s7_pointer p;
+ if (is_symbol(lst))
+ return(cons(sc, add_symbol_to_list(sc, lst), e));
+ sc->w = e;
+ for (p = lst; is_pair(p); p = cdr(p))
+ {
+ s7_pointer car_p;
+ car_p = car(p);
+ if (is_pair(car_p))
+ car_p = car(car_p);
+ if ((is_symbol(car_p)) &&
+ (!is_keyword(car_p)))
+ sc->w = cons(sc, add_symbol_to_list(sc, car_p), sc->w);
+ }
+ if (is_symbol(p)) /* rest arg */
+ sc->w = cons(sc, add_symbol_to_list(sc, p), sc->w);
+ return(sc->w);
+}
+
+
/* make macros and closures */
+typedef enum {OPT_F, OPT_T, OPT_OOPS} opt_t;
+static opt_t optimize(s7_scheme *sc, s7_pointer code, int hop, s7_pointer e);
+
+static void clear_all_optimizations(s7_scheme *sc, s7_pointer p)
+{
+ /* I believe that we would not have been optimized to begin with if the tree were circular,
+ * and this tree is supposed to be a function call + args -- a circular list here is a bug.
+ */
+ if (is_pair(p))
+ {
+ if ((is_optimized(p)) &&
+ ((optimize_op(p) & 1) == 0)) /* protect possibly shared code? Elsewhere we assume these aren't changed */
+ {
+ clear_optimized(p);
+ clear_optimize_op(p);
+ }
+ clear_all_optimizations(sc, cdr(p));
+ clear_all_optimizations(sc, car(p));
+ }
+}
+
+
static s7_pointer make_macro(s7_scheme *sc)
{
s7_pointer cx, mac;
@@ -7320,7 +8208,10 @@ static s7_pointer make_macro(s7_scheme *sc)
slot_set_value_with_hook(cx, mac);
else s7_make_slot(sc, sc->envir, sc->code, mac); /* was current but we've checked immutable already */
- optimize(sc, closure_body(mac), 0, sc->nil);
+ clear_symbol_list(sc); /* tracks names local to this macro */
+ if (optimize(sc, closure_body(mac), 1, collect_parameters(sc, closure_args(mac), sc->nil)) == OPT_OOPS)
+ clear_all_optimizations(sc, closure_body(mac));
+
sc->temp6 = sc->nil;
return(mac);
}
@@ -7333,18 +8224,11 @@ static s7_pointer make_closure(s7_scheme *sc, s7_pointer args, s7_pointer code,
s7_pointer x;
unsigned int typ;
+ if (type == T_CLOSURE)
+ typ = T_CLOSURE | T_COPY_ARGS;
+ else typ = T_CLOSURE_STAR;
if (is_safe_closure(code))
- {
- if (type == T_CLOSURE)
- typ = T_CLOSURE | T_PROCEDURE | T_SAFE_CLOSURE | T_COPY_ARGS;
- else typ = T_CLOSURE_STAR | T_PROCEDURE | T_SAFE_CLOSURE;
- }
- else
- {
- if (type == T_CLOSURE)
- typ = T_CLOSURE | T_PROCEDURE | T_COPY_ARGS;
- else typ = T_CLOSURE_STAR | T_PROCEDURE;
- }
+ typ |= T_SAFE_CLOSURE;
new_cell(sc, x, typ);
closure_set_args(x, args);
@@ -7363,8 +8247,8 @@ static s7_pointer make_closure(s7_scheme *sc, s7_pointer args, s7_pointer code,
do { \
unsigned int _T_; \
if (is_safe_closure(Code)) \
- _T_ = T_CLOSURE | T_PROCEDURE | T_SAFE_CLOSURE | T_COPY_ARGS; \
- else _T_ = T_CLOSURE | T_PROCEDURE | T_COPY_ARGS; \
+ _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); \
@@ -7379,8 +8263,8 @@ static s7_pointer make_closure(s7_scheme *sc, s7_pointer args, s7_pointer code,
do { \
unsigned int _T_; \
if (is_safe_closure(Code)) \
- _T_ = T_CLOSURE | T_PROCEDURE | T_SAFE_CLOSURE | T_COPY_ARGS; \
- else _T_ = T_CLOSURE | T_PROCEDURE | T_COPY_ARGS; \
+ _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); \
@@ -7428,7 +8312,7 @@ static s7_pointer copy_tree(s7_scheme *sc, s7_pointer tree)
(is_pair(cdr(tree))) ? COPY_TREE(cdr(tree)) : cdr(tree)));
}
-static void annotate_expansion(s7_pointer p)
+static inline void annotate_expansion(s7_pointer p)
{
if ((is_symbol(car(p))) &&
(is_pair(cdr(p))))
@@ -7448,6 +8332,7 @@ static void annotate_expansion(s7_pointer p)
static s7_pointer copy_body(s7_scheme *sc, s7_pointer p)
{
+ /* ideally we'd use tree_len here, but it currently does not protect against cycles */
if (8192 >= (sc->free_heap_top - sc->free_heap))
{
gc(sc);
@@ -7561,6 +8446,16 @@ bool s7_is_defined(s7_scheme *sc, const char *name)
return(false);
}
+static bool is_defined_b_p(s7_pointer p)
+{
+ if (!is_symbol(p))
+ simple_wrong_type_argument(cur_sc, cur_sc->is_defined_symbol, p, T_SYMBOL);
+ return(is_slot(find_symbol(cur_sc, p)));
+}
+
+static bool is_defined_b_pp(s7_pointer p, s7_pointer e) {return(g_is_defined(cur_sc, set_plist_2(cur_sc, p, e)) != cur_sc->F);}
+
+
void s7_define(s7_scheme *sc, s7_pointer envir, s7_pointer symbol, s7_pointer value)
{
@@ -7598,7 +8493,7 @@ s7_pointer s7_define_variable_with_documentation(s7_scheme *sc, const char *name
s7_pointer sym;
sym = s7_define_variable(sc, name, value);
symbol_set_has_help(sym);
- symbol_help(sym) = copy_string(help);
+ symbol_set_help(sym, copy_string(help));
return(sym);
}
@@ -7621,7 +8516,7 @@ s7_pointer s7_define_constant_with_documentation(s7_scheme *sc, const char *name
s7_pointer sym;
sym = s7_define_constant(sc, name, value);
symbol_set_has_help(sym);
- symbol_help(sym) = copy_string(help);
+ symbol_set_help(sym, copy_string(help));
return(value); /* inconsistent with variable above, but consistent with define_function? */
}
@@ -7644,7 +8539,7 @@ char *s7_symbol_set_documentation(s7_scheme *sc, s7_pointer sym, const char *new
(symbol_help(sym)))
free(symbol_help(sym));
symbol_set_has_help(sym);
- symbol_help(sym) = copy_string(new_doc);
+ symbol_set_help(sym, copy_string(new_doc));
return(symbol_help(sym));
}
@@ -7688,18 +8583,10 @@ static s7_pointer g_string_to_keyword(s7_scheme *sc, s7_pointer args)
#define Q_string_to_keyword s7_make_signature(sc, 2, sc->is_keyword_symbol, sc->is_string_symbol)
if (!is_string(car(args)))
- method_or_bust(sc, car(args), sc->string_to_keyword_symbol, args, T_STRING, 0);
+ method_or_bust_one_arg(sc, car(args), sc->string_to_keyword_symbol, args, T_STRING);
return(s7_make_keyword(sc, string_value(car(args))));
}
-static s7_pointer c_string_to_keyword(s7_scheme *sc, s7_pointer x)
-{
- if (!is_string(x))
- method_or_bust(sc, x, sc->string_to_keyword_symbol, list_1(sc, x), T_STRING, 0);
- return(s7_make_keyword(sc, string_value(x)));
-}
-
-
/* -------------------------------- keyword->symbol -------------------------------- */
static s7_pointer g_keyword_to_symbol(s7_scheme *sc, s7_pointer args)
{
@@ -7709,14 +8596,7 @@ static s7_pointer g_keyword_to_symbol(s7_scheme *sc, s7_pointer args)
s7_pointer sym;
sym = car(args);
if (!is_keyword(sym))
- method_or_bust_with_type(sc, sym, sc->keyword_to_symbol_symbol, args, make_string_wrapper(sc, "a keyword"), 0);
- return(keyword_symbol(sym));
-}
-
-static s7_pointer c_keyword_to_symbol(s7_scheme *sc, s7_pointer sym)
-{
- if (!is_keyword(sym))
- method_or_bust_with_type(sc, sym, sc->keyword_to_symbol_symbol, list_1(sc, sym), make_string_wrapper(sc, "a keyword"), 0);
+ method_or_bust_with_type_one_arg(sc, sym, sc->keyword_to_symbol_symbol, args, make_string_wrapper(sc, "a keyword"));
return(keyword_symbol(sym));
}
@@ -7728,18 +8608,10 @@ static s7_pointer g_symbol_to_keyword(s7_scheme *sc, s7_pointer args)
#define Q_symbol_to_keyword s7_make_signature(sc, 2, sc->is_keyword_symbol, sc->is_symbol_symbol)
if (!is_symbol(car(args)))
- method_or_bust(sc, car(args), sc->symbol_to_keyword_symbol, args, T_SYMBOL, 0);
+ method_or_bust_one_arg(sc, car(args), sc->symbol_to_keyword_symbol, args, T_SYMBOL);
return(s7_make_keyword(sc, symbol_name(car(args))));
}
-static s7_pointer c_symbol_to_keyword(s7_scheme *sc, s7_pointer sym)
-{
- if (!is_symbol(sym))
- method_or_bust(sc, sym, sc->symbol_to_keyword_symbol, list_1(sc, sym), T_SYMBOL, 0);
- return(s7_make_keyword(sc, symbol_name(sym)));
-}
-
-
/* ---------------- uninterpreted pointers ---------------- */
@@ -7779,6603 +8651,5674 @@ static s7_pointer g_is_c_pointer(s7_scheme *sc, s7_pointer args)
check_boolean_method(sc, s7_is_c_pointer, sc->is_c_pointer_symbol, args);
}
-
-static s7_pointer c_c_pointer(s7_scheme *sc, s7_pointer arg)
+static s7_pointer g_c_pointer(s7_scheme *sc, s7_pointer args)
{
+ #define H_c_pointer "(c-pointer int) returns a c-pointer object."
+ #define Q_c_pointer s7_make_signature(sc, 2, sc->is_c_pointer_symbol, sc->is_integer_symbol)
+
+ s7_pointer arg;
ptr_int 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")) */
return(s7_make_c_pointer(sc, (void *)p));
}
-static s7_pointer g_c_pointer(s7_scheme *sc, s7_pointer args)
-{
- #define H_c_pointer "(c-pointer int) returns a c-pointer object."
- #define Q_c_pointer s7_make_signature(sc, 2, sc->is_c_pointer_symbol, sc->is_integer_symbol)
- return(c_c_pointer(sc, car(args)));
-}
-
+/* -------------------------------- continuations and gotos -------------------------------- */
-/* --------------------------------- rf (CLM optimizer) ----------------------------------------------- */
-
-s7_pointer *s7_xf_start(s7_scheme *sc)
+static s7_pointer g_is_continuation(s7_scheme *sc, s7_pointer args)
{
- sc->cur_rf->cur = sc->cur_rf->data;
- return(sc->cur_rf->cur);
-}
+ #define H_is_continuation "(continuation? obj) returns #t if obj is a continuation"
+ #define Q_is_continuation pl_bt
-static void resize_xf(s7_scheme *sc, xf_t *rc)
-{
- /* if we're saving pointers into this array (for later fill-in), this realloc
- * means earlier (backfill) pointers are not valid, so we have to save the position to be
- * filled, not the pointer to it.
+ check_boolean_method(sc, is_continuation, sc->is_continuation_symbol, args);
+ /* is this the right thing? It returns #f for call-with-exit ("goto") because
+ * that form of continuation can't continue (via a jump back to its context).
+ * how to recognize the call-with-exit function? "goto" is an internal name.
*/
- s7_int loc;
- loc = rc->cur - rc->data;
-
-#if DEBUGGING
- int i;
- s7_pointer *old;
- old = rc->data;
- rc->data = (s7_pointer *)calloc(rc->size * 2, sizeof(s7_pointer));
- for (i = 0; i < rc->size; i++)
- {
- rc->data[i] = old[i];
- old[i] = NULL;
- }
-#else
- rc->data = (s7_pointer *)realloc(rc->data, rc->size * 2 * sizeof(s7_pointer));
-#endif
- rc->cur = (s7_pointer *)(rc->data + loc);
- rc->size *= 2;
- rc->end = (s7_pointer *)(rc->data + rc->size);
}
-#define rc_loc(sc) (ptr_int)(sc->cur_rf->cur - sc->cur_rf->data)
-#define rc_go(sc, loc) (s7_pointer *)(sc->cur_rf->data + loc)
+static bool s7_is_continuation(s7_pointer p) {return(is_continuation(p));}
-#define xf_init(N) do {rc = sc->cur_rf; if ((rc->cur + N) >= rc->end) resize_xf(sc, rc);} while (0)
-#define xf_store(Val) do {(*(rc->cur)) = Val; rc->cur++;} while (0)
-#define xf_save_loc(Loc) do {Loc = rc->cur - rc->data; rc->cur++;} while (0)
-#define xf_save_loc2(Loc1, Loc2) do {Loc1 = rc->cur - rc->data; Loc2 = Loc1 + 1; rc->cur += 2;} while (0)
-#define xf_save_loc3(Loc1, Loc2, Loc3) do {Loc1 = rc->cur - rc->data; Loc2 = Loc1 + 1; Loc3 = Loc2 + 1; rc->cur += 3;} while (0)
-#define xf_store_at(Loc, Val) rc->data[Loc] = Val
-#define xf_go(loc) rc->cur = (s7_pointer *)(rc->data + loc)
-/* #define xf_loc() (ptr_int)(rc->cur - rc->data) */
-s7_int s7_xf_store(s7_scheme *sc, s7_pointer val)
+static s7_pointer protected_list_copy(s7_scheme *sc, s7_pointer a)
{
- s7_pointer *cur;
- xf_t *rc;
- rc = sc->cur_rf;
- if (rc->cur == rc->end)
- resize_xf(sc, rc);
- cur = rc->cur++;
- (*cur) = val;
- return(cur - rc->data);
-}
+ s7_pointer slow, fast, p;
-void s7_xf_store_at(s7_scheme *sc, s7_int index, s7_pointer val)
-{
- sc->cur_rf->data[index] = val;
-}
+ sc->w = cons(sc, car(a), sc->nil);
+ p = sc->w;
-void *s7_xf_new(s7_scheme *sc, s7_pointer e)
-{
- xf_t *result;
- if (sc->rf_free_list)
- {
- result = sc->rf_free_list;
- sc->rf_free_list = sc->rf_free_list->next;
- }
- else
- {
- result = (xf_t *)malloc(sizeof(xf_t));
- result->size = 8;
- result->data = (s7_pointer *)calloc(result->size, sizeof(s7_pointer));
- result->end = (s7_pointer *)(result->data + result->size);
- }
- if (sc->cur_rf)
+ slow = fast = cdr(a);
+ while (true)
{
- sc->cur_rf->next = sc->rf_stack;
- sc->rf_stack = sc->cur_rf;
- }
- sc->cur_rf = result;
- result->cur = result->data;
- result->e = e; /* set only here? */
- result->gc_list = NULL;
- return((void *)result);
-}
-
-static void s7_xf_clear(s7_scheme *sc)
-{
- while (sc->cur_rf) {s7_xf_free(sc);}
-}
+ if (!is_pair(fast))
+ {
+ if (is_null(fast))
+ return(sc->w);
+ set_cdr(p, fast);
+ return(sc->w);
+ }
-bool s7_xf_is_stepper(s7_scheme *sc, s7_pointer sym)
-{
- s7_pointer e, p;
- e = sc->cur_rf->e;
- if (!e) return(false);
- for (p = let_slots(e); is_slot(p); p = next_slot(p))
- if (slot_symbol(p) == sym)
- return(true);
- return(false);
-}
+ set_cdr(p, cons(sc, car(fast), sc->nil));
+ p = cdr(p);
+ fast = cdr(fast);
+ if (!is_pair(fast))
+ {
+ if (is_null(fast))
+ return(sc->w);
+ set_cdr(p, fast);
+ return(sc->w);
+ }
+ /* if unrolled further, it's a lot slower? */
+ set_cdr(p, cons(sc, car(fast), sc->nil));
+ p = cdr(p);
-static void xf_clear_list(s7_scheme *sc, xf_t *r)
-{
- gc_obj *p, *op;
- for (p = r->gc_list; p; p = op)
- {
- op = p->nxt;
- free(p);
+ fast = cdr(fast);
+ slow = cdr(slow);
+ if (fast == slow)
+ {
+ /* try to preserve the original cyclic structure */
+ s7_pointer p1, f1, p2, f2;
+ set_match_pair(a);
+ for (p1 = sc->w, f1 = a; !(is_matched_pair(cdr(f1))); f1 = cdr(f1), p1 = cdr(p1))
+ set_match_pair(f1);
+ for (p2 = sc->w, f2 = a; cdr(f1) != f2; f2 = cdr(f2), p2 = cdr(p2))
+ clear_match_pair(f2);
+ for (f1 = f2; is_pair(f1); f1 = cdr(f1), f2 = cdr(f2))
+ {
+ clear_match_pair(f1);
+ f1 = cdr(f1);
+ clear_match_pair(f1);
+ if (f1 == f2) break;
+ }
+ if (is_null(p1))
+ set_cdr(p2, p2);
+ else set_cdr(p1, p2);
+ return(sc->w);
+ }
}
- r->gc_list = NULL;
+ return(sc->w);
}
-void *s7_xf_detach(s7_scheme *sc)
-{
- xf_t *r;
- r = sc->cur_rf;
- sc->cur_rf = sc->rf_stack;
- if (sc->rf_stack)
- sc->rf_stack = sc->rf_stack->next;
- return((void *)r);
-}
-void s7_xf_attach(s7_scheme *sc, void *ur)
+static s7_pointer copy_counter(s7_scheme *sc, s7_pointer obj)
{
- xf_t *r = (xf_t *)ur;
- r->next = sc->rf_free_list;
- sc->rf_free_list = r;
- xf_clear_list(sc, r);
+ s7_pointer nobj;
+ new_cell(sc, nobj, T_COUNTER);
+ counter_set_result(nobj, counter_result(obj));
+ counter_set_list(nobj, counter_list(obj));
+ counter_set_capture(nobj, counter_capture(obj));
+ counter_set_let(nobj, counter_let(obj));
+ counter_set_slots(nobj, counter_slots(obj));
+ return(nobj);
}
-s7_pointer *s7_xf_top(s7_scheme *sc, void *ur)
+
+static s7_pointer copy_stack(s7_scheme *sc, s7_pointer old_v, int top)
{
- xf_t *r = (xf_t *)ur;
- return(r->data);
-}
+ #define CC_INITIAL_STACK_SIZE 256 /* 128 is too small here */
+ int i, len;
+ s7_pointer new_v;
+ s7_pointer *nv, *ov;
+ /* stacks can grow temporarily, so sc->stack_size grows, but we don't normally need all that
+ * leftover space here, so choose the original stack size if it's smaller.
+ */
+ len = vector_length(old_v);
+ if (len > CC_INITIAL_STACK_SIZE)
+ {
+ if (top < CC_INITIAL_STACK_SIZE / 4)
+ len = CC_INITIAL_STACK_SIZE;
+ }
+ else
+ {
+ if (len < CC_INITIAL_STACK_SIZE)
+ len = CC_INITIAL_STACK_SIZE;
+ }
+ if ((int)(sc->free_heap_top - sc->free_heap) < (int)(sc->heap_size / 4)) gc(sc);
+ /* this gc call is needed if there are lots of call/cc's -- by pure bad luck
+ * we can end up hitting the end of the gc free list time after time while
+ * in successive copy_stack's below, causing s7 to core up until it runs out of memory.
+ */
-static s7_pointer xf_push(s7_scheme *sc, s7_pointer obj)
-{
- gc_obj *p;
- p = (gc_obj *)malloc(sizeof(gc_obj));
- p->nxt = sc->cur_rf->gc_list;
- sc->cur_rf->gc_list = p;
- p->p = obj;
- return(obj);
-}
+ new_v = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
+ set_type(new_v, T_STACK);
+ temp_stack_top(new_v) = top;
+ nv = vector_elements(new_v);
+ ov = vector_elements(old_v);
+ if (len > 0)
+ memcpy((void *)nv, (void *)ov, len * sizeof(s7_pointer));
-#if WITH_ADD_PF
-static s7_pointer xf_pop(s7_scheme *sc)
-{
- if ((sc->cur_rf) &&
- (sc->cur_rf->gc_list))
+ s7_gc_on(sc, false);
+ for (i = 2; i < top; i += 4)
{
s7_pointer p;
- gc_obj *g;
- g = sc->cur_rf->gc_list;
- p = g->p;
- sc->cur_rf->gc_list = g->nxt;
- free(g);
- return(p);
+ p = ov[i]; /* args */
+ if (is_pair(p)) /* args need not be a list (it can be a port or #f, etc) */
+ nv[i] = protected_list_copy(sc, p); /* args (copy is needed -- see s7test.scm) */
+ /* lst can be dotted or circular here. The circular list only happens in a case like:
+ * (dynamic-wind (lambda () (eq? (let ((lst (cons 1 2))) (set-cdr! lst lst) lst) (call/cc (lambda (k) k)))) (lambda () #f) (lambda () #f))
+ */
+ else
+ {
+ if (is_counter(p)) /* these can only occur in this context */
+ nv[i] = copy_counter(sc, p);
+ }
}
- return(NULL);
+ s7_gc_on(sc, true);
+ return(new_v);
}
-#endif
-void s7_xf_free(s7_scheme *sc)
+
+static s7_pointer make_goto(s7_scheme *sc)
{
- sc->cur_rf->next = sc->rf_free_list;
- sc->rf_free_list = sc->cur_rf;
- xf_clear_list(sc, sc->cur_rf);
- sc->cur_rf = sc->rf_stack;
- if (sc->rf_stack)
- sc->rf_stack = sc->rf_stack->next;
+ 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_active(x) = true;
+ return(x);
}
-static s7_if_t implicit_int_vector_ref(s7_scheme *sc, s7_pointer expr);
-static s7_rf_t implicit_float_vector_ref(s7_scheme *sc, s7_pointer expr);
-static s7_pf_t implicit_pf_sequence_ref(s7_scheme *sc, s7_pointer expr);
-static s7_pf_t implicit_gf_sequence_ref(s7_scheme *sc, s7_pointer expr);
-
-#if WITH_OPTIMIZATION
-static s7_pf_t implicit_pf_sequence_set(s7_scheme *sc, s7_pointer v, s7_pointer ind, s7_pointer val);
-static s7_pf_t implicit_gf_sequence_set(s7_scheme *sc, s7_pointer v, s7_pointer ind, s7_pointer val);
-#endif
-
-/* set cases are via set_if/set_rf -- but set_gp|pf would need to be restricted to non-symbol settees */
-/* need to make sure sequence is not a step var, also set cases */
-
-static s7_rp_t rf_function(s7_pointer f)
+static s7_pointer *copy_op_stack(s7_scheme *sc)
{
- switch (type(f))
- {
- case T_C_FUNCTION_STAR: case T_C_FUNCTION: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
- return(c_function_rp(f));
-
- case T_FLOAT_VECTOR:
- return(implicit_float_vector_ref);
-
- case T_C_OBJECT:
- return(c_object_rp(f));
-
- case T_SYNTAX:
- return(syntax_rp(f));
- }
- return(NULL);
+ int len;
+ s7_pointer *ops;
+ ops = (s7_pointer *)malloc(sc->op_stack_size * sizeof(s7_pointer));
+ len = (int)(sc->op_stack_now - sc->op_stack);
+ if (len > 0)
+ memcpy((void *)ops, (void *)(sc->op_stack), len * sizeof(s7_pointer));
+ return(ops);
}
-static s7_ip_t if_function(s7_pointer f)
-{
- switch (type(f))
- {
- case T_C_FUNCTION_STAR: case T_C_FUNCTION: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
- return(c_function_ip(f));
-
- case T_INT_VECTOR:
- return(implicit_int_vector_ref);
- case T_C_OBJECT:
- return(c_object_ip(f));
+/* (with-baffle . body) calls body guaranteeing that there can be no jumps into the
+ * middle of it from outside -- no outer evaluation of a continuation can jump across this
+ * barrier: The flip-side of call-with-exit.
+ * It sets a T_BAFFLE var in a new env, that has a unique key. Call/cc then always
+ * checks the env chain for any such variable, saving the localmost. Apply of a continuation
+ * looks for such a saved variable, if none, go ahead, else check the current env (before the
+ * jump) for that variable. If none, error, else go ahead. This is different from a delimited
+ * continuation which simply delimits the extent of the continuation (why not use lambda?) -- we want to block it
+ * from coming at us from some unknown place.
+ */
- case T_SYNTAX:
- return(syntax_ip(f));
- }
- return(NULL);
+static s7_pointer make_baffle(s7_scheme *sc)
+{
+ s7_pointer x;
+ new_cell(sc, x, T_BAFFLE);
+ baffle_key(x) = sc->baffle_ctr++;
+ return(x);
}
-static s7_pp_t pf_function(s7_pointer f)
+
+static bool find_baffle(s7_scheme *sc, int key)
{
- switch (type(f))
- {
- case T_C_FUNCTION_STAR: case T_C_FUNCTION: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
- return(c_function_pp(f));
+ /* search backwards through sc->envir for sc->baffle_symbol with key as value
+ */
+ s7_pointer x, y;
+ for (x = sc->envir; is_let(x); x = outlet(x))
+ for (y = let_slots(x); is_slot(y); y = next_slot(y))
+ if ((slot_symbol(y) == sc->baffle_symbol) &&
+ (baffle_key(slot_value(y)) == key))
+ return(true);
- case T_PAIR: case T_STRING: case T_VECTOR: case T_HASH_TABLE: case T_LET:
- return(implicit_pf_sequence_ref);
+ if ((is_slot(global_slot(sc->baffle_symbol))) &&
+ (is_baffle(slot_value(global_slot(sc->baffle_symbol)))))
+ return(baffle_key(slot_value(global_slot(sc->baffle_symbol))) == key);
- case T_SYNTAX:
- return(syntax_pp(f));
- }
- return(NULL);
+ return(false);
}
-static s7_pp_t gf_function(s7_pointer f)
+
+static int find_any_baffle(s7_scheme *sc)
{
- switch (type(f))
+ /* search backwards through sc->envir for any sc->baffle_symbol
+ */
+ if (sc->baffle_ctr > 0)
{
- case T_C_FUNCTION_STAR: case T_C_FUNCTION: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
- return(c_function_gp(f));
+ s7_pointer x, y;
+ for (x = sc->envir; is_let(x); x = outlet(x))
+ for (y = let_slots(x); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == sc->baffle_symbol)
+ return(baffle_key(slot_value(y)));
- case T_PAIR: case T_STRING: case T_VECTOR: case T_HASH_TABLE: case T_LET: case T_C_OBJECT: case T_INT_VECTOR: case T_FLOAT_VECTOR:
- return(implicit_gf_sequence_ref);
+ if ((is_slot(global_slot(sc->baffle_symbol))) &&
+ (is_baffle(slot_value(global_slot(sc->baffle_symbol)))))
+ return(baffle_key(slot_value(global_slot(sc->baffle_symbol))));
}
- return(NULL);
+ return(-1);
}
-s7_rp_t s7_rf_function(s7_scheme *sc, s7_pointer func) {return(rf_function(func));}
-s7_ip_t s7_if_function(s7_scheme *sc, s7_pointer func) {return(if_function(func));}
-s7_pp_t s7_pf_function(s7_scheme *sc, s7_pointer func) {return(pf_function(func));}
-s7_pp_t s7_gf_function(s7_scheme *sc, s7_pointer func) {return(gf_function(func));}
-void s7_rf_set_function(s7_pointer f, s7_rp_t rp)
+s7_pointer s7_make_continuation(s7_scheme *sc)
{
-#if WITH_OPTIMIZATION
- if (!is_c_function(f)) return;
- c_function_rp(f) = rp;
-#else
- return;
-#endif
-}
+ s7_pointer x, stack;
+ int loc;
-void s7_if_set_function(s7_pointer f, s7_ip_t ip)
-{
-#if WITH_OPTIMIZATION
- if (!is_c_function(f)) return;
- c_function_ip(f) = ip;
-#else
- return;
-#endif
-}
+ loc = s7_stack_top(sc);
+ stack = copy_stack(sc, sc->stack, loc);
+ sc->temp8 = stack;
-void s7_pf_set_function(s7_pointer f, s7_pp_t pp)
-{
-#if WITH_OPTIMIZATION
- if (!is_c_function(f)) return;
- c_function_pp(f) = pp;
-#else
- return;
-#endif
-}
+ new_cell(sc, x, T_CONTINUATION);
+ continuation_data(x) = (continuation_t *)malloc(sizeof(continuation_t));
+ continuation_set_stack(x, stack);
+ continuation_stack_size(x) = vector_length(continuation_stack(x)); /* copy_stack can return a smaller stack than the current one */
+ 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_size(x) = sc->op_stack_size;
+ continuation_key(x) = find_any_baffle(sc);
+ sc->temp8 = sc->nil;
-void s7_gf_set_function(s7_pointer f, s7_pp_t gp)
-{
-#if WITH_OPTIMIZATION
- if (!is_c_function(f)) return;
- c_function_gp(f) = gp;
-#else
- return;
-#endif
+ add_continuation(sc, x);
+ return(x);
}
-static s7_rp_t pair_to_rp(s7_scheme *sc, s7_pointer expr)
+static void let_temp_done(s7_scheme *sc, s7_pointer args, s7_pointer code)
{
- s7_pointer val_sym, val;
- val_sym = car(expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- if (s7_local_slot(sc, val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- return(s7_rf_function(sc, val));
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->args = args;
+ sc->code = code;
+ eval(sc, OP_LET_TEMP_DONE);
}
-static s7_ip_t pair_to_ip(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer val_sym, val;
- val_sym = car(expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- if (s7_local_slot(sc, val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- return(s7_if_function(sc, val));
-}
-static s7_pp_t pair_to_pp(s7_scheme *sc, s7_pointer expr)
+static bool check_for_dynamic_winds(s7_scheme *sc, s7_pointer c)
{
- s7_pointer val_sym, val;
- val_sym = car(expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- if (s7_local_slot(sc, val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- return(s7_pf_function(sc, val));
-}
+ int i, s_base = 0, c_base = -1;
+ opcode_t op;
-static s7_pp_t pair_to_gp(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer val_sym, val;
- val_sym = car(expr);
- if (!s7_is_symbol(val_sym)) return(NULL);
- if (s7_local_slot(sc, val_sym)) return(NULL);
- val = s7_symbol_value(sc, val_sym);
- return(s7_gf_function(sc, val));
-}
+ for (i = s7_stack_top(sc) - 1; i > 0; i -= 4)
+ {
+ op = stack_op(sc->stack, i);
+ switch (op)
+ {
+ case OP_DYNAMIC_WIND:
+ case OP_LET_TEMP_DONE:
+ {
+ s7_pointer x;
+ int 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) ||
+ (stack_op(continuation_stack(c), j) == OP_LET_TEMP_DONE)) &&
+ (x == stack_code(continuation_stack(c), j)))
+ {
+ s_base = i;
+ c_base = j;
+ break;
+ }
-static s7_pf_t xf_opt(s7_scheme *sc, s7_pointer lp)
-{
- s7_int loc;
- s7_pointer f;
- s7_rp_t rp;
- s7_ip_t xp;
- s7_pp_t pp;
- xf_t *rc;
+ if (s_base != 0)
+ break;
- f = find_symbol(sc, car(lp));
- if (!is_slot(f)) return(NULL);
- f = slot_value(f);
+ if (op == OP_DYNAMIC_WIND)
+ {
+ if (dynamic_wind_state(x) == DWIND_BODY)
+ {
+ dynamic_wind_state(x) = DWIND_FINISH;
+ if (dynamic_wind_out(x) != sc->F)
+ {
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->args = sc->nil;
+ sc->code = dynamic_wind_out(x);
+ eval(sc, OP_APPLY);
+ }
+ }
+ }
+ else let_temp_done(sc, stack_args(sc->stack, i), stack_code(sc->stack, i));
+ }
+ break;
- xf_init(3);
- xf_save_loc(loc);
+ case OP_BARRIER:
+ if (i > continuation_stack_top(c)) /* otherwise it's some unproblematic outer eval-string? */
+ return(false); /* but what if we've already evaluated a dynamic-wind closer? */
+ break;
- xp = if_function(f);
- if (xp)
- {
- s7_if_t xf;
- xf = xp(sc, lp);
- if (xf)
- {
- xf_store_at(loc, (s7_pointer)xf);
- return((s7_pf_t)xf);
- }
- xf_go(loc + 1);
- }
+ case OP_DEACTIVATE_GOTO: /* here we're jumping out of an unrelated call-with-exit block */
+ if (i > continuation_stack_top(c))
+ call_exit_active(stack_args(sc->stack, i)) = false;
+ break;
- rp = rf_function(f);
- if (rp)
- {
- s7_rf_t rf;
- rf = rp(sc, lp);
- if (rf)
- {
- xf_store_at(loc, (s7_pointer)rf);
- return((s7_pf_t)rf);
+ default:
+ break;
}
- xf_go(loc + 1);
}
- pp = pf_function(f);
- if (pp)
+ for (i = c_base + 4; i < continuation_stack_top(c); i += 4)
{
- s7_pf_t pf;
- pf = pp(sc, lp);
- if (pf)
- {
- xf_store_at(loc, (s7_pointer)pf);
- return(pf);
- }
- xf_go(loc + 1);
- }
+ op = stack_op(continuation_stack(c), i);
- pp = gf_function(f);
- if (pp)
- {
- s7_pf_t pf;
- pf = pp(sc, lp);
- if (pf)
+ if (op == OP_DYNAMIC_WIND)
{
- xf_store_at(loc, (s7_pointer)pf);
- return(pf);
- }
- }
- return(NULL);
-}
-
-#if 0
-static s7_pointer if_to_pf(s7_scheme *sc, s7_pointer **p)
-{
- s7_if_t xf;
- s7_int x;
- xf = (s7_if_t)(**p); (*p)++;
- x = xf(sc, p);
- return(make_integer(sc, x));
-}
-
-static s7_pointer rf_to_pf(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t rf;
- s7_double x;
- rf = (s7_rf_t)(**p); (*p)++;
- x = rf(sc, p);
- return(make_real(sc, x));
-}
-
-static s7_pf_t pf_opt(s7_scheme *sc, s7_pointer lp)
-{
- s7_int loc, loc1;
- s7_pointer f;
- s7_rp_t rp;
- s7_ip_t xp;
- s7_pp_t pp;
- xf_t *rc;
-
- f = find_symbol(sc, car(lp));
- if (!is_slot(f)) return(NULL);
- f = slot_value(f);
-
- xf_init(3);
- xf_save_loc(loc);
-
- xp = if_function(f);
- if (xp)
- {
- s7_if_t xf;
- xf_save_loc(loc1);
- xf = xp(sc, lp);
- if (xf)
- {
- xf_store_at(loc, (s7_pointer)if_to_pf);
- xf_store_at(loc1, (s7_pointer)xf);
- return((s7_pf_t)if_to_pf);
- }
- xf_go(loc + 1);
- }
-
- rp = rf_function(f);
- if (rp)
- {
- s7_rf_t rf;
- xf_save_loc(loc1);
- rf = rp(sc, lp);
- if (rf)
- {
- xf_store_at(loc, (s7_pointer)rf_to_pf);
- xf_store_at(loc1, (s7_pointer)rf);
- return((s7_pf_t)rf_to_pf);
+ s7_pointer x;
+ x = stack_code(continuation_stack(c), i);
+ if (dynamic_wind_in(x) != sc->F)
+ {
+ /* this can cause an infinite loop if the call/cc is trying to jump back into
+ * a dynamic-wind init function -- it's even possible to trick with-baffle!
+ * I can't find any fool-proof way to catch this problem.
+ */
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->args = sc->nil;
+ sc->code = dynamic_wind_in(x);
+ eval(sc, OP_APPLY);
+ }
+ dynamic_wind_state(x) = DWIND_BODY;
}
- xf_go(loc + 1);
- }
-
- pp = pf_function(f);
- if (pp)
- {
- s7_pf_t pf;
- pf = pp(sc, lp);
- if (pf)
+ else
{
- xf_store_at(loc, (s7_pointer)pf);
- return(pf);
+ if (op == OP_DEACTIVATE_GOTO)
+ call_exit_active(stack_args(continuation_stack(c), i)) = true;
+ else
+ {
+ if (op == OP_LET_TEMP_DONE)
+ let_temp_done(sc, stack_args(continuation_stack(c), i), stack_code(continuation_stack(c), i));
+ }
}
}
- return(NULL);
+ return(true);
}
-#endif
-static s7_double rf_c(s7_scheme *sc, s7_pointer **p)
-{
- s7_double x;
- x = s7_number_to_real(sc, **p); (*p)++;
- return(x);
-}
-static s7_double rf_s(s7_scheme *sc, s7_pointer **p)
+static bool call_with_current_continuation(s7_scheme *sc)
{
- s7_double x;
- x = s7_number_to_real(sc, slot_value(**p)); (*p)++;
- return(x);
-}
+ s7_pointer c;
+ c = sc->code;
-static bool arg_to_rf(s7_scheme *sc, s7_pointer a1, s7_int in_loc)
-{
- s7_int loc;
- xf_t *rc;
+ /* check for (baffle ...) blocking the current attempt to continue */
+ if ((continuation_key(c) >= 0) &&
+ (!(find_baffle(sc, continuation_key(c))))) /* should this raise an error? */
+ return(false);
- xf_init(2);
- if (in_loc == -1)
- xf_save_loc(loc);
- else loc = in_loc;
+ if (!check_for_dynamic_winds(sc, c)) /* if OP_BARRIER on stack deeper than continuation top(?), but can this happen? (it doesn't in s7test) */
+ return(true);
- if (is_pair(a1))
- {
- s7_rp_t rp;
- s7_rf_t rf;
- rp = pair_to_rp(sc, a1);
- if (!rp) return(false);
- rf = rp(sc, a1);
- if (!rf) return(false);
- xf_store_at(loc, (s7_pointer)rf);
- return(true);
- }
+ /* we push_stack sc->code before calling an embedded eval above, so sc->code should still be c here, etc
+ */
+ sc->stack = copy_stack(sc, continuation_stack(c), continuation_stack_top(c));
+ sc->stack_size = continuation_stack_size(c);
+ sc->stack_start = vector_elements(sc->stack);
+ sc->stack_end = (s7_pointer *)(sc->stack_start + continuation_stack_top(c));
+ sc->stack_resize_trigger = (s7_pointer *)(sc->stack_start + sc->stack_size / 2);
- if (is_symbol(a1))
- {
- s7_pointer slot;
- slot = s7_slot(sc, a1);
- if ((is_slot(slot)) &&
- (is_real(slot_value(slot))))
- {
- xf_store(slot);
- xf_store_at(loc, (s7_pointer)rf_s);
- return(true);
- }
- return(false);
- }
+ {
+ int i, top;
+ top = continuation_op_loc(c);
+ sc->op_stack_now = (s7_pointer *)(sc->op_stack + top);
+ sc->op_stack_size = continuation_op_size(c);
+ sc->op_stack_end = (s7_pointer *)(sc->op_stack + sc->op_stack_size);
+ for (i = 0; i < top; i++)
+ sc->op_stack[i] = continuation_op_stack(c)[i];
+ }
- if (is_real(a1))
+ if (is_null(sc->args))
+ sc->value = sc->nil;
+ else
{
- xf_store(a1);
- xf_store_at(loc, (s7_pointer)rf_c);
- return(true);
+ if (is_null(cdr(sc->args)))
+ sc->value = car(sc->args);
+ else sc->value = splice_in_values(sc, sc->args);
}
-
- return(false);
-}
-
-bool s7_arg_to_rf(s7_scheme *sc, s7_pointer a1)
-{
- return(arg_to_rf(sc, a1, -1));
-}
-
-static s7_int if_c(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer i;
- i = **p; (*p)++;
- return(integer(i));
+ return(true);
}
-static s7_int if_s(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer x;
- x = slot_value(**p); (*p)++;
- if (!is_integer(x)) s7_wrong_type_arg_error(sc, "", 0, x, "an integer");
- return(integer(x));
-}
-static bool arg_to_if(s7_scheme *sc, s7_pointer a1, s7_int in_loc)
+static void call_with_exit(s7_scheme *sc)
{
- s7_int loc;
- xf_t *rc;
-
- xf_init(2);
- if (in_loc == -1)
- xf_save_loc(loc);
- else loc = in_loc;
+ int i, new_stack_top, quit = 0;
- if (is_pair(a1))
+ if (!call_exit_active(sc->code))
{
- s7_ip_t ip;
- s7_if_t xf;
- ip = pair_to_ip(sc, a1);
- if (!ip) return(false);
- xf = ip(sc, a1);
- if (!xf) return(false);
- xf_store_at(loc, (s7_pointer)xf);
- return(true);
+ static s7_pointer call_with_exit_error = NULL;
+ if (!call_with_exit_error)
+ call_with_exit_error = s7_make_permanent_string("call-with-exit escape procedure called outside its block");
+ s7_error(sc, sc->invalid_escape_function_symbol, set_elist_1(sc, call_with_exit_error));
}
- if (is_symbol(a1))
+ call_exit_active(sc->code) = false;
+ new_stack_top = call_exit_goto_loc(sc->code);
+ sc->op_stack_now = (s7_pointer *)(sc->op_stack + call_exit_op_loc(sc->code));
+
+ /* look for dynamic-wind in the stack section that we are jumping out of */
+ for (i = s7_stack_top(sc) - 1; i > new_stack_top; i -= 4)
{
- s7_pointer slot;
- slot = s7_slot(sc, a1);
- if ((is_slot(slot)) &&
- (is_integer(slot_value(slot))))
+ opcode_t op;
+
+ op = stack_op(sc->stack, i);
+ switch (op)
{
- xf_store(slot);
- xf_store_at(loc, (s7_pointer)if_s);
- return(true);
- }
- return(false);
- }
+ case OP_DYNAMIC_WIND:
+ {
+ s7_pointer lx;
+ lx = stack_code(sc->stack, i);
+ if (dynamic_wind_state(lx) == DWIND_BODY)
+ {
+ dynamic_wind_state(lx) = DWIND_FINISH;
+ if (dynamic_wind_out(lx) != sc->F)
+ {
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->args = sc->nil;
+ sc->code = dynamic_wind_out(lx);
+ eval(sc, OP_APPLY);
+ }
+ }
+ }
+ break;
- if (is_integer(a1))
- {
- xf_store(a1);
- xf_store_at(loc, (s7_pointer)if_c);
- return(true);
- }
+ case OP_EVAL_STRING_2:
+ s7_close_input_port(sc, sc->input_port);
+ pop_input_port(sc);
+ break;
- return(false);
-}
+ case OP_BARRIER: /* oops -- we almost certainly went too far */
+ return;
-bool s7_arg_to_if(s7_scheme *sc, s7_pointer a1)
-{
- return(arg_to_if(sc, a1, -1));
-}
+ case OP_DEACTIVATE_GOTO: /* here we're jumping into an unrelated call-with-exit block */
+ call_exit_active(stack_args(sc->stack, i)) = false;
+ break;
-static s7_pointer pf_c(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer x;
- x = **p; (*p)++;
- return(x);
-}
+ case OP_LET_TEMP_DONE:
+ let_temp_done(sc, stack_args(sc->stack, i), stack_code(sc->stack, i));
+ break;
-static s7_pointer pf_s(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer x;
- x = slot_value(**p); (*p)++;
- return(x);
-}
+ /* call/cc does not close files, but I think call-with-exit should */
+ case OP_GET_OUTPUT_STRING_1:
+ case OP_UNWIND_OUTPUT:
+ {
+ s7_pointer x;
+ x = stack_code(sc->stack, i); /* "code" = port that we opened */
+ s7_close_output_port(sc, x);
+ x = stack_args(sc->stack, i); /* "args" = port that we shadowed, if not #f */
+ if (x != sc->F)
+ sc->output_port = x;
+ }
+ break;
-static bool arg_to_pf(s7_scheme *sc, s7_pointer a1, s7_int in_loc)
-{
- s7_int loc;
- xf_t *rc;
+ case OP_UNWIND_INPUT:
+ s7_close_input_port(sc, stack_code(sc->stack, i)); /* "code" = port that we opened */
+ sc->input_port = stack_args(sc->stack, i); /* "args" = port that we shadowed */
+ break;
+
+ case OP_EVAL_DONE: /* goto called in a method -- put off the inner eval return(s) until we clean up the stack */
+ quit++;
+ break;
+
+ default:
+ break;
+ }
+ }
- xf_init(2);
- if (in_loc == -1)
- xf_save_loc(loc);
- else loc = in_loc;
+ sc->stack_end = (s7_pointer *)(sc->stack_start + new_stack_top);
- if (is_pair(a1))
+ /* the return value should have an implicit values call, just as in call/cc */
+ if (is_null(sc->args))
+ sc->value = sc->nil;
+ else
{
- s7_pp_t pp;
- s7_pf_t pf;
- pp = pair_to_pp(sc, a1);
- if (!pp) return(false);
- pf = pp(sc, a1);
- if (!pf) return(false);
- xf_store_at(loc, (s7_pointer)pf);
- return(true);
+ if (is_null(cdr(sc->args)))
+ sc->value = car(sc->args);
+ else sc->value = splice_in_values(sc, sc->args);
}
- if (is_symbol(a1))
+ if (quit > 0)
{
- s7_pointer slot;
- slot = s7_slot(sc, a1);
- if (is_slot(slot))
+ if (sc->longjmp_ok)
{
- xf_store(slot);
- xf_store_at(loc, (s7_pointer)pf_s);
- return(true);
+ pop_stack(sc);
+ longjmp(sc->goto_start, CALL_WITH_EXIT_JUMP);
}
- return(false);
+ for (i = 0; i < quit; i++)
+ push_stack(sc, OP_EVAL_DONE, sc->nil, sc->nil);
}
-
- xf_store(a1);
- xf_store_at(loc, (s7_pointer)pf_c);
- return(true);
}
-bool s7_arg_to_pf(s7_scheme *sc, s7_pointer a1)
-{
- return(arg_to_pf(sc, a1, -1));
-}
-static bool arg_to_gf(s7_scheme *sc, s7_pointer a1, s7_int in_loc)
+static s7_pointer g_call_cc(s7_scheme *sc, s7_pointer args)
{
- if (is_pair(a1))
- {
- s7_pp_t gp;
- gp = pair_to_gp(sc, a1);
- if (gp)
- {
- xf_t *rc;
- s7_pf_t gf;
- s7_int loc;
+ #define H_call_cc "(call-with-current-continuation func) is always a mistake!"
+ #define Q_call_cc s7_make_signature(sc, 2, sc->values_symbol, sc->is_procedure_symbol)
+ /* I think the intent is that sc->values_symbol as the proc-sig return type indicates multiple values are possible (otherwise use #t). */
- xf_init(1);
- if (in_loc == -1)
- xf_save_loc(loc);
- else loc = in_loc;
- gf = gp(sc, a1);
- if (gf)
- {
- xf_store_at(loc, (s7_pointer)gf);
- return(true);
- }
- }
+ s7_pointer p;
+ p = car(args); /* this is the procedure passed to call/cc */
+ if (!is_procedure(p)) /* this includes continuations */
+ {
+ check_two_methods(sc, p, sc->call_cc_symbol, sc->call_with_current_continuation_symbol, args);
+ return(simple_wrong_type_argument_with_type(sc, sc->call_cc_symbol, p, a_procedure_string));
}
- return(false);
-}
+ if (!s7_is_aritable(sc, p, 1))
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "call/cc procedure, ~A, should take one argument"), p)));
-bool s7_arg_to_gf(s7_scheme *sc, s7_pointer a1)
-{
- return(arg_to_gf(sc, a1, -1));
-}
+ sc->w = s7_make_continuation(sc);
+ push_stack(sc, OP_APPLY, list_1(sc, sc->w), p);
+ sc->w = sc->nil;
-static s7_rf_t pair_to_rf(s7_scheme *sc, s7_pointer a1, s7_rf_t x)
-{
- if (s7_arg_to_rf(sc, a1))
- return(x);
- return(NULL);
+ return(sc->nil);
}
-static s7_rf_t pair_to_rf_via_if(s7_scheme *sc, s7_pointer a1, s7_rf_t x)
-{
- if (s7_arg_to_if(sc, a1))
- return(x);
- return(NULL);
-}
+/* we can't naively optimize call/cc to call-with-exit if the continuation is only
+ * used as a function in the call/cc body because it might (for example) be wrapped
+ * in a lambda form that is being exported. See b-func in s7test for an example.
+ */
-s7_rf_t s7_rf_1(s7_scheme *sc, s7_pointer expr, s7_rf_t r, s7_rf_t s, s7_rf_t x)
+static s7_pointer g_call_with_exit(s7_scheme *sc, s7_pointer args)
{
- s7_pointer a1;
- xf_t *rc;
-
- if ((is_null(cdr(expr))) || (!is_null(cddr(expr)))) return(NULL);
- a1 = cadr(expr);
+ #define H_call_with_exit "(call-with-exit func) is call/cc without the ability to jump back into a previous computation."
+ #define Q_call_with_exit s7_make_signature(sc, 2, sc->values_symbol, sc->is_procedure_symbol)
- xf_init(1);
- if (is_real(a1))
- {
- xf_store(a1);
- return(r);
- }
+ s7_pointer p, x;
+ /* (call-with-exit (lambda (return) ...)) */
- if (is_symbol(a1))
- {
- a1 = s7_slot(sc, a1);
- if ((!is_slot(a1)) || (is_t_complex(slot_value(a1)))) return(NULL);
- xf_store(a1);
- return(s);
- }
+ p = car(args);
+ if (!is_procedure(p)) /* this includes continuations */
+ method_or_bust_with_type_one_arg(sc, p, sc->call_with_exit_symbol, args, a_procedure_string);
- if (is_pair(a1))
- return(pair_to_rf(sc, a1, x));
+ x = make_goto(sc);
+ push_stack(sc, OP_DEACTIVATE_GOTO, x, p); /* this means call-with-exit is not tail-recursive */
+ push_stack(sc, OP_APPLY, cons_unchecked(sc, x, sc->nil), p);
- return(NULL);
+ /* if the lambda body calls the argument as a function,
+ * it is applied to its arguments, apply notices that it is a goto, and...
+ *
+ * (conceptually...) sc->stack_top = call_exit_goto_loc(sc->code);
+ * s_pop(sc, (is_not_null(sc->args)) ? car(sc->args) : sc->nil);
+ *
+ * which jumps to the point of the goto returning car(args).
+ *
+ * There is one gotcha: we can't jump back in from outside, so if the caller saves the goto
+ * and tries to invoke it outside the call-with-exit block, we have to
+ * make sure it triggers an error. So, if the escape is called, it then
+ * deactivates itself. Otherwise the block returns, we pop to OP_DEACTIVATE_GOTO,
+ * and it finds the goto in sc->args.
+ * Even worse:
+ *
+ (let ((cc #f))
+ (call-with-exit
+ (lambda (c3)
+ (call/cc (lambda (ret) (set! cc ret)))
+ (c3)))
+ (cc))
+ *
+ * where we jump back into a call-with-exit body via call/cc, the goto has to be
+ * re-established.
+ *
+ * I think call-with-exit could be based on catch, but it's a simpler notion,
+ * and certainly at the source level it is easier to read.
+ */
+ return(sc->nil);
}
-s7_rf_t s7_rf_2(s7_scheme *sc, s7_pointer expr, s7_rf_t rr, s7_rf_t sr, s7_rf_t xr, s7_rf_t rs, s7_rf_t ss, s7_rf_t xs, s7_rf_t rx, s7_rf_t sx, s7_rf_t xx)
-{
- s7_pointer a1, a2;
- xf_t *rc;
- if ((is_null(cdr(expr))) || (!is_null(cdddr(expr)))) return(NULL);
- a1 = cadr(expr);
- a2 = caddr(expr);
- xf_init(2);
- if (is_real(a1))
- {
- xf_store(a1);
- if (is_real(a2))
- {
- xf_store(a2);
- return(rr);
- }
- if (is_symbol(a2))
- {
- a2 = s7_slot(sc, a2);
- if ((!is_slot(a2)) || (is_t_complex(slot_value(a2)))) return(NULL);
- xf_store(a2);
- return(rs);
- }
- if (is_pair(a2))
- return(pair_to_rf(sc, a2, rx));
- return(NULL);
- }
+/* -------------------------------- numbers -------------------------------- */
- if (is_symbol(a1))
- {
- a1 = s7_slot(sc, a1);
- if ((!is_slot(a1)) || (is_t_complex(slot_value(a1)))) return(NULL);
- xf_store(a1);
- if (is_real(a2))
- {
- xf_store(a2);
- return(sr);
- }
- if (is_symbol(a2))
- {
- a2 = s7_slot(sc, a2);
- if ((!is_slot(a2)) || (is_t_complex(slot_value(a2)))) return(NULL);
- xf_store(a2);
- return(ss);
- }
- if (is_pair(a2))
- return(pair_to_rf(sc, a2, sx));
- return(NULL);
- }
+#if WITH_GMP
+ static char *big_number_to_string_with_radix(s7_pointer p, int radix, int width, int *nlen, use_write_t use_write);
+ static bool big_numbers_are_eqv(s7_pointer a, s7_pointer b);
+ static s7_pointer string_to_either_integer(s7_scheme *sc, const char *str, int radix);
+ static s7_pointer string_to_either_ratio(s7_scheme *sc, const char *nstr, const char *dstr, int radix);
+ static s7_pointer string_to_either_real(s7_scheme *sc, const char *str, int radix);
+ static s7_pointer string_to_either_complex(s7_scheme *sc, char *q, char *slash1, char *ex1, bool has_dec_point1,
+ char *plus, char *slash2, char *ex2, bool has_dec_point2, int radix, int has_plus_or_minus);
+ static s7_pointer big_add(s7_scheme *sc, s7_pointer args);
+ static s7_pointer big_subtract(s7_scheme *sc, s7_pointer args);
+ static s7_pointer big_multiply(s7_scheme *sc, s7_pointer args);
+ static s7_pointer big_divide(s7_scheme *sc, s7_pointer args);
+ static s7_pointer big_random(s7_scheme *sc, s7_pointer args);
+ static s7_pointer s7_int_to_big_integer(s7_scheme *sc, s7_int val);
+ static s7_pointer s7_ratio_to_big_ratio(s7_scheme *sc, s7_int num, s7_int den);
+ static s7_pointer s7_number_to_big_real(s7_scheme *sc, s7_pointer p);
+ static s7_pointer promote_number(s7_scheme *sc, int type, s7_pointer x);
+ static s7_pointer big_equal(s7_scheme *sc, s7_pointer args);
+ static s7_pointer big_negate(s7_scheme *sc, s7_pointer args);
+ static s7_pointer big_invert(s7_scheme *sc, s7_pointer args);
+#if (!WITH_PURE_S7)
+ static s7_pointer big_inexact_to_exact(s7_scheme *sc, s7_pointer args);
+ static s7_pointer big_exact_to_inexact(s7_scheme *sc, s7_pointer args);
+#endif
+ static s7_pointer mpz_to_big_integer(s7_scheme *sc, mpz_t val);
+ static s7_pointer mpq_to_big_ratio(s7_scheme *sc, mpq_t val);
+ static s7_pointer mpfr_to_big_real(s7_scheme *sc, mpfr_t val);
+ static s7_pointer mpc_to_big_complex(s7_scheme *sc, mpc_t val);
+#endif
- if (is_pair(a1))
- {
- s7_int loc;
- s7_rp_t rp;
- s7_rf_t rf;
+#if ((defined(__clang__) && ((__clang_major__ > 3) || (__clang_major__ == 3 && __clang_minor__ >= 4))) || (defined(__GNUC__) && __GNUC__ >= 5))
+ #define HAVE_OVERFLOW_CHECKS 1
+#else
+ #define HAVE_OVERFLOW_CHECKS 0
+ #if (!WITH_GMP)
+ #warning "no arithmetic overflow checks in this version of s7"
+ #endif
+#endif
- xf_save_loc(loc);
- rp = pair_to_rp(sc, a1);
- if (!rp) return(NULL);
- rf = rp(sc, a1);
- if (!rf) return(NULL);
- xf_store_at(loc, (s7_pointer)rf);
+#if (defined(__clang__) && ((__clang_major__ > 3) || (__clang_major__ == 3 && __clang_minor__ >= 4)))
+ #define subtract_overflow(A, B, C) __builtin_ssubll_overflow(A, B, C)
+ #define add_overflow(A, B, C) __builtin_saddll_overflow(A, B, C)
+ #define multiply_overflow(A, B, C) __builtin_smulll_overflow(A, B, C)
+ #define int_subtract_overflow(A, B, C) __builtin_ssub_overflow(A, B, C)
+ #define int_add_overflow(A, B, C) __builtin_sadd_overflow(A, B, C)
+ #define int_multiply_overflow(A, B, C) __builtin_smul_overflow(A, B, C)
+#else
+#if (defined(__GNUC__) && __GNUC__ >= 5)
+ #define subtract_overflow(A, B, C) __builtin_sub_overflow(A, B, C)
+ #define add_overflow(A, B, C) __builtin_add_overflow(A, B, C)
+ #define multiply_overflow(A, B, C) __builtin_mul_overflow(A, B, C)
+ #define int_subtract_overflow(A, B, C) __builtin_sub_overflow(A, B, C)
+ #define int_add_overflow(A, B, C) __builtin_add_overflow(A, B, C)
+ #define int_multiply_overflow(A, B, C) __builtin_mul_overflow(A, B, C)
+#endif
+#endif
- if (is_real(a2))
- {
- xf_store(a2);
- return(xr);
- }
- if (is_symbol(a2))
- {
- a2 = s7_slot(sc, a2);
- if ((!is_slot(a2)) || (is_t_complex(slot_value(a2)))) return(NULL);
- xf_store(a2);
- return(xs);
- }
- if (is_pair(a2))
- return(pair_to_rf(sc, a2, xx));
- return(NULL);
- }
- return(NULL);
-}
-#if (!WITH_GMP)
-typedef struct {s7_rf_t none, r, s, p, rs, rp, ss, sp, pp, rss, rsp, rpp, sss, ssp, spp, ppp;} rf_ops;
-static rf_ops *add_r_ops, *multiply_r_ops;
+#define s7_int_abs(x) ((x) >= 0 ? (x) : -(x))
+/* can't use abs even in gcc -- it doesn't work with long long ints! */
-static s7_rf_t com_rf_2(s7_scheme *sc, s7_pointer expr, rf_ops *a)
-{
- /* expr len is assumed to be 3 (2 args) */
- s7_pointer a1, a2, p1 = NULL, p2 = NULL, s1 = NULL, s2 = NULL, c1 = NULL, c2 = NULL;
- xf_t *rc;
+#if (!__NetBSD__)
+ #define s7_fabsl(X) fabsl(X)
+#else
+ static double s7_fabsl(long double x) {if (x < 0.0) return(-x); return(x);}
+#endif
- a1 = cadr(expr);
- if (is_pair(a1)) p1 = a1; else {if (is_symbol(a1)) s1 = a1; else {if (is_real(a1)) c1 = a1; else return(NULL);}}
- a2 = caddr(expr);
- if (is_pair(a2)) p2 = a2; else {if (is_symbol(a2)) s2 = a2; else {if (is_real(a2)) c2 = a2; else return(NULL);}}
-
- xf_init(2);
- if (!c1) {c1 = c2; c2 = NULL;}
- if (c2)
- {
- if ((is_t_real(c1)) || (is_t_real(c2)))
- {
- s7_pointer x;
- s7_double x1, x2;
- x1 = real_to_double(sc, c1, (a == add_r_ops) ? "+" : "*");
- x2 = real_to_double(sc, c2, (a == add_r_ops) ? "+" : "*");
- if (a == add_r_ops)
- x = make_real(sc, x1 + x2);
- else x = make_real(sc, x1 * x2);
- if (!is_immutable_real(x))
- xf_push(sc, x);
- xf_store(x);
- return(a->r);
- }
- return(NULL);
- }
- if (!s1) {s1 = s2; s2 = NULL;}
- if (!p1) {p1 = p2; p2 = NULL;}
-
- if (s1)
- {
- bool s1_real;
- s1 = s7_slot(sc, s1);
- if ((!is_slot(s1)) || (is_unsafe_stepper(s1)) || (is_t_complex(slot_value(s1)))) return(NULL);
- s1_real = (is_t_real(slot_value(s1)));
- xf_store(s1);
- if (s2)
- {
- s2 = s7_slot(sc, s2);
- if ((!is_slot(s2)) || (is_unsafe_stepper(s2)) || (is_t_complex(slot_value(s2)))) return(NULL);
-
- if ((s1_real) || /* TODO: look at step etc */
- (is_t_real(slot_value(s2))))
- {
- xf_store(s2);
- return(a->ss);
- }
- return(NULL);
- }
- if (c1)
- {
- if ((s1_real) || (is_t_real(c1)))
- {
- xf_store(c1);
- return(a->rs);
- }
- return(NULL);
- }
- if (s7_arg_to_rf(sc, p1))
- return(a->sp);
- return(NULL);
- }
- /* must be p1 here, c1 or p2 */
- if (c1)
- {
- xf_store(c1);
- if (s7_arg_to_rf(sc, p1))
- return(a->rp);
- return(NULL);
- }
-
- if ((s7_arg_to_rf(sc, p1)) &&
- (s7_arg_to_rf(sc, p2)))
- return(a->pp);
+static bool is_NaN(s7_double x) {return(x != x);}
+/* callgrind says this is faster than isnan, I think (very confusing data...) */
- return(NULL);
-}
-static s7_rf_t com_rf_3(s7_scheme *sc, s7_pointer expr, rf_ops *a)
-{
- /* expr len is assumed to be 4 (3 args) */
- s7_pointer a1, a2, a3, p1 = NULL, p2 = NULL, p3 = NULL, s1 = NULL, s2 = NULL, s3 = NULL, c1 = NULL, c2 = NULL, c3 = NULL;
- bool s1_real = false;
- xf_t *rc;
-
- a1 = cadr(expr);
- if (is_pair(a1)) p1 = a1; else {if (is_symbol(a1)) s1 = a1; else {if (is_real(a1)) c1 = a1; else return(NULL);}}
- a2 = caddr(expr);
- if (is_pair(a2)) p2 = a2; else {if (is_symbol(a2)) s2 = a2; else {if (is_real(a2)) c2 = a2; else return(NULL);}}
- a3 = cadddr(expr);
- if (is_pair(a3)) p3 = a3; else {if (is_symbol(a3)) s3 = a3; else {if (is_real(a3)) c3 = a3; else return(NULL);}}
-
- if (!s2) {s2 = s3; s3 = NULL;}
- if (!s1) {s1 = s2; s2 = s3; s3 = NULL;}
+#if defined(__sun) && defined(__SVR4)
+ static bool is_inf(s7_double x) {return((x == x) && (is_NaN(x - x)));} /* there's no isinf in Solaris */
+#else
+#if (!MS_WINDOWS)
- xf_init(3);
- if (s1)
- {
- s1 = s7_slot(sc, s1);
- if ((!is_slot(s1)) || (is_unsafe_stepper(s1)) || (is_t_complex(slot_value(s1)))) return(NULL);
- s1_real = (is_t_real(slot_value(s1)));
- xf_store(s1);
- }
+ #if __cplusplus
+ #define is_inf(x) std::isinf(x)
+ #else
+ #define is_inf(x) isinf(x)
+ #endif
- if (!p2) {p2 = p3; p3 = NULL;}
- if (!p1) {p1 = p2; p2 = p3; p3 = NULL;}
+#else
+ static bool is_inf(s7_double x) {return((x == x) && (is_NaN(x - x)));} /* Another possibility: (x * 0) != 0 */
- if (!c2) {c2 = c3; c3 = NULL;}
- if (!c1) {c1 = c2; c2 = c3; c3 = NULL;}
- if (c2)
- {
- if ((is_t_real(c1)) || (is_t_real(c2)) || ((c3) && (is_t_real(c3))))
- {
- s7_pointer x;
- s7_double x1, x2, x3;
- x1 = real_to_double(sc, c1, (a == add_r_ops) ? "+" : "*");
- x2 = real_to_double(sc, c2, (a == add_r_ops) ? "+" : "*");
- if (c3) x3 = real_to_double(sc, c3, (a == add_r_ops) ? "+" : "*"); else x3 = ((a == add_r_ops) ? 0.0 : 1.0);
- if (a == add_r_ops)
- x = make_real(sc, x1 + x2 + x3);
- else x = make_real(sc, x1 * x2 * x3);
- if (!is_immutable_real(x))
- xf_push(sc, x);
- xf_store(x);
- if (c3) return(a->r);
- if (s1) return(a->rs);
- if (s7_arg_to_rf(sc, p1))
- return(a->rp);
- }
- return(NULL);
- }
+ /* in MS C, we need to provide inverse hyperbolic trig funcs and cbrt */
+ static double asinh(double x) {return(log(x + sqrt(1.0 + x * x)));}
+ static double acosh(double x) {return(log(x + sqrt(x * x - 1.0)));}
+ /* perhaps less prone to numerical troubles (untested): 2.0 * log(sqrt(0.5 * (x + 1.0)) + sqrt(0.5 * (x - 1.0))) */
+ static double atanh(double x) {return(log((1.0 + x) / (1.0 - x)) / 2.0);}
+ static double cbrt(double x) {if (x >= 0.0) return(pow(x, 1.0 / 3.0)); return(-pow(-x, 1.0 / 3.0));}
+#endif /* windows */
+#endif /* sun */
- if (s1)
- {
- if (s2)
- {
- bool s2_real;
- s2 = s7_slot(sc, s2);
- if ((!is_slot(s2)) || (is_unsafe_stepper(s2)) || (is_t_complex(slot_value(s2)))) return(NULL);
- s2_real = (is_t_real(slot_value(s2)));
- xf_store(s2);
- if (s3)
- {
- s3 = s7_slot(sc, s3);
- if ((!is_slot(s3)) || (is_unsafe_stepper(s3)) || (is_t_complex(slot_value(s3)))) return(NULL);
- if ((s1_real) || (s2_real) || (is_t_real(slot_value(s3))))
- {
- xf_store(s3);
- return(a->sss);
- }
- return(NULL);
- }
- if (c1)
- {
- if ((s1_real) || (s2_real) || (is_t_real(c1)))
- {
- xf_store(c1);
- return(a->rss);
- }
- return(NULL);
- }
- if (s7_arg_to_rf(sc, p1))
- return(a->ssp);
- return(NULL);
- }
- if (c1)
- {
- xf_store(c1);
- if (s7_arg_to_rf(sc, p1))
- return(a->rsp);
- return(NULL);
- }
- if ((s7_arg_to_rf(sc, p1)) &&
- (s7_arg_to_rf(sc, p2)))
- return(a->spp);
- return(NULL);
- }
-
- if (c1)
- {
- xf_store(c1);
- if ((s7_arg_to_rf(sc, p1)) &&
- (s7_arg_to_rf(sc, p2)))
- return(a->rpp);
- return(NULL);
- }
- if ((s7_arg_to_rf(sc, p1)) &&
- (s7_arg_to_rf(sc, p2)) &&
- (s7_arg_to_rf(sc, p3)))
- return(a->ppp);
- return(NULL);
-}
+/* for g_log, we also need round. this version is from stackoverflow, see also round_per_R5RS below */
+double s7_round(double number) {return((number < 0.0) ? ceil(number - 0.5) : floor(number + 0.5));}
-typedef struct {s7_if_t none, r, s, p, rs, rp, ss, sp, pp, rss, rsp, rpp, sss, ssp, spp, ppp;} if_ops;
-static if_ops *add_i_ops, *multiply_i_ops;
+#if HAVE_COMPLEX_NUMBERS
+#if __cplusplus
+ #define _Complex_I (complex<s7_double>(0.0, 1.0))
+ #define creal(x) Real(x)
+ #define cimag(x) Imag(x)
+ #define carg(x) arg(x)
+ #define cabs(x) abs(x)
+ #define csqrt(x) sqrt(x)
+ #define cpow(x, y) pow(x, y)
+ #define clog(x) log(x)
+ #define cexp(x) exp(x)
+ #define csin(x) sin(x)
+ #define ccos(x) cos(x)
+ #define csinh(x) sinh(x)
+ #define ccosh(x) cosh(x)
+#else
+ typedef double complex s7_complex;
+#endif
-static s7_if_t com_if_2(s7_scheme *sc, s7_pointer expr, if_ops *a)
-{
- /* expr len is assumed to be 3 (2 args) */
- s7_pointer a1, a2, p1 = NULL, p2 = NULL, s1 = NULL, s2 = NULL, c1 = NULL, c2 = NULL;
- xf_t *rc;
- a1 = cadr(expr);
- if (is_pair(a1)) p1 = a1; else {if (is_symbol(a1)) s1 = a1; else {if (is_real(a1)) c1 = a1; else return(NULL);}}
- a2 = caddr(expr);
- if (is_pair(a2)) p2 = a2; else {if (is_symbol(a2)) s2 = a2; else {if (is_real(a2)) c2 = a2; else return(NULL);}}
-
- xf_init(2);
- if (!c1) {c1 = c2; c2 = NULL;}
- if ((c1) && (!is_t_integer(c1))) return(NULL);
- if (c2)
- {
- s7_pointer x;
- if (!(is_t_integer(c2))) return(NULL);
- if (a == add_i_ops)
- x = make_integer(sc, integer(c1) + integer(c2));
- else x = make_integer(sc, integer(c1) * integer(c2));
- if (!is_immutable_integer(x))
- xf_push(sc, x);
- xf_store(x);
- return(a->r);
- }
- if (!s1) {s1 = s2; s2 = NULL;}
- if (!p1) {p1 = p2; p2 = NULL;}
-
- if (s1)
- {
- s1 = s7_slot(sc, s1);
- if ((!is_slot(s1)) || (is_unsafe_stepper(s1)) || (!is_t_integer(slot_value(s1)))) return(NULL);
- xf_store(s1);
- if (s2)
- {
- s2 = s7_slot(sc, s2);
- if ((!is_slot(s2)) || (is_unsafe_stepper(s2)) || (!is_t_integer(slot_value(s2)))) return(NULL);
- xf_store(s2);
- return(a->ss);
- }
- if (c1)
- {
- xf_store(c1);
- return(a->rs);
- }
- if (s7_arg_to_if(sc, p1))
- return(a->sp);
- return(NULL);
- }
+#if (!HAVE_COMPLEX_TRIG)
+#if (__cplusplus)
- /* must be p1 here, c1 or p2 */
- if (c1)
- {
- xf_store(c1);
- if (s7_arg_to_if(sc, p1))
- return(a->rp);
- return(NULL);
- }
-
- if ((s7_arg_to_if(sc, p1)) &&
- (s7_arg_to_if(sc, p2)))
- return(a->pp);
+ static s7_complex ctan(s7_complex z) {return(csin(z) / ccos(z));}
+ static s7_complex ctanh(s7_complex z) {return(csinh(z) / ccosh(z));}
+ static s7_complex casin(s7_complex z) {return(-_Complex_I * clog(_Complex_I * z + csqrt(1.0 - z * z)));}
+ static s7_complex cacos(s7_complex z) {return(-_Complex_I * clog(z + _Complex_I * csqrt(1.0 - z * z)));}
+ static s7_complex catan(s7_complex z) {return(_Complex_I * clog((_Complex_I + z) / (_Complex_I - z)) / 2.0);}
+ static s7_complex casinh(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
+ static s7_complex cacosh(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
+ static s7_complex catanh(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
+#else
- return(NULL);
+/* still not in FreeBSD! */
+static s7_complex clog(s7_complex z) {return(log(fabs(cabs(z))) + carg(z) * _Complex_I);}
+static s7_complex cpow(s7_complex x, s7_complex y)
+{
+ s7_double r = cabs(x);
+ s7_double theta = carg(x);
+ s7_double yre = creal(y);
+ s7_double yim = cimag(y);
+ s7_double nr = exp(yre * log(r) - yim * theta);
+ s7_double ntheta = yre * theta + yim * log(r);
+ return(nr * cos(ntheta) + (nr * sin(ntheta)) * _Complex_I); /* make-polar */
}
-static s7_if_t com_if_3(s7_scheme *sc, s7_pointer expr, if_ops *a)
-{
- /* expr len is assumed to be 4 (3 args) */
- s7_pointer a1, a2, a3, p1 = NULL, p2 = NULL, p3 = NULL, s1 = NULL, s2 = NULL, s3 = NULL, c1 = NULL, c2 = NULL, c3 = NULL;
- xf_t *rc;
+#if (!defined(__FreeBSD__)) || (__FreeBSD__ < 9) /* untested -- this orignally looked at __FreeBSD_version which apparently no longer exists */
+ static s7_complex cexp(s7_complex z) {return(exp(creal(z)) * cos(cimag(z)) + (exp(creal(z)) * sin(cimag(z))) * _Complex_I);}
+#endif
- a1 = cadr(expr);
- if (is_pair(a1)) p1 = a1; else {if (is_symbol(a1)) s1 = a1; else {if (is_real(a1)) c1 = a1; else return(NULL);}}
- a2 = caddr(expr);
- if (is_pair(a2)) p2 = a2; else {if (is_symbol(a2)) s2 = a2; else {if (is_real(a2)) c2 = a2; else return(NULL);}}
- a3 = cadddr(expr);
- if (is_pair(a3)) p3 = a3; else {if (is_symbol(a3)) s3 = a3; else {if (is_real(a3)) c3 = a3; else return(NULL);}}
-
- xf_init(3);
- if (!s2) {s2 = s3; s3 = NULL;}
- if (!s1) {s1 = s2; s2 = s3; s3 = NULL;}
- if (s1)
- {
- s1 = s7_slot(sc, s1);
- if ((!is_slot(s1)) || (is_unsafe_stepper(s1)) || (!is_t_integer(slot_value(s1)))) return(NULL);
- xf_store(s1);
- }
+#if (!defined(__FreeBSD__)) || (__FreeBSD__ < 10)
+ static s7_complex csin(s7_complex z) {return(sin(creal(z)) * cosh(cimag(z)) + (cos(creal(z)) * sinh(cimag(z))) * _Complex_I);}
+ static s7_complex ccos(s7_complex z) {return(cos(creal(z)) * cosh(cimag(z)) + (-sin(creal(z)) * sinh(cimag(z))) * _Complex_I);}
+ static s7_complex csinh(s7_complex z) {return(sinh(creal(z)) * cos(cimag(z)) + (cosh(creal(z)) * sin(cimag(z))) * _Complex_I);}
+ static s7_complex ccosh(s7_complex z) {return(cosh(creal(z)) * cos(cimag(z)) + (sinh(creal(z)) * sin(cimag(z))) * _Complex_I);}
+ static s7_complex ctan(s7_complex z) {return(csin(z) / ccos(z));}
+ static s7_complex ctanh(s7_complex z) {return(csinh(z) / ccosh(z));}
+ static s7_complex casin(s7_complex z) {return(-_Complex_I * clog(_Complex_I * z + csqrt(1.0 - z * z)));}
+ static s7_complex cacos(s7_complex z) {return(-_Complex_I * clog(z + _Complex_I * csqrt(1.0 - z * z)));}
+ static s7_complex catan(s7_complex z) {return(_Complex_I * clog((_Complex_I + z) / (_Complex_I - z)) / 2.0);}
+ static s7_complex catanh(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
+ static s7_complex casinh(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
+ static s7_complex cacosh(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
+ /* perhaps less prone to numerical troubles (untested): 2.0 * clog(csqrt(0.5 * (z + 1.0)) + csqrt(0.5 * (z - 1.0))) */
+#endif /* not FreeBSD 10 */
+#endif /* not c++ */
+#endif /* not HAVE_COMPLEX_TRIG */
- if (!p2) {p2 = p3; p3 = NULL;}
- if (!p1) {p1 = p2; p2 = p3; p3 = NULL;}
+#else /* not HAVE_COMPLEX_NUMBERS */
+ typedef double s7_complex;
+ #define _Complex_I 1
+ #define creal(x) x
+ #define cimag(x) x
+ #define csin(x) sin(x)
+ #define casin(x) x
+ #define ccos(x) cos(x)
+ #define cacos(x) x
+ #define ctan(x) x
+ #define catan(x) x
+ #define csinh(x) x
+ #define casinh(x) x
+ #define ccosh(x) x
+ #define cacosh(x) x
+ #define ctanh(x) x
+ #define catanh(x) x
+ #define cexp(x) exp(x)
+ #define cpow(x, y) pow(x, y)
+ #define clog(x) log(x)
+ #define csqrt(x) sqrt(x)
+ #define conj(x) x
+#endif
- if (!c2) {c2 = c3; c3 = NULL;}
- if (!c1) {c1 = c2; c2 = c3; c3 = NULL;}
- if (c1)
- {
- if (!is_t_integer(c1)) return(NULL);
- if (c2)
- {
- s7_pointer x;
- if (!is_t_integer(c2)) return(NULL);
- if ((c3) && (!is_t_integer(c3))) return(NULL);
- if (a == add_i_ops)
- x = make_integer(sc, integer(c1) + integer(c2) + ((c3) ? integer(c3) : 0));
- else x = make_integer(sc, integer(c1) * integer(c2) * ((c3) ? integer(c3) : 1));
- if (!is_immutable_integer(x))
- xf_push(sc, x);
- xf_store(x);
- if (c3) return(a->r);
- if (s1) return(a->rs);
- if (s7_arg_to_if(sc, p1))
- return(a->rp);
- }
- return(NULL);
- }
+#ifdef __OpenBSD__
+ /* openbsd's builtin versions of these functions are not usable */
+ static s7_complex catanh_1(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
+ static s7_complex casinh_1(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
+ static s7_complex cacosh_1(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
+#endif
+#ifdef __NetBSD__
+ static s7_complex catanh_1(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
+ static s7_complex casinh_1(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
+#endif
- if (s1)
- {
- if (s2)
- {
- s2 = s7_slot(sc, s2);
- if ((!is_slot(s2)) || (is_unsafe_stepper(s2)) || (!is_t_integer(slot_value(s2)))) return(NULL);
- xf_store(s2);
- if (s3)
- {
- s3 = s7_slot(sc, s3);
- if ((!is_slot(s3)) || (is_unsafe_stepper(s3)) || (!is_t_integer(slot_value(s3)))) return(NULL);
- xf_store(s3);
- return(a->sss);
- }
- if (c1)
- {
- xf_store(c1);
- return(a->rss);
- }
- if (s7_arg_to_if(sc, p1))
- return(a->ssp);
- return(NULL);
- }
- if (c1)
- {
- xf_store(c1);
- if (s7_arg_to_if(sc, p1))
- return(a->rsp);
- return(NULL);
- }
- if ((s7_arg_to_if(sc, p1)) &&
- (s7_arg_to_if(sc, p2)))
- return(a->spp);
- return(NULL);
- }
-
- if (c1)
- {
- xf_store(c1);
- if ((s7_arg_to_if(sc, p1)) &&
- (s7_arg_to_if(sc, p2)))
- return(a->rpp);
- return(NULL);
- }
- if ((s7_arg_to_if(sc, p1)) &&
- (s7_arg_to_if(sc, p2)) &&
- (s7_arg_to_if(sc, p3)))
- return(a->ppp);
- return(NULL);
-}
+bool s7_is_number(s7_pointer p)
+{
+#if WITH_GMP
+ return((is_number(p)) || (is_big_number(p)));
+#else
+ return(is_number(p));
#endif
+}
+
-#if WITH_OPTIMIZATION
-static s7_double set_rf_sr(s7_scheme *sc, s7_pointer **p)
+bool s7_is_integer(s7_pointer p)
{
- s7_pointer s1, c1;
- s7_double x;
- s1 = (**p); (*p)++;
- c1 = (**p); (*p)++;
- x = real(c1);
- slot_set_value(s1, make_real(sc, x));
- return(x);
+#if WITH_GMP
+ return((is_t_integer(p)) ||
+ (is_t_big_integer(p)));
+#else
+ return(is_integer(p));
+#endif
}
-#if 0
-static s7_double set_rf_ss(s7_scheme *sc, s7_pointer **p)
+bool s7_is_real(s7_pointer p)
{
- s7_pointer s1, s2;
- s7_double x;
- s1 = (**p); (*p)++;
- s2 = (**p); (*p)++;
- x = real_to_double(sc, slot_value(s2), "set!");
- slot_set_value(s1, make_real(sc, x));
- return(x);
-}
+#if WITH_GMP
+ return((is_real(p)) ||
+ (is_t_big_integer(p)) ||
+ (is_t_big_ratio(p)) ||
+ (is_t_big_real(p)));
+#else
+ return(is_real(p)); /* in GSL, a NaN or inf is not a real, or perhaps better, finite = not (nan or inf) */
#endif
+}
-static s7_double set_rf_sx(s7_scheme *sc, s7_pointer **p)
+
+bool s7_is_rational(s7_pointer p)
{
- s7_pointer s1;
- s7_double x;
- s7_rf_t r1;
- s1 = (**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- slot_set_value(s1, make_real(sc, x));
- return(x);
+#if WITH_GMP
+ return((is_rational(p)) ||
+ (is_t_big_integer(p)) ||
+ (is_t_big_ratio(p)));
+#else
+ return(is_rational(p));
+#endif
}
-static s7_int set_if_sx(s7_scheme *sc, s7_pointer **p)
+
+bool s7_is_ratio(s7_pointer p)
{
- s7_pointer s1;
- s7_int x;
- s7_if_t i1;
- s1 = (**p); (*p)++;
- i1 = (s7_if_t)(**p); (*p)++;
- x = i1(sc, p);
- slot_set_value(s1, make_integer(sc, x));
- return(x);
+#if WITH_GMP
+ return((is_t_ratio(p)) ||
+ (is_t_big_ratio(p)));
+#else
+ return(is_t_ratio(p));
+#endif
}
-static s7_rf_t float_vector_set_rf_expanded(s7_scheme *sc, s7_pointer fv, s7_pointer ind_sym, s7_pointer val_expr);
-static s7_if_t int_vector_set_if_expanded(s7_scheme *sc, s7_pointer iv, s7_pointer ind_sym, s7_pointer val_expr);
-static s7_rf_t set_rf(s7_scheme *sc, s7_pointer expr)
+bool s7_is_complex(s7_pointer p)
{
- s7_pointer slot, a1;
- xf_t *rc;
+#if WITH_GMP
+ return((is_number(p)) || (is_big_number(p)));
+#else
+ return(is_number(p));
+#endif
+}
- if (is_pair(cdddr(expr))) return(NULL);
- a1 = cadr(expr);
- if (!is_symbol(a1)) /* look for implicit index case */
- {
- s7_pointer fv;
- if ((!is_pair(a1)) || (!is_symbol(car(a1))) || (!is_null(cddr(a1)))) return(NULL);
- fv = s7_symbol_value(sc, car(a1));
- if (is_float_vector(fv))
- return(float_vector_set_rf_expanded(sc, fv, cadr(a1), caddr(expr)));
- if ((is_c_object(fv)) &&
- (c_object_set_rp(fv)))
- return(c_object_set_rp(fv)(sc, expr));
- return(NULL);
- }
- /* if sym has real value and new val is real, we're ok */
- slot = s7_slot(sc, a1);
- if (!is_slot(slot)) return(NULL);
+static s7_int c_gcd(s7_int u, s7_int v)
+{
+ s7_int a, b;
- xf_init(2);
- if (is_t_real(slot_value(slot)))
+ if ((u == s7_int_min) || (v == s7_int_min))
{
- s7_pointer a2;
- xf_store(slot);
- a2 = caddr(expr);
- if (is_t_real(a2))
- {
- xf_store(a2);
- return(set_rf_sr);
- }
-#if 0
- if (is_symbol(a2))
- {
- s7_pointer a2_slot;
- a2_slot = s7_slot(sc, a2);
- if (!is_slot(a2_slot)) return(NULL);
- if (type(slot_value(a2_slot)) != T_REAL) return(NULL);
- xf_store(a2_slot);
- return(set_rf_ss);
- }
-#endif
- if (is_pair(a2))
+ /* can't take abs of these (below) so do it by hand */
+ s7_int divisor = 1;
+ if (u == v) return(u);
+ while (((u & 1) == 0) && ((v & 1) == 0))
{
- s7_rp_t rp;
- s7_rf_t rf;
- s7_int loc;
- xf_save_loc(loc);
- rp = pair_to_rp(sc, a2);
- if (!rp) return(NULL);
- rf = rp(sc, a2);
- if (!rf) return(NULL);
- xf_store_at(loc, (s7_pointer)rf);
- return(set_rf_sx);
+ u /= 2;
+ v /= 2;
+ divisor *= 2;
}
+ return(divisor);
}
- return(NULL);
+
+ a = s7_int_abs(u);
+ b = s7_int_abs(v);
+ while (b != 0)
+ {
+ s7_int temp;
+ temp = a % b;
+ a = b;
+ b = temp;
+ }
+ if (a < 0)
+ return(-a);
+ return(a);
}
-static s7_if_t set_if(s7_scheme *sc, s7_pointer expr)
+
+static bool c_rationalize(s7_double ux, s7_double error, s7_int *numer, s7_int *denom)
{
- s7_pointer slot, a1;
+ /*
+ (define* (rat ux (err 0.0000001))
+ ;; translated from CL code in Canny, Donald, Ressler, "A Rational Rotation Method for Robust Geometric Algorithms"
+ (let ((x0 (- ux error))
+ (x1 (+ ux error)))
+ (let ((i (ceiling x0))
+ (i0 (floor x0))
+ (i1 (ceiling x1))
+ (r 0))
+ (if (>= x1 i)
+ i
+ (do ((p0 i0 (+ p1 (* r p0)))
+ (q0 1 (+ q1 (* r q0)))
+ (p1 i1 p0)
+ (q1 1 q0)
+ (e0 (- i1 x0) e1p)
+ (e1 (- x0 i0) (- e0p (* r e1p)))
+ (e0p (- i1 x1) e1)
+ (e1p (- x1 i0) (- e0 (* r e1))))
+ ((<= x0 (/ p0 q0) x1)
+ (/ p0 q0))
+ (set! r (min (floor (/ e0 e1))
+ (ceiling (/ e0p e1p)))))))))
+ */
- if (is_pair(cdddr(expr))) return(NULL);
- a1 = cadr(expr);
+ double x0, x1;
+ s7_int i, i0, i1, p0, q0, p1, q1;
+ double e0, e1, e0p, e1p;
+ int tries = 0;
+ /* don't use s7_double here; if it is "long double", the loop below will hang */
- if (!is_symbol(a1)) /* look for implicit index case */
+ /* #e1e19 is a killer -- it's bigger than most-positive-fixnum, but if we ceil(ux) below
+ * it turns into most-negative-fixnum. 1e19 is trouble in many places.
+ */
+ if ((ux > s7_int_max) || (ux < s7_int_min))
{
- s7_pointer fv;
- if ((!is_pair(a1)) || (!is_symbol(car(a1))) || (!is_null(cddr(a1)))) return(NULL);
- fv = s7_symbol_value(sc, car(a1));
- if (is_int_vector(fv))
- return(int_vector_set_if_expanded(sc, fv, cadr(a1), caddr(expr)));
- if ((is_c_object(fv)) &&
- (c_object_set_ip(fv)))
- return(c_object_set_ip(fv)(sc, expr));
- return(NULL);
+ /* can't return false here because that confuses some of the callers!
+ */
+ if (ux > s7_int_min) (*numer) = s7_int_max; else (*numer) = s7_int_min;
+ (*denom) = 1;
+ return(true);
}
- if (!is_symbol(a1)) return(NULL);
- slot = s7_slot(sc, a1);
- if (!is_slot(slot)) return(NULL);
+ if (error < 0.0) error = -error;
+ x0 = ux - error;
+ x1 = ux + error;
+ i = (s7_int)ceil(x0);
- if (is_t_integer(slot_value(slot)))
+ if (error >= 1.0) /* aw good grief! */
{
- s7_pointer a2;
- xf_t *rc;
- xf_init(1);
- xf_store(slot);
- a2 = caddr(expr);
- if ((is_pair(a2)) &&
- (s7_arg_to_if(sc, a2)))
- return(set_if_sx);
+ if (x0 < 0)
+ {
+ if (x1 < 0)
+ (*numer) = (s7_int)floor(x1);
+ else (*numer) = 0;
+ }
+ else (*numer) = i;
+ (*denom) = 1;
+ return(true);
}
- return(NULL);
-}
-static s7_pf_t set_pf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer a1;
- if (is_pair(cdddr(expr))) return(NULL);
- a1 = cadr(expr);
- if (is_pair(a1)) /* look for implicit index case */
+ if (x1 >= i)
{
- s7_pointer v;
- if ((!is_symbol(car(a1))) || (!is_pair(cdr(a1))) || (!is_null(cddr(a1)))) return(NULL);
- v = s7_slot(sc, car(a1));
- if (!is_slot(v)) return(NULL);
- switch (type(slot_value(v)))
- {
- case T_PAIR: case T_STRING: case T_VECTOR: case T_HASH_TABLE: case T_LET:
- return(implicit_pf_sequence_set(sc, v, cadr(a1), caddr(expr)));
-
- case T_INT_VECTOR: case T_FLOAT_VECTOR:
- return(implicit_gf_sequence_set(sc, v, cadr(a1), caddr(expr)));
- }
+ if (i >= 0)
+ (*numer) = i;
+ else (*numer) = (s7_int)floor(x1);
+ (*denom) = 1;
+ return(true);
}
- return(NULL);
-}
-#endif
-typedef s7_pointer (*p0_pf_t)(s7_scheme *sc);
-static s7_pointer p0_pf_1(s7_scheme *sc, s7_pointer **p, p0_pf_t fnc)
-{
- return(fnc(sc));
-}
+ i0 = (s7_int)floor(x0);
+ i1 = (s7_int)ceil(x1);
-static s7_pf_t pf_0(s7_scheme *sc, s7_pointer expr, s7_pf_t fnc)
-{
- if (!is_null(cdr(expr))) return(NULL);
- return(fnc);
-}
+ p0 = i0;
+ q0 = 1;
+ p1 = i1;
+ q1 = 1;
+ e0 = i1 - x0;
+ e1 = x0 - i0;
+ e0p = i1 - x1;
+ e1p = x1 - i0;
-#define PF_0(CName, Pfnc) \
- static s7_pointer CName ## _pf_0(s7_scheme *sc, s7_pointer **rp) {return(p0_pf_1(sc, rp, Pfnc));} \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(pf_0(sc, expr, CName ## _pf_0));}
+ while (true)
+ {
+ s7_int old_p1, old_q1;
+ double old_e0, old_e1, old_e0p, val, r, r1;
+ val = (double)p0 / (double)q0;
-PF_0(curlet, s7_curlet)
-PF_0(rootlet, s7_rootlet)
-PF_0(current_input_port, s7_current_input_port)
-PF_0(current_output_port, s7_current_output_port)
-PF_0(current_error_port, s7_current_error_port)
+ if (((x0 <= val) && (val <= x1)) ||
+ (e1 == 0) ||
+ (e1p == 0) ||
+ (tries > 100))
+ {
+ (*numer) = p0;
+ (*denom) = q0;
+ return(true);
+ }
+ tries++;
-static s7_pointer c_unlet(s7_scheme *sc) {return(g_unlet(sc, sc->nil));}
-PF_0(unlet, c_unlet)
-static s7_pointer c_gc(s7_scheme *sc) {return(g_gc(sc, sc->nil));}
-PF_0(gc, c_gc)
+ r = (s7_int)floor(e0 / e1);
+ r1 = (s7_int)ceil(e0p / e1p);
+ if (r1 < r) r = r1;
+ /* do handles all step vars in parallel */
+ old_p1 = p1;
+ p1 = p0;
+ old_q1 = q1;
+ q1 = q0;
+ old_e0 = e0;
+ e0 = e1p;
+ old_e0p = e0p;
+ e0p = e1;
+ old_e1 = e1;
-/* -------- PF_TO_PF -------- */
-typedef s7_pointer (*pf_pf_t)(s7_scheme *sc, s7_pointer x);
-static s7_pointer pf_pf_1(s7_scheme *sc, s7_pointer **p, pf_pf_t fnc)
-{
- s7_pf_t f;
- s7_pointer x;
- f = (s7_pf_t)(**p); (*p)++;
- x = f(sc, p);
- return(fnc(sc, x));
+ p0 = old_p1 + r * p0;
+ q0 = old_q1 + r * q0;
+ e1 = old_e0p - r * e1p;
+ /* if the error is set too low, we can get e1 = 0 here: (rationalize (/ pi) 1e-17) */
+ e1p = old_e0 - r * old_e1;
+ }
+ return(false);
}
-static s7_pointer pf_pf_s(s7_scheme *sc, s7_pointer **p, pf_pf_t fnc)
+
+s7_pointer s7_rationalize(s7_scheme *sc, s7_double x, s7_double error)
{
- s7_pointer x;
- (*p)++; x = slot_value(**p); (*p)++;
- return(fnc(sc, x));
+ s7_int numer = 0, denom = 1;
+ if (c_rationalize(x, error, &numer, &denom))
+ return(s7_make_ratio(sc, numer, denom));
+ return(make_real(sc, x));
}
-static s7_pf_t pf_1(s7_scheme *sc, s7_pointer expr, s7_pf_t f1, s7_pf_t f2)
+
+static s7_int number_to_numerator(s7_pointer n)
{
- if ((is_pair(cdr(expr))) && (is_null(cddr(expr))))
- {
- ptr_int loc;
- s7_pointer a1;
- a1 = cadr(expr);
- loc = rc_loc(sc);
- if (s7_arg_to_pf(sc, a1)) return((is_symbol(a1)) ? f2 : f1);
- sc->cur_rf->cur = rc_go(sc, loc);
- if (s7_arg_to_gf(sc, a1)) return((is_symbol(a1)) ? f2 : f1);
- }
- return(NULL);
+ if (is_t_ratio(n))
+ return(numerator(n));
+ return(integer(n));
}
-#define PF_TO_PF(CName, Pfnc) \
- static s7_pointer CName ## _pf_p(s7_scheme *sc, s7_pointer **rp) {return(pf_pf_1(sc, rp, Pfnc));} \
- static s7_pointer CName ## _pf_s(s7_scheme *sc, s7_pointer **rp) {return(pf_pf_s(sc, rp, Pfnc));} \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(pf_1(sc, expr, CName ## _pf_p, CName ## _pf_s));}
-
-static s7_pointer c_symbol_to_value(s7_scheme *sc, s7_pointer x) {return(g_symbol_to_value(sc, set_plist_1(sc, x)));}
-PF_TO_PF(symbol_to_value, c_symbol_to_value)
-static s7_pointer c_symbol_to_string(s7_scheme *sc, s7_pointer p) {return(g_symbol_to_string(sc, set_plist_1(sc, p)));}
-PF_TO_PF(symbol_to_string, c_symbol_to_string)
-static s7_pointer c_gensym(s7_scheme *sc, s7_pointer p) {return(g_gensym(sc, set_plist_1(sc, p)));}
-PF_TO_PF(gensym, c_gensym)
-
-static s7_pointer c_not(s7_scheme *sc, s7_pointer x) {return((x == sc->F) ? sc->T : sc->F);}
-PF_TO_PF(not, c_not)
-PF_TO_PF(outlet, s7_outlet)
-PF_TO_PF(openlet, s7_openlet)
-PF_TO_PF(funclet, s7_funclet)
-PF_TO_PF(coverlet, c_coverlet)
-
-#define bool_with_method(Name, Checker, Method) \
- static s7_pointer c_ ## Name (s7_scheme *sc, s7_pointer p) \
- { \
- s7_pointer func; \
- if (Checker(p)) return(sc->T); \
- if ((has_methods(p)) && \
- ((func = find_method(sc, find_let(sc, p), Method)) != sc->undefined)) \
- return(s7_apply_function(sc, func, list_1(sc, p))); \
- return(sc->F); \
- } \
- PF_TO_PF(Name, c_ ## Name)
-
-bool_with_method(is_char, s7_is_character, sc->is_char_symbol)
-bool_with_method(is_boolean, s7_is_boolean, sc->is_boolean_symbol)
-bool_with_method(is_byte_vector, is_byte_vector, sc->is_byte_vector_symbol)
-bool_with_method(is_complex, is_number, sc->is_complex_symbol)
-bool_with_method(is_constant, s7_is_constant, sc->is_constant_symbol)
-bool_with_method(is_continuation, is_continuation, sc->is_continuation_symbol)
-bool_with_method(is_c_pointer, s7_is_c_pointer, sc->is_c_pointer_symbol)
-bool_with_method(is_dilambda, s7_is_dilambda, sc->is_dilambda_symbol)
-bool_with_method(is_eof_object, is_eof, sc->is_eof_object_symbol)
-bool_with_method(is_float_vector, is_float_vector, sc->is_float_vector_symbol)
-bool_with_method(is_gensym, is_gensym, sc->is_gensym_symbol)
-bool_with_method(is_hash_table, is_hash_table, sc->is_hash_table_symbol)
-bool_with_method(is_input_port, is_input_port, sc->is_input_port_symbol)
-bool_with_method(is_integer, is_integer, sc->is_integer_symbol)
-bool_with_method(is_int_vector, is_int_vector, sc->is_int_vector_symbol)
-bool_with_method(is_iterator, is_iterator, sc->is_iterator_symbol)
-bool_with_method(is_keyword, is_keyword, sc->is_keyword_symbol)
-bool_with_method(is_let, is_let, sc->is_let_symbol)
-bool_with_method(is_macro, is_macro, sc->is_macro_symbol)
-bool_with_method(is_null, is_null, sc->is_null_symbol)
-bool_with_method(is_number, is_number, sc->is_number_symbol)
-bool_with_method(is_openlet, s7_is_openlet, sc->is_openlet_symbol)
-bool_with_method(is_output_port, is_output_port, sc->is_output_port_symbol)
-bool_with_method(is_pair, is_pair, sc->is_pair_symbol)
-bool_with_method(is_procedure, is_procedure, sc->is_procedure_symbol)
-bool_with_method(is_rational, is_rational, sc->is_rational_symbol)
-bool_with_method(is_real, is_real, sc->is_real_symbol)
-bool_with_method(is_string, is_string, sc->is_string_symbol)
-bool_with_method(is_symbol, is_symbol, sc->is_symbol_symbol)
-bool_with_method(is_vector, s7_is_vector, sc->is_vector_symbol)
-#define opt_is_list(p) s7_is_list(sc, p)
-bool_with_method(is_list, opt_is_list, sc->is_list_symbol)
-bool_with_method(iterator_is_at_end, iterator_is_at_end, sc->iterator_is_at_end_symbol)
-bool_with_method(is_random_state, is_random_state, sc->is_random_state_symbol)
-
-PF_TO_PF(string_to_keyword, c_string_to_keyword)
-PF_TO_PF(keyword_to_symbol, c_keyword_to_symbol)
-PF_TO_PF(symbol_to_keyword, c_symbol_to_keyword)
-
-static s7_pointer c_symbol(s7_scheme *sc, s7_pointer x) {return(g_string_to_symbol_1(sc, x, sc->symbol_symbol));}
-PF_TO_PF(symbol, c_symbol)
-#if 0
-static s7_pointer symbol_pf_p(s7_scheme *sc, s7_pointer **p)
+static s7_int number_to_denominator(s7_pointer n)
{
- s7_pf_t f;
- s7_pointer x;
- f = (s7_pf_t)(**p); (*p)++;
- x = f(sc, p);
- return(g_string_to_symbol_1(sc, x, sc->symbol_symbol));
+ if (is_t_ratio(n))
+ return(denominator(n));
+ return(1);
}
-#endif
-/* an experiment -- we need a temp pointer per func? */
-static s7_pointer string_to_symbol_pf_p(s7_scheme *sc, s7_pointer **p)
+
+s7_pointer s7_make_integer(s7_scheme *sc, s7_int n)
{
- s7_pf_t f;
s7_pointer x;
- f = (s7_pf_t)(**p); (*p)++;
- x = f(sc, p);
- return(g_string_to_symbol_1(sc, x, sc->string_to_symbol_symbol));
+ if (is_small(n)) /* ((n >= 0) && (n < NUM_SMALL_INTS)) is slower */
+ return(small_int(n));
+
+ new_cell(sc, x, T_INTEGER);
+ integer(x) = n;
+ return(x);
}
-static s7_pointer number_to_string_pf_p(s7_scheme *sc, s7_pointer **p);
-static s7_pointer number_to_string_pf_s(s7_scheme *sc, s7_pointer **p);
-static s7_pointer number_to_string_pf_temp(s7_scheme *sc, s7_pointer **p);
-static s7_pointer number_to_string_pf_s_temp(s7_scheme *sc, s7_pointer **p);
-static s7_pf_t string_to_symbol_pf(s7_scheme *sc, s7_pointer expr)
+static s7_pointer make_mutable_integer(s7_scheme *sc, s7_int n)
{
- if ((is_pair(cdr(expr))) && (is_null(cddr(expr))))
- {
- ptr_int loc;
- loc = rc_loc(sc);
- if (s7_arg_to_pf(sc, cadr(expr)))
- return(string_to_symbol_pf_p);
- sc->cur_rf->cur = rc_go(sc, loc);
- if (s7_arg_to_gf(sc, cadr(expr)))
- {
- if (sc->cur_rf->data[loc] == (s7_pointer)number_to_string_pf_p)
- sc->cur_rf->data[loc] = (s7_pointer)number_to_string_pf_temp;
- if (sc->cur_rf->data[loc] == (s7_pointer)number_to_string_pf_s)
- sc->cur_rf->data[loc] = (s7_pointer)number_to_string_pf_s_temp;
- return(string_to_symbol_pf_p);
- }
- }
- return(NULL);
+ s7_pointer x;
+ new_cell(sc, x, T_INTEGER | T_MUTABLE);
+ integer(x) = n;
+ return(x);
}
-#if (!WITH_PURE_S7)
-PF_TO_PF(let_to_list, s7_let_to_list)
-#endif
-
-/* -------- PF2_TO_PF -------- */
-typedef s7_pointer (*pf2_pf_t)(s7_scheme *sc, s7_pointer x, s7_pointer y);
-static s7_pointer pf2_pf_1(s7_scheme *sc, s7_pointer **p, pf2_pf_t fnc)
+static s7_pointer make_permanent_integer_unchecked(s7_int i)
{
- s7_pf_t f;
- s7_pointer x, y;
- f = (s7_pf_t)(**p); (*p)++;
- x = f(sc, p);
- f = (s7_pf_t)(**p); (*p)++;
- y = f(sc, p);
- return(fnc(sc, x, y));
+ s7_pointer p;
+ p = (s7_pointer)calloc(1, sizeof(s7_cell));
+ typeflag(p) = T_IMMUTABLE | T_INTEGER;
+ unheap(p);
+ integer(p) = i;
+ return(p);
}
-static s7_pointer pf2_pf_sp(s7_scheme *sc, s7_pointer **p, pf2_pf_t fnc)
+static s7_pointer make_permanent_integer(s7_int i)
{
- s7_pf_t f;
- s7_pointer x, y;
- x = slot_value(**p); (*p)++;
- f = (s7_pf_t)(**p); (*p)++;
- y = f(sc, p);
- return(fnc(sc, x, y));
-}
+ if (is_small(i)) return(small_int(i));
-static s7_pointer pf2_pf_ss(s7_scheme *sc, s7_pointer **p, pf2_pf_t fnc)
-{
- s7_pointer x, y;
- x = slot_value(**p); (*p)++;
- y = slot_value(**p); (*p)++;
- return(fnc(sc, x, y));
+ if (i == MAX_ARITY) return(max_arity);
+ if (i == CLOSURE_ARITY_NOT_SET) return(arity_not_set);
+ if (i == -1) return(minus_one);
+ if (i == -2) return(minus_two);
+ /* a few -3 */
+
+ return(make_permanent_integer_unchecked(i));
}
-static s7_pointer pf2_pf_sc(s7_scheme *sc, s7_pointer **p, pf2_pf_t fnc)
+
+s7_pointer s7_make_real(s7_scheme *sc, s7_double n)
{
- s7_pointer x, y;
- x = slot_value(**p); (*p)++;
- y = (**p); (*p)++;
- return(fnc(sc, x, y));
+ s7_pointer x;
+ new_cell(sc, x, T_REAL);
+ set_real(x, n);
+ return(x);
}
-static s7_pointer pf2_pf_pc(s7_scheme *sc, s7_pointer **p, pf2_pf_t fnc)
+
+s7_pointer s7_make_mutable_real(s7_scheme *sc, s7_double n)
{
- s7_pf_t f;
- s7_pointer x, y;
- f = (s7_pf_t)(**p); (*p)++;
- x = f(sc, p);
- y = (**p); (*p)++;
- return(fnc(sc, x, y));
+ s7_pointer x;
+ new_cell(sc, x, T_REAL | T_MUTABLE);
+ set_real(x, n);
+ return(x);
}
-static s7_pf_t pf_2(s7_scheme *sc, s7_pointer expr, s7_pf_t fpp, s7_pf_t fsp, s7_pf_t fss, s7_pf_t fsc, s7_pf_t fpc)
+
+static s7_pointer make_permanent_real(s7_double n)
{
- if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))))
- {
- s7_pointer a1, a2;
- xf_t *rc;
+ s7_pointer x;
+ int nlen = 0;
+ char *str;
- xf_init(2);
- a1 = cadr(expr);
- a2 = caddr(expr);
- if (is_symbol(a1))
- {
- a1 = s7_slot(sc, a1);
- if (!is_slot(a1)) return(NULL);
- xf_store(a1);
- if (is_symbol(a2))
- {
- a2 = s7_slot(sc, a2);
- if (!is_slot(a2)) return(NULL);
- xf_store(a2);
- return(fss);
- }
- if (is_pair(a2))
- {
- if (!s7_arg_to_pf(sc, a2)) return(NULL);
- return(fsp);
- }
- xf_store(a2);
- return(fsc);
- }
- if (s7_arg_to_pf(sc, a1))
- {
- if ((!is_pair(a2)) && (!is_symbol(a2)))
- {
- xf_store(a2);
- return(fpc);
- }
- if (s7_arg_to_pf(sc, a2))
- return(fpp);
- }
- }
- return(NULL);
-}
+ x = (s7_pointer)calloc(1, sizeof(s7_cell));
+ set_type(x, T_IMMUTABLE | T_REAL);
+ unheap(x);
+ set_real(x, n);
-#define PF2_TO_PF(CName, Pfnc) \
- static s7_pointer CName ## _pf_p2(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_1(sc, rp, Pfnc));} \
- static s7_pointer CName ## _pf_p2_sp(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_sp(sc, rp, Pfnc));} \
- static s7_pointer CName ## _pf_p2_ss(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_ss(sc, rp, Pfnc));} \
- static s7_pointer CName ## _pf_p2_sc(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_sc(sc, rp, Pfnc));} \
- static s7_pointer CName ## _pf_p2_pc(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_pc(sc, rp, Pfnc));} \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) \
- { \
- return(pf_2(sc, expr, CName ## _pf_p2, CName ## _pf_p2_sp, CName ## _pf_p2_ss, CName ## _pf_p2_sc, CName ## _pf_p2_pc));\
- }
+ str = number_to_string_base_10(x, 0, float_format_precision, 'g', &nlen, USE_WRITE);
+ set_print_name(x, str, nlen);
+ return(x);
+}
-static s7_pf_t pf_2_x(s7_scheme *sc, s7_pointer expr, bool (*checker)(s7_scheme *sc, s7_pointer obj),
- s7_pf_t fpp, s7_pf_t fpp_x, s7_pf_t fsp, s7_pf_t fss, s7_pf_t fsc, s7_pf_t fpc, s7_pf_t fpc_x)
+s7_pointer s7_make_complex(s7_scheme *sc, s7_double a, s7_double b)
{
- if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))))
+ s7_pointer x;
+ if (b == 0.0)
{
- s7_pointer a1, a2;
- xf_t *rc;
-
- xf_init(2);
- a1 = cadr(expr);
- a2 = caddr(expr);
- if (is_symbol(a1))
- {
- a1 = s7_slot(sc, a1);
- if (!is_slot(a1)) return(NULL);
- xf_store(a1);
- if (is_symbol(a2))
- {
- a2 = s7_slot(sc, a2);
- if (!is_slot(a2)) return(NULL);
- xf_store(a2);
- return(fss);
- }
- if (is_pair(a2))
- {
- if (!s7_arg_to_pf(sc, a2)) return(NULL);
- return(fsp);
- }
- xf_store(a2);
- return(fsc);
- }
- if (s7_arg_to_pf(sc, a1))
- {
- if ((!is_pair(a2)) && (!is_symbol(a2)))
- {
- xf_store(a2);
- if ((checker(sc, a1)) && (checker(sc, a2)))
- return(fpc_x);
- return(fpc);
- }
- if (s7_arg_to_pf(sc, a2))
- {
- if ((checker(sc, a1)) && (checker(sc, a2)))
- return(fpp_x);
- return(fpp);
- }
- }
+ new_cell(sc, x, T_REAL);
+ set_real(x, a);
}
- return(NULL);
+ else
+ {
+ new_cell(sc, x, T_COMPLEX);
+ set_real_part(x, a);
+ set_imag_part(x, b);
+ }
+ return(x);
}
-#define PF2_TO_PF_X(CName, Checker, Pfnc1, Pfnc2) \
- static s7_pointer CName ## _pf_p2_pp(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_1(sc, rp, Pfnc1));} \
- static s7_pointer CName ## _pf_p2_ppx(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_1(sc, rp, Pfnc2));} \
- static s7_pointer CName ## _pf_p2_pc(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_pc(sc, rp, Pfnc1));} \
- static s7_pointer CName ## _pf_p2_pcx(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_pc(sc, rp, Pfnc2));} \
- static s7_pointer CName ## _pf_p2_sp(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_sp(sc, rp, Pfnc1));} \
- static s7_pointer CName ## _pf_p2_ss(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_ss(sc, rp, Pfnc1));} \
- static s7_pointer CName ## _pf_p2_sc(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_sc(sc, rp, Pfnc1));} \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) \
- {\
- return(pf_2_x(sc, expr, Checker, \
- CName ## _pf_p2_pp, CName ## _pf_p2_ppx, \
- CName ## _pf_p2_sp, CName ## _pf_p2_ss, CName ## _pf_p2_sc, \
- CName ## _pf_p2_pc, CName ## _pf_p2_pcx)); \
- }
-
-static s7_pointer c_is_eq(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(make_boolean(sc, x == y));}
-PF2_TO_PF(is_eq, c_is_eq)
-static s7_pointer c_is_eqv(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(make_boolean(sc, s7_is_eqv(x, y)));}
-PF2_TO_PF(is_eqv, c_is_eqv)
-static s7_pointer c_is_equal(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(make_boolean(sc, s7_is_equal(sc, x, y)));}
-PF2_TO_PF(is_equal, c_is_equal)
-static s7_pointer c_is_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(make_boolean(sc, s7_is_morally_equal(sc, x, y)));}
-PF2_TO_PF(is_morally_equal, c_is_morally_equal)
-PF2_TO_PF(let_ref, s7_let_ref)
-
-static s7_pointer c_cutlet(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_cutlet(sc, set_plist_2(sc, x, y)));}
-PF2_TO_PF(cutlet, c_cutlet)
-static s7_pointer c_inlet(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(s7_inlet(sc, set_plist_2(sc, x, y)));}
-PF2_TO_PF(inlet, c_inlet)
-
-
-/* -------- PF3_TO_PF -------- */
-typedef s7_pointer (*pf3_pf_t)(s7_scheme *sc, s7_pointer x, s7_pointer y, s7_pointer z);
-static s7_pointer pf3_pf_1(s7_scheme *sc, s7_pointer **p, pf3_pf_t fnc)
+s7_pointer s7_make_ratio(s7_scheme *sc, s7_int a, s7_int b)
{
- s7_pf_t f;
- s7_pointer x, y, z;
- f = (s7_pf_t)(**p); (*p)++;
- x = f(sc, p);
- f = (s7_pf_t)(**p); (*p)++;
- y = f(sc, p);
- f = (s7_pf_t)(**p); (*p)++;
- z = f(sc, p);
- return(fnc(sc, x, y, z));
-}
+ s7_pointer x;
+ s7_int divisor;
-static s7_pointer pf3_pf_s(s7_scheme *sc, s7_pointer **p, pf3_pf_t fnc)
-{
- s7_pf_t f;
- s7_pointer x, y, z;
- x = slot_value(**p); (*p)++;
- f = (s7_pf_t)(**p); (*p)++;
- y = f(sc, p);
- f = (s7_pf_t)(**p); (*p)++;
- z = f(sc, p);
- return(fnc(sc, x, y, z));
-}
+ if (b == 0)
+ return(division_by_zero_error(sc, make_string_wrapper(sc, "make-ratio"), set_elist_2(sc, make_integer(sc, a), small_int(0))));
+ if (a == 0)
+ return(small_int(0));
+ if (b == 1)
+ return(make_integer(sc, a));
-static s7_pf_t pf_3(s7_scheme *sc, s7_pointer expr, s7_pf_t fp, s7_pf_t fs)
-{
- if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_pair(cdddr(expr))) && (is_null(cddddr(expr))))
+#if (!WITH_GMP)
+ if (b == s7_int_min)
{
- s7_pointer a1;
+ if (a == b)
+ return(small_int(1));
- a1 = cadr(expr);
- if (is_symbol(a1))
+ /* we've got a problem... This should not trigger an error during reading -- we might have the
+ * ratio on a switch with-bignums or whatever, so its mere occurrence is just an annoyance.
+ * We'll try to do something...
+ */
+ if (a & 1)
{
- s7_pointer slot;
- slot = s7_slot(sc, a1);
- if (!is_slot(slot)) return(NULL);
- s7_xf_store(sc, slot);
+ if (a == 1)
+ return(real_NaN);
+ /* not an error here? we can't get this in the ratio reader, I think, because the denominator is negative */
+ b = b + 1;
+ /* so (/ -1 most-negative-fixnum) -> 1/9223372036854775807 -- not ideal, but ... */
}
else
{
- if (!s7_arg_to_pf(sc, a1)) return(NULL);
+ a /= 2;
+ b /= 2;
}
- if ((s7_arg_to_pf(sc, caddr(expr))) &&
- (s7_arg_to_pf(sc, cadddr(expr))))
- return((is_symbol(a1)) ? fs : fp);
}
- return(NULL);
-}
-
-#define PF3_TO_PF(CName, Pfnc) \
- static s7_pointer CName ## _pf_p3(s7_scheme *sc, s7_pointer **rp) {return(pf3_pf_1(sc, rp, Pfnc));} \
- static s7_pointer CName ## _pf_p3_s(s7_scheme *sc, s7_pointer **rp) {return(pf3_pf_s(sc, rp, Pfnc));} \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(pf_3(sc, expr, CName ## _pf_p3, CName ## _pf_p3_s));}
+#endif
-PF3_TO_PF(let_set, s7_let_set)
-PF3_TO_PF(varlet, s7_varlet)
-PF_TO_PF(c_pointer, c_c_pointer)
+ if (b < 0)
+ {
+ a = -a;
+ b = -b;
+ }
+ divisor = c_gcd(a, b);
+ if (divisor != 1)
+ {
+ a /= divisor;
+ b /= divisor;
+ }
+ if (b == 1)
+ return(make_integer(sc, a));
+ new_cell(sc, x, T_RATIO);
+ numerator(x) = a;
+ denominator(x) = b;
-/* -------- PIF_TO_PF -------- */
-typedef s7_pointer (*pif_pf_t)(s7_scheme *sc, s7_pointer x, s7_int y);
-static s7_pointer pif_pf_1(s7_scheme *sc, s7_pointer **p, pif_pf_t fnc)
-{
- s7_pf_t pf;
- s7_if_t xf;
- s7_pointer x;
- s7_int y;
- pf = (s7_pf_t)(**p); (*p)++;
- x = pf(sc, p);
- xf = (s7_if_t)(**p); (*p)++;
- y = xf(sc, p);
- return(fnc(sc, x, y));
-}
-
-static s7_pointer pif_pf_s(s7_scheme *sc, s7_pointer **p, pif_pf_t fnc)
-{
- s7_if_t xf;
- s7_pointer x;
- s7_int y;
- x = slot_value(**p); (*p)++;
- xf = (s7_if_t)(**p); (*p)++;
- y = xf(sc, p);
- return(fnc(sc, x, y));
+ return(x);
}
+/* in fc19 as a guest running in virtualbox on OSX, the line a /= divisor can abort with an arithmetic exception (SIGFPE)
+ * if leastfix/mostfix -- apparently this is a bug in virtualbox.
+ */
-static s7_pointer pif_pf_pp(s7_scheme *sc, s7_pointer **p, pif_pf_t fnc)
-{
- s7_pf_t pf;
- s7_pointer x, y;
- pf = (s7_pf_t)(**p); (*p)++;
- x = pf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- y = pf(sc, p);
- if (!is_integer(y))
- return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "~A should be an integer"), y)));
- return(fnc(sc, x, integer(y)));
-}
-static s7_pointer pif_pf_sp(s7_scheme *sc, s7_pointer **p, pif_pf_t fnc)
-{
- s7_pf_t pf;
- s7_pointer x, y;
- x = slot_value(**p); (*p)++;
- pf = (s7_pf_t)(**p); (*p)++;
- y = pf(sc, p);
- if (!is_integer(y))
- return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "~A should be an integer"), y)));
- return(fnc(sc, x, integer(y)));
-}
+#define WITH_OVERFLOW_ERROR true
+#define WITHOUT_OVERFLOW_ERROR false
-static s7_pf_t pif_1(s7_scheme *sc, s7_pointer expr, s7_pf_t fpi, s7_pf_t fsi, s7_pf_t fpp, s7_pf_t fsp)
+#if (!WITH_PURE_S7) && (!WITH_GMP)
+static s7_pointer exact_to_inexact(s7_scheme *sc, s7_pointer x)
{
- if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))))
+ /* this is tricky because a big int can mess up when turned into a double:
+ * (truncate (exact->inexact most-positive-fixnum)) -> -9223372036854775808
+ */
+ switch (type(x))
{
- s7_pointer a1, a2;
- ptr_int loc;
- a1 = cadr(expr);
- a2 = caddr(expr);
- if (is_symbol(a1))
- {
- s7_pointer slot;
- slot = s7_slot(sc, a1);
- if (!is_slot(slot)) return(NULL);
- s7_xf_store(sc, slot);
- }
- else
- {
- if (!s7_arg_to_pf(sc, a1))
- return(NULL);
- }
- loc = rc_loc(sc);
- if (s7_arg_to_if(sc, a2))
- return((is_symbol(a1)) ? fsi : fpi);
-
- sc->cur_rf->cur = rc_go(sc, loc);
- if (s7_arg_to_pf(sc, a2))
- return((is_symbol(a1)) ? fsp : fpp);
+ case T_INTEGER: return(make_real(sc, (s7_double)(integer(x))));
+ case T_RATIO: return(make_real(sc, (s7_double)(fraction(x))));
+ case T_REAL:
+ case T_COMPLEX: return(x); /* apparently (exact->inexact 1+i) is not an error */
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->exact_to_inexact_symbol, list_1(sc, x), a_number_string);
}
- return(NULL);
-}
-
-#define PIF_TO_PF(CName, Pfnc) \
- static s7_pointer CName ## _pf_pi(s7_scheme *sc, s7_pointer **rp) {return(pif_pf_1(sc, rp, Pfnc));} \
- static s7_pointer CName ## _pf_si(s7_scheme *sc, s7_pointer **rp) {return(pif_pf_s(sc, rp, Pfnc));} \
- static s7_pointer CName ## _pf_pp(s7_scheme *sc, s7_pointer **rp) {return(pif_pf_pp(sc, rp, Pfnc));} \
- static s7_pointer CName ## _pf_sp(s7_scheme *sc, s7_pointer **rp) {return(pif_pf_sp(sc, rp, Pfnc));} \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(pif_1(sc, expr, CName ## _pf_pi, CName ## _pf_si, CName ## _pf_pp, CName ## _pf_sp));}
-
-
-/* -------- PPIF_TO_PF -------- */
-typedef s7_pointer (*ppif_pf_t)(s7_scheme *sc, s7_pointer x, s7_pointer y, s7_int z);
-static s7_pointer ppif_pf_1(s7_scheme *sc, s7_pointer **p, ppif_pf_t fnc) /* other case is pf2_pf_1, type pf2_pf_t */
-{
- s7_pf_t pf;
- s7_if_t xf;
- s7_pointer x, y;
- s7_int z;
- pf = (s7_pf_t)(**p); (*p)++;
- x = pf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- y = pf(sc, p);
- xf = (s7_if_t)(**p); (*p)++;
- z = xf(sc, p);
- return(fnc(sc, x, y, z));
}
-static s7_pf_t ppif_1(s7_scheme *sc, s7_pointer expr, s7_pf_t f1, s7_pf_t f2)
+static s7_pointer inexact_to_exact(s7_scheme *sc, s7_pointer x, bool with_error)
{
- if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))))
+ switch (type(x))
{
- ptr_int loc;
- if (!s7_arg_to_pf(sc, cadr(expr))) return(NULL);
- loc = rc_loc(sc);
- if (!s7_arg_to_pf(sc, caddr(expr)))
- {
- sc->cur_rf->cur = rc_go(sc, loc);
- if (!s7_arg_to_gf(sc, caddr(expr))) return(NULL);
- }
- if (is_null(cdddr(expr))) return(f1);
- if (!is_null(cddddr(expr))) return(NULL);
- if (s7_arg_to_if(sc, cadddr(expr))) return(f2);
- }
- return(NULL);
-}
+ case T_INTEGER:
+ case T_RATIO:
+ return(x);
-#define PPIF_TO_PF(CName, Pfnc1, Pfnc2) \
- static s7_pointer CName ## _pf_pp(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_1(sc, rp, Pfnc1));} \
- static s7_pointer CName ## _pf_ppi(s7_scheme *sc, s7_pointer **rp) {return(ppif_pf_1(sc, rp, Pfnc2));} \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(ppif_1(sc, expr, CName ## _pf_pp, CName ## _pf_ppi));}
+ case T_REAL:
+ {
+ s7_int numer = 0, denom = 1;
+ s7_double val;
+ val = s7_real(x);
+ if ((is_inf(val)) || (is_NaN(val)))
+ {
+ if (with_error)
+ return(simple_wrong_type_argument_with_type(sc, sc->inexact_to_exact_symbol, x, a_normal_real_string));
+ return(sc->nil);
+ }
-/* -------- PIPF_TO_PF -------- */
-typedef s7_pointer (*pipf_pf_t)(s7_scheme *sc, s7_pointer x, s7_int y, s7_pointer z);
-static s7_pointer pipf_pf_slot(s7_scheme *sc, s7_pointer **p, pipf_pf_t fnc)
-{
- s7_pf_t pf;
- s7_pointer x, z;
- s7_int y;
- x = (s7_pointer)(**p); (*p)++;
- y = s7_integer(slot_value(**p)); (*p)++;
- pf = (s7_pf_t)(**p); (*p)++;
- z = pf(sc, p);
- return(fnc(sc, x, y, z));
-}
+ if ((val > s7_int_max) ||
+ (val < s7_int_min))
+ {
+ if (with_error)
+ return(simple_out_of_range(sc, sc->inexact_to_exact_symbol, x, its_too_large_string));
+ return(sc->nil);
+ }
-static s7_pointer pipf_pf_s(s7_scheme *sc, s7_pointer **p, pipf_pf_t fnc)
-{
- s7_pf_t pf;
- s7_if_t xf;
- s7_pointer x, z;
- s7_int y;
- x = (s7_pointer)(**p); (*p)++;
- xf = (s7_if_t)(**p); (*p)++;
- y = xf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- z = pf(sc, p);
- return(fnc(sc, x, y, z));
-}
+ if (c_rationalize(val, sc->default_rationalize_error, &numer, &denom))
+ return(s7_make_ratio(sc, numer, denom));
+ }
-static s7_pointer pipf_pf_seq(s7_scheme *sc, s7_pointer **p, pipf_pf_t fnc) /* used in implicit_sequence_set */
-{
- s7_pf_t pf;
- s7_if_t xf;
- s7_pointer x, z;
- s7_int y;
- x = slot_value(**p); (*p)++;
- xf = (s7_if_t)(**p); (*p)++;
- y = xf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- z = pf(sc, p);
- return(fnc(sc, x, y, z));
+ default:
+ if (with_error)
+ method_or_bust_one_arg(sc, x, sc->inexact_to_exact_symbol, list_1(sc, x), T_REAL);
+ return(sc->nil);
+ }
+ return(x);
}
+#endif
-static s7_pointer pipf_pf_a(s7_scheme *sc, s7_pointer **p, pipf_pf_t fnc)
+s7_double s7_number_to_real_with_caller(s7_scheme *sc, s7_pointer x, const char *caller)
{
- s7_pf_t pf;
- s7_if_t xf;
- s7_pointer x, z;
- s7_int y;
- pf = (s7_pf_t)(**p); (*p)++;
- x = pf(sc, p);
- xf = (s7_if_t)(**p); (*p)++;
- y = xf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- z = pf(sc, p);
- return(fnc(sc, x, y, z));
-}
+ if (is_t_real(x))
+ return(real(x));
+ /* this is nearly always the case in current usage, so by avoiding the "switch" we can go twice as fast */
-enum {TEST_NO_S, TEST_SS, TEST_SI, TEST_SQ}; /* si = sym ind, ss = sym sym for first two */
-typedef int (*pf_i_t)(s7_scheme *sc, s7_pointer x);
-static s7_pf_t pipf_1(s7_scheme *sc, s7_pointer expr, s7_pf_t f1, s7_pf_t f2, s7_pf_t f3, pf_i_t tester)
-{
- if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_pair(cdddr(expr))) && (is_null(cddddr(expr))))
+ switch (type(x))
{
- int choice;
- choice = tester(sc, expr);
- if ((choice == TEST_SS) || (choice == TEST_SI) ||
- ((choice == TEST_NO_S) &&
- (s7_arg_to_pf(sc, cadr(expr))) &&
- (s7_arg_to_if(sc, caddr(expr)))))
- {
- ptr_int loc;
- loc = rc_loc(sc);
- if (s7_arg_to_pf(sc, cadddr(expr)))
- return((choice == TEST_SS) ? f1 : ((choice == TEST_SI) ? f2 : f3));
- sc->cur_rf->cur = rc_go(sc, loc);
- if (s7_arg_to_gf(sc, cadddr(expr)))
- return((choice == TEST_SS) ? f1 : ((choice == TEST_SI) ? f2 : f3));
- }
+ case T_INTEGER: return((s7_double)integer(x));
+ case T_RATIO: return((s7_double)numerator(x) / (s7_double)denominator(x));
+ case T_REAL: return(real(x));
+#if WITH_GMP
+ case T_BIG_INTEGER: return((s7_double)big_integer_to_s7_int(big_integer(x)));
+ case T_BIG_RATIO: return((s7_double)((long double)big_integer_to_s7_int(mpq_numref(big_ratio(x))) /
+ (long double)big_integer_to_s7_int(mpq_denref(big_ratio(x)))));
+ case T_BIG_REAL: return((s7_double)mpfr_get_d(big_real(x), GMP_RNDN));
+#endif
}
- return(NULL);
+ s7_wrong_type_arg_error(sc, caller, 0, x, "a real number");
+ return(0.0);
}
-#define PIPF_TO_PF(CName, F1, F2, Tester) \
- static s7_pointer CName ## _pf_slot(s7_scheme *sc, s7_pointer **rp) {return(pipf_pf_slot(sc, rp, F1));} \
- static s7_pointer CName ## _pf_s(s7_scheme *sc, s7_pointer **rp) {return(pipf_pf_s(sc, rp, F1));} \
- static s7_pointer CName ## _pf_seq(s7_scheme *sc, s7_pointer **rp) {return(pipf_pf_seq(sc, rp, F1));} \
- static s7_pointer CName ## _pf_a(s7_scheme *sc, s7_pointer **rp) {return(pipf_pf_a(sc, rp, F2));} \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(pipf_1(sc, expr, CName ## _pf_slot, CName ## _pf_s, CName ## _pf_a, Tester));}
-
-
-/* -------- IF_TO_IF -------- */
-typedef s7_int (*if_if_t)(s7_scheme *sc, s7_int x);
-static s7_int if_if_1(s7_scheme *sc, s7_pointer **p, if_if_t fnc)
-{
- s7_if_t f;
- s7_int x;
- f = (s7_if_t)(**p); (*p)++;
- x = f(sc, p);
- return(fnc(sc, x));
-}
-static s7_if_t if_1(s7_scheme *sc, s7_pointer expr, s7_if_t f)
+s7_double s7_number_to_real(s7_scheme *sc, s7_pointer x)
{
- if ((is_pair(cdr(expr))) && (is_null(cddr(expr))) && (s7_arg_to_if(sc, cadr(expr))))
- return(f);
- return(NULL);
+ return(s7_number_to_real_with_caller(sc, x, "s7_number_to_real"));
}
-#define IF_TO_IF(CName, Ifnc) \
- static s7_int CName ## _if_i(s7_scheme *sc, s7_pointer **rp) {return(if_if_1(sc, rp, Ifnc));} \
- static s7_if_t CName ## _if(s7_scheme *sc, s7_pointer expr) {return(if_1(sc, expr, CName ## _if_i));}
-
-#if (!WITH_GMP)
-/* -------- IF2_TO_IF -------- */
-typedef s7_int (*if2_if_t)(s7_scheme *sc, s7_int x, s7_int y);
-static s7_int if2_if_1(s7_scheme *sc, s7_pointer **p, if2_if_t fnc)
+s7_int s7_number_to_integer_with_caller(s7_scheme *sc, s7_pointer x, const char *caller)
{
- s7_if_t f;
- s7_int x, y;
- f = (s7_if_t)(**p); (*p)++;
- x = f(sc, p);
- f = (s7_if_t)(**p); (*p)++;
- y = f(sc, p);
- return(fnc(sc, x, y));
+ if (!s7_is_integer(x))
+ s7_wrong_type_arg_error(sc, caller, 0, x, "an integer");
+#if WITH_GMP
+ if (is_t_big_integer(x))
+ return(big_integer_to_s7_int(big_integer(x)));
+#endif
+ return(integer(x));
}
-static s7_if_t if_2(s7_scheme *sc, s7_pointer expr, s7_if_t f)
+s7_int s7_number_to_integer(s7_scheme *sc, s7_pointer x)
{
- if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))) &&
- (s7_arg_to_if(sc, cadr(expr))) &&
- (s7_arg_to_if(sc, caddr(expr))))
- return(f);
- return(NULL);
+ return(s7_number_to_integer_with_caller(sc, x, "s7_number_to_integer"));
}
-#define IF2_TO_IF(CName, Ifnc) \
- static s7_int CName ## _if_i2(s7_scheme *sc, s7_pointer **rp) {return(if2_if_1(sc, rp, Ifnc));} \
- static s7_if_t CName ## _if(s7_scheme *sc, s7_pointer expr) {return(if_2(sc, expr, CName ## _if_i2));}
-
-
-/* -------- IF_3_TO_IF -------- */
-
-typedef s7_int (*if3_if_t)(s7_scheme *sc, s7_int x, s7_int y, s7_int z);
-static s7_int if3_if_1(s7_scheme *sc, s7_pointer **p, if3_if_t fnc)
-{
- s7_if_t f;
- s7_int x, y, z;
- f = (s7_if_t)(**p); (*p)++;
- x = f(sc, p);
- f = (s7_if_t)(**p); (*p)++;
- y = f(sc, p);
- f = (s7_if_t)(**p); (*p)++;
- z = f(sc, p);
- return(fnc(sc, x, y, z));
-}
-static s7_if_t if_3(s7_scheme *sc, s7_pointer expr, s7_if_t f1, s7_if_t f2, s7_if_t f3)
+s7_int s7_numerator(s7_pointer x)
{
- if (!is_pair(cdr(expr))) return(NULL);
- if (!s7_arg_to_if(sc, cadr(expr))) return(NULL);
- if (is_null(cddr(expr))) return(f1);
- if (!s7_arg_to_if(sc, caddr(expr))) return(NULL);
- if (is_null(cdddr(expr))) return(f2);
- if (!s7_arg_to_if(sc, cadddr(expr))) return(NULL);
- if (is_null(cddddr(expr))) return(f3);
- return(NULL);
+ switch (type(x))
+ {
+ case T_INTEGER: return(integer(x));
+ case T_RATIO: return(numerator(x));
+#if WITH_GMP
+ case T_BIG_INTEGER: return(big_integer_to_s7_int(big_integer(x)));
+ case T_BIG_RATIO: return(big_integer_to_s7_int(mpq_numref(big_ratio(x))));
+#endif
+ }
+ return(0);
}
-#define IF_3_TO_IF(CName, Ifnc1, Ifnc2, Ifnc3) \
- static s7_int CName ## _if_i1(s7_scheme *sc, s7_pointer **rp) {return(if_if_1(sc, rp, Ifnc1));} \
- static s7_int CName ## _if_i2(s7_scheme *sc, s7_pointer **rp) {return(if2_if_1(sc, rp, Ifnc2));} \
- static s7_int CName ## _if_i3(s7_scheme *sc, s7_pointer **rp) {return(if3_if_1(sc, rp, Ifnc3));} \
- static s7_if_t CName ## _if(s7_scheme *sc, s7_pointer expr) {return(if_3(sc, expr, CName ## _if_i1, CName ## _if_i2, CName ## _if_i3));}
-#endif /* gmp */
-
-
-/* -------- IF_TO_PF -------- */
-typedef s7_pointer (*if_pf_t)(s7_scheme *sc, s7_int x);
-static s7_pointer if_p_1(s7_scheme *sc, s7_pointer **p, if_pf_t fnc)
-{
- s7_if_t f;
- s7_int x;
- f = (s7_if_t)(**p); (*p)++;
- x = f(sc, p);
- return(fnc(sc, x));
-}
-static s7_pf_t if_pf_1(s7_scheme *sc, s7_pointer expr, s7_pf_t f)
+s7_int s7_denominator(s7_pointer x)
{
- if ((is_pair(cdr(expr))) && (is_null(cddr(expr))) && (s7_arg_to_if(sc, cadr(expr))))
- return(f);
- return(NULL);
+ switch (type(x))
+ {
+ case T_RATIO: return(denominator(x));
+#if WITH_GMP
+ case T_BIG_RATIO: return(big_integer_to_s7_int(mpq_denref(big_ratio(x))));
+#endif
+ }
+ return(1);
}
-#define IF_TO_PF(CName, Ifnc) \
- static s7_pointer CName ## _pf_i(s7_scheme *sc, s7_pointer **rp) {return(if_p_1(sc, rp, Ifnc));} \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(if_pf_1(sc, expr, CName ## _pf_i));}
-
-
-/* -------- PF_TO_IF -------- */
-typedef s7_int (*pf_if_t)(s7_scheme *sc, s7_pointer x);
-static s7_int pf_i_1(s7_scheme *sc, s7_pointer **p, pf_if_t fnc)
-{
- s7_pf_t f;
- s7_pointer x;
- f = (s7_pf_t)(**p); (*p)++;
- x = f(sc, p);
- return(fnc(sc, x));
-}
-static s7_if_t pf_if_1(s7_scheme *sc, s7_pointer expr, s7_if_t f)
+s7_int s7_integer(s7_pointer p)
{
- if ((is_pair(cdr(expr))) && (is_null(cddr(expr))) && (s7_arg_to_pf(sc, cadr(expr))))
- return(f);
- return(NULL);
+#if WITH_GMP
+ if (is_t_big_integer(p))
+ return(big_integer_to_s7_int(big_integer(p)));
+#endif
+ return(integer(p));
}
-#define PF_TO_IF(CName, Pfnc) \
- static s7_int CName ## _if_p(s7_scheme *sc, s7_pointer **rp) {return(pf_i_1(sc, rp, Pfnc));} \
- static s7_if_t CName ## _if(s7_scheme *sc, s7_pointer expr) {return(pf_if_1(sc, expr, CName ## _if_p));}
-
-/* -------- PF_TO_RF -------- */
-typedef s7_double (*pf_rf_t)(s7_scheme *sc, s7_pointer x);
-static s7_double pf_r_1(s7_scheme *sc, s7_pointer **p, pf_rf_t fnc)
-{
- s7_pf_t f;
- s7_pointer x;
- f = (s7_pf_t)(**p); (*p)++;
- x = f(sc, p);
- return(fnc(sc, x));
-}
-
-static s7_rf_t pf_rf_1(s7_scheme *sc, s7_pointer expr, s7_rf_t f)
+s7_double s7_real(s7_pointer p)
{
- if ((is_pair(cdr(expr))) && (is_null(cddr(expr))) && (s7_arg_to_rf(sc, cadr(expr))))
- return(f);
- return(NULL);
+#if WITH_GMP
+ if (is_t_big_real(p))
+ return((s7_double)mpfr_get_d(big_real(p), GMP_RNDN));
+#endif
+ return(real(p));
}
-#define PF_TO_RF(CName, Pfnc) \
- static s7_double CName ## _rf_p(s7_scheme *sc, s7_pointer **rp) {return(pf_r_1(sc, rp, Pfnc));} \
- static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) {return(pf_rf_1(sc, expr, CName ## _rf_p));}
-
#if (!WITH_GMP)
-
-/* -------- RF_TO_IF -------- */
-typedef s7_int (*rf_if_t)(s7_scheme *sc, s7_double x);
-static s7_int rf_i_1(s7_scheme *sc, s7_pointer **p, rf_if_t fnc)
+static s7_complex s7_to_c_complex(s7_pointer p)
{
- s7_rf_t f;
- s7_double x;
- f = (s7_rf_t)(**p); (*p)++;
- x = f(sc, p);
- return(fnc(sc, x));
+#if HAVE_COMPLEX_NUMBERS
+ return(CMPLX(s7_real_part(p), s7_imag_part(p)));
+#else
+ return(0.0);
+#endif
}
-static s7_if_t rf_if_1(s7_scheme *sc, s7_pointer expr, s7_if_t f)
+
+static s7_pointer s7_from_c_complex(s7_scheme *sc, s7_complex z)
{
- if ((is_pair(cdr(expr))) && (is_null(cddr(expr))) && (s7_arg_to_rf(sc, cadr(expr))))
- return(f);
- return(NULL);
+ return(s7_make_complex(sc, creal(z), cimag(z)));
}
+#endif
-#define RF_TO_IF(CName, Rfnc) \
- static s7_int CName ## _if_r(s7_scheme *sc, s7_pointer **rp) {return(rf_i_1(sc, rp, Rfnc));} \
- static s7_if_t CName ## _if(s7_scheme *sc, s7_pointer expr) {return(rf_if_1(sc, expr, CName ## _if_r));}
-#endif /* gmp */
+static int s7_int32_max = 0, s7_int32_min = 0, s7_int_bits = 0, s7_int_digits = 0; /* initialized later */
+static int s7_int_digits_by_radix[17];
-/* -------- RF_TO_PF -------- */
-typedef s7_pointer (*rf_pf_t)(s7_scheme *sc, s7_double x);
-static s7_pointer rf_p_1(s7_scheme *sc, s7_pointer **p, rf_pf_t fnc)
-{
- s7_rf_t f;
- s7_double x;
- f = (s7_rf_t)(**p); (*p)++;
- x = f(sc, p);
- return(fnc(sc, x));
-}
#if (!WITH_GMP)
-
-static s7_pf_t rf_pf_1(s7_scheme *sc, s7_pointer expr, s7_pf_t f)
+static s7_pointer s7_negate(s7_scheme *sc, s7_pointer p) /* can't use "negate" because it confuses C++! */
{
- if ((is_pair(cdr(expr))) && (is_null(cddr(expr))) && (s7_arg_to_rf(sc, cadr(expr))))
- return(f);
- return(NULL);
+ switch (type(p))
+ {
+ case T_INTEGER: return(make_integer(sc, -integer(p)));
+ case T_RATIO: return(s7_make_ratio(sc, -numerator(p), denominator(p)));
+ case T_REAL: return(make_real(sc, -real(p)));
+ default: return(s7_make_complex(sc, -real_part(p), -imag_part(p)));
+ }
}
+#endif
-#define RF_TO_PF(CName, Pfnc) \
- static s7_pointer CName ## _pf_r(s7_scheme *sc, s7_pointer **rp) {return(rf_p_1(sc, rp, Pfnc));} \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(rf_pf_1(sc, expr, CName ## _pf_r));}
-
-
-/* -------- RF_TO_RF -------- */
-typedef s7_double (*rf_rf_t)(s7_scheme *sc, s7_double x);
-static s7_double rf_rf_1(s7_scheme *sc, s7_pointer **p, rf_rf_t fnc)
-{
- s7_rf_t f;
- s7_double x;
- f = (s7_rf_t)(**p); (*p)++;
- x = f(sc, p);
- return(fnc(sc, x));
-}
-static s7_rf_t rf_1(s7_scheme *sc, s7_pointer expr, s7_rf_t f)
+static s7_pointer s7_invert(s7_scheme *sc, s7_pointer p) /* s7_ to be consistent... */
{
- if ((is_pair(cdr(expr))) && (is_null(cddr(expr))) && (s7_arg_to_rf(sc, cadr(expr))))
- return(f);
- return(NULL);
-}
-
-#define RF_TO_RF(CName, Rfnc) \
- static s7_double CName ## _rf_r(s7_scheme *sc, s7_pointer **rp) {return(rf_rf_1(sc, rp, Rfnc));} \
- static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) {return(rf_1(sc, expr, CName ## _rf_r));}
-
-#define DIRECT_RF_TO_RF(CName) \
- static s7_double CName ## _rf_r(s7_scheme *sc, s7_pointer **p) {s7_rf_t f; s7_double x; f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); return(CName(x));} \
- static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) {if (s7_arg_to_rf(sc, s7_cadr(expr))) return(CName ## _rf_r); return(NULL);}
+ switch (type(p))
+ {
+ case T_INTEGER:
+ return(s7_make_ratio(sc, 1, integer(p))); /* a already checked, not 0 */
+ case T_RATIO:
+ return(s7_make_ratio(sc, denominator(p), numerator(p)));
+ case T_REAL:
+ return(make_real(sc, 1.0 / real(p)));
-/* -------- RF2_TO_RF -------- */
-typedef s7_double (*rf2_rf_t)(s7_scheme *sc, s7_double x, s7_double y);
-static s7_double rf2_rf_1(s7_scheme *sc, s7_pointer **p, rf2_rf_t fnc)
-{
- s7_rf_t f;
- s7_double x, y;
- f = (s7_rf_t)(**p); (*p)++;
- x = f(sc, p);
- f = (s7_rf_t)(**p); (*p)++;
- y = f(sc, p);
- return(fnc(sc, x, y));
-}
+ case T_COMPLEX:
+ {
+ s7_double r2, i2, den;
+ r2 = real_part(p);
+ i2 = imag_part(p);
+ den = (r2 * r2 + i2 * i2);
+ return(s7_make_complex(sc, r2 / den, -i2 / den));
+ }
-static s7_rf_t rf_2(s7_scheme *sc, s7_pointer expr, s7_rf_t f)
-{
- if ((is_pair(cdr(expr))) && (is_null(cddr(expr))) &&
- (s7_arg_to_rf(sc, cadr(expr))) &&
- (s7_arg_to_rf(sc, caddr(expr))))
- return(f);
- return(NULL);
+ default:
+ return(wrong_type_argument_with_type(sc, sc->divide_symbol, 1, p, a_number_string));
+ }
}
-#define RF2_TO_RF(CName, Rfnc) \
- static s7_double CName ## _rf_r2(s7_scheme *sc, s7_pointer **rp) {return(rf2_rf_1(sc, rp, Rfnc));} \
- static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) {return(rf_2(sc, expr, CName ## _rf_r2));}
-
-/* -------- RF_3_TO_RF -------- */
-
-typedef s7_double (*rf3_rf_t)(s7_scheme *sc, s7_double x, s7_double y, s7_double z);
-static s7_double rf3_rf_1(s7_scheme *sc, s7_pointer **p, rf3_rf_t fnc)
+static s7_pointer subtract_ratios(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- s7_rf_t f;
- s7_double x, y, z;
- f = (s7_rf_t)(**p); (*p)++;
- x = f(sc, p);
- f = (s7_rf_t)(**p); (*p)++;
- y = f(sc, p);
- f = (s7_rf_t)(**p); (*p)++;
- z = f(sc, p);
- return(fnc(sc, x, y, z));
-}
+ s7_int d1, d2, n1, n2;
+ d1 = number_to_denominator(x);
+ n1 = number_to_numerator(x);
+ d2 = number_to_denominator(y);
+ n2 = number_to_numerator(y);
-static s7_rf_t rf_3(s7_scheme *sc, s7_pointer expr, s7_rf_t f1, s7_rf_t f2, s7_rf_t f3)
-{
- if (!is_pair(cdr(expr))) return(NULL);
- if (!s7_arg_to_rf(sc, cadr(expr))) return(NULL);
- if (is_null(cddr(expr))) return(f1);
- if (!s7_arg_to_rf(sc, caddr(expr))) return(NULL);
- if (is_null(cdddr(expr))) return(f2);
- if (!s7_arg_to_rf(sc, cadddr(expr))) return(NULL);
- if (is_null(cddddr(expr))) return(f3);
- return(NULL);
-}
+ if (d1 == d2) /* the easy case -- if overflow here, it matches the int case */
+ return(s7_make_ratio(sc, n1 - n2, d1));
-#define RF_3_TO_RF(CName, Rfnc1, Rfnc2, Rfnc3) \
- static s7_double CName ## _rf_r1(s7_scheme *sc, s7_pointer **rp) {return(rf_rf_1(sc, rp, Rfnc1));} \
- static s7_double CName ## _rf_r2(s7_scheme *sc, s7_pointer **rp) {return(rf2_rf_1(sc, rp, Rfnc2));} \
- static s7_double CName ## _rf_r3(s7_scheme *sc, s7_pointer **rp) {return(rf3_rf_1(sc, rp, Rfnc3));} \
- static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) {return(rf_3(sc, expr, CName ## _rf_r1, CName ## _rf_r2, CName ## _rf_r3));}
+#if (!WITH_GMP) && HAVE_OVERFLOW_CHECKS
+ {
+ s7_int n1d2, n2d1, d1d2, dn;
+ if ((multiply_overflow(d1, d2, &d1d2)) ||
+ (multiply_overflow(n1, d2, &n1d2)) ||
+ (multiply_overflow(n2, d1, &n2d1)) ||
+ (subtract_overflow(n1d2, n2d1, &dn)))
+ return(make_real(sc, ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2)));
+ return(s7_make_ratio(sc, dn, d1d2));
+ }
+#else
+ return(s7_make_ratio(sc, n1 * d2 - n2 * d1, d1 * d2));
+#endif
+}
-/* -------- R_P_F_TO_PF -------- */
-static s7_pf_t rpf_pf_1(s7_scheme *sc, s7_pointer expr, s7_pf_t fnc1, s7_pf_t fnc2, s7_pf_t fnc3)
+static bool s7_is_negative(s7_pointer obj)
{
- if ((is_pair(cdr(expr))) && (is_null(cddr(expr))))
+ switch (type(obj))
{
- ptr_int loc;
- loc = rc_loc(sc);
- if (s7_arg_to_rf(sc, cadr(expr))) return(fnc1);
- sc->cur_rf->cur = rc_go(sc, loc);
- if (s7_arg_to_pf(sc, cadr(expr))) return(fnc2);
- sc->cur_rf->cur = rc_go(sc, loc);
- if (s7_arg_to_gf(sc, cadr(expr))) return(fnc3);
+ case T_INTEGER: return(integer(obj) < 0);
+ case T_RATIO: return(numerator(obj) < 0);
+#if WITH_GMP
+ case T_BIG_INTEGER: return(mpz_cmp_ui(big_integer(obj), 0) < 0);
+ case T_BIG_RATIO: return(mpq_cmp_ui(big_ratio(obj), 0, 1) < 0);
+ case T_BIG_REAL: return(mpfr_cmp_ui(big_real(obj), 0) < 0);
+#endif
+ default: return(real(obj) < 0);
}
- return(NULL);
}
-#define R_P_F_TO_PF(CName, PFnc1, PFnc2, PFnc3) \
- static s7_pointer CName ## _pf_r(s7_scheme *sc, s7_pointer **rp) {return(rf_p_1(sc, rp, PFnc1));} \
- static s7_pointer CName ## _pf_p(s7_scheme *sc, s7_pointer **rp) {return(pf_pf_1(sc, rp, PFnc2));} \
- static s7_pointer CName ## _pf_g(s7_scheme *sc, s7_pointer **rp) {return(pf_pf_1(sc, rp, PFnc3));} \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(rpf_pf_1(sc, expr, CName ## _pf_r, CName ## _pf_p, CName ## _pf_g));}
-
-#endif /* gmp */
-/* -------- XF_TO_PF -------- */
-static s7_pf_t xf_pf_1(s7_scheme *sc, s7_pointer expr, s7_pf_t f1, s7_pf_t f2, s7_pf_t f3)
+static bool s7_is_positive(s7_pointer x)
{
- if ((is_pair(cdr(expr))) && (is_null(cddr(expr))))
+ switch (type(x))
{
- ptr_int loc;
- loc = rc_loc(sc);
- if (s7_arg_to_if(sc, cadr(expr))) return(f1);
- sc->cur_rf->cur = rc_go(sc, loc);
- if (s7_arg_to_rf(sc, cadr(expr))) return(f2);
- sc->cur_rf->cur = rc_go(sc, loc);
- if (s7_arg_to_pf(sc, cadr(expr))) return(f3);
+ case T_INTEGER: return(integer(x) > 0);
+ case T_RATIO: return(numerator(x) > 0);
+#if WITH_GMP
+ case T_BIG_INTEGER: return(mpz_cmp_ui(big_integer(x), 0) > 0);
+ case T_BIG_RATIO: return(mpq_cmp_ui(big_ratio(x), 0, 1) > 0);
+ case T_BIG_REAL: return(mpfr_cmp_ui(big_real(x), 0) > 0);
+#endif
+ default: return(real(x) > 0.0);
}
- return(NULL);
}
-#define XF_TO_PF(CName, PFnc1, PFnc2, PFnc3) \
- static s7_pointer CName ## _pf_i(s7_scheme *sc, s7_pointer **rp) {return(if_p_1(sc, rp, PFnc1));} \
- static s7_pointer CName ## _pf_r(s7_scheme *sc, s7_pointer **rp) {return(rf_p_1(sc, rp, PFnc2));} \
- static s7_pointer CName ## _pf_p(s7_scheme *sc, s7_pointer **rp) {return(pf_pf_1(sc, rp, PFnc3));} \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(xf_pf_1(sc, expr, CName ## _pf_i, CName ## _pf_r, CName ## _pf_p));}
-
-/* -------- XF2_TO_PF -------- */
-typedef s7_pointer (*if2_pf_t)(s7_scheme *sc, s7_int x, s7_int y);
-typedef s7_pointer (*rf2_pf_t)(s7_scheme *sc, s7_double x, s7_double y);
-static s7_pointer if2_pf_1(s7_scheme *sc, s7_pointer **p, if2_pf_t fnc)
-{
- s7_if_t f;
- s7_int x, y;
- f = (s7_if_t)(**p); (*p)++; x = f(sc, p);
- f = (s7_if_t)(**p); (*p)++; y = f(sc, p);
- return(fnc(sc, x, y));
-}
-
-static s7_pointer rf2_pf_1(s7_scheme *sc, s7_pointer **p, rf2_pf_t fnc)
-{
- s7_rf_t f;
- s7_double x, y;
- f = (s7_rf_t)(**p); (*p)++; x = f(sc, p);
- f = (s7_rf_t)(**p); (*p)++; y = f(sc, p);
- return(fnc(sc, x, y));
-}
-
-static s7_pointer rf2_pf_sc(s7_scheme *sc, s7_pointer **p, rf2_pf_t fnc)
-{
- s7_pointer xp, yp;
- (*p)++;
- xp = slot_value(**p); (*p) += 2;
- yp = (**p); (*p)++;
- if ((is_t_real(xp)) && (is_t_real(yp)))
- return(fnc(sc, real(xp), real(yp)));
- return(fnc(sc, s7_number_to_real(sc, xp), s7_number_to_real(sc, yp)));
-}
-
-static s7_pf_t xf2_pf_1(s7_scheme *sc, s7_pointer expr, s7_pf_t f1, s7_pf_t f2, s7_pf_t f3, s7_pf_t f4, s7_pf_t f5)
+static bool s7_is_zero(s7_pointer x)
{
- if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))))
+ switch (type(x))
{
- ptr_int loc;
- s7_pointer a1, a2;
- a1 = cadr(expr);
- a2 = caddr(expr);
- if ((is_symbol(a1)) && (is_symbol(a2)))
- {
- a1 = s7_slot(sc, a1);
- if (!is_slot(a1)) return(NULL);
- s7_xf_store(sc, a1);
- a2 = s7_slot(sc, a2);
- if (!is_slot(a2)) return(NULL);
- s7_xf_store(sc, a2);
- return(f5);
- }
- loc = rc_loc(sc);
- if ((s7_arg_to_if(sc, a1)) && (s7_arg_to_if(sc, a2))) return(f1);
- sc->cur_rf->cur = rc_go(sc, loc);
- if ((s7_arg_to_rf(sc, a1)) && (s7_arg_to_rf(sc, a2))) return(((is_symbol(a1)) && (is_real(a2))) ? f3 : f2);
- sc->cur_rf->cur = rc_go(sc, loc);
- if ((s7_arg_to_pf(sc, a1)) && (s7_arg_to_pf(sc, a2))) return(f4);
+ case T_INTEGER: return(integer(x) == 0);
+ case T_REAL: return(real(x) == 0.0);
+#if WITH_GMP
+ case T_BIG_INTEGER: return(mpz_cmp_ui(big_integer(x), 0) == 0);
+ case T_BIG_REAL: return(mpfr_zero_p(big_real(x)));
+#endif
+ default: return(false); /* ratios and complex numbers here are already collapsed into integers and reals */
}
- return(NULL);
}
-#define XF2_TO_PF(CName, PFnc1, PFnc2, PFnc3) \
- static s7_pointer CName ## _pf_i2(s7_scheme *sc, s7_pointer **rp) {return(if2_pf_1(sc, rp, PFnc1));} \
- static s7_pointer CName ## _pf_r2(s7_scheme *sc, s7_pointer **rp) {return(rf2_pf_1(sc, rp, PFnc2));} \
- static s7_pointer CName ## _pf_r2_sc(s7_scheme *sc, s7_pointer **rp) {return(rf2_pf_sc(sc, rp, PFnc2));} \
- static s7_pointer CName ## _pf_p2(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_1(sc, rp, PFnc3));} \
- static s7_pointer CName ## _pf_ss(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_ss(sc, rp, PFnc3));} \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) \
- {\
- return(xf2_pf_1(sc, expr, CName ## _pf_i2, CName ## _pf_r2, CName ## _pf_r2_sc, CName ## _pf_p2, CName ## _pf_ss)); \
- }
-#if WITH_OPTIMIZATION
-static s7_pointer if_pf_xx(s7_scheme *sc, s7_pointer **p)
+static bool s7_is_one(s7_pointer x)
{
- s7_pf_t test, t;
- s7_pointer val;
- ptr_int e1;
-
- test = (s7_pf_t)(**p); (*p)++;
- t = (s7_pf_t)(**p); (*p)++;
- e1 = (ptr_int)(**p); (*p)++;
-
- val = test(sc, p);
- if (val != sc->F)
- val = t(sc, p);
- else val = sc->unspecified;
- (*p) = rc_go(sc, e1);
-
- return(val);
+ return(((is_integer(x)) && (integer(x) == 1)) ||
+ ((is_t_real(x)) && (real(x) == 1.0)));
}
-static s7_pointer if_pf_not_xx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pf_t test, t;
- s7_pointer val;
- ptr_int e1;
-
- test = (s7_pf_t)(**p); (*p)++;
- t = (s7_pf_t)(**p); (*p)++;
- e1 = (ptr_int)(**p); (*p)++;
-
- val = test(sc, p);
- if (val == sc->F)
- val = t(sc, p);
- else val = sc->unspecified;
- (*p) = rc_go(sc, e1);
- return(val);
-}
-
-#if (!WITH_GMP)
-static s7_pointer equal_p2(s7_scheme *sc, s7_pointer **p);
-#endif
-static s7_pointer c_equal_2(s7_scheme *sc, s7_pointer x, s7_pointer y);
+/* optimize exponents */
+#define MAX_POW 32
+static double pepow[17][MAX_POW], mepow[17][MAX_POW];
-static s7_pointer if_pf_not_equal_2(s7_scheme *sc, s7_pointer **p)
+static void init_pows(void)
{
- s7_pf_t t, eq2;
- s7_pointer val, x, y;
- ptr_int e1;
-
- (*p)++;
- t = (s7_pf_t)(**p); (*p)++;
- e1 = (ptr_int)(**p); (*p)++;
-
- eq2 = (s7_pf_t)(**p); (*p)++;
- x = eq2(sc, p);
- eq2 = (s7_pf_t)(**p); (*p)++;
- y = eq2(sc, p);
-
- if (c_equal_2(sc, x, y) == sc->F)
- val = t(sc, p);
- else val = sc->unspecified;
- (*p) = rc_go(sc, e1);
-
- return(val);
+ int i, j;
+ for (i = 2; i < 17; i++) /* radix between 2 and 16 */
+ for (j = 0; j < MAX_POW; j++) /* saved exponent between 0 and +/- MAX_POW */
+ {
+ pepow[i][j] = pow((double)i, (double)j);
+ mepow[i][j] = pow((double)i, (double)(-j));
+ }
}
-static s7_pointer if_pf_xxx(s7_scheme *sc, s7_pointer **p)
+static double ipow(int x, int y)
{
- s7_pointer x;
- s7_pf_t r1, r2;
- s7_pf_t pf;
- s7_pointer val;
- ptr_int e1, e2;
-
- pf = (s7_pf_t)(**p); (*p)++;
- r1 = (s7_pf_t)(**p); (*p)++;
- e1 = (ptr_int)(**p); (*p)++;
- r2 = (s7_pf_t)(**p); (*p)++;
- e2 = (ptr_int)(**p); (*p)++;
-
- val = pf(sc, p);
- if (val != sc->F)
- {
- x = r1(sc, p);
- (*p) = rc_go(sc, e2);
- }
- else
+ if ((y < MAX_POW) && (y > (-MAX_POW)))
{
- (*p) = rc_go(sc, e1);
- x = r2(sc, p);
+ if (y >= 0)
+ return(pepow[x][y]);
+ return(mepow[x][-y]);
}
- return(x);
+ return(pow((double)x, (double)y));
}
-static s7_pf_t if_pf(s7_scheme *sc, s7_pointer expr)
+
+static int s7_int_to_string(char *p, s7_int n, int radix, int width)
{
- s7_pointer test, t, f = NULL;
- s7_int test_loc, t_loc, f_loc = 0, e1_loc, e2_loc = 0;
- bool not_case = false;
- ptr_int loc;
- xf_t *rc;
+ static const char dignum[] = "0123456789abcdef";
+ int i, len, start, end;
+ bool sign;
+ s7_int pown;
+
+ if ((radix < 2) || (radix > 16))
+ return(0);
- if ((is_null(cdr(expr))) || (is_null(cddr(expr)))) return(NULL);
- test = cadr(expr);
- if ((is_pair(test)) && (car(test) == sc->not_symbol))
+ if (n == s7_int_min) /* can't negate this, so do it by hand */
{
- not_case = true;
- test = cadr(test);
+ static const char *mnfs[17] = {"","",
+ "-1000000000000000000000000000000000000000000000000000000000000000", "-2021110011022210012102010021220101220222",
+ "-20000000000000000000000000000000", "-1104332401304422434310311213", "-1540241003031030222122212",
+ "-22341010611245052052301", "-1000000000000000000000", "-67404283172107811828", "-9223372036854775808",
+ "-1728002635214590698", "-41a792678515120368", "-10b269549075433c38", "-4340724c6c71dc7a8", "-160e2ad3246366808", "-8000000000000000"};
+
+ len = safe_strlen(mnfs[radix]);
+ if (width > len)
+ {
+ start = width - len - 1;
+ memset((void *)p, (int)' ', start);
+ }
+ else start = 0;
+ for (i = 0; i < len; i++)
+ p[start + i] = mnfs[radix][i];
+ p[len + start] = '\0';
+ return(len + start);
}
- t = caddr(expr);
- xf_init(5);
- xf_save_loc3(test_loc, t_loc, e1_loc);
+ sign = (n < 0);
+ if (sign) n = -n;
- if (is_pair(cdddr(expr)))
+ /* the previous version that counted up to n, rather than dividing down below n, as here,
+ * could be confused by large ints on 64 bit machines
+ */
+ pown = n;
+ for (i = 1; i < 100; i++)
{
- f = cadddr(expr);
- xf_save_loc2(f_loc, e2_loc);
+ if (pown < radix)
+ break;
+ pown /= (s7_int)radix;
}
-
- if (!arg_to_pf(sc, test, test_loc)) return(NULL);
- loc = rc_loc(sc);
- if (!arg_to_pf(sc, t, t_loc))
+ len = i - 1;
+ if (sign) len++;
+ end = 0;
+ if (width > len) /* (format #f "~10B" 123) */
+ {
+ start = width - len - 1;
+ end += start;
+ memset((void *)p, (int)' ', start);
+ }
+ else
{
- sc->cur_rf->cur = rc_go(sc, loc);
- if (!arg_to_if(sc, t, t_loc)) return(NULL);
+ start = 0;
+ end = 0;
}
- xf_store_at(e1_loc, (s7_pointer)rc_loc(sc));
- if (f)
+ if (sign)
{
- if (!arg_to_pf(sc, f, f_loc)) return(NULL);
- xf_store_at(e2_loc, (s7_pointer)rc_loc(sc));
+ p[start] = '-';
+ end++;
}
- if (!f)
+ for (i = start + len; i >= end; i--)
{
- if (not_case)
- {
-#if (!WITH_GMP)
- if ((s7_pointer)equal_p2 == sc->cur_rf->data[test_loc])
- return(if_pf_not_equal_2);
-#endif
- return(if_pf_not_xx);
- }
- return(if_pf_xx);
+ p[i] = dignum[n % radix];
+ n /= radix;
}
- return(if_pf_xxx);
+ p[len + start + 1] = '\0';
+ return(len + start + 1);
}
-static s7_double if_rf_xxx(s7_scheme *sc, s7_pointer **p)
+static char *integer_to_string_base_10_no_width(s7_pointer obj, int *nlen) /* do not free the returned string */
{
- s7_double x;
- s7_rf_t r1, r2;
- s7_pf_t pf;
- s7_pointer val;
- ptr_int e1, e2;
-
- pf = (s7_pf_t)(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- r2 = (s7_rf_t)(**p); (*p)++;
- e1 = (ptr_int)(**p); (*p)++;
- e2 = (ptr_int)(**p); (*p)++;
+ long long int num;
+ char *p, *op;
+ bool sign;
+ static char int_to_str[INT_TO_STR_SIZE];
- val = pf(sc, p);
- if (val != sc->F)
+ if (has_print_name(obj))
{
- x = r1(sc, p);
- (*p) = rc_go(sc, e2);
+ (*nlen) = print_name_length(obj);
+ return((char *)print_name(obj));
}
- else
+ /* (*nlen) = snprintf(int_to_str, INT_TO_STR_SIZE, "%lld", (long long int)integer(obj));
+ * but that is very slow -- the following code is 6 times faster
+ */
+ num = (long long int)integer(obj);
+ if (num == s7_int_min)
{
- (*p) = rc_go(sc, e1);
- x = r2(sc, p);
+ (*nlen) = 20;
+ return((char *)"-9223372036854775808");
}
- return(x);
-}
-
-static s7_rf_t if_rf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer test, t, f;
- s7_int test_loc, t_loc, f_loc = 0, e1_loc = 0, e2_loc;
- xf_t *rc;
-
- if ((is_null(cdr(expr))) || (is_null(cddr(expr))) || (is_null(cdddr(expr)))) return(NULL);
- test = cadr(expr);
- t = caddr(expr);
- f = cadddr(expr);
- xf_init(5);
-
- xf_save_loc3(test_loc, t_loc, f_loc);
- xf_save_loc2(e1_loc, e2_loc);
-
- if (!arg_to_pf(sc, test, test_loc)) return(NULL);
- if (!arg_to_rf(sc, t, t_loc)) return(NULL);
- xf_store_at(e1_loc, (s7_pointer)rc_loc(sc));
- if (!arg_to_rf(sc, f, f_loc)) return(NULL);
- xf_store_at(e2_loc, (s7_pointer)rc_loc(sc));
-
- return(if_rf_xxx);
-}
-
-static s7_pointer quote_pf_s(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s;
- s = **p; (*p)++;
- return(s);
-}
+ p = (char *)(int_to_str + INT_TO_STR_SIZE - 1);
+ op = p;
+ *p-- = '\0';
-static s7_pf_t quote_pf(s7_scheme *sc, s7_pointer expr)
-{
- if (is_symbol(cadr(expr)))
+ sign = (num < 0);
+ if (sign) num = -num; /* we need a positive index below */
+ do {*p-- = "0123456789"[num % 10]; num /= 10;} while (num);
+ if (sign)
{
- xf_t *rc;
- xf_init(1);
- xf_store(cadr(expr));
- return(quote_pf_s);
+ *p = '-';
+ (*nlen) = op - p;
+ return(p);
}
- return(NULL);
+
+ (*nlen) = op - p - 1;
+ return(++p);
}
-static s7_pointer or_pf_xx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pf_t pf1, pf2;
- ptr_int e1;
- s7_pointer val;
- pf1 = (s7_pf_t)(**p); (*p)++;
- pf2 = (s7_pf_t)(**p); (*p)++;
- e1 = (ptr_int)(**p); (*p)++;
+#define BASE_10 10
+static int num_to_str_size = -1;
+static char *num_to_str = NULL;
+static const char *float_format_g = NULL;
- val = pf1(sc, p);
- if (val != sc->F)
+static char *floatify(char *str, int *nlen)
+{
+ if ((!strchr(str, 'e')) &&
+ (!strchr(str, '.')))
{
- (*p) = rc_go(sc, e1);
- return(val);
+ /* this assumes there is room in str for 2 more chars */
+ int len;
+ len = *nlen;
+ str[len]='.';
+ str[len + 1]='0';
+ str[len + 2]='\0';
+ (*nlen) = len + 2;
}
- return(pf2(sc, p));
+ return(str);
}
-static s7_pf_t or_pf(s7_scheme *sc, s7_pointer expr)
+static char *number_to_string_base_10(s7_pointer obj, int width, int precision, char float_choice, int *nlen, use_write_t choice) /* don't free result */
{
+ /* the rest of s7 assumes nlen is set to the correct length
+ * a tricky case: (format #f "~f" 1e308) -- tries to print 308 digits! so 256 as default len is too small.
+ * but then even worse: (format #f "~F" 1e308+1e308i)!
+ */
int len;
- len = s7_list_length(sc, expr);
- if (len == 3)
+ len = 1024;
+ if (width > len) len = 2 * width;
+ if (len > num_to_str_size)
+ {
+ if (!num_to_str)
+ num_to_str = (char *)malloc(len * sizeof(char));
+ else num_to_str = (char *)realloc(num_to_str, len * sizeof(char));
+ num_to_str_size = len;
+ }
+
+ /* bignums can't happen here */
+ switch (type(obj))
{
- int loc1, loc2, eloc;
- xf_t *rc;
- xf_init(3);
- xf_save_loc3(loc1, loc2, eloc);
+ case T_INTEGER:
+ if (width == 0)
+ return(integer_to_string_base_10_no_width(obj, nlen));
+ (*nlen) = snprintf(num_to_str, num_to_str_size, "%*" LL_D, width, (long long int)integer(obj));
+ break;
+
+ case T_RATIO:
+ len = snprintf(num_to_str, num_to_str_size, "%" LL_D "/%" LL_D, (long long int)numerator(obj), (long long int)denominator(obj));
+ if (width > len)
+ {
+ int spaces;
+ if (width >= num_to_str_size)
+ {
+ num_to_str_size = width + 1;
+ num_to_str = (char *)realloc(num_to_str, num_to_str_size * sizeof(char));
+ }
+ spaces = width - len;
+ num_to_str[width] = '\0';
+ memmove((void *)(num_to_str + spaces), (void *)num_to_str, len);
+ memset((void *)num_to_str, (int)' ', spaces);
+ (*nlen) = width;
+ }
+ else (*nlen) = len;
+ break;
+
+ case T_REAL:
+ {
+ const char *frmt;
+ if (sizeof(double) >= sizeof(s7_double))
+ frmt = (float_choice == 'g') ? "%*.*g" : ((float_choice == 'f') ? "%*.*f" : "%*.*e");
+ else frmt = (float_choice == 'g') ? "%*.*Lg" : ((float_choice == 'f') ? "%*.*Lf" : "%*.*Le");
+
+ len = snprintf(num_to_str, num_to_str_size - 4, frmt, width, precision, s7_real(obj)); /* -4 for floatify */
+ (*nlen) = len;
+ floatify(num_to_str, nlen);
+ }
+ break;
+
+ default:
+ {
+ if ((choice == USE_READABLE_WRITE) &&
+ ((is_NaN(real_part(obj))) || (is_NaN(imag_part(obj))) || ((is_inf(real_part(obj))) || (is_inf(imag_part(obj))))))
+ {
+ char rbuf[128], ibuf[128];
+ char *rp, *ip;
+ if (is_NaN(real_part(obj)))
+ rp = (char *)"nan.0";
+ else
+ {
+ if (is_inf(real_part(obj)))
+ {
+ if (real_part(obj) < 0.0)
+ rp = (char *)"-inf.0";
+ else rp = (char *)"inf.0";
+ }
+ else
+ {
+ snprintf(rbuf, 128, float_format_g, precision, real_part(obj));
+ rp = rbuf;
+ }
+ }
+ if (is_NaN(imag_part(obj)))
+ ip = (char *)"nan.0";
+ else
+ {
+ if (is_inf(imag_part(obj)))
+ {
+ if (imag_part(obj) < 0.0)
+ ip = (char *)"-inf.0";
+ else ip = (char *)"inf.0";
+ }
+ else
+ {
+ snprintf(ibuf, 128, float_format_g, precision, imag_part(obj));
+ ip = ibuf;
+ }
+ }
+ len = snprintf(num_to_str, num_to_str_size, "(complex %s %s)", rp, ip);
+ }
+ else
+ {
+ const char *frmt;
+ if (sizeof(double) >= sizeof(s7_double))
+ {
+ if (imag_part(obj) >= 0.0)
+ frmt = (float_choice == 'g') ? "%.*g+%.*gi" : ((float_choice == 'f') ? "%.*f+%.*fi" : "%.*e+%.*ei");
+ else frmt = (float_choice == 'g') ? "%.*g%.*gi" : ((float_choice == 'f') ? "%.*f%.*fi" :"%.*e%.*ei"); /* minus sign comes with the imag_part */
+ }
+ else
+ {
+ if (imag_part(obj) >= 0.0)
+ frmt = (float_choice == 'g') ? "%.*Lg+%.*Lgi" : ((float_choice == 'f') ? "%.*Lf+%.*Lfi" : "%.*Le+%.*Lei");
+ else frmt = (float_choice == 'g') ? "%.*Lg%.*Lgi" : ((float_choice == 'f') ? "%.*Lf%.*Lfi" : "%.*Le%.*Lei");
+ }
- if (!arg_to_pf(sc, cadr(expr), loc1)) return(NULL);
- if (!arg_to_pf(sc, caddr(expr), loc2)) return(NULL);
- xf_store_at(eloc, (s7_pointer)rc_loc(sc));
+ len = snprintf(num_to_str, num_to_str_size, frmt, precision, real_part(obj), precision, imag_part(obj));
+ }
- return(or_pf_xx);
+ if (width > len) /* (format #f "~20g" 1+i) */
+ {
+ int spaces;
+ if (width >= num_to_str_size)
+ {
+ num_to_str_size = width + 1;
+ num_to_str = (char *)realloc(num_to_str, num_to_str_size * sizeof(char));
+ }
+ spaces = width - len;
+ num_to_str[width] = '\0';
+ memmove((void *)(num_to_str + spaces), (void *)num_to_str, len);
+ memset((void *)num_to_str, (int)' ', spaces);
+ (*nlen) = width;
+ }
+ else (*nlen) = len;
+ }
+ break;
}
- return(NULL);
+ return(num_to_str);
}
-static s7_pointer and_pf_xx(s7_scheme *sc, s7_pointer **p)
+
+static char *number_to_string_with_radix(s7_scheme *sc, s7_pointer obj, int radix, int width, int precision, char float_choice, int *nlen)
{
- s7_pf_t pf1, pf2;
- ptr_int e1;
+ /* the rest of s7 assumes nlen is set to the correct length */
+ char *p;
+ int len, str_len;
- pf1 = (s7_pf_t)(**p); (*p)++;
- pf2 = (s7_pf_t)(**p); (*p)++;
- e1 = (ptr_int)(**p); (*p)++;
+#if WITH_GMP
+ if (s7_is_bignum(obj))
+ return(big_number_to_string_with_radix(obj, radix, width, nlen, USE_WRITE));
+ /* this ignores precision because it's way too hard to get the mpfr string to look like
+ * C's output -- we either have to call mpfr_get_str twice (the first time just to
+ * find out what the exponent is and how long the string actually is), or we have
+ * to do messy string manipulations. So (format #f "",3F" pi) ignores the "3" and
+ * prints the full string.
+ */
+#endif
- if (pf1(sc, p) == sc->F)
+ if (radix == 10)
{
- (*p) = rc_go(sc, e1);
- return(sc->F);
+ p = number_to_string_base_10(obj, width, precision, float_choice, nlen, USE_WRITE);
+ return(copy_string_with_length(p, *nlen));
}
- return(pf2(sc, p));
-}
-static s7_pf_t and_pf(s7_scheme *sc, s7_pointer expr)
-{
- int len;
- len = s7_list_length(sc, expr);
- if (len == 3)
+ switch (type(obj))
{
- s7_int loc1, loc2, eloc;
- xf_t *rc;
- xf_init(3);
- xf_save_loc3(loc1, loc2, eloc);
-
- if (!arg_to_pf(sc, cadr(expr), loc1)) return(NULL);
- if (!arg_to_pf(sc, caddr(expr), loc2)) return(NULL);
- xf_store_at(eloc, (s7_pointer)rc_loc(sc));
+ case T_INTEGER:
+ p = (char *)malloc((128 + width) * sizeof(char));
+ *nlen = s7_int_to_string(p, s7_integer(obj), radix, width);
+ return(p);
- return(and_pf_xx);
- }
- return(NULL);
-}
-#endif
+ case T_RATIO:
+ {
+ char n[128], d[128];
+ s7_int_to_string(n, numerator(obj), radix, 0);
+ s7_int_to_string(d, denominator(obj), radix, 0);
+ p = (char *)malloc(256 * sizeof(char));
+ len = snprintf(p, 256, "%s/%s", n, d);
+ str_len = 256;
+ }
+ break;
+ case T_REAL:
+ {
+ int i;
+ s7_int int_part;
+ s7_double x, frac_part, min_frac, base;
+ bool sign = false;
+ char n[128], d[256];
-/* -------------------------------- continuations and gotos -------------------------------- */
+ x = s7_real(obj);
-static s7_pointer g_is_continuation(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_continuation "(continuation? obj) returns #t if obj is a continuation"
- #define Q_is_continuation pl_bt
+ if (is_NaN(x))
+ return(copy_string_with_length("nan.0", *nlen = 5));
+ if (is_inf(x))
+ {
+ if (x < 0.0)
+ return(copy_string_with_length("-inf.0", *nlen = 6));
+ return(copy_string_with_length("inf.0", *nlen = 5));
+ }
- check_boolean_method(sc, is_continuation, sc->is_continuation_symbol, args);
- /* is this the right thing? It returns #f for call-with-exit ("goto") because
- * that form of continuation can't continue (via a jump back to its context).
- * how to recognize the call-with-exit function? "goto" is an internal name.
- */
-}
+ if (x < 0.0)
+ {
+ sign = true;
+ x = -x;
+ }
+ if (x > 1.0e18) /* i.e. close to or greater than most-positive-fixnum (9.22e18), so the code below is unlikely to work, (format #f "~X" 1e19) */
+ {
+ int ep;
+ char *p1;
+ s7_pointer r;
-static s7_pointer protected_list_copy(s7_scheme *sc, s7_pointer a)
-{
- s7_pointer slow, fast, p;
+ len = 0;
+ ep = (int)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));
+ (*nlen) = snprintf(p, len + 8, "%s%se%d", (sign) ? "-" : "", p1, ep);
+ free(p1);
+ return(p);
+ }
- sc->w = cons(sc, car(a), sc->nil);
- p = sc->w;
+ int_part = (s7_int)floor(x);
+ frac_part = x - int_part;
+ s7_int_to_string(n, int_part, radix, 0);
+ min_frac = (s7_double)ipow(radix, -precision);
- slow = fast = cdr(a);
- while (true)
- {
- if (!is_pair(fast))
- {
- if (is_null(fast))
- return(sc->w);
- set_cdr(p, fast);
- return(sc->w);
- }
+ /* doesn't this assume precision < 128/256 and that we can fit in 256 digits (1e308)? */
- set_cdr(p, cons(sc, car(fast), sc->nil));
- p = cdr(p);
+ for (i = 0, base = radix; (i < precision) && (frac_part > min_frac); i++, base *= radix)
+ {
+ s7_int ipart;
+ ipart = (s7_int)(frac_part * base);
+ if (ipart >= radix) /* rounding confusion */
+ ipart = radix - 1;
+ frac_part -= (ipart / base);
+ if (ipart < 10)
+ d[i] = (char)('0' + ipart);
+ else d[i] = (char)('a' + ipart - 10);
+ }
+ if (i == 0)
+ d[i++] = '0';
+ d[i] = '\0';
+ p = (char *)malloc(256 * sizeof(char));
+ len = snprintf(p, 256, "%s%s.%s", (sign) ? "-" : "", n, d);
+ str_len = 256;
+ }
+ break;
- fast = cdr(fast);
- if (!is_pair(fast))
- {
- if (is_null(fast))
- return(sc->w);
- set_cdr(p, fast);
- return(sc->w);
- }
- /* if unrolled further, it's a lot slower? */
- set_cdr(p, cons(sc, car(fast), sc->nil));
- p = cdr(p);
+ default:
+ {
+ char *n, *d;
+ p = (char *)malloc(512 * sizeof(char));
+ n = number_to_string_with_radix(sc, make_real(sc, real_part(obj)), radix, 0, precision, float_choice, &len);
+ d = number_to_string_with_radix(sc, make_real(sc, imag_part(obj)), radix, 0, precision, float_choice, &len);
+ len = snprintf(p, 512, "%s%s%si", n, (imag_part(obj) < 0.0) ? "" : "+", d);
+ str_len = 512;
+ free(n);
+ free(d);
+ }
+ break;
+ }
- fast = cdr(fast);
- slow = cdr(slow);
- if (fast == slow)
+ if (width > len)
+ {
+ int spaces;
+ if (width >= str_len)
{
- /* try to preserve the original cyclic structure */
- s7_pointer p1, f1, p2, f2;
- set_match_pair(a);
- for (p1 = sc->w, f1 = a; !(is_matched_pair(cdr(f1))); f1 = cdr(f1), p1 = cdr(p1))
- set_match_pair(f1);
- for (p2 = sc->w, f2 = a; cdr(f1) != f2; f2 = cdr(f2), p2 = cdr(p2))
- clear_match_pair(f2);
- for (f1 = f2; is_pair(f1); f1 = cdr(f1), f2 = cdr(f2))
- {
- clear_match_pair(f1);
- f1 = cdr(f1);
- clear_match_pair(f1);
- if (f1 == f2) break;
- }
- if (is_null(p1))
- set_cdr(p2, p2);
- else set_cdr(p1, p2);
- return(sc->w);
+ str_len = width + 1;
+ p = (char *)realloc(p, str_len * sizeof(char));
}
+ spaces = width - len;
+ p[width] = '\0';
+ memmove((void *)(p + spaces), (void *)p, len);
+ memset((void *)p, (int)' ', spaces);
+ (*nlen) = width;
}
- return(sc->w);
+ else (*nlen) = len;
+ return(p);
}
-static s7_pointer copy_counter(s7_scheme *sc, s7_pointer obj)
+char *s7_number_to_string(s7_scheme *sc, s7_pointer obj, int radix)
{
- s7_pointer nobj;
- new_cell(sc, nobj, T_COUNTER);
- counter_set_result(nobj, counter_result(obj));
- counter_set_list(nobj, counter_list(obj));
- counter_set_capture(nobj, counter_capture(obj));
- counter_set_let(nobj, counter_let(obj));
- counter_set_slots(nobj, counter_slots(obj));
- return(nobj);
+ int nlen = 0;
+ return(number_to_string_with_radix(sc, obj, radix, 0, 20, 'g', &nlen));
+ /* (log top 10) so we get all the digits in base 10 (??) */
}
-
-static s7_pointer copy_stack(s7_scheme *sc, s7_pointer old_v, int top)
+static s7_pointer number_to_string_p(s7_pointer p)
{
- #define CC_INITIAL_STACK_SIZE 256 /* 128 is too small here */
- int i, len;
- s7_pointer new_v;
- s7_pointer *nv, *ov;
+ int nlen = 0;
+ char *res;
+ if (!is_number(p))
+ simple_wrong_type_argument_with_type(cur_sc, cur_sc->number_to_string_symbol, p, a_number_string);
+ res = number_to_string_base_10(p, 0, 20, 'g', &nlen, USE_WRITE);
+ return(s7_make_string_with_length(cur_sc, res, nlen));
+}
- /* stacks can grow temporarily, so sc->stack_size grows, but we don't normally need all that
- * leftover space here, so choose the original stack size if it's smaller.
- */
- len = vector_length(old_v);
- if (len > CC_INITIAL_STACK_SIZE)
+
+static void prepare_temporary_string(s7_scheme *sc, int len, int which)
+{
+ s7_pointer p;
+ p = sc->tmp_strs[which];
+ if (len > string_temp_true_length(p))
{
- if (top < CC_INITIAL_STACK_SIZE / 4)
- len = CC_INITIAL_STACK_SIZE;
+ string_value(p) = (char *)realloc(string_value(p), len * sizeof(char));
+ string_temp_true_length(p) = len;
}
- else
+}
+
+static s7_pointer g_number_to_string_1(s7_scheme *sc, s7_pointer args, bool temporary)
+{
+ #define H_number_to_string "(number->string num (radix 10)) converts the number num into a string."
+ #define Q_number_to_string s7_make_signature(sc, 3, sc->is_string_symbol, sc->is_number_symbol, sc->is_integer_symbol)
+
+ s7_int radix = 10;
+ int size, nlen = 0;
+ char *res;
+ s7_pointer x;
+
+ x = car(args);
+ if (!s7_is_number(x))
+ method_or_bust_with_type(sc, x, sc->number_to_string_symbol, args, a_number_string, 1);
+
+ if (is_pair(cdr(args)))
{
- if (len < CC_INITIAL_STACK_SIZE)
- len = CC_INITIAL_STACK_SIZE;
+ s7_pointer y;
+ y = cadr(args);
+ if (s7_is_integer(y))
+ radix = s7_integer(y);
+ else method_or_bust(sc, y, sc->number_to_string_symbol, args, T_INTEGER, 2);
+ if ((radix < 2) || (radix > 16))
+ return(out_of_range(sc, sc->number_to_string_symbol, small_int(2), y, a_valid_radix_string));
}
- if ((int)(sc->free_heap_top - sc->free_heap) < (int)(sc->heap_size / 4)) gc(sc);
- /* this gc call is needed if there are lots of call/cc's -- by pure bad luck
- * we can end up hitting the end of the gc free list time after time while
- * in successive copy_stack's below, causing s7 to core up until it runs out of memory.
- */
- new_v = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
- set_type(new_v, T_STACK);
- temp_stack_top(new_v) = top;
- nv = vector_elements(new_v);
- ov = vector_elements(old_v);
- if (len > 0)
- memcpy((void *)nv, (void *)ov, len * sizeof(s7_pointer));
+#if WITH_GMP
+ if (s7_is_bignum(x))
+ {
+ res = big_number_to_string_with_radix(x, radix, 0, &nlen, USE_WRITE);
+ return(make_string_uncopied_with_length(sc, res, nlen));
+ }
+#endif
- s7_gc_on(sc, false);
- for (i = 2; i < top; i += 4)
+ size = float_format_precision;
+ if (!is_rational(x))
{
- s7_pointer p;
- p = ov[i]; /* args */
- if (is_pair(p)) /* args need not be a list (it can be a port or #f, etc) */
- nv[i] = protected_list_copy(sc, p); /* args (copy is needed -- see s7test.scm) */
- /* lst can be dotted or circular here. The circular list only happens in a case like:
- * (dynamic-wind (lambda () (eq? (let ((lst (cons 1 2))) (set-cdr! lst lst) lst) (call/cc (lambda (k) k)))) (lambda () #f) (lambda () #f))
+ /* if size = 20, (number->string .1) gives "0.10000000000000000555", but if it's less than 20,
+ * large numbers (or very small numbers) mess up the less significant digits.
*/
- else
+ if (radix == 10)
{
- if (is_counter(p)) /* these can only occur in this context */
- nv[i] = copy_counter(sc, p);
+ if (is_real(x))
+ {
+ s7_double val;
+ val = fabs(s7_real(x));
+ if ((val > (s7_int32_max / 4)) || (val < 1.0e-6))
+ size += 4;
+ }
+ else
+ {
+ s7_double rl;
+ rl = fabs(s7_real_part(x));
+ if ((rl > (s7_int32_max / 4)) || (rl < 1.0e-6))
+ {
+ s7_double im;
+ im = fabs(s7_imag_part(x));
+ if ((im > (s7_int32_max / 4)) || (im < 1.0e-6))
+ size += 4;
+ }
+ }
}
}
- s7_gc_on(sc, true);
- return(new_v);
+ if (radix != 10)
+ {
+ res = number_to_string_with_radix(sc, x, radix, 0, size, 'g', &nlen);
+ return(make_string_uncopied_with_length(sc, res, nlen));
+ }
+ res = number_to_string_base_10(x, 0, size, 'g', &nlen, USE_WRITE);
+ if (temporary)
+ {
+ s7_pointer p;
+ prepare_temporary_string(sc, nlen + 1, 1);
+ p = sc->tmp_strs[1];
+ string_length(p) = nlen;
+ memcpy((void *)(string_value(p)), (void *)res, nlen);
+ string_value(p)[nlen] = 0;
+ return(p);
+ }
+ return(s7_make_string_with_length(sc, res, nlen));
}
-
-static s7_pointer make_goto(s7_scheme *sc)
+static s7_pointer g_number_to_string(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
- new_cell(sc, x, T_GOTO | T_PROCEDURE);
- call_exit_goto_loc(x) = s7_stack_top(sc);
- call_exit_op_loc(x) = (int)(sc->op_stack_now - sc->op_stack);
- call_exit_active(x) = true;
- return(x);
+ return(g_number_to_string_1(sc, args, false));
}
+static s7_pointer number_to_string_p_p(s7_pointer p) {return(g_number_to_string_1(cur_sc, set_plist_1(cur_sc, p), false));}
+static s7_pointer number_to_string_p_pp(s7_pointer p1, s7_pointer p2) {return(g_number_to_string_1(cur_sc, set_plist_2(cur_sc, p1, p2), false));}
-static s7_pointer *copy_op_stack(s7_scheme *sc)
+static s7_pointer number_to_string_temp;
+static s7_pointer g_number_to_string_temp(s7_scheme *sc, s7_pointer args)
{
- int len;
- s7_pointer *ops;
- ops = (s7_pointer *)malloc(sc->op_stack_size * sizeof(s7_pointer));
- len = (int)(sc->op_stack_now - sc->op_stack);
- if (len > 0)
- memcpy((void *)ops, (void *)(sc->op_stack), len * sizeof(s7_pointer));
- return(ops);
+ return(g_number_to_string_1(sc, args, true));
}
-/* (with-baffle . body) calls body guaranteeing that there can be no jumps into the
- * middle of it from outside -- no outer evaluation of a continuation can jump across this
- * barrier: The flip-side of call-with-exit.
- * It sets a T_BAFFLE var in a new env, that has a unique key. Call/cc then always
- * checks the env chain for any such variable, saving the localmost. Apply of a continuation
- * looks for such a saved variable, if none, go ahead, else check the current env (before the
- * jump) for that variable. If none, error, else go ahead. This is different from a delimited
- * continuation which simply delimits the extent of the continuation (why not use lambda?) -- we want to block it
- * from coming at us from some unknown place.
- */
-
-static s7_pointer make_baffle(s7_scheme *sc)
-{
- s7_pointer x;
- new_cell(sc, x, T_BAFFLE);
- baffle_key(x) = sc->baffle_ctr++;
- return(x);
-}
+#define CTABLE_SIZE 256
+static bool *exponent_table, *slashify_table, *char_ok_in_a_name, *white_space, *number_table, *symbol_slashify_table;
+static int *digits;
-static bool find_baffle(s7_scheme *sc, int key)
+static void init_ctables(void)
{
- /* search backwards through sc->envir for sc->baffle_symbol with key as value
- */
- s7_pointer x, y;
- for (x = sc->envir; is_let(x); x = outlet(x))
- for (y = let_slots(x); is_slot(y); y = next_slot(y))
- if ((slot_symbol(y) == sc->baffle_symbol) &&
- (baffle_key(slot_value(y)) == key))
- return(true);
-
- if ((is_slot(global_slot(sc->baffle_symbol))) &&
- (is_baffle(slot_value(global_slot(sc->baffle_symbol)))))
- return(baffle_key(slot_value(global_slot(sc->baffle_symbol))) == key);
-
- return(false);
-}
-
+ int i;
-static int find_any_baffle(s7_scheme *sc)
-{
- /* search backwards through sc->envir for any sc->baffle_symbol
- */
- if (sc->baffle_ctr > 0)
- {
- s7_pointer x, y;
- for (x = sc->envir; is_let(x); x = outlet(x))
- for (y = let_slots(x); is_slot(y); y = next_slot(y))
- if (slot_symbol(y) == sc->baffle_symbol)
- return(baffle_key(slot_value(y)));
+ exponent_table = (bool *)calloc(CTABLE_SIZE, sizeof(bool));
+ slashify_table = (bool *)calloc(CTABLE_SIZE, sizeof(bool));
+ symbol_slashify_table = (bool *)calloc(CTABLE_SIZE, sizeof(bool));
+ char_ok_in_a_name = (bool *)calloc(CTABLE_SIZE, sizeof(bool));
+ white_space = (bool *)calloc(CTABLE_SIZE + 1, sizeof(bool));
+ white_space++; /* leave white_space[-1] false for white_space[EOF] */
+ number_table = (bool *)calloc(CTABLE_SIZE, sizeof(bool));
- if ((is_slot(global_slot(sc->baffle_symbol))) &&
- (is_baffle(slot_value(global_slot(sc->baffle_symbol)))))
- return(baffle_key(slot_value(global_slot(sc->baffle_symbol))));
- }
- return(-1);
-}
+ for (i = 1; i < CTABLE_SIZE; i++)
+ char_ok_in_a_name[i] = true;
+ char_ok_in_a_name[0] = false;
+ char_ok_in_a_name[(unsigned char)'('] = false; /* idiotic cast is for C++'s benefit */
+ char_ok_in_a_name[(unsigned char)')'] = false;
+ char_ok_in_a_name[(unsigned char)';'] = false;
+ char_ok_in_a_name[(unsigned char)'\t'] = false;
+ char_ok_in_a_name[(unsigned char)'\n'] = false;
+ char_ok_in_a_name[(unsigned char)'\r'] = false;
+ char_ok_in_a_name[(unsigned char)' '] = false;
+ char_ok_in_a_name[(unsigned char)'"'] = false;
+ /* what about stuff like vertical tab? or comma? */
+ for (i = 0; i < CTABLE_SIZE; i++)
+ white_space[i] = false;
+ white_space[(unsigned char)'\t'] = true;
+ white_space[(unsigned char)'\n'] = true;
+ white_space[(unsigned char)'\r'] = true;
+ white_space[(unsigned char)'\f'] = true;
+ white_space[(unsigned char)'\v'] = true;
+ white_space[(unsigned char)' '] = true;
+ white_space[(unsigned char)'\205'] = true; /* 133 */
+ white_space[(unsigned char)'\240'] = true; /* 160 */
-s7_pointer s7_make_continuation(s7_scheme *sc)
-{
- s7_pointer x, stack;
- int loc;
+ /* surely only 'e' is needed... */
+ exponent_table[(unsigned char)'e'] = true; exponent_table[(unsigned char)'E'] = true;
+ exponent_table[(unsigned char)'@'] = true;
+#if WITH_EXTRA_EXPONENT_MARKERS
+ exponent_table[(unsigned char)'s'] = true; exponent_table[(unsigned char)'S'] = true;
+ exponent_table[(unsigned char)'f'] = true; exponent_table[(unsigned char)'F'] = true;
+ exponent_table[(unsigned char)'d'] = true; exponent_table[(unsigned char)'D'] = true;
+ exponent_table[(unsigned char)'l'] = true; exponent_table[(unsigned char)'L'] = true;
+#endif
- loc = s7_stack_top(sc);
- stack = copy_stack(sc, sc->stack, loc);
- sc->temp8 = stack;
+ for (i = 0; i < 32; i++)
+ slashify_table[i] = true;
+ for (i = 127; i < 160; i++)
+ slashify_table[i] = true;
+ slashify_table[(unsigned char)'\\'] = true;
+ slashify_table[(unsigned char)'"'] = true;
+ slashify_table[(unsigned char)'\n'] = false;
- new_cell(sc, x, T_CONTINUATION | T_PROCEDURE);
- continuation_data(x) = (continuation_t *)malloc(sizeof(continuation_t));
- continuation_set_stack(x, stack);
- continuation_stack_size(x) = vector_length(continuation_stack(x)); /* copy_stack can return a smaller stack than the current one */
- 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_size(x) = sc->op_stack_size;
- continuation_key(x) = find_any_baffle(sc);
+ for (i = 0; i < CTABLE_SIZE; i++)
+ symbol_slashify_table[i] = ((slashify_table[i]) || (!char_ok_in_a_name[i]));
- add_continuation(sc, x);
- return(x);
-}
+ digits = (int *)calloc(CTABLE_SIZE, sizeof(int));
+ for (i = 0; i < CTABLE_SIZE; i++)
+ digits[i] = 256;
+ digits[(unsigned char)'0'] = 0; digits[(unsigned char)'1'] = 1; digits[(unsigned char)'2'] = 2; digits[(unsigned char)'3'] = 3; digits[(unsigned char)'4'] = 4;
+ digits[(unsigned char)'5'] = 5; digits[(unsigned char)'6'] = 6; digits[(unsigned char)'7'] = 7; digits[(unsigned char)'8'] = 8; digits[(unsigned char)'9'] = 9;
+ digits[(unsigned char)'a'] = 10; digits[(unsigned char)'A'] = 10;
+ digits[(unsigned char)'b'] = 11; digits[(unsigned char)'B'] = 11;
+ digits[(unsigned char)'c'] = 12; digits[(unsigned char)'C'] = 12;
+ digits[(unsigned char)'d'] = 13; digits[(unsigned char)'D'] = 13;
+ digits[(unsigned char)'e'] = 14; digits[(unsigned char)'E'] = 14;
+ digits[(unsigned char)'f'] = 15; digits[(unsigned char)'F'] = 15;
-static bool check_for_dynamic_winds(s7_scheme *sc, s7_pointer c)
-{
- int i, s_base = 0, c_base = -1;
- opcode_t op;
+ for (i = 0; i < CTABLE_SIZE; i++)
+ number_table[i] = false;
+ number_table[(unsigned char)'0'] = true;
+ number_table[(unsigned char)'1'] = true;
+ number_table[(unsigned char)'2'] = true;
+ number_table[(unsigned char)'3'] = true;
+ number_table[(unsigned char)'4'] = true;
+ number_table[(unsigned char)'5'] = true;
+ number_table[(unsigned char)'6'] = true;
+ number_table[(unsigned char)'7'] = true;
+ number_table[(unsigned char)'8'] = true;
+ number_table[(unsigned char)'9'] = true;
+ number_table[(unsigned char)'.'] = true;
+ number_table[(unsigned char)'+'] = true;
+ number_table[(unsigned char)'-'] = true;
+ number_table[(unsigned char)'#'] = true;
+}
- for (i = s7_stack_top(sc) - 1; i > 0; i -= 4)
- {
- op = stack_op(sc->stack, i);
- switch (op)
- {
- case OP_DYNAMIC_WIND:
- {
- s7_pointer x;
- int 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) &&
- (x == stack_code(continuation_stack(c), j)))
- {
- s_base = i;
- c_base = j;
- break;
- }
- if (s_base != 0)
- break;
+#define is_white_space(C) white_space[C]
+ /* this is much faster than C's isspace, and does not depend on the current locale.
+ * if c == EOF (-1), it indexes into the empty (0) slot we preallocated below white_space
+ */
- if (dynamic_wind_state(x) == DWIND_BODY)
- {
- dynamic_wind_state(x) = DWIND_FINISH;
- if (dynamic_wind_out(x) != sc->F)
- {
- push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
- sc->args = sc->nil;
- sc->code = dynamic_wind_out(x);
- eval(sc, OP_APPLY);
- }
- }
- }
- break;
- case OP_BARRIER:
- if (i > continuation_stack_top(c)) /* otherwise it's some unproblematic outer eval-string? */
- return(false); /* but what if we've already evaluated a dynamic-wind closer? */
- break;
+static s7_pointer check_sharp_readers(s7_scheme *sc, const char *name)
+{
+ s7_pointer reader, value, args;
+ bool need_loader_port;
+ value = sc->F;
+ args = sc->F;
- case OP_DEACTIVATE_GOTO: /* here we're jumping out of an unrelated call-with-exit block */
- if (i > continuation_stack_top(c))
- call_exit_active(stack_args(sc->stack, i)) = false;
- break;
+ /* *#reader* is assumed to be an alist of (char . proc)
+ * where each proc takes one argument, the string from just beyond the "#" to the next delimiter.
+ * The procedure can call read-char to read ahead in the current-input-port.
+ * If it returns anything other than #f, that is the value of the sharp expression.
+ * Since #f means "nothing found", it is tricky to handle #F:
+ * (cons #\F (lambda (str) (and (string=? str "F") (list 'not #t))))
+ * This search happens after #|, #t, and #f (and #nD for multivectors?). #! has a fallback.
+ */
- default:
- break;
- }
- }
+ need_loader_port = is_loader_port(sc->input_port);
+ if (need_loader_port)
+ clear_loader_port(sc->input_port);
- for (i = c_base + 4; i < continuation_stack_top(c); i += 4)
+ /* normally read* can't read from sc->input_port if it is in use by the loader,
+ * but here we are deliberately making that possible.
+ */
+ for (reader = slot_value(sc->sharp_readers); is_not_null(reader); reader = cdr(reader))
{
- op = stack_op(continuation_stack(c), i);
-
- if (op == OP_DYNAMIC_WIND)
+ if (name[0] == s7_character(caar(reader)))
{
- s7_pointer x;
- x = stack_code(continuation_stack(c), i);
- if (dynamic_wind_in(x) != sc->F)
- {
- /* this can cause an infinite loop if the call/cc is trying to jump back into
- * a dynamic-wind init function -- it's even possible to trick with-baffle!
- * I can't find any fool-proof way to catch this problem.
- */
- push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
- sc->args = sc->nil;
- sc->code = dynamic_wind_in(x);
- eval(sc, OP_APPLY);
- }
- dynamic_wind_state(x) = DWIND_BODY;
+ if (args == sc->F)
+ args = list_1(sc, s7_make_string(sc, name));
+ /* args is GC protected by s7_apply_function?? (placed on the stack) */
+ value = s7_apply_function(sc, cdar(reader), args); /* this is much less error-safe than s7_call */
+ if (value != sc->F)
+ break;
}
- else
+ }
+ if (need_loader_port)
+ set_loader_port(sc->input_port);
+ return(value);
+}
+
+
+static s7_pointer g_sharp_readers_set(s7_scheme *sc, s7_pointer args)
+{
+ /* new value must be either () or a proper list of conses (char . func) */
+ if (is_null(cadr(args))) return(cadr(args));
+ if (is_pair(cadr(args)))
+ {
+ s7_pointer x;
+ for (x = cadr(args); is_pair(x); x = cdr(x))
{
- if (op == OP_DEACTIVATE_GOTO)
- call_exit_active(stack_args(continuation_stack(c), i)) = true;
+ if ((!is_pair(car(x))) ||
+ (!s7_is_character(caar(x))) ||
+ (!s7_is_procedure(cdar(x))))
+ return(sc->error_symbol);
}
+ if (is_null(x))
+ return(cadr(args));
}
- return(true);
+ return(sc->error_symbol);
}
-static bool call_with_current_continuation(s7_scheme *sc)
+static bool is_abnormal(s7_pointer x)
{
- s7_pointer c;
- c = sc->code;
+ switch (type(x))
+ {
+ case T_INTEGER:
+ case T_RATIO:
+ return(false);
- /* check for (baffle ...) blocking the current attempt to continue */
- if ((continuation_key(c) >= 0) &&
- (!(find_baffle(sc, continuation_key(c))))) /* should this raise an error? */
- return(false);
+ case T_REAL:
+ return(is_inf(real(x)) ||
+ is_NaN(real(x)));
- if (!check_for_dynamic_winds(sc, c)) /* if OP_BARRIER on stack deeper than continuation top(?), but can this happen? (it doesn't in s7test) */
- return(true);
+ case T_COMPLEX:
+ return(((is_inf(s7_real_part(x))) ||
+ (is_inf(s7_imag_part(x))) ||
+ (is_NaN(s7_real_part(x))) ||
+ (is_NaN(s7_imag_part(x)))));
- /* we push_stack sc->code before calling an embedded eval above, so sc->code should still be c here, etc
- */
- sc->stack = copy_stack(sc, continuation_stack(c), continuation_stack_top(c));
- sc->stack_size = continuation_stack_size(c);
- sc->stack_start = vector_elements(sc->stack);
- sc->stack_end = (s7_pointer *)(sc->stack_start + continuation_stack_top(c));
- sc->stack_resize_trigger = (s7_pointer *)(sc->stack_start + sc->stack_size / 2);
+#if WITH_GMP
+ case T_BIG_INTEGER:
+ case T_BIG_RATIO:
+ return(false);
- {
- int i, top;
- top = continuation_op_loc(c);
- sc->op_stack_now = (s7_pointer *)(sc->op_stack + top);
- sc->op_stack_size = continuation_op_size(c);
- sc->op_stack_end = (s7_pointer *)(sc->op_stack + sc->op_stack_size);
- for (i = 0; i < top; i++)
- sc->op_stack[i] = continuation_op_stack(c)[i];
- }
+ case T_BIG_REAL:
+ return((is_inf(s7_real_part(x))) ||
+ (is_NaN(s7_real_part(x))));
- if (is_null(sc->args))
- sc->value = sc->nil;
- else
+ case T_BIG_COMPLEX:
+ return((is_inf(s7_real_part(x))) ||
+ (is_inf(s7_imag_part(x))) ||
+ (is_NaN(s7_real_part(x))) ||
+ (is_NaN(s7_imag_part(x))));
+#endif
+
+ default:
+ return(true);
+ }
+}
+
+static s7_pointer unknown_sharp_constant(s7_scheme *sc, char *name)
+{
+ /* check *read-error-hook* */
+ if (hook_has_functions(sc->read_error_hook))
{
- if (is_null(cdr(sc->args)))
- sc->value = car(sc->args);
- else sc->value = splice_in_values(sc, sc->args);
+ s7_pointer result;
+ result = s7_call(sc, sc->read_error_hook, list_2(sc, sc->T, make_string_wrapper(sc, name)));
+ if (result != sc->unspecified)
+ return(result);
}
- return(true);
+ return(sc->nil);
}
+#define SYMBOL_OK true
+#define NO_SYMBOLS false
-static void call_with_exit(s7_scheme *sc)
+static s7_pointer make_sharp_constant(s7_scheme *sc, char *name, int radix, bool with_error)
{
- int i, new_stack_top, quit = 0;
+ /* name is the stuff after the '#', return sc->nil if not a recognized #... entity */
+ int len;
+ s7_pointer x;
- if (!call_exit_active(sc->code))
+ if ((name[0] == 't') &&
+ ((name[1] == '\0') || (strings_are_equal(name, "true"))))
+ return(sc->T);
+
+ if ((name[0] == 'f') &&
+ ((name[1] == '\0') || (strings_are_equal(name, "false"))))
+ return(sc->F);
+
+ if (is_not_null(slot_value(sc->sharp_readers)))
{
- static s7_pointer call_with_exit_error = NULL;
- if (!call_with_exit_error)
- call_with_exit_error = s7_make_permanent_string("call-with-exit escape procedure called outside its block");
- s7_error(sc, sc->invalid_escape_function_symbol, set_elist_1(sc, call_with_exit_error));
+ x = check_sharp_readers(sc, name);
+ if (x != sc->F)
+ return(x);
}
- call_exit_active(sc->code) = false;
- new_stack_top = call_exit_goto_loc(sc->code);
- sc->op_stack_now = (s7_pointer *)(sc->op_stack + call_exit_op_loc(sc->code));
+ len = safe_strlen5(name); /* just count up to 5 */
+ if (len < 2)
+ return(unknown_sharp_constant(sc, name));
- /* look for dynamic-wind in the stack section that we are jumping out of */
- for (i = s7_stack_top(sc) - 1; i > new_stack_top; i -= 4)
+ switch (name[0])
{
- opcode_t op;
+ /* -------- #< ... > -------- */
+ case '<':
+ if (strings_are_equal(name, "<unspecified>"))
+ return(sc->unspecified);
- op = stack_op(sc->stack, i);
- switch (op)
+ if (strings_are_equal(name, "<undefined>"))
+ return(sc->undefined);
+
+ if (strings_are_equal(name, "<eof>"))
+ return(sc->eof_object);
+
+ return(unknown_sharp_constant(sc, name));
+
+
+ /* -------- #o #d #x #b -------- */
+ case 'o': /* #o (octal) */
+ case 'x': /* #x (hex) */
+ case 'b': /* #b (binary) */
+ {
+ int num_at = 1;
+ /* the #b or whatever overrides any radix passed in earlier */
+ x = make_atom(sc, (char *)(name + num_at), (name[0] == 'o') ? 8 : ((name[0] == 'x') ? 16 : ((name[0] == 'b') ? 2 : 10)), NO_SYMBOLS, with_error);
+ if (is_abnormal(x))
+ return(unknown_sharp_constant(sc, name));
+ return(x);
+ }
+ break;
+
+
+ /* -------- #_... -------- */
+ case '_':
+ {
+ s7_pointer sym;
+ sym = make_symbol(sc, (char *)(name + 1));
+ if (is_slot(initial_slot(sym)))
+ return(slot_value(initial_slot(sym)));
+ return(s7_error(sc, sc->syntax_error_symbol, set_elist_2(sc, make_string_wrapper(sc, "#~A is undefined"), make_string_wrapper(sc, name))));
+ /* return(sc->undefined); */
+ }
+
+
+ /* -------- #\... -------- */
+ case '\\':
+ if (name[2] == 0) /* the most common case: #\a */
+ return(chars[(unsigned char)(name[1])]);
+ /* not unsigned int here! (unsigned int)255 (as a char) returns -1!! */
+ switch (name[1])
{
- case OP_DYNAMIC_WIND:
- {
- s7_pointer lx;
- lx = stack_code(sc->stack, i);
- if (dynamic_wind_state(lx) == DWIND_BODY)
- {
- dynamic_wind_state(lx) = DWIND_FINISH;
- if (dynamic_wind_out(lx) != sc->F)
- {
- push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
- sc->args = sc->nil;
- sc->code = dynamic_wind_out(lx);
- eval(sc, OP_APPLY);
- }
- }
- }
+ case 'n':
+ if ((strings_are_equal(name + 1, "null")) ||
+ (strings_are_equal(name + 1, "nul")))
+ return(chars[0]);
+
+ if (strings_are_equal(name + 1, "newline"))
+ return(chars[(unsigned char)'\n']);
break;
- case OP_EVAL_STRING_2:
- s7_close_input_port(sc, sc->input_port);
- pop_input_port(sc);
+ case 's':
+ if (strings_are_equal(name + 1, "space"))
+ return(chars[(unsigned char)' ']);
break;
- case OP_BARRIER: /* oops -- we almost certainly went too far */
- return;
+ case 'r':
+ if (strings_are_equal(name + 1, "return"))
+ return(chars[(unsigned char)'\r']);
+ break;
- case OP_DEACTIVATE_GOTO: /* here we're jumping into an unrelated call-with-exit block */
- call_exit_active(stack_args(sc->stack, i)) = false;
+ case 'l':
+ if (strings_are_equal(name + 1, "linefeed"))
+ return(chars[(unsigned char)'\n']);
break;
- /* call/cc does not close files, but I think call-with-exit should */
- case OP_GET_OUTPUT_STRING_1:
- case OP_UNWIND_OUTPUT:
- {
- s7_pointer x;
- x = stack_code(sc->stack, i); /* "code" = port that we opened */
- s7_close_output_port(sc, x);
- x = stack_args(sc->stack, i); /* "args" = port that we shadowed, if not #f */
- if (x != sc->F)
- sc->output_port = x;
- }
+ case 't':
+ if (strings_are_equal(name + 1, "tab"))
+ return(chars[(unsigned char)'\t']);
break;
- case OP_UNWIND_INPUT:
- s7_close_input_port(sc, stack_code(sc->stack, i)); /* "code" = port that we opened */
- sc->input_port = stack_args(sc->stack, i); /* "args" = port that we shadowed */
+ case 'a':
+ /* the next 4 are for r7rs */
+ if (strings_are_equal(name + 1, "alarm"))
+ return(chars[7]);
break;
- case OP_EVAL_DONE: /* goto called in a method -- put off the inner eval return(s) until we clean up the stack */
- quit++;
+ case 'b':
+ if (strings_are_equal(name + 1, "backspace"))
+ return(chars[8]);
break;
- default:
+ case 'e':
+ if (strings_are_equal(name + 1, "escape"))
+ return(chars[0x1b]);
break;
- }
- }
- sc->stack_end = (s7_pointer *)(sc->stack_start + new_stack_top);
+ case 'd':
+ if (strings_are_equal(name + 1, "delete"))
+ return(chars[0x7f]);
+ break;
- /* the return value should have an implicit values call, just as in call/cc */
- if (is_null(sc->args))
- sc->value = sc->nil;
- else
- {
- if (is_null(cdr(sc->args)))
- sc->value = car(sc->args);
- else sc->value = splice_in_values(sc, sc->args);
- }
+ 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.
+ */
+ {
+ /* 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.
+ * another problem: #\xbdca2cbec overflows so lval is -593310740 -> segfault unless caught
+ */
+ bool happy = true;
+ char *tmp;
+ int lval = 0;
- if (quit > 0)
- {
- if (sc->longjmp_ok)
- {
- pop_stack(sc);
- longjmp(sc->goto_start, CALL_WITH_EXIT_JUMP);
+ tmp = (char *)(name + 2);
+ while ((*tmp) && (happy) && (lval >= 0))
+ {
+ int dig;
+ dig = digits[(int)(*tmp++)];
+ if (dig < 16)
+ lval = dig + (lval * 16);
+ else happy = false;
+ }
+ if ((happy) &&
+ (lval < 256) &&
+ (lval >= 0))
+ return(chars[lval]);
+ }
+ break;
}
- for (i = 0; i < quit; i++)
- push_stack(sc, OP_EVAL_DONE, sc->nil, sc->nil);
}
+ return(unknown_sharp_constant(sc, name));
}
-static s7_pointer g_call_cc(s7_scheme *sc, s7_pointer args)
+static s7_int string_to_integer(const char *str, int radix, bool *overflow)
{
- #define H_call_cc "(call-with-current-continuation func) is always a mistake!"
- #define Q_call_cc s7_make_signature(sc, 2, sc->values_symbol, sc->is_procedure_symbol)
- /* I think the intent is that sc->values_symbol as the proc-sig return type indicates multiple values are possible (otherwise use #t). */
+ bool negative = false;
+ s7_int lval = 0;
+ int dig;
+ char *tmp = (char *)str;
+ char *tmp1;
- s7_pointer p;
- p = car(args); /* this is the procedure passed to call/cc */
- if (!is_procedure(p)) /* this includes continuations */
+ if (str[0] == '+')
+ tmp++;
+ else
{
- check_two_methods(sc, p, sc->call_cc_symbol, sc->call_with_current_continuation_symbol, args);
- return(simple_wrong_type_argument_with_type(sc, sc->call_cc_symbol, p, a_procedure_string));
+ if (str[0] == '-')
+ {
+ negative = true;
+ tmp++;
+ }
}
- if (!s7_is_aritable(sc, p, 1))
- return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "call/cc procedure, ~A, should take one argument"), p)));
+ while (*tmp == '0') {tmp++;};
+ tmp1 = tmp;
- sc->w = s7_make_continuation(sc);
- push_stack(sc, OP_APPLY, list_1(sc, sc->w), p);
- sc->w = sc->nil;
+ if (radix == 10)
+ {
+ while (true)
+ {
+ dig = digits[(unsigned char)(*tmp++)];
+ if (dig > 9) break;
+#if HAVE_OVERFLOW_CHECKS
+ if (multiply_overflow(lval, (s7_int)10, &lval)) break;
+ if (add_overflow(lval, (s7_int)dig, &lval)) break;
+#else
+ lval = dig + (lval * 10);
+ dig = digits[(unsigned char)(*tmp++)];
+ if (dig > 9) break;
+ lval = dig + (lval * 10);
+#endif
+ }
+ }
+ else
+ {
+ while (true)
+ {
+ dig = digits[(unsigned char)(*tmp++)];
+ if (dig >= radix) break;
+#if HAVE_OVERFLOW_CHECKS
+ if (multiply_overflow(lval, (s7_int)radix, &lval)) break;
+ if (add_overflow(lval, (s7_int)dig, &lval)) break;
+#else
+ lval = dig + (lval * radix);
+ dig = digits[(unsigned char)(*tmp++)];
+ if (dig >= radix) break;
+ lval = dig + (lval * radix);
+#endif
+ }
+ }
- return(sc->nil);
+#if WITH_GMP
+ (*overflow) = ((lval > s7_int32_max) ||
+ ((tmp - tmp1) > s7_int_digits_by_radix[radix]));
+ /* this tells the string->number readers to create a bignum. We need to be very
+ * conservative here to catch contexts such as (/ 1/524288 19073486328125)
+ */
+#else
+ if ((tmp - tmp1 - 2) > s7_int_digits_by_radix[radix])
+ {
+ /* I can't decide what to do with these non-gmp overflows. Perhaps NAN in all cases?
+ * overflow: 9223372036854775810 -> -9223372036854775806 -- this is not caught currently
+ */
+ (*overflow) = true;
+ if (negative)
+ return(s7_int_min); /* or INFINITY? */
+ return(s7_int_max); /* 0/100000000000000000000000000000000000000000000000000000000000000000000 */
+ }
+#endif
+
+ if (negative)
+ return(-lval);
+ return(lval);
}
-/* we can't naively optimize call/cc to call-with-exit if the continuation is only
- * used as a function in the call/cc body because it might (for example) be wrapped
- * in a lambda form that is being exported. See b-func in s7test for an example.
- */
+/* 9223372036854775807 9223372036854775807
+ * -9223372036854775808 -9223372036854775808
+ * 0000000000000000000000000001.0 1.0
+ * 1.0000000000000000000000000000 1.0
+ * 1000000000000000000000000000.0e-40 1.0e-12
+ * 0.0000000000000000000000000001e40 1.0e12
+ * 1.0e00000000000000000001 10.0
+ */
-static s7_pointer g_call_with_exit(s7_scheme *sc, s7_pointer args)
+static s7_double string_to_double_with_radix(const char *ur_str, int radix, bool *overflow)
{
- #define H_call_with_exit "(call-with-exit func) is call/cc without the ability to jump back into a previous computation."
- #define Q_call_with_exit s7_make_signature(sc, 2, sc->values_symbol, sc->is_procedure_symbol)
-
- s7_pointer p, x;
- /* (call-with-exit (lambda (return) ...)) */
- p = car(args);
- if (!is_procedure(p)) /* this includes continuations */
- method_or_bust_with_type(sc, p, sc->call_with_exit_symbol, args, a_procedure_string, 0);
+ /* strtod follows LANG which is not what we want (only "." is decimal point in Scheme).
+ * To overcome LANG in strtod would require screwing around with setlocale which never works.
+ * So we use our own code -- according to valgrind, this function is much faster than strtod.
+ *
+ * comma as decimal point causes ambiguities: `(+ ,1 2) etc
+ */
- x = make_goto(sc);
- push_stack(sc, OP_DEACTIVATE_GOTO, x, p); /* this means call-with-exit is not tail-recursive */
- push_stack(sc, OP_APPLY, cons_unchecked(sc, x, sc->nil), p);
+ int i, sign = 1, frac_len, int_len, dig, max_len, exponent = 0;
+ long long int int_part = 0, frac_part = 0;
+ char *str;
+ char *ipart, *fpart;
+ s7_double dval = 0.0;
- /* if the lambda body calls the argument as a function,
- * it is applied to its arguments, apply notices that it is a goto, and...
- *
- * (conceptually...) sc->stack_top = call_exit_goto_loc(sc->code);
- * s_pop(sc, (is_not_null(sc->args)) ? car(sc->args) : sc->nil);
- *
- * which jumps to the point of the goto returning car(args).
- *
- * There is one gotcha: we can't jump back in from outside, so if the caller saves the goto
- * and tries to invoke it outside the call-with-exit block, we have to
- * make sure it triggers an error. So, if the escape is called, it then
- * deactivates itself. Otherwise the block returns, we pop to OP_DEACTIVATE_GOTO,
- * and it finds the goto in sc->args.
- * Even worse:
- *
- (let ((cc #f))
- (call-with-exit
- (lambda (c3)
- (call/cc (lambda (ret) (set! cc ret)))
- (c3)))
- (cc))
- *
- * where we jump back into a call-with-exit body via call/cc, the goto has to be
- * re-established.
+ /* there's an ambiguity in number notation here if we allow "1e1" or "1.e1" in base 16 (or 15) -- is e a digit or an exponent marker?
+ * but 1e+1, for example disambiguates it -- kind of messy! -- the scheme spec says "e" can only occur in base 10.
+ * mpfr says "e" as exponent only in bases <= 10 -- else use '@' which works in any base. This can only cause confusion
+ * in scheme, unfortunately, due to the idiotic scheme polar notation. But we accept "s" and "l" as exponent markers
+ * so, perhaps for radix > 10, the exponent, if any, has to use one of S s L l? Not "l"! And "s" originally meant "short".
*
- * I think call-with-exit could be based on catch, but it's a simpler notion,
- * and certainly at the source level it is easier to read.
+ * '@' can now be used as the exponent marker (26-Mar-12).
+ * Another slight ambiguity: 1+1/2i is parsed as 1 + 0.5i, not 1+1/(2i), or (1+1)/(2i) or (1+1/2)i etc
*/
- return(sc->nil);
-}
-
+ max_len = s7_int_digits_by_radix[radix];
+ str = (char *)ur_str;
-/* -------------------------------- numbers -------------------------------- */
+ if (*str == '+')
+ str++;
+ else
+ {
+ if (*str == '-')
+ {
+ str++;
+ sign = -1;
+ }
+ }
+ while (*str == '0') {str++;};
-#if WITH_GMP
- static char *big_number_to_string_with_radix(s7_pointer p, int radix, int width, int *nlen, use_write_t use_write);
- static bool big_numbers_are_eqv(s7_pointer a, s7_pointer b);
- static s7_pointer string_to_either_integer(s7_scheme *sc, const char *str, int radix);
- static s7_pointer string_to_either_ratio(s7_scheme *sc, const char *nstr, const char *dstr, int radix);
- static s7_pointer string_to_either_real(s7_scheme *sc, const char *str, int radix);
- static s7_pointer string_to_either_complex(s7_scheme *sc, char *q, char *slash1, char *ex1, bool has_dec_point1,
- char *plus, char *slash2, char *ex2, bool has_dec_point2, int radix, int has_plus_or_minus);
- static s7_pointer big_add(s7_scheme *sc, s7_pointer args);
- static s7_pointer big_subtract(s7_scheme *sc, s7_pointer args);
- static s7_pointer big_multiply(s7_scheme *sc, s7_pointer args);
- static s7_pointer big_divide(s7_scheme *sc, s7_pointer args);
- static s7_pointer big_random(s7_scheme *sc, s7_pointer args);
- static s7_pointer s7_int_to_big_integer(s7_scheme *sc, s7_int val);
- static s7_pointer s7_ratio_to_big_ratio(s7_scheme *sc, s7_int num, s7_int den);
- static s7_pointer s7_number_to_big_real(s7_scheme *sc, s7_pointer p);
- static s7_pointer promote_number(s7_scheme *sc, int type, s7_pointer x);
- static s7_pointer big_equal(s7_scheme *sc, s7_pointer args);
- static s7_pointer big_negate(s7_scheme *sc, s7_pointer args);
- static s7_pointer big_invert(s7_scheme *sc, s7_pointer args);
-#if (!WITH_PURE_S7)
- static s7_pointer big_inexact_to_exact(s7_scheme *sc, s7_pointer args);
- static s7_pointer big_exact_to_inexact(s7_scheme *sc, s7_pointer args);
-#endif
- static s7_pointer mpz_to_big_integer(s7_scheme *sc, mpz_t val);
- static s7_pointer mpq_to_big_ratio(s7_scheme *sc, mpq_t val);
- static s7_pointer mpfr_to_big_real(s7_scheme *sc, mpfr_t val);
- static s7_pointer mpc_to_big_complex(s7_scheme *sc, mpc_t val);
-#endif
+ ipart = str;
+ while (digits[(int)(*str)] < radix) str++;
+ int_len = str - ipart;
-#define HAVE_OVERFLOW_CHECKS ((defined(__clang__) && ((__clang_major__ > 3) || (__clang_major__ == 3 && __clang_minor__ >= 4))) || \
- (defined(__GNUC__) && __GNUC__ >= 5))
+ if (*str == '.') str++;
+ fpart = str;
+ while (digits[(int)(*str)] < radix) str++;
+ frac_len = str - fpart;
-#if (defined(__clang__) && ((__clang_major__ > 3) || (__clang_major__ == 3 && __clang_minor__ >= 4)))
- #define subtract_overflow(A, B, C) __builtin_ssubll_overflow(A, B, C)
- #define add_overflow(A, B, C) __builtin_saddll_overflow(A, B, C)
- #define multiply_overflow(A, B, C) __builtin_smulll_overflow(A, B, C)
- #define int_subtract_overflow(A, B, C) __builtin_ssub_overflow(A, B, C)
- #define int_add_overflow(A, B, C) __builtin_sadd_overflow(A, B, C)
- #define int_multiply_overflow(A, B, C) __builtin_smul_overflow(A, B, C)
+ if ((*str) && (exponent_table[(unsigned char)(*str)]))
+ {
+ int exp_negative = false;
+ str++;
+ if (*str == '+')
+ str++;
+ else
+ {
+ if (*str == '-')
+ {
+ str++;
+ exp_negative = true;
+ }
+ }
+ while ((dig = digits[(int)(*str++)]) < 10) /* exponent itself is always base 10 */
+ {
+#if HAVE_OVERFLOW_CHECKS
+ if ((int_multiply_overflow(exponent, 10, &exponent)) ||
+ (int_add_overflow(exponent, dig, &exponent)))
+ {
+ exponent = 1000000; /* see below */
+ break;
+ }
#else
-#if (defined(__GNUC__) && __GNUC__ >= 5)
- #define subtract_overflow(A, B, C) __builtin_sub_overflow(A, B, C)
- #define add_overflow(A, B, C) __builtin_add_overflow(A, B, C)
- #define multiply_overflow(A, B, C) __builtin_mul_overflow(A, B, C)
- #define int_subtract_overflow(A, B, C) __builtin_sub_overflow(A, B, C)
- #define int_add_overflow(A, B, C) __builtin_add_overflow(A, B, C)
- #define int_multiply_overflow(A, B, C) __builtin_mul_overflow(A, B, C)
+ exponent = dig + (exponent * 10);
#endif
+ }
+#if (!defined(__GNUC__)) || (__GNUC__ < 5)
+ if (exponent < 0) /* we overflowed, so make sure we notice it below (need to check for 0.0e... first) (Brian Damgaard) */
+ exponent = 1000000; /* see below for examples -- this number needs to be very big but not too big for add */
#endif
+ if (exp_negative)
+ exponent = -exponent;
+ /* 2e12341234123123123123213123123123 -> 0.0
+ * but exp len is not the decider: 2e00000000000000000000000000000000000000001 -> 20.0
+ * first zero: 2e123412341231231231231
+ * then: 2e12341234123123123123123123 -> inf
+ * then: 2e123412341231231231231231231231231231 -> 0.0
+ * 2e-123412341231231231231 -> inf
+ * but: 0e123412341231231231231231231231231231
+ */
+ }
-#define s7_int_abs(x) ((x) >= 0 ? (x) : -(x))
-/* can't use abs even in gcc -- it doesn't work with long long ints! */
-
-#if (!__NetBSD__)
- #define s7_fabsl(X) fabsl(X)
-#else
- static double s7_fabsl(long double x) {if (x < 0.0) return(-x); return(x);}
+#if WITH_GMP
+ /* 9007199254740995.0 */
+ if (int_len + frac_len >= max_len)
+ {
+ (*overflow) = true;
+ return(0.0);
+ }
#endif
+ str = ipart;
+ if ((int_len + exponent) > max_len)
+ {
+ /* 12341234.56789e12 12341234567889999872.0 1.234123456789e+19
+ * -1234567890123456789.0 -1234567890123456768.0 -1.2345678901235e+18
+ * 12345678901234567890.0 12345678901234567168.0 1.2345678901235e+19
+ * 123.456e30 123456000000000012741097792995328.0 1.23456e+32
+ * 12345678901234567890.0e12 12345678901234569054409354903552.0 1.2345678901235e+31
+ * 1.234567890123456789012e30 1234567890123456849145940148224.0 1.2345678901235e+30
+ * 1e20 100000000000000000000.0 1e+20
+ * 1234567890123456789.0 1234567890123456768.0 1.2345678901235e+18
+ * 123.456e16 1234560000000000000.0 1.23456e+18
+ * 98765432101234567890987654321.0e-5 987654321012345728401408.0 9.8765432101235e+23
+ * 98765432101234567890987654321.0e-10 9876543210123456512.0 9.8765432101235e+18
+ * 0.00000000000000001234e20 1234.0
+ * 0.000000000000000000000000001234e30 1234.0
+ * 0.0000000000000000000000000000000000001234e40 1234.0
+ * 0.000000000012345678909876543210e15 12345.678909877
+ * 0e1000 0.0
+ */
-static bool is_NaN(s7_double x) {return(x != x);}
-/* callgrind says this is faster than isnan, I think (very confusing data...) */
+ for (i = 0; i < max_len; i++)
+ {
+ dig = digits[(int)(*str++)];
+ if (dig < radix)
+ int_part = dig + (int_part * radix);
+ else break;
+ }
+ /* if the exponent is huge, check for 0 int_part and frac_part before complaining (0e1000 or 0.0e1000)
+ */
+ if ((int_part == 0) &&
+ (exponent > max_len))
+ {
+ /* if frac_part is also 0, return 0.0 */
+ if (frac_len == 0)
+ return(0.0);
-#if defined(__sun) && defined(__SVR4)
- static bool is_inf(s7_double x) {return((x == x) && (is_NaN(x - x)));} /* there's no isinf in Solaris */
-#else
-#if (!MS_WINDOWS)
+ str = fpart;
+ while ((dig = digits[(int)(*str++)]) < radix)
+ frac_part = dig + (frac_part * radix);
+ if (frac_part == 0)
+ return(0.0);
- #if __cplusplus
- #define is_inf(x) std::isinf(x)
- #else
- #define is_inf(x) isinf(x)
- #endif
+#if WITH_GMP
+ (*overflow) = true;
+#endif
+ }
-#else
- static bool is_inf(s7_double x) {return((x == x) && (is_NaN(x - x)));} /* Another possibility: (x * 0) != 0 */
+#if WITH_GMP
+ (*overflow) = ((int_part > 0) || (exponent > 20)); /* .1e310 is a tricky case */
+#endif
- /* in MS C, we need to provide inverse hyperbolic trig funcs and cbrt */
- static double asinh(double x) {return(log(x + sqrt(1.0 + x * x)));}
- static double acosh(double x) {return(log(x + sqrt(x * x - 1.0)));}
- /* perhaps less prone to numerical troubles (untested): 2.0 * log(sqrt(0.5 * (x + 1.0)) + sqrt(0.5 * (x - 1.0))) */
- static double atanh(double x) {return(log((1.0 + x) / (1.0 - x)) / 2.0);}
- static double cbrt(double x) {if (x >= 0.0) return(pow(x, 1.0 / 3.0)); return(-pow(-x, 1.0 / 3.0));}
-#endif /* windows */
-#endif /* sun */
+ if (int_part != 0) /* 0.<310 zeros here>1e310 for example --
+ * pow (via ipow) thinks it has to be too big, returns Nan,
+ * then Nan * 0 -> Nan and the NaN propagates
+ */
+ {
+ if (int_len <= max_len)
+ dval = int_part * ipow(radix, exponent);
+ else dval = int_part * ipow(radix, exponent + int_len - max_len);
+ }
+ else dval = 0.0;
+ /* shift by exponent, but if int_len > max_len then we assumed (see below) int_len - max_len 0's on the left */
+ /* using int_to_int or table lookups here instead of pow did not make any difference in speed */
-/* for g_log, we also need round. this version is from stackoverflow, see also round_per_R5RS below */
-double s7_round(double number) {return((number < 0.0) ? ceil(number - 0.5) : floor(number + 0.5));}
+ if (int_len < max_len)
+ {
+ int k, flen;
+ str = fpart;
-#if HAVE_COMPLEX_NUMBERS
-#if __cplusplus
- #define _Complex_I (complex<s7_double>(0.0, 1.0))
- #define creal(x) Real(x)
- #define cimag(x) Imag(x)
- #define carg(x) arg(x)
- #define cabs(x) abs(x)
- #define csqrt(x) sqrt(x)
- #define cpow(x, y) pow(x, y)
- #define clog(x) log(x)
- #define cexp(x) exp(x)
- #define csin(x) sin(x)
- #define ccos(x) cos(x)
- #define csinh(x) sinh(x)
- #define ccosh(x) cosh(x)
-#else
- typedef double complex s7_complex;
-#endif
+ for (k = 0; (frac_len > 0) && (k < exponent); k += max_len)
+ {
+ if (frac_len > max_len) flen = max_len; else flen = frac_len;
+ frac_len -= max_len;
+ frac_part = 0;
+ for (i = 0; i < flen; i++)
+ frac_part = digits[(int)(*str++)] + (frac_part * radix);
-#if (!HAVE_COMPLEX_TRIG)
-#if (__cplusplus)
+ if (frac_part != 0) /* same pow->NaN problem as above can occur here */
+ dval += frac_part * ipow(radix, exponent - flen - k);
+ }
+ }
+ else
+ {
+ /* some of the fraction is in the integer part before the negative exponent shifts it over */
+ if (int_len > max_len)
+ {
+ int ilen;
+ /* str should be at the last digit we read */
+ ilen = int_len - max_len; /* we read these above */
+ if (ilen > max_len)
+ ilen = max_len;
- static s7_complex ctan(s7_complex z) {return(csin(z) / ccos(z));}
- static s7_complex ctanh(s7_complex z) {return(csinh(z) / ccosh(z));}
- static s7_complex casin(s7_complex z) {return(-_Complex_I * clog(_Complex_I * z + csqrt(1.0 - z * z)));}
- static s7_complex cacos(s7_complex z) {return(-_Complex_I * clog(z + _Complex_I * csqrt(1.0 - z * z)));}
- static s7_complex catan(s7_complex z) {return(_Complex_I * clog((_Complex_I + z) / (_Complex_I - z)) / 2.0);}
- static s7_complex casinh(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
- static s7_complex cacosh(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
- static s7_complex catanh(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
-#else
+ for (i = 0; i < ilen; i++)
+ frac_part = digits[(int)(*str++)] + (frac_part * radix);
-/* still not in FreeBSD! */
-static s7_complex clog(s7_complex z) {return(log(fabs(cabs(z))) + carg(z) * _Complex_I);}
-static s7_complex cpow(s7_complex x, s7_complex y)
-{
- s7_double r = cabs(x);
- s7_double theta = carg(x);
- s7_double yre = creal(y);
- s7_double yim = cimag(y);
- s7_double nr = exp(yre * log(r) - yim * theta);
- s7_double ntheta = yre * theta + yim * log(r);
- return(nr * cos(ntheta) + (nr * sin(ntheta)) * _Complex_I); /* make-polar */
-}
+ dval += frac_part * ipow(radix, exponent - ilen);
+ }
+ }
-#if (!defined(__FreeBSD__)) || (__FreeBSD__ < 9) /* untested -- this orignally looked at __FreeBSD_version which apparently no longer exists */
- static s7_complex cexp(s7_complex z) {return(exp(creal(z)) * cos(cimag(z)) + (exp(creal(z)) * sin(cimag(z))) * _Complex_I);}
-#endif
+ return(sign * dval);
+ }
-#if (!defined(__FreeBSD__)) || (__FreeBSD__ < 10)
- static s7_complex csin(s7_complex z) {return(sin(creal(z)) * cosh(cimag(z)) + (cos(creal(z)) * sinh(cimag(z))) * _Complex_I);}
- static s7_complex ccos(s7_complex z) {return(cos(creal(z)) * cosh(cimag(z)) + (-sin(creal(z)) * sinh(cimag(z))) * _Complex_I);}
- static s7_complex csinh(s7_complex z) {return(sinh(creal(z)) * cos(cimag(z)) + (cosh(creal(z)) * sin(cimag(z))) * _Complex_I);}
- static s7_complex ccosh(s7_complex z) {return(cosh(creal(z)) * cos(cimag(z)) + (sinh(creal(z)) * sin(cimag(z))) * _Complex_I);}
- static s7_complex ctan(s7_complex z) {return(csin(z) / ccos(z));}
- static s7_complex ctanh(s7_complex z) {return(csinh(z) / ccosh(z));}
- static s7_complex casin(s7_complex z) {return(-_Complex_I * clog(_Complex_I * z + csqrt(1.0 - z * z)));}
- static s7_complex cacos(s7_complex z) {return(-_Complex_I * clog(z + _Complex_I * csqrt(1.0 - z * z)));}
- static s7_complex catan(s7_complex z) {return(_Complex_I * clog((_Complex_I + z) / (_Complex_I - z)) / 2.0);}
- static s7_complex catanh(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
- static s7_complex casinh(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
- static s7_complex cacosh(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
- /* perhaps less prone to numerical troubles (untested): 2.0 * clog(csqrt(0.5 * (z + 1.0)) + csqrt(0.5 * (z - 1.0))) */
-#endif /* not FreeBSD 10 */
-#endif /* not c++ */
-#endif /* not HAVE_COMPLEX_TRIG */
+ /* int_len + exponent <= max_len */
-#else /* not HAVE_COMPLEX_NUMBERS */
- typedef double s7_complex;
- #define _Complex_I 1
- #define creal(x) x
- #define cimag(x) x
- #define csin(x) sin(x)
- #define casin(x) x
- #define ccos(x) cos(x)
- #define cacos(x) x
- #define ctan(x) x
- #define catan(x) x
- #define csinh(x) x
- #define casinh(x) x
- #define ccosh(x) x
- #define cacosh(x) x
- #define ctanh(x) x
- #define catanh(x) x
- #define cexp(x) exp(x)
- #define cpow(x, y) pow(x, y)
- #define clog(x) log(x)
- #define csqrt(x) sqrt(x)
- #define conj(x) x
-#endif
+ if (int_len <= max_len)
+ {
+ int int_exponent;
-#ifdef __OpenBSD__
- /* openbsd's builtin versions of these functions are not usable */
- static s7_complex catanh_1(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
- static s7_complex casinh_1(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
- static s7_complex cacosh_1(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
-#endif
-#ifdef __NetBSD__
- static s7_complex catanh_1(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
- static s7_complex casinh_1(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
-#endif
+ /* a better algorithm (since the inaccuracies are in the radix^exponent portion):
+ * strip off leading zeros and possible sign,
+ * strip off digits beyond max_len, then remove any trailing zeros.
+ * (maybe fiddle with the lowest order digit here for rounding, but I doubt it matters)
+ * read digits until end of number or max_len reached, ignoring the decimal point
+ * get exponent and use it and decimal point location to position the current result integer
+ * this always combines the same integer and the same exponent no matter how the number is expressed.
+ */
+ int_exponent = exponent;
+ if (int_len > 0)
+ {
+ char *iend;
+ iend = (char *)(str + int_len - 1);
+ while ((*iend == '0') && (iend != str)) {iend--; int_exponent++;}
-bool s7_is_number(s7_pointer p)
-{
-#if WITH_GMP
- return((is_number(p)) || (is_big_number(p)));
-#else
- return(is_number(p));
-#endif
-}
+ while (str <= iend)
+ int_part = digits[(int)(*str++)] + (int_part * radix);
+ }
+ if (int_exponent != 0)
+ dval = int_part * ipow(radix, int_exponent);
+ else dval = (s7_double)int_part;
+ }
+ else
+ {
+ int len, flen;
+ long long int frpart = 0;
+ /* 98765432101234567890987654321.0e-20 987654321.012346
+ * 98765432101234567890987654321.0e-29 0.98765432101235
+ * 98765432101234567890987654321.0e-30 0.098765432101235
+ * 98765432101234567890987654321.0e-28 9.8765432101235
+ */
-bool s7_is_integer(s7_pointer p)
-{
-#if WITH_GMP
- return((is_t_integer(p)) ||
- (is_t_big_integer(p)));
-#else
- return(is_integer(p));
-#endif
-}
+ len = int_len + exponent;
+ for (i = 0; i < len; i++)
+ int_part = digits[(int)(*str++)] + (int_part * radix);
-bool s7_is_real(s7_pointer p)
-{
-#if WITH_GMP
- return((is_real(p)) ||
- (is_t_big_integer(p)) ||
- (is_t_big_ratio(p)) ||
- (is_t_big_real(p)));
-#else
- return(is_real(p)); /* in GSL, a NaN or inf is not a real, or perhaps better, finite = not (nan or inf) */
-#endif
-}
+ flen = -exponent;
+ if (flen > max_len)
+ flen = max_len;
+ for (i = 0; i < flen; i++)
+ frpart = digits[(int)(*str++)] + (frpart * radix);
-bool s7_is_rational(s7_pointer p)
-{
-#if WITH_GMP
- return((is_rational(p)) ||
- (is_t_big_integer(p)) ||
- (is_t_big_ratio(p)));
-#else
- return(is_rational(p));
-#endif
-}
+ if (len <= 0)
+ dval = int_part + frpart * ipow(radix, len - flen);
+ else dval = int_part + frpart * ipow(radix, -flen);
+ }
+ if (frac_len > 0)
+ {
+ str = fpart;
+ if (frac_len <= max_len)
+ {
+ /* splitting out base 10 case saves very little here */
+ /* this ignores trailing zeros, so that 0.3 equals 0.300 */
+ char *fend;
-bool s7_is_ratio(s7_pointer p)
-{
-#if WITH_GMP
- return((is_t_ratio(p)) ||
- (is_t_big_ratio(p)));
-#else
- return(is_t_ratio(p));
-#endif
-}
+ fend = (char *)(str + frac_len - 1);
+ while ((*fend == '0') && (fend != str)) {fend--; frac_len--;} /* (= .6 0.6000) */
+ while (str <= fend)
+ frac_part = digits[(int)(*str++)] + (frac_part * radix);
+ dval += frac_part * ipow(radix, exponent - frac_len);
-bool s7_is_complex(s7_pointer p)
-{
-#if WITH_GMP
- return((is_number(p)) || (is_big_number(p)));
-#else
- return(is_number(p));
-#endif
-}
+ /* fprintf(stderr, "frac: %lld, exp: (%d %d) %.20f, val: %.20f\n", frac_part, exponent, frac_len, ipow(radix, exponent - frac_len), dval);
+ * 0.6: frac: 6, exp: 0.10000000000000000555, val: 0.60000000000000008882
+ * 0.60: frac: 60, exp: 0.01000000000000000021, val: 0.59999999999999997780
+ * 0.6000: frac: 6000, exp: 0.00010000000000000000, val: 0.59999999999999997780
+ * :(= 0.6 0.60)
+ * #f
+ * :(= #i3/5 0.6)
+ * #f
+ * so (string->number (number->string num)) == num only if both num's are the same text (or you get lucky)
+ * :(= 0.6 6e-1) ; but not 60e-2
+ * #t
+ *
+ * to fix the 0.60 case, we need to ignore trailing post-dot zeros.
+ */
+ }
+ else
+ {
+ if (exponent <= 0)
+ {
+ for (i = 0; i < max_len; i++)
+ frac_part = digits[(int)(*str++)] + (frac_part * radix);
+ dval += frac_part * ipow(radix, exponent - max_len);
+ }
+ else
+ {
+ /* 1.0123456789876543210e1 10.12345678987654373771
+ * 1.0123456789876543210e10 10123456789.87654304504394531250
+ * 0.000000010000000000000000e10 100.0
+ * 0.000000010000000000000000000000000000000000000e10 100.0
+ * 0.000000012222222222222222222222222222222222222e10 122.22222222222222
+ * 0.000000012222222222222222222222222222222222222e17 1222222222.222222
+ */
-static s7_int c_gcd(s7_int u, s7_int v)
-{
- s7_int a, b;
+ int_part = 0;
+ for (i = 0; i < exponent; i++)
+ int_part = digits[(int)(*str++)] + (int_part * radix);
- if ((u == s7_int_min) || (v == s7_int_min))
- {
- /* can't take abs of these (below) so do it by hand */
- s7_int divisor = 1;
- if (u == v) return(u);
- while (((u & 1) == 0) && ((v & 1) == 0))
- {
- u /= 2;
- v /= 2;
- divisor *= 2;
+ 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);
+
+ dval += int_part + frac_part * ipow(radix, -frac_len);
+ }
}
- return(divisor);
}
- a = s7_int_abs(u);
- b = s7_int_abs(v);
- while (b != 0)
- {
- s7_int temp;
- temp = a % b;
- a = b;
- b = temp;
- }
- if (a < 0)
- return(-a);
- return(a);
+#if WITH_GMP
+ if ((int_part == 0) &&
+ (frac_part == 0))
+ return(0.0);
+ (*overflow) = ((frac_len - exponent) > max_len);
+#endif
+
+ return(sign * dval);
}
-static bool c_rationalize(s7_double ux, s7_double error, s7_int *numer, s7_int *denom)
+static s7_pointer make_atom(s7_scheme *sc, char *q, int radix, bool want_symbol, bool with_error)
{
- /*
- (define* (rat ux (err 0.0000001))
- ;; translated from CL code in Canny, Donald, Ressler, "A Rational Rotation Method for Robust Geometric Algorithms"
- (let ((x0 (- ux error))
- (x1 (+ ux error)))
- (let ((i (ceiling x0))
- (i0 (floor x0))
- (i1 (ceiling x1))
- (r 0))
- (if (>= x1 i)
- i
- (do ((p0 i0 (+ p1 (* r p0)))
- (q0 1 (+ q1 (* r q0)))
- (p1 i1 p0)
- (q1 1 q0)
- (e0 (- i1 x0) e1p)
- (e1 (- x0 i0) (- e0p (* r e1p)))
- (e0p (- i1 x1) e1)
- (e1p (- x1 i0) (- e0 (* r e1))))
- ((<= x0 (/ p0 q0) x1)
- (/ p0 q0))
- (set! r (min (floor (/ e0 e1))
- (ceiling (/ e0p e1p)))))))))
- */
+ /* make symbol or number from string */
+ #define IS_DIGIT(Chr, Rad) (digits[(unsigned char)Chr] < Rad)
- double x0, x1;
- s7_int i, i0, i1, p0, q0, p1, q1;
- double e0, e1, e0p, e1p;
- int tries = 0;
- /* don't use s7_double here; if it is "long double", the loop below will hang */
+ char c, *p;
+ bool has_dec_point1 = false;
- /* #e1e19 is a killer -- it's bigger than most-positive-fixnum, but if we ceil(ux) below
- * it turns into most-negative-fixnum. 1e19 is trouble in many places.
- */
- if ((ux > s7_int_max) || (ux < s7_int_min))
- {
- /* can't return false here because that confuses some of the callers!
- */
- if (ux > s7_int_min) (*numer) = s7_int_max; else (*numer) = s7_int_min;
- (*denom) = 1;
- return(true);
- }
+ p = q;
+ c = *p++;
- if (error < 0.0) error = -error;
- x0 = ux - error;
- x1 = ux + error;
- i = (s7_int)ceil(x0);
+ /* a number starts with + - . or digit, but so does 1+ for example */
- if (error >= 1.0) /* aw good grief! */
+ switch (c)
{
- if (x0 < 0)
+ case '#':
+ return(make_sharp_constant(sc, p, radix, with_error)); /* make_sharp_constant expects the '#' to be removed */
+
+ case '+':
+ case '-':
+ c = *p++;
+ if (c == '.')
{
- if (x1 < 0)
- (*numer) = (s7_int)floor(x1);
- else (*numer) = 0;
+ has_dec_point1 = true;
+ c = *p++;
}
- else (*numer) = i;
- (*denom) = 1;
- return(true);
- }
+ if ((!c) || (!IS_DIGIT(c, radix)))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ break;
- if (x1 >= i)
- {
- if (i >= 0)
- (*numer) = i;
- else (*numer) = (s7_int)floor(x1);
- (*denom) = 1;
- return(true);
- }
+ case '.':
+ has_dec_point1 = true;
+ c = *p++;
- i0 = (s7_int)floor(x0);
- i1 = (s7_int)ceil(x1);
+ if ((!c) || (!IS_DIGIT(c, radix)))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ break;
- p0 = i0;
- q0 = 1;
- p1 = i1;
- q1 = 1;
- e0 = i1 - x0;
- e1 = x0 - i0;
- e0p = i1 - x1;
- e1p = x1 - i0;
+ case '0': /* these two are always digits */
+ case '1':
+ break;
- while (true)
- {
- s7_int old_p1, old_q1;
- double old_e0, old_e1, old_e0p, val, r, r1;
- val = (double)p0 / (double)q0;
+ default:
+ if (!IS_DIGIT(c, radix))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ break;
+ }
- if (((x0 <= val) && (val <= x1)) ||
- (e1 == 0) ||
- (e1p == 0) ||
- (tries > 100))
- {
- (*numer) = p0;
- (*denom) = q0;
- return(true);
- }
- tries++;
+ /* now it's possibly a number -- the first character(s) could be part of a number in the current radix */
+ {
+ char *slash1 = NULL, *slash2 = NULL, *plus = NULL, *ex1 = NULL, *ex2 = NULL;
+ bool has_i = false, has_dec_point2 = false;
+ int has_plus_or_minus = 0, current_radix;
- r = (s7_int)floor(e0 / e1);
- r1 = (s7_int)ceil(e0p / e1p);
- if (r1 < r) r = r1;
+#if (!WITH_GMP)
+ bool overflow = false;
+#endif
+ current_radix = radix; /* current_radix is 10 for the exponent portions, but radix for all the rest */
- /* do handles all step vars in parallel */
- old_p1 = p1;
- p1 = p0;
- old_q1 = q1;
- q1 = q0;
- old_e0 = e0;
- e0 = e1p;
- old_e0p = e0p;
- e0p = e1;
- old_e1 = e1;
+ for ( ; (c = *p) != 0; ++p)
+ {
+ /* what about embedded null? (string->number (string #\1 (integer->char 0) #\0))
+ * currently we stop and return 1, but Guile returns #f
+ */
+ if (!IS_DIGIT(c, current_radix)) /* moving this inside the switch statement was much slower */
+ {
+ current_radix = radix;
- p0 = old_p1 + r * p0;
- q0 = old_q1 + r * q0;
- e1 = old_e0p - r * e1p;
- /* if the error is set too low, we can get e1 = 0 here: (rationalize (/ pi) 1e-17) */
- e1p = old_e0 - r * old_e1;
- }
- return(false);
-}
+ switch (c)
+ {
+ /* -------- decimal point -------- */
+ case '.':
+ if ((!IS_DIGIT(p[1], current_radix)) &&
+ (!IS_DIGIT(p[-1], current_radix)))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ if (has_plus_or_minus == 0)
+ {
+ if ((has_dec_point1) || (slash1))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ has_dec_point1 = true;
+ }
+ else
+ {
+ if ((has_dec_point2) || (slash2))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ has_dec_point2 = true;
+ }
+ continue;
-s7_pointer s7_rationalize(s7_scheme *sc, s7_double x, s7_double error)
-{
- s7_int numer = 0, denom = 1;
- if (c_rationalize(x, error, &numer, &denom))
- return(s7_make_ratio(sc, numer, denom));
- return(make_real(sc, x));
-}
+ /* -------- exponent marker -------- */
+#if WITH_EXTRA_EXPONENT_MARKERS
+ /* 1st 3d-perspective 0.0f 128.0f 3d 1s -- in 2 million lines of public scheme code, not one actual use! */
+ case 's': case 'S':
+ case 'd': case 'D':
+ case 'f': case 'F':
+ case 'l': case 'L':
+#endif
+ case 'e': case 'E':
+ if (current_radix > 10)
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ /* see note above */
+ /* fall through -- if '@' used, radices>10 are ok */
-static s7_int number_to_numerator(s7_pointer n)
-{
- if (is_t_ratio(n))
- return(numerator(n));
- return(integer(n));
-}
+ case '@':
+ current_radix = 10;
+ if (((ex1) ||
+ (slash1)) &&
+ (has_plus_or_minus == 0)) /* ee */
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
-static s7_int number_to_denominator(s7_pointer n)
-{
- if (is_t_ratio(n))
- return(denominator(n));
- return(1);
-}
+ if (((ex2) ||
+ (slash2)) &&
+ (has_plus_or_minus != 0)) /* 1+1.0ee */
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ if ((!IS_DIGIT(p[-1], radix)) && /* was current_radix but that's always 10! */
+ (p[-1] != '.'))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
-s7_pointer s7_make_integer(s7_scheme *sc, s7_int n)
-{
- s7_pointer x;
- if (is_small(n)) /* ((n >= 0) && (n < NUM_SMALL_INTS)) is slower */
- return(small_int(n));
+ if (has_plus_or_minus == 0)
+ {
+ ex1 = p;
+ has_dec_point1 = true; /* decimal point illegal from now on */
+ }
+ else
+ {
+ ex2 = p;
+ has_dec_point2 = true;
+ }
+ p++;
+ if ((*p == '-') || (*p == '+')) p++;
+ if (IS_DIGIT(*p, current_radix))
+ continue;
+ break;
- new_cell(sc, x, T_INTEGER);
- integer(x) = n;
- return(x);
-}
+ /* -------- internal + or - -------- */
+ case '+':
+ case '-':
+ if (has_plus_or_minus != 0) /* already have the separator */
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
-static s7_pointer make_mutable_integer(s7_scheme *sc, s7_int n)
-{
- s7_pointer x;
- new_cell(sc, x, T_INTEGER | T_MUTABLE);
- integer(x) = n;
- return(x);
-}
+ if (c == '+') has_plus_or_minus = 1; else has_plus_or_minus = -1;
+ plus = (char *)(p + 1);
+ continue;
+ /* ratio marker */
+ case '/':
+ if ((has_plus_or_minus == 0) &&
+ ((ex1) ||
+ (slash1) ||
+ (has_dec_point1)))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
-static s7_pointer make_permanent_integer_unchecked(s7_int i)
-{
- s7_pointer p;
- p = (s7_pointer)calloc(1, sizeof(s7_cell));
- typeflag(p) = T_IMMUTABLE | T_INTEGER;
- unheap(p);
- integer(p) = i;
- return(p);
-}
+ if ((has_plus_or_minus != 0) &&
+ ((ex2) ||
+ (slash2) ||
+ (has_dec_point2)))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
-static s7_pointer make_permanent_integer(s7_int i)
-{
- if (is_small(i)) return(small_int(i));
+ if (has_plus_or_minus == 0)
+ slash1 = (char *)(p + 1);
+ else slash2 = (char *)(p + 1);
- if (i == MAX_ARITY) return(max_arity);
- if (i == CLOSURE_ARITY_NOT_SET) return(arity_not_set);
- if (i == -1) return(minus_one);
- if (i == -2) return(minus_two);
- /* a few -3 */
+ if ((!IS_DIGIT(p[1], current_radix)) ||
+ (!IS_DIGIT(p[-1], current_radix)))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
- return(make_permanent_integer_unchecked(i));
-}
+ continue;
-s7_pointer s7_make_real(s7_scheme *sc, s7_double n)
-{
- s7_pointer x;
- /* in snd-test this is called about 40000000 times, primarily test 8/18/22 */
+ /* -------- i for the imaginary part -------- */
+ case 'i':
+ if ((has_plus_or_minus != 0) &&
+ (!has_i))
+ {
+ has_i = true;
+ continue;
+ }
+ break;
- if (n == 0.0)
- return(real_zero);
+ default:
+ break;
+ }
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ }
+ }
- new_cell(sc, x, T_REAL);
- set_real(x, n);
+ if ((has_plus_or_minus != 0) && /* that is, we have an internal + or - */
+ (!has_i)) /* but no i for the imaginary part */
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
- return(x);
-}
+ if (has_i)
+ {
+#if (!WITH_GMP)
+ s7_double rl = 0.0, im = 0.0;
+#else
+ char e1 = 0, e2 = 0;
+#endif
+ s7_pointer result;
+ int len;
+ char ql1, pl1;
+ len = safe_strlen(q);
-s7_pointer s7_make_mutable_real(s7_scheme *sc, s7_double n)
-{
- s7_pointer x;
- new_cell(sc, x, T_REAL | T_MUTABLE);
- set_real(x, n);
- return(x);
-}
+ if (q[len - 1] != 'i')
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ /* save original string */
+ ql1 = q[len - 1];
+ pl1 = (*(plus - 1));
+#if WITH_GMP
+ if (ex1) {e1 = *ex1; (*ex1) = '@';} /* for mpfr */
+ if (ex2) {e2 = *ex2; (*ex2) = '@';}
+#endif
-static s7_pointer make_permanent_real(s7_double n)
-{
- s7_pointer x;
- int nlen = 0;
- char *str;
+ /* look for cases like 1+i */
+ if ((q[len - 2] == '+') || (q[len - 2] == '-'))
+ q[len - 1] = '1';
+ else q[len - 1] = '\0'; /* remove 'i' */
- x = (s7_pointer)calloc(1, sizeof(s7_cell));
- set_type(x, T_IMMUTABLE | T_REAL);
- unheap(x);
- set_real(x, n);
+ (*((char *)(plus - 1))) = '\0';
- str = number_to_string_base_10(x, 0, float_format_precision, 'g', &nlen, USE_WRITE);
- set_print_name(x, str, nlen);
- return(x);
-}
+ /* there is a slight inconsistency here:
+ 1/0 -> nan.0
+ 1/0+0i -> inf.0 (0/1+0i is 0.0)
+ #i1/0+0i -> inf.0
+ 0/0 -> nan.0
+ 0/0+0i -> -nan.0
+ */
+#if (!WITH_GMP)
+ if ((has_dec_point1) ||
+ (ex1))
+ {
+ /* (string->number "1100.1+0.11i" 2) -- need to split into 2 honest reals before passing to non-base-10 str->dbl */
+ rl = string_to_double_with_radix(q, radix, &overflow);
+ }
+ else
+ {
+ if (slash1)
+ {
+ /* here the overflow could be innocuous if it's in the denominator and the numerator is 0
+ * 0/100000000000000000000000000000000000000-0i
+ */
+ s7_int num, den;
+ num = string_to_integer(q, radix, &overflow);
+ den = string_to_integer(slash1, radix, &overflow);
+ if (den == 0)
+ rl = NAN;
+ else
+ {
+ if (num == 0)
+ {
+ rl = 0.0;
+ overflow = false;
+ }
+ else rl = (s7_double)num / (s7_double)den;
+ }
+ }
+ else rl = (s7_double)string_to_integer(q, radix, &overflow);
+ if (overflow) return(real_NaN);
+ }
+ if (rl == -0.0) rl = 0.0;
-s7_pointer s7_make_complex(s7_scheme *sc, s7_double a, s7_double b)
-{
- s7_pointer x;
- if (b == 0.0)
- {
- new_cell(sc, x, T_REAL);
- set_real(x, a);
- }
- else
- {
- new_cell(sc, x, T_COMPLEX);
- set_real_part(x, a);
- set_imag_part(x, b);
- }
- return(x);
-}
+ if ((has_dec_point2) ||
+ (ex2))
+ im = string_to_double_with_radix(plus, radix, &overflow);
+ else
+ {
+ if (slash2)
+ {
+ /* same as above: 0-0/100000000000000000000000000000000000000i
+ */
+ s7_int num, den;
+ num = string_to_integer(plus, radix, &overflow);
+ den = string_to_integer(slash2, radix, &overflow);
+ if (den == 0)
+ im = NAN;
+ else
+ {
+ if (num == 0)
+ {
+ im = 0.0;
+ overflow = false;
+ }
+ else im = (s7_double)num / (s7_double)den;
+ }
+ }
+ else im = (s7_double)string_to_integer(plus, radix, &overflow);
+ if (overflow) return(real_NaN);
+ }
+ if ((has_plus_or_minus == -1) &&
+ (im != 0.0))
+ im = -im;
+ result = s7_make_complex(sc, rl, im);
+#else
+ result = string_to_either_complex(sc, q, slash1, ex1, has_dec_point1, plus, slash2, ex2, has_dec_point2, radix, has_plus_or_minus);
+#endif
+ /* restore original string */
+ q[len - 1] = ql1;
+ (*((char *)(plus - 1))) = pl1;
+#if WITH_GMP
+ if (ex1) (*ex1) = e1;
+ if (ex2) (*ex2) = e2;
+#endif
-s7_pointer s7_make_ratio(s7_scheme *sc, s7_int a, s7_int b)
-{
- s7_pointer x;
- s7_int divisor;
+ return(result);
+ }
- if (b == 0)
- return(division_by_zero_error(sc, make_string_wrapper(sc, "make-ratio"), set_elist_2(sc, make_integer(sc, a), small_int(0))));
- if (a == 0)
- return(small_int(0));
- if (b == 1)
- return(make_integer(sc, a));
+ /* not complex */
+ if ((has_dec_point1) ||
+ (ex1))
+ {
+ s7_pointer result;
-#if (!WITH_GMP)
- if (b == s7_int_min)
- {
- if (a == b)
- return(small_int(1));
+ if (slash1) /* not complex, so slash and "." is not a number */
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
- /* we've got a problem... This should not trigger an error during reading -- we might have the
- * ratio on a switch with-bignums or whatever, so its mere occurrence is just an annoyance.
- * We'll try to do something...
- */
- if (a & 1)
- {
- if (a == 1)
- return(real_NaN);
- /* not an error here? we can't get this in the ratio reader, I think, because the denominator is negative */
- b = b + 1;
- /* so (/ -1 most-negative-fixnum) -> 1/9223372036854775807 -- not ideal, but ... */
- }
- else
+#if (!WITH_GMP)
+ result = make_real(sc, string_to_double_with_radix(q, radix, &overflow));
+#else
{
- a /= 2;
- b /= 2;
+ char old_e = 0;
+ if (ex1)
+ {
+ old_e = (*ex1);
+ (*ex1) = '@';
+ }
+ result = string_to_either_real(sc, q, radix);
+ if (ex1)
+ (*ex1) = old_e;
}
- }
#endif
+ return(result);
+ }
- if (b < 0)
- {
- a = -a;
- b = -b;
- }
- divisor = c_gcd(a, b);
- if (divisor != 1)
- {
- a /= divisor;
- b /= divisor;
- }
- if (b == 1)
- return(make_integer(sc, a));
-
- new_cell(sc, x, T_RATIO);
- numerator(x) = a;
- denominator(x) = b;
-
- return(x);
-}
-/* in fc19 as a guest running in virtualbox on OSX, the line a /= divisor can abort with an arithmetic exception (SIGFPE)
- * if leastfix/mostfix -- apparently this is a bug in virtualbox.
- */
+ /* not real */
+ if (slash1)
+#if (!WITH_GMP)
+ {
+ s7_int n, d;
+ n = string_to_integer(q, radix, &overflow);
+ d = string_to_integer(slash1, radix, &overflow);
-#define WITH_OVERFLOW_ERROR true
-#define WITHOUT_OVERFLOW_ERROR false
+ if ((n == 0) && (d != 0)) /* 0/100000000000000000000000000000000000000 */
+ return(small_int(0));
+ if ((d == 0) || (overflow))
+ return(real_NaN);
+ /* it would be neat to return 1 from 10000000000000000000000000000/10000000000000000000000000000
+ * but q is the entire number ('/' included) and slash1 is the stuff after the '/', and every
+ * big number comes through here, so there's no clean and safe way to check that q == slash1.
+ */
+ return(s7_make_ratio(sc, n, d));
+ }
+#else
+ return(string_to_either_ratio(sc, q, slash1, radix));
+#endif
-#if (!WITH_PURE_S7)
-static s7_pointer exact_to_inexact(s7_scheme *sc, s7_pointer x)
-{
- /* this is tricky because a big int can mess up when turned into a double:
- * (truncate (exact->inexact most-positive-fixnum)) -> -9223372036854775808
- */
- switch (type(x))
+ /* integer */
+#if (!WITH_GMP)
{
- case T_INTEGER: return(make_real(sc, (s7_double)(integer(x))));
- case T_RATIO: return(make_real(sc, (s7_double)(fraction(x))));
- case T_REAL:
- case T_COMPLEX: return(x); /* apparently (exact->inexact 1+i) is not an error */
- default:
- method_or_bust_with_type(sc, x, sc->exact_to_inexact_symbol, list_1(sc, x), a_number_string, 0);
+ s7_int x;
+ x = string_to_integer(q, radix, &overflow);
+ if (overflow)
+ return((q[0] == '-') ? real_minus_infinity : real_infinity);
+ return(make_integer(sc, x));
}
+#else
+ return(string_to_either_integer(sc, q, radix));
+#endif
+ }
}
-static s7_pointer inexact_to_exact(s7_scheme *sc, s7_pointer x, bool with_error)
+
+static s7_pointer s7_string_to_number(s7_scheme *sc, char *str, int radix)
{
- switch (type(x))
- {
- case T_INTEGER:
- case T_RATIO:
- return(x);
+ s7_pointer x;
+ x = make_atom(sc, str, radix, NO_SYMBOLS, WITHOUT_OVERFLOW_ERROR);
+ if (s7_is_number(x)) /* only needed because str might start with '#' and not be a number (#t for example) */
+ return(x);
+ return(sc->F);
+}
- case T_REAL:
- {
- s7_int numer = 0, denom = 1;
- s7_double val;
- val = s7_real(x);
- if ((is_inf(val)) || (is_NaN(val)))
- {
- if (with_error)
- return(simple_wrong_type_argument_with_type(sc, sc->inexact_to_exact_symbol, x, a_normal_real_string));
- return(sc->nil);
- }
+static s7_pointer g_string_to_number_1(s7_scheme *sc, s7_pointer args, s7_pointer caller)
+{
+ #define H_string_to_number "(string->number str (radix 10)) converts str into a number. \
+If str does not represent a number, string->number returns #f. If 'str' has an embedded radix, \
+the optional 'radix' argument is ignored: (string->number \"#x11\" 2) -> 17 not 3."
+ #define Q_string_to_number s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->is_number_symbol, sc->is_boolean_symbol), sc->is_string_symbol, sc->is_integer_symbol)
- if ((val > s7_int_max) ||
- (val < s7_int_min))
- {
- if (with_error)
- return(simple_out_of_range(sc, sc->inexact_to_exact_symbol, x, its_too_large_string));
- return(sc->nil);
- }
+ s7_int radix = 0;
+ char *str;
- if (c_rationalize(val, sc->default_rationalize_error, &numer, &denom))
- return(s7_make_ratio(sc, numer, denom));
- }
+ if (!is_string(car(args)))
+ method_or_bust(sc, car(args), caller, args, T_STRING, 1);
- default:
- if (with_error)
- method_or_bust(sc, x, sc->inexact_to_exact_symbol, list_1(sc, x), T_REAL, 0);
- return(sc->nil);
+ if (is_pair(cdr(args)))
+ {
+ s7_pointer rad, p;
+ rad = cadr(args);
+ if (!s7_is_integer(rad))
+ {
+ if (!s7_is_integer(p = check_values(sc, rad, cdr(args))))
+ method_or_bust(sc, rad, caller, args, T_INTEGER, 2);
+ rad = p;
+ }
+ radix = s7_integer(rad);
+ if ((radix < 2) || /* what about negative int as base (Knuth), reals such as phi, and some complex like -1+i */
+ (radix > 16)) /* the only problem here is printing the number; perhaps put each digit in "()" in base 10: (123)(0)(34) */
+ return(out_of_range(sc, caller, small_int(2), rad, a_valid_radix_string));
}
- return(x);
-}
-#endif
+ else radix = 10;
-s7_double s7_number_to_real_with_caller(s7_scheme *sc, s7_pointer x, const char *caller)
-{
- if (is_t_real(x))
- return(real(x));
- /* this is nearly always the case in current usage, so by avoiding the "switch" we can go twice as fast */
+ str = (char *)string_value(car(args));
+ if ((!str) || (!(*str)))
+ return(sc->F);
- switch (type(x))
+ switch (str[0])
{
- case T_INTEGER: return((s7_double)integer(x));
- case T_RATIO: return((s7_double)numerator(x) / (s7_double)denominator(x));
- case T_REAL: return(real(x));
-#if WITH_GMP
- case T_BIG_INTEGER: return((s7_double)big_integer_to_s7_int(big_integer(x)));
- case T_BIG_RATIO: return((s7_double)((long double)big_integer_to_s7_int(mpq_numref(big_ratio(x))) /
- (long double)big_integer_to_s7_int(mpq_denref(big_ratio(x)))));
- case T_BIG_REAL: return((s7_double)mpfr_get_d(big_real(x), GMP_RNDN));
-#endif
+ case 'n':
+ if (safe_strcmp(str, "nan.0"))
+ return(real_NaN);
+ break;
+
+ case 'i':
+ if (safe_strcmp(str, "inf.0"))
+ return(real_infinity);
+ break;
+
+ case '-':
+ if ((str[1] == 'i') && (safe_strcmp((const char *)(str + 1), "inf.0")))
+ return(real_minus_infinity);
+ break;
+
+ case '+':
+ if ((str[1] == 'i') && (safe_strcmp((const char *)(str + 1), "inf.0")))
+ return(real_infinity);
+ break;
}
- s7_wrong_type_arg_error(sc, caller, 0, x, "a real number");
- return(0.0);
+ return(s7_string_to_number(sc, str, radix));
}
-s7_double s7_number_to_real(s7_scheme *sc, s7_pointer x)
+static s7_pointer g_string_to_number(s7_scheme *sc, s7_pointer args)
{
- return(s7_number_to_real_with_caller(sc, x, "s7_number_to_real"));
+ return(g_string_to_number_1(sc, args, sc->string_to_number_symbol));
}
-s7_int s7_number_to_integer_with_caller(s7_scheme *sc, s7_pointer x, const char *caller) /* currently unused */
+static bool numbers_are_eqv(s7_pointer a, s7_pointer b)
{
- if (type(x) != T_INTEGER)
- s7_wrong_type_arg_error(sc, caller, 0, x, "an integer");
- return(integer(x));
-}
+ if (type(a) != type(b)) /* (eqv? 1 1.0) -> #f! */
+ return(false);
-s7_int s7_number_to_integer(s7_scheme *sc, s7_pointer x) /* currently unused */
-{
- return(s7_number_to_integer_with_caller(sc, x, "s7_number_to_integer"));
-}
+ switch (type(a))
+ {
+ case T_INTEGER:
+ return((integer(a) == integer(b)));
+
+ case T_RATIO:
+ return((numerator(a) == numerator(b)) &&
+ (denominator(a) == denominator(b)));
+ case T_REAL:
+ if (is_NaN(real(a)))
+ return(false);
+ return(real(a) == real(b));
-s7_int s7_numerator(s7_pointer x)
-{
- switch (type(x))
- {
- case T_INTEGER: return(integer(x));
- case T_RATIO: return(numerator(x));
+ case T_COMPLEX:
+ if ((is_NaN(real_part(a))) ||
+ (is_NaN(imag_part(a))))
+ return(false);
+ return((real_part(a) == real_part(b)) &&
+ (imag_part(a) == imag_part(b)));
+
+ default:
#if WITH_GMP
- case T_BIG_INTEGER: return(big_integer_to_s7_int(big_integer(x)));
- case T_BIG_RATIO: return(big_integer_to_s7_int(mpq_numref(big_ratio(x))));
+ if ((is_big_number(a)) || (is_big_number(b))) /* this can happen if (member bignum ...) -> memv */
+ return(big_numbers_are_eqv(a, b));
#endif
+ break;
}
- return(0);
+ return(false);
}
-s7_int s7_denominator(s7_pointer x)
+static bool is_rational_via_method(s7_scheme *sc, s7_pointer p)
{
- switch (type(x))
+ if (s7_is_rational(p))
+ return(true);
+ if (has_methods(p))
{
- case T_RATIO: return(denominator(x));
-#if WITH_GMP
- case T_BIG_RATIO: return(big_integer_to_s7_int(mpq_denref(big_ratio(x))));
-#endif
+ s7_pointer f;
+ f = find_method(sc, find_let(sc, p), sc->is_rational_symbol);
+ if (f != sc->undefined)
+ return(is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->nil))));
}
- return(1);
+ return(false);
}
-s7_int s7_integer(s7_pointer p)
+/* -------------------------------- abs -------------------------------- */
+#if (!WITH_GMP)
+static s7_pointer g_abs(s7_scheme *sc, s7_pointer args)
{
-#if WITH_GMP
- if (is_t_big_integer(p))
- return(big_integer_to_s7_int(big_integer(p)));
-#endif
- return(integer(p));
-}
+ #define H_abs "(abs x) returns the absolute value of the real number x"
+ #define Q_abs s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_real_symbol)
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(x) < 0)
+ {
+ if (integer(x) == s7_int_min)
+ return(make_integer(sc, s7_int_max));
+ return(make_integer(sc, -integer(x)));
+ }
+ return(x);
-s7_double s7_real(s7_pointer p)
-{
-#if WITH_GMP
- if (is_t_big_real(p))
- return((s7_double)mpfr_get_d(big_real(p), GMP_RNDN));
-#endif
- return(real(p));
-}
+ case T_RATIO:
+ if (numerator(x) < 0)
+ {
+ if (numerator(x) == s7_int_min)
+ return(s7_make_ratio(sc, s7_int_max, denominator(x)));
+ return(s7_make_ratio(sc, -numerator(x), denominator(x)));
+ }
+ return(x);
+ case T_REAL:
+ if (is_NaN(real(x))) /* (abs -nan.0) -> nan.0, not -nan.0 */
+ return(real_NaN);
+ if (real(x) < 0.0)
+ return(make_real(sc, -real(x)));
+ return(x);
-#if (!WITH_GMP)
-static s7_complex s7_to_c_complex(s7_pointer p)
-{
-#if HAVE_COMPLEX_NUMBERS
- return(CMPLX(s7_real_part(p), s7_imag_part(p)));
-#else
- return(0.0);
-#endif
+ default:
+ method_or_bust_one_arg(sc, x, sc->abs_symbol, args, T_REAL);
+ }
}
+static s7_double abs_d_d(s7_double x) {return((x < 0.0) ? (-x) : x);}
+static s7_int abs_i_i(s7_int x) {return((x < 0.0) ? (-x) : x);}
-static s7_pointer s7_from_c_complex(s7_scheme *sc, s7_complex z)
-{
- return(s7_make_complex(sc, creal(z), cimag(z)));
-}
-#endif
+/* -------------------------------- magnitude -------------------------------- */
-#if ((!WITH_PURE_S7) || (!HAVE_OVERFLOW_CHECKS))
-static int integer_length(s7_int a)
+static double my_hypot(double x, double y)
{
- static const int bits[256] =
- {0, 1, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
- 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
- 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
- 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
- 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
- 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
- 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
- 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8};
+ /* according to callgrind, this is much faster than libc's hypot */
+ if (x == 0.0) return(fabs(y));
+ if (y == 0.0) return(fabs(x));
+ if (x == y) return(1.414213562373095 * fabs(x));
+ if ((is_NaN(x)) || (is_NaN(y))) return(NAN);
+ return(sqrt(x * x + y * y));
+}
- #define I_8 256LL
- #define I_16 65536LL
- #define I_24 16777216LL
- #define I_32 4294967296LL
- #define I_40 1099511627776LL
- #define I_48 281474976710656LL
- #define I_56 72057594037927936LL
+static s7_pointer g_magnitude(s7_scheme *sc, s7_pointer args)
+{
+ #define H_magnitude "(magnitude z) returns the magnitude of z"
+ #define Q_magnitude s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_number_symbol)
+ s7_pointer x;
+ x = car(args);
- /* a might be most-negative-fixnum! in Clisp: (integer-length -9223372036854775808) -> 63
- */
- if (a < 0)
+ switch (type(x))
{
- if (a == s7_int_min) return(63);
- a = -a;
- }
- if (a < I_8) return(bits[a]);
- if (a < I_16) return(8 + bits[a >> 8]);
- if (a < I_24) return(16 + bits[a >> 16]);
- if (a < I_32) return(24 + bits[a >> 24]);
- if (a < I_40) return(32 + bits[a >> 32]);
- if (a < I_48) return(40 + bits[a >> 40]);
- if (a < I_56) return(48 + bits[a >> 48]);
- return(56 + bits[a >> 56]);
-}
-#endif
+ case T_INTEGER:
+ if (integer(x) == s7_int_min)
+ return(make_integer(sc, s7_int_max));
+ /* (magnitude -9223372036854775808) -> -9223372036854775808
+ * same thing happens in abs, lcm and gcd: (gcd -9223372036854775808) -> -9223372036854775808
+ */
+ if (integer(x) < 0)
+ return(make_integer(sc, -integer(x)));
+ return(x);
-static int s7_int32_max = 0, s7_int32_min = 0, s7_int_bits = 0, s7_int_digits = 0; /* initialized later */
-static int s7_int_digits_by_radix[17];
+ case T_RATIO:
+ if (numerator(x) < 0)
+ return(s7_make_ratio(sc, -numerator(x), denominator(x)));
+ return(x);
+ case T_REAL:
+ if (is_NaN(real(x))) /* (magnitude -nan.0) -> nan.0, not -nan.0 */
+ return(real_NaN);
+ if (real(x) < 0.0)
+ return(make_real(sc, -real(x)));
+ return(x);
-#if (!WITH_GMP)
-static s7_pointer s7_negate(s7_scheme *sc, s7_pointer p) /* can't use "negate" because it confuses C++! */
-{
- switch (type(p))
- {
- case T_INTEGER: return(make_integer(sc, -integer(p)));
- case T_RATIO: return(s7_make_ratio(sc, -numerator(p), denominator(p)));
- case T_REAL: return(make_real(sc, -real(p)));
- default: return(s7_make_complex(sc, -real_part(p), -imag_part(p)));
+ case T_COMPLEX:
+ return(make_real(sc, my_hypot(imag_part(x), real_part(x))));
+
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->magnitude_symbol, args, a_number_string);
}
}
-#endif
+static s7_double magnitude_d_p(s7_pointer p) {return(s7_number_to_real_with_caller(cur_sc, g_magnitude(cur_sc, set_plist_1(cur_sc, p)), "magnitude"));}
-static s7_pointer s7_invert(s7_scheme *sc, s7_pointer p) /* s7_ to be consistent... */
+
+/* -------------------------------- rationalize -------------------------------- */
+static s7_pointer g_rationalize(s7_scheme *sc, s7_pointer args)
{
- switch (type(p))
+ #define H_rationalize "(rationalize x err) returns the ratio with lowest denominator within err of x"
+ #define Q_rationalize s7_make_signature(sc, 3, sc->is_rational_symbol, sc->is_real_symbol, sc->is_real_symbol)
+ s7_double err;
+ s7_pointer x;
+
+ x = car(args);
+ if (!s7_is_real(x))
+ method_or_bust(sc, x, sc->rationalize_symbol, args, T_REAL, 1);
+
+ if (is_not_null(cdr(args)))
+ {
+ s7_pointer ex;
+ ex = cadr(args);
+ if (!s7_is_real(ex))
+ method_or_bust(sc, ex, sc->rationalize_symbol, args, T_REAL, 2);
+
+ err = real_to_double(sc, ex, "rationalize");
+ if (is_NaN(err))
+ return(out_of_range(sc, sc->rationalize_symbol, small_int(2), cadr(args), its_nan_string));
+ if (err < 0.0) err = -err;
+ }
+ else err = sc->default_rationalize_error;
+
+ switch (type(x))
{
case T_INTEGER:
- return(s7_make_ratio(sc, 1, integer(p))); /* a already checked, not 0 */
+ {
+ s7_int a, b, pa;
+ if (err < 1.0) return(x);
+ a = s7_integer(x);
+ if (a < 0) pa = -a; else pa = a;
+ if (err >= pa) return(small_int(0));
+ b = (s7_int)err;
+ pa -= b;
+ if (a < 0)
+ return(make_integer(sc, -pa));
+ return(make_integer(sc, pa));
+ }
case T_RATIO:
- return(s7_make_ratio(sc, denominator(p), numerator(p)));
+ if (err == 0.0)
+ return(x);
case T_REAL:
- return(make_real(sc, 1.0 / real(p)));
-
- case T_COMPLEX:
{
- s7_double r2, i2, den;
- r2 = real_part(p);
- i2 = imag_part(p);
- den = (r2 * r2 + i2 * i2);
- return(s7_make_complex(sc, r2 / den, -i2 / den));
- }
-
- default:
- return(wrong_type_argument_with_type(sc, sc->divide_symbol, 1, p, a_number_string));
- }
-}
+ s7_double rat;
+ s7_int numer = 0, denom = 1;
+ rat = real_to_double(sc, x, "rationalize");
-static s7_pointer subtract_ratios(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- s7_int d1, d2, n1, n2;
- d1 = number_to_denominator(x);
- n1 = number_to_numerator(x);
- d2 = number_to_denominator(y);
- n2 = number_to_numerator(y);
+ if ((is_NaN(rat)) || (is_inf(rat)))
+ return(wrong_type_argument_with_type(sc, sc->rationalize_symbol, 1, x, a_normal_real_string));
- if (d1 == d2) /* the easy case -- if overflow here, it matches the int case */
- return(s7_make_ratio(sc, n1 - n2, d1));
+ if (err >= fabs(rat))
+ return(small_int(0));
-#if (!WITH_GMP)
-#if HAVE_OVERFLOW_CHECKS
- {
- s7_int n1d2, n2d1, d1d2, dn;
- if ((multiply_overflow(d1, d2, &d1d2)) ||
- (multiply_overflow(n1, d2, &n1d2)) ||
- (multiply_overflow(n2, d1, &n2d1)) ||
- (subtract_overflow(n1d2, n2d1, &dn)))
- return(make_real(sc, ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2)));
- return(s7_make_ratio(sc, dn, d1d2));
- }
-#else
- if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
- (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
- (n1 < s7_int32_min) || (n2 < s7_int32_min))
- {
- int d1bits, d2bits;
- d1bits = integer_length(d1);
- d2bits = integer_length(d2);
- if (((d1bits + d2bits) > s7_int_bits) ||
- ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
- ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
- return(make_real(sc, ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2)));
- return(s7_make_ratio(sc, n1 * d2 - n2 * d1, d1 * d2));
- }
-#endif
-#endif
- return(s7_make_ratio(sc, n1 * d2 - n2 * d1, d1 * d2));
-}
+ if ((rat > 9.2233720368548e+18) || (rat < -9.2233720368548e+18))
+ return(out_of_range(sc, sc->rationalize_symbol, small_int(1), x, its_too_large_string));
+ if ((fabs(rat) + fabs(err)) < 1.0e-18)
+ err = 1.0e-18;
+ /* (/ 1.0 most-positive-fixnum) is 1.0842021e-19, so if we let err be less than that,
+ * (rationalize 1e-19 1e-20) hangs, but this only affects the initial ceiling, I believe.
+ */
-static bool s7_is_negative(s7_pointer obj)
-{
- switch (type(obj))
- {
- case T_INTEGER: return(integer(obj) < 0);
- case T_RATIO: return(numerator(obj) < 0);
-#if WITH_GMP
- case T_BIG_INTEGER: return(mpz_cmp_ui(big_integer(obj), 0) < 0);
- case T_BIG_RATIO: return(mpq_cmp_ui(big_ratio(obj), 0, 1) < 0);
- case T_BIG_REAL: return(mpfr_cmp_ui(big_real(obj), 0) < 0);
-#endif
- default: return(real(obj) < 0);
- }
-}
+ if (fabs(rat) < fabs(err))
+ return(small_int(0));
+ if (c_rationalize(rat, err, &numer, &denom))
+ return(s7_make_ratio(sc, numer, denom));
-static bool s7_is_positive(s7_pointer x)
-{
- switch (type(x))
- {
- case T_INTEGER: return(integer(x) > 0);
- case T_RATIO: return(numerator(x) > 0);
-#if WITH_GMP
- case T_BIG_INTEGER: return(mpz_cmp_ui(big_integer(x), 0) > 0);
- case T_BIG_RATIO: return(mpq_cmp_ui(big_ratio(x), 0, 1) > 0);
- case T_BIG_REAL: return(mpfr_cmp_ui(big_real(x), 0) > 0);
-#endif
- default: return(real(x) > 0.0);
+ return(sc->F);
+ }
}
+ return(sc->F); /* make compiler happy */
}
-static bool s7_is_zero(s7_pointer x)
+/* -------------------------------- angle -------------------------------- */
+static s7_pointer g_angle(s7_scheme *sc, s7_pointer args)
{
+ #define H_angle "(angle z) returns the angle of z"
+ #define Q_angle s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_number_symbol)
+ s7_pointer x;
+ /* (angle inf+infi) -> 0.78539816339745 ?
+ * I think this should be -pi < ang <= pi
+ */
+
+ x = car(args);
switch (type(x))
{
- case T_INTEGER: return(integer(x) == 0);
- case T_REAL: return(real(x) == 0.0);
-#if WITH_GMP
- case T_BIG_INTEGER: return(mpz_cmp_ui(big_integer(x), 0) == 0);
- case T_BIG_REAL: return(mpfr_zero_p(big_real(x)));
-#endif
- default: return(false); /* ratios and complex numbers here are already collapsed into integers and reals */
- }
-}
-
+ case T_INTEGER:
+ if (integer(x) < 0)
+ return(real_pi);
+ return(small_int(0));
-static bool s7_is_one(s7_pointer x)
-{
- return(((is_integer(x)) && (integer(x) == 1)) ||
- ((is_t_real(x)) && (real(x) == 1.0)));
-}
+ case T_RATIO:
+ if (numerator(x) < 0)
+ return(real_pi);
+ return(small_int(0));
+ case T_REAL:
+ if (is_NaN(real(x))) return(x);
+ if (real(x) < 0.0)
+ return(real_pi);
+ return(real_zero);
-/* optimize exponents */
-#define MAX_POW 32
-static double pepow[17][MAX_POW], mepow[17][MAX_POW];
+ case T_COMPLEX:
+ return(make_real(sc, atan2(imag_part(x), real_part(x))));
-static void init_pows(void)
-{
- int i, j;
- for (i = 2; i < 17; i++) /* radix between 2 and 16 */
- for (j = 0; j < MAX_POW; j++) /* saved exponent between 0 and +/- MAX_POW */
- {
- pepow[i][j] = pow((double)i, (double)j);
- mepow[i][j] = pow((double)i, (double)(-j));
- }
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->angle_symbol, args, a_number_string);
+ }
}
-static double ipow(int x, int y)
+static s7_double angle_d_p(s7_pointer x)
{
- if ((y < MAX_POW) && (y > (-MAX_POW)))
+ switch (type(x))
{
- if (y >= 0)
- return(pepow[x][y]);
- return(mepow[x][-y]);
+ case T_INTEGER: if (integer(x) < 0) return(M_PI); return(0.0); break;
+ case T_RATIO: if (numerator(x) < 0) return(M_PI); return(0.0); break;
+ case T_REAL: if (is_NaN(real(x))) return(NAN); if (real(x) < 0.0) return(M_PI); return(0.0); break;
+ case T_COMPLEX: return(atan2(imag_part(x), real_part(x))); break;
+ default: simple_wrong_type_argument_with_type(cur_sc, cur_sc->angle_symbol, x, a_number_string); break;
}
- return(pow((double)x, (double)y));
+ return(0.0);
}
-static int s7_int_to_string(char *p, s7_int n, int radix, int width)
+/* -------------------------------- make-polar -------------------------------- */
+#if (!WITH_PURE_S7)
+static s7_pointer g_make_polar(s7_scheme *sc, s7_pointer args)
{
- static const char dignum[] = "0123456789abcdef";
- int i, len, start, end;
- bool sign;
- s7_int pown;
+ s7_pointer x, y;
+ s7_double ang, mag;
+ #define H_make_polar "(make-polar mag ang) returns a complex number with magnitude mag and angle ang"
+ #define Q_make_polar s7_make_signature(sc, 3, sc->is_number_symbol, sc->is_real_symbol, sc->is_real_symbol)
- if ((radix < 2) || (radix > 16))
- return(0);
+ x = car(args);
+ y = cadr(args);
- if (n == s7_int_min) /* can't negate this, so do it by hand */
+ switch (type(x))
{
- static const char *mnfs[17] = {"","",
- "-1000000000000000000000000000000000000000000000000000000000000000", "-2021110011022210012102010021220101220222",
- "-20000000000000000000000000000000", "-1104332401304422434310311213", "-1540241003031030222122212",
- "-22341010611245052052301", "-1000000000000000000000", "-67404283172107811828", "-9223372036854775808",
- "-1728002635214590698", "-41a792678515120368", "-10b269549075433c38", "-4340724c6c71dc7a8", "-160e2ad3246366808", "-8000000000000000"};
-
- len = safe_strlen(mnfs[radix]);
- if (width > len)
+ case T_INTEGER:
+ switch (type(y))
{
- start = width - len - 1;
- memset((void *)p, (int)' ', start);
+ case T_INTEGER:
+ if (integer(x) == 0) return(x); /* (make-polar 0 1) -> 0 */
+ if (integer(y) == 0) return(x); /* (make-polar 1 0) -> 1 */
+ mag = (s7_double)integer(x);
+ ang = (s7_double)integer(y);
+ break;
+
+ case T_RATIO:
+ if (integer(x) == 0) return(x);
+ mag = (s7_double)integer(x);
+ ang = (s7_double)fraction(y);
+ break;
+
+ case T_REAL:
+ ang = real(y);
+ if (ang == 0.0) return(x);
+ if (is_NaN(ang)) return(y);
+ if (is_inf(ang)) return(real_NaN);
+ if ((ang == M_PI) || (ang == -M_PI)) return(make_integer(sc, -integer(x)));
+ mag = (s7_double)integer(x);
+ break;
+
+ default:
+ method_or_bust(sc, y, sc->make_polar_symbol, args, T_REAL, 2);
}
- else start = 0;
- for (i = 0; i < len; i++)
- p[start + i] = mnfs[radix][i];
- p[len + start] = '\0';
- return(len + start);
- }
+ break;
- sign = (n < 0);
- if (sign) n = -n;
+ case T_RATIO:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(y) == 0) return(x);
+ mag = (s7_double)fraction(x);
+ ang = (s7_double)integer(y);
+ break;
- /* the previous version that counted up to n, rather than dividing down below n, as here,
- * could be confused by large ints on 64 bit machines
- */
- pown = n;
- for (i = 1; i < 100; i++)
- {
- if (pown < radix)
- break;
- pown /= (s7_int)radix;
- }
- len = i - 1;
- if (sign) len++;
- end = 0;
- if (width > len) /* (format #f "~10B" 123) */
- {
- start = width - len - 1;
- end += start;
- memset((void *)p, (int)' ', start);
- }
- else
- {
- start = 0;
- end = 0;
- }
+ case T_RATIO:
+ mag = (s7_double)fraction(x);
+ ang = (s7_double)fraction(y);
+ break;
- if (sign)
- {
- p[start] = '-';
- end++;
- }
+ case T_REAL:
+ ang = real(y);
+ if (ang == 0.0) return(x);
+ if (is_NaN(ang)) return(y);
+ if (is_inf(ang)) return(real_NaN);
+ if ((ang == M_PI) || (ang == -M_PI)) return(s7_make_ratio(sc, -numerator(x), denominator(x)));
+ mag = (s7_double)fraction(x);
+ break;
- for (i = start + len; i >= end; i--)
- {
- p[i] = dignum[n % radix];
- n /= radix;
- }
- p[len + start + 1] = '\0';
- return(len + start + 1);
-}
+ default:
+ method_or_bust(sc, y, sc->make_polar_symbol, args, T_REAL, 2);
+ }
+ break;
+ case T_REAL:
+ mag = real(x);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (is_NaN(mag)) return(x);
+ if (integer(y) == 0) return(x);
+ ang = (s7_double)integer(y);
+ break;
-static char *integer_to_string_base_10_no_width(s7_pointer obj, int *nlen) /* do not free the returned string */
-{
- long long int num;
- char *p, *op;
- bool sign;
- static char int_to_str[INT_TO_STR_SIZE];
+ case T_RATIO:
+ if (is_NaN(mag)) return(x);
+ ang = (s7_double)fraction(y);
+ break;
- if (has_print_name(obj))
- {
- (*nlen) = print_name_length(obj);
- return((char *)print_name(obj));
- }
- /* (*nlen) = snprintf(int_to_str, INT_TO_STR_SIZE, "%lld", (long long int)integer(obj));
- * but that is very slow -- the following code is 6 times faster
- */
- num = (long long int)integer(obj);
- if (num == s7_int_min)
- {
- (*nlen) = 20;
- return((char *)"-9223372036854775808");
- }
- p = (char *)(int_to_str + INT_TO_STR_SIZE - 1);
- op = p;
- *p-- = '\0';
+ case T_REAL:
+ if (is_NaN(mag)) return(x);
+ ang = real(y);
+ if (ang == 0.0) return(x);
+ if (is_NaN(ang)) return(y);
+ if (is_inf(ang)) return(real_NaN);
+ break;
- sign = (num < 0);
- if (sign) num = -num; /* we need a positive index below */
- do {*p-- = "0123456789"[num % 10]; num /= 10;} while (num);
- if (sign)
- {
- *p = '-';
- (*nlen) = op - p;
- return(p);
+ default:
+ method_or_bust(sc, y, sc->make_polar_symbol, args, T_REAL, 2);
+ }
+ break;
+
+ default:
+ method_or_bust(sc, x, sc->make_polar_symbol, args, T_REAL, 1);
}
- (*nlen) = op - p - 1;
- return(++p);
+ return(s7_make_complex(sc, mag * cos(ang), mag * sin(ang)));
+
+ /* since sin is inaccurate for large arguments, so is make-polar:
+ * (make-polar 1.0 1e40) -> -0.76267273202438+0.64678458842683i, not 8.218988919070239214448025364432557517335E-1-5.696334009536363273080341815735687231337E-1i
+ */
}
+#endif
-#define BASE_10 10
-static int num_to_str_size = -1;
-static char *num_to_str = NULL;
-static const char *float_format_g = NULL;
+/* -------------------------------- complex -------------------------------- */
-static char *floatify(char *str, int *nlen)
+static s7_pointer c_complex(s7_scheme *sc, s7_double rl, s7_double im)
{
- if ((!strchr(str, 'e')) &&
- (!strchr(str, '.')))
- {
- /* this assumes there is room in str for 2 more chars */
- int len;
- len = *nlen;
- str[len]='.';
- str[len + 1]='0';
- str[len + 2]='\0';
- (*nlen) = len + 2;
- }
- return(str);
+ /* same as s7_make_complex, but assumes im is not 0.0 */
+ s7_pointer x;
+ new_cell(sc, x, T_COMPLEX);
+ set_real_part(x, rl);
+ set_imag_part(x, im);
+ return(x);
}
-static char *number_to_string_base_10(s7_pointer obj, int width, int precision, char float_choice, int *nlen, use_write_t choice) /* don't free result */
+static s7_pointer g_complex(s7_scheme *sc, s7_pointer args)
{
- /* the rest of s7 assumes nlen is set to the correct length
- * a tricky case: (format #f "~f" 1e308) -- tries to print 308 digits! so 256 as default len is too small.
- * but then even worse: (format #f "~F" 1e308+1e308i)!
- */
- int len;
- len = 1024;
- if (width > len) len = 2 * width;
- if (len > num_to_str_size)
- {
- if (!num_to_str)
- num_to_str = (char *)malloc(len * sizeof(char));
- else num_to_str = (char *)realloc(num_to_str, len * sizeof(char));
- num_to_str_size = len;
- }
+ s7_pointer x, y;
+ #define H_complex "(complex x1 x2) returns a complex number with real-part x1 and imaginary-part x2"
+ #define Q_complex s7_make_signature(sc, 3, sc->is_number_symbol, sc->is_real_symbol, sc->is_real_symbol)
- /* bignums can't happen here */
- switch (type(obj))
+ x = car(args);
+ y = cadr(args);
+
+ switch (type(y))
{
case T_INTEGER:
- if (width == 0)
- return(integer_to_string_base_10_no_width(obj, nlen));
- (*nlen) = snprintf(num_to_str, num_to_str_size, "%*lld", width, (long long int)integer(obj));
- break;
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(y) == 0) return(x);
+ return(c_complex(sc, (s7_double)integer(x), (s7_double)integer(y)));
+
+ case T_RATIO:
+ if (integer(y) == 0) return(x);
+ return(c_complex(sc, (s7_double)fraction(x), (s7_double)integer(y)));
+
+ case T_REAL:
+ if (integer(y) == 0) return(x);
+ return(c_complex(sc, real(x), (s7_double)integer(y)));
+
+ default:
+ method_or_bust(sc, x, sc->complex_symbol, args, T_REAL, 1);
+ }
case T_RATIO:
- len = snprintf(num_to_str, num_to_str_size, "%lld/%lld", (long long int)numerator(obj), (long long int)denominator(obj));
- if (width > len)
+ switch (type(x))
{
- int spaces;
- if (width >= num_to_str_size)
- {
- num_to_str_size = width + 1;
- num_to_str = (char *)realloc(num_to_str, num_to_str_size * sizeof(char));
- }
- spaces = width - len;
- num_to_str[width] = '\0';
- memmove((void *)(num_to_str + spaces), (void *)num_to_str, len);
- memset((void *)num_to_str, (int)' ', spaces);
- (*nlen) = width;
+ case T_INTEGER: return(c_complex(sc, (s7_double)integer(x), (s7_double)fraction(y)));
+ case T_RATIO: return(c_complex(sc, (s7_double)fraction(x), (s7_double)fraction(y)));
+ case T_REAL: return(c_complex(sc, real(x), (s7_double)fraction(y)));
+ default:
+ method_or_bust(sc, x, sc->complex_symbol, args, T_REAL, 1);
}
- else (*nlen) = len;
- break;
case T_REAL:
- {
- const char *frmt;
- if (sizeof(double) >= sizeof(s7_double))
- frmt = (float_choice == 'g') ? "%*.*g" : ((float_choice == 'f') ? "%*.*f" : "%*.*e");
- else frmt = (float_choice == 'g') ? "%*.*Lg" : ((float_choice == 'f') ? "%*.*Lf" : "%*.*Le");
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (real(y) == 0.0) return(x);
+ return(c_complex(sc, (s7_double)integer(x), real(y)));
- len = snprintf(num_to_str, num_to_str_size - 4, frmt, width, precision, s7_real(obj)); /* -4 for floatify */
- (*nlen) = len;
- floatify(num_to_str, nlen);
- }
- break;
+ case T_RATIO:
+ if (real(y) == 0.0) return(x);
+ return(c_complex(sc, (s7_double)fraction(x), real(y)));
- default:
- {
- if ((choice == USE_READABLE_WRITE) &&
- ((is_NaN(real_part(obj))) || (is_NaN(imag_part(obj))) || ((is_inf(real_part(obj))) || (is_inf(imag_part(obj))))))
- {
- char rbuf[128], ibuf[128];
- char *rp, *ip;
- if (is_NaN(real_part(obj)))
- rp = (char *)"nan.0";
- else
- {
- if (is_inf(real_part(obj)))
- {
- if (real_part(obj) < 0.0)
- rp = (char *)"-inf.0";
- else rp = (char *)"inf.0";
- }
- else
- {
- snprintf(rbuf, 128, float_format_g, precision, real_part(obj));
- rp = rbuf;
- }
- }
- if (is_NaN(imag_part(obj)))
- ip = (char *)"nan.0";
- else
- {
- if (is_inf(imag_part(obj)))
- {
- if (imag_part(obj) < 0.0)
- ip = (char *)"-inf.0";
- else ip = (char *)"inf.0";
- }
- else
- {
- snprintf(ibuf, 128, float_format_g, precision, imag_part(obj));
- ip = ibuf;
- }
- }
- len = snprintf(num_to_str, num_to_str_size, "(complex %s %s)", rp, ip);
- }
- else
- {
- const char *frmt;
- if (sizeof(double) >= sizeof(s7_double))
- {
- if (imag_part(obj) >= 0.0)
- frmt = (float_choice == 'g') ? "%.*g+%.*gi" : ((float_choice == 'f') ? "%.*f+%.*fi" : "%.*e+%.*ei");
- else frmt = (float_choice == 'g') ? "%.*g%.*gi" : ((float_choice == 'f') ? "%.*f%.*fi" :"%.*e%.*ei"); /* minus sign comes with the imag_part */
- }
- else
- {
- if (imag_part(obj) >= 0.0)
- frmt = (float_choice == 'g') ? "%.*Lg+%.*Lgi" : ((float_choice == 'f') ? "%.*Lf+%.*Lfi" : "%.*Le+%.*Lei");
- else frmt = (float_choice == 'g') ? "%.*Lg%.*Lgi" : ((float_choice == 'f') ? "%.*Lf%.*Lfi" : "%.*Le%.*Lei");
- }
+ case T_REAL:
+ if (real(y) == 0.0) return(x);
+ return(c_complex(sc, real(x), real(y)));
- len = snprintf(num_to_str, num_to_str_size, frmt, precision, real_part(obj), precision, imag_part(obj));
- }
+ default:
+ method_or_bust(sc, x, sc->complex_symbol, args, T_REAL, 1);
+ }
- if (width > len) /* (format #f "~20g" 1+i) */
- {
- int spaces;
- if (width >= num_to_str_size)
- {
- num_to_str_size = width + 1;
- num_to_str = (char *)realloc(num_to_str, num_to_str_size * sizeof(char));
- }
- spaces = width - len;
- num_to_str[width] = '\0';
- memmove((void *)(num_to_str + spaces), (void *)num_to_str, len);
- memset((void *)num_to_str, (int)' ', spaces);
- (*nlen) = width;
- }
- else (*nlen) = len;
- }
- break;
+ default:
+ method_or_bust(sc, (is_let(x)) ? x : y, sc->complex_symbol, args, T_REAL, 2);
}
- return(num_to_str);
}
-
-static char *number_to_string_with_radix(s7_scheme *sc, s7_pointer obj, int radix, int width, int precision, char float_choice, int *nlen)
+static s7_pointer complex_p_ii(s7_int x, s7_int y)
{
- /* the rest of s7 assumes nlen is set to the correct length */
- char *p;
- int len, str_len;
+ if (y == 0)
+ return(make_real(cur_sc, (s7_double)x));
+ return(c_complex(cur_sc, (s7_double)x, (s7_double)y));
+}
-#if WITH_GMP
- if (s7_is_bignum(obj))
- return(big_number_to_string_with_radix(obj, radix, width, nlen, USE_WRITE));
- /* this ignores precision because it's way too hard to get the mpfr string to look like
- * C's output -- we either have to call mpfr_get_str twice (the first time just to
- * find out what the exponent is and how long the string actually is), or we have
- * to do messy string manipulations. So (format #f "",3F" pi) ignores the "3" and
- * prints the full string.
- */
-#endif
- if (radix == 10)
- {
- p = number_to_string_base_10(obj, width, precision, float_choice, nlen, USE_WRITE);
- return(copy_string_with_length(p, *nlen));
- }
+/* -------------------------------- exp -------------------------------- */
+static s7_pointer g_exp(s7_scheme *sc, s7_pointer args)
+{
+ #define H_exp "(exp z) returns e^z, (exp 1) is 2.718281828459"
+ #define Q_exp pcl_n
- switch (type(obj))
+ s7_pointer x;
+
+ x = car(args);
+ switch (type(x))
{
case T_INTEGER:
- p = (char *)malloc((128 + width) * sizeof(char));
- *nlen = s7_int_to_string(p, s7_integer(obj), radix, width);
- return(p);
+ if (integer(x) == 0) return(small_int(1)); /* (exp 0) -> 1 */
+ return(make_real(sc, exp((s7_double)(integer(x)))));
case T_RATIO:
- {
- char n[128], d[128];
- s7_int_to_string(n, numerator(obj), radix, 0);
- s7_int_to_string(d, denominator(obj), radix, 0);
- p = (char *)malloc(256 * sizeof(char));
- len = snprintf(p, 256, "%s/%s", n, d);
- str_len = 256;
- }
- break;
+ return(make_real(sc, exp((s7_double)fraction(x))));
case T_REAL:
- {
- int i;
- s7_int int_part;
- s7_double x, frac_part, min_frac, base;
- bool sign = false;
- char n[128], d[256];
-
- x = s7_real(obj);
-
- if (is_NaN(x))
- return(copy_string_with_length("nan.0", *nlen = 5));
- if (is_inf(x))
- {
- if (x < 0.0)
- return(copy_string_with_length("-inf.0", *nlen = 6));
- return(copy_string_with_length("inf.0", *nlen = 5));
- }
-
- if (x < 0.0)
- {
- sign = true;
- x = -x;
- }
-
- if (x > 1.0e18) /* i.e. close to or greater than most-positive-fixnum (9.22e18), so the code below is unlikely to work, (format #f "~X" 1e19) */
- {
- int ep;
- char *p1;
- s7_pointer r;
-
- len = 0;
- ep = (int)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));
- (*nlen) = snprintf(p, len + 8, "%s%se%d", (sign) ? "-" : "", p1, ep);
- free(p1);
- return(p);
- }
-
- int_part = (s7_int)floor(x);
- frac_part = x - int_part;
- s7_int_to_string(n, int_part, radix, 0);
- min_frac = (s7_double)ipow(radix, -precision);
-
- /* doesn't this assume precision < 128/256 and that we can fit in 256 digits (1e308)? */
+ return(make_real(sc, exp(real(x))));
- for (i = 0, base = radix; (i < precision) && (frac_part > min_frac); i++, base *= radix)
- {
- s7_int ipart;
- ipart = (s7_int)(frac_part * base);
- if (ipart >= radix) /* rounding confusion */
- ipart = radix - 1;
- frac_part -= (ipart / base);
- if (ipart < 10)
- d[i] = (char)('0' + ipart);
- else d[i] = (char)('a' + ipart - 10);
- }
- if (i == 0)
- d[i++] = '0';
- d[i] = '\0';
- p = (char *)malloc(256 * sizeof(char));
- len = snprintf(p, 256, "%s%s.%s", (sign) ? "-" : "", n, d);
- str_len = 256;
- }
- break;
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ return(s7_from_c_complex(sc, cexp(as_c_complex(x))));
+ /* this is inaccurate for large arguments:
+ * (exp 0+1e20i) -> -0.66491178990701-0.74692189125949i, not 7.639704044417283004001468027378811228331E-1-6.45251285265780844205811711312523007406E-1i
+ */
+#else
+ return(out_of_range(sc, sc->exp_symbol, small_int(1), x, no_complex_numbers_string));
+#endif
default:
- {
- char *n, *d;
- p = (char *)malloc(512 * sizeof(char));
- n = number_to_string_with_radix(sc, make_real(sc, real_part(obj)), radix, 0, precision, float_choice, &len);
- d = number_to_string_with_radix(sc, make_real(sc, imag_part(obj)), radix, 0, precision, float_choice, &len);
- len = snprintf(p, 512, "%s%s%si", n, (imag_part(obj) < 0.0) ? "" : "+", d);
- str_len = 512;
- free(n);
- free(d);
- }
- break;
- }
-
- if (width > len)
- {
- int spaces;
- if (width >= str_len)
- {
- str_len = width + 1;
- p = (char *)realloc(p, str_len * sizeof(char));
- }
- spaces = width - len;
- p[width] = '\0';
- memmove((void *)(p + spaces), (void *)p, len);
- memset((void *)p, (int)' ', spaces);
- (*nlen) = width;
+ method_or_bust_with_type_one_arg(sc, x, sc->exp_symbol, args, a_number_string);
}
- else (*nlen) = len;
- return(p);
}
+static s7_double exp_d_d(s7_double x) {return(exp(x));}
-char *s7_number_to_string(s7_scheme *sc, s7_pointer obj, int radix)
-{
- int nlen = 0;
- return(number_to_string_with_radix(sc, obj, radix, 0, 20, 'g', &nlen));
- /* (log top 10) so we get all the digits in base 10 (??) */
-}
+/* -------------------------------- log -------------------------------- */
-static void prepare_temporary_string(s7_scheme *sc, int len, int which)
-{
- s7_pointer p;
- p = sc->tmp_strs[which];
- if (len > string_temp_true_length(p))
- {
- string_value(p) = (char *)realloc(string_value(p), len * sizeof(char));
- string_temp_true_length(p) = len;
- }
-}
+#if __cplusplus
+#define LOG_2 1.4426950408889634074
+#else
+#define LOG_2 1.4426950408889634073599246810018921L /* (/ (log 2.0)) */
+#endif
-static s7_pointer g_number_to_string_1(s7_scheme *sc, s7_pointer args, bool temporary)
+static s7_pointer g_log(s7_scheme *sc, s7_pointer args)
{
- #define H_number_to_string "(number->string num (radix 10)) converts the number num into a string."
- #define Q_number_to_string s7_make_signature(sc, 3, sc->is_string_symbol, sc->is_number_symbol, sc->is_integer_symbol)
+ #define H_log "(log z1 (z2 e)) returns log(z1) / log(z2) where z2 (the base) defaults to e: (log 8 2) = 3"
+ #define Q_log pcl_n
- s7_int radix = 10;
- int size, nlen = 0;
- char *res;
s7_pointer x;
-
x = car(args);
if (!s7_is_number(x))
- method_or_bust_with_type(sc, x, sc->number_to_string_symbol, args, a_number_string, 1);
+ method_or_bust_with_type(sc, x, sc->log_symbol, args, a_number_string, 1);
if (is_pair(cdr(args)))
{
s7_pointer y;
- y = cadr(args);
- if (s7_is_integer(y))
- radix = s7_integer(y);
- else method_or_bust(sc, y, sc->number_to_string_symbol, args, T_INTEGER, 2);
- if ((radix < 2) || (radix > 16))
- return(out_of_range(sc, sc->number_to_string_symbol, small_int(2), y, a_valid_radix_string));
- }
-#if WITH_GMP
- if (s7_is_bignum(x))
- {
- res = big_number_to_string_with_radix(x, radix, 0, &nlen, USE_WRITE);
- return(make_string_uncopied_with_length(sc, res, nlen));
- }
-#endif
+ y = cadr(args);
+ if (!(s7_is_number(y)))
+ method_or_bust_with_type(sc, y, sc->log_symbol, args, a_number_string, 2);
- size = float_format_precision;
- if (!is_rational(x))
- {
- /* if size = 20, (number->string .1) gives "0.10000000000000000555", but if it's less than 20,
- * large numbers (or very small numbers) mess up the less significant digits.
- */
- if (radix == 10)
+ if (y == small_int(2))
{
- if (is_real(x))
- {
- s7_double val;
- val = fabs(s7_real(x));
- if ((val > (s7_int32_max / 4)) || (val < 1.0e-6))
- size += 4;
- }
- else
+ /* (define (2^n? x) (and (not (zero? x)) (zero? (logand x (- x 1))))) */
+ if (is_integer(x))
{
- s7_double rl;
- rl = fabs(s7_real_part(x));
- if ((rl > (s7_int32_max / 4)) || (rl < 1.0e-6))
+ s7_int ix;
+ ix = s7_integer(x);
+ if (ix > 0)
{
- s7_double im;
- im = fabs(s7_imag_part(x));
- if ((im > (s7_int32_max / 4)) || (im < 1.0e-6))
- size += 4;
+ s7_double fx;
+#if (__ANDROID__) || (MS_WINDOWS) || ((__GNUC__) && ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ <= 4))))
+ /* just a guess -- log2 gets a warning in gcc 4.3.2, but not in 4.4.4 */
+ fx = log((double)ix) / log(2.0);
+#else
+ fx = log2((double)ix);
+#endif
+ /* (s7_int)fx rounds (log 8 2) to 2 in FreeBSD! */
+#if ((__GNUC__) && ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ < 4))))
+ return(make_real(sc, fx));
+#else
+ if ((ix & (ix - 1)) == 0)
+ return(make_integer(sc, (s7_int)s7_round(fx)));
+ return(make_real(sc, fx));
+#endif
}
}
+ if ((s7_is_real(x)) &&
+ (s7_is_positive(x)))
+ return(make_real(sc, log(real_to_double(sc, x, "log")) * LOG_2));
+ return(s7_from_c_complex(sc, clog(s7_to_c_complex(x)) * LOG_2));
}
+
+ if ((x == small_int(1)) && (y == small_int(1))) /* (log 1 1) -> 0 (this is NaN in the bignum case) */
+ return(small_int(0));
+
+ /* (log 1 0) must be 0 since everyone says (expt 0 0) is 1 */
+ if (s7_is_zero(y))
+ {
+ if ((y == small_int(0)) &&
+ (x == small_int(1)))
+ return(y);
+ return(out_of_range(sc, sc->log_symbol, small_int(2), y, make_string_wrapper(sc, "can't be 0")));
+ }
+
+ if (s7_is_one(y)) /* this used to raise an error, but the bignum case is simpler if we return inf */
+ {
+ if (s7_is_one(x)) /* but (log 1.0 1.0) -> 0.0 */
+ return(real_zero);
+ return(real_infinity); /* currently (log 1/0 1) is inf? */
+ }
+
+ if ((s7_is_real(x)) &&
+ (s7_is_real(y)) &&
+ (s7_is_positive(x)) &&
+ (s7_is_positive(y)))
+ {
+ if ((s7_is_rational(x)) &&
+ (s7_is_rational(y)))
+ {
+ s7_double res;
+ s7_int ires;
+ res = log(rational_to_double(sc, x)) / log(rational_to_double(sc, y));
+ ires = (s7_int)res;
+ if (res - ires == 0.0)
+ return(make_integer(sc, ires)); /* (log 8 2) -> 3 or (log 1/8 2) -> -3 */
+ return(make_real(sc, res)); /* perhaps use rationalize here? (log 2 8) -> 1/3 */
+ }
+ return(make_real(sc, log(real_to_double(sc, x, "log")) / log(real_to_double(sc, y, "log"))));
+ }
+ return(s7_from_c_complex(sc, clog(s7_to_c_complex(x)) / clog(s7_to_c_complex(y))));
}
- if (radix != 10)
- {
- res = number_to_string_with_radix(sc, x, radix, 0, size, 'g', &nlen);
- return(make_string_uncopied_with_length(sc, res, nlen));
- }
- res = number_to_string_base_10(x, 0, size, 'g', &nlen, USE_WRITE);
- if (temporary)
+
+ if (s7_is_real(x))
{
- s7_pointer p;
- prepare_temporary_string(sc, nlen + 1, 1);
- p = sc->tmp_strs[1];
- string_length(p) = nlen;
- memcpy((void *)(string_value(p)), (void *)res, nlen);
- string_value(p)[nlen] = 0;
- return(p);
+ if (s7_is_positive(x))
+ return(make_real(sc, log(real_to_double(sc, x, "log"))));
+ return(s7_make_complex(sc, log(-real_to_double(sc, x, "log")), M_PI));
}
- return(s7_make_string_with_length(sc, res, nlen));
+ return(s7_from_c_complex(sc, clog(s7_to_c_complex(x))));
}
-static s7_pointer g_number_to_string(s7_scheme *sc, s7_pointer args)
-{
- return(g_number_to_string_1(sc, args, false));
-}
-static s7_pointer number_to_string_temp;
-static s7_pointer g_number_to_string_temp(s7_scheme *sc, s7_pointer args)
-{
- return(g_number_to_string_1(sc, args, true));
-}
-static s7_pointer number_to_string_pf_temp(s7_scheme *sc, s7_pointer **p)
+/* -------------------------------- sin -------------------------------- */
+static s7_pointer g_sin(s7_scheme *sc, s7_pointer args)
{
- s7_pf_t f;
- s7_pointer x;
- f = (s7_pf_t)(**p); (*p)++;
- x = f(sc, p);
- return(g_number_to_string_1(sc, set_plist_1(sc, x), true));
-}
+ #define H_sin "(sin z) returns sin(z)"
+ #define Q_sin pcl_n
-static s7_pointer number_to_string_pf_s_temp(s7_scheme *sc, s7_pointer **p)
-{
s7_pointer x;
- (*p)++; x = slot_value(**p); (*p)++;
- return(g_number_to_string_1(sc, set_plist_1(sc, x), true));
-}
+ x = car(args);
+ switch (type(x))
+ {
+ case T_REAL:
+ return(make_real(sc, sin(real(x))));
-static s7_pointer c_number_to_string(s7_scheme *sc, s7_pointer n) {return(g_number_to_string_1(sc, set_plist_1(sc, n), false));}
-PF_TO_PF(number_to_string, c_number_to_string)
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(0)); /* (sin 0) -> 0 */
+ return(make_real(sc, sin((s7_double)integer(x))));
+ case T_RATIO:
+ return(make_real(sc, sin((s7_double)(fraction(x)))));
-#define CTABLE_SIZE 256
-static bool *exponent_table, *slashify_table, *char_ok_in_a_name, *white_space, *number_table, *symbol_slashify_table;
-static int *digits;
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ return(s7_from_c_complex(sc, csin(as_c_complex(x))));
+#else
+ return(out_of_range(sc, sc->sin_symbol, small_int(1), x, no_complex_numbers_string));
+#endif
-static void init_ctables(void)
-{
- int i;
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->sin_symbol, args, a_number_string);
+ }
- exponent_table = (bool *)calloc(CTABLE_SIZE, sizeof(bool));
- slashify_table = (bool *)calloc(CTABLE_SIZE, sizeof(bool));
- symbol_slashify_table = (bool *)calloc(CTABLE_SIZE, sizeof(bool));
- char_ok_in_a_name = (bool *)calloc(CTABLE_SIZE, sizeof(bool));
- white_space = (bool *)calloc(CTABLE_SIZE + 1, sizeof(bool));
- white_space++; /* leave white_space[-1] false for white_space[EOF] */
- number_table = (bool *)calloc(CTABLE_SIZE, sizeof(bool));
+ /* sin is totally inaccurate over about 1e18. There's a way to get true results,
+ * but it involves fancy "range reduction" techniques.
+ * This means that lots of things are inaccurate:
+ * (sin (remainder 1e22 (* 2 pi)))
+ * -0.57876806033477
+ * but it should be -8.522008497671888065747423101326159661908E-1
+ * ---
+ * (remainder 1e22 (* 2 pi)) -> 1.0057952155665e+22 !!
+ * it should be 5.263007914620499494429139986095833592117E0
+ */
+}
- for (i = 1; i < CTABLE_SIZE; i++)
- char_ok_in_a_name[i] = true;
- char_ok_in_a_name[0] = false;
- char_ok_in_a_name[(unsigned char)'('] = false; /* idiotic cast is for C++'s benefit */
- char_ok_in_a_name[(unsigned char)')'] = false;
- char_ok_in_a_name[(unsigned char)';'] = false;
- char_ok_in_a_name[(unsigned char)'\t'] = false;
- char_ok_in_a_name[(unsigned char)'\n'] = false;
- char_ok_in_a_name[(unsigned char)'\r'] = false;
- char_ok_in_a_name[(unsigned char)' '] = false;
- char_ok_in_a_name[(unsigned char)'"'] = false;
- /* what about stuff like vertical tab? or comma? */
+static s7_double sin_d_d(s7_double x) {return(sin(x));}
- for (i = 0; i < CTABLE_SIZE; i++)
- white_space[i] = false;
- white_space[(unsigned char)'\t'] = true;
- white_space[(unsigned char)'\n'] = true;
- white_space[(unsigned char)'\r'] = true;
- white_space[(unsigned char)'\f'] = true;
- white_space[(unsigned char)'\v'] = true;
- white_space[(unsigned char)' '] = true;
- white_space[(unsigned char)'\205'] = true; /* 133 */
- white_space[(unsigned char)'\240'] = true; /* 160 */
- /* surely only 'e' is needed... */
- exponent_table[(unsigned char)'e'] = true; exponent_table[(unsigned char)'E'] = true;
- exponent_table[(unsigned char)'@'] = true;
-#if WITH_EXTRA_EXPONENT_MARKERS
- exponent_table[(unsigned char)'s'] = true; exponent_table[(unsigned char)'S'] = true;
- exponent_table[(unsigned char)'f'] = true; exponent_table[(unsigned char)'F'] = true;
- exponent_table[(unsigned char)'d'] = true; exponent_table[(unsigned char)'D'] = true;
- exponent_table[(unsigned char)'l'] = true; exponent_table[(unsigned char)'L'] = true;
-#endif
+/* -------------------------------- cos -------------------------------- */
+static s7_pointer g_cos(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cos "(cos z) returns cos(z)"
+ #define Q_cos pcl_n
- for (i = 0; i < 32; i++)
- slashify_table[i] = true;
- for (i = 127; i < 160; i++)
- slashify_table[i] = true;
- slashify_table[(unsigned char)'\\'] = true;
- slashify_table[(unsigned char)'"'] = true;
- slashify_table[(unsigned char)'\n'] = false;
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_REAL:
+ return(make_real(sc, cos(real(x))));
- for (i = 0; i < CTABLE_SIZE; i++)
- symbol_slashify_table[i] = ((slashify_table[i]) || (!char_ok_in_a_name[i]));
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(1)); /* (cos 0) -> 1 */
+ return(make_real(sc, cos((s7_double)integer(x))));
- digits = (int *)calloc(CTABLE_SIZE, sizeof(int));
- for (i = 0; i < CTABLE_SIZE; i++)
- digits[i] = 256;
+ case T_RATIO:
+ return(make_real(sc, cos((s7_double)(fraction(x)))));
- digits[(unsigned char)'0'] = 0; digits[(unsigned char)'1'] = 1; digits[(unsigned char)'2'] = 2; digits[(unsigned char)'3'] = 3; digits[(unsigned char)'4'] = 4;
- digits[(unsigned char)'5'] = 5; digits[(unsigned char)'6'] = 6; digits[(unsigned char)'7'] = 7; digits[(unsigned char)'8'] = 8; digits[(unsigned char)'9'] = 9;
- digits[(unsigned char)'a'] = 10; digits[(unsigned char)'A'] = 10;
- digits[(unsigned char)'b'] = 11; digits[(unsigned char)'B'] = 11;
- digits[(unsigned char)'c'] = 12; digits[(unsigned char)'C'] = 12;
- digits[(unsigned char)'d'] = 13; digits[(unsigned char)'D'] = 13;
- digits[(unsigned char)'e'] = 14; digits[(unsigned char)'E'] = 14;
- digits[(unsigned char)'f'] = 15; digits[(unsigned char)'F'] = 15;
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ return(s7_from_c_complex(sc, ccos(as_c_complex(x))));
+#else
+ return(out_of_range(sc, sc->cos_symbol, small_int(1), x, no_complex_numbers_string));
+#endif
- for (i = 0; i < CTABLE_SIZE; i++)
- number_table[i] = false;
- number_table[(unsigned char)'0'] = true;
- number_table[(unsigned char)'1'] = true;
- number_table[(unsigned char)'2'] = true;
- number_table[(unsigned char)'3'] = true;
- number_table[(unsigned char)'4'] = true;
- number_table[(unsigned char)'5'] = true;
- number_table[(unsigned char)'6'] = true;
- number_table[(unsigned char)'7'] = true;
- number_table[(unsigned char)'8'] = true;
- number_table[(unsigned char)'9'] = true;
- number_table[(unsigned char)'.'] = true;
- number_table[(unsigned char)'+'] = true;
- number_table[(unsigned char)'-'] = true;
- number_table[(unsigned char)'#'] = true;
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->cos_symbol, args, a_number_string);
+ }
}
-
-#define is_white_space(C) white_space[C]
- /* this is much faster than C's isspace, and does not depend on the current locale.
- * if c == EOF (-1), it indexes into the empty (0) slot we preallocated below white_space
- */
+static s7_double cos_d_d(s7_double x) {return(cos(x));}
-static s7_pointer check_sharp_readers(s7_scheme *sc, const char *name)
+/* -------------------------------- tan -------------------------------- */
+static s7_pointer g_tan(s7_scheme *sc, s7_pointer args)
{
- s7_pointer reader, value, args;
- bool need_loader_port;
- value = sc->F;
- args = sc->F;
+ #define H_tan "(tan z) returns tan(z)"
+ #define Q_tan pcl_n
- /* *#reader* is assumed to be an alist of (char . proc)
- * where each proc takes one argument, the string from just beyond the "#" to the next delimiter.
- * The procedure can call read-char to read ahead in the current-input-port.
- * If it returns anything other than #f, that is the value of the sharp expression.
- * Since #f means "nothing found", it is tricky to handle #F:
- * (cons #\F (lambda (str) (and (string=? str "F") (list 'not #t))))
- * This search happens after #|, #t, and #f (and #nD for multivectors?). #! has a fallback.
- */
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_REAL:
+ return(make_real(sc, tan(real(x))));
- need_loader_port = is_loader_port(sc->input_port);
- if (need_loader_port)
- clear_loader_port(sc->input_port);
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(0)); /* (tan 0) -> 0 */
+ return(make_real(sc, tan((s7_double)(integer(x)))));
- /* normally read* can't read from sc->input_port if it is in use by the loader,
- * but here we are deliberately making that possible.
- */
- for (reader = slot_value(sc->sharp_readers); is_not_null(reader); reader = cdr(reader))
- {
- if (name[0] == s7_character(caar(reader)))
- {
- if (args == sc->F)
- args = list_1(sc, s7_make_string(sc, name));
- /* args is GC protected by s7_apply_function?? (placed on the stack) */
- value = s7_apply_function(sc, cdar(reader), args); /* this is much less error-safe than s7_call */
- if (value != sc->F)
- break;
- }
+ case T_RATIO:
+ return(make_real(sc, tan((s7_double)(fraction(x)))));
+
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ if (imag_part(x) > 350.0)
+ return(c_complex(sc, 0.0, 1.0));
+ if (imag_part(x) < -350.0)
+ return(c_complex(sc, 0.0, -1.0));
+ return(s7_from_c_complex(sc, ctan(as_c_complex(x))));
+#else
+ return(out_of_range(sc, sc->tan_symbol, small_int(1), x, no_complex_numbers_string));
+#endif
+
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->tan_symbol, args, a_number_string);
}
- if (need_loader_port)
- set_loader_port(sc->input_port);
- return(value);
}
+static s7_double tan_d_d(s7_double x) {return(tan(x));}
-static s7_pointer g_sharp_readers_set(s7_scheme *sc, s7_pointer args)
+
+/* -------------------------------- asin -------------------------------- */
+static s7_pointer c_asin(s7_scheme *sc, s7_double x)
{
- /* new value must be either () or a proper list of conses (char . func) */
- if (is_null(cadr(args))) return(cadr(args));
- if (is_pair(cadr(args)))
+ s7_double absx, recip;
+ s7_complex result;
+
+ absx = fabs(x);
+ if (absx <= 1.0)
+ return(make_real(sc, asin(x)));
+
+ /* otherwise use maxima code: */
+ recip = 1.0 / absx;
+ result = (M_PI / 2.0) - (_Complex_I * clog(absx * (1.0 + (sqrt(1.0 + recip) * csqrt(1.0 - recip)))));
+ if (x < 0.0)
+ return(s7_from_c_complex(sc, -result));
+ return(s7_from_c_complex(sc, result));
+}
+
+
+static s7_pointer g_asin(s7_scheme *sc, s7_pointer args)
+{
+ #define H_asin "(asin z) returns asin(z); (sin (asin x)) = x"
+ #define Q_asin pcl_n
+ s7_pointer n;
+
+ n = car(args);
+ switch (type(n))
{
- s7_pointer x;
- for (x = cadr(args); is_pair(x); x = cdr(x))
+ case T_INTEGER:
+ if (integer(n) == 0) return(small_int(0)); /* (asin 0) -> 0 */
+ /* in netBSD, (asin 2) returns 0.25383842987008+0.25383842987008i according to Peter Bex */
+ return(c_asin(sc, (s7_double)integer(n)));
+
+ case T_RATIO:
+ return(c_asin(sc, (s7_double)numerator(n) / (s7_double)denominator(n)));
+
+ case T_REAL:
+ return(c_asin(sc, real(n)));
+
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ /* if either real or imag part is very large, use explicit formula, not casin */
+ /* this code taken from sbcl's src/code/irrat.lisp */
+ /* break is around x+70000000i */
+
+ if ((fabs(real_part(n)) > 1.0e7) ||
+ (fabs(imag_part(n)) > 1.0e7))
{
- if ((!is_pair(car(x))) ||
- (!s7_is_character(caar(x))) ||
- (!s7_is_procedure(cdar(x))))
- return(sc->error_symbol);
+ s7_complex sq1mz, sq1pz, z;
+ z = as_c_complex(n);
+ sq1mz = csqrt(1.0 - z);
+ sq1pz = csqrt(1.0 + z);
+ return(s7_make_complex(sc, atan(real_part(n) / creal(sq1mz * sq1pz)), asinh(cimag(sq1pz * conj(sq1mz)))));
}
- if (is_null(x))
- return(cadr(args));
+ return(s7_from_c_complex(sc, casin(as_c_complex(n))));
+#else
+ return(out_of_range(sc, sc->asin_symbol, small_int(1), n, no_complex_numbers_string));
+#endif
+
+ default:
+ method_or_bust_with_type_one_arg(sc, n, sc->asin_symbol, list_1(sc, n), a_number_string);
}
- return(sc->error_symbol);
}
-static bool is_abnormal(s7_pointer x)
+/* -------------------------------- acos -------------------------------- */
+static s7_pointer c_acos(s7_scheme *sc, s7_double x)
{
- switch (type(x))
+ s7_double absx, recip;
+ s7_complex result;
+
+ absx = fabs(x);
+ if (absx <= 1.0)
+ return(make_real(sc, acos(x)));
+
+ /* else follow maxima again: */
+ recip = 1.0 / absx;
+ if (x > 0.0)
+ result = _Complex_I * clog(absx * (1.0 + (sqrt(1.0 + recip) * csqrt(1.0 - recip))));
+ else result = M_PI - _Complex_I * clog(absx * (1.0 + (sqrt(1.0 + recip) * csqrt(1.0 - recip))));
+ return(s7_from_c_complex(sc, result));
+}
+
+static s7_pointer g_acos(s7_scheme *sc, s7_pointer args)
+{
+ #define H_acos "(acos z) returns acos(z); (cos (acos 1)) = 1"
+ #define Q_acos pcl_n
+ s7_pointer n;
+
+ n = car(args);
+ switch (type(n))
{
case T_INTEGER:
+ if (integer(n) == 1) return(small_int(0));
+ return(c_acos(sc, (s7_double)integer(n)));
+
case T_RATIO:
- return(false);
+ return(c_acos(sc, (s7_double)numerator(n) / (s7_double)denominator(n)));
case T_REAL:
- return(is_inf(real(x)) ||
- is_NaN(real(x)));
+ return(c_acos(sc, real(n)));
case T_COMPLEX:
- return(((is_inf(s7_real_part(x))) ||
- (is_inf(s7_imag_part(x))) ||
- (is_NaN(s7_real_part(x))) ||
- (is_NaN(s7_imag_part(x)))));
-
-#if WITH_GMP
- case T_BIG_INTEGER:
- case T_BIG_RATIO:
- return(false);
-
- case T_BIG_REAL:
- return((is_inf(s7_real_part(x))) ||
- (is_NaN(s7_real_part(x))));
+#if HAVE_COMPLEX_NUMBERS
+ /* if either real or imag part is very large, use explicit formula, not cacos */
+ /* this code taken from sbcl's src/code/irrat.lisp */
- case T_BIG_COMPLEX:
- return((is_inf(s7_real_part(x))) ||
- (is_inf(s7_imag_part(x))) ||
- (is_NaN(s7_real_part(x))) ||
- (is_NaN(s7_imag_part(x))));
+ if ((fabs(real_part(n)) > 1.0e7) ||
+ (fabs(imag_part(n)) > 1.0e7))
+ {
+ s7_complex sq1mz, sq1pz, z;
+ z = as_c_complex(n);
+ sq1mz = csqrt(1.0 - z);
+ sq1pz = csqrt(1.0 + z);
+ return(s7_make_complex(sc, 2.0 * atan(creal(sq1mz) / creal(sq1pz)), asinh(cimag(sq1mz * conj(sq1pz)))));
+ }
+ return(s7_from_c_complex(sc, cacos(s7_to_c_complex(n))));
+#else
+ return(out_of_range(sc, sc->acos_symbol, small_int(1), n, no_complex_numbers_string));
#endif
default:
- return(true);
+ method_or_bust_with_type_one_arg(sc, n, sc->acos_symbol, list_1(sc, n), a_number_string);
}
}
-static s7_pointer unknown_sharp_constant(s7_scheme *sc, char *name)
+
+/* -------------------------------- atan -------------------------------- */
+
+static s7_pointer g_atan(s7_scheme *sc, s7_pointer args)
{
- /* check *read-error-hook* */
- if (hook_has_functions(sc->read_error_hook))
+ #define H_atan "(atan z) returns atan(z), (atan y x) returns atan(y/x)"
+ #define Q_atan s7_make_signature(sc, 3, sc->is_number_symbol, sc->is_number_symbol, sc->is_real_symbol)
+ /* actually if there are two args, both should be real, but how to express that in the signature? */
+ s7_pointer x, y;
+ s7_double x1, x2;
+
+ /* currently (atan inf.0 inf.0) -> 0.78539816339745, and (atan inf.0 -inf.0) -> 2.3561944901923 (etc) */
+
+ x = car(args);
+ if (!is_pair(cdr(args)))
{
- s7_pointer result;
- result = s7_call(sc, sc->read_error_hook, list_2(sc, sc->T, make_string_wrapper(sc, name)));
- if (result != sc->unspecified)
- return(result);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(0)); /* (atan 0) -> 0 */
+
+ case T_RATIO:
+ case T_REAL:
+ return(make_real(sc, atan(real_to_double(sc, x, "atan"))));
+
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ return(s7_from_c_complex(sc, catan(as_c_complex(x))));
+#else
+ return(out_of_range(sc, sc->atan_symbol, small_int(1), x, no_complex_numbers_string));
+#endif
+
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->atan_symbol, args, a_number_string);
+ }
}
- return(sc->nil);
+
+ if (!s7_is_real(x))
+ method_or_bust(sc, x, sc->atan_symbol, args, T_REAL, 1);
+
+ y = cadr(args);
+ if (!s7_is_real(y))
+ method_or_bust(sc, y, sc->atan_symbol, args, T_REAL, 2);
+
+ x1 = real_to_double(sc, x, "atan");
+ x2 = real_to_double(sc, y, "atan");
+ return(make_real(sc, atan2(x1, x2)));
}
-#define NESTED_SHARP false
-#define UNNESTED_SHARP true
+static s7_double atan_d_dd(s7_double x, s7_double y) {return(atan2(x, y));}
-#define SYMBOL_OK true
-#define NO_SYMBOLS false
-static s7_pointer make_sharp_constant(s7_scheme *sc, char *name, bool at_top, int radix, bool with_error)
+/* -------------------------------- sinh -------------------------------- */
+static s7_pointer g_sinh(s7_scheme *sc, s7_pointer args)
{
- /* name is the stuff after the '#', return sc->nil if not a recognized #... entity */
- int len;
+ #define H_sinh "(sinh z) returns sinh(z)"
+ #define Q_sinh pcl_n
+
s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(0)); /* (sinh 0) -> 0 */
- if ((name[0] == 't') &&
- ((name[1] == '\0') || (strings_are_equal(name, "true"))))
- return(sc->T);
+ case T_REAL:
+ case T_RATIO:
+ return(make_real(sc, sinh(real_to_double(sc, x, "sinh"))));
- if ((name[0] == 'f') &&
- ((name[1] == '\0') || (strings_are_equal(name, "false"))))
- return(sc->F);
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ return(s7_from_c_complex(sc, csinh(as_c_complex(x))));
+#else
+ return(out_of_range(sc, sc->sinh_symbol, small_int(1), x, no_complex_numbers_string));
+#endif
- if (is_not_null(slot_value(sc->sharp_readers)))
- {
- x = check_sharp_readers(sc, name);
- if (x != sc->F)
- return(x);
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->sinh_symbol, args, a_number_string);
}
+}
- len = safe_strlen5(name); /* just count up to 5 */
- if (len < 2)
- return(unknown_sharp_constant(sc, name));
+static s7_double sinh_d_d(s7_double x) {return(sinh(x));}
- switch (name[0])
- {
- /* -------- #< ... > -------- */
- case '<':
- if (strings_are_equal(name, "<unspecified>"))
- return(sc->unspecified);
- if (strings_are_equal(name, "<undefined>"))
- return(sc->undefined);
+/* -------------------------------- cosh -------------------------------- */
+static s7_pointer g_cosh(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cosh "(cosh z) returns cosh(z)"
+ #define Q_cosh pcl_n
- if (strings_are_equal(name, "<eof>"))
- return(sc->eof_object);
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(1)); /* (cosh 0) -> 1 */
- return(unknown_sharp_constant(sc, name));
+ case T_REAL:
+ case T_RATIO:
+ /* this is not completely correct when optimization kicks in.
+ * :(define (hi) (do ((i 0 (+ i 1))) ((= i 1)) (display (cosh i))))
+ * hi
+ * :(hi)
+ * 1.0()
+ * :(cosh 0)
+ * 1
+ */
+ return(make_real(sc, cosh(real_to_double(sc, x, "cosh"))));
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ return(s7_from_c_complex(sc, ccosh(as_c_complex(x))));
+#else
+ return(out_of_range(sc, sc->cosh_symbol, small_int(1), x, no_complex_numbers_string));
+#endif
- /* -------- #o #d #x #b -------- */
- case 'o': /* #o (octal) */
- case 'd': /* #d (decimal) */
- case 'x': /* #x (hex) */
- case 'b': /* #b (binary) */
- {
- int num_at = 1;
-#if (!WITH_PURE_S7)
- bool to_inexact = false, to_exact = false;
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->cosh_symbol, args, a_number_string);
+ }
+}
- if (name[1] == '#')
- {
- if (!at_top)
- return(unknown_sharp_constant(sc, name));
- if ((len > 2) && ((name[2] == 'e') || (name[2] == 'i'))) /* r6rs includes caps here */
- {
- if ((len > 3) && (name[3] == '#'))
- return(unknown_sharp_constant(sc, name));
- to_inexact = (name[2] == 'i');
- to_exact = (name[2] == 'e');
- num_at = 3;
- }
- else return(unknown_sharp_constant(sc, name));
- }
-#endif
- /* the #b or whatever overrides any radix passed in earlier */
- x = make_atom(sc, (char *)(name + num_at), (name[0] == 'o') ? 8 : ((name[0] == 'x') ? 16 : ((name[0] == 'b') ? 2 : 10)), NO_SYMBOLS, with_error);
+static s7_double cosh_d_d(s7_double x) {return(cosh(x));}
- /* #x#i1 apparently makes sense, so #x1.0 should also be accepted.
- * here we can get #b#e0/0 or #b#e+1/0 etc.
- * surely if #e1+i is an error (or #f), and #e#x1+i is an error,
- * #x#e1+i should also be an error, but #e1+0i is not an error I guess since there actually isn't any imaginary part
- */
- if (is_abnormal(x))
- return(unknown_sharp_constant(sc, name));
-#if (!WITH_PURE_S7)
- if ((!to_exact) && (!to_inexact))
- return(x);
+/* -------------------------------- tanh -------------------------------- */
+static s7_pointer g_tanh(s7_scheme *sc, s7_pointer args)
+{
+ #define H_tanh "(tanh z) returns tanh(z)"
+ #define Q_tanh pcl_n
- if ((s7_imag_part(x) != 0.0) && (to_exact)) /* #x#e1+i */
- return(unknown_sharp_constant(sc, name));
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(0)); /* (tanh 0) -> 0 */
-#if WITH_GMP
- if (s7_is_bignum(x))
- {
- if (to_exact)
- return(big_inexact_to_exact(sc, set_plist_1(sc, x)));
- return(big_exact_to_inexact(sc, set_plist_1(sc, x)));
- }
-#endif
- if (to_exact)
- return(inexact_to_exact(sc, x, with_error));
- return(exact_to_inexact(sc, x));
+ case T_REAL:
+ case T_RATIO:
+ return(make_real(sc, tanh(real_to_double(sc, x, "tanh"))));
+
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ if (real_part(x) > 350.0)
+ return(real_one); /* closer than 0.0 which is what ctanh is about to return! */
+ if (real_part(x) < -350.0)
+ return(make_real(sc, -1.0)); /* closer than ctanh's -0.0 */
+ return(s7_from_c_complex(sc, ctanh(as_c_complex(x))));
#else
- return(x);
+ return(out_of_range(sc, sc->tanh_symbol, small_int(1), x, no_complex_numbers_string));
#endif
- }
- break;
-#if (!WITH_PURE_S7)
- /* -------- #i -------- */
- case 'i': /* #i<num> = ->inexact (see token for table of choices here) */
- if (name[1] == '#')
- {
- /* there are special cases here: "#e0/0" or "#e#b0/0" -- all infs are complex:
- * #i1/0=nan.0 but #i1/0+i=inf+1i so e->i is a no-op but i->e is not
- *
- * even trickier: a *#reader* like #t<num> could be used as #e#t13.25 so make_sharp_constant
- * needs to be willing to call the readers even when not at_top (i.e. when NESTED_SHARP).
- */
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->tanh_symbol, args, a_number_string);
+ }
+}
- if ((name[2] == 'e') || /* #i#e1 -- assume these aren't redefinable? */
- (name[2] == 'i'))
- return(unknown_sharp_constant(sc, name));
+static s7_double tanh_d_d(s7_double x) {return(tanh(x));}
- x = make_sharp_constant(sc, (char *)(name + 2), NESTED_SHARP, radix, with_error);
- if (s7_is_number(x))
- {
- if (is_abnormal(x))
- return(unknown_sharp_constant(sc, name));
-#if WITH_GMP
- if (s7_is_bignum(x)) /* (string->number "#b#e-11e+111") */
- return(big_exact_to_inexact(sc, set_plist_1(sc, x)));
-#endif
- return(exact_to_inexact(sc, x));
- }
- return(unknown_sharp_constant(sc, name));
- }
- x = make_atom(sc, (char *)(name + 1), radix, NO_SYMBOLS, with_error);
- if (!s7_is_number(x)) /* not is_abnormal(x) -- #i0/0 -> nan etc */
- return(unknown_sharp_constant(sc, name));
-#if WITH_GMP
- if (s7_is_bignum(x))
- return(big_exact_to_inexact(sc, set_plist_1(sc, x)));
-#endif
- return(exact_to_inexact(sc, x));
+/* -------------------------------- asinh -------------------------------- */
- /* -------- #e -------- */
- case 'e': /* #e<num> = ->exact */
- if (name[1] == '#')
- {
- if ((name[2] == 'e') || /* #e#e1 */
- (name[2] == 'i'))
- return(unknown_sharp_constant(sc, name));
+static s7_pointer g_asinh(s7_scheme *sc, s7_pointer args)
+{
+ #define H_asinh "(asinh z) returns asinh(z)"
+ #define Q_asinh pcl_n
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(0));
+ return(make_real(sc, asinh((s7_double)integer(x))));
- x = make_sharp_constant(sc, (char *)(name + 2), NESTED_SHARP, radix, with_error);
- if (s7_is_number(x))
- {
- if (is_abnormal(x)) /* (string->number "#e#b0/0") */
- return(unknown_sharp_constant(sc, name));
- if (!s7_is_real(x)) /* (string->number "#e#b1+i") */
- return(unknown_sharp_constant(sc, name));
-#if WITH_GMP
- return(big_inexact_to_exact(sc, set_plist_1(sc, x)));
-#endif
- return(inexact_to_exact(sc, x, with_error));
- }
- return(unknown_sharp_constant(sc, name));
- }
+ case T_RATIO:
+ return(make_real(sc, asinh((s7_double)numerator(x) / (s7_double)denominator(x))));
- x = make_atom(sc, (char *)(name + 1), radix, NO_SYMBOLS, with_error);
-#if WITH_GMP
- /* #e1e310 is a simple case */
- if (s7_is_bignum(x))
- return(big_inexact_to_exact(sc, set_plist_1(sc, x)));
-#endif
- if (is_abnormal(x)) /* (string->number "#e0/0") */
- return(unknown_sharp_constant(sc, name));
- if (!s7_is_real(x)) /* (string->number "#e1+i") */
- return(unknown_sharp_constant(sc, name));
+ case T_REAL:
+ return(make_real(sc, asinh(real(x))));
-#if WITH_GMP
- /* there are non-big floats that are greater than most-positive-fixnum:
- * :(> .1e20 most-positive-fixnum) -> #t
- * :(bignum? .1e20) -> #f
- * so we have to check that, not just is it a bignum.
- */
- return(big_inexact_to_exact(sc, set_plist_1(sc, x)));
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ #if (defined(__OpenBSD__)) || (defined(__NetBSD__))
+ return(s7_from_c_complex(sc, casinh_1(as_c_complex(x))));
+ #else
+ return(s7_from_c_complex(sc, casinh(as_c_complex(x))));
+ #endif
+#else
+ return(out_of_range(sc, sc->asinh_symbol, small_int(1), x, no_complex_numbers_string));
#endif
- return(inexact_to_exact(sc, x, with_error));
-#endif /* !WITH_PURE_S7 */
+
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->asinh_symbol, list_1(sc, x), a_number_string);
+ }
+}
- /* -------- #_... -------- */
- case '_':
+/* -------------------------------- acosh -------------------------------- */
+
+static s7_pointer g_acosh(s7_scheme *sc, s7_pointer args)
+{
+ #define H_acosh "(acosh z) returns acosh(z)"
+ #define Q_acosh pcl_n
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(x) == 1) return(small_int(0));
+
+ case T_REAL:
+ case T_RATIO:
{
- s7_pointer sym;
- sym = make_symbol(sc, (char *)(name + 1));
- if (is_slot(initial_slot(sym)))
- return(slot_value(initial_slot(sym)));
- return(s7_error(sc, sc->syntax_error_symbol, set_elist_2(sc, make_string_wrapper(sc, "#~A is undefined"), make_string_wrapper(sc, name))));
- /* return(sc->undefined); */
+ double x1;
+ x1 = real_to_double(sc, x, "acosh");
+ if (x1 >= 1.0)
+ return(make_real(sc, acosh(x1)));
}
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ #ifdef __OpenBSD__
+ return(s7_from_c_complex(sc, cacosh_1(s7_to_c_complex(x))));
+ #else
+ return(s7_from_c_complex(sc, cacosh(s7_to_c_complex(x)))); /* not as_c_complex because x might not be complex */
+ #endif
+#else
+ /* since we can fall through to this branch, we need a better error message than "must be a number, not 0.0" */
+ return(out_of_range(sc, sc->acosh_symbol, small_int(1), x, no_complex_numbers_string));
+#endif
- /* -------- #\... -------- */
- case '\\':
- if (name[2] == 0) /* the most common case: #\a */
- return(chars[(unsigned char)(name[1])]);
- /* not unsigned int here! (unsigned int)255 (as a char) returns -1!! */
- switch (name[1])
- {
- case 'n':
- if ((strings_are_equal(name + 1, "null")) ||
- (strings_are_equal(name + 1, "nul")))
- return(chars[0]);
-
- if (strings_are_equal(name + 1, "newline"))
- return(chars[(unsigned char)'\n']);
- break;
-
- case 's':
- if (strings_are_equal(name + 1, "space"))
- return(chars[(unsigned char)' ']);
- break;
-
- case 'r':
- if (strings_are_equal(name + 1, "return"))
- return(chars[(unsigned char)'\r']);
- break;
-
- case 'l':
- if (strings_are_equal(name + 1, "linefeed"))
- return(chars[(unsigned char)'\n']);
- break;
-
- case 't':
- if (strings_are_equal(name + 1, "tab"))
- return(chars[(unsigned char)'\t']);
- break;
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->acosh_symbol, list_1(sc, x), a_number_string);
+ }
+}
- case 'a':
- /* the next 4 are for r7rs */
- if (strings_are_equal(name + 1, "alarm"))
- return(chars[7]);
- break;
- case 'b':
- if (strings_are_equal(name + 1, "backspace"))
- return(chars[8]);
- break;
+/* -------------------------------- atanh -------------------------------- */
- case 'e':
- if (strings_are_equal(name + 1, "escape"))
- return(chars[0x1b]);
- break;
+static s7_pointer g_atanh(s7_scheme *sc, s7_pointer args)
+{
+ #define H_atanh "(atanh z) returns atanh(z)"
+ #define Q_atanh pcl_n
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(0)); /* (atanh 0) -> 0 */
- case 'd':
- if (strings_are_equal(name + 1, "delete"))
- return(chars[0x7f]);
- break;
+ case T_REAL:
+ case T_RATIO:
+ {
+ double x1;
+ x1 = real_to_double(sc, x, "atanh");
+ if (fabs(x1) < 1.0)
+ return(make_real(sc, atanh(x1)));
+ }
- 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.
- */
- {
- /* 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.
- * another problem: #\xbdca2cbec overflows so lval is -593310740 -> segfault unless caught
- */
- bool happy = true;
- char *tmp;
- int lval = 0;
+ /* if we can't distinguish x from 1.0 even with long doubles, we'll get inf.0:
+ * (atanh 9223372036854775/9223372036854776) -> 18.714973875119
+ * (atanh 92233720368547758/92233720368547757) -> inf.0
+ */
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ #if (defined(__OpenBSD__)) || (defined(__NetBSD__))
+ return(s7_from_c_complex(sc, catanh_1(s7_to_c_complex(x))));
+ #else
+ return(s7_from_c_complex(sc, catanh(s7_to_c_complex(x))));
+ #endif
+#else
+ return(out_of_range(sc, sc->atanh_symbol, small_int(1), x, no_complex_numbers_string));
+#endif
- tmp = (char *)(name + 2);
- while ((*tmp) && (happy) && (lval >= 0))
- {
- int dig;
- dig = digits[(int)(*tmp++)];
- if (dig < 16)
- lval = dig + (lval * 16);
- else happy = false;
- }
- if ((happy) &&
- (lval < 256) &&
- (lval >= 0))
- return(chars[lval]);
- }
- break;
- }
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->atanh_symbol, list_1(sc, x), a_number_string);
}
- return(unknown_sharp_constant(sc, name));
}
-static s7_int string_to_integer(const char *str, int radix, bool *overflow)
+/* -------------------------------- sqrt -------------------------------- */
+static s7_pointer g_sqrt(s7_scheme *sc, s7_pointer args)
{
- bool negative = false;
- s7_int lval = 0;
- int dig;
- char *tmp = (char *)str;
- char *tmp1;
+ #define H_sqrt "(sqrt z) returns the square root of z"
+ #define Q_sqrt pcl_n
- if (str[0] == '+')
- tmp++;
- else
+ s7_pointer n;
+ s7_double sqx;
+
+ n = car(args);
+ switch (type(n))
{
- if (str[0] == '-')
+ case T_INTEGER:
+ if (integer(n) >= 0)
{
- negative = true;
- tmp++;
+ s7_int ix;
+ sqx = sqrt((s7_double)integer(n));
+ ix = (s7_int)sqx;
+ if ((ix * ix) == integer(n))
+ return(make_integer(sc, ix));
+ return(make_real(sc, sqx));
+ /* Mark Weaver notes that
+ * (zero? (- (sqrt 9007199136250226) 94906265.0)) -> #t
+ * but (* 94906265 94906265) -> 9007199136250225 -- oops
+ * at least we return a real here, not an incorrect integer and
+ * (sqrt 9007199136250225) -> 94906265
+ */
}
- }
- while (*tmp == '0') {tmp++;};
- tmp1 = tmp;
+ sqx = (s7_double)integer(n); /* we're trying to protect against (sqrt -9223372036854775808) where we can't negate the integer argument */
+ return(s7_make_complex(sc, 0.0, sqrt((s7_double)(-sqx))));
- if (radix == 10)
- {
- while (true)
+ case T_RATIO:
+ sqx = (s7_double)fraction(n);
+ if (sqx > 0.0) /* else it's complex, so it can't be a ratio */
{
- dig = digits[(unsigned char)(*tmp++)];
- if (dig > 9) break;
+ s7_int nm = 0, dn = 1;
+ if (c_rationalize(sqx, 1.0e-16, &nm, &dn)) /* 1e-16 so that (sqrt 1/1099511627776) returns 1/1048576 */
+ {
#if HAVE_OVERFLOW_CHECKS
- if (multiply_overflow(lval, (s7_int)10, &lval)) break;
- if (add_overflow(lval, (s7_int)dig, &lval)) break;
+ s7_int nm2, dn2;
+ if ((multiply_overflow(nm, nm, &nm2)) ||
+ (multiply_overflow(dn, dn, &dn2)))
+ return(make_real(sc, sqrt(sqx)));
+ if ((nm2 == numerator(n)) &&
+ (dn2 == denominator(n)))
+ return(s7_make_ratio(sc, nm, dn));
#else
- lval = dig + (lval * 10);
- dig = digits[(unsigned char)(*tmp++)];
- if (dig > 9) break;
- lval = dig + (lval * 10);
+ if ((nm * nm == numerator(n)) &&
+ (dn * dn == denominator(n)))
+ return(s7_make_ratio(sc, nm, dn));
#endif
+ }
+ return(make_real(sc, sqrt(sqx)));
}
- }
- else
- {
- while (true)
- {
- dig = digits[(unsigned char)(*tmp++)];
- if (dig >= radix) break;
-#if HAVE_OVERFLOW_CHECKS
- if (multiply_overflow(lval, (s7_int)radix, &lval)) break;
- if (add_overflow(lval, (s7_int)dig, &lval)) break;
+ return(s7_make_complex(sc, 0.0, sqrt(-sqx)));
+
+ case T_REAL:
+ if (is_NaN(real(n)))
+ return(real_NaN);
+ if (real(n) >= 0.0)
+ return(make_real(sc, sqrt(real(n))));
+ return(s7_make_complex(sc, 0.0, sqrt(-real(n))));
+
+ case T_COMPLEX:
+ /* (* inf.0 (sqrt -1)) -> -nan+infi, but (sqrt -inf.0) -> 0+infi */
+#if HAVE_COMPLEX_NUMBERS
+ return(s7_from_c_complex(sc, csqrt(as_c_complex(n))));
#else
- lval = dig + (lval * radix);
- dig = digits[(unsigned char)(*tmp++)];
- if (dig >= radix) break;
- lval = dig + (lval * radix);
+ return(out_of_range(sc, sc->sqrt_symbol, small_int(1), n, no_complex_numbers_string));
#endif
- }
+
+ default:
+ method_or_bust_with_type_one_arg(sc, n, sc->sqrt_symbol, args, a_number_string);
}
+}
-#if WITH_GMP
- (*overflow) = ((lval > s7_int32_max) ||
- ((tmp - tmp1) > s7_int_digits_by_radix[radix]));
- /* this tells the string->number readers to create a bignum. We need to be very
- * conservative here to catch contexts such as (/ 1/524288 19073486328125)
- */
+
+/* -------------------------------- expt -------------------------------- */
+
+static s7_int int_to_int(s7_int x, s7_int n)
+{
+ /* from GSL */
+ s7_int value = 1;
+ do {
+ if (n & 1) value *= x;
+ n >>= 1;
+#if HAVE_OVERFLOW_CHECKS
+ if (multiply_overflow(x, x, &x))
+ break;
#else
- if ((tmp - tmp1 - 2) > s7_int_digits_by_radix[radix])
- {
- /* I can't decide what to do with these non-gmp overflows. Perhaps NAN in all cases?
- * overflow: 9223372036854775810 -> -9223372036854775806 -- this is not caught currently
- */
- (*overflow) = true;
- if (negative)
- return(s7_int_min); /* or INFINITY? */
- return(s7_int_max); /* 0/100000000000000000000000000000000000000000000000000000000000000000000 */
- }
+ x *= x;
#endif
-
- if (negative)
- return(-lval);
- return(lval);
+ } while (n);
+ return(value);
}
-/* 9223372036854775807 9223372036854775807
- * -9223372036854775808 -9223372036854775808
- * 0000000000000000000000000001.0 1.0
- * 1.0000000000000000000000000000 1.0
- * 1000000000000000000000000000.0e-40 1.0e-12
- * 0.0000000000000000000000000001e40 1.0e12
- * 1.0e00000000000000000001 10.0
- */
+static const long long int nth_roots[63] = {
+ S7_LLONG_MAX, S7_LLONG_MAX, 3037000499LL, 2097151, 55108, 6208, 1448, 511, 234, 127, 78, 52, 38, 28, 22,
+ 18, 15, 13, 11, 9, 8, 7, 7, 6, 6, 5, 5, 5, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2};
-static s7_double string_to_double_with_radix(const char *ur_str, int radix, bool *overflow)
+static const long int_nth_roots[31] = {
+ S7_LONG_MAX, S7_LONG_MAX, 46340, 1290, 215, 73, 35, 21, 14, 10, 8, 7, 5, 5, 4, 4, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2};
+
+static bool int_pow_ok(s7_int x, s7_int y)
{
- /* strtod follows LANG which is not what we want (only "." is decimal point in Scheme).
- * To overcome LANG in strtod would require screwing around with setlocale which never works.
- * So we use our own code -- according to valgrind, this function is much faster than strtod.
- *
- * comma as decimal point causes ambiguities: `(+ ,1 2) etc
- */
+ if (s7_int_bits > 31)
+ return((y < 63) &&
+ (nth_roots[y] >= s7_int_abs(x)));
+ return((y < 31) &&
+ (int_nth_roots[y] >= s7_int_abs(x)));
+}
- int i, sign = 1, frac_len, int_len, dig, max_len, exponent = 0;
- long long int int_part = 0, frac_part = 0;
- char *str;
- char *ipart, *fpart;
- s7_double dval = 0.0;
- /* there's an ambiguity in number notation here if we allow "1e1" or "1.e1" in base 16 (or 15) -- is e a digit or an exponent marker?
- * but 1e+1, for example disambiguates it -- kind of messy! -- the scheme spec says "e" can only occur in base 10.
- * mpfr says "e" as exponent only in bases <= 10 -- else use '@' which works in any base. This can only cause confusion
- * in scheme, unfortunately, due to the idiotic scheme polar notation. But we accept "s" and "l" as exponent markers
- * so, perhaps for radix > 10, the exponent, if any, has to use one of S s L l? Not "l"! And "s" originally meant "short".
+static s7_pointer g_expt(s7_scheme *sc, s7_pointer args)
+{
+ #define H_expt "(expt z1 z2) returns z1^z2"
+ #define Q_expt pcl_n
+ s7_pointer n, pw;
+
+ n = car(args);
+ if (!s7_is_number(n))
+ method_or_bust_with_type(sc, n, sc->expt_symbol, args, a_number_string, 1);
+
+ pw = cadr(args);
+ if (!s7_is_number(pw))
+ method_or_bust_with_type(sc, pw, sc->expt_symbol, args, a_number_string, 2);
+
+ /* this provides more than 2 args to expt:
+ * if (is_not_null(cddr(args)))
+ * return(g_expt(sc, list_2(sc, car(args), g_expt(sc, cdr(args)))));
*
- * '@' can now be used as the exponent marker (26-Mar-12).
- * Another slight ambiguity: 1+1/2i is parsed as 1 + 0.5i, not 1+1/(2i), or (1+1)/(2i) or (1+1/2)i etc
+ * but it's unusual in scheme to process args in reverse order, and the
+ * syntax by itself is ambiguous (does (expt 2 2 3) = 256 or 64?)
*/
- max_len = s7_int_digits_by_radix[radix];
- str = (char *)ur_str;
-
- if (*str == '+')
- str++;
- else
+ if (s7_is_zero(n))
{
- if (*str == '-')
+ if (s7_is_zero(pw))
{
- str++;
- sign = -1;
+ if ((s7_is_integer(n)) && (s7_is_integer(pw))) /* (expt 0 0) -> 1 */
+ return(small_int(1));
+ return(real_zero); /* (expt 0.0 0) -> 0.0 */
}
- }
- while (*str == '0') {str++;};
-
- ipart = str;
- while (digits[(int)(*str)] < radix) str++;
- int_len = str - ipart;
-
- if (*str == '.') str++;
- fpart = str;
- while (digits[(int)(*str)] < radix) str++;
- frac_len = str - fpart;
- if ((*str) && (exponent_table[(unsigned char)(*str)]))
- {
- int exp_negative = false;
- str++;
- if (*str == '+')
- str++;
- else
+ if (s7_is_real(pw))
{
- if (*str == '-')
- {
- str++;
- exp_negative = true;
- }
+ if (s7_is_negative(pw)) /* (expt 0 -1) */
+ return(division_by_zero_error(sc, sc->expt_symbol, args));
+ /* (Clisp gives divide-by-zero error here, Guile returns inf.0) */
+
+ if ((!s7_is_rational(pw)) && /* (expt 0 most-positive-fixnum) */
+ (is_NaN(s7_real(pw)))) /* (expt 0 +nan.0) */
+ return(pw);
}
- while ((dig = digits[(int)(*str++)]) < 10) /* exponent itself is always base 10 */
- {
-#if HAVE_OVERFLOW_CHECKS
- if ((int_multiply_overflow(exponent, 10, &exponent)) ||
- (int_add_overflow(exponent, dig, &exponent)))
- {
- exponent = 1000000; /* see below */
- break;
- }
-#else
- exponent = dig + (exponent * 10);
-#endif
+ else
+ { /* (expt 0 a+bi) */
+ if (real_part(pw) < 0.0) /* (expt 0 -1+i) */
+ return(division_by_zero_error(sc, sc->expt_symbol, args));
+ if ((is_NaN(real_part(pw))) || /* (expt 0 0+1/0i) */
+ (is_NaN(imag_part(pw))))
+ return(real_NaN);
}
-#if (!defined(__GNUC__)) || (__GNUC__ < 5)
- if (exponent < 0) /* we overflowed, so make sure we notice it below (need to check for 0.0e... first) (Brian Damgaard) */
- exponent = 1000000; /* see below for examples -- this number needs to be very big but not too big for add */
-#endif
- if (exp_negative)
- exponent = -exponent;
- /* 2e12341234123123123123213123123123 -> 0.0
- * but exp len is not the decider: 2e00000000000000000000000000000000000000001 -> 20.0
- * first zero: 2e123412341231231231231
- * then: 2e12341234123123123123123123 -> inf
- * then: 2e123412341231231231231231231231231231 -> 0.0
- * 2e-123412341231231231231 -> inf
- * but: 0e123412341231231231231231231231231231
- */
+ if ((s7_is_integer(n)) && (s7_is_integer(pw))) /* pw != 0, (expt 0 2312) */
+ return(small_int(0));
+ return(real_zero); /* (expt 0.0 123123) */
}
-#if WITH_GMP
- /* 9007199254740995.0 */
- if (int_len + frac_len >= max_len)
+ if (s7_is_one(pw))
{
- (*overflow) = true;
- return(0.0);
+ if (s7_is_integer(pw))
+ return(n);
+ if (is_rational(n))
+ return(make_real(sc, rational_to_double(sc, n)));
+ return(n);
}
-#endif
- str = ipart;
- if ((int_len + exponent) > max_len)
+ if (is_t_integer(pw))
{
- /* 12341234.56789e12 12341234567889999872.0 1.234123456789e+19
- * -1234567890123456789.0 -1234567890123456768.0 -1.2345678901235e+18
- * 12345678901234567890.0 12345678901234567168.0 1.2345678901235e+19
- * 123.456e30 123456000000000012741097792995328.0 1.23456e+32
- * 12345678901234567890.0e12 12345678901234569054409354903552.0 1.2345678901235e+31
- * 1.234567890123456789012e30 1234567890123456849145940148224.0 1.2345678901235e+30
- * 1e20 100000000000000000000.0 1e+20
- * 1234567890123456789.0 1234567890123456768.0 1.2345678901235e+18
- * 123.456e16 1234560000000000000.0 1.23456e+18
- * 98765432101234567890987654321.0e-5 987654321012345728401408.0 9.8765432101235e+23
- * 98765432101234567890987654321.0e-10 9876543210123456512.0 9.8765432101235e+18
- * 0.00000000000000001234e20 1234.0
- * 0.000000000000000000000000001234e30 1234.0
- * 0.0000000000000000000000000000000000001234e40 1234.0
- * 0.000000000012345678909876543210e15 12345.678909877
- * 0e1000 0.0
- */
-
- for (i = 0; i < max_len; i++)
+ s7_int y;
+ y = integer(pw);
+ if (y == 0)
{
- dig = digits[(int)(*str++)];
- if (dig < radix)
- int_part = dig + (int_part * radix);
- else break;
+ if (is_rational(n)) /* (expt 3 0) */
+ return(small_int(1));
+ if ((is_NaN(s7_real_part(n))) || /* (expt 1/0 0) -> NaN */
+ (is_NaN(s7_imag_part(n)))) /* (expt (complex 0 1/0) 0) -> NaN */
+ return(n);
+ return(real_one); /* (expt 3.0 0) */
}
- /* if the exponent is huge, check for 0 int_part and frac_part before complaining (0e1000 or 0.0e1000)
- */
- if ((int_part == 0) &&
- (exponent > max_len))
+ switch (type(n))
{
- /* if frac_part is also 0, return 0.0 */
- if (frac_len == 0)
- return(0.0);
-
- str = fpart;
- while ((dig = digits[(int)(*str++)]) < radix)
- frac_part = dig + (frac_part * radix);
- if (frac_part == 0)
- return(0.0);
-
-#if WITH_GMP
- (*overflow) = true;
-#endif
- }
+ case T_INTEGER:
+ {
+ s7_int x;
+ x = s7_integer(n);
+ if (x == 1) /* (expt 1 y) */
+ return(n);
-#if WITH_GMP
- (*overflow) = ((int_part > 0) || (exponent > 20)); /* .1e310 is a tricky case */
-#endif
+ if (x == -1)
+ {
+ if (y == s7_int_min) /* (expt -1 most-negative-fixnum) */
+ return(small_int(1));
- if (int_part != 0) /* 0.<310 zeros here>1e310 for example --
- * pow (via ipow) thinks it has to be too big, returns Nan,
- * then Nan * 0 -> Nan and the NaN propagates
- */
- {
- if (int_len <= max_len)
- dval = int_part * ipow(radix, exponent);
- else dval = int_part * ipow(radix, exponent + int_len - max_len);
- }
- else dval = 0.0;
+ if (s7_int_abs(y) & 1) /* (expt -1 odd-int) */
+ return(n);
+ return(small_int(1)); /* (expt -1 even-int) */
+ }
- /* shift by exponent, but if int_len > max_len then we assumed (see below) int_len - max_len 0's on the left */
- /* using int_to_int or table lookups here instead of pow did not make any difference in speed */
+ if (y == s7_int_min) /* (expt x most-negative-fixnum) */
+ return(small_int(0));
+ if (x == s7_int_min) /* (expt most-negative-fixnum y) */
+ return(make_real(sc, pow((double)x, (double)y)));
- if (int_len < max_len)
- {
- int k, flen;
- str = fpart;
+ if (int_pow_ok(x, s7_int_abs(y)))
+ {
+ if (y > 0)
+ return(make_integer(sc, int_to_int(x, y)));
+ return(s7_make_ratio(sc, 1, int_to_int(x, -y)));
+ }
+ }
+ break;
- for (k = 0; (frac_len > 0) && (k < exponent); k += max_len)
- {
- if (frac_len > max_len) flen = max_len; else flen = frac_len;
- frac_len -= max_len;
+ case T_RATIO:
+ {
+ s7_int nm, dn;
- frac_part = 0;
- for (i = 0; i < flen; i++)
- frac_part = digits[(int)(*str++)] + (frac_part * radix);
+ nm = numerator(n);
+ dn = denominator(n);
- if (frac_part != 0) /* same pow->NaN problem as above can occur here */
- dval += frac_part * ipow(radix, exponent - flen - k);
- }
- }
- else
- {
- /* some of the fraction is in the integer part before the negative exponent shifts it over */
- if (int_len > max_len)
+ if (y == s7_int_min)
+ {
+ if (s7_int_abs(nm) > dn)
+ return(small_int(0)); /* (expt 4/3 most-negative-fixnum) -> 0? */
+ return(real_infinity); /* (expt 3/4 most-negative-fixnum) -> inf? */
+ }
+
+ if ((int_pow_ok(nm, s7_int_abs(y))) &&
+ (int_pow_ok(dn, s7_int_abs(y))))
+ {
+ if (y > 0)
+ return(s7_make_ratio(sc, int_to_int(nm, y), int_to_int(dn, y)));
+ return(s7_make_ratio(sc, int_to_int(dn, -y), int_to_int(nm, -y)));
+ }
+ }
+ break;
+ /* occasionally int^rat can be int but it happens so infrequently it's probably not worth checking
+ * one possibly easy case: (expt 1 1/2) -> 1 (-1?) etc
+ */
+
+ case T_REAL:
+ /* (expt -1.0 most-positive-fixnum) should be -1.0
+ * (expt -1.0 (+ (expt 2 53) 1)) -> -1.0
+ * (expt -1.0 (- 1 (expt 2 54))) -> -1.0
+ */
+ if (real(n) == -1.0)
{
- int ilen;
- /* str should be at the last digit we read */
- ilen = int_len - max_len; /* we read these above */
- if (ilen > max_len)
- ilen = max_len;
+ if (y == s7_int_min)
+ return(real_one);
- for (i = 0; i < ilen; i++)
- frac_part = digits[(int)(*str++)] + (frac_part * radix);
+ if (s7_int_abs(y) & 1)
+ return(n);
+ return(real_one);
+ }
+ break;
- dval += frac_part * ipow(radix, exponent - ilen);
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ if ((s7_real_part(n) == 0.0) &&
+ ((s7_imag_part(n) == 1.0) ||
+ (s7_imag_part(n) == -1.0)))
+ {
+ bool yp, np;
+ yp = (y > 0);
+ np = (s7_imag_part(n) > 0.0);
+ switch (s7_int_abs(y) % 4)
+ {
+ case 0: return(real_one);
+ case 1: return(s7_make_complex(sc, 0.0, (yp == np) ? 1.0 : -1.0));
+ case 2: return(make_real(sc, -1.0));
+ case 3: return(s7_make_complex(sc, 0.0, (yp == np) ? -1.0 : 1.0));
+ }
}
+#else
+ return(out_of_range(sc, sc->expt_symbol, small_int(2), n, no_complex_numbers_string));
+#endif
+ break;
}
-
- return(sign * dval);
}
- /* int_len + exponent <= max_len */
-
- if (int_len <= max_len)
+ if ((s7_is_real(n)) &&
+ (s7_is_real(pw)))
{
- int int_exponent;
-
- /* a better algorithm (since the inaccuracies are in the radix^exponent portion):
- * strip off leading zeros and possible sign,
- * strip off digits beyond max_len, then remove any trailing zeros.
- * (maybe fiddle with the lowest order digit here for rounding, but I doubt it matters)
- * read digits until end of number or max_len reached, ignoring the decimal point
- * get exponent and use it and decimal point location to position the current result integer
- * this always combines the same integer and the same exponent no matter how the number is expressed.
- */
+ s7_double x, y;
- int_exponent = exponent;
- if (int_len > 0)
+ if ((is_t_ratio(pw)) &&
+ (numerator(pw) == 1))
{
- char *iend;
- iend = (char *)(str + int_len - 1);
- while ((*iend == '0') && (iend != str)) {iend--; int_exponent++;}
+ if (denominator(pw) == 2)
+ return(g_sqrt(sc, args));
+ if (denominator(pw) == 3)
+ return(make_real(sc, cbrt(real_to_double(sc, n, "expt")))); /* (expt 27 1/3) should be 3, not 3.0... */
- while (str <= iend)
- int_part = digits[(int)(*str++)] + (int_part * radix);
+ /* but: (expt 512/729 1/3) -> 0.88888888888889
+ */
+ /* and 4 -> sqrt(sqrt...) etc? */
}
- if (int_exponent != 0)
- dval = int_part * ipow(radix, int_exponent);
- else dval = (s7_double)int_part;
- }
- else
- {
- int len, flen;
- long long int frpart = 0;
- /* 98765432101234567890987654321.0e-20 987654321.012346
- * 98765432101234567890987654321.0e-29 0.98765432101235
- * 98765432101234567890987654321.0e-30 0.098765432101235
- * 98765432101234567890987654321.0e-28 9.8765432101235
- */
+ x = real_to_double(sc, n, "expt");
+ y = real_to_double(sc, pw, "expt");
- len = int_len + exponent;
- for (i = 0; i < len; i++)
- int_part = digits[(int)(*str++)] + (int_part * radix);
+ if (is_NaN(x)) return(n);
+ if (is_NaN(y)) return(pw);
+ if (y == 0.0) return(real_one);
- flen = -exponent;
- if (flen > max_len)
- flen = max_len;
+ if (x > 0.0)
+ return(make_real(sc, pow(x, y)));
+ /* tricky cases abound here: (expt -1 1/9223372036854775807)
+ */
+ }
- for (i = 0; i < flen; i++)
- frpart = digits[(int)(*str++)] + (frpart * radix);
+ /* (expt 0+i 1e+16) = 0.98156860153485-0.19111012657867i ?
+ * (expt 0+i 1+1/0i) = 0.0 ??
+ */
+ return(s7_from_c_complex(sc, cpow(s7_to_c_complex(n), s7_to_c_complex(pw))));
+}
- if (len <= 0)
- dval = int_part + frpart * ipow(radix, len - flen);
- else dval = int_part + frpart * ipow(radix, -flen);
- }
- if (frac_len > 0)
- {
- str = fpart;
- if (frac_len <= max_len)
- {
- /* splitting out base 10 case saves very little here */
- /* this ignores trailing zeros, so that 0.3 equals 0.300 */
- char *fend;
+/* -------------------------------- lcm -------------------------------- */
+static s7_pointer g_lcm(s7_scheme *sc, s7_pointer args)
+{
+ #define H_lcm "(lcm ...) returns the least common multiple of its rational arguments"
+ #define Q_lcm pcl_f
- fend = (char *)(str + frac_len - 1);
- while ((*fend == '0') && (fend != str)) {fend--; frac_len--;} /* (= .6 0.6000) */
+ s7_int n = 1, d = 0;
+ s7_pointer p;
- while (str <= fend)
- frac_part = digits[(int)(*str++)] + (frac_part * radix);
- dval += frac_part * ipow(radix, exponent - frac_len);
+ if (!is_pair(args))
+ return(small_int(1));
- /* fprintf(stderr, "frac: %lld, exp: (%d %d) %.20f, val: %.20f\n", frac_part, exponent, frac_len, ipow(radix, exponent - frac_len), dval);
- * 0.6: frac: 6, exp: 0.10000000000000000555, val: 0.60000000000000008882
- * 0.60: frac: 60, exp: 0.01000000000000000021, val: 0.59999999999999997780
- * 0.6000: frac: 6000, exp: 0.00010000000000000000, val: 0.59999999999999997780
- * :(= 0.6 0.60)
- * #f
- * :(= #i3/5 0.6)
- * #f
- * so (string->number (number->string num)) == num only if both num's are the same text (or you get lucky)
- * :(= 0.6 6e-1) ; but not 60e-2
- * #t
- *
- * to fix the 0.60 case, we need to ignore trailing post-dot zeros.
- */
- }
- else
+ if (!is_pair(cdr(args)))
+ {
+ if (!is_rational(car(args)))
+ method_or_bust_with_type(sc, car(args), sc->lcm_symbol, args, a_rational_string, 1);
+ return(g_abs(sc, args));
+ }
+
+ for (p = args; is_pair(p); p = cdr(p))
+ {
+ s7_pointer x;
+ s7_int b;
+ x = car(p);
+ switch (type(x))
{
- if (exponent <= 0)
+ case T_INTEGER:
+ if (integer(x) == 0)
+ n = 0;
+ else
{
- for (i = 0; i < max_len; i++)
- frac_part = digits[(int)(*str++)] + (frac_part * radix);
-
- dval += frac_part * ipow(radix, exponent - max_len);
+ b = integer(x);
+ if (b < 0) b = -b;
+ n = (n / c_gcd(n, b)) * b;
}
- else
- {
- /* 1.0123456789876543210e1 10.12345678987654373771
- * 1.0123456789876543210e10 10123456789.87654304504394531250
- * 0.000000010000000000000000e10 100.0
- * 0.000000010000000000000000000000000000000000000e10 100.0
- * 0.000000012222222222222222222222222222222222222e10 122.22222222222222
- * 0.000000012222222222222222222222222222222222222e17 1222222222.222222
- */
-
- int_part = 0;
- for (i = 0; i < exponent; i++)
- int_part = digits[(int)(*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);
+ if (d != 0) d = 1;
+ break;
- dval += int_part + frac_part * ipow(radix, -frac_len);
+ case T_RATIO:
+ b = numerator(x);
+ if (b < 0) b = -b;
+ n = (n / c_gcd(n, b)) * b;
+ if (d == 0)
+ {
+ if (p == args)
+ d = s7_denominator(x);
+ else d = 1;
}
+ else d = c_gcd(d, s7_denominator(x));
+ break;
+
+ default:
+ method_or_bust_with_type(sc, x, sc->lcm_symbol, cons(sc, (d <= 1) ? make_integer(sc, n) : s7_make_ratio(sc, n, d), p), a_rational_string, position_of(p, args));
+ }
+ if (n < 0) return(simple_out_of_range(sc, sc->lcm_symbol, args, result_is_too_large_string));
+ if (n == 0)
+ {
+ for (p = cdr(p); is_pair(p); p = cdr(p))
+ if (!is_rational_via_method(sc, car(p)))
+ return(wrong_type_argument_with_type(sc, sc->lcm_symbol, position_of(p, args), x, a_rational_string));
+ return(small_int(0));
}
}
-#if WITH_GMP
- if ((int_part == 0) &&
- (frac_part == 0))
- return(0.0);
- (*overflow) = ((frac_len - exponent) > max_len);
-#endif
-
- return(sign * dval);
+ if (d <= 1)
+ return(make_integer(sc, n));
+ return(s7_make_ratio(sc, n, d));
}
-static s7_pointer make_atom(s7_scheme *sc, char *q, int radix, bool want_symbol, bool with_error)
-{
- /* make symbol or number from string */
- #define IS_DIGIT(Chr, Rad) (digits[(unsigned char)Chr] < Rad)
-
- char c, *p;
- bool has_dec_point1 = false;
- p = q;
- c = *p++;
+/* -------------------------------- gcd -------------------------------- */
+static s7_pointer g_gcd(s7_scheme *sc, s7_pointer args)
+{
+ #define H_gcd "(gcd ...) returns the greatest common divisor of its rational arguments"
+ #define Q_gcd pcl_f
+ s7_int n = 0, d = 1;
+ s7_pointer p;
- /* a number starts with + - . or digit, but so does 1+ for example */
+ if (!is_pair(args))
+ return(small_int(0));
- switch (c)
+ if (!is_pair(cdr(args)))
{
- case '#':
- return(make_sharp_constant(sc, p, UNNESTED_SHARP, radix, with_error)); /* make_sharp_constant expects the '#' to be removed */
+ if (!is_rational(car(args)))
+ method_or_bust_with_type(sc, car(args), sc->gcd_symbol, args, a_rational_string, 1);
+ return(g_abs(sc, args));
+ }
- case '+':
- case '-':
- c = *p++;
- if (c == '.')
+ for (p = args; is_pair(p); p = cdr(p))
+ {
+ s7_pointer x;
+ s7_int b;
+ x = car(p);
+ switch (type(x))
{
- has_dec_point1 = true;
- c = *p++;
- }
- if ((!c) || (!IS_DIGIT(c, radix)))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
- break;
+ case T_INTEGER:
+ n = c_gcd(n, integer(x));
+ break;
- case '.':
- has_dec_point1 = true;
- c = *p++;
+ case T_RATIO:
+ n = c_gcd(n, s7_numerator(x));
+ b = s7_denominator(x);
+ if (b < 0) b = -b;
+ d = (d / c_gcd(d, b)) * b;
+ if (d < 0) return(simple_out_of_range(sc, sc->gcd_symbol, args, result_is_too_large_string));
+ break;
- if ((!c) || (!IS_DIGIT(c, radix)))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
- break;
+ default:
+ method_or_bust_with_type(sc, x, sc->gcd_symbol, cons(sc, (d <= 1) ? make_integer(sc, n) : s7_make_ratio(sc, n, d), p), a_rational_string, position_of(p, args));
+ }
+ if (n < 0) return(simple_out_of_range(sc, sc->gcd_symbol, args, result_is_too_large_string));
+ }
- case '0': /* these two are always digits */
- case '1':
- break;
+ if (d <= 1)
+ return(make_integer(sc, n));
+ return(s7_make_ratio(sc, n, d));
+}
- default:
- if (!IS_DIGIT(c, radix))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
- break;
- }
- /* now it's possibly a number -- the first character(s) could be part of a number in the current radix */
- {
- char *slash1 = NULL, *slash2 = NULL, *plus = NULL, *ex1 = NULL, *ex2 = NULL;
- bool has_i = false, has_dec_point2 = false;
- int has_plus_or_minus = 0, current_radix;
-#if (!WITH_GMP)
- bool overflow = false;
-#endif
- current_radix = radix; /* current_radix is 10 for the exponent portions, but radix for all the rest */
+static s7_pointer s7_truncate(s7_scheme *sc, s7_pointer caller, s7_double xf) /* can't use "truncate" -- it's in unistd.h */
+{
+ if ((xf > s7_int_max) ||
+ (xf < s7_int_min))
+ return(simple_out_of_range(sc, caller, make_real(sc, xf), its_too_large_string));
- for ( ; (c = *p) != 0; ++p)
- {
- /* what about embedded null? (string->number (string #\1 (integer->char 0) #\0))
- * currently we stop and return 1, but Guile returns #f
- */
- if (!IS_DIGIT(c, current_radix)) /* moving this inside the switch statement was much slower */
- {
- current_radix = radix;
+ if (xf > 0.0)
+ return(make_integer(sc, (s7_int)floor(xf)));
+ return(make_integer(sc, (s7_int)ceil(xf)));
+}
- switch (c)
- {
- /* -------- decimal point -------- */
- case '.':
- if ((!IS_DIGIT(p[1], current_radix)) &&
- (!IS_DIGIT(p[-1], current_radix)))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
+static s7_int c_quo_int(s7_scheme *sc, s7_int x, s7_int y)
+{
+ if (y == 0)
+ division_by_zero_error(sc, sc->quotient_symbol, set_elist_2(sc, make_integer(sc, x), make_integer(sc, y)));
+ if ((y == -1) && (x == s7_int_min)) /* (quotient most-negative-fixnum -1) */
+ simple_out_of_range(sc, sc->quotient_symbol, set_elist_2(sc, make_integer(sc, x), make_integer(sc, y)), its_too_large_string);
+ return(x / y);
+}
- if (has_plus_or_minus == 0)
- {
- if ((has_dec_point1) || (slash1))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
- has_dec_point1 = true;
- }
- else
- {
- if ((has_dec_point2) || (slash2))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
- has_dec_point2 = true;
- }
- continue;
+static s7_double c_quo_dbl(s7_scheme *sc, s7_double x, s7_double y)
+{
+ s7_double xf;
+ if (y == 0.0)
+ division_by_zero_error(sc, sc->quotient_symbol, set_elist_2(sc, make_real(sc, x), make_real(sc, y)));
+ if ((is_inf(y)) || (is_NaN(y)))
+ wrong_type_argument_with_type(sc, sc->quotient_symbol, 2, make_real(sc, y), a_normal_real_string);
- /* -------- exponent marker -------- */
-#if WITH_EXTRA_EXPONENT_MARKERS
- /* 1st 3d-perspective 0.0f 128.0f 3d 1s -- in 2 million lines of public scheme code, not one actual use! */
- case 's': case 'S':
- case 'd': case 'D':
- case 'f': case 'F':
- case 'l': case 'L':
-#endif
- case 'e': case 'E':
- if (current_radix > 10)
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
- /* see note above */
- /* fall through -- if '@' used, radices>10 are ok */
+ xf = x / y;
+ if ((xf > s7_int_max) ||
+ (xf < s7_int_min))
+ simple_out_of_range(sc, sc->quotient_symbol, make_real(sc, xf), its_too_large_string);
- case '@':
- current_radix = 10;
+ if (xf > 0.0)
+ return(floor(xf));
+ return(ceil(xf));
+}
- if (((ex1) ||
- (slash1)) &&
- (has_plus_or_minus == 0)) /* ee */
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
+static s7_int quotient_i_ii(s7_int i1, s7_int i2) {return(c_quo_int(cur_sc, i1, i2));}
+static s7_double quotient_d_dd(s7_double x1, s7_double x2)
+{
+ if ((is_inf(x1)) || (is_NaN(x1)))
+ wrong_type_argument_with_type(cur_sc, cur_sc->quotient_symbol, 1, make_real(cur_sc, x1), a_normal_real_string);
+ return(c_quo_dbl(cur_sc, x1, x2));
+}
- if (((ex2) ||
- (slash2)) &&
- (has_plus_or_minus != 0)) /* 1+1.0ee */
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
+static s7_pointer g_quotient(s7_scheme *sc, s7_pointer args)
+{
+ #define H_quotient "(quotient x1 x2) returns the integer quotient of x1 and x2; (quotient 4 3) = 1"
+ #define Q_quotient pcl_r
+ /* (define (quo x1 x2) (truncate (/ x1 x2))) ; slib
+ */
+ s7_pointer x, y;
+ s7_int d1, d2, n1, n2;
- if ((!IS_DIGIT(p[-1], radix)) && /* was current_radix but that's always 10! */
- (p[-1] != '.'))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ x = car(args);
+ y = cadr(args);
- if (has_plus_or_minus == 0)
- {
- ex1 = p;
- has_dec_point1 = true; /* decimal point illegal from now on */
- }
- else
- {
- ex2 = p;
- has_dec_point2 = true;
- }
- p++;
- if ((*p == '-') || (*p == '+')) p++;
- if (IS_DIGIT(*p, current_radix))
- continue;
- break;
+ switch (type(x))
+ {
+ case T_INTEGER:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ return(make_integer(sc, c_quo_int(sc, integer(x), integer(y))));
+ case T_RATIO:
+ n1 = integer(x);
+ d1 = 1;
+ n2 = numerator(y);
+ d2 = denominator(y);
+ /* (quotient -9223372036854775808 -1/9223372036854775807): arithmetic exception in the no-overflow-checks case */
+ goto RATIO_QUO_RATIO;
- /* -------- internal + or - -------- */
- case '+':
- case '-':
- if (has_plus_or_minus != 0) /* already have the separator */
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ case T_REAL:
+ if (real(y) == 0.0)
+ return(division_by_zero_error(sc, sc->quotient_symbol, args));
+ if ((is_inf(real(y))) || (is_NaN(real(y))))
+ return(wrong_type_argument_with_type(sc, sc->quotient_symbol, 2, y, a_normal_real_string));
+ return(s7_truncate(sc, sc->quotient_symbol, (s7_double)integer(x) / real(y)));
- if (c == '+') has_plus_or_minus = 1; else has_plus_or_minus = -1;
- plus = (char *)(p + 1);
- continue;
+ default:
+ method_or_bust(sc, y, sc->quotient_symbol, args, T_REAL, 2);
+ }
- /* ratio marker */
- case '/':
- if ((has_plus_or_minus == 0) &&
- ((ex1) ||
- (slash1) ||
- (has_dec_point1)))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
-
- if ((has_plus_or_minus != 0) &&
- ((ex2) ||
- (slash2) ||
- (has_dec_point2)))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ case T_RATIO:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(y) == 0)
+ return(division_by_zero_error(sc, sc->quotient_symbol, args));
+ n1 = numerator(x);
+ d1 = denominator(x);
+ n2 = integer(y);
+ d2 = 1;
+ goto RATIO_QUO_RATIO;
+ /* this can lose:
+ * (quotient 1 2305843009213693952/4611686018427387903) -> 2, not 1
+ * (quotient 21053343141/6701487259 3587785776203/1142027682075) -> 1, not 0
+ */
- if (has_plus_or_minus == 0)
- slash1 = (char *)(p + 1);
- else slash2 = (char *)(p + 1);
+ case T_RATIO:
+ n1 = numerator(x);
+ d1 = denominator(x);
+ n2 = numerator(y);
+ d2 = denominator(y);
+ RATIO_QUO_RATIO:
+ if (d1 == d2)
+ return(make_integer(sc, n1 / n2)); /* (quotient 3/9223372036854775807 1/9223372036854775807) */
+ if (n1 == n2)
+ return(make_integer(sc, d2 / d1)); /* (quotient 9223372036854775807/2 9223372036854775807/8) */
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int n1d2, n2d1;
+ if ((multiply_overflow(n1, d2, &n1d2)) ||
+ (multiply_overflow(n2, d1, &n2d1)))
+ return(s7_truncate(sc, sc->quotient_symbol, ((long double)n1 / (long double)n2) * ((long double)d2 / (long double)d1)));
+ return(make_integer(sc, n1d2 / n2d1));
+ }
+#else
+ return(make_integer(sc, (n1 * d2) / (n2 * d1)));
+#endif
- if ((!IS_DIGIT(p[1], current_radix)) ||
- (!IS_DIGIT(p[-1], current_radix)))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ case T_REAL:
+ if (real(y) == 0.0)
+ return(division_by_zero_error(sc, sc->quotient_symbol, args));
+ if ((is_inf(real(y))) || (is_NaN(real(y))))
+ return(wrong_type_argument_with_type(sc, sc->quotient_symbol, 2, y, a_normal_real_string));
+ return(s7_truncate(sc, sc->quotient_symbol, (s7_double)fraction(x) / real(y)));
- continue;
+ default:
+ method_or_bust(sc, y, sc->quotient_symbol, args, T_REAL, 2);
+ }
+ case T_REAL:
+ if ((is_inf(real(x))) || (is_NaN(real(x))))
+ return(wrong_type_argument_with_type(sc, sc->quotient_symbol, 1, x, a_normal_real_string));
- /* -------- i for the imaginary part -------- */
- case 'i':
- if ((has_plus_or_minus != 0) &&
- (!has_i))
- {
- has_i = true;
- continue;
- }
- break;
+ /* if infs allowed we need to return infs/nans, else:
+ * (quotient inf.0 1e-309) -> -9223372036854775808
+ * (quotient inf.0 inf.0) -> -9223372036854775808
+ */
- default:
- break;
- }
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
- }
- }
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(y) == 0)
+ return(division_by_zero_error(sc, sc->quotient_symbol, args));
+ return(s7_truncate(sc, sc->quotient_symbol, real(x) / (s7_double)integer(y)));
- if ((has_plus_or_minus != 0) && /* that is, we have an internal + or - */
- (!has_i)) /* but no i for the imaginary part */
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ case T_RATIO:
+ return(s7_truncate(sc, sc->quotient_symbol, real(x) / (s7_double)fraction(y)));
- if (has_i)
- {
-#if (!WITH_GMP)
- s7_double rl = 0.0, im = 0.0;
-#else
- char e1 = 0, e2 = 0;
-#endif
- s7_pointer result;
- int len;
- char ql1, pl1;
+ case T_REAL:
+ return(make_real(sc, c_quo_dbl(sc, real(x), real(y))));
- len = safe_strlen(q);
+ default:
+ method_or_bust(sc, y, sc->quotient_symbol, args, T_REAL, 2);
+ }
- if (q[len - 1] != 'i')
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ default:
+ method_or_bust(sc, x, sc->quotient_symbol, args, T_REAL, 2);
+ }
+}
- /* save original string */
- ql1 = q[len - 1];
- pl1 = (*(plus - 1));
-#if WITH_GMP
- if (ex1) {e1 = *ex1; (*ex1) = '@';} /* for mpfr */
- if (ex2) {e2 = *ex2; (*ex2) = '@';}
-#endif
- /* look for cases like 1+i */
- if ((q[len - 2] == '+') || (q[len - 2] == '-'))
- q[len - 1] = '1';
- else q[len - 1] = '\0'; /* remove 'i' */
+static s7_int c_rem_int(s7_scheme *sc, s7_int x, s7_int y)
+{
+ if (y == 0)
+ division_by_zero_error(sc, sc->remainder_symbol, set_elist_2(sc, make_integer(sc, x), make_integer(sc, y)));
+ if ((y == 1) || (y == -1)) /* (remainder most-negative-fixnum -1) will segfault with arithmetic exception */
+ return(0);
+ return(x % y);
+}
- (*((char *)(plus - 1))) = '\0';
+static s7_double c_rem_dbl(s7_scheme *sc, s7_double x, s7_double y)
+{
+ s7_int quo;
+ s7_double pre_quo;
+ if (y == 0.0)
+ division_by_zero_error(sc, sc->remainder_symbol, set_elist_2(sc, make_real(sc, x), make_real(sc, y)));
+ if ((is_inf(y)) || (is_NaN(y)))
+ wrong_type_argument_with_type(sc, sc->remainder_symbol, 2, set_elist_1(sc, make_real(sc, y)), a_normal_real_string);
- /* there is a slight inconsistency here:
- 1/0 -> nan.0
- 1/0+0i -> inf.0 (0/1+0i is 0.0)
- #i1/0+0i -> inf.0
- 0/0 -> nan.0
- 0/0+0i -> -nan.0
- */
+ pre_quo = x / y;
+ if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
+ simple_out_of_range(sc, sc->remainder_symbol, set_elist_2(sc, make_real(sc, x), make_real(sc, y)), its_too_large_string);
+ if (pre_quo > 0.0)
+ quo = (s7_int)floor(pre_quo);
+ else quo = (s7_int)ceil(pre_quo);
+ return(x - (y * quo));
+}
-#if (!WITH_GMP)
- if ((has_dec_point1) ||
- (ex1))
- {
- /* (string->number "1100.1+0.11i" 2) -- need to split into 2 honest reals before passing to non-base-10 str->dbl */
- rl = string_to_double_with_radix(q, radix, &overflow);
- }
- else
- {
- if (slash1)
- {
- /* here the overflow could be innocuous if it's in the denominator and the numerator is 0
- * 0/100000000000000000000000000000000000000-0i
- */
- s7_int num, den;
- num = string_to_integer(q, radix, &overflow);
- den = string_to_integer(slash1, radix, &overflow);
- if (den == 0)
- rl = NAN;
- else
- {
- if (num == 0)
- {
- rl = 0.0;
- overflow = false;
- }
- else rl = (s7_double)num / (s7_double)den;
- }
- }
- else rl = (s7_double)string_to_integer(q, radix, &overflow);
- if (overflow) return(real_NaN);
- }
- if (rl == -0.0) rl = 0.0;
+static s7_int remainder_i_ii(s7_int i1, s7_int i2) {return(c_rem_int(cur_sc, i1, i2));}
+static s7_double remainder_d_dd(s7_double x1, s7_double x2)
+{
+ if ((is_inf(x1)) || (is_NaN(x1)))
+ wrong_type_argument_with_type(cur_sc, cur_sc->remainder_symbol, 1, set_elist_1(cur_sc, make_real(cur_sc, x1)), a_normal_real_string);
+ return(c_rem_dbl(cur_sc, x1, x2));
+}
- if ((has_dec_point2) ||
- (ex2))
- im = string_to_double_with_radix(plus, radix, &overflow);
- else
- {
- if (slash2)
- {
- /* same as above: 0-0/100000000000000000000000000000000000000i
- */
- s7_int num, den;
- num = string_to_integer(plus, radix, &overflow);
- den = string_to_integer(slash2, radix, &overflow);
- if (den == 0)
- im = NAN;
- else
- {
- if (num == 0)
- {
- im = 0.0;
- overflow = false;
- }
- else im = (s7_double)num / (s7_double)den;
- }
- }
- else im = (s7_double)string_to_integer(plus, radix, &overflow);
- if (overflow) return(real_NaN);
- }
- if ((has_plus_or_minus == -1) &&
- (im != 0.0))
- im = -im;
- result = s7_make_complex(sc, rl, im);
-#else
- result = string_to_either_complex(sc, q, slash1, ex1, has_dec_point1, plus, slash2, ex2, has_dec_point2, radix, has_plus_or_minus);
-#endif
+static s7_pointer g_remainder(s7_scheme *sc, s7_pointer args)
+{
+ #define H_remainder "(remainder x1 x2) returns the remainder of x1/x2; (remainder 10 3) = 1"
+ #define Q_remainder pcl_r
+ /* (define (rem x1 x2) (- x1 (* x2 (quo x1 x2)))) ; slib, if x2 is an integer (- x1 (truncate x1 x2)), fractional part: (remainder x 1) */
- /* restore original string */
- q[len - 1] = ql1;
- (*((char *)(plus - 1))) = pl1;
-#if WITH_GMP
- if (ex1) (*ex1) = e1;
- if (ex2) (*ex2) = e2;
-#endif
+ s7_pointer x, y;
+ s7_int quo, d1, d2, n1, n2;
+ s7_double pre_quo;
- return(result);
- }
+ x = car(args);
+ y = cadr(args);
- /* not complex */
- if ((has_dec_point1) ||
- (ex1))
- {
- s7_pointer result;
+ switch (type(x))
+ {
+ case T_INTEGER:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ return(make_integer(sc, c_rem_int(sc, integer(x), integer(y))));
- if (slash1) /* not complex, so slash and "." is not a number */
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ case T_RATIO:
+ n1 = integer(x);
+ d1 = 1;
+ n2 = numerator(y);
+ d2 = denominator(y);
+ goto RATIO_REM_RATIO;
-#if (!WITH_GMP)
- result = make_real(sc, string_to_double_with_radix(q, radix, &overflow));
-#else
- {
- char old_e = 0;
- if (ex1)
- {
- old_e = (*ex1);
- (*ex1) = '@';
- }
- result = string_to_either_real(sc, q, radix);
- if (ex1)
- (*ex1) = old_e;
- }
-#endif
- return(result);
- }
+ case T_REAL:
+ if (real(y) == 0.0)
+ return(division_by_zero_error(sc, sc->remainder_symbol, args));
+ if ((is_inf(real(y))) || (is_NaN(real(y))))
+ return(wrong_type_argument_with_type(sc, sc->remainder_symbol, 2, y, a_normal_real_string));
- /* not real */
- if (slash1)
-#if (!WITH_GMP)
- {
- s7_int n, d;
+ pre_quo = (s7_double)integer(x) / real(y);
+ if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
+ return(simple_out_of_range(sc, sc->remainder_symbol, args, its_too_large_string));
+ if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
+ return(make_real(sc, integer(x) - real(y) * quo));
- n = string_to_integer(q, radix, &overflow);
- d = string_to_integer(slash1, radix, &overflow);
+ default:
+ method_or_bust(sc, y, sc->remainder_symbol, args, T_REAL, 2);
+ }
- if ((n == 0) && (d != 0)) /* 0/100000000000000000000000000000000000000 */
- return(small_int(0));
- if ((d == 0) || (overflow))
- return(real_NaN);
- /* it would be neat to return 1 from 10000000000000000000000000000/10000000000000000000000000000
- * but q is the entire number ('/' included) and slash1 is the stuff after the '/', and every
- * big number comes through here, so there's no clean and safe way to check that q == slash1.
- */
- return(s7_make_ratio(sc, n, d));
- }
-#else
- return(string_to_either_ratio(sc, q, slash1, radix));
-#endif
+ case T_RATIO:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ n2 = integer(y);
+ if (n2 == 0)
+ return(division_by_zero_error(sc, sc->remainder_symbol, args));
+ n1 = numerator(x);
+ d1 = denominator(x);
+ d2 = 1;
+ goto RATIO_REM_RATIO;
- /* integer */
-#if (!WITH_GMP)
- {
- s7_int x;
- x = string_to_integer(q, radix, &overflow);
- if (overflow)
- return((q[0] == '-') ? real_minus_infinity : real_infinity);
- return(make_integer(sc, x));
- }
+ case T_RATIO:
+ n1 = numerator(x);
+ d1 = denominator(x);
+ n2 = numerator(y);
+ d2 = denominator(y);
+ RATIO_REM_RATIO:
+ if (d1 == d2)
+ quo = (s7_int)(n1 / n2);
+ else
+ {
+ if (n1 == n2)
+ quo = (s7_int)(d2 / d1);
+ else
+ {
+#if HAVE_OVERFLOW_CHECKS
+ s7_int n1d2, n2d1;
+ if ((multiply_overflow(n1, d2, &n1d2)) ||
+ (multiply_overflow(n2, d1, &n2d1)))
+ {
+ pre_quo = ((long double)n1 / (long double)n2) * ((long double)d2 / (long double)d1);
+ if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
+ return(simple_out_of_range(sc, sc->remainder_symbol, args, its_too_large_string));
+ if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
+ }
+ else quo = n1d2 / n2d1;
#else
- return(string_to_either_integer(sc, q, radix));
+ quo = (n1 * d2) / (n2 * d1);
#endif
- }
-}
+ }
+ }
+ if (quo == 0)
+ return(x);
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int dn, nq;
+ if (!multiply_overflow(n2, quo, &nq))
+ {
+ if ((d1 == d2) &&
+ (!subtract_overflow(n1, nq, &dn)))
+ return(s7_make_ratio(sc, dn, d1));
-static s7_pointer s7_string_to_number(s7_scheme *sc, char *str, int radix)
-{
- s7_pointer x;
- x = make_atom(sc, str, radix, NO_SYMBOLS, WITHOUT_OVERFLOW_ERROR);
- if (s7_is_number(x)) /* only needed because str might start with '#' and not be a number (#t for example) */
- return(x);
- return(sc->F);
-}
+ if ((!multiply_overflow(n1, d2, &dn)) &&
+ (!multiply_overflow(nq, d1, &nq)) &&
+ (!subtract_overflow(dn, nq, &nq)) &&
+ (!multiply_overflow(d1, d2, &d1)))
+ return(s7_make_ratio(sc, nq, d1));
+ }
+ }
+#else
+ if (d1 == d2)
+ return(s7_make_ratio(sc, n1 - n2 * quo, d1));
+ return(s7_make_ratio(sc, n1 * d2 - n2 * d1 * quo, d1 * d2));
+#endif
+ return(simple_out_of_range(sc, sc->remainder_symbol, args, make_string_wrapper(sc, "intermediate (a/b) is too large")));
-static s7_pointer g_string_to_number_1(s7_scheme *sc, s7_pointer args, s7_pointer caller)
-{
- #define H_string_to_number "(string->number str (radix 10)) converts str into a number. \
-If str does not represent a number, string->number returns #f. If 'str' has an embedded radix, \
-the 'radix' it is ignored: (string->number \"#x11\" 2) -> 17 not 3."
- #define Q_string_to_number s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->is_number_symbol, sc->is_boolean_symbol), sc->is_string_symbol, sc->is_integer_symbol)
+ case T_REAL:
+ {
+ s7_double frac;
+ if (real(y) == 0.0)
+ return(division_by_zero_error(sc, sc->remainder_symbol, args));
+ if ((is_inf(real(y))) || (is_NaN(real(y))))
+ return(wrong_type_argument_with_type(sc, sc->remainder_symbol, 2, y, a_normal_real_string));
+ frac = (s7_double)fraction(x);
+ pre_quo = frac / real(y);
+ if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
+ return(simple_out_of_range(sc, sc->remainder_symbol, args, its_too_large_string));
+ if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
+ return(make_real(sc, frac - real(y) * quo));
+ }
- s7_int radix = 0;
- char *str;
+ default:
+ method_or_bust(sc, y, sc->remainder_symbol, args, T_REAL, 2);
+ }
- if (!is_string(car(args)))
- method_or_bust(sc, car(args), caller, args, T_STRING, 1);
+ case T_REAL:
+ if ((is_inf(real(x))) || (is_NaN(real(x))))
+ return(wrong_type_argument_with_type(sc, sc->remainder_symbol, 1, x, a_normal_real_string));
- if (is_pair(cdr(args)))
- {
- s7_pointer rad, p;
- rad = cadr(args);
- if (!s7_is_integer(rad))
+ switch (type(y))
{
- if (!s7_is_integer(p = check_values(sc, rad, cdr(args))))
- method_or_bust(sc, rad, caller, args, T_INTEGER, 2);
- rad = p;
- }
- radix = s7_integer(rad);
- if ((radix < 2) || /* what about negative int as base (Knuth), reals such as phi, and some complex like -1+i */
- (radix > 16)) /* the only problem here is printing the number; perhaps put each digit in "()" in base 10: (123)(0)(34) */
- return(out_of_range(sc, caller, small_int(2), rad, a_valid_radix_string));
- }
- else radix = 10;
+ case T_INTEGER:
+ if (integer(y) == 0)
+ return(division_by_zero_error(sc, sc->remainder_symbol, args));
+ pre_quo = real(x) / (s7_double)integer(y);
+ if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
+ return(simple_out_of_range(sc, sc->remainder_symbol, args, its_too_large_string));
+ if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
+ return(make_real(sc, real(x) - integer(y) * quo));
+ /* but... (remainder 1e+18 9223372036854775807) -> 1e+18 */
- str = (char *)string_value(car(args));
- if ((!str) || (!(*str)))
- return(sc->F);
+ case T_RATIO:
+ {
+ /* bad cases here start around 1e16: (remainder 1e15 3/13) -> 0.0 with loss of digits earlier
+ * would long double help?
+ */
+ s7_double frac;
+ frac = (s7_double)fraction(y);
+ pre_quo = real(x) / frac;
+ if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
+ return(simple_out_of_range(sc, sc->remainder_symbol, args, its_too_large_string));
+ if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
+ return(make_real(sc, real(x) - frac * quo));
+ }
- switch (str[0])
- {
- case 'n':
- if (safe_strcmp(str, "nan.0"))
- return(real_NaN);
- break;
+ case T_REAL:
+ return(make_real(sc, c_rem_dbl(sc, real(x), real(y))));
- case 'i':
- if (safe_strcmp(str, "inf.0"))
- return(real_infinity);
- break;
+ /* see under sin -- this calculation is completely bogus if "a" is large
+ * (quotient 1e22 (* 2 pi)) -> -9223372036854775808 -- should this return arithmetic-overflow?
+ * but it should be 1591549430918953357688,
+ * (remainder 1e22 (* 2 pi)) -> 1.0057952155665e+22
+ * -- the "remainder" is greater than the original argument!
+ * Clisp gives 0.0 here, as does sbcl
+ * currently s7 throws an error (out-of-range).
+ */
- case '-':
- if ((str[1] == 'i') && (safe_strcmp((const char *)(str + 1), "inf.0")))
- return(real_minus_infinity);
- break;
+ default:
+ method_or_bust(sc, y, sc->remainder_symbol, args, T_REAL, 2);
+ }
- case '+':
- if ((str[1] == 'i') && (safe_strcmp((const char *)(str + 1), "inf.0")))
- return(real_infinity);
- break;
+ default:
+ method_or_bust(sc, x, sc->remainder_symbol, args, T_REAL, 1);
}
- return(s7_string_to_number(sc, str, radix));
}
-static s7_pointer g_string_to_number(s7_scheme *sc, s7_pointer args)
-{
- return(g_string_to_number_1(sc, args, sc->string_to_number_symbol));
-}
+/* -------------------------------- floor -------------------------------- */
-static s7_pointer c_string_to_number(s7_scheme *sc, s7_pointer n)
-{
- return(g_string_to_number_1(sc, set_plist_1(sc, n), sc->string_to_number_symbol));
-}
+#define REAL_TO_INT_LIMIT 9.2233727815085e+18
+/* unfortunately, this limit is only a max in a sense: (ceiling 9223372036854770.9) => 9223372036854770
+ * see s7test for more examples
+ */
-PF_TO_PF(string_to_number, c_string_to_number)
-
-
-static bool numbers_are_eqv(s7_pointer a, s7_pointer b)
+static s7_pointer g_floor(s7_scheme *sc, s7_pointer args)
{
- if (type(a) != type(b)) /* (eqv? 1 1.0) -> #f! */
- return(false);
+ #define H_floor "(floor x) returns the integer closest to x toward -inf"
+ #define Q_floor s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_real_symbol)
- switch (type(a))
+ s7_pointer x;
+
+ x = car(args);
+ switch (type(x))
{
case T_INTEGER:
- return((integer(a) == integer(b)));
+ return(x);
case T_RATIO:
- return((numerator(a) == numerator(b)) &&
- (denominator(a) == denominator(b)));
+ {
+ s7_int val;
+ val = numerator(x) / denominator(x);
+ /* C "/" truncates? -- C spec says "truncation toward 0" */
+ /* we're avoiding "floor" here because the int->double conversion introduces inaccuracies for big numbers */
+ if (numerator(x) < 0) /* not "val" because it might be truncated to 0 */
+ return(make_integer(sc, val - 1));
+ return(make_integer(sc, val));
+ }
case T_REAL:
- if (is_NaN(real(a)))
- return(false);
- return(real(a) == real(b));
+ {
+ s7_double z;
+ z = real(x);
+ if (is_NaN(z))
+ return(simple_out_of_range(sc, sc->floor_symbol, x, its_nan_string));
+ if (fabs(z) > REAL_TO_INT_LIMIT)
+ return(simple_out_of_range(sc, sc->floor_symbol, x, its_too_large_string));
+ return(make_integer(sc, (s7_int)floor(z)));
+ /* floor here rounds down, whereas a straight int<=real coercion apparently rounds towards 0 */
+ }
case T_COMPLEX:
- if ((is_NaN(real_part(a))) ||
- (is_NaN(imag_part(a))))
- return(false);
- return((real_part(a) == real_part(b)) &&
- (imag_part(a) == imag_part(b)));
-
default:
-#if WITH_GMP
- if ((is_big_number(a)) || (is_big_number(b))) /* this can happen if (member bignum ...) -> memv */
- return(big_numbers_are_eqv(a, b));
-#endif
- break;
+ method_or_bust_one_arg(sc, x, sc->floor_symbol, args, T_REAL);
}
- return(false);
}
+static s7_int floor_i_i(s7_int i) {return(i);}
+static s7_int floor_i_d(s7_double x)
+{
+ if (is_NaN(x))
+ simple_out_of_range(cur_sc, cur_sc->floor_symbol, make_real(cur_sc, x), its_nan_string);
+ if (fabs(x) > REAL_TO_INT_LIMIT)
+ simple_out_of_range(cur_sc, cur_sc->floor_symbol, make_real(cur_sc, x), its_too_large_string);
+ return((s7_int)floor(x));
+}
-static bool is_rational_via_method(s7_scheme *sc, s7_pointer p)
+static s7_double floor_d_d(s7_double x)
{
- if (s7_is_rational(p))
- return(true);
- if (has_methods(p))
- {
- s7_pointer f;
- f = find_method(sc, find_let(sc, p), sc->is_rational_symbol);
- if (f != sc->undefined)
- return(is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->nil))));
- }
- return(false);
+ if (is_NaN(x))
+ simple_out_of_range(cur_sc, cur_sc->floor_symbol, make_real(cur_sc, x), its_nan_string);
+ if (fabs(x) > REAL_TO_INT_LIMIT)
+ simple_out_of_range(cur_sc, cur_sc->floor_symbol, make_real(cur_sc, x), its_too_large_string);
+ return(floor(x));
}
-/* -------------------------------- abs -------------------------------- */
-#if (!WITH_GMP)
-static s7_pointer g_abs(s7_scheme *sc, s7_pointer args)
+/* -------------------------------- ceiling -------------------------------- */
+static s7_pointer g_ceiling(s7_scheme *sc, s7_pointer args)
{
- #define H_abs "(abs x) returns the absolute value of the real number x"
- #define Q_abs s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_real_symbol)
+ #define H_ceiling "(ceiling x) returns the integer closest to x toward inf"
+ #define Q_ceiling s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_real_symbol)
s7_pointer x;
+
x = car(args);
switch (type(x))
{
case T_INTEGER:
- if (integer(x) < 0)
- {
- if (integer(x) == s7_int_min)
- return(make_integer(sc, s7_int_max));
- return(make_integer(sc, -integer(x)));
- }
return(x);
case T_RATIO:
- if (numerator(x) < 0)
- {
- if (numerator(x) == s7_int_min)
- return(s7_make_ratio(sc, s7_int_max, denominator(x)));
- return(s7_make_ratio(sc, -numerator(x), denominator(x)));
- }
- return(x);
+ {
+ s7_int val;
+ val = numerator(x) / denominator(x);
+ if (numerator(x) < 0)
+ return(make_integer(sc, val));
+ return(make_integer(sc, val + 1));
+ }
case T_REAL:
- if (is_NaN(real(x))) /* (abs -nan.0) -> nan.0, not -nan.0 */
- return(real_NaN);
- if (real(x) < 0.0)
- return(make_real(sc, -real(x)));
- return(x);
+ {
+ s7_double z;
+ z = real(x);
+ if (is_NaN(z))
+ return(simple_out_of_range(sc, sc->ceiling_symbol, x, its_nan_string));
+ if ((is_inf(z)) ||
+ (z > REAL_TO_INT_LIMIT) ||
+ (z < -REAL_TO_INT_LIMIT))
+ return(simple_out_of_range(sc, sc->ceiling_symbol, x, its_too_large_string));
+ return(make_integer(sc, (s7_int)ceil(real(x))));
+ }
+ case T_COMPLEX:
default:
- method_or_bust(sc, x, sc->abs_symbol, args, T_REAL, 0);
+ method_or_bust_one_arg(sc, x, sc->ceiling_symbol, args, T_REAL);
}
}
-static s7_int c_abs_i(s7_scheme *sc, s7_int arg) {return((arg < 0) ? (-arg) : arg);}
-IF_TO_IF(abs, c_abs_i)
-
-static s7_double c_abs_r(s7_scheme *sc, s7_double arg) {return((arg < 0.0) ? (-arg) : arg);}
-DIRECT_RF_TO_RF(fabs)
-
-
-/* -------------------------------- magnitude -------------------------------- */
+static s7_int ceiling_i_i(s7_int i) {return(i);}
+static s7_int ceiling_i_d(s7_double x)
+{
+ if (is_NaN(x))
+ simple_out_of_range(cur_sc, cur_sc->ceiling_symbol, make_real(cur_sc, x), its_nan_string);
+ if ((is_inf(x)) ||
+ (x > REAL_TO_INT_LIMIT) ||
+ (x < -REAL_TO_INT_LIMIT))
+ simple_out_of_range(cur_sc, cur_sc->ceiling_symbol, make_real(cur_sc, x), its_too_large_string);
+ return((s7_int)ceil(x));
+}
-static double my_hypot(double x, double y)
+static s7_double ceiling_d_d(s7_double x)
{
- /* according to callgrind, this is much faster than libc's hypot */
- if (x == 0.0) return(fabs(y));
- if (y == 0.0) return(fabs(x));
- if (x == y) return(1.414213562373095 * fabs(x));
- if ((is_NaN(x)) || (is_NaN(y))) return(NAN);
- return(sqrt(x * x + y * y));
+ if (is_NaN(x))
+ simple_out_of_range(cur_sc, cur_sc->ceiling_symbol, make_real(cur_sc, x), its_nan_string);
+ if ((is_inf(x)) ||
+ (x > REAL_TO_INT_LIMIT) ||
+ (x < -REAL_TO_INT_LIMIT))
+ simple_out_of_range(cur_sc, cur_sc->ceiling_symbol, make_real(cur_sc, x), its_too_large_string);
+ return(ceil(x));
}
-static s7_pointer g_magnitude(s7_scheme *sc, s7_pointer args)
+
+/* -------------------------------- truncate -------------------------------- */
+static s7_pointer g_truncate(s7_scheme *sc, s7_pointer args)
{
- #define H_magnitude "(magnitude z) returns the magnitude of z"
- #define Q_magnitude s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_number_symbol)
+ #define H_truncate "(truncate x) returns the integer closest to x toward 0"
+ #define Q_truncate s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_real_symbol)
+
s7_pointer x;
x = car(args);
-
switch (type(x))
{
case T_INTEGER:
- if (integer(x) == s7_int_min)
- return(make_integer(sc, s7_int_max));
- /* (magnitude -9223372036854775808) -> -9223372036854775808
- * same thing happens in abs, lcm and gcd: (gcd -9223372036854775808) -> -9223372036854775808
- */
- if (integer(x) < 0)
- return(make_integer(sc, -integer(x)));
return(x);
case T_RATIO:
- if (numerator(x) < 0)
- return(s7_make_ratio(sc, -numerator(x), denominator(x)));
- return(x);
+ return(make_integer(sc, (s7_int)(numerator(x) / denominator(x)))); /* C "/" already truncates */
case T_REAL:
- if (is_NaN(real(x))) /* (magnitude -nan.0) -> nan.0, not -nan.0 */
- return(real_NaN);
- if (real(x) < 0.0)
- return(make_real(sc, -real(x)));
- return(x);
+ {
+ s7_double z;
+ z = real(x);
+ if (is_NaN(z))
+ return(simple_out_of_range(sc, sc->truncate_symbol, x, its_nan_string));
+ if (is_inf(z))
+ return(simple_out_of_range(sc, sc->truncate_symbol, x, its_infinite_string));
+ return(s7_truncate(sc, sc->truncate_symbol, real(x)));
+ }
case T_COMPLEX:
- return(make_real(sc, my_hypot(imag_part(x), real_part(x))));
-
default:
- method_or_bust_with_type(sc, x, sc->magnitude_symbol, args, a_number_string, 0);
+ method_or_bust_one_arg(sc, x, sc->truncate_symbol, args, T_REAL);
}
}
-IF_TO_IF(magnitude, c_abs_i)
-RF_TO_RF(magnitude, c_abs_r)
+static s7_int truncate_i_i(s7_int i) {return(i);}
+
+static s7_double truncate_d_d(s7_double x)
+{
+ if (is_NaN(x))
+ simple_out_of_range(cur_sc, cur_sc->truncate_symbol, make_real(cur_sc, x), its_nan_string);
+ if (is_inf(x))
+ simple_out_of_range(cur_sc, cur_sc->truncate_symbol, make_real(cur_sc, x), its_infinite_string);
+ if (x > 0.0) return(floor(x));
+ return(ceil(x));
+}
+static s7_int truncate_i_d(s7_double x)
+{
+ return((s7_int)truncate_d_d(x));
+}
-/* -------------------------------- rationalize -------------------------------- */
-static s7_pointer g_rationalize(s7_scheme *sc, s7_pointer args)
+/* -------------------------------- round -------------------------------- */
+static s7_double round_per_R5RS(s7_double x)
{
- #define H_rationalize "(rationalize x err) returns the ratio with lowest denominator within err of x"
- #define Q_rationalize s7_make_signature(sc, 3, sc->is_rational_symbol, sc->is_real_symbol, sc->is_real_symbol)
- s7_double err;
- s7_pointer x;
+ s7_double fl, ce, dfl, dce;
- x = car(args);
- if (!s7_is_real(x))
- method_or_bust(sc, x, sc->rationalize_symbol, args, T_REAL, 1);
+ fl = floor(x);
+ ce = ceil(x);
+ dfl = x - fl;
+ dce = ce - x;
- if (is_not_null(cdr(args)))
- {
- s7_pointer ex;
- ex = cadr(args);
- if (!s7_is_real(ex))
- method_or_bust(sc, ex, sc->rationalize_symbol, args, T_REAL, 2);
+ if (dfl > dce) return(ce);
+ if (dfl < dce) return(fl);
+ if (fmod(fl, 2.0) == 0.0) return(fl);
+ return(ce);
+}
- err = real_to_double(sc, ex, "rationalize");
- if (is_NaN(err))
- return(out_of_range(sc, sc->rationalize_symbol, small_int(2), cadr(args), its_nan_string));
- if (err < 0.0) err = -err;
- }
- else err = sc->default_rationalize_error;
+static s7_pointer g_round(s7_scheme *sc, s7_pointer args)
+{
+ #define H_round "(round x) returns the integer closest to x"
+ #define Q_round s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_real_symbol)
+ s7_pointer x;
+ x = car(args);
switch (type(x))
{
case T_INTEGER:
- {
- s7_int a, b, pa;
- if (err < 1.0) return(x);
- a = s7_integer(x);
- if (a < 0) pa = -a; else pa = a;
- if (err >= pa) return(small_int(0));
- b = (s7_int)err;
- pa -= b;
- if (a < 0)
- return(make_integer(sc, -pa));
- return(make_integer(sc, pa));
- }
+ return(x);
case T_RATIO:
- if (err == 0.0)
- return(x);
-
- case T_REAL:
{
- s7_double rat;
- s7_int numer = 0, denom = 1;
-
- rat = real_to_double(sc, x, "rationalize");
-
- if ((is_NaN(rat)) || (is_inf(rat)))
- return(wrong_type_argument_with_type(sc, sc->rationalize_symbol, 1, x, a_normal_real_string));
-
- if (err >= fabs(rat))
- return(small_int(0));
-
- if ((rat > 9.2233720368548e+18) || (rat < -9.2233720368548e+18))
- return(out_of_range(sc, sc->rationalize_symbol, small_int(1), x, its_too_large_string));
-
- if ((fabs(rat) + fabs(err)) < 1.0e-18)
- err = 1.0e-18;
- /* (/ 1.0 most-positive-fixnum) is 1.0842021e-19, so if we let err be less than that,
- * (rationalize 1e-19 1e-20) hangs, but this only affects the initial ceiling, I believe.
- */
+ s7_int truncated, remains;
+ long double frac;
- if (fabs(rat) < fabs(err))
- return(small_int(0));
+ truncated = numerator(x) / denominator(x);
+ remains = numerator(x) % denominator(x);
+ frac = s7_fabsl((long double)remains / (long double)denominator(x));
- if (c_rationalize(rat, err, &numer, &denom))
- return(s7_make_ratio(sc, numer, denom));
+ if ((frac > 0.5) ||
+ ((frac == 0.5) &&
+ (truncated % 2 != 0)))
+ {
+ if (numerator(x) < 0)
+ return(make_integer(sc, truncated - 1));
+ return(make_integer(sc, truncated + 1));
+ }
+ return(make_integer(sc, truncated));
+ }
- return(sc->F);
+ case T_REAL:
+ {
+ s7_double z;
+ z = real(x);
+ if (is_NaN(z))
+ return(simple_out_of_range(sc, sc->round_symbol, x, its_nan_string));
+ if ((is_inf(z)) ||
+ (z > REAL_TO_INT_LIMIT) ||
+ (z < -REAL_TO_INT_LIMIT))
+ return(simple_out_of_range(sc, sc->round_symbol, x, its_too_large_string));
+ return(make_integer(sc, (s7_int)round_per_R5RS(z)));
}
+
+ case T_COMPLEX:
+ default:
+ method_or_bust_one_arg(sc, x, sc->round_symbol, args, T_REAL);
}
- return(sc->F); /* make compiler happy */
}
-static s7_pointer c_rats(s7_scheme *sc, s7_pointer x) {return(g_rationalize(sc, set_plist_1(sc, x)));}
-PF_TO_PF(rationalize, c_rats)
-
-
-/* -------------------------------- angle -------------------------------- */
-static s7_pointer g_angle(s7_scheme *sc, s7_pointer args)
+static s7_int round_i_i(s7_int i) {return(i);}
+static s7_int round_i_d(s7_double z)
{
- #define H_angle "(angle z) returns the angle of z"
- #define Q_angle s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_number_symbol)
- s7_pointer x;
- /* (angle inf+infi) -> 0.78539816339745 ?
- * I think this should be -pi < ang <= pi
- */
-
- x = car(args);
- switch (type(x))
- {
- case T_INTEGER:
- if (integer(x) < 0)
- return(real_pi);
- return(small_int(0));
-
- case T_RATIO:
- if (numerator(x) < 0)
- return(real_pi);
- return(small_int(0));
+ if (is_NaN(z))
+ simple_out_of_range(cur_sc, cur_sc->round_symbol, make_real(cur_sc, z), its_nan_string);
+ if ((is_inf(z)) ||
+ (z > REAL_TO_INT_LIMIT) ||
+ (z < -REAL_TO_INT_LIMIT))
+ simple_out_of_range(cur_sc, cur_sc->round_symbol, make_real(cur_sc, z), its_too_large_string);
+ return((s7_int)round_per_R5RS(z));
+}
- case T_REAL:
- if (is_NaN(real(x))) return(x);
- if (real(x) < 0.0)
- return(real_pi);
- return(real_zero);
+static s7_double round_d_d(s7_double z)
+{
+ if (is_NaN(z))
+ simple_out_of_range(cur_sc, cur_sc->round_symbol, make_real(cur_sc, z), its_nan_string);
+ if ((is_inf(z)) ||
+ (z > REAL_TO_INT_LIMIT) ||
+ (z < -REAL_TO_INT_LIMIT))
+ simple_out_of_range(cur_sc, cur_sc->round_symbol, make_real(cur_sc, z), its_too_large_string);
+ return(round_per_R5RS(z));
+}
- case T_COMPLEX:
- return(make_real(sc, atan2(imag_part(x), real_part(x))));
- default:
- method_or_bust_with_type(sc, x, sc->angle_symbol, args, a_number_string, 0);
- }
+static s7_int c_mod(s7_int x, s7_int y)
+{
+ s7_int z;
+ if (y == 0) return(x); /* else arithmetic exception */
+ if ((y == 1) || (y == -1)) /* else (modulo most-negative-fixnum -1) will segfault with arithmetic exception */
+ return(0);
+ z = x % y;
+ if (((y < 0) && (z > 0)) ||
+ ((y > 0) && (z < 0)))
+ return(z + y);
+ return(z);
}
+static s7_int modulo_i_ii(s7_int i1, s7_int i2) {return(c_mod(i1, i2));}
+static s7_int modulo_i_ii_direct(s7_int i1, s7_int i2)
+{
+ /* i2 > 1 */
+ s7_int z;
+ z = i1 % i2;
+ if (z < 0)
+ return(z + i2);
+ return(z);
+}
+static s7_double modulo_d_dd(s7_double x1, s7_double x2) {return(x1 - x2 * (s7_int)floor(x1 / x2));}
-/* -------------------------------- make-polar -------------------------------- */
-#if (!WITH_PURE_S7)
-static s7_pointer g_make_polar(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_modulo(s7_scheme *sc, s7_pointer args)
{
+ #define H_modulo "(modulo x1 x2) returns x1 mod x2; (modulo 4 3) = 1. The arguments can be real numbers."
+ #define Q_modulo pcl_r
+ /* (define (mod x1 x2) (- x1 (* x2 (floor (/ x1 x2))))) from slib
+ * (mod x 0) = x according to "Concrete Mathematics"
+ */
s7_pointer x, y;
- s7_double ang, mag;
- #define H_make_polar "(make-polar mag ang) returns a complex number with magnitude mag and angle ang"
- #define Q_make_polar s7_make_signature(sc, 3, sc->is_number_symbol, sc->is_real_symbol, sc->is_real_symbol)
+ s7_double a, b;
+ s7_int n1, n2, d1, d2;
x = car(args);
y = cadr(args);
@@ -14386,34532 +14329,39213 @@ static s7_pointer g_make_polar(s7_scheme *sc, s7_pointer args)
switch (type(y))
{
case T_INTEGER:
- if (integer(x) == 0) return(x); /* (make-polar 0 1) -> 0 */
- if (integer(y) == 0) return(x); /* (make-polar 1 0) -> 1 */
- mag = (s7_double)integer(x);
- ang = (s7_double)integer(y);
- break;
+ return(make_integer(sc, c_mod(integer(x), integer(y))));
case T_RATIO:
- if (integer(x) == 0) return(x);
- mag = (s7_double)integer(x);
- ang = (s7_double)fraction(y);
- break;
+ n1 = integer(x);
+ d1 = 1;
+ n2 = numerator(y);
+ d2 = denominator(y);
+ goto RATIO_MOD_RATIO;
case T_REAL:
- ang = real(y);
- if (ang == 0.0) return(x);
- if (is_NaN(ang)) return(y);
- if (is_inf(ang)) return(real_NaN);
- if ((ang == M_PI) || (ang == -M_PI)) return(make_integer(sc, -integer(x)));
- mag = (s7_double)integer(x);
- break;
+ b = real(y);
+ if (b == 0.0) return(x);
+ if (is_NaN(b)) return(y);
+ if (is_inf(b)) return(real_NaN);
+ a = (s7_double)integer(x);
+ return(make_real(sc, a - b * (s7_int)floor(a / b)));
default:
- method_or_bust(sc, y, sc->make_polar_symbol, args, T_REAL, 2);
+ method_or_bust(sc, y, sc->modulo_symbol, args, T_REAL, 2);
}
- break;
case T_RATIO:
switch (type(y))
{
case T_INTEGER:
if (integer(y) == 0) return(x);
- mag = (s7_double)fraction(x);
- ang = (s7_double)integer(y);
- break;
+ n1 = numerator(x);
+ d1 = denominator(x);
+ n2 = integer(y);
+
+ if ((n2 > 0) && (n1 > 0) && (n2 > n1)) return(x);
+ if ((n2 < 0) && (n1 < 0) && (n2 < n1)) return(x);
+
+ if (n2 == s7_int_min)
+ return(simple_out_of_range(sc, sc->modulo_symbol, y, make_string_wrapper(sc, "intermediate (a/b) is too large")));
+ /* the problem here is that (modulo 3/2 most-negative-fixnum)
+ * will segfault with signal SIGFPE, Arithmetic exception, so try to trap it.
+ */
+
+ d2 = 1;
+ goto RATIO_MOD_RATIO;
case T_RATIO:
- mag = (s7_double)fraction(x);
- ang = (s7_double)fraction(y);
- break;
+ n1 = numerator(x);
+ d1 = denominator(x);
+ n2 = numerator(y); /* can't be 0 */
+ d2 = denominator(y);
+ if (d1 == d2)
+ return(s7_make_ratio(sc, c_mod(n1, n2), d1));
+
+ RATIO_MOD_RATIO:
+
+ if ((n1 == n2) &&
+ (d1 > d2))
+ return(x); /* signs match so this should be ok */
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int n2d1, n1d2, d1d2, fl;
+ if (!multiply_overflow(n2, d1, &n2d1))
+ {
+ if (n2d1 == 1)
+ return(small_int(0));
+
+ if (!multiply_overflow(n1, d2, &n1d2))
+ {
+ /* can't use "floor" here (int->float ruins everything) */
+ fl = (s7_int)(n1d2 / n2d1);
+ if (((n1 < 0) && (n2 > 0)) ||
+ ((n1 > 0) && (n2 < 0)))
+ fl -= 1;
+
+ if (fl == 0)
+ return(x);
+
+ if ((!multiply_overflow(d1, d2, &d1d2)) &&
+ (!multiply_overflow(fl, n2d1, &fl)) &&
+ (!subtract_overflow(n1d2, fl, &fl)))
+ return(s7_make_ratio(sc, fl, d1d2));
+ }
+ }
+ }
+#else
+ {
+ s7_int n1d2, n2d1, fl;
+ n1d2 = n1 * d2;
+ n2d1 = n2 * d1;
+
+ if (n2d1 == 1)
+ return(small_int(0));
+
+ /* can't use "floor" here (int->float ruins everything) */
+ fl = (s7_int)(n1d2 / n2d1);
+ if (((n1 < 0) && (n2 > 0)) ||
+ ((n1 > 0) && (n2 < 0)))
+ fl -= 1;
+
+ if (fl == 0)
+ return(x);
+
+ return(s7_make_ratio(sc, n1d2 - (n2d1 * fl), d1 * d2));
+ }
+#endif
+
+ /* there are cases here we might want to catch:
+ * (modulo 9223372036 1/9223372036) -> error, not 0?
+ * (modulo 1 1/9223372036854775807) -> error, not 0?
+ */
+ return(simple_out_of_range(sc, sc->modulo_symbol, x, make_string_wrapper(sc, "intermediate (a/b) is too large")));
case T_REAL:
- ang = real(y);
- if (ang == 0.0) return(x);
- if (is_NaN(ang)) return(y);
- if (is_inf(ang)) return(real_NaN);
- if ((ang == M_PI) || (ang == -M_PI)) return(s7_make_ratio(sc, -numerator(x), denominator(x)));
- mag = (s7_double)fraction(x);
- break;
+ b = real(y);
+ if (b == 0.0) return(x);
+ if (is_NaN(b)) return(y);
+ if (is_inf(b)) return(real_NaN);
+ a = fraction(x);
+ return(make_real(sc, a - b * (s7_int)floor(a / b)));
default:
- method_or_bust(sc, y, sc->make_polar_symbol, args, T_REAL, 2);
+ method_or_bust(sc, y, sc->modulo_symbol, args, T_REAL, 2);
}
- break;
case T_REAL:
- mag = real(x);
+ a = real(x);
+
switch (type(y))
{
case T_INTEGER:
- if (is_NaN(mag)) return(x);
+ if (is_NaN(a)) return(x);
+ if (is_inf(a)) return(real_NaN);
if (integer(y) == 0) return(x);
- ang = (s7_double)integer(y);
- break;
+ b = (s7_double)integer(y);
+ return(make_real(sc, a - b * (s7_int)floor(a / b)));
case T_RATIO:
- if (is_NaN(mag)) return(x);
- ang = (s7_double)fraction(y);
- break;
+ if (is_NaN(a)) return(x);
+ if (is_inf(a)) return(real_NaN);
+ b = fraction(y);
+ return(make_real(sc, a - b * (s7_int)floor(a / b)));
case T_REAL:
- if (is_NaN(mag)) return(x);
- ang = real(y);
- if (ang == 0.0) return(x);
- if (is_NaN(ang)) return(y);
- if (is_inf(ang)) return(real_NaN);
- break;
+ if (is_NaN(a)) return(x);
+ if (is_inf(a)) return(real_NaN);
+ b = real(y);
+ if (b == 0.0) return(x);
+ if (is_NaN(b)) return(y);
+ if (is_inf(b)) return(real_NaN);
+ return(make_real(sc, a - b * (s7_int)floor(a / b)));
default:
- method_or_bust(sc, y, sc->make_polar_symbol, args, T_REAL, 2);
+ method_or_bust(sc, y, sc->modulo_symbol, args, T_REAL, 2);
}
- break;
default:
- method_or_bust(sc, x, sc->make_polar_symbol, args, T_REAL, 1);
+ method_or_bust(sc, x, sc->modulo_symbol, args, T_REAL, 1);
}
-
- return(s7_make_complex(sc, mag * cos(ang), mag * sin(ang)));
-
- /* since sin is inaccurate for large arguments, so is make-polar:
- * (make-polar 1.0 1e40) -> -0.76267273202438+0.64678458842683i, not 8.218988919070239214448025364432557517335E-1-5.696334009536363273080341815735687231337E-1i
- */
}
-static s7_pointer c_make_polar_2(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_make_polar(sc, set_plist_2(sc, x, y)));}
-PF2_TO_PF(make_polar, c_make_polar_2)
-#endif
+static s7_pointer mod_si;
+static s7_pointer g_mod_si(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x;
+ s7_int y;
+ x = find_symbol_unchecked(sc, car(args));
+ y = integer(cadr(args));
-/* -------------------------------- complex -------------------------------- */
-static s7_pointer g_complex(s7_scheme *sc, s7_pointer args)
+ if (is_integer(x))
+ {
+ s7_int z;
+ /* here we know y is positive */
+ z = integer(x) % y;
+ if (z < 0)
+ return(make_integer(sc, z + y));
+ return(make_integer(sc, z));
+ }
+
+ if (is_t_real(x))
+ {
+ s7_double a, b;
+ a = real(x);
+ if (is_NaN(a)) return(x);
+ if (is_inf(a)) return(real_NaN);
+ b = (s7_double)y;
+ return(make_real(sc, a - b * (s7_int)floor(a / b)));
+ }
+
+ if (s7_is_ratio(x))
+ return(g_modulo(sc, set_plist_2(sc, x, cadr(args))));
+
+ method_or_bust(sc, x, sc->modulo_symbol, list_2(sc, x, cadr(args)), T_REAL, 1);
+}
+#endif
+/* !WITH_GMP */
+
+
+static int reduce_fraction(s7_scheme *sc, s7_int *numer, s7_int *denom)
{
- s7_pointer x, y;
- #define H_complex "(complex x1 x2) returns a complex number with real-part x1 and imaginary-part x2"
- #define Q_complex s7_make_signature(sc, 3, sc->is_number_symbol, sc->is_real_symbol, sc->is_real_symbol)
+ /* we're assuming in several places that we have a normal s7 rational after returning,
+ * so the denominator needs to be positive.
+ */
+ s7_int divisor;
+
+ if (*numer == 0)
+ {
+ *denom = 1;
+ return(T_INTEGER);
+ }
+ if (*denom < 0)
+ {
+ if (*denom == *numer)
+ {
+ *denom = 1;
+ *numer = 1;
+ return(T_INTEGER);
+ }
+ if (*denom == s7_int_min)
+ {
+ if (*numer & 1)
+ return(T_RATIO);
+ *denom /= 2;
+ *numer /= 2;
+ }
+ else
+ {
+ if (*numer == s7_int_min)
+ {
+ if (*denom & 1)
+ return(T_RATIO);
+ *denom /= 2;
+ *numer /= 2;
+ }
+ }
+ *denom = -*denom;
+ *numer = -*numer;
+ }
+ divisor = c_gcd(*numer, *denom);
+ if (divisor != 1)
+ {
+ *numer /= divisor;
+ *denom /= divisor;
+ }
+ if (*denom == 1)
+ return(T_INTEGER);
+ return(T_RATIO);
+}
+
+
+
+/* ---------------------------------------- add ---------------------------------------- */
+
+static s7_pointer g_add(s7_scheme *sc, s7_pointer args)
+{
+ #define H_add "(+ ...) adds its arguments"
+ #define Q_add pcl_n
+ s7_pointer x, p;
+ s7_int num_a, den_a, dn;
+ s7_double rl_a, im_a;
+
+#if (!WITH_GMP)
+ if (is_null(args))
+ return(small_int(0));
+#endif
x = car(args);
- y = cadr(args);
+ p = cdr(args);
+ if (is_null(p))
+ {
+ if (!is_number(x))
+ method_or_bust_with_type_one_arg(sc, x, sc->add_symbol, args, a_number_string);
+ return(x);
+ }
- switch (type(y))
+ switch (type(x))
{
case T_INTEGER:
+ num_a = integer(x);
+
+ ADD_INTEGERS:
+#if WITH_GMP
+ if ((num_a > s7_int32_max) ||
+ (num_a < s7_int32_min))
+ return(big_add(sc, cons(sc, s7_int_to_big_integer(sc, num_a), p)));
+#endif
+ x = car(p);
+ p = cdr(p);
+
switch (type(x))
{
case T_INTEGER:
- if (integer(y) == 0) return(x);
- return(s7_make_complex(sc, (s7_double)integer(x), (s7_double)integer(y)));
+#if HAVE_OVERFLOW_CHECKS
+ if (add_overflow(num_a, integer(x), &den_a))
+ {
+ rl_a = (s7_double)num_a + (s7_double)integer(x);
+ if (is_null(p)) return(make_real(sc, rl_a));
+ goto ADD_REALS;
+ }
+#else
+ den_a = num_a + integer(x);
+ if (den_a < 0)
+ {
+ if ((num_a > 0) && (integer(x) > 0))
+ {
+ rl_a = (s7_double)num_a + (s7_double)integer(x);
+ if (is_null(p)) return(make_real(sc, rl_a));
+ goto ADD_REALS;
+ }
+ }
+ else
+ {
+ if ((num_a < 0) && (integer(x) < 0))
+ {
+ rl_a = (s7_double)num_a + (s7_double)integer(x);
+ if (is_null(p)) return(make_real(sc, rl_a));
+
+ /* this is not ideal! piano.scm has its own noise generator that wants integer
+ * arithmetic to overflow as an integer. Perhaps 'safety==0 would not check
+ * anywhere?
+ */
+ goto ADD_REALS;
+ }
+ }
+#endif
+ if (is_null(p)) return(make_integer(sc, den_a));
+ num_a = den_a;
+ /* (+ 4611686018427387904 4611686018427387904) -> -9223372036854775808
+ * (+ most-positive-fixnum most-positive-fixnum) -> -2
+ * (+ most-negative-fixnum most-negative-fixnum) -> 0
+ * can't check result - arg: (- 0 most-negative-fixnum) -> most-negative-fixnum
+ */
+ goto ADD_INTEGERS;
case T_RATIO:
- if (integer(y) == 0) return(x);
- return(s7_make_complex(sc, (s7_double)fraction(x), (s7_double)integer(y)));
+ den_a = denominator(x);
+#if HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(den_a, num_a, &dn)) ||
+ (add_overflow(dn, numerator(x), &dn)))
+ {
+ if (is_null(p))
+ {
+ if (num_a == 0) /* (+ 0 1/9223372036854775807) */
+ return(x);
+ return(make_real(sc, num_a + fraction(x)));
+ }
+ rl_a = (s7_double)num_a + fraction(x);
+ goto ADD_REALS;
+ }
+#else
+ dn = numerator(x) + (num_a * den_a);
+#endif
+ if (is_null(p)) return(s7_make_ratio(sc, dn, den_a));
+ num_a = dn;
+
+ /* overflow examples:
+ * (+ 100000 1/142857142857140) -> -832205957599110323/28571428571428
+ * (+ 4611686018427387904 3/4) -> 3/4
+ * see s7test for more
+ */
+ goto ADD_RATIOS;
case T_REAL:
- if (integer(y) == 0) return(x);
- return(s7_make_complex(sc, real(x), (s7_double)integer(y)));
+ if (is_null(p)) return(make_real(sc, num_a + real(x)));
+ rl_a = (s7_double)num_a + real(x);
+ goto ADD_REALS;
+
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, num_a + real_part(x), imag_part(x)));
+ rl_a = (s7_double)num_a + real_part(x);
+ im_a = imag_part(x);
+ goto ADD_COMPLEX;
default:
- method_or_bust(sc, x, sc->complex_symbol, args, T_REAL, 1);
+ 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);
}
+ break;
case T_RATIO:
+ num_a = numerator(x);
+ den_a = denominator(x);
+ ADD_RATIOS:
+#if WITH_GMP
+ if ((num_a > s7_int32_max) ||
+ (den_a > s7_int32_max) ||
+ (num_a < s7_int32_min))
+ return(big_add(sc, cons(sc, s7_ratio_to_big_ratio(sc, num_a, den_a), p)));
+#endif
+ x = car(p);
+ p = cdr(p);
+
switch (type(x))
{
- case T_INTEGER: return(s7_make_complex(sc, (s7_double)integer(x), (s7_double)fraction(y)));
- case T_RATIO: return(s7_make_complex(sc, (s7_double)fraction(x), (s7_double)fraction(y)));
- case T_REAL: return(s7_make_complex(sc, real(x), (s7_double)fraction(y)));
+ case T_INTEGER:
+#if HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(den_a, integer(x), &dn)) ||
+ (add_overflow(dn, num_a, &dn)))
+ {
+ /* (+ 3/4 4611686018427387904) -> 3/4
+ * (+ 1/17179869184 1073741824) -> 1/17179869184
+ * (+ 1/8589934592 1073741824) -> -9223372036854775807/8589934592
+ */
+ if (is_null(p))
+ return(make_real(sc, (s7_double)integer(x) + ((long double)num_a / (long double)den_a)));
+ rl_a = (s7_double)integer(x) + ((long double)num_a / (long double)den_a);
+ goto ADD_REALS;
+ }
+#else
+ dn = num_a + (integer(x) * den_a);
+#endif
+ if (is_null(p)) return(s7_make_ratio(sc, dn, den_a));
+ num_a = dn;
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto ADD_INTEGERS;
+ goto ADD_RATIOS;
+
+ case T_RATIO:
+ {
+ s7_int d1, d2, n1, n2;
+ d1 = den_a;
+ n1 = num_a;
+ d2 = denominator(x);
+ n2 = numerator(x);
+ if (d1 == d2) /* the easy case -- if overflow here, it matches the int case */
+ {
+ if (is_null(p))
+ return(s7_make_ratio(sc, n1 + n2, d1));
+ num_a += n2; /* d1 can't be zero */
+ }
+ else
+ {
+#if (!WITH_GMP)
+#if HAVE_OVERFLOW_CHECKS
+ s7_int n1d2, n2d1;
+ if ((multiply_overflow(d1, d2, &den_a)) ||
+ (multiply_overflow(n1, d2, &n1d2)) ||
+ (multiply_overflow(n2, d1, &n2d1)) ||
+ (add_overflow(n1d2, n2d1, &num_a)))
+ {
+ if (is_null(p))
+ return(make_real(sc, ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2)));
+ rl_a = ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2);
+ goto ADD_REALS;
+ }
+#else
+ num_a = n1 * d2 + n2 * d1;
+ den_a = d1 * d2;
+#endif
+#else
+ num_a = n1 * d2 + n2 * d1;
+ den_a = d1 * d2;
+#endif
+ if (is_null(p))
+ return(s7_make_ratio(sc, num_a, den_a));
+ }
+ /* (+ 1/100 99/100 (- most-positive-fixnum 2)) should not be converted to real
+ */
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto ADD_INTEGERS;
+ goto ADD_RATIOS;
+ }
+
+ case T_REAL:
+ if (is_null(p)) return(make_real(sc, ((long double)num_a / (long double)den_a) + real(x)));
+ rl_a = ((long double)num_a / (long double)den_a) + real(x);
+ goto ADD_REALS;
+
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, ((long double)num_a / (long double)den_a) + real_part(x), imag_part(x)));
+ rl_a = ((long double)num_a / (long double)den_a) + real_part(x);
+ im_a = imag_part(x);
+ goto ADD_COMPLEX;
+
default:
- method_or_bust(sc, x, sc->complex_symbol, args, T_REAL, 1);
+ 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);
}
+ break;
case T_REAL:
+ rl_a = real(x);
+
+ ADD_REALS:
+ x = car(p);
+ p = cdr(p);
+
switch (type(x))
{
case T_INTEGER:
- if (real(y) == 0.0) return(x);
- return(s7_make_complex(sc, (s7_double)integer(x), real(y)));
+ if (is_null(p)) return(make_real(sc, rl_a + integer(x)));
+ rl_a += (s7_double)integer(x);
+ goto ADD_REALS;
case T_RATIO:
- if (real(y) == 0.0) return(x);
- return(s7_make_complex(sc, (s7_double)fraction(x), real(y)));
+ if (is_null(p)) return(make_real(sc, rl_a + fraction(x)));
+ rl_a += (s7_double)fraction(x);
+ goto ADD_REALS;
case T_REAL:
- if (real(y) == 0.0) return(x);
- return(s7_make_complex(sc, real(x), real(y)));
+ if (is_null(p)) return(make_real(sc, rl_a + real(x)));
+ rl_a += real(x);
+ goto ADD_REALS;
+
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a + real_part(x), imag_part(x)));
+ rl_a += real_part(x);
+ im_a = imag_part(x);
+ goto ADD_COMPLEX;
default:
- method_or_bust(sc, x, sc->complex_symbol, args, T_REAL, 1);
+ 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);
}
+ break;
- default:
- method_or_bust(sc, (is_let(x)) ? x : y, sc->complex_symbol, args, T_REAL, 2);
- }
-}
-
-static s7_pointer c_make_complex_2(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_complex(sc, set_plist_2(sc, x, y)));}
-PF2_TO_PF(make_complex, c_make_complex_2)
-
+ case T_COMPLEX:
+ rl_a = real_part(x);
+ im_a = imag_part(x);
-/* -------------------------------- exp -------------------------------- */
-static s7_pointer g_exp(s7_scheme *sc, s7_pointer args)
-{
- #define H_exp "(exp z) returns e^z, (exp 1) is 2.718281828459"
- #define Q_exp pcl_n
+ ADD_COMPLEX:
+ x = car(p);
+ p = cdr(p);
- s7_pointer x;
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a + integer(x), im_a));
+ rl_a += (s7_double)integer(x);
+ goto ADD_COMPLEX;
- x = car(args);
- switch (type(x))
- {
- case T_INTEGER:
- if (integer(x) == 0) return(small_int(1)); /* (exp 0) -> 1 */
- return(make_real(sc, exp((s7_double)(integer(x)))));
+ case T_RATIO:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a + fraction(x), im_a));
+ rl_a += (s7_double)fraction(x);
+ goto ADD_COMPLEX;
- case T_RATIO:
- return(make_real(sc, exp((s7_double)fraction(x))));
+ case T_REAL:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a + real(x), im_a));
+ rl_a += real(x);
+ goto ADD_COMPLEX;
- case T_REAL:
- return(make_real(sc, exp(real(x))));
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a + real_part(x), im_a + imag_part(x)));
+ rl_a += real_part(x);
+ im_a += imag_part(x);
+ if (im_a == 0.0)
+ goto ADD_REALS;
+ goto ADD_COMPLEX;
- case T_COMPLEX:
-#if HAVE_COMPLEX_NUMBERS
- return(s7_from_c_complex(sc, cexp(as_c_complex(x))));
- /* this is inaccurate for large arguments:
- * (exp 0+1e20i) -> -0.66491178990701-0.74692189125949i, not 7.639704044417283004001468027378811228331E-1-6.45251285265780844205811711312523007406E-1i
- */
-#else
- return(out_of_range(sc, sc->exp_symbol, small_int(1), x, no_complex_numbers_string));
-#endif
+ 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);
+ }
+ break;
default:
- method_or_bust_with_type(sc, x, sc->exp_symbol, args, a_number_string, 0);
+ method_or_bust_with_type(sc, x, sc->add_symbol, args, a_number_string, 1);
}
}
-DIRECT_RF_TO_RF(exp)
+static s7_pointer add_2, add_1s, add_s1, add_cs1, add_cl1, add_si, add_sf, add_fs;
-/* -------------------------------- log -------------------------------- */
+static s7_pointer add_ratios(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ s7_int d1, d2, n1, n2;
+ d1 = number_to_denominator(x);
+ n1 = number_to_numerator(x);
+ d2 = number_to_denominator(y);
+ n2 = number_to_numerator(y);
-#if __cplusplus
-#define LOG_2 1.4426950408889634074
+ if (d1 == d2) /* the easy case -- if overflow here, it matches the int case */
+ return(s7_make_ratio(sc, n1 + n2, d1));
+
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int n1d2, n2d1, d1d2, dn;
+ if ((multiply_overflow(d1, d2, &d1d2)) ||
+ (multiply_overflow(n1, d2, &n1d2)) ||
+ (multiply_overflow(n2, d1, &n2d1)) ||
+ (add_overflow(n1d2, n2d1, &dn)))
+ return(make_real(sc, ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2)));
+ return(s7_make_ratio(sc, dn, d1d2));
+ }
#else
-#define LOG_2 1.4426950408889634073599246810018921L /* (/ (log 2.0)) */
+ return(s7_make_ratio(sc, n1 * d2 + n2 * d1, d1 * d2));
#endif
+}
-static s7_pointer g_log(s7_scheme *sc, s7_pointer args)
-{
- #define H_log "(log z1 (z2 e)) returns log(z1) / log(z2) where z2 (the base) defaults to e: (log 8 2) = 3"
- #define Q_log pcl_n
- s7_pointer x;
+static s7_pointer g_add_2(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x, y;
x = car(args);
- if (!s7_is_number(x))
- method_or_bust_with_type(sc, x, sc->log_symbol, args, a_number_string, 1);
+ y = cadr(args);
- if (is_pair(cdr(args)))
+ if (type(x) == type(y))
{
- s7_pointer y;
-
- y = cadr(args);
- if (!(s7_is_number(y)))
- method_or_bust_with_type(sc, y, sc->log_symbol, args, a_number_string, 2);
-
- if (y == small_int(2))
+ if (is_t_real(x))
+ return(make_real(sc, real(x) + real(y)));
+ else
{
- /* (define (2^n? x) (and (not (zero? x)) (zero? (logand x (- x 1))))) */
- if (is_integer(x))
+ switch (type(x))
{
- s7_int ix;
- ix = s7_integer(x);
- if (ix > 0)
- {
- s7_double fx;
-#if (__ANDROID__) || (MS_WINDOWS) || ((__GNUC__) && ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ <= 4))))
- /* just a guess -- log2 gets a warning in gcc 4.3.2, but not in 4.4.4 */
- fx = log((double)ix) / log(2.0);
-#else
- fx = log2((double)ix);
-#endif
- /* (s7_int)fx rounds (log 8 2) to 2 in FreeBSD! */
-#if ((__GNUC__) && ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ < 4))))
- return(make_real(sc, fx));
+#if HAVE_OVERFLOW_CHECKS
+ case T_INTEGER:
+ {
+ s7_int val;
+ if (add_overflow(integer(x), integer(y), &val))
+ return(make_real(sc, (double)integer(x) + (double)integer(y)));
+ return(make_integer(sc, val));
+ }
#else
- if ((ix & (ix - 1)) == 0)
- return(make_integer(sc, (s7_int)s7_round(fx)));
- return(make_real(sc, fx));
+ case T_INTEGER: return(make_integer(sc, integer(x) + integer(y)));
#endif
- }
+ case T_RATIO: return(add_ratios(sc, x, y));
+ case T_REAL: return(make_real(sc, real(x) + real(y)));
+ case T_COMPLEX: return(make_complex(sc, real_part(x) + real_part(y), imag_part(x) + imag_part(y)));
+ default:
+ if (!is_number(x))
+ method_or_bust_with_type(sc, x, sc->add_symbol, args, a_number_string, 1);
+ method_or_bust_with_type(sc, y, sc->add_symbol, args, a_number_string, 2);
}
- if ((s7_is_real(x)) &&
- (s7_is_positive(x)))
- return(make_real(sc, log(real_to_double(sc, x, "log")) * LOG_2));
- return(s7_from_c_complex(sc, clog(s7_to_c_complex(x)) * LOG_2));
}
+ }
- if ((x == small_int(1)) && (y == small_int(1))) /* (log 1 1) -> 0 (this is NaN in the bignum case) */
- return(small_int(0));
-
- /* (log 1 0) must be 0 since everyone says (expt 0 0) is 1 */
- if (s7_is_zero(y))
+ switch (type(x))
+ {
+ case T_INTEGER:
+ switch (type(y))
{
- if ((y == small_int(0)) &&
- (x == small_int(1)))
- return(y);
- return(out_of_range(sc, sc->log_symbol, small_int(2), y, make_string_wrapper(sc, "can't be 0")));
+ case T_INTEGER: return(make_integer(sc, integer(x) + integer(y)));
+ case T_RATIO: return(add_ratios(sc, x, y));
+ case T_REAL: return(make_real(sc, integer(x) + real(y)));
+ case T_COMPLEX: return(make_complex(sc, integer(x) + real_part(y), imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->add_symbol, args, a_number_string, 2);
}
- if (s7_is_one(y)) /* this used to raise an error, but the bignum case is simpler if we return inf */
+ case T_RATIO:
+ switch (type(y))
{
- if (s7_is_one(x)) /* but (log 1.0 1.0) -> 0.0 */
- return(real_zero);
- return(real_infinity); /* currently (log 1/0 1) is inf? */
+ case T_INTEGER:
+ case T_RATIO: return(add_ratios(sc, x, y));
+ case T_REAL: return(make_real(sc, fraction(x) + real(y)));
+ case T_COMPLEX: return(s7_make_complex(sc, fraction(x) + real_part(y), imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->add_symbol, args, a_number_string, 2);
}
- if ((s7_is_real(x)) &&
- (s7_is_real(y)) &&
- (s7_is_positive(x)) &&
- (s7_is_positive(y)))
+ case T_REAL:
+ switch (type(y))
{
- if ((s7_is_rational(x)) &&
- (s7_is_rational(y)))
- {
- s7_double res;
- s7_int ires;
- res = log(rational_to_double(sc, x)) / log(rational_to_double(sc, y));
- ires = (s7_int)res;
- if (res - ires == 0.0)
- return(make_integer(sc, ires)); /* (log 8 2) -> 3 or (log 1/8 2) -> -3 */
- return(make_real(sc, res)); /* perhaps use rationalize here? (log 2 8) -> 1/3 */
- }
- return(make_real(sc, log(real_to_double(sc, x, "log")) / log(real_to_double(sc, y, "log"))));
+ case T_INTEGER: return(make_real(sc, real(x) + integer(y)));
+ case T_RATIO: return(make_real(sc, real(x) + fraction(y)));
+ case T_REAL: return(make_real(sc, real(x) + real(y)));
+ case T_COMPLEX: return(make_complex(sc, real(x) + real_part(y), imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->add_symbol, args, a_number_string, 2);
}
- return(s7_from_c_complex(sc, clog(s7_to_c_complex(x)) / clog(s7_to_c_complex(y))));
- }
- if (s7_is_real(x))
- {
- if (s7_is_positive(x))
- return(make_real(sc, log(real_to_double(sc, x, "log"))));
- return(s7_make_complex(sc, log(-real_to_double(sc, x, "log")), M_PI));
+ case T_COMPLEX:
+ switch (type(y))
+ {
+ case T_INTEGER: return(s7_make_complex(sc, real_part(x) + integer(y), imag_part(x)));
+ case T_RATIO: return(s7_make_complex(sc, real_part(x) + fraction(y), imag_part(x)));
+ case T_REAL: return(s7_make_complex(sc, real_part(x) + real(y), imag_part(x)));
+ case T_COMPLEX: return(make_complex(sc, real_part(x) + real_part(y), imag_part(x) + imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->add_symbol, args, a_number_string, 2);
+ }
+
+ default:
+ method_or_bust_with_type(sc, x, sc->add_symbol, args, a_number_string, 1);
}
- return(s7_from_c_complex(sc, clog(s7_to_c_complex(x))));
+ return(x);
}
-
-/* -------------------------------- sin -------------------------------- */
-static s7_pointer g_sin(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_add_s1_1(s7_scheme *sc, s7_pointer x, s7_pointer args)
{
- #define H_sin "(sin z) returns sin(z)"
- #define Q_sin pcl_n
-
- s7_pointer x;
- x = car(args);
switch (type(x))
{
- case T_REAL:
- return(make_real(sc, sin(real(x))));
-
+#if HAVE_OVERFLOW_CHECKS
case T_INTEGER:
- if (integer(x) == 0) return(small_int(0)); /* (sin 0) -> 0 */
- return(make_real(sc, sin((s7_double)integer(x))));
-
- case T_RATIO:
- return(make_real(sc, sin((s7_double)(fraction(x)))));
-
- case T_COMPLEX:
-#if HAVE_COMPLEX_NUMBERS
- return(s7_from_c_complex(sc, csin(as_c_complex(x))));
+ {
+ s7_int val;
+ if (add_overflow(integer(x), 1, &val))
+ return(make_real(sc, (double)integer(x) + 1.0));
+ return(make_integer(sc, val));
+ }
#else
- return(out_of_range(sc, sc->sin_symbol, small_int(1), x, no_complex_numbers_string));
+ case T_INTEGER: return(make_integer(sc, integer(x) + 1));
#endif
-
+ case T_RATIO: return(add_ratios(sc, x, small_int(1)));
+ case T_REAL: return(make_real(sc, real(x) + 1.0));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) + 1.0, imag_part(x)));
default:
- method_or_bust_with_type(sc, x, sc->sin_symbol, args, a_number_string, 0);
+ method_or_bust_with_type(sc, x, sc->add_symbol, cons(sc, x, cdr(args)), a_number_string, 1);
}
-
- /* sin is totally inaccurate over about 1e18. There's a way to get true results,
- * but it involves fancy "range reduction" techniques.
- * This means that lots of things are inaccurate:
- * (sin (remainder 1e22 (* 2 pi)))
- * -0.57876806033477
- * but it should be -8.522008497671888065747423101326159661908E-1
- * ---
- * (remainder 1e22 (* 2 pi)) -> 1.0057952155665e+22 !!
- * it should be 5.263007914620499494429139986095833592117E0
- */
+ return(x);
}
-DIRECT_RF_TO_RF(sin)
-
-
-/* -------------------------------- cos -------------------------------- */
-static s7_pointer g_cos(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_add_s1(s7_scheme *sc, s7_pointer args)
{
- #define H_cos "(cos z) returns cos(z)"
- #define Q_cos pcl_n
-
s7_pointer x;
x = car(args);
- switch (type(x))
- {
- case T_REAL:
- return(make_real(sc, cos(real(x))));
-
- case T_INTEGER:
- if (integer(x) == 0) return(small_int(1)); /* (cos 0) -> 1 */
- return(make_real(sc, cos((s7_double)integer(x))));
-
- case T_RATIO:
- return(make_real(sc, cos((s7_double)(fraction(x)))));
-
- case T_COMPLEX:
-#if HAVE_COMPLEX_NUMBERS
- return(s7_from_c_complex(sc, ccos(as_c_complex(x))));
-#else
- return(out_of_range(sc, sc->cos_symbol, small_int(1), x, no_complex_numbers_string));
-#endif
-
- default:
- method_or_bust_with_type(sc, x, sc->cos_symbol, args, a_number_string, 0);
- }
+ if (is_t_integer(x))
+ return(make_integer(sc, integer(x) + 1));
+ return(g_add_s1_1(sc, x, args));
}
-DIRECT_RF_TO_RF(cos)
-
-
-/* -------------------------------- tan -------------------------------- */
-static s7_pointer g_tan(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_add_cs1(s7_scheme *sc, s7_pointer args)
{
- #define H_tan "(tan z) returns tan(z)"
- #define Q_tan pcl_n
-
s7_pointer x;
- x = car(args);
- switch (type(x))
- {
- case T_REAL:
- return(make_real(sc, tan(real(x))));
+ x = find_symbol_unchecked(sc, car(args));
+ if (is_integer(x))
+ return(make_integer(sc, integer(x) + 1));
+ return(g_add_s1_1(sc, x, args));
+}
- case T_INTEGER:
- if (integer(x) == 0) return(small_int(0)); /* (tan 0) -> 0 */
- return(make_real(sc, tan((s7_double)(integer(x)))));
+static s7_pointer g_add_cl1(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x;
+ x = local_symbol_value(car(args));
+ if (is_integer(x))
+ return(make_integer(sc, integer(x) + 1));
+ return(g_add_s1_1(sc, x, args));
+}
- case T_RATIO:
- return(make_real(sc, tan((s7_double)(fraction(x)))));
+static s7_pointer g_add_1s(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x;
- case T_COMPLEX:
-#if HAVE_COMPLEX_NUMBERS
- if (imag_part(x) > 350.0)
- return(s7_make_complex(sc, 0.0, 1.0));
- if (imag_part(x) < -350.0)
- return(s7_make_complex(sc, 0.0, -1.0));
- return(s7_from_c_complex(sc, ctan(as_c_complex(x))));
-#else
- return(out_of_range(sc, sc->tan_symbol, small_int(1), x, no_complex_numbers_string));
-#endif
+ x = cadr(args);
+ if (is_integer(x))
+ return(make_integer(sc, integer(x) + 1));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_integer(sc, integer(x) + 1));
+ case T_RATIO: return(add_ratios(sc, x, small_int(1)));
+ case T_REAL: return(make_real(sc, real(x) + 1.0));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) + 1.0, imag_part(x)));
default:
- method_or_bust_with_type(sc, x, sc->tan_symbol, args, a_number_string, 0);
+ method_or_bust_with_type(sc, x, sc->add_symbol, args, a_number_string, 2);
}
+ return(x);
}
-DIRECT_RF_TO_RF(tan)
-
-
-/* -------------------------------- asin -------------------------------- */
-static s7_pointer c_asin(s7_scheme *sc, s7_double x)
+static s7_pointer g_add_si(s7_scheme *sc, s7_pointer args)
{
- s7_double absx, recip;
- s7_complex result;
-
- absx = fabs(x);
- if (absx <= 1.0)
- return(make_real(sc, asin(x)));
-
- /* otherwise use maxima code: */
- recip = 1.0 / absx;
- result = (M_PI / 2.0) - (_Complex_I * clog(absx * (1.0 + (sqrt(1.0 + recip) * csqrt(1.0 - recip)))));
- if (x < 0.0)
- return(s7_from_c_complex(sc, -result));
- return(s7_from_c_complex(sc, result));
-}
+ s7_pointer x;
+ s7_int n;
-static s7_pointer g_asin_1(s7_scheme *sc, s7_pointer n)
-{
- switch (type(n))
+ x = find_symbol_unchecked(sc, car(args));
+ n = integer(cadr(args));
+ if (is_integer(x))
+#if HAVE_OVERFLOW_CHECKS
{
- case T_INTEGER:
- if (integer(n) == 0) return(small_int(0)); /* (asin 0) -> 0 */
- /* in netBSD, (asin 2) returns 0.25383842987008+0.25383842987008i according to Peter Bex */
- return(c_asin(sc, (s7_double)integer(n)));
-
- case T_RATIO:
- return(c_asin(sc, (s7_double)numerator(n) / (s7_double)denominator(n)));
-
- case T_REAL:
- return(c_asin(sc, real(n)));
-
- case T_COMPLEX:
-#if HAVE_COMPLEX_NUMBERS
- /* if either real or imag part is very large, use explicit formula, not casin */
- /* this code taken from sbcl's src/code/irrat.lisp */
- /* break is around x+70000000i */
-
- if ((fabs(real_part(n)) > 1.0e7) ||
- (fabs(imag_part(n)) > 1.0e7))
- {
- s7_complex sq1mz, sq1pz, z;
- z = as_c_complex(n);
- sq1mz = csqrt(1.0 - z);
- sq1pz = csqrt(1.0 + z);
- return(s7_make_complex(sc, atan(real_part(n) / creal(sq1mz * sq1pz)), asinh(cimag(sq1pz * conj(sq1mz)))));
- }
- return(s7_from_c_complex(sc, casin(as_c_complex(n))));
+ s7_int val;
+ if (add_overflow(integer(x), n, &val))
+ return(make_real(sc, (double)integer(x) + (double)n));
+ return(make_integer(sc, val));
+ }
#else
- return(out_of_range(sc, sc->asin_symbol, small_int(1), n, no_complex_numbers_string));
+ return(make_integer(sc, integer(x) + n));
#endif
-
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_integer(sc, integer(x) + n));
+ case T_RATIO: return(add_ratios(sc, x, cadr(args)));
+ case T_REAL: return(make_real(sc, real(x) + n));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) + n, imag_part(x)));
default:
- method_or_bust_with_type(sc, n, sc->asin_symbol, list_1(sc, n), a_number_string, 0);
+ method_or_bust_with_type(sc, x, sc->add_symbol, list_2(sc, x, cadr(args)), a_number_string, 1);
}
+ return(x);
}
-static s7_pointer g_asin(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_add_sf(s7_scheme *sc, s7_pointer args)
{
- #define H_asin "(asin z) returns asin(z); (sin (asin x)) = x"
- #define Q_asin pcl_n
+ s7_pointer x;
+ s7_double n;
- return(g_asin_1(sc, car(args)));
+ x = find_symbol_unchecked(sc, car(args));
+ n = real(cadr(args));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_real(sc, integer(x) + n));
+ case T_RATIO: return(make_real(sc, fraction(x) + n));
+ case T_REAL: return(make_real(sc, real(x) + n));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) + n, imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->add_symbol, list_2(sc, x, cadr(args)), a_number_string, 1);
+ }
+ return(x);
}
-R_P_F_TO_PF(asin, c_asin, g_asin_1, g_asin_1)
-/* g_asin_1 is safe for the gf case because it won't trigger the GC before it is done with its argument */
-
-
-/* -------------------------------- acos -------------------------------- */
-static s7_pointer c_acos(s7_scheme *sc, s7_double x)
+static s7_pointer g_add_fs(s7_scheme *sc, s7_pointer args)
{
- s7_double absx, recip;
- s7_complex result;
-
- absx = fabs(x);
- if (absx <= 1.0)
- return(make_real(sc, acos(x)));
+ s7_pointer x;
+ s7_double n;
- /* else follow maxima again: */
- recip = 1.0 / absx;
- if (x > 0.0)
- result = _Complex_I * clog(absx * (1.0 + (sqrt(1.0 + recip) * csqrt(1.0 - recip))));
- else result = M_PI - _Complex_I * clog(absx * (1.0 + (sqrt(1.0 + recip) * csqrt(1.0 - recip))));
- return(s7_from_c_complex(sc, result));
+ x = find_symbol_unchecked(sc, cadr(args));
+ n = real(car(args));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_real(sc, integer(x) + n));
+ case T_RATIO: return(make_real(sc, fraction(x) + n));
+ case T_REAL: return(make_real(sc, real(x) + n));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) + n, imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->add_symbol, list_2(sc, x, car(args)), a_number_string, 2);
+ }
+ return(x);
}
-static s7_pointer g_acos_1(s7_scheme *sc, s7_pointer n)
+static s7_pointer add_f_sf;
+static s7_pointer g_add_f_sf(s7_scheme *sc, s7_pointer args)
{
- switch (type(n))
- {
- case T_INTEGER:
- if (integer(n) == 1) return(small_int(0));
- return(c_acos(sc, (s7_double)integer(n)));
-
- case T_RATIO:
- return(c_acos(sc, (s7_double)numerator(n) / (s7_double)denominator(n)));
-
- case T_REAL:
- return(c_acos(sc, real(n)));
+ /* (+ x (* s y)) */
+ s7_pointer vargs, s;
+ s7_double x, y;
- case T_COMPLEX:
-#if HAVE_COMPLEX_NUMBERS
- /* if either real or imag part is very large, use explicit formula, not cacos */
- /* this code taken from sbcl's src/code/irrat.lisp */
+ x = real(car(args));
+ vargs = cdadr(args);
+ s = find_symbol_unchecked(sc, car(vargs));
+ y = real(cadr(vargs));
- if ((fabs(real_part(n)) > 1.0e7) ||
- (fabs(imag_part(n)) > 1.0e7))
- {
- s7_complex sq1mz, sq1pz, z;
- z = as_c_complex(n);
- sq1mz = csqrt(1.0 - z);
- sq1pz = csqrt(1.0 + z);
- return(s7_make_complex(sc, 2.0 * atan(creal(sq1mz) / creal(sq1pz)), asinh(cimag(sq1mz * conj(sq1pz)))));
- }
- return(s7_from_c_complex(sc, cacos(s7_to_c_complex(n))));
-#else
- return(out_of_range(sc, sc->acos_symbol, small_int(1), n, no_complex_numbers_string));
-#endif
+ if (is_t_real(s))
+ return(make_real(sc, x + (real(s) * y)));
+ switch (type(s))
+ {
+ case T_INTEGER: return(make_real(sc, x + (integer(s) * y)));
+ case T_RATIO: return(make_real(sc, x + (fraction(s) * y)));
+ case T_REAL: return(make_real(sc, x + real(s) * y));
+ case T_COMPLEX: return(s7_make_complex(sc, x + (real_part(s) * y), imag_part(s) * y));
default:
- method_or_bust_with_type(sc, n, sc->acos_symbol, list_1(sc, n), a_number_string, 0);
+ {
+ s7_pointer func;
+ if ((func = find_method(sc, find_let(sc, s), sc->multiply_symbol)) != sc->undefined)
+ return(g_add_2(sc, set_plist_2(sc, car(args), s7_apply_function(sc, func, list_2(sc, s, cadr(vargs))))));
+ return(wrong_type_argument_with_type(sc, sc->multiply_symbol, 1, s, a_number_string));
+ }
}
+ return(s);
}
-static s7_pointer g_acos(s7_scheme *sc, s7_pointer args)
-{
- #define H_acos "(acos z) returns acos(z); (cos (acos 1)) = 1"
- #define Q_acos pcl_n
- return(g_acos_1(sc, car(args)));
-}
-R_P_F_TO_PF(acos, c_acos, g_acos_1, g_acos_1)
+static s7_double add_d_d(s7_double x) {return(x);}
+static s7_double add_d_dd(s7_double x1, s7_double x2) {return(x1 + x2);}
+static s7_double add_d_ddd(s7_double x1, s7_double x2, s7_double x3) {return(x1 + x2 + x3);}
+static s7_double add_d_dddd(s7_double x1, s7_double x2, s7_double x3, s7_double x4) {return(x1 + x2 + x3 + x4);}
+static s7_int add_i_ii(s7_int i1, s7_int i2) {return(i1 + i2);}
+static s7_int add_i_iii(s7_int i1, s7_int i2, s7_int i3) {return(i1 + i2 + i3);}
-/* -------------------------------- atan -------------------------------- */
+static s7_pointer add_p_pp(s7_pointer p1, s7_pointer p2) {return(g_add_2(cur_sc, set_plist_2(cur_sc, p1, p2)));}
-static s7_double c_atan(s7_scheme *sc, s7_double x, s7_double y)
-{
- return(atan2(x, y));
-}
-static s7_pointer g_atan(s7_scheme *sc, s7_pointer args)
+/* ---------------------------------------- subtract ---------------------------------------- */
+
+static s7_pointer g_subtract(s7_scheme *sc, s7_pointer args)
{
- #define H_atan "(atan z) returns atan(z), (atan y x) returns atan(y/x)"
- #define Q_atan s7_make_signature(sc, 3, sc->is_number_symbol, sc->is_number_symbol, sc->is_real_symbol)
- /* actually if there are two args, both should be real, but how to express that in the signature? */
- s7_pointer x, y;
- s7_double x1, x2;
+ #define H_subtract "(- x1 ...) subtracts its trailing arguments from the first, or negates the first if only one it is given"
+ #define Q_subtract pcl_n
- /* currently (atan inf.0 inf.0) -> 0.78539816339745, and (atan inf.0 -inf.0) -> 2.3561944901923 (etc) */
+ s7_pointer x, p;
+ s7_int num_a, den_a;
+ s7_double rl_a, im_a;
x = car(args);
- if (!is_pair(cdr(args)))
- {
- switch (type(x))
- {
- case T_INTEGER:
- if (integer(x) == 0) return(small_int(0)); /* (atan 0) -> 0 */
-
- case T_RATIO:
- case T_REAL:
- return(make_real(sc, atan(real_to_double(sc, x, "atan"))));
-
- case T_COMPLEX:
-#if HAVE_COMPLEX_NUMBERS
- return(s7_from_c_complex(sc, catan(as_c_complex(x))));
-#else
- return(out_of_range(sc, sc->atan_symbol, small_int(1), x, no_complex_numbers_string));
-#endif
+ p = cdr(args);
- default:
- method_or_bust_with_type(sc, x, sc->atan_symbol, args, a_number_string, 0);
- }
+#if (!WITH_GMP)
+ if (is_null(p))
+ {
+ if (!is_number(x))
+ method_or_bust_with_type_one_arg(sc, x, sc->subtract_symbol, args, a_number_string);
+ return(s7_negate(sc, x));
}
+#endif
- if (!s7_is_real(x))
- method_or_bust(sc, x, sc->atan_symbol, args, T_REAL, 1);
-
- y = cadr(args);
- if (!s7_is_real(y))
- method_or_bust(sc, y, sc->atan_symbol, args, T_REAL, 2);
-
- x1 = real_to_double(sc, x, "atan");
- x2 = real_to_double(sc, y, "atan");
- return(make_real(sc, atan2(x1, x2)));
-}
-
-RF2_TO_RF(atan, c_atan)
-
-
-/* -------------------------------- sinh -------------------------------- */
-static s7_pointer g_sinh(s7_scheme *sc, s7_pointer args)
-{
- #define H_sinh "(sinh z) returns sinh(z)"
- #define Q_sinh pcl_n
-
- s7_pointer x;
- x = car(args);
switch (type(x))
{
case T_INTEGER:
- if (integer(x) == 0) return(small_int(0)); /* (sinh 0) -> 0 */
+ num_a = integer(x);
- case T_REAL:
- case T_RATIO:
- return(make_real(sc, sinh(real_to_double(sc, x, "sinh"))));
+ SUBTRACT_INTEGERS:
+#if WITH_GMP
+ if ((num_a > s7_int32_max) ||
+ (num_a < s7_int32_min))
+ return(big_subtract(sc, cons(sc, s7_int_to_big_integer(sc, num_a), p)));
+#endif
+ x = car(p);
+ p = cdr(p);
- case T_COMPLEX:
-#if HAVE_COMPLEX_NUMBERS
- return(s7_from_c_complex(sc, csinh(as_c_complex(x))));
+ switch (type(x))
+ {
+ case T_INTEGER:
+#if HAVE_OVERFLOW_CHECKS
+ if (subtract_overflow(num_a, integer(x), &den_a))
+ {
+ rl_a = (s7_double)num_a - (s7_double)integer(x);
+ if (is_null(p)) return(make_real(sc, rl_a));
+ goto SUBTRACT_REALS;
+ }
#else
- return(out_of_range(sc, sc->sinh_symbol, small_int(1), x, no_complex_numbers_string));
+ den_a = num_a - integer(x);
+ if (den_a < 0)
+ {
+ if ((num_a > 0) && (integer(x) < 0))
+ {
+ rl_a = (s7_double)num_a - (s7_double)integer(x);
+ if (is_null(p)) return(make_real(sc, rl_a));
+ goto SUBTRACT_REALS;
+ }
+ /* (- most-positive-fixnum most-negative-fixnum) -> -1 (1.8446744073709551615E19)
+ */
+ }
+ else
+ {
+ if ((num_a < 0) && (integer(x) > 0))
+ {
+ rl_a = (s7_double)num_a - (s7_double)integer(x);
+ if (is_null(p)) return(make_real(sc, rl_a));
+ goto SUBTRACT_REALS;
+ }
+ /* (- most-negative-fixnum most-positive-fixnum) -> 1 (-1.8446744073709551615E19)
+ */
+ }
#endif
+ if (is_null(p)) return(make_integer(sc, den_a));
+ num_a = den_a;
+ goto SUBTRACT_INTEGERS;
- default:
- method_or_bust_with_type(sc, x, sc->sinh_symbol, args, a_number_string, 0);
- }
-}
-
-DIRECT_RF_TO_RF(sinh)
+ case T_RATIO:
+ {
+ s7_int dn;
+ den_a = denominator(x);
+#if HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(num_a, den_a, &dn)) ||
+ (subtract_overflow(dn, numerator(x), &dn)))
+ {
+ if (is_null(p)) return(make_real(sc, num_a - fraction(x)));
+ rl_a = (s7_double)num_a - fraction(x);
+ goto SUBTRACT_REALS;
+ }
+#else
+ dn = (num_a * den_a) - numerator(x);
+#endif
+ if (is_null(p)) return(s7_make_ratio(sc, dn, den_a));
+ num_a = dn;
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto SUBTRACT_INTEGERS;
+ goto SUBTRACT_RATIOS;
+ }
+ case T_REAL:
+ if (is_null(p)) return(make_real(sc, num_a - real(x)));
+ rl_a = (s7_double)num_a - real(x);
+ goto SUBTRACT_REALS;
-/* -------------------------------- cosh -------------------------------- */
-static s7_pointer g_cosh(s7_scheme *sc, s7_pointer args)
-{
- #define H_cosh "(cosh z) returns cosh(z)"
- #define Q_cosh pcl_n
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, num_a - real_part(x), -imag_part(x)));
+ rl_a = (s7_double)num_a - real_part(x);
+ im_a = -imag_part(x);
+ goto SUBTRACT_COMPLEX;
- s7_pointer x;
- x = car(args);
- switch (type(x))
- {
- case T_INTEGER:
- if (integer(x) == 0) return(small_int(1)); /* (cosh 0) -> 1 */
+ 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);
+ }
+ break;
- case T_REAL:
case T_RATIO:
- /* this is not completely correct when optimization kicks in.
- * :(define (hi) (do ((i 0 (+ i 1))) ((= i 1)) (display (cosh i))))
- * hi
- * :(hi)
- * 1.0()
- * :(cosh 0)
- * 1
- */
- return(make_real(sc, cosh(real_to_double(sc, x, "cosh"))));
+ num_a = numerator(x);
+ den_a = denominator(x);
+ SUBTRACT_RATIOS:
+#if WITH_GMP
+ if ((num_a > s7_int32_max) ||
+ (den_a > s7_int32_max) ||
+ (num_a < s7_int32_min))
+ return(big_subtract(sc, cons(sc, s7_ratio_to_big_ratio(sc, num_a, den_a), p)));
+#endif
+ x = car(p);
+ p = cdr(p);
- case T_COMPLEX:
-#if HAVE_COMPLEX_NUMBERS
- return(s7_from_c_complex(sc, ccosh(as_c_complex(x))));
+ switch (type(x))
+ {
+ case T_INTEGER:
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int di;
+ if ((multiply_overflow(den_a, integer(x), &di)) ||
+ (subtract_overflow(num_a, di, &di)))
+ {
+ if (is_null(p)) return(make_real(sc, ((long double)num_a / (long double)den_a) - integer(x)));
+ rl_a = ((long double)num_a / (long double)den_a) - integer(x);
+ goto SUBTRACT_REALS;
+ }
+ if (is_null(p)) return(s7_make_ratio(sc, di, den_a));
+ num_a = di;
+ }
#else
- return(out_of_range(sc, sc->cosh_symbol, small_int(1), x, no_complex_numbers_string));
+ if (is_null(p)) return(s7_make_ratio(sc, num_a - (den_a * integer(x)), den_a));
+ num_a -= (den_a * integer(x));
+#endif
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto SUBTRACT_INTEGERS;
+ goto SUBTRACT_RATIOS;
+
+ case T_RATIO:
+ {
+ s7_int d1, d2, n1, n2;
+ d1 = den_a;
+ n1 = num_a;
+ d2 = denominator(x);
+ n2 = numerator(x);
+ if (d1 == d2) /* the easy case -- if overflow here, it matches the int case */
+ {
+ if (is_null(p))
+ return(s7_make_ratio(sc, n1 - n2, d1));
+ num_a -= n2; /* d1 can't be zero */
+ }
+ else
+ {
+#if (!WITH_GMP) && HAVE_OVERFLOW_CHECKS
+ s7_int n1d2, n2d1;
+ if ((multiply_overflow(d1, d2, &den_a)) ||
+ (multiply_overflow(n1, d2, &n1d2)) ||
+ (multiply_overflow(n2, d1, &n2d1)) ||
+ (subtract_overflow(n1d2, n2d1, &num_a)))
+ {
+ if (is_null(p))
+ return(make_real(sc, ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2)));
+ rl_a = ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2);
+ goto SUBTRACT_REALS;
+ }
+#else
+ num_a = n1 * d2 - n2 * d1;
+ den_a = d1 * d2;
#endif
+ if (is_null(p))
+ return(s7_make_ratio(sc, num_a, den_a));
+ }
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto SUBTRACT_INTEGERS;
+ goto SUBTRACT_RATIOS;
+ }
+
+ case T_REAL:
+ if (is_null(p)) return(make_real(sc, ((long double)num_a / (long double)den_a) - real(x)));
+ rl_a = ((long double)num_a / (long double)den_a) - real(x);
+ goto SUBTRACT_REALS;
+
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, ((long double)num_a / (long double)den_a) - real_part(x), -imag_part(x)));
+ rl_a = ((long double)num_a / (long double)den_a) - real_part(x);
+ im_a = -imag_part(x);
+ 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);
+ }
+ break;
+
+ case T_REAL:
+ rl_a = real(x);
+
+ SUBTRACT_REALS:
+ x = car(p);
+ p = cdr(p);
+
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (is_null(p)) return(make_real(sc, rl_a - integer(x)));
+ rl_a -= (s7_double)integer(x);
+ goto SUBTRACT_REALS;
+
+ case T_RATIO:
+ if (is_null(p)) return(make_real(sc, rl_a - fraction(x)));
+ rl_a -= (s7_double)fraction(x);
+ goto SUBTRACT_REALS;
+
+ case T_REAL:
+ if (is_null(p)) return(make_real(sc, rl_a - real(x)));
+ rl_a -= real(x);
+ goto SUBTRACT_REALS;
+
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a - real_part(x), -imag_part(x)));
+ rl_a -= real_part(x);
+ im_a = -imag_part(x);
+ 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);
+ }
+ break;
+
+ case T_COMPLEX:
+ rl_a = real_part(x);
+ im_a = imag_part(x);
+
+ SUBTRACT_COMPLEX:
+ x = car(p);
+ p = cdr(p);
+
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a - integer(x), im_a));
+ rl_a -= (s7_double)integer(x);
+ goto SUBTRACT_COMPLEX;
+
+ case T_RATIO:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a - fraction(x), im_a));
+ rl_a -= (s7_double)fraction(x);
+ goto SUBTRACT_COMPLEX;
+
+ case T_REAL:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a - real(x), im_a));
+ rl_a -= real(x);
+ goto SUBTRACT_COMPLEX;
+
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a - real_part(x), im_a - imag_part(x)));
+ rl_a -= real_part(x);
+ im_a -= imag_part(x);
+ if (im_a == 0.0)
+ goto SUBTRACT_REALS;
+ 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);
+ }
+ break;
default:
- method_or_bust_with_type(sc, x, sc->cosh_symbol, args, a_number_string, 0);
+ method_or_bust_with_type(sc, x, sc->subtract_symbol, args, a_number_string, 1);
}
}
-DIRECT_RF_TO_RF(cosh)
-
-/* -------------------------------- tanh -------------------------------- */
-static s7_pointer g_tanh(s7_scheme *sc, s7_pointer args)
+static s7_pointer subtract_1, subtract_s1, subtract_cs1, subtract_cl1, subtract_2, subtract_csn;
+static s7_pointer g_subtract_1(s7_scheme *sc, s7_pointer args)
{
- #define H_tanh "(tanh z) returns tanh(z)"
- #define Q_tanh pcl_n
+ s7_pointer p;
- s7_pointer x;
- x = car(args);
- switch (type(x))
+ p = car(args);
+ switch (type(p))
{
case T_INTEGER:
- if (integer(x) == 0) return(small_int(0)); /* (tanh 0) -> 0 */
+ if (integer(p) == s7_int_min)
+#if WITH_GMP
+ return(big_negate(sc, set_plist_1(sc, promote_number(sc, T_BIG_INTEGER, p))));
+#else
+ return(make_integer(sc, s7_int_max));
+#endif
+ return(make_integer(sc, -integer(p)));
- case T_REAL:
case T_RATIO:
- return(make_real(sc, tanh(real_to_double(sc, x, "tanh"))));
+ return(s7_make_ratio(sc, -numerator(p), denominator(p)));
+
+ case T_REAL:
+ return(make_real(sc, -real(p)));
case T_COMPLEX:
-#if HAVE_COMPLEX_NUMBERS
- if (real_part(x) > 350.0)
- return(real_one); /* closer than 0.0 which is what ctanh is about to return! */
- if (real_part(x) < -350.0)
- return(make_real(sc, -1.0)); /* closer than ctanh's -0.0 */
- return(s7_from_c_complex(sc, ctanh(as_c_complex(x))));
-#else
- return(out_of_range(sc, sc->tanh_symbol, small_int(1), x, no_complex_numbers_string));
-#endif
+ return(s7_make_complex(sc, -real_part(p), -imag_part(p)));
default:
- method_or_bust_with_type(sc, x, sc->tanh_symbol, args, a_number_string, 0);
+ method_or_bust_with_type(sc, p, sc->subtract_symbol, args, a_number_string, 1);
}
}
-DIRECT_RF_TO_RF(tanh)
+static s7_pointer g_subtract_2(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x, y;
+ x = car(args);
+ y = cadr(args);
+
+ if (type(x) == type(y))
+ {
+ if (is_t_real(x))
+ return(make_real(sc, real(x) - real(y)));
+ else
+ {
+ switch (type(x))
+ {
+#if HAVE_OVERFLOW_CHECKS
+ case T_INTEGER:
+ {
+ s7_int val;
+ if (subtract_overflow(integer(x), integer(y), &val))
+ return(make_real(sc, (double)integer(x) - (double)integer(y)));
+ return(make_integer(sc, val));
+ }
+#else
+ case T_INTEGER: return(make_integer(sc, integer(x) - integer(y)));
+#endif
+ case T_RATIO: return(g_subtract(sc, args));
+ case T_REAL: return(make_real(sc, real(x) - real(y)));
+ case T_COMPLEX: return(make_complex(sc, real_part(x) - real_part(y), imag_part(x) - imag_part(y)));
+ default:
+ if (!is_number(x))
+ method_or_bust_with_type(sc, x, sc->subtract_symbol, args, a_number_string, 1);
+ method_or_bust_with_type(sc, y, sc->subtract_symbol, args, a_number_string, 2);
+ }
+ }
+ }
-/* -------------------------------- asinh -------------------------------- */
-static s7_pointer c_asinh_1(s7_scheme *sc, s7_pointer x)
-{
switch (type(x))
{
case T_INTEGER:
- if (integer(x) == 0) return(small_int(0));
- return(make_real(sc, asinh((s7_double)integer(x))));
+ switch (type(y))
+ {
+ case T_INTEGER: return(make_integer(sc, integer(x) - integer(y)));
+ case T_RATIO: return(g_subtract(sc, args));
+ case T_REAL: return(make_real(sc, integer(x) - real(y)));
+ case T_COMPLEX: return(make_complex(sc, integer(x) - real_part(y), -imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->subtract_symbol, args, a_number_string, 2);
+ }
case T_RATIO:
- return(make_real(sc, asinh((s7_double)numerator(x) / (s7_double)denominator(x))));
+ switch (type(y))
+ {
+ case T_INTEGER:
+ case T_RATIO: return(g_subtract(sc, args));
+ case T_REAL: return(make_real(sc, fraction(x) - real(y)));
+ case T_COMPLEX: return(s7_make_complex(sc, fraction(x) - real_part(y), -imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->subtract_symbol, args, a_number_string, 2);
+ }
case T_REAL:
- return(make_real(sc, asinh(real(x))));
+ switch (type(y))
+ {
+ case T_INTEGER: return(make_real(sc, real(x) - integer(y)));
+ case T_RATIO: return(make_real(sc, real(x) - fraction(y)));
+ case T_REAL: return(make_real(sc, real(x) - real(y)));
+ case T_COMPLEX: return(make_complex(sc, real(x) - real_part(y), -imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->subtract_symbol, args, a_number_string, 2);
+ }
case T_COMPLEX:
-#if HAVE_COMPLEX_NUMBERS
- #if (defined(__OpenBSD__)) || (defined(__NetBSD__))
- return(s7_from_c_complex(sc, casinh_1(as_c_complex(x))));
- #else
- return(s7_from_c_complex(sc, casinh(as_c_complex(x))));
- #endif
-#else
- return(out_of_range(sc, sc->asinh_symbol, small_int(1), x, no_complex_numbers_string));
-#endif
+ switch (type(y))
+ {
+ case T_INTEGER: return(s7_make_complex(sc, real_part(x) - integer(y), imag_part(x)));
+ case T_RATIO: return(s7_make_complex(sc, real_part(x) - fraction(y), imag_part(x)));
+ case T_REAL: return(s7_make_complex(sc, real_part(x) - real(y), imag_part(x)));
+ case T_COMPLEX: return(make_complex(sc, real_part(x) - real_part(y), imag_part(x) - imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->subtract_symbol, args, a_number_string, 2);
+ }
default:
- method_or_bust_with_type(sc, x, sc->asinh_symbol, list_1(sc, x), a_number_string, 0);
+ method_or_bust_with_type(sc, x, sc->subtract_symbol, args, a_number_string, 1);
}
+ return(x);
}
-static s7_pointer g_asinh(s7_scheme *sc, s7_pointer args)
-{
- #define H_asinh "(asinh z) returns asinh(z)"
- #define Q_asinh pcl_n
- return(c_asinh_1(sc, car(args)));
+static s7_pointer minus_c1(s7_scheme *sc, s7_pointer x)
+{
+ switch (type(x))
+ {
+#if HAVE_OVERFLOW_CHECKS
+ case T_INTEGER:
+ {
+ s7_int val;
+ if (subtract_overflow(integer(x), 1, &val))
+ return(make_real(sc, (double)integer(x) - 1.0));
+ return(make_integer(sc, val));
+ }
+#else
+ case T_INTEGER: return(make_integer(sc, integer(x) - 1));
+#endif
+ case T_RATIO: return(subtract_ratios(sc, x, small_int(1)));
+ case T_REAL: return(make_real(sc, real(x) - 1.0));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) - 1.0, imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->subtract_symbol, list_2(sc, x, small_int(1)), a_number_string, 1);
+ }
+ return(x);
}
-static s7_pointer c_asinh(s7_scheme *sc, s7_double x)
+static s7_pointer g_subtract_cs1(s7_scheme *sc, s7_pointer args)
{
- return(make_real(sc, asinh(x)));
+ s7_pointer x;
+ x = find_symbol_unchecked(sc, car(args));
+ if (is_integer(x))
+ return(make_integer(sc, integer(x) - 1));
+ return(minus_c1(sc, x));
}
-R_P_F_TO_PF(asinh, c_asinh, c_asinh_1, c_asinh_1)
-
+static s7_pointer g_subtract_cl1(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x;
+ x = local_symbol_value(car(args));
+ if (is_integer(x))
+ return(make_integer(sc, integer(x) - 1));
+ return(minus_c1(sc, x));
+}
-/* -------------------------------- acosh -------------------------------- */
-static s7_pointer c_acosh_1(s7_scheme *sc, s7_pointer x)
+static s7_pointer g_subtract_s1(s7_scheme *sc, s7_pointer args)
{
+ s7_pointer x;
+ x = car(args);
+ /* this one seems to hit reals as often as integers */
switch (type(x))
{
+#if HAVE_OVERFLOW_CHECKS
case T_INTEGER:
- if (integer(x) == 1) return(small_int(0));
-
- case T_REAL:
- case T_RATIO:
{
- double x1;
- x1 = real_to_double(sc, x, "acosh");
- if (x1 >= 1.0)
- return(make_real(sc, acosh(x1)));
+ s7_int val;
+ if (subtract_overflow(integer(x), 1, &val))
+ return(make_real(sc, (double)integer(x) - 1.0));
+ return(make_integer(sc, val));
}
-
- case T_COMPLEX:
-#if HAVE_COMPLEX_NUMBERS
- #ifdef __OpenBSD__
- return(s7_from_c_complex(sc, cacosh_1(s7_to_c_complex(x))));
- #else
- return(s7_from_c_complex(sc, cacosh(s7_to_c_complex(x)))); /* not as_c_complex because x might not be complex */
- #endif
#else
- /* since we can fall through to this branch, we need a better error message than "must be a number, not 0.0" */
- return(out_of_range(sc, sc->acosh_symbol, small_int(1), x, no_complex_numbers_string));
+ case T_INTEGER: return(make_integer(sc, integer(x) - 1));
#endif
-
+ case T_RATIO: return(subtract_ratios(sc, x, small_int(1)));
+ case T_REAL: return(make_real(sc, real(x) - 1.0));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) - 1.0, imag_part(x)));
default:
- method_or_bust_with_type(sc, x, sc->acosh_symbol, list_1(sc, x), a_number_string, 0);
+ method_or_bust_with_type(sc, x, sc->subtract_symbol, args, a_number_string, 1);
}
+ return(x);
}
-static s7_pointer g_acosh(s7_scheme *sc, s7_pointer args)
-{
- #define H_acosh "(acosh z) returns acosh(z)"
- #define Q_acosh pcl_n
- return(c_acosh_1(sc, car(args)));
-}
-
-static s7_pointer c_acosh(s7_scheme *sc, s7_double x)
+static s7_pointer g_subtract_csn(s7_scheme *sc, s7_pointer args)
{
- if (x >= 1.0)
- return(make_real(sc, acosh(x)));
- return(c_acosh_1(sc, set_plist_1(sc, make_real(sc, x))));
-}
-
-R_P_F_TO_PF(acosh, c_acosh, c_acosh_1, c_acosh_1)
+ s7_pointer x;
+ s7_int n;
+ x = find_symbol_unchecked(sc, car(args));
+ n = s7_integer(cadr(args));
+ if (is_integer(x))
+ return(make_integer(sc, integer(x) - n));
-/* -------------------------------- atanh -------------------------------- */
-static s7_pointer c_atanh_1(s7_scheme *sc, s7_pointer x)
-{
switch (type(x))
{
+#if HAVE_OVERFLOW_CHECKS
case T_INTEGER:
- if (integer(x) == 0) return(small_int(0)); /* (atanh 0) -> 0 */
-
- case T_REAL:
- case T_RATIO:
{
- double x1;
- x1 = real_to_double(sc, x, "atanh");
- if (fabs(x1) < 1.0)
- return(make_real(sc, atanh(x1)));
+ s7_int val;
+ if (subtract_overflow(integer(x), n, &val))
+ return(make_real(sc, (double)integer(x) - (double)n));
+ return(make_integer(sc, val));
}
-
- /* if we can't distinguish x from 1.0 even with long doubles, we'll get inf.0:
- * (atanh 9223372036854775/9223372036854776) -> 18.714973875119
- * (atanh 92233720368547758/92233720368547757) -> inf.0
- */
- case T_COMPLEX:
-#if HAVE_COMPLEX_NUMBERS
- #if (defined(__OpenBSD__)) || (defined(__NetBSD__))
- return(s7_from_c_complex(sc, catanh_1(s7_to_c_complex(x))));
- #else
- return(s7_from_c_complex(sc, catanh(s7_to_c_complex(x))));
- #endif
#else
- return(out_of_range(sc, sc->atanh_symbol, small_int(1), x, no_complex_numbers_string));
+ case T_INTEGER: return(make_integer(sc, integer(x) - n));
#endif
+ case T_RATIO: return(subtract_ratios(sc, x, cadr(args)));
+ case T_REAL: return(make_real(sc, real(x) - n));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) - n, imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->subtract_symbol, list_2(sc, x, cadr(args)), a_number_string, 1);
+ }
+ return(x);
+}
+
+static s7_pointer subtract_sf;
+static s7_pointer g_subtract_sf(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x;
+ s7_double n;
+ x = find_symbol_unchecked(sc, car(args));
+ n = real(cadr(args));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_real(sc, integer(x) - n));
+ case T_RATIO: return(make_real(sc, fraction(x) - n));
+ case T_REAL: return(make_real(sc, real(x) - n));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) - n, imag_part(x)));
default:
- method_or_bust_with_type(sc, x, sc->atanh_symbol, list_1(sc, x), a_number_string, 0);
+ method_or_bust_with_type(sc, x, sc->subtract_symbol, list_2(sc, x, cadr(args)), a_number_string, 1);
}
+ return(x);
}
-static s7_pointer g_atanh(s7_scheme *sc, s7_pointer args)
+static s7_pointer subtract_2f;
+static s7_pointer g_subtract_2f(s7_scheme *sc, s7_pointer args)
{
- #define H_atanh "(atanh z) returns atanh(z)"
- #define Q_atanh pcl_n
- return(c_atanh_1(sc, car(args)));
+ s7_pointer x;
+ s7_double n;
+
+ x = car(args);
+ n = real(cadr(args));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_real(sc, integer(x) - n));
+ case T_RATIO: return(make_real(sc, fraction(x) - n));
+ case T_REAL: return(make_real(sc, real(x) - n));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) - n, imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->subtract_symbol, args, a_number_string, 1);
+ }
+ return(x);
}
-static s7_pointer c_atanh(s7_scheme *sc, s7_double x)
+static s7_pointer subtract_fs;
+static s7_pointer g_subtract_fs(s7_scheme *sc, s7_pointer args)
{
- if (fabs(x) < 1.0)
- return(make_real(sc, atanh(x)));
- return(c_atanh_1(sc, set_plist_1(sc, make_real(sc, x))));
+ s7_pointer x;
+ s7_double n;
+
+ x = find_symbol_unchecked(sc, cadr(args));
+ n = real(car(args));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_real(sc, n - integer(x)));
+ case T_RATIO: return(make_real(sc, n - fraction(x)));
+ case T_REAL: return(make_real(sc, n - real(x)));
+ case T_COMPLEX: return(s7_make_complex(sc, n - real_part(x), -imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->subtract_symbol, list_2(sc, car(args), x), a_number_string, 2);
+ }
+ return(x);
}
-R_P_F_TO_PF(atanh, c_atanh, c_atanh_1, c_atanh_1)
+static s7_int subtract_i_ii(s7_int i1, s7_int i2) {return(i1 - i2);}
+static s7_int subtract_i_i(s7_int x) {return(-x);}
+static s7_int subtract_i_iii(s7_int i1, s7_int i2, s7_int i3) {return(i1 - i2 - i3);}
+static s7_double subtract_d_d(s7_double x) {return(-x);}
+static s7_double subtract_d_dd(s7_double x1, s7_double x2) {return(x1 - x2);}
+static s7_double subtract_d_ddd(s7_double x1, s7_double x2, s7_double x3) {return(x1 - x2 - x3);}
+static s7_double subtract_d_dddd(s7_double x1, s7_double x2, s7_double x3, s7_double x4) {return(x1 - x2 - x3 - x4);}
-/* -------------------------------- sqrt -------------------------------- */
-static s7_pointer g_sqrt(s7_scheme *sc, s7_pointer args)
+static s7_pointer subtract_p_pp(s7_pointer p1, s7_pointer p2) {return(g_subtract_2(cur_sc, set_plist_2(cur_sc, p1, p2)));}
+
+
+
+/* ---------------------------------------- multiply ---------------------------------------- */
+
+static s7_pointer g_multiply(s7_scheme *sc, s7_pointer args)
{
- #define H_sqrt "(sqrt z) returns the square root of z"
- #define Q_sqrt pcl_n
+ #define H_multiply "(* ...) multiplies its arguments"
+ #define Q_multiply pcl_n
- s7_pointer n;
- s7_double sqx;
+ s7_pointer x, p;
+ s7_int num_a, den_a;
+ s7_double rl_a, im_a;
- n = car(args);
- switch (type(n))
+#if (!WITH_GMP)
+ if (is_null(args))
+ return(small_int(1));
+#endif
+
+ x = car(args);
+ p = cdr(args);
+ if (is_null(p))
+ {
+ if (!is_number(x))
+ method_or_bust_with_type_one_arg(sc, x, sc->multiply_symbol, args, a_number_string);
+ return(x);
+ }
+
+ switch (type(x))
{
case T_INTEGER:
- if (integer(n) >= 0)
- {
- s7_int ix;
- sqx = sqrt((s7_double)integer(n));
- ix = (s7_int)sqx;
- if ((ix * ix) == integer(n))
- return(make_integer(sc, ix));
- return(make_real(sc, sqx));
- /* Mark Weaver notes that
- * (zero? (- (sqrt 9007199136250226) 94906265.0)) -> #t
- * but (* 94906265 94906265) -> 9007199136250225 -- oops
- * at least we return a real here, not an incorrect integer and
- * (sqrt 9007199136250225) -> 94906265
- */
- }
- sqx = (s7_double)integer(n); /* we're trying to protect against (sqrt -9223372036854775808) where we can't negate the integer argument */
- return(s7_make_complex(sc, 0.0, sqrt((s7_double)(-sqx))));
+ num_a = integer(x);
- case T_RATIO:
- sqx = (s7_double)fraction(n);
- if (sqx > 0.0) /* else it's complex, so it can't be a ratio */
+ MULTIPLY_INTEGERS:
+#if WITH_GMP
+ if ((num_a > s7_int32_max) ||
+ (num_a < s7_int32_min))
+ return(big_multiply(sc, cons(sc, s7_int_to_big_integer(sc, num_a), p)));
+#endif
+ x = car(p);
+ p = cdr(p);
+ switch (type(x))
{
- s7_int nm = 0, dn = 1;
- if (c_rationalize(sqx, 1.0e-16, &nm, &dn)) /* 1e-16 so that (sqrt 1/1099511627776) returns 1/1048576 */
- {
-#if HAVE_OVERFLOW_CHECKS
- s7_int nm2, dn2;
- if ((multiply_overflow(nm, nm, &nm2)) ||
- (multiply_overflow(dn, dn, &dn2)))
- return(make_real(sc, sqrt(sqx)));
- if ((nm2 == numerator(n)) &&
- (dn2 == denominator(n)))
- return(s7_make_ratio(sc, nm, dn));
-#else
- if ((nm * nm == numerator(n)) &&
- (dn * dn == denominator(n)))
- return(s7_make_ratio(sc, nm, dn));
+ case T_INTEGER:
+#if WITH_GMP
+ if ((integer(x) > s7_int32_max) ||
+ (integer(x) < s7_int32_min))
+ return(big_multiply(sc, cons(sc, s7_int_to_big_integer(sc, num_a), cons(sc, x, p))));
#endif
- }
- return(make_real(sc, sqrt(sqx)));
- }
- return(s7_make_complex(sc, 0.0, sqrt(-sqx)));
-
- case T_REAL:
- if (is_NaN(real(n)))
- return(real_NaN);
- if (real(n) >= 0.0)
- return(make_real(sc, sqrt(real(n))));
- return(s7_make_complex(sc, 0.0, sqrt(-real(n))));
- case T_COMPLEX:
- /* (* inf.0 (sqrt -1)) -> -nan+infi, but (sqrt -inf.0) -> 0+infi */
-#if HAVE_COMPLEX_NUMBERS
- return(s7_from_c_complex(sc, csqrt(as_c_complex(n))));
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int dn;
+ if (multiply_overflow(num_a, integer(x), &dn))
+ {
+ if (is_null(p)) return(make_real(sc, (s7_double)num_a * (s7_double)integer(x)));
+ rl_a = (s7_double)num_a * (s7_double)integer(x);
+ goto MULTIPLY_REALS;
+ }
+ num_a = dn;
+ }
#else
- return(out_of_range(sc, sc->sqrt_symbol, small_int(1), n, no_complex_numbers_string));
+ num_a *= integer(x);
#endif
+ if (is_null(p)) return(make_integer(sc, num_a));
+ goto MULTIPLY_INTEGERS;
- default:
- method_or_bust_with_type(sc, n, sc->sqrt_symbol, args, a_number_string, 0);
- }
-}
-
-
-/* -------------------------------- expt -------------------------------- */
-
-static s7_int int_to_int(s7_int x, s7_int n)
-{
- /* from GSL */
- s7_int value = 1;
- do {
- if (n & 1) value *= x;
- n >>= 1;
+ case T_RATIO:
#if HAVE_OVERFLOW_CHECKS
- if (multiply_overflow(x, x, &x))
- break;
+ {
+ s7_int dn;
+ if (multiply_overflow(numerator(x), num_a, &dn))
+ {
+ if (is_null(p))
+ return(make_real(sc, (s7_double)num_a * fraction(x)));
+ rl_a = (s7_double)num_a * fraction(x);
+ goto MULTIPLY_REALS;
+ }
+ num_a = dn;
+ }
#else
- x *= x;
+ num_a *= numerator(x);
#endif
- } while (n);
- return(value);
-}
-
-
-static const long long int nth_roots[63] = {
- S7_LLONG_MAX, S7_LLONG_MAX, 3037000499LL, 2097151, 55108, 6208, 1448, 511, 234, 127, 78, 52, 38, 28, 22,
- 18, 15, 13, 11, 9, 8, 7, 7, 6, 6, 5, 5, 5, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2,
- 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2};
-
-static const long int_nth_roots[31] = {
- S7_LONG_MAX, S7_LONG_MAX, 46340, 1290, 215, 73, 35, 21, 14, 10, 8, 7, 5, 5, 4, 4, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2};
-
-static bool int_pow_ok(s7_int x, s7_int y)
-{
- if (s7_int_bits > 31)
- return((y < 63) &&
- (nth_roots[y] >= s7_int_abs(x)));
- return((y < 31) &&
- (int_nth_roots[y] >= s7_int_abs(x)));
-}
-
-
-static s7_pointer g_expt(s7_scheme *sc, s7_pointer args)
-{
- #define H_expt "(expt z1 z2) returns z1^z2"
- #define Q_expt pcl_n
- s7_pointer n, pw;
-
- n = car(args);
- if (!s7_is_number(n))
- method_or_bust_with_type(sc, n, sc->expt_symbol, args, a_number_string, 1);
-
- pw = cadr(args);
- if (!s7_is_number(pw))
- method_or_bust_with_type(sc, pw, sc->expt_symbol, args, a_number_string, 2);
-
- /* this provides more than 2 args to expt:
- * if (is_not_null(cddr(args)))
- * return(g_expt(sc, list_2(sc, car(args), g_expt(sc, cdr(args)))));
- *
- * but it's unusual in scheme to process args in reverse order, and the
- * syntax by itself is ambiguous (does (expt 2 2 3) = 256 or 64?)
- */
+ den_a = denominator(x);
+ if (is_null(p)) return(s7_make_ratio(sc, num_a, den_a));
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto MULTIPLY_INTEGERS;
+ goto MULTIPLY_RATIOS;
- if (s7_is_zero(n))
- {
- if (s7_is_zero(pw))
- {
- if ((s7_is_integer(n)) && (s7_is_integer(pw))) /* (expt 0 0) -> 1 */
- return(small_int(1));
- return(real_zero); /* (expt 0.0 0) -> 0.0 */
- }
+ case T_REAL:
+ if (is_null(p)) return(make_real(sc, num_a * real(x)));
+ rl_a = num_a * real(x);
+ goto MULTIPLY_REALS;
- if (s7_is_real(pw))
- {
- if (s7_is_negative(pw)) /* (expt 0 -1) */
- return(division_by_zero_error(sc, sc->expt_symbol, args));
- /* (Clisp gives divide-by-zero error here, Guile returns inf.0) */
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, num_a * real_part(x), num_a * imag_part(x)));
+ rl_a = num_a * real_part(x);
+ im_a = num_a * imag_part(x);
+ goto MULTIPLY_COMPLEX;
- if ((!s7_is_rational(pw)) && /* (expt 0 most-positive-fixnum) */
- (is_NaN(s7_real(pw)))) /* (expt 0 +nan.0) */
- return(pw);
- }
- else
- { /* (expt 0 a+bi) */
- if (real_part(pw) < 0.0) /* (expt 0 -1+i) */
- return(division_by_zero_error(sc, sc->expt_symbol, args));
- if ((is_NaN(real_part(pw))) || /* (expt 0 0+1/0i) */
- (is_NaN(imag_part(pw))))
- return(real_NaN);
+ 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);
}
+ break;
- if ((s7_is_integer(n)) && (s7_is_integer(pw))) /* pw != 0, (expt 0 2312) */
- return(small_int(0));
- return(real_zero); /* (expt 0.0 123123) */
- }
-
- if (s7_is_one(pw))
- {
- if (s7_is_integer(pw))
- return(n);
- if (is_rational(n))
- return(make_real(sc, rational_to_double(sc, n)));
- return(n);
- }
-
- if (is_t_integer(pw))
- {
- s7_int y;
- y = integer(pw);
- if (y == 0)
- {
- if (is_rational(n)) /* (expt 3 0) */
- return(small_int(1));
- if ((is_NaN(s7_real_part(n))) || /* (expt 1/0 0) -> NaN */
- (is_NaN(s7_imag_part(n)))) /* (expt (complex 0 1/0) 0) -> NaN */
- return(n);
- return(real_one); /* (expt 3.0 0) */
- }
+ case T_RATIO:
+ num_a = numerator(x);
+ den_a = denominator(x);
+ MULTIPLY_RATIOS:
+#if WITH_GMP
+ if ((num_a > s7_int32_max) ||
+ (den_a > s7_int32_max) ||
+ (num_a < s7_int32_min))
+ return(big_multiply(sc, cons(sc, s7_ratio_to_big_ratio(sc, num_a, den_a), p)));
+#endif
+ x = car(p);
+ p = cdr(p);
- switch (type(n))
+ switch (type(x))
{
case T_INTEGER:
+ /* as in +, this can overflow:
+ * (* 8 -9223372036854775807 8) -> 64
+ * (* 3/4 -9223372036854775807 8) -> 6
+ * (* 8 -9223372036854775808 8) -> 0
+ * (* -1 9223372036854775806 8) -> 16
+ * (* -9223372036854775808 8 1e+308) -> 0.0
+ */
+#if HAVE_OVERFLOW_CHECKS
{
- s7_int x;
- x = s7_integer(n);
- if (x == 1) /* (expt 1 y) */
- return(n);
-
- if (x == -1)
- {
- if (y == s7_int_min) /* (expt -1 most-negative-fixnum) */
- return(small_int(1));
-
- if (s7_int_abs(y) & 1) /* (expt -1 odd-int) */
- return(n);
- return(small_int(1)); /* (expt -1 even-int) */
- }
-
- if (y == s7_int_min) /* (expt x most-negative-fixnum) */
- return(small_int(0));
- if (x == s7_int_min) /* (expt most-negative-fixnum y) */
- return(make_real(sc, pow((double)x, (double)y)));
-
- if (int_pow_ok(x, s7_int_abs(y)))
+ s7_int dn;
+ if (multiply_overflow(integer(x), num_a, &dn))
{
- if (y > 0)
- return(make_integer(sc, int_to_int(x, y)));
- return(s7_make_ratio(sc, 1, int_to_int(x, -y)));
+ if (is_null(p))
+ return(make_real(sc, ((s7_double)integer(x) / (s7_double)den_a) * (s7_double)num_a));
+ rl_a = ((s7_double)integer(x) / (s7_double)den_a) * (s7_double)num_a;
+ goto MULTIPLY_REALS;
}
+ num_a = dn;
}
- break;
+#else
+ num_a *= integer(x);
+#endif
+ if (is_null(p)) return(s7_make_ratio(sc, num_a, den_a));
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto MULTIPLY_INTEGERS;
+ goto MULTIPLY_RATIOS;
case T_RATIO:
{
- s7_int nm, dn;
-
- nm = numerator(n);
- dn = denominator(n);
-
- if (y == s7_int_min)
- {
- if (s7_int_abs(nm) > dn)
- return(small_int(0)); /* (expt 4/3 most-negative-fixnum) -> 0? */
- return(real_infinity); /* (expt 3/4 most-negative-fixnum) -> inf? */
- }
-
- if ((int_pow_ok(nm, s7_int_abs(y))) &&
- (int_pow_ok(dn, s7_int_abs(y))))
+#if (!WITH_GMP)
+ s7_int d1, n1;
+#endif
+ s7_int d2, n2;
+ d2 = denominator(x);
+ n2 = numerator(x);
+#if (!WITH_GMP)
+ d1 = den_a;
+ n1 = num_a;
+#if HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(n1, n2, &num_a)) ||
+ (multiply_overflow(d1, d2, &den_a)))
{
- if (y > 0)
- return(s7_make_ratio(sc, int_to_int(nm, y), int_to_int(dn, y)));
- return(s7_make_ratio(sc, int_to_int(dn, -y), int_to_int(nm, -y)));
+ if (is_null(p))
+ return(make_real(sc, ((long double)n1 / (long double)d1) * ((long double)n2 / (long double)d2)));
+ rl_a = ((long double)n1 / (long double)d1) * ((long double)n2 / (long double)d2);
+ goto MULTIPLY_REALS;
}
+#else
+ num_a *= n2;
+ den_a *= d2;
+#endif
+#else
+ num_a *= n2;
+ den_a *= d2;
+#endif
+ if (is_null(p)) return(s7_make_ratio(sc, num_a, den_a));
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto MULTIPLY_INTEGERS;
+ goto MULTIPLY_RATIOS;
}
- break;
- /* occasionally int^rat can be int but it happens so infrequently it's probably not worth checking
- * one possibly easy case: (expt 1 1/2) -> 1 (-1?) etc
- */
case T_REAL:
- /* (expt -1.0 most-positive-fixnum) should be -1.0
- * (expt -1.0 (+ (expt 2 53) 1)) -> -1.0
- * (expt -1.0 (- 1 (expt 2 54))) -> -1.0
- */
- if (real(n) == -1.0)
- {
- if (y == s7_int_min)
- return(real_one);
-
- if (s7_int_abs(y) & 1)
- return(n);
- return(real_one);
- }
- break;
+ if (is_null(p)) return(make_real(sc, ((long double)num_a / (long double)den_a) * real(x)));
+ rl_a = ((long double)num_a / (long double)den_a) * real(x);
+ goto MULTIPLY_REALS;
case T_COMPLEX:
-#if HAVE_COMPLEX_NUMBERS
- if ((s7_real_part(n) == 0.0) &&
- ((s7_imag_part(n) == 1.0) ||
- (s7_imag_part(n) == -1.0)))
- {
- bool yp, np;
- yp = (y > 0);
- np = (s7_imag_part(n) > 0.0);
- switch (s7_int_abs(y) % 4)
- {
- case 0: return(real_one);
- case 1: return(s7_make_complex(sc, 0.0, (yp == np) ? 1.0 : -1.0));
- case 2: return(make_real(sc, -1.0));
- case 3: return(s7_make_complex(sc, 0.0, (yp == np) ? -1.0 : 1.0));
- }
- }
-#else
- return(out_of_range(sc, sc->expt_symbol, small_int(2), n, no_complex_numbers_string));
-#endif
- break;
+ {
+ s7_double frac;
+ frac = ((long double)num_a / (long double)den_a);
+ if (is_null(p)) return(s7_make_complex(sc, frac * real_part(x), frac * imag_part(x)));
+ rl_a = frac * real_part(x);
+ im_a = frac * imag_part(x);
+ goto MULTIPLY_COMPLEX;
+ }
+
+ 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);
}
- }
+ break;
- if ((s7_is_real(n)) &&
- (s7_is_real(pw)))
- {
- s7_double x, y;
+ case T_REAL:
+ rl_a = real(x);
- if ((is_t_ratio(pw)) &&
- (numerator(pw) == 1))
- {
- if (denominator(pw) == 2)
- return(g_sqrt(sc, args));
- if (denominator(pw) == 3)
- return(make_real(sc, cbrt(real_to_double(sc, n, "expt")))); /* (expt 27 1/3) should be 3, not 3.0... */
+ MULTIPLY_REALS:
+ x = car(p);
+ p = cdr(p);
- /* but: (expt 512/729 1/3) -> 0.88888888888889
- */
- /* and 4 -> sqrt(sqrt...) etc? */
- }
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (is_null(p)) return(make_real(sc, rl_a * integer(x)));
+ rl_a *= integer(x);
+ goto MULTIPLY_REALS;
- x = real_to_double(sc, n, "expt");
- y = real_to_double(sc, pw, "expt");
+ case T_RATIO:
+ if (is_null(p)) return(make_real(sc, rl_a * fraction(x)));
+ rl_a *= (s7_double)fraction(x);
+ goto MULTIPLY_REALS;
- if (is_NaN(x)) return(n);
- if (is_NaN(y)) return(pw);
- if (y == 0.0) return(real_one);
+ case T_REAL:
+ if (is_null(p)) return(make_real(sc, rl_a * real(x)));
+ rl_a *= real(x);
+ goto MULTIPLY_REALS;
- if (x > 0.0)
- return(make_real(sc, pow(x, y)));
- /* tricky cases abound here: (expt -1 1/9223372036854775807)
- */
- }
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a * real_part(x), rl_a * imag_part(x)));
+ im_a = rl_a * imag_part(x);
+ rl_a *= real_part(x);
+ goto MULTIPLY_COMPLEX;
- /* (expt 0+i 1e+16) = 0.98156860153485-0.19111012657867i ?
- * (expt 0+i 1+1/0i) = 0.0 ??
- */
- return(s7_from_c_complex(sc, cpow(s7_to_c_complex(n), s7_to_c_complex(pw))));
-}
+ 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);
+ }
+ break;
+ case T_COMPLEX:
+ rl_a = real_part(x);
+ im_a = imag_part(x);
-#if (!WITH_GMP)
-static s7_pointer c_expt_i(s7_scheme *sc, s7_int x, s7_int y)
-{
- if (y == 0) return(small_int(1));
- if (y == 1) return(make_integer(sc, x));
- return(g_expt(sc, set_plist_2(sc, make_integer(sc, x), make_integer(sc, y))));
-}
+ MULTIPLY_COMPLEX:
+ x = car(p);
+ p = cdr(p);
-static s7_pointer c_expt_r(s7_scheme *sc, s7_double x, s7_double y)
-{
- if (y > 0.0)
- return(make_real(sc, pow(x, y)));
- return(g_expt(sc, set_plist_2(sc, make_real(sc, x), make_real(sc, y))));
-}
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a * integer(x), im_a * integer(x)));
+ rl_a *= integer(x);
+ im_a *= integer(x);
+ goto MULTIPLY_COMPLEX;
-static s7_pointer c_expt_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- return(g_expt(sc, set_plist_2(sc, x, y)));
-}
+ case T_RATIO:
+ {
+ s7_double frac;
+ frac = fraction(x);
+ if (is_null(p)) return(s7_make_complex(sc, rl_a * frac, im_a * frac));
+ rl_a *= frac;
+ im_a *= frac;
+ goto MULTIPLY_COMPLEX;
+ }
-XF2_TO_PF(expt, c_expt_i, c_expt_r, c_expt_2)
-#endif
+ case T_REAL:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a * real(x), im_a * real(x)));
+ rl_a *= real(x);
+ im_a *= real(x);
+ goto MULTIPLY_COMPLEX;
+ case T_COMPLEX:
+ {
+ s7_double r1, r2, i1, i2;
+ r1 = rl_a;
+ i1 = im_a;
+ r2 = real_part(x);
+ i2 = imag_part(x);
+ if (is_null(p))
+ return(s7_make_complex(sc, r1 * r2 - i1 * i2, r1 * i2 + r2 * i1));
+ rl_a = r1 * r2 - i1 * i2;
+ im_a = r1 * i2 + r2 * i1;
+ if (im_a == 0.0)
+ goto MULTIPLY_REALS;
+ goto MULTIPLY_COMPLEX;
+ }
-/* -------------------------------- lcm -------------------------------- */
-static s7_pointer g_lcm(s7_scheme *sc, s7_pointer args)
-{
- #define H_lcm "(lcm ...) returns the least common multiple of its rational arguments"
- #define Q_lcm pcl_f
+ 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);
+ }
+ break;
- s7_int n = 1, d = 0;
- s7_pointer p;
+ default:
+ method_or_bust_with_type(sc, x, sc->multiply_symbol, args, a_number_string, 1);
+ }
+}
- if (!is_pair(args))
- return(small_int(1));
+#if (!WITH_GMP)
+static s7_pointer multiply_2, multiply_fs, multiply_sf, multiply_is, multiply_si;
- if (!is_pair(cdr(args)))
- {
- if (!is_rational(car(args)))
- method_or_bust_with_type(sc, car(args), sc->lcm_symbol, args, a_rational_string, 1);
- return(g_abs(sc, args));
- }
+static s7_pointer g_multiply_2(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x, y;
+ x = car(args);
+ y = cadr(args);
- for (p = args; is_pair(p); p = cdr(p))
+ if (type(x) == type(y))
{
- s7_pointer x;
- s7_int b;
- x = car(p);
- switch (type(x))
+ if (is_t_real(x))
+ return(make_real(sc, real(x) * real(y)));
+ else
{
- case T_INTEGER:
- if (integer(x) == 0)
- n = 0;
- else
+ switch (type(x))
{
- b = integer(x);
- if (b < 0) b = -b;
- n = (n / c_gcd(n, b)) * b;
+#if HAVE_OVERFLOW_CHECKS
+ case T_INTEGER:
+ {
+ s7_int n;
+ if (multiply_overflow(integer(x), integer(y), &n))
+ return(make_real(sc, ((s7_double)integer(x)) * ((s7_double)integer(y))));
+ return(make_integer(sc, n));
+ }
+#else
+ case T_INTEGER: return(make_integer(sc, integer(x) * integer(y)));
+#endif
+ case T_RATIO: return(g_multiply(sc, args));
+ case T_REAL: return(make_real(sc, real(x) * real(y)));
+ case T_COMPLEX:
+ {
+ s7_double r1, r2, i1, i2;
+ r1 = real_part(x);
+ r2 = real_part(y);
+ i1 = imag_part(x);
+ i2 = imag_part(y);
+ return(s7_make_complex(sc, r1 * r2 - i1 * i2, r1 * i2 + r2 * i1));
+ }
+ default:
+ if (!is_number(x))
+ method_or_bust_with_type(sc, x, sc->multiply_symbol, args, a_number_string, 1);
+ method_or_bust_with_type(sc, y, sc->multiply_symbol, args, a_number_string, 2);
}
- if (d != 0) d = 1;
- break;
+ }
+ }
- case T_RATIO:
- b = numerator(x);
- if (b < 0) b = -b;
- n = (n / c_gcd(n, b)) * b;
- if (d == 0)
- {
- if (p == args)
- d = s7_denominator(x);
- else d = 1;
- }
- else d = c_gcd(d, s7_denominator(x));
- break;
+ switch (type(x))
+ {
+ case T_INTEGER:
+ switch (type(y))
+ {
+ case T_INTEGER: return(make_integer(sc, integer(x) * integer(y)));
+ case T_RATIO: return(g_multiply(sc, args));
+ case T_REAL: return(make_real(sc, integer(x) * real(y)));
+ case T_COMPLEX: return(s7_make_complex(sc, integer(x) * real_part(y), integer(x) * imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->multiply_symbol, args, a_number_string, 2);
+ }
+ case T_RATIO:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ case T_RATIO: return(g_multiply(sc, args));
+ case T_REAL: return(make_real(sc, fraction(x) * real(y)));
+ case T_COMPLEX:
+ {
+ s7_double frac;
+ frac = fraction(x);
+ return(s7_make_complex(sc, frac * real_part(y), frac * imag_part(y)));
+ }
default:
- method_or_bust_with_type(sc, x, sc->lcm_symbol, cons(sc, (d <= 1) ? make_integer(sc, n) : s7_make_ratio(sc, n, d), p), a_rational_string, position_of(p, args));
+ method_or_bust_with_type(sc, y, sc->multiply_symbol, args, a_number_string, 2);
}
- if (n < 0) return(simple_out_of_range(sc, sc->lcm_symbol, args, result_is_too_large_string));
- if (n == 0)
+
+ case T_REAL:
+ switch (type(y))
{
- for (p = cdr(p); is_pair(p); p = cdr(p))
- if (!is_rational_via_method(sc, car(p)))
- return(wrong_type_argument_with_type(sc, sc->lcm_symbol, position_of(p, args), x, a_rational_string));
- return(small_int(0));
+ case T_INTEGER: return(make_real(sc, real(x) * integer(y)));
+ case T_RATIO: return(make_real(sc, real(x) * fraction(y)));
+ case T_REAL: return(make_real(sc, real(x) * real(y)));
+ case T_COMPLEX: return(s7_make_complex(sc, real(x) * real_part(y), real(x) * imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->multiply_symbol, args, a_number_string, 2);
}
- }
- if (d <= 1)
- return(make_integer(sc, n));
- return(s7_make_ratio(sc, n, d));
-}
+ case T_COMPLEX:
+ switch (type(y))
+ {
+ case T_INTEGER: return(s7_make_complex(sc, real_part(x) * integer(y), imag_part(x) * integer(y)));
+ case T_RATIO:
+ {
+ s7_double frac;
+ frac = fraction(y);
+ return(s7_make_complex(sc, real_part(x) * frac, imag_part(x) * frac));
+ }
+ case T_REAL: return(s7_make_complex(sc, real_part(x) * real(y), imag_part(x) * real(y)));
+ case T_COMPLEX:
+ {
+ s7_double r1, r2, i1, i2;
+ r1 = real_part(x);
+ r2 = real_part(y);
+ i1 = imag_part(x);
+ i2 = imag_part(y);
+ return(s7_make_complex(sc, r1 * r2 - i1 * i2, r1 * i2 + r2 * i1));
+ }
+ default:
+ method_or_bust_with_type(sc, y, sc->multiply_symbol, args, a_number_string, 2);
+ }
-static s7_int c_lcm(s7_scheme *sc, s7_int a, s7_int b)
-{
- if ((a == 0) || (b == 0)) return(0);
- if (a < 0) a = -a;
- if (b < 0) b = -b;
- return((a / c_gcd(a, b)) * b);
+ default:
+ method_or_bust_with_type(sc, x, sc->multiply_symbol, args, a_number_string, 1);
+ }
+ return(x);
}
-IF2_TO_IF(lcm, c_lcm)
-
+/* all of these mess up if overflows occur
+ * (let () (define (f x) (* x 9223372036854775806)) (f -63)) -> -9223372036854775682, but (* -63 9223372036854775806) -> -5.810724383218509e+20
+ * how to catch this? (affects * - +)
+ */
-/* -------------------------------- gcd -------------------------------- */
-static s7_pointer g_gcd(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_multiply_si(s7_scheme *sc, s7_pointer args)
{
- #define H_gcd "(gcd ...) returns the greatest common divisor of its rational arguments"
- #define Q_gcd pcl_f
- s7_int n = 0, d = 1;
- s7_pointer p;
+ s7_pointer x;
+ s7_int n;
- if (!is_pair(args))
- return(small_int(0));
+ x = find_symbol_unchecked(sc, car(args));
+ n = integer(cadr(args));
- if (!is_pair(cdr(args)))
+ switch (type(x))
{
- if (!is_rational(car(args)))
- method_or_bust_with_type(sc, car(args), sc->gcd_symbol, args, a_rational_string, 1);
- return(g_abs(sc, args));
+#if HAVE_OVERFLOW_CHECKS
+ case T_INTEGER:
+ {
+ s7_int val;
+ if (multiply_overflow(integer(x), n, &val))
+ return(make_real(sc, (double)integer(x) * (double)n));
+ return(make_integer(sc, val));
+ }
+ case T_RATIO:
+ {
+ s7_int val;
+ if (multiply_overflow(numerator(x), n, &val))
+ return(make_real(sc, fraction(x) * (double)n));
+ return(s7_make_ratio(sc, val, denominator(x)));
+ }
+#else
+ case T_INTEGER: return(make_integer(sc, integer(x) * n));
+ case T_RATIO: return(s7_make_ratio(sc, numerator(x) * n, denominator(x)));
+#endif
+ case T_REAL: return(make_real(sc, real(x) * n));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) * n, imag_part(x) * n));
+ default:
+ method_or_bust_with_type(sc, x, sc->multiply_symbol, list_2(sc, x, cadr(args)), a_number_string, 1);
}
+ return(x);
+}
- for (p = args; is_pair(p); p = cdr(p))
- {
- s7_pointer x;
- s7_int b;
- x = car(p);
- switch (type(x))
- {
- case T_INTEGER:
- n = c_gcd(n, integer(x));
- break;
+static s7_pointer g_multiply_is(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x;
+ s7_int n;
- case T_RATIO:
- n = c_gcd(n, s7_numerator(x));
- b = s7_denominator(x);
- if (b < 0) b = -b;
- d = (d / c_gcd(d, b)) * b;
- if (d < 0) return(simple_out_of_range(sc, sc->gcd_symbol, args, result_is_too_large_string));
- break;
+ x = find_symbol_unchecked(sc, cadr(args));
+ n = integer(car(args));
- default:
- method_or_bust_with_type(sc, x, sc->gcd_symbol, cons(sc, (d <= 1) ? make_integer(sc, n) : s7_make_ratio(sc, n, d), p), a_rational_string, position_of(p, args));
- }
- if (n < 0) return(simple_out_of_range(sc, sc->gcd_symbol, args, result_is_too_large_string));
+ switch (type(x))
+ {
+#if HAVE_OVERFLOW_CHECKS
+ case T_INTEGER:
+ {
+ s7_int val;
+ if (multiply_overflow(integer(x), n, &val))
+ return(make_real(sc, (double)integer(x) * (double)n));
+ return(make_integer(sc, val));
+ }
+ case T_RATIO:
+ {
+ s7_int val;
+ if (multiply_overflow(numerator(x), n, &val))
+ return(make_real(sc, fraction(x) * (double)n));
+ return(s7_make_ratio(sc, val, denominator(x)));
+ }
+#else
+ case T_INTEGER: return(make_integer(sc, integer(x) * n));
+ case T_RATIO: return(s7_make_ratio(sc, numerator(x) * n, denominator(x)));
+#endif
+ case T_REAL: return(make_real(sc, real(x) * n));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) * n, imag_part(x) * n));
+ default:
+ method_or_bust_with_type(sc, x, sc->multiply_symbol, list_2(sc, car(args), x), a_number_string, 2);
}
-
- if (d <= 1)
- return(make_integer(sc, n));
- return(s7_make_ratio(sc, n, d));
+ return(x);
}
-static s7_int c_gcd_1(s7_scheme *sc, s7_int a, s7_int b) {return(c_gcd(a, b));}
-
-IF2_TO_IF(gcd, c_gcd_1)
-
-
-static s7_pointer s7_truncate(s7_scheme *sc, s7_pointer caller, s7_double xf) /* can't use "truncate" -- it's in unistd.h */
+static s7_pointer g_multiply_fs(s7_scheme *sc, s7_pointer args)
{
- if ((xf > s7_int_max) ||
- (xf < s7_int_min))
- return(simple_out_of_range(sc, caller, make_real(sc, xf), its_too_large_string));
+ s7_pointer x;
+ s7_double scl;
- if (xf > 0.0)
- return(make_integer(sc, (s7_int)floor(xf)));
- return(make_integer(sc, (s7_int)ceil(xf)));
-}
+ scl = real(car(args));
+ x = find_symbol_unchecked(sc, cadr(args));
-static s7_int c_quo_int(s7_scheme *sc, s7_int x, s7_int y)
-{
- if (y == 0)
- division_by_zero_error(sc, sc->quotient_symbol, set_elist_2(sc, make_integer(sc, x), make_integer(sc, y)));
- if ((y == -1) && (x == s7_int_min)) /* (quotient most-negative-fixnum -1) */
- simple_out_of_range(sc, sc->quotient_symbol, set_elist_2(sc, make_integer(sc, x), make_integer(sc, y)), its_too_large_string);
- return(x / y);
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_real(sc, integer(x) * scl));
+ case T_RATIO: return(make_real(sc, numerator(x) * scl / denominator(x)));
+ case T_REAL: return(make_real(sc, real(x) * scl));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) * scl, imag_part(x) * scl));
+ default:
+ method_or_bust_with_type(sc, x, sc->multiply_symbol, list_2(sc, car(args), x), a_number_string, 1);
+ }
+ return(x);
}
-static s7_double c_quo_dbl(s7_scheme *sc, s7_double x, s7_double y)
+static s7_pointer g_multiply_sf(s7_scheme *sc, s7_pointer args)
{
- s7_double xf;
-
- if (y == 0.0)
- division_by_zero_error(sc, sc->quotient_symbol, set_elist_2(sc, make_real(sc, x), make_real(sc, y)));
- if ((is_inf(y)) || (is_NaN(y)))
- wrong_type_argument_with_type(sc, sc->quotient_symbol, 2, make_real(sc, y), a_normal_real_string);
+ s7_pointer x;
+ s7_double scl;
- xf = x / y;
- if ((xf > s7_int_max) ||
- (xf < s7_int_min))
- simple_out_of_range(sc, sc->quotient_symbol, make_real(sc, xf), its_too_large_string);
+ scl = real(cadr(args));
+ x = find_symbol_unchecked(sc, car(args));
- if (xf > 0.0)
- return(floor(xf));
- return(ceil(xf));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_real(sc, integer(x) * scl));
+ case T_RATIO: return(make_real(sc, numerator(x) * scl / denominator(x)));
+ case T_REAL: return(make_real(sc, real(x) * scl));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) * scl, imag_part(x) * scl));
+ default:
+ method_or_bust_with_type(sc, x, sc->multiply_symbol, list_2(sc, x, cadr(args)), a_number_string, 2);
+ }
+ return(x);
}
-static s7_pointer g_quotient(s7_scheme *sc, s7_pointer args)
+static s7_pointer sqr_ss;
+static s7_pointer g_sqr_ss(s7_scheme *sc, s7_pointer args)
{
- #define H_quotient "(quotient x1 x2) returns the integer quotient of x1 and x2; (quotient 4 3) = 1"
- #define Q_quotient pcl_r
- /* (define (quo x1 x2) (truncate (/ x1 x2))) ; slib
- */
- s7_pointer x, y;
- s7_int d1, d2, n1, n2;
-
- x = car(args);
- y = cadr(args);
+ s7_pointer x;
+ x = find_symbol_unchecked(sc, car(args));
switch (type(x))
{
- case T_INTEGER:
- switch (type(y))
- {
- case T_INTEGER:
- return(make_integer(sc, c_quo_int(sc, integer(x), integer(y))));
-
- case T_RATIO:
- n1 = integer(x);
- d1 = 1;
- n2 = numerator(y);
- d2 = denominator(y);
- goto RATIO_QUO_RATIO;
-
- case T_REAL:
- if (real(y) == 0.0)
- return(division_by_zero_error(sc, sc->quotient_symbol, args));
- if ((is_inf(real(y))) || (is_NaN(real(y))))
- return(wrong_type_argument_with_type(sc, sc->quotient_symbol, 2, y, a_normal_real_string));
- return(s7_truncate(sc, sc->quotient_symbol, (s7_double)integer(x) / real(y)));
-
- default:
- method_or_bust(sc, y, sc->quotient_symbol, args, T_REAL, 2);
- }
-
- case T_RATIO:
- switch (type(y))
- {
- case T_INTEGER:
- if (integer(y) == 0)
- return(division_by_zero_error(sc, sc->quotient_symbol, args));
- n1 = numerator(x);
- d1 = denominator(x);
- n2 = integer(y);
- d2 = 1;
- goto RATIO_QUO_RATIO;
- /* this can lose:
- * (quotient 1 2305843009213693952/4611686018427387903) -> 2, not 1
- * (quotient 21053343141/6701487259 3587785776203/1142027682075) -> 1, not 0
- */
-
- case T_RATIO:
- n1 = numerator(x);
- d1 = denominator(x);
- n2 = numerator(y);
- d2 = denominator(y);
- RATIO_QUO_RATIO:
- if (d1 == d2)
- return(make_integer(sc, n1 / n2)); /* (quotient 3/9223372036854775807 1/9223372036854775807) */
- if (n1 == n2)
- return(make_integer(sc, d2 / d1)); /* (quotient 9223372036854775807/2 9223372036854775807/8) */
#if HAVE_OVERFLOW_CHECKS
- {
- s7_int n1d2, n2d1;
- if ((multiply_overflow(n1, d2, &n1d2)) ||
- (multiply_overflow(n2, d1, &n2d1)))
- return(s7_truncate(sc, sc->quotient_symbol, ((long double)n1 / (long double)n2) * ((long double)d2 / (long double)d1)));
- return(make_integer(sc, n1d2 / n2d1));
- }
+ case T_INTEGER:
+ {
+ s7_int val;
+ if (multiply_overflow(integer(x), integer(x), &val))
+ return(make_real(sc, (double)integer(x) * (double)integer(x)));
+ return(make_integer(sc, val));
+ }
+ case T_RATIO:
+ {
+ s7_int num, den;
+ if ((multiply_overflow(numerator(x), numerator(x), &num)) ||
+ (multiply_overflow(denominator(x), denominator(x), &den)))
+ return(make_real(sc, fraction(x) * fraction(x)));
+ return(s7_make_ratio(sc, num, den));
+ }
#else
- if ((integer_length(n1) + integer_length(d2) >= s7_int_bits) ||
- (integer_length(n2) + integer_length(d1) >= s7_int_bits))
- return(s7_truncate(sc, sc->quotient_symbol, ((long double)n1 / (long double)n2) * ((long double)d2 / (long double)d1)));
- return(make_integer(sc, (n1 * d2) / (n2 * d1)));
+ case T_INTEGER: return(s7_make_integer(sc, integer(x) * integer(x)));
+ case T_RATIO: return(s7_make_ratio(sc, numerator(x) * numerator(x), denominator(x) * denominator(x)));
#endif
+ case T_REAL: return(make_real(sc, real(x) * real(x)));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) * real_part(x) - imag_part(x) * imag_part(x), 2.0 * real_part(x) * imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->multiply_symbol, list_2(sc, x, x), a_number_string, 1);
+ }
+ return(x);
+}
- case T_REAL:
- if (real(y) == 0.0)
- return(division_by_zero_error(sc, sc->quotient_symbol, args));
- if ((is_inf(real(y))) || (is_NaN(real(y))))
- return(wrong_type_argument_with_type(sc, sc->quotient_symbol, 2, y, a_normal_real_string));
- return(s7_truncate(sc, sc->quotient_symbol, (s7_double)fraction(x) / real(y)));
-
- default:
- method_or_bust(sc, y, sc->quotient_symbol, args, T_REAL, 2);
- }
+static s7_pointer mul_s_sin_s, mul_s_cos_s;
+static s7_pointer g_mul_s_sin_s(s7_scheme *sc, s7_pointer args)
+{
+ /* (* s (sin s)) */
+ s7_pointer x, y;
- case T_REAL:
- if ((is_inf(real(x))) || (is_NaN(real(x))))
- return(wrong_type_argument_with_type(sc, sc->quotient_symbol, 1, x, a_normal_real_string));
+ x = find_symbol_unchecked(sc, car(args));
+ y = find_symbol_unchecked(sc, cadadr(args));
- /* if infs allowed we need to return infs/nans, else:
- * (quotient inf.0 1e-309) -> -9223372036854775808
- * (quotient inf.0 inf.0) -> -9223372036854775808
- */
+ if ((is_real(x)) && (is_real(y)))
+ return(make_real(sc, real_to_double(sc, x, "*") * sin(real_to_double(sc, y, "sin"))));
- switch (type(y))
- {
- case T_INTEGER:
- if (integer(y) == 0)
- return(division_by_zero_error(sc, sc->quotient_symbol, args));
- return(s7_truncate(sc, sc->quotient_symbol, real(x) / (s7_double)integer(y)));
+ return(g_multiply(sc, set_plist_2(sc, x, g_sin(sc, set_plist_1(sc, y)))));
+}
- case T_RATIO:
- return(s7_truncate(sc, sc->quotient_symbol, real(x) / (s7_double)fraction(y)));
+static s7_pointer g_mul_s_cos_s(s7_scheme *sc, s7_pointer args)
+{
+ /* (* s (cos s)) */
+ s7_pointer x, y;
- case T_REAL:
- return(make_real(sc, c_quo_dbl(sc, real(x), real(y))));
+ x = find_symbol_unchecked(sc, car(args));
+ y = find_symbol_unchecked(sc, cadadr(args));
- default:
- method_or_bust(sc, y, sc->quotient_symbol, args, T_REAL, 2);
- }
+ if ((is_real(x)) && (is_real(y)))
+ return(make_real(sc, real_to_double(sc, x, "*") * cos(real_to_double(sc, y, "cos"))));
- default:
- method_or_bust(sc, x, sc->quotient_symbol, args, T_REAL, 2);
- }
+ return(g_multiply(sc, set_plist_2(sc, x, g_cos(sc, set_plist_1(sc, y)))));
}
+#endif /* with-gmp */
+static s7_int multiply_i_ii(s7_int i1, s7_int i2) {return(i1 * i2);}
+static s7_int multiply_i_iii(s7_int i1, s7_int i2, s7_int i3) {return(i1 * i2 * i3);}
-IF2_TO_IF(quotient, c_quo_int)
-RF2_TO_RF(quotient, c_quo_dbl)
+static s7_double multiply_d_d(s7_double x) {return(x);}
+static s7_double multiply_d_dd(s7_double x1, s7_double x2) {return(x1 * x2);}
+static s7_double multiply_d_ddd(s7_double x1, s7_double x2, s7_double x3) {return(x1 * x2 * x3);}
+static s7_double multiply_d_dddd(s7_double x1, s7_double x2, s7_double x3, s7_double x4) {return(x1 * x2 * x3 * x4);}
+#if (!WITH_GMP)
+static s7_pointer multiply_p_pp(s7_pointer x1, s7_pointer x2) {return(g_multiply_2(cur_sc, set_plist_2(cur_sc, x1, x2)));}
+#endif
-static s7_int c_rem_int(s7_scheme *sc, s7_int x, s7_int y)
-{
- if (y == 0)
- division_by_zero_error(sc, sc->remainder_symbol, set_elist_2(sc, make_integer(sc, x), make_integer(sc, y)));
- if ((y == 1) || (y == -1)) /* (remainder most-negative-fixnum -1) will segfault with arithmetic exception */
- return(0);
- return(x % y);
-}
-static s7_double c_rem_dbl(s7_scheme *sc, s7_double x, s7_double y)
-{
- s7_int quo;
- s7_double pre_quo;
- if (y == 0.0)
- division_by_zero_error(sc, sc->remainder_symbol, set_elist_2(sc, make_real(sc, x), make_real(sc, y)));
- if ((is_inf(y)) || (is_NaN(y)))
- wrong_type_argument_with_type(sc, sc->remainder_symbol, 2, set_elist_1(sc, make_real(sc, y)), a_normal_real_string);
+/* ---------------------------------------- divide ---------------------------------------- */
- pre_quo = x / y;
- if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
- simple_out_of_range(sc, sc->remainder_symbol, set_elist_2(sc, make_real(sc, x), make_real(sc, y)), its_too_large_string);
- if (pre_quo > 0.0)
- quo = (s7_int)floor(pre_quo);
- else quo = (s7_int)ceil(pre_quo);
- return(x - (y * quo));
+static bool is_number_via_method(s7_scheme *sc, s7_pointer p)
+{
+ if (s7_is_number(p))
+ return(true);
+ if (has_methods(p))
+ {
+ s7_pointer f;
+ f = find_method(sc, find_let(sc, p), sc->is_number_symbol);
+ if (f != sc->undefined)
+ return(is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->nil))));
+ }
+ return(false);
}
-static s7_pointer g_remainder(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_divide(s7_scheme *sc, s7_pointer args)
{
- #define H_remainder "(remainder x1 x2) returns the remainder of x1/x2; (remainder 10 3) = 1"
- #define Q_remainder pcl_r
- /* (define (rem x1 x2) (- x1 (* x2 (quo x1 x2)))) ; slib, if x2 is an integer (- x1 (truncate x1 x2)), fractional part: (remainder x 1) */
+ #define H_divide "(/ x1 ...) divides its first argument by the rest, or inverts the first if there is only one argument"
+ #define Q_divide pcl_n
- s7_pointer x, y;
- s7_int quo, d1, d2, n1, n2;
- s7_double pre_quo;
+ s7_pointer x, p;
+ s7_int num_a, den_a;
+ s7_double rl_a, im_a;
x = car(args);
- y = cadr(args);
+ p = cdr(args);
+ if (is_null(p))
+ {
+ if (!is_number(x))
+ method_or_bust_with_type_one_arg(sc, x, sc->divide_symbol, args, a_number_string);
+ if (s7_is_zero(x))
+ return(division_by_zero_error(sc, sc->divide_symbol, args));
+ return(s7_invert(sc, x));
+ }
switch (type(x))
{
case T_INTEGER:
- switch (type(y))
+ num_a = integer(x);
+ if (num_a == 0)
{
- case T_INTEGER:
- return(make_integer(sc, c_rem_int(sc, integer(x), integer(y))));
-
- case T_RATIO:
- n1 = integer(x);
- d1 = 1;
- n2 = numerator(y);
- d2 = denominator(y);
- goto RATIO_REM_RATIO;
-
- case T_REAL:
- if (real(y) == 0.0)
- return(division_by_zero_error(sc, sc->remainder_symbol, args));
- if ((is_inf(real(y))) || (is_NaN(real(y))))
- return(wrong_type_argument_with_type(sc, sc->remainder_symbol, 2, y, a_normal_real_string));
-
- pre_quo = (s7_double)integer(x) / real(y);
- if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
- return(simple_out_of_range(sc, sc->remainder_symbol, args, its_too_large_string));
- if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
- return(make_real(sc, integer(x) - real(y) * quo));
-
- default:
- method_or_bust(sc, y, sc->remainder_symbol, args, T_REAL, 2);
+ bool return_nan = false, return_real_zero = false;
+ for (; is_pair(p); p = cdr(p))
+ {
+ s7_pointer n;
+ n = car(p);
+ if (!s7_is_number(n))
+ {
+ n = check_values(sc, n, p);
+ if (!s7_is_number(n))
+ return(wrong_type_argument_with_type(sc, sc->divide_symbol, position_of(p, args), n, a_number_string));
+ }
+ if (s7_is_zero(n))
+ return(division_by_zero_error(sc, sc->divide_symbol, args));
+ if (type(n) > T_RATIO)
+ {
+ return_real_zero = true;
+ if (is_NaN(s7_real_part(n)))
+ return_nan = true;
+ }
+ }
+ if (return_nan)
+ return(real_NaN);
+ if (return_real_zero)
+ return(real_zero);
+ return(small_int(0));
}
- case T_RATIO:
- switch (type(y))
+ DIVIDE_INTEGERS:
+#if WITH_GMP
+ if ((num_a > s7_int32_max) ||
+ (num_a < s7_int32_min))
+ return(big_divide(sc, cons(sc, s7_int_to_big_integer(sc, num_a), p)));
+#endif
+ x = car(p);
+ p = cdr(p);
+
+ switch (type(x))
{
case T_INTEGER:
- n2 = integer(y);
- if (n2 == 0)
- return(division_by_zero_error(sc, sc->remainder_symbol, args));
- n1 = numerator(x);
- d1 = denominator(x);
- d2 = 1;
- goto RATIO_REM_RATIO;
+ if (integer(x) == 0)
+ return(division_by_zero_error(sc, sc->divide_symbol, args));
+
+ /* to be consistent, I suppose we should search first for NaNs in the divisor list.
+ * (* 0 0/0) is NaN, so (/ 1 0 0/0) should equal (/ 1 0/0) = NaN. But the whole
+ * thing is ridiculous.
+ */
+ if (is_null(p))
+ return(s7_make_ratio(sc, num_a, integer(x)));
+
+ den_a = integer(x);
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto DIVIDE_INTEGERS;
+ goto DIVIDE_RATIOS;
case T_RATIO:
- n1 = numerator(x);
- d1 = denominator(x);
- n2 = numerator(y);
- d2 = denominator(y);
- RATIO_REM_RATIO:
- if (d1 == d2)
- quo = (s7_int)(n1 / n2);
- else
- {
- if (n1 == n2)
- quo = (s7_int)(d2 / d1);
- else
- {
+ den_a = denominator(x);
#if HAVE_OVERFLOW_CHECKS
- s7_int n1d2, n2d1;
- if ((multiply_overflow(n1, d2, &n1d2)) ||
- (multiply_overflow(n2, d1, &n2d1)))
- {
- pre_quo = ((long double)n1 / (long double)n2) * ((long double)d2 / (long double)d1);
- if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
- return(simple_out_of_range(sc, sc->remainder_symbol, args, its_too_large_string));
- if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
- }
- else quo = n1d2 / n2d1;
+ {
+ s7_int dn;
+ if (multiply_overflow(num_a, den_a, &dn))
+ {
+ if (is_null(p)) return(make_real(sc, num_a * inverted_fraction(x)));
+ rl_a = (s7_double)num_a * inverted_fraction(x);
+ goto DIVIDE_REALS;
+ }
+ num_a = dn;
+ }
#else
- if ((integer_length(n1) + integer_length(d2) >= s7_int_bits) ||
- (integer_length(n2) + integer_length(d1) >= s7_int_bits))
- {
- pre_quo = ((long double)n1 / (long double)n2) * ((long double)d2 / (long double)d1);
- if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
- return(simple_out_of_range(sc, sc->remainder_symbol, args, its_too_large_string));
- if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
- }
- else quo = (n1 * d2) / (n2 * d1);
+ num_a *= den_a;
#endif
- }
- }
- if (quo == 0)
- return(x);
+ den_a = numerator(x);
+ if (is_null(p)) return(s7_make_ratio(sc, num_a, den_a));
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto DIVIDE_INTEGERS;
+ goto DIVIDE_RATIOS;
+
+ case T_REAL:
+ rl_a = (s7_double)num_a;
+ if (real(x) == 0.0)
+ return(division_by_zero_error(sc, sc->divide_symbol, args));
+ if (is_null(p)) return(make_real(sc, rl_a / real(x)));
+ rl_a /= real(x);
+ goto DIVIDE_REALS;
+
+ case T_COMPLEX:
+ {
+ s7_double i2, r2, den;
+ rl_a = (s7_double)num_a;
+ r2 = real_part(x);
+ i2 = imag_part(x);
+ den = 1.0 / (r2 * r2 + i2 * i2);
+ /* we could avoid the squaring (see Knuth II p613 16)
+ * not a big deal: (/ 1.0e308+1.0e308i 2.0e308+2.0e308i) => nan
+ * (gmp case is ok here)
+ */
+ if (is_null(p))
+ return(s7_make_complex(sc, rl_a * r2 * den, -(rl_a * i2 * den)));
+ im_a = -rl_a * i2 * den;
+ rl_a *= r2 * den;
+ goto DIVIDE_COMPLEX;
+ }
+
+ 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);
+ }
+ break;
+
+ case T_RATIO:
+ num_a = numerator(x);
+ den_a = denominator(x);
+ DIVIDE_RATIOS:
+#if WITH_GMP
+ if ((num_a > s7_int32_max) ||
+ (den_a > s7_int32_max) ||
+ (num_a < s7_int32_min))
+ return(big_divide(sc, cons(sc, s7_ratio_to_big_ratio(sc, num_a, den_a), p)));
+#endif
+ x = car(p);
+ p = cdr(p);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(x) == 0)
+ return(division_by_zero_error(sc, sc->divide_symbol, args));
#if HAVE_OVERFLOW_CHECKS
{
- s7_int dn, nq;
- if (!multiply_overflow(n2, quo, &nq))
+ s7_int dn;
+ if (multiply_overflow(den_a, integer(x), &dn))
{
- if ((d1 == d2) &&
- (!subtract_overflow(n1, nq, &dn)))
- return(s7_make_ratio(sc, dn, d1));
-
- if ((!multiply_overflow(n1, d2, &dn)) &&
- (!multiply_overflow(nq, d1, &nq)) &&
- (!subtract_overflow(dn, nq, &nq)) &&
- (!multiply_overflow(d1, d2, &d1)))
- return(s7_make_ratio(sc, nq, d1));
+ if (is_null(p)) return(make_real(sc, (long double)num_a / ((long double)den_a * (s7_double)integer(x))));
+ rl_a = (long double)num_a / ((long double)den_a * (s7_double)integer(x));
+ goto DIVIDE_REALS;
}
+ den_a = dn;
}
#else
- if ((d1 == d2) &&
- ((integer_length(n2) + integer_length(quo)) < s7_int_bits))
- return(s7_make_ratio(sc, n1 - n2 * quo, d1));
+ den_a *= integer(x);
+#endif
+ if (is_null(p)) return(s7_make_ratio(sc, num_a, den_a));
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto DIVIDE_INTEGERS;
+ goto DIVIDE_RATIOS;
- if ((integer_length(n1) + integer_length(d2) < s7_int_bits) &&
- (integer_length(d1) + integer_length(d2) < s7_int_bits) &&
- (integer_length(n2) + integer_length(d1) + integer_length(quo) < s7_int_bits))
- return(s7_make_ratio(sc, n1 * d2 - n2 * d1 * quo, d1 * d2));
+ case T_RATIO:
+ {
+ s7_int d1, d2, n1, n2;
+ d1 = den_a;
+ n1 = num_a;
+ d2 = denominator(x);
+ n2 = numerator(x);
+ if (d1 == d2)
+ {
+ if (is_null(p))
+ return(s7_make_ratio(sc, n1, n2));
+ den_a = n2;
+ }
+ else
+ {
+#if (!WITH_GMP) && HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(n1, d2, &n1)) ||
+ (multiply_overflow(n2, d1, &d1)))
+ {
+ s7_double r1, r2;
+ r1 = ((long double)num_a / (long double)den_a);
+ r2 = inverted_fraction(x);
+ if (is_null(p)) return(make_real(sc, r1 * r2));
+ rl_a = r1 * r2;
+ goto DIVIDE_REALS;
+ }
+ num_a = n1;
+ den_a = d1;
+#else
+ num_a *= d2;
+ den_a *= n2;
#endif
- return(simple_out_of_range(sc, sc->remainder_symbol, args, make_string_wrapper(sc, "intermediate (a/b) is too large")));
+ if (is_null(p))
+ return(s7_make_ratio(sc, num_a, den_a));
+ }
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto DIVIDE_INTEGERS;
+ goto DIVIDE_RATIOS;
+ }
case T_REAL:
{
- s7_double frac;
- if (real(y) == 0.0)
- return(division_by_zero_error(sc, sc->remainder_symbol, args));
- if ((is_inf(real(y))) || (is_NaN(real(y))))
- return(wrong_type_argument_with_type(sc, sc->remainder_symbol, 2, y, a_normal_real_string));
- frac = (s7_double)fraction(x);
- pre_quo = frac / real(y);
- if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
- return(simple_out_of_range(sc, sc->remainder_symbol, args, its_too_large_string));
- if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
- return(make_real(sc, frac - real(y) * quo));
+ s7_double r1;
+ if (real(x) == 0.0)
+ return(division_by_zero_error(sc, sc->divide_symbol, args));
+ r1 = ((long double)num_a / (long double)den_a);
+ if (is_null(p)) return(make_real(sc, r1 / real(x)));
+ rl_a = r1 / real(x);
+ goto DIVIDE_REALS;
+ }
+
+ case T_COMPLEX:
+ {
+ s7_double den, i2, r2;
+ rl_a = ((long double)num_a / (long double)den_a);
+ r2 = real_part(x);
+ i2 = imag_part(x);
+ den = 1.0 / (r2 * r2 + i2 * i2);
+ if (is_null(p))
+ return(s7_make_complex(sc, rl_a * r2 * den, -rl_a * i2 * den));
+ im_a = -rl_a * i2 * den;
+ rl_a *= r2 * den;
+ goto DIVIDE_COMPLEX;
}
default:
- method_or_bust(sc, y, sc->remainder_symbol, args, T_REAL, 2);
+ 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);
}
+ break;
case T_REAL:
- if ((is_inf(real(x))) || (is_NaN(real(x))))
- return(wrong_type_argument_with_type(sc, sc->remainder_symbol, 1, x, a_normal_real_string));
+ rl_a = real(x);
+ if (rl_a == 0)
+ {
+ bool return_nan = false;
+ for (; is_pair(p); p = cdr(p))
+ {
+ s7_pointer n;
+ n = car(p);
+ if (!s7_is_number(n))
+ {
+ n = check_values(sc, n, p);
+ if (!s7_is_number(n))
+ return(wrong_type_argument_with_type(sc, sc->divide_symbol, position_of(p, args), n, a_number_string));
+ }
+ if (s7_is_zero(n))
+ return(division_by_zero_error(sc, sc->divide_symbol, args));
+ if ((is_t_real(n)) &&
+ (is_NaN(real(n))))
+ return_nan = true;
+ }
+ if (return_nan)
+ return(real_NaN);
+ return(real_zero);
+ }
- switch (type(y))
+ DIVIDE_REALS:
+ x = car(p);
+ p = cdr(p);
+
+ switch (type(x))
{
case T_INTEGER:
- if (integer(y) == 0)
- return(division_by_zero_error(sc, sc->remainder_symbol, args));
- pre_quo = real(x) / (s7_double)integer(y);
- if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
- return(simple_out_of_range(sc, sc->remainder_symbol, args, its_too_large_string));
- if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
- return(make_real(sc, real(x) - integer(y) * quo));
- /* but... (remainder 1e+18 9223372036854775807) -> 1e+18 */
+ if (integer(x) == 0)
+ return(division_by_zero_error(sc, sc->divide_symbol, args));
+ if (is_null(p)) return(make_real(sc, rl_a / integer(x)));
+ rl_a /= (s7_double)integer(x);
+ goto DIVIDE_REALS;
case T_RATIO:
- {
- /* bad cases here start around 1e16: (remainder 1e15 3/13) -> 0.0 with loss of digits earlier
- * would long double help?
- */
- s7_double frac;
- frac = (s7_double)fraction(y);
- pre_quo = real(x) / frac;
- if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
- return(simple_out_of_range(sc, sc->remainder_symbol, args, its_too_large_string));
- if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
- return(make_real(sc, real(x) - frac * quo));
- }
+ if (is_null(p)) return(make_real(sc, rl_a * inverted_fraction(x)));
+ rl_a *= (s7_double)inverted_fraction(x);
+ goto DIVIDE_REALS;
case T_REAL:
- return(make_real(sc, c_rem_dbl(sc, real(x), real(y))));
+ if (real(x) == 0.0)
+ return(division_by_zero_error(sc, sc->divide_symbol, args));
+ if (is_null(p)) return(make_real(sc, rl_a / real(x)));
+ rl_a /= real(x);
+ goto DIVIDE_REALS;
- /* see under sin -- this calculation is completely bogus if "a" is large
- * (quotient 1e22 (* 2 pi)) -> -9223372036854775808 -- should this return arithmetic-overflow?
- * but it should be 1591549430918953357688,
- * (remainder 1e22 (* 2 pi)) -> 1.0057952155665e+22
- * -- the "remainder" is greater than the original argument!
- * Clisp gives 0.0 here, as does sbcl
- * currently s7 throws an error (out-of-range).
- */
+ case T_COMPLEX:
+ {
+ s7_double den, r2, i2;
+ r2 = real_part(x);
+ i2 = imag_part(x);
+ den = 1.0 / (r2 * r2 + i2 * i2);
+ if (is_null(p))
+ return(s7_make_complex(sc, rl_a * r2 * den, -rl_a * i2 * den));
+ im_a = -rl_a * i2 * den;
+ rl_a *= r2 * den;
+ goto DIVIDE_COMPLEX;
+ }
default:
- method_or_bust(sc, y, sc->remainder_symbol, args, T_REAL, 2);
+ 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);
}
+ break;
- default:
- method_or_bust(sc, x, sc->remainder_symbol, args, T_REAL, 1);
- }
-}
-
-IF2_TO_IF(remainder, c_rem_int)
-RF2_TO_RF(remainder, c_rem_dbl)
-
-
-/* -------------------------------- floor -------------------------------- */
+ case T_COMPLEX:
+ rl_a = real_part(x);
+ im_a = imag_part(x);
-#define REAL_TO_INT_LIMIT 9.2233727815085e+18
-/* unfortunately, this limit is only a max in a sense: (ceiling 9223372036854770.9) => 9223372036854770
- * see s7test for more examples
- */
+ DIVIDE_COMPLEX:
+ x = car(p);
+ p = cdr(p);
-static s7_pointer g_floor(s7_scheme *sc, s7_pointer args)
-{
- #define H_floor "(floor x) returns the integer closest to x toward -inf"
- #define Q_floor s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_real_symbol)
+ switch (type(x))
+ {
+ case T_INTEGER:
+ {
+ s7_double r1;
+ if (integer(x) == 0)
+ return(division_by_zero_error(sc, sc->divide_symbol, args));
+ r1 = 1.0 / (s7_double)integer(x);
+ if (is_null(p)) return(s7_make_complex(sc, rl_a * r1, im_a * r1));
+ rl_a *= r1;
+ im_a *= r1;
+ goto DIVIDE_COMPLEX;
+ }
- s7_pointer x;
+ case T_RATIO:
+ {
+ s7_double frac;
+ frac = inverted_fraction(x);
+ if (is_null(p)) return(s7_make_complex(sc, rl_a * frac, im_a * frac));
+ rl_a *= frac;
+ im_a *= frac;
+ goto DIVIDE_COMPLEX;
+ }
- x = car(args);
- switch (type(x))
- {
- case T_INTEGER:
- return(x);
+ case T_REAL:
+ {
+ s7_double r1;
+ if (real(x) == 0.0)
+ return(division_by_zero_error(sc, sc->divide_symbol, args));
+ r1 = 1.0 / real(x);
+ if (is_null(p)) return(s7_make_complex(sc, rl_a * r1, im_a * r1));
+ rl_a *= r1;
+ im_a *= r1;
+ goto DIVIDE_COMPLEX;
+ }
- case T_RATIO:
- {
- s7_int val;
- val = numerator(x) / denominator(x);
- /* C "/" truncates? -- C spec says "truncation toward 0" */
- /* we're avoiding "floor" here because the int->double conversion introduces inaccuracies for big numbers */
- if (numerator(x) < 0) /* not "val" because it might be truncated to 0 */
- return(make_integer(sc, val - 1));
- return(make_integer(sc, val));
- }
+ case T_COMPLEX:
+ {
+ s7_double r1, r2, i1, i2, den;
+ r1 = rl_a;
+ i1 = im_a;
+ r2 = real_part(x);
+ i2 = imag_part(x);
+ den = 1.0 / (r2 * r2 + i2 * i2);
+ if (is_null(p))
+ return(s7_make_complex(sc, (r1 * r2 + i1 * i2) * den, (r2 * i1 - r1 * i2) * den));
+ rl_a = (r1 * r2 + i1 * i2) * den;
+ im_a = (r2 * i1 - r1 * i2) * den;
+ goto DIVIDE_COMPLEX;
+ }
- case T_REAL:
- {
- s7_double z;
- z = real(x);
- if (is_NaN(z))
- return(simple_out_of_range(sc, sc->floor_symbol, x, its_nan_string));
- if (fabs(z) > REAL_TO_INT_LIMIT)
- return(simple_out_of_range(sc, sc->floor_symbol, x, its_too_large_string));
- return(make_integer(sc, (s7_int)floor(z)));
- /* floor here rounds down, whereas a straight int<=real coercion apparently rounds towards 0 */
- }
+ 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);
+ }
+ break;
- case T_COMPLEX:
default:
- method_or_bust(sc, x, sc->floor_symbol, args, T_REAL, 0);
+ method_or_bust_with_type(sc, x, sc->divide_symbol, args, a_number_string, 1);
}
}
-static s7_int c_floor(s7_scheme *sc, s7_double x) {return((s7_int)floor(x));}
-RF_TO_IF(floor, c_floor)
+#if (!WITH_GMP)
+static s7_pointer invert_1;
-/* -------------------------------- ceiling -------------------------------- */
-static s7_pointer g_ceiling(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_invert_1(s7_scheme *sc, s7_pointer args)
{
- #define H_ceiling "(ceiling x) returns the integer closest to x toward inf"
- #define Q_ceiling s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_real_symbol)
-
- s7_pointer x;
-
- x = car(args);
- switch (type(x))
+ s7_pointer p;
+ p = car(args);
+ switch (type(p))
{
case T_INTEGER:
- return(x);
+ if (integer(p) != 0)
+ return(s7_make_ratio(sc, 1, integer(p))); /* a already checked, not 0 */
+ return(division_by_zero_error(sc, sc->divide_symbol, args));
case T_RATIO:
- {
- s7_int val;
- val = numerator(x) / denominator(x);
- if (numerator(x) < 0)
- return(make_integer(sc, val));
- return(make_integer(sc, val + 1));
- }
+ return(s7_make_ratio(sc, denominator(p), numerator(p)));
case T_REAL:
+ if (real(p) != 0.0)
+ return(make_real(sc, 1.0 / real(p)));
+ return(division_by_zero_error(sc, sc->divide_symbol, args));
+
+ case T_COMPLEX:
{
- s7_double z;
- z = real(x);
- if (is_NaN(z))
- return(simple_out_of_range(sc, sc->ceiling_symbol, x, its_nan_string));
- if ((is_inf(z)) ||
- (z > REAL_TO_INT_LIMIT) ||
- (z < -REAL_TO_INT_LIMIT))
- return(simple_out_of_range(sc, sc->ceiling_symbol, x, its_too_large_string));
- return(make_integer(sc, (s7_int)ceil(real(x))));
+ s7_double r2, i2, den;
+ r2 = real_part(p);
+ i2 = imag_part(p);
+ den = (r2 * r2 + i2 * i2);
+ return(s7_make_complex(sc, r2 / den, -i2 / den));
}
- case T_COMPLEX:
default:
- method_or_bust(sc, x, sc->ceiling_symbol, args, T_REAL, 0);
+ method_or_bust_with_type(sc, p, sc->divide_symbol, args, a_number_string, 1);
}
}
-static s7_int c_ceiling(s7_scheme *sc, s7_double x) {return((s7_int)ceil(x));}
-RF_TO_IF(ceiling, c_ceiling)
-
-/* -------------------------------- truncate -------------------------------- */
-static s7_pointer g_truncate(s7_scheme *sc, s7_pointer args)
+static s7_pointer divide_1r;
+static s7_pointer g_divide_1r(s7_scheme *sc, s7_pointer args)
{
- #define H_truncate "(truncate x) returns the integer closest to x toward 0"
- #define Q_truncate s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_real_symbol)
-
- s7_pointer x;
- x = car(args);
- switch (type(x))
+ if (s7_is_real(cadr(args)))
{
- case T_INTEGER:
- return(x);
-
- case T_RATIO:
- return(make_integer(sc, (s7_int)(numerator(x) / denominator(x)))); /* C "/" already truncates */
-
- case T_REAL:
- {
- s7_double z;
- z = real(x);
- if (is_NaN(z))
- return(simple_out_of_range(sc, sc->truncate_symbol, x, its_nan_string));
- if (is_inf(z))
- return(simple_out_of_range(sc, sc->truncate_symbol, x, its_infinite_string));
- return(s7_truncate(sc, sc->truncate_symbol, real(x)));
- }
-
- case T_COMPLEX:
- default:
- method_or_bust(sc, x, sc->truncate_symbol, args, T_REAL, 0);
+ s7_double rl;
+ rl = real_to_double(sc, cadr(args), "/");
+ if (rl == 0.0)
+ return(division_by_zero_error(sc, sc->divide_symbol, args));
+ return(make_real(sc, 1.0 / rl));
}
+ return(g_divide(sc, args));
}
+#endif
-static s7_int c_trunc(s7_scheme *sc, s7_double x)
+
+static s7_double divide_d_d(s7_double x)
{
- if ((x > s7_int_max) || (x < s7_int_min))
- simple_out_of_range(sc, sc->truncate_symbol, make_real(sc, x), its_too_large_string);
- if (x > 0.0)
- return((s7_int)floor(x));
- return((s7_int)ceil(x));
+ if (x == 0.0) division_by_zero_error(cur_sc, cur_sc->divide_symbol, set_elist_1(cur_sc, real_zero));
+ return(1.0 / x);
}
-RF_TO_IF(truncate, c_trunc)
-
-
-/* -------------------------------- round -------------------------------- */
-static s7_double round_per_R5RS(s7_double x)
+static s7_double divide_d_dd(s7_double x1, s7_double x2)
{
- s7_double fl, ce, dfl, dce;
-
- fl = floor(x);
- ce = ceil(x);
- dfl = x - fl;
- dce = ce - x;
-
- if (dfl > dce) return(ce);
- if (dfl < dce) return(fl);
- if (fmod(fl, 2.0) == 0.0) return(fl);
- return(ce);
+ if (x2 == 0.0) division_by_zero_error(cur_sc, cur_sc->divide_symbol, set_elist_1(cur_sc, real_zero));
+ return(x1 / x2);
}
-static s7_pointer g_round(s7_scheme *sc, s7_pointer args)
+static s7_double divide_d_ddd(s7_double x1, s7_double x2, s7_double x3)
{
- #define H_round "(round x) returns the integer closest to x"
- #define Q_round s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_real_symbol)
-
- s7_pointer x;
- x = car(args);
- switch (type(x))
- {
- case T_INTEGER:
- return(x);
+ s7_double d;
+ d = x2 * x3;
+ if (d == 0.0) division_by_zero_error(cur_sc, cur_sc->divide_symbol, set_elist_1(cur_sc, real_zero));
+ return(x1 / d);
+}
- case T_RATIO:
- {
- s7_int truncated, remains;
- long double frac;
+static s7_double divide_d_dddd(s7_double x1, s7_double x2, s7_double x3, s7_double x4)
+{
+ s7_double d;
+ d = x2 * x3 * x4;
+ if (d == 0.0) division_by_zero_error(cur_sc, cur_sc->divide_symbol, set_elist_1(cur_sc, real_zero));
+ return(x1 / d);
+}
- truncated = numerator(x) / denominator(x);
- remains = numerator(x) % denominator(x);
- frac = s7_fabsl((long double)remains / (long double)denominator(x));
+static s7_pointer divide_p_ii(s7_int x, s7_int y) {return(s7_make_ratio(cur_sc, x, y));} /* make-ratio checks for y==0 */
- if ((frac > 0.5) ||
- ((frac == 0.5) &&
- (truncated % 2 != 0)))
- {
- if (numerator(x) < 0)
- return(make_integer(sc, truncated - 1));
- return(make_integer(sc, truncated + 1));
- }
- return(make_integer(sc, truncated));
- }
- case T_REAL:
- {
- s7_double z;
- z = real(x);
- if (is_NaN(z))
- return(simple_out_of_range(sc, sc->round_symbol, x, its_nan_string));
- if ((is_inf(z)) ||
- (z > REAL_TO_INT_LIMIT) ||
- (z < -REAL_TO_INT_LIMIT))
- return(simple_out_of_range(sc, sc->round_symbol, x, its_too_large_string));
- return(make_integer(sc, (s7_int)round_per_R5RS(z)));
- }
+/* ---------------------------------------- max/min ---------------------------------------- */
- case T_COMPLEX:
- default:
- method_or_bust(sc, x, sc->round_symbol, args, T_REAL, 0);
- }
+static bool is_real_via_method_1(s7_scheme *sc, s7_pointer p)
+{
+ s7_pointer f;
+ f = find_method(sc, find_let(sc, p), sc->is_real_symbol);
+ if (f != sc->undefined)
+ return(is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->nil))));
+ return(false);
}
-static s7_int c_round(s7_scheme *sc, s7_double x) {return((s7_int)round_per_R5RS(x));}
-RF_TO_IF(round, c_round)
+#define is_real_via_method(sc, p) ((s7_is_real(p)) || ((has_methods(p)) && (is_real_via_method_1(sc, p))))
-static s7_int c_mod(s7_scheme *sc, s7_int x, s7_int y)
+static s7_pointer g_max(s7_scheme *sc, s7_pointer args)
{
- s7_int z;
- /* if (y == 0) return(x); */ /* else arithmetic exception, but we're checking for this elsewhere */
- z = x % y;
- if (((y < 0) && (z > 0)) ||
- ((y > 0) && (z < 0)))
- return(z + y);
- return(z);
-}
+ #define H_max "(max ...) returns the maximum of its arguments"
+ #define Q_max pcl_r
-static s7_pointer g_modulo(s7_scheme *sc, s7_pointer args)
-{
- #define H_modulo "(modulo x1 x2) returns x1 mod x2; (modulo 4 3) = 1. The arguments can be real numbers."
- #define Q_modulo pcl_r
- /* (define (mod x1 x2) (- x1 (* x2 (floor (/ x1 x2))))) from slib
- * (mod x 0) = x according to "Concrete Mathematics"
- */
- s7_pointer x, y;
- s7_double a, b;
- s7_int n1, n2, d1, d2;
+ s7_pointer x, y, p;
+ s7_int num_a, num_b, den_a, den_b;
x = car(args);
- y = cadr(args);
+ p = cdr(args);
switch (type(x))
{
case T_INTEGER:
+ MAX_INTEGERS:
+ if (is_null(p)) return(x);
+ y = car(p);
+ p = cdr(p);
switch (type(y))
{
case T_INTEGER:
- if (integer(y) == 0)
- return(x);
- if ((integer(y) == 1) || (integer(y) == -1))
- return(small_int(0));
- /* (modulo most-negative-fixnum -1) will segfault with arithmetic exception */
- return(make_integer(sc, c_mod(sc, integer(x), integer(y))));
+ if (integer(x) < integer(y)) x = y;
+ goto MAX_INTEGERS;
case T_RATIO:
- n1 = integer(x);
- d1 = 1;
- n2 = numerator(y);
- d2 = denominator(y);
- goto RATIO_MOD_RATIO;
+ num_a = integer(x);
+ den_a = 1;
+ num_b = numerator(y);
+ den_b = denominator(y);
+ goto RATIO_MAX_RATIO;
case T_REAL:
- b = real(y);
- if (b == 0.0) return(x);
- if (is_NaN(b)) return(y);
- if (is_inf(b)) return(real_NaN);
- a = (s7_double)integer(x);
- return(make_real(sc, a - b * (s7_int)floor(a / b)));
+ if (is_NaN(real(y)))
+ {
+ for (; is_not_null(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->max_symbol, position_of(p, args), car(p), T_REAL));
+ return(y);
+ }
+ if (integer(x) < real(y))
+ {
+ x = y;
+ goto MAX_REALS;
+ }
+ goto MAX_INTEGERS;
default:
- method_or_bust(sc, y, sc->modulo_symbol, args, T_REAL, 2);
+ method_or_bust(sc, y, sc->max_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
+
case T_RATIO:
+ MAX_RATIOS:
+ if (is_null(p)) return(x);
+ y = car(p);
+ p = cdr(p);
switch (type(y))
{
case T_INTEGER:
- if (integer(y) == 0) return(x);
- n1 = numerator(x);
- d1 = denominator(x);
- n2 = integer(y);
-
- if ((n2 > 0) && (n1 > 0) && (n2 > n1)) return(x);
- if ((n2 < 0) && (n1 < 0) && (n2 < n1)) return(x);
-
- if (n2 == s7_int_min)
- return(simple_out_of_range(sc, sc->modulo_symbol, y, make_string_wrapper(sc, "intermediate (a/b) is too large")));
- /* the problem here is that (modulo 3/2 most-negative-fixnum)
- * will segfault with signal SIGFPE, Arithmetic exception, so try to trap it.
- */
-
- d2 = 1;
- goto RATIO_MOD_RATIO;
+ num_a = numerator(x);
+ den_a = denominator(x);
+ num_b = integer(y);
+ den_b = 1;
+ goto RATIO_MAX_RATIO;
case T_RATIO:
- n1 = numerator(x);
- d1 = denominator(x);
- n2 = numerator(y); /* can't be 0 */
- d2 = denominator(y);
- if (d1 == d2)
- return(s7_make_ratio(sc, c_mod(sc, n1, n2), d1));
-
- RATIO_MOD_RATIO:
-
- if ((n1 == n2) &&
- (d1 > d2))
- return(x); /* signs match so this should be ok */
-#if HAVE_OVERFLOW_CHECKS
- {
- s7_int n2d1, n1d2, d1d2, fl;
- if (!multiply_overflow(n2, d1, &n2d1))
- {
- if (n2d1 == 1)
- return(small_int(0));
-
- if (!multiply_overflow(n1, d2, &n1d2))
- {
- /* can't use "floor" here (int->float ruins everything) */
- fl = (s7_int)(n1d2 / n2d1);
- if (((n1 < 0) && (n2 > 0)) ||
- ((n1 > 0) && (n2 < 0)))
- fl -= 1;
-
- if (fl == 0)
- return(x);
+ num_a = numerator(x);
+ den_a = denominator(x);
+ num_b = numerator(y);
+ den_b = denominator(y);
- if ((!multiply_overflow(d1, d2, &d1d2)) &&
- (!multiply_overflow(fl, n2d1, &fl)) &&
- (!subtract_overflow(n1d2, fl, &fl)))
- return(s7_make_ratio(sc, fl, d1d2));
- }
- }
- }
-#else
- if ((integer_length(n1) + integer_length(d2) < s7_int_bits) &&
- (integer_length(n2) + integer_length(d1) < s7_int_bits) &&
- (integer_length(d1) + integer_length(d2) < s7_int_bits))
+ RATIO_MAX_RATIO:
+ /* there are tricky cases here where long ints outrun doubles:
+ * (max 92233720368547758/9223372036854775807 92233720368547757/9223372036854775807)
+ * which should be 92233720368547758/9223372036854775807) but first the fraction gets reduced
+ * to 13176245766935394/1317624576693539401, so we fall into the double comparison, and
+ * there we should be comparing
+ * 9.999999999999999992410584792601468961145E-3 and
+ * 9.999999999999999883990367544051025548645E-3
+ * but if using doubles we get
+ * 0.010000000000000000208166817117 and
+ * 0.010000000000000000208166817117
+ * that is, we can't distinguish these two fractions once they're coerced to doubles.
+ *
+ * Even long doubles fail in innocuous-looking cases:
+ * (min 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
+ * (max 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
+ *
+ * Another consequence: outside gmp, we can't handle cases like
+ * (max 9223372036854776/9223372036854775807 #i9223372036854775/9223372036854775000)
+ * (max #i9223372036854776/9223372036854775807 9223372036854775/9223372036854775000)
+ * I guess if the user is using "inexact" numbers (#i...), he accepts their inexactness.
+ */
+
+ if ((num_a < 0) && (num_b >= 0)) /* x < 0, y >= 0 -> y */
+ x = y;
+ else
{
- s7_int n1d2, n2d1, fl;
- n1d2 = n1 * d2;
- n2d1 = n2 * d1;
-
- if (n2d1 == 1)
- return(small_int(0));
-
- /* can't use "floor" here (int->float ruins everything) */
- fl = (s7_int)(n1d2 / n2d1);
- if (((n1 < 0) && (n2 > 0)) ||
- ((n1 > 0) && (n2 < 0)))
- fl -= 1;
-
- if (fl == 0)
- return(x);
-
- if (integer_length(n2d1) + integer_length(fl) < s7_int_bits)
- return(s7_make_ratio(sc, n1d2 - (n2d1 * fl), d1 * d2));
+ if ((num_a < 0) || (num_b >= 0))
+ {
+ if (den_a == den_b)
+ {
+ if (num_a < num_b)
+ x = y;
+ }
+ else
+ {
+ if (num_a == num_b)
+ {
+ if (((num_a >= 0) &&
+ (den_a > den_b)) ||
+ ((num_a < 0) &&
+ (den_a < den_b)))
+ x = y;
+ }
+ else
+ {
+ s7_int vala, valb;
+ vala = num_a / den_a;
+ valb = num_b / den_b;
+ if (!((vala > valb) ||
+ ((vala == valb) && (is_t_integer(y)))))
+ {
+ if ((valb > vala) ||
+ ((vala == valb) && (is_t_integer(x))) ||
+ /* sigh -- both are ratios and the int parts are equal */
+ (((long double)(num_a % den_a) / (long double)den_a) <= ((long double)(num_b % den_b) / (long double)den_b)))
+ x = y;
+ }
+ }
+ }
+ }
}
-#endif
-
- /* there are cases here we might want to catch:
- * (modulo 9223372036 1/9223372036) -> error, not 0?
- * (modulo 1 1/9223372036854775807) -> error, not 0?
- */
- return(simple_out_of_range(sc, sc->modulo_symbol, x, make_string_wrapper(sc, "intermediate (a/b) is too large")));
+ if (is_t_ratio(x))
+ goto MAX_RATIOS;
+ goto MAX_INTEGERS;
case T_REAL:
- b = real(y);
- if (b == 0.0) return(x);
- if (is_NaN(b)) return(y);
- if (is_inf(b)) return(real_NaN);
- a = fraction(x);
- return(make_real(sc, a - b * (s7_int)floor(a / b)));
+ /* (max 3/4 nan.0) should probably return NaN */
+ if (is_NaN(real(y)))
+ {
+ for (; is_not_null(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->max_symbol, position_of(p, args), car(p), T_REAL));
+ return(y);
+ }
+
+ if (fraction(x) < real(y))
+ {
+ x = y;
+ goto MAX_REALS;
+ }
+ goto MAX_RATIOS;
default:
- method_or_bust(sc, y, sc->modulo_symbol, args, T_REAL, 2);
+ method_or_bust(sc, y, sc->max_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
+
case T_REAL:
- a = real(x);
+ if (is_NaN(real(x)))
+ {
+ for (; is_not_null(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->max_symbol, position_of(p, args), car(p), T_REAL));
+ return(x);
+ }
+
+ MAX_REALS:
+ if (is_null(p)) return(x);
+ y = car(p);
+ p = cdr(p);
switch (type(y))
{
case T_INTEGER:
- if (is_NaN(a)) return(x);
- if (is_inf(a)) return(real_NaN);
- if (integer(y) == 0) return(x);
- b = (s7_double)integer(y);
- return(make_real(sc, a - b * (s7_int)floor(a / b)));
+ if (real(x) < integer(y))
+ {
+ x = y;
+ goto MAX_INTEGERS;
+ }
+ goto MAX_REALS;
case T_RATIO:
- if (is_NaN(a)) return(x);
- if (is_inf(a)) return(real_NaN);
- b = fraction(y);
- return(make_real(sc, a - b * (s7_int)floor(a / b)));
+ if (real(x) < fraction(y))
+ {
+ x = y;
+ goto MAX_RATIOS;
+ }
+ goto MAX_REALS;
case T_REAL:
- if (is_NaN(a)) return(x);
- if (is_inf(a)) return(real_NaN);
- b = real(y);
- if (b == 0.0) return(x);
- if (is_NaN(b)) return(y);
- if (is_inf(b)) return(real_NaN);
- return(make_real(sc, a - b * (s7_int)floor(a / b)));
+ if (is_NaN(real(y)))
+ {
+ for (; is_not_null(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->max_symbol, position_of(p, args), car(p), T_REAL));
+ return(y);
+ }
+ if (real(x) < real(y)) x = y;
+ goto MAX_REALS;
default:
- method_or_bust(sc, y, sc->modulo_symbol, args, T_REAL, 2);
+ method_or_bust(sc, y, sc->max_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
default:
- method_or_bust(sc, x, sc->modulo_symbol, args, T_REAL, 1);
+ method_or_bust(sc, x, sc->max_symbol, cons(sc, x, p), T_REAL, 1);
}
}
-IF2_TO_IF(modulo, c_mod)
-static s7_double c_mod_r(s7_scheme *sc, s7_double x, s7_double y) {return(x - y * (s7_int)floor(x / y));}
-RF2_TO_RF(modulo, c_mod_r)
+static s7_int max_i_ii(s7_int i1, s7_int i2) {return((i1 > i2) ? i1 : i2);}
+static s7_double max_d_dd(s7_double x1, s7_double x2) {return((x1 > x2) ? x1 : x2);}
-static s7_pointer mod_si;
-static s7_pointer g_mod_si(s7_scheme *sc, s7_pointer args)
+#if (!WITH_GMP)
+static s7_pointer max_f2;
+static s7_pointer g_max_f2(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
- s7_int y;
-
- x = find_symbol_checked(sc, car(args));
- y = integer(cadr(args));
+ s7_pointer x, y;
+ x = car(args);
+ y = cadr(args);
+ if (is_t_real(y))
+ return((real(x) >= real(y)) ? x : y);
+ if (is_real(y))
+ return((real(x) >= real_to_double(sc, y, "max")) ? x : y);
+ method_or_bust(sc, y, sc->max_symbol, args, T_REAL, 2);
+}
+#endif
- if (is_integer(x))
- {
- s7_int z;
- /* here we know y is positive */
- z = integer(x) % y;
- if (z < 0)
- return(make_integer(sc, z + y));
- return(make_integer(sc, z));
- }
+static s7_pointer g_min(s7_scheme *sc, s7_pointer args)
+{
+ #define H_min "(min ...) returns the minimum of its arguments"
+ #define Q_min pcl_r
- if (is_t_real(x))
- {
- s7_double a, b;
- a = real(x);
- if (is_NaN(a)) return(x);
- if (is_inf(a)) return(real_NaN);
- b = (s7_double)y;
- return(make_real(sc, a - b * (s7_int)floor(a / b)));
- }
+ s7_pointer x, y, p;
+ s7_int num_a, num_b, den_a, den_b;
- if (s7_is_ratio(x))
- return(g_modulo(sc, set_plist_2(sc, x, cadr(args))));
+ x = car(args);
+ p = cdr(args);
- method_or_bust(sc, x, sc->modulo_symbol, list_2(sc, x, cadr(args)), T_REAL, 1);
-}
+ switch (type(x))
+ {
+ case T_INTEGER:
+ MIN_INTEGERS:
+ if (is_null(p)) return(x);
+ y = car(p);
+ p = cdr(p);
-static s7_pointer g_is_zero(s7_scheme *sc, s7_pointer args);
-static s7_pointer mod_si_is_zero;
-static s7_pointer g_mod_si_is_zero(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer x;
- s7_int y;
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(x) > integer(y)) x = y;
+ goto MIN_INTEGERS;
- /* car is (modulo symbol integer), cadr is 0 or not present (if zero?) */
- x = find_symbol_checked(sc, cadar(args));
- y = integer(caddar(args));
+ case T_RATIO:
+ num_a = integer(x);
+ den_a = 1;
+ num_b = numerator(y);
+ den_b = denominator(y);
+ goto RATIO_MIN_RATIO;
- if (is_integer(x))
- return(make_boolean(sc, (integer(x) % y) == 0));
+ case T_REAL:
+ if (is_NaN(real(y)))
+ {
+ for (; is_not_null(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->min_symbol, position_of(p, args), car(p), T_REAL));
+ return(y);
+ }
+ if (integer(x) > real(y))
+ {
+ x = y;
+ goto MIN_REALS;
+ }
+ goto MIN_INTEGERS;
- if (is_t_real(x))
- return(make_boolean(sc, (fmod(real(x), (s7_double)y) == 0.0)));
+ default:
+ method_or_bust(sc, y, sc->min_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
- if (s7_is_ratio(x))
- return(sc->F);
- {
- s7_pointer func;
- if ((func = find_method(sc, find_let(sc, x), sc->modulo_symbol)) != sc->undefined)
- return(g_is_zero(sc, set_plist_1(sc, s7_apply_function(sc, func, list_2(sc, x, caddar(args))))));
- }
- return(wrong_type_argument(sc, sc->modulo_symbol, 1, x, T_REAL));
-}
-#endif
-/* !WITH_GMP */
+ case T_RATIO:
+ MIN_RATIOS:
+ if (is_null(p)) return(x);
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ num_a = numerator(x);
+ den_a = denominator(x);
+ num_b = integer(y);
+ den_b = 1;
+ goto RATIO_MIN_RATIO;
-static int reduce_fraction(s7_scheme *sc, s7_int *numer, s7_int *denom)
-{
- /* we're assuming in several places that we have a normal s7 rational after returning,
- * so the denominator needs to be positive.
- */
- s7_int divisor;
+ case T_RATIO:
+ num_a = numerator(x);
+ den_a = denominator(x);
+ num_b = numerator(y);
+ den_b = denominator(y);
- if (*numer == 0)
- {
- *denom = 1;
- return(T_INTEGER);
- }
- if (*denom < 0)
- {
- if (*denom == *numer)
- {
- *denom = 1;
- *numer = 1;
- return(T_INTEGER);
+ RATIO_MIN_RATIO:
+ if ((num_a >= 0) && (num_b < 0))
+ x = y;
+ else
+ {
+ if ((num_a >= 0) || (num_b < 0))
+ {
+ if (den_a == den_b)
+ {
+ if (num_a > num_b)
+ x = y;
+ }
+ else
+ {
+ if (num_a == num_b)
+ {
+ if (((num_a >= 0) &&
+ (den_a < den_b)) ||
+ ((num_a < 0) &&
+ (den_a > den_b)))
+ x = y;
+ }
+ else
+ {
+ s7_int vala, valb;
+ vala = num_a / den_a;
+ valb = num_b / den_b;
+
+ if (!((vala < valb) ||
+ ((vala == valb) && (is_t_integer(x)))))
+ {
+ if ((valb < vala) ||
+ ((vala == valb) && (is_t_integer(y))) ||
+ (((long double)(num_a % den_a) / (long double)den_a) >= ((long double)(num_b % den_b) / (long double)den_b)))
+ x = y;
+ }
+ }
+ }
+ }
+ }
+ if (is_t_ratio(x))
+ goto MIN_RATIOS;
+ goto MIN_INTEGERS;
+
+ case T_REAL:
+ /* (min 3/4 nan.0) should probably return NaN */
+ if (is_NaN(real(y)))
+ {
+ for (; is_not_null(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->min_symbol, position_of(p, args), car(p), T_REAL));
+ return(y);
+ }
+ if (fraction(x) > real(y))
+ {
+ x = y;
+ goto MIN_REALS;
+ }
+ 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);
}
- if (*denom == s7_int_min)
+
+
+ case T_REAL:
+ if (is_NaN(real(x)))
{
- if (*numer & 1)
- return(T_RATIO);
- *denom /= 2;
- *numer /= 2;
+ for (; is_not_null(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->min_symbol, position_of(p, args), car(p), T_REAL));
+ return(x);
}
- else
+
+ MIN_REALS:
+ if (is_null(p)) return(x);
+ y = car(p);
+ p = cdr(p);
+
+ switch (type(y))
{
- if (*numer == s7_int_min)
+ case T_INTEGER:
+ if (real(x) > integer(y))
{
- if (*denom & 1)
- return(T_RATIO);
- *denom /= 2;
- *numer /= 2;
+ x = y;
+ goto MIN_INTEGERS;
+ }
+ goto MIN_REALS;
+
+ case T_RATIO:
+ if (real(x) > fraction(y))
+ {
+ x = y;
+ goto MIN_RATIOS;
}
+ goto MIN_REALS;
+
+ case T_REAL:
+ if (is_NaN(real(y)))
+ {
+ for (; is_not_null(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->min_symbol, position_of(p, args), car(p), T_REAL));
+ return(y);
+ }
+ if (real(x) > real(y)) x = y;
+ 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);
}
- *denom = -*denom;
- *numer = -*numer;
- }
- divisor = c_gcd(*numer, *denom);
- if (divisor != 1)
- {
- *numer /= divisor;
- *denom /= divisor;
+
+ default:
+ method_or_bust(sc, x, sc->min_symbol, cons(sc, x, p), T_REAL, 1);
}
- if (*denom == 1)
- return(T_INTEGER);
- return(T_RATIO);
}
+static s7_int min_i_ii(s7_int i1, s7_int i2) {return((i1 < i2) ? i1 : i2);}
+static s7_double min_d_dd(s7_double x1, s7_double x2) {return((x1 < x2) ? x1 : x2);}
+
+#if (!WITH_GMP)
+static s7_pointer min_f2;
+static s7_pointer g_min_f2(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x, y;
+ x = car(args);
+ y = cadr(args);
+ if (is_t_real(y))
+ return((real(x) <= real(y)) ? x : y);
+ if (is_real(y))
+ return((real(x) <= real_to_double(sc, y, "min")) ? x : y);
+ method_or_bust(sc, y, sc->min_symbol, args, T_REAL, 2);
+}
+#endif
+
-/* ---------------------------------------- add ---------------------------------------- */
+/* ---------------------------------------- = > < >= <= ---------------------------------------- */
-static s7_pointer g_add(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_equal(s7_scheme *sc, s7_pointer args)
{
- #define H_add "(+ ...) adds its arguments"
- #define Q_add pcl_n
+ #define H_equal "(= z1 ...) returns #t if all its arguments are equal"
+ #define Q_equal s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_number_symbol)
s7_pointer x, p;
- s7_int num_a, den_a, dn;
+ s7_int num_a, den_a;
s7_double rl_a, im_a;
-#if (!WITH_GMP)
- if (is_null(args))
- return(small_int(0));
-#endif
-
x = car(args);
p = cdr(args);
- if (is_null(p))
- {
- if (!is_number(x))
- method_or_bust_with_type(sc, x, sc->add_symbol, args, a_number_string, 0);
- return(x);
- }
switch (type(x))
{
case T_INTEGER:
num_a = integer(x);
-
- ADD_INTEGERS:
-#if WITH_GMP
- if ((num_a > s7_int32_max) ||
- (num_a < s7_int32_min))
- return(big_add(sc, cons(sc, s7_int_to_big_integer(sc, num_a), p)));
-#endif
- x = car(p);
- p = cdr(p);
-
- switch (type(x))
+ while (true)
{
- case T_INTEGER:
-#if HAVE_OVERFLOW_CHECKS
- if (add_overflow(num_a, integer(x), &den_a))
- {
- rl_a = (s7_double)num_a + (s7_double)integer(x);
- if (is_null(p)) return(make_real(sc, rl_a));
- goto ADD_REALS;
- }
-#else
- den_a = num_a + integer(x);
- if (den_a < 0)
- {
- if ((num_a > 0) && (integer(x) > 0))
- {
- rl_a = (s7_double)num_a + (s7_double)integer(x);
- if (is_null(p)) return(make_real(sc, rl_a));
- goto ADD_REALS;
- }
- }
- else
- {
- if ((num_a < 0) && (integer(x) < 0))
- {
- rl_a = (s7_double)num_a + (s7_double)integer(x);
- if (is_null(p)) return(make_real(sc, rl_a));
-
- /* this is not ideal! piano.scm has its own noise generator that wants integer
- * arithmetic to overflow as an integer. Perhaps 'safety==0 would not check
- * anywhere?
- */
- goto ADD_REALS;
- }
- }
-#endif
- if (is_null(p)) return(make_integer(sc, den_a));
- num_a = den_a;
- /* (+ 4611686018427387904 4611686018427387904) -> -9223372036854775808
- * (+ most-positive-fixnum most-positive-fixnum) -> -2
- * (+ most-negative-fixnum most-negative-fixnum) -> 0
- * can't check result - arg: (- 0 most-negative-fixnum) -> most-negative-fixnum
- */
- goto ADD_INTEGERS;
-
- case T_RATIO:
- den_a = denominator(x);
-#if HAVE_OVERFLOW_CHECKS
- if ((multiply_overflow(den_a, num_a, &dn)) ||
- (add_overflow(dn, numerator(x), &dn)))
-#else
- if ((integer_length(num_a) + integer_length(den_a) + integer_length(numerator(x))) < s7_int_bits)
- dn = numerator(x) + (num_a * den_a);
- else
-#endif
+ x = car(p);
+ p = cdr(p);
+ switch (type(x))
{
- if (is_null(p))
- {
- if (num_a == 0) /* (+ 0 1/9223372036854775807) */
- return(x);
- return(make_real(sc, num_a + fraction(x)));
- }
- rl_a = (s7_double)num_a + fraction(x);
- goto ADD_REALS;
- }
- if (is_null(p)) return(s7_make_ratio(sc, dn, den_a));
- num_a = dn;
-
- /* overflow examples:
- * (+ 100000 1/142857142857140) -> -832205957599110323/28571428571428
- * (+ 4611686018427387904 3/4) -> 3/4
- * see s7test for more
- */
- goto ADD_RATIOS;
+ case T_INTEGER:
+ if (num_a != integer(x)) goto NOT_EQUAL;
+ break;
- case T_REAL:
- if (is_null(p)) return(make_real(sc, num_a + real(x)));
- rl_a = (s7_double)num_a + real(x);
- goto ADD_REALS;
+ case T_RATIO:
+ case T_COMPLEX:
+ goto NOT_EQUAL;
- case T_COMPLEX:
- if (is_null(p)) return(s7_make_complex(sc, num_a + real_part(x), imag_part(x)));
- rl_a = (s7_double)num_a + real_part(x);
- im_a = imag_part(x);
- goto ADD_COMPLEX;
+ case T_REAL:
+ if (num_a != real(x)) goto NOT_EQUAL;
+ break;
- 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);
+ 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);
+ }
+ if (is_null(p))
+ return(sc->T);
}
- break;
case T_RATIO:
num_a = numerator(x);
den_a = denominator(x);
- ADD_RATIOS:
-#if WITH_GMP
- if ((num_a > s7_int32_max) ||
- (den_a > s7_int32_max) ||
- (num_a < s7_int32_min))
- return(big_add(sc, cons(sc, s7_ratio_to_big_ratio(sc, num_a, den_a), p)));
-#endif
- x = car(p);
- p = cdr(p);
-
- switch (type(x))
+ rl_a = 0.0;
+ while (true)
{
- case T_INTEGER:
-#if HAVE_OVERFLOW_CHECKS
- if ((multiply_overflow(den_a, integer(x), &dn)) ||
- (add_overflow(dn, num_a, &dn)))
-#else
- if ((integer_length(integer(x)) + integer_length(den_a) + integer_length(num_a)) < s7_int_bits)
- dn = num_a + (integer(x) * den_a);
- else
-#endif
+ x = car(p);
+ p = cdr(p);
+ switch (type(x))
{
- /* (+ 3/4 4611686018427387904) -> 3/4
- * (+ 1/17179869184 1073741824) -> 1/17179869184
- * (+ 1/8589934592 1073741824) -> -9223372036854775807/8589934592
- */
- if (is_null(p))
- return(make_real(sc, (s7_double)integer(x) + ((long double)num_a / (long double)den_a)));
- rl_a = (s7_double)integer(x) + ((long double)num_a / (long double)den_a);
- goto ADD_REALS;
- }
- if (is_null(p)) return(s7_make_ratio(sc, dn, den_a));
- num_a = dn;
- if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
- goto ADD_INTEGERS;
- goto ADD_RATIOS;
-
- case T_RATIO:
- {
- s7_int d1, d2, n1, n2;
- d1 = den_a;
- n1 = num_a;
- d2 = denominator(x);
- n2 = numerator(x);
- if (d1 == d2) /* the easy case -- if overflow here, it matches the int case */
- {
- if (is_null(p))
- return(s7_make_ratio(sc, n1 + n2, d1));
- num_a += n2; /* d1 can't be zero */
- }
- else
- {
-#if (!WITH_GMP)
-#if HAVE_OVERFLOW_CHECKS
- s7_int n1d2, n2d1;
- if ((multiply_overflow(d1, d2, &den_a)) ||
- (multiply_overflow(n1, d2, &n1d2)) ||
- (multiply_overflow(n2, d1, &n2d1)) ||
- (add_overflow(n1d2, n2d1, &num_a)))
- {
- if (is_null(p))
- return(make_real(sc, ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2)));
- rl_a = ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2);
- goto ADD_REALS;
- }
-#else
- if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
- (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
- (n1 < s7_int32_min) || (n2 < s7_int32_min))
- {
- int d1bits, d2bits;
- d1bits = integer_length(d1);
- d2bits = integer_length(d2);
- if (((d1bits + d2bits) > s7_int_bits) ||
- ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
- ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
- {
- if (is_null(p))
- return(make_real(sc, ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2)));
- rl_a = ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2);
- /* this can lose:
- * (+ 1 1/9223372036854775807 -1) -> 0.0 not 1/9223372036854775807
- */
- goto ADD_REALS;
- }
- }
- num_a = n1 * d2 + n2 * d1;
- den_a = d1 * d2;
-#endif
-#else
- num_a = n1 * d2 + n2 * d1;
- den_a = d1 * d2;
-#endif
- if (is_null(p))
- return(s7_make_ratio(sc, num_a, den_a));
- }
- /* (+ 1/100 99/100 (- most-positive-fixnum 2)) should not be converted to real
- */
- if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
- goto ADD_INTEGERS;
- goto ADD_RATIOS;
- }
+ case T_INTEGER:
+ case T_COMPLEX:
+ goto NOT_EQUAL;
- case T_REAL:
- if (is_null(p)) return(make_real(sc, ((long double)num_a / (long double)den_a) + real(x)));
- rl_a = ((long double)num_a / (long double)den_a) + real(x);
- goto ADD_REALS;
+ case T_RATIO:
+ if ((num_a != numerator(x)) || (den_a != denominator(x))) goto NOT_EQUAL; /* hidden cast here */
+ break;
- case T_COMPLEX:
- if (is_null(p)) return(s7_make_complex(sc, ((long double)num_a / (long double)den_a) + real_part(x), imag_part(x)));
- rl_a = ((long double)num_a / (long double)den_a) + real_part(x);
- im_a = imag_part(x);
- goto ADD_COMPLEX;
+ case T_REAL:
+ if (rl_a == 0.0)
+ rl_a = ((long double)num_a) / ((long double)den_a);
+ if (rl_a != real(x)) goto NOT_EQUAL;
+ break;
- 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);
+ 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);
+ }
+ if (is_null(p))
+ return(sc->T);
}
- break;
case T_REAL:
rl_a = real(x);
-
- ADD_REALS:
- x = car(p);
- p = cdr(p);
-
- switch (type(x))
+ while (true)
{
- case T_INTEGER:
- if (is_null(p)) return(make_real(sc, rl_a + integer(x)));
- rl_a += (s7_double)integer(x);
- goto ADD_REALS;
+ x = car(p);
+ p = cdr(p);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (rl_a != integer(x)) goto NOT_EQUAL;
+ break;
- case T_RATIO:
- if (is_null(p)) return(make_real(sc, rl_a + fraction(x)));
- rl_a += (s7_double)fraction(x);
- goto ADD_REALS;
+ case T_RATIO:
+ if (rl_a != (double)fraction(x)) goto NOT_EQUAL;
+ /* the cast to double is needed because rl_a is s7_double and we want (= ratio real) to be the same as (= real ratio):
+ * (= 1.0 9223372036854775807/9223372036854775806)
+ * (= 9223372036854775807/9223372036854775806 1.0)
+ */
+ break;
- case T_REAL:
- if (is_null(p)) return(make_real(sc, rl_a + real(x)));
- rl_a += real(x);
- goto ADD_REALS;
+ case T_REAL:
+ if (rl_a != real(x)) goto NOT_EQUAL;
+ break;
- case T_COMPLEX:
- if (is_null(p)) return(s7_make_complex(sc, rl_a + real_part(x), imag_part(x)));
- rl_a += real_part(x);
- im_a = imag_part(x);
- goto ADD_COMPLEX;
+ case T_COMPLEX:
+ goto NOT_EQUAL;
- 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);
+ 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);
+ }
+ if (is_null(p))
+ return(sc->T);
}
- break;
case T_COMPLEX:
rl_a = real_part(x);
im_a = imag_part(x);
-
- ADD_COMPLEX:
- x = car(p);
- p = cdr(p);
-
- switch (type(x))
+ while (true)
{
- case T_INTEGER:
- if (is_null(p)) return(s7_make_complex(sc, rl_a + integer(x), im_a));
- rl_a += (s7_double)integer(x);
- goto ADD_COMPLEX;
-
- case T_RATIO:
- if (is_null(p)) return(s7_make_complex(sc, rl_a + fraction(x), im_a));
- rl_a += (s7_double)fraction(x);
- goto ADD_COMPLEX;
-
- case T_REAL:
- if (is_null(p)) return(s7_make_complex(sc, rl_a + real(x), im_a));
- rl_a += real(x);
- goto ADD_COMPLEX;
+ x = car(p);
+ p = cdr(p);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ case T_RATIO:
+ case T_REAL:
+ goto NOT_EQUAL;
+ break;
- case T_COMPLEX:
- if (is_null(p)) return(s7_make_complex(sc, rl_a + real_part(x), im_a + imag_part(x)));
- rl_a += real_part(x);
- im_a += imag_part(x);
- if (im_a == 0.0)
- goto ADD_REALS;
- goto ADD_COMPLEX;
+ case T_COMPLEX:
+ if ((rl_a != real_part(x)) || (im_a != imag_part(x)))
+ goto NOT_EQUAL;
+ break;
- 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);
+ 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);
+ }
+ if (is_null(p))
+ return(sc->T);
}
- break;
default:
- method_or_bust_with_type(sc, x, sc->add_symbol, args, a_number_string, 1);
+ method_or_bust_with_type(sc, x, sc->eq_symbol, args, a_number_string, 1);
}
-}
+ NOT_EQUAL:
+ for (; is_pair(p); p = cdr(p))
+ if (!is_number_via_method(sc, car(p)))
+ return(wrong_type_argument_with_type(sc, sc->eq_symbol, position_of(p, args), car(p), a_number_string));
-static s7_pointer add_2, add_1s, add_s1, add_cs1, add_si, add_sf, add_fs;
+ return(sc->F);
+}
-static s7_pointer add_ratios(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_int object_length_to_int(s7_scheme *sc, s7_pointer obj);
+
+#if (!WITH_GMP)
+static s7_pointer equal_s_ic;
+static s7_pointer g_equal_s_ic(s7_scheme *sc, s7_pointer args)
{
- s7_int d1, d2, n1, n2;
- d1 = number_to_denominator(x);
- n1 = number_to_numerator(x);
- d2 = number_to_denominator(y);
- n2 = number_to_numerator(y);
+ s7_int y;
+ s7_pointer val;
- if (d1 == d2) /* the easy case -- if overflow here, it matches the int case */
- return(s7_make_ratio(sc, n1 + n2, d1));
+ val = find_symbol_unchecked(sc, car(args));
+ y = s7_integer(cadr(args));
+ if (is_integer(val))
+ return(make_boolean(sc, integer(val) == y));
-#if HAVE_OVERFLOW_CHECKS
- {
- s7_int n1d2, n2d1, d1d2, dn;
- if ((multiply_overflow(d1, d2, &d1d2)) ||
- (multiply_overflow(n1, d2, &n1d2)) ||
- (multiply_overflow(n2, d1, &n2d1)) ||
- (add_overflow(n1d2, n2d1, &dn)))
- return(make_real(sc, ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2)));
- return(s7_make_ratio(sc, dn, d1d2));
- }
-#else
- if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
- (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
- (n1 < s7_int32_min) || (n2 < s7_int32_min))
- {
- int d1bits, d2bits;
- d1bits = integer_length(d1);
- d2bits = integer_length(d2);
- if (((d1bits + d2bits) > s7_int_bits) ||
- ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
- ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
- return(make_real(sc, ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2)));
+ switch (type(val))
+ {
+ case T_INTEGER: return(make_boolean(sc, integer(val) == y));
+ case T_RATIO: return(sc->F);
+ case T_REAL: return(make_boolean(sc, real(val) == y));
+ case T_COMPLEX: return(sc->F);
+ default:
+ method_or_bust_with_type(sc, val, sc->eq_symbol, list_2(sc, val, cadr(args)), a_number_string, 1);
}
- return(s7_make_ratio(sc, n1 * d2 + n2 * d1, d1 * d2));
-#endif
+ return(sc->T);
}
+static s7_pointer equal_length_ic;
+static s7_pointer g_equal_length_ic(s7_scheme *sc, s7_pointer args)
+{
+ /* avoid make_integer (and telescope opts), we get here with car=length expr, cadr=int */
+ s7_int ilen;
+ s7_pointer val;
+
+ val = find_symbol_unchecked(sc, cadar(args));
+ ilen = s7_integer(cadr(args));
-static s7_pointer g_add_2(s7_scheme *sc, s7_pointer args)
+ switch (type(val))
+ {
+ case T_PAIR: return(make_boolean(sc, s7_list_length(sc, val) == ilen));
+ case T_NIL: return(make_boolean(sc, ilen == 0));
+ 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_LET: return(make_boolean(sc, let_length(sc, val) == ilen));
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR: return(make_boolean(sc, vector_length(val) == ilen));
+ case T_CLOSURE:
+ case T_CLOSURE_STAR: if (has_methods(val)) return(make_boolean(sc, closure_length(sc, val) == ilen));
+ default: return(simple_wrong_type_argument_with_type(sc, sc->length_symbol, val, a_sequence_string));
+ /* here we already lost because we checked for the length above */
+ }
+ return(sc->F);
+}
+
+
+static bool equal_b_pi(s7_scheme *sc, s7_pointer x, s7_int y)
{
- s7_pointer x, y;
- x = car(args);
- y = cadr(args);
+ if (is_integer(x))
+ return(integer(x) == y);
- if (type(x) == type(y))
+ switch (type(x))
{
- if (is_t_real(x))
- return(make_real(sc, real(x) + real(y)));
- else
- {
- switch (type(x))
- {
-#if HAVE_OVERFLOW_CHECKS
- case T_INTEGER:
- {
- s7_int val;
- if (add_overflow(integer(x), integer(y), &val))
- return(make_real(sc, (double)integer(x) + (double)integer(y)));
- return(make_integer(sc, val));
- }
-#else
- case T_INTEGER: return(make_integer(sc, integer(x) + integer(y)));
+ case T_INTEGER: return(integer(x) == y);
+ case T_RATIO: return(false);
+ case T_REAL: return(real(x) == y);
+ case T_COMPLEX: return(false);
+ default:
+ simple_wrong_type_argument_with_type(cur_sc, sc->eq_symbol, x, a_number_string);
+ }
+ return(false);
+}
#endif
- case T_RATIO: return(add_ratios(sc, x, y));
- case T_REAL: return(make_real(sc, real(x) + real(y)));
- case T_COMPLEX: return(make_complex(sc, real_part(x) + real_part(y), imag_part(x) + imag_part(y)));
- default:
- if (!is_number(x))
- method_or_bust_with_type(sc, x, sc->add_symbol, args, a_number_string, 1);
- method_or_bust_with_type(sc, y, sc->add_symbol, args, a_number_string, 2);
- }
- }
+
+static s7_pointer c_equal_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
+ {
+ if (type(x) == T_INTEGER)
+ return(make_boolean(sc, integer(x) == integer(y)));
+ if (type(x) == T_REAL)
+ return(make_boolean(sc, real(x) == real(y)));
+ if (type(x) == T_COMPLEX)
+ return(make_boolean(sc, (real_part(x) == real_part(y)) && (imag_part(x) == imag_part(y))));
+ if (type(x) == T_RATIO)
+ return(make_boolean(sc, (numerator(x) == numerator(y)) && (denominator(x) == denominator(y))));
}
+#endif
switch (type(x))
{
case T_INTEGER:
switch (type(y))
{
- case T_INTEGER: return(make_integer(sc, integer(x) + integer(y)));
- case T_RATIO: return(add_ratios(sc, x, y));
- case T_REAL: return(make_real(sc, integer(x) + real(y)));
- case T_COMPLEX: return(make_complex(sc, integer(x) + real_part(y), imag_part(y)));
+ case T_INTEGER: return(make_boolean(sc, integer(x) == integer(y)));
+ case T_RATIO: return(sc->F);
+ case T_REAL: return(make_boolean(sc, integer(x) == real(y)));
+ case T_COMPLEX: return(sc->F);
default:
- method_or_bust_with_type(sc, y, sc->add_symbol, args, a_number_string, 2);
+ method_or_bust_with_type(sc, y, sc->eq_symbol, list_2(sc, x, y), a_number_string, 2);
}
+ break;
case T_RATIO:
switch (type(y))
{
- case T_INTEGER:
- case T_RATIO: return(add_ratios(sc, x, y));
- case T_REAL: return(make_real(sc, fraction(x) + real(y)));
- case T_COMPLEX: return(s7_make_complex(sc, fraction(x) + real_part(y), imag_part(y)));
+ case T_INTEGER: return(sc->F);
+ case T_RATIO: return(make_boolean(sc, (numerator(x) == numerator(y)) && (denominator(x) == denominator(y))));
+ case T_REAL: return(make_boolean(sc, fraction(x) == real(y))); /* this could avoid the divide via numerator == denominator * x */
+ case T_COMPLEX: return(sc->F);
default:
- method_or_bust_with_type(sc, y, sc->add_symbol, args, a_number_string, 2);
+ method_or_bust_with_type(sc, y, sc->eq_symbol, list_2(sc, x, y), a_number_string, 2);
}
+ break;
case T_REAL:
switch (type(y))
{
- case T_INTEGER: return(make_real(sc, real(x) + integer(y)));
- case T_RATIO: return(make_real(sc, real(x) + fraction(y)));
- case T_REAL: return(make_real(sc, real(x) + real(y)));
- case T_COMPLEX: return(make_complex(sc, real(x) + real_part(y), imag_part(y)));
+ case T_INTEGER: return(make_boolean(sc, real(x) == integer(y)));
+ case T_RATIO: return(make_boolean(sc, real(x) == fraction(y)));
+ case T_REAL: return(make_boolean(sc, real(x) == real(y)));
+ case T_COMPLEX: return(sc->F);
default:
- method_or_bust_with_type(sc, y, sc->add_symbol, args, a_number_string, 2);
+ method_or_bust_with_type(sc, y, sc->eq_symbol, list_2(sc, x, y), a_number_string, 2);
}
+ break;
case T_COMPLEX:
switch (type(y))
{
- case T_INTEGER: return(s7_make_complex(sc, real_part(x) + integer(y), imag_part(x)));
- case T_RATIO: return(s7_make_complex(sc, real_part(x) + fraction(y), imag_part(x)));
- case T_REAL: return(s7_make_complex(sc, real_part(x) + real(y), imag_part(x)));
- case T_COMPLEX: return(make_complex(sc, real_part(x) + real_part(y), imag_part(x) + imag_part(y)));
- default:
- method_or_bust_with_type(sc, y, sc->add_symbol, args, a_number_string, 2);
- }
-
- default:
- method_or_bust_with_type(sc, x, sc->add_symbol, args, a_number_string, 1);
- }
- return(x);
-}
+ case T_INTEGER:
+ case T_RATIO:
+ case T_REAL:
+ return(sc->F);
-static s7_pointer g_add_s1_1(s7_scheme *sc, s7_pointer x, s7_pointer args)
-{
- switch (type(x))
- {
-#if HAVE_OVERFLOW_CHECKS
- case T_INTEGER:
- {
- s7_int val;
- if (add_overflow(integer(x), 1, &val))
- return(make_real(sc, (double)integer(x) + 1.0));
- return(make_integer(sc, val));
- }
+#if (!MS_WINDOWS)
+ case T_COMPLEX:
+ return(make_boolean(sc, (real_part(x) == real_part(y)) && (imag_part(x) == imag_part(y))));
#else
- case T_INTEGER: return(make_integer(sc, integer(x) + 1));
+ case T_COMPLEX:
+ if ((real_part(x) == real_part(y)) && (imag_part(x) == imag_part(y))) return(sc->T); else return(sc->F);
#endif
- case T_RATIO: return(add_ratios(sc, x, small_int(1)));
- case T_REAL: return(make_real(sc, real(x) + 1.0));
- case T_COMPLEX: return(s7_make_complex(sc, real_part(x) + 1.0, imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, y, sc->eq_symbol, list_2(sc, x, y), a_number_string, 2);
+ }
+ break;
+
default:
- method_or_bust_with_type(sc, x, sc->add_symbol, cons(sc, x, cdr(args)), a_number_string, 1);
+ method_or_bust_with_type(sc, x, sc->eq_symbol, list_2(sc, x, y), a_number_string, 1);
}
- return(x);
+ return(sc->F);
}
-static s7_pointer g_add_s1(s7_scheme *sc, s7_pointer args)
+#if (!WITH_GMP)
+static s7_pointer equal_p_pp(s7_pointer p1, s7_pointer p2) {return(c_equal_2(cur_sc, p1, p2));}
+static s7_pointer equal_p_pi(s7_pointer p1, s7_int p2)
{
- s7_pointer x;
- x = car(args);
- if (is_t_integer(x))
- return(make_integer(sc, integer(x) + 1));
- return(g_add_s1_1(sc, x, args));
+ if (is_integer(p1))
+ return((integer(p1) == p2) ? cur_sc->T : cur_sc->F);
+ if (is_t_real(p1))
+ return((real(p1) == p2) ? cur_sc->T : cur_sc->F);
+ if (is_number(p1))
+ 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 c_add_s1(s7_scheme *sc, s7_pointer x)
-{
- if (is_t_integer(x))
- return(make_integer(sc, integer(x) + 1));
- return(g_add_s1_1(sc, x, set_plist_1(sc, x)));
-}
+static s7_pointer equal_2;
+#endif
-static s7_pointer g_add_cs1(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer x;
- x = find_symbol_checked(sc, car(args));
- if (is_integer(x))
- return(make_integer(sc, integer(x) + 1));
- return(g_add_s1_1(sc, x, args));
-}
+static s7_pointer g_equal_2(s7_scheme *sc, s7_pointer args) {return(c_equal_2(sc, car(args), cadr(args)));}
-static s7_pointer g_add_1s(s7_scheme *sc, s7_pointer args)
+#if (!WITH_GMP)
+static s7_pointer g_less(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
-
- x = cadr(args);
- if (is_integer(x))
- return(make_integer(sc, integer(x) + 1));
+ #define H_less "(< x1 ...) returns #t if its arguments are in increasing order"
+ #define Q_less s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_real_symbol)
- switch (type(x))
- {
- case T_INTEGER: return(make_integer(sc, integer(x) + 1));
- case T_RATIO: return(add_ratios(sc, x, small_int(1)));
- case T_REAL: return(make_real(sc, real(x) + 1.0));
- case T_COMPLEX: return(s7_make_complex(sc, real_part(x) + 1.0, imag_part(x)));
- default:
- method_or_bust_with_type(sc, x, sc->add_symbol, args, a_number_string, 2);
- }
- return(x);
-}
+ s7_pointer x, y, p;
-static s7_pointer g_add_si(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer x;
- s7_int n;
+ x = car(args);
+ p = cdr(args);
- x = find_symbol_checked(sc, car(args));
- n = integer(cadr(args));
- if (is_integer(x))
-#if HAVE_OVERFLOW_CHECKS
- {
- s7_int val;
- if (add_overflow(integer(x), n, &val))
- return(make_real(sc, (double)integer(x) + (double)n));
- return(make_integer(sc, val));
- }
-#else
- return(make_integer(sc, integer(x) + n));
-#endif
switch (type(x))
{
- case T_INTEGER: return(make_integer(sc, integer(x) + n));
- case T_RATIO: return(add_ratios(sc, x, cadr(args)));
- case T_REAL: return(make_real(sc, real(x) + n));
- case T_COMPLEX: return(s7_make_complex(sc, real_part(x) + n, imag_part(x)));
- default:
- method_or_bust_with_type(sc, x, sc->add_symbol, list_2(sc, x, cadr(args)), a_number_string, 1);
- }
- return(x);
-}
-
-static s7_pointer g_add_sf(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer x;
- s7_double n;
+ case T_INTEGER:
+ INTEGER_LESS:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(x) >= integer(y)) goto NOT_LESS;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_LESS;
- x = find_symbol_checked(sc, car(args));
- n = real(cadr(args));
- switch (type(x))
- {
- case T_INTEGER: return(make_real(sc, integer(x) + n));
- case T_RATIO: return(make_real(sc, fraction(x) + n));
- case T_REAL: return(make_real(sc, real(x) + n));
- case T_COMPLEX: return(s7_make_complex(sc, real_part(x) + n, imag_part(x)));
- default:
- method_or_bust_with_type(sc, x, sc->add_symbol, list_2(sc, x, cadr(args)), a_number_string, 1);
- }
- return(x);
-}
+ case T_RATIO:
+ /* no gmp here, but this can overflow: (< 9223372036 1/9223372036), but conversion to real is also problematic
+ */
+ if ((integer(x) >= 0) && (numerator(y) < 0)) goto NOT_LESS; /* (< 1 -1/2), ratio numerator can't be 0 */
+ if ((integer(x) <= 0) && (numerator(y) > 0)) /* (< 0 1/2) */
+ {
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_LESS;
+ }
+ if ((integer(x) < s7_int32_max) &&
+ (integer(x) > s7_int32_min) &&
+ (denominator(y) < s7_int32_max))
+ {
+ if ((integer(x) * denominator(y)) >= numerator(y)) goto NOT_LESS;
+ }
+ else
+ {
+ if (integer(x) >= fraction(y)) goto NOT_LESS;
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_LESS;
-static s7_pointer g_add_fs(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer x;
- s7_double n;
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_LESS;
+ if (integer(x) >= real(y)) goto NOT_LESS;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_LESS;
- x = find_symbol_checked(sc, cadr(args));
- n = real(car(args));
- switch (type(x))
- {
- case T_INTEGER: return(make_real(sc, integer(x) + n));
- case T_RATIO: return(make_real(sc, fraction(x) + n));
- case T_REAL: return(make_real(sc, real(x) + n));
- case T_COMPLEX: return(s7_make_complex(sc, real_part(x) + n, imag_part(x)));
- default:
- method_or_bust_with_type(sc, x, sc->add_symbol, list_2(sc, x, car(args)), a_number_string, 2);
- }
- return(x);
-}
+ default:
+ method_or_bust(sc, y, sc->lt_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
-static s7_pointer add_f_sf;
-static s7_pointer g_add_f_sf(s7_scheme *sc, s7_pointer args)
-{
- /* (+ x (* s y)) */
- s7_pointer vargs, s;
- s7_double x, y;
- x = real(car(args));
- vargs = cdadr(args);
- s = find_symbol_checked(sc, car(vargs));
- y = real(cadr(vargs));
+ case T_RATIO:
+ RATIO_LESS:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if ((numerator(x) > 0) && (integer(y) <= 0)) goto NOT_LESS;
+ if ((numerator(x) < 0) && (integer(y) >= 0))
+ {
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_LESS;
+ }
+ if ((integer(y) < s7_int32_max) &&
+ (integer(y) > s7_int32_min) &&
+ (denominator(x) < s7_int32_max))
+ {
+ if (numerator(x) >= (integer(y) * denominator(x))) goto NOT_LESS;
+ }
+ else
+ {
+ if (fraction(x) >= integer(y)) goto NOT_LESS;
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_LESS;
- if (is_t_real(s))
- return(make_real(sc, x + (real(s) * y)));
+ case T_RATIO:
+ /* conversion to real and >= is not safe here (see comment under g_greater) */
+ {
+ s7_int d1, d2, n1, n2;
+ d1 = denominator(x);
+ n1 = numerator(x);
+ d2 = denominator(y);
+ n2 = numerator(y);
+ if (d1 == d2)
+ {
+ if (n1 >= n2) goto NOT_LESS;
+ }
+ else
+ {
+#if HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(n1, d2, &n1)) ||
+ (multiply_overflow(n2, d1, &n2)))
+ {
+ if (fraction(x) >= fraction(y)) goto NOT_LESS;
+ }
+ else
+ {
+ if (n1 >= n2) goto NOT_LESS;
+ }
+#else
+ if ((n1 * d2) >= (n2 * d1)) goto NOT_LESS;
+#endif
+ }
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_LESS;
- switch (type(s))
- {
- case T_INTEGER: return(make_real(sc, x + (integer(s) * y)));
- case T_RATIO: return(make_real(sc, x + (fraction(s) * y)));
- case T_REAL: return(make_real(sc, x + real(s) * y));
- case T_COMPLEX: return(s7_make_complex(sc, x + (real_part(s) * y), imag_part(s) * y));
- default:
- {
- s7_pointer func;
- if ((func = find_method(sc, find_let(sc, s), sc->multiply_symbol)) != sc->undefined)
- return(g_add_2(sc, set_plist_2(sc, car(args), s7_apply_function(sc, func, list_2(sc, s, cadr(vargs))))));
- return(wrong_type_argument_with_type(sc, sc->multiply_symbol, 1, s, a_number_string));
- }
- }
- return(s);
-}
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_LESS;
+ if (fraction(x) >= real(y)) goto NOT_LESS;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ 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);
+ }
-static s7_pointer add_ss_1ss_1(s7_scheme *sc, s7_pointer s1, s7_pointer s2, s7_pointer s3)
-{
- s7_double r1, r2, r3, loc, i1, i2, i3, is1;
- if ((is_t_real(s1)) &&
- (is_t_real(s2)) &&
- (is_t_real(s3)))
- return(make_real(sc, (real(s1) * real(s2)) + ((1.0 - real(s1)) * real(s3))));
-
- if ((is_real(s1)) &&
- (is_real(s2)) &&
- (is_real(s3)))
- {
- r1 = real_to_double(sc, s1, "*");
- r2 = real_to_double(sc, s2, "*");
- r3 = real_to_double(sc, s3, "*");
- return(make_real(sc, (r1 * r2) + ((1.0 - r1) * r3)));
- }
-
- r1 = s7_real_part(s1);
- loc = 1.0 - r1;
- r2 = s7_real_part(s2);
- r3 = s7_real_part(s3);
- i1 = s7_imag_part(s1);
- is1 = -i1;
- i2 = s7_imag_part(s2);
- i3 = s7_imag_part(s3);
- return(s7_make_complex(sc,
- (r1 * r2 - i1 * i2) + (loc * r3 - is1 * i3),
- (r1 * i2 + r2 * i1) + (loc * i3 + r3 * is1)));
- /* (let ()
- * (define (hi a b c) (+ (* a b) (* (- 1.0 a) c)))
- * (define (hi1 a b c) (+ (* b a) (* c (- 1 a))))
- * (define (ho a b c) (list (hi a b c) (hi1 a b c)))
- * (ho 1.4 2.5+i 3.1))
- */
-}
-static s7_pointer add_ss_1ss;
-static s7_pointer g_add_ss_1ss(s7_scheme *sc, s7_pointer args)
-{
- /* (+ (* s1 s2) (* (- 1.0 s1) s3)) */
- s7_pointer s1, s2, s3;
- s1 = find_symbol_checked(sc, cadr(car(args)));
- s2 = find_symbol_checked(sc, opt_sym1(args)); /* caddr(car(args))) */
- s3 = find_symbol_checked(sc, opt_sym2(args)); /* caddr(cadr(args))) */
+ case T_REAL:
+ if (is_NaN(real(x))) goto NOT_LESS;
- return(add_ss_1ss_1(sc, s1, s2, s3));
-}
+ REAL_LESS:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (real(x) >= integer(y)) goto NOT_LESS;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_LESS;
+ case T_RATIO:
+ if (real(x) >= fraction(y)) goto NOT_LESS;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_LESS;
-#if (!WITH_GMP)
-static s7_double add_rf_xx(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t r1, r2;
- s7_double x, y;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- r2 = (s7_rf_t)(**p); (*p)++;
- y = r2(sc, p);
- return(x + y);
-}
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_LESS;
+ if (real(x) >= real(y)) goto NOT_LESS;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_LESS;
-static s7_double add_rf_rx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1;
- s7_rf_t r1;
- s1 = **p; (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(r1(sc, p) + real_to_double(sc, s1, "+"));
-}
+ default:
+ method_or_bust(sc, y, sc->lt_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
-static s7_double add_rf_sx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1;
- s7_rf_t r1;
- s1 = slot_value(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- return(r1(sc, p) + real_to_double(sc, s1, "+"));
-}
+ default:
+ method_or_bust(sc, x, sc->lt_symbol, args, T_REAL, 1);
+ }
-static s7_double add_rf_ss(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1, s2;
- s7_double x1;
- s1 = slot_value(**p); (*p)++;
- x1 = real_to_double(sc, s1, "+");
- s2 = slot_value(**p); (*p)++;
- return(x1 + real_to_double(sc, s2, "+"));
-}
+ NOT_LESS:
+ for (; is_pair(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->lt_symbol, position_of(p, args), car(p), T_REAL));
-static s7_double add_rf_rs(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer c1, s1;
- s7_double x1;
- s1 = slot_value(**p); (*p)++;
- c1 = **p; (*p)++;
- x1 = real_to_double(sc, c1, "+");
- return(x1 + real_to_double(sc, s1, "+"));
+ return(sc->F);
}
-static s7_double add_rf_xxx(s7_scheme *sc, s7_pointer **p)
+static s7_pointer g_less_or_equal(s7_scheme *sc, s7_pointer args)
{
- s7_rf_t r1, r2, r3;
- s7_double x, y, z;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- r2 = (s7_rf_t)(**p); (*p)++;
- y = r2(sc, p);
- r3 = (s7_rf_t)(**p); (*p)++;
- z = r3(sc, p);
- return(x + y + z);
-}
+ #define H_less_or_equal "(<= x1 ...) returns #t if its arguments are in increasing order"
+ #define Q_less_or_equal s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_real_symbol)
-static s7_double add_rf_rxx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer c1;
- s7_rf_t r1, r2;
- s7_double x, y;
- c1 = **p; (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- r2 = (s7_rf_t)(**p); (*p)++;
- y = r2(sc, p);
- return(x + y + real_to_double(sc, c1, "+"));
-}
+ s7_pointer x, y, p;
-static s7_double add_rf_sxx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1;
- s7_rf_t r1, r2;
- s7_double x, y;
- s1 = slot_value(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- r2 = (s7_rf_t)(**p); (*p)++;
- y = r2(sc, p);
- return(x + y + real_to_double(sc, s1, "+"));
-}
+ x = car(args);
+ p = cdr(args);
-static s7_double add_rf_rsx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer c1, s1;
- s7_rf_t r1;
- s7_double x, x1, x2;
- s1 = slot_value(**p); (*p)++;
- x2 = real_to_double(sc, s1, "+");
- c1 = **p; (*p)++;
- x1 = real_to_double(sc, c1, "+");
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- return(x + x1 + x2);
-}
+ switch (type(x))
+ {
+ case T_INTEGER:
+ INTEGER_LEQ:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(x) > integer(y)) goto NOT_LEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_LEQ;
-static s7_double add_rf_ssx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1, s2;
- s7_rf_t r1;
- s7_double x, x1;
- s1 = slot_value(**p); (*p)++;
- x1 = real_to_double(sc, s1, "+");
- s2 = slot_value(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- return(x + x1 + real_to_double(sc, s2, "+"));
-}
-
-static s7_double add_rf_sss(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1, s2, s3;
- s7_double x1, x2;
- s1 = slot_value(**p); (*p)++;
- x1 = real_to_double(sc, s1, "+");
- s2 = slot_value(**p); (*p)++;
- x2 = real_to_double(sc, s2, "+");
- s3 = slot_value(**p); (*p)++;
- return(x1 + x2 + real_to_double(sc, s3, "+"));
-}
-
-static s7_double add_rf_rss(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer c1, s1, s2;
- s7_double x1, x2;
- s1 = slot_value(**p); (*p)++;
- x1 = real_to_double(sc, s1, "+");
- s2 = slot_value(**p); (*p)++;
- x2 = real_to_double(sc, s2, "+");
- c1 = **p; (*p)++;
- return(real_to_double(sc, c1, "+") + x1 + x2);
-}
-
-static s7_rf_t add_rf_1(s7_scheme *sc, s7_pointer expr, int len)
-{
- if (len == 3)
- return(com_rf_2(sc, expr, add_r_ops));
- if (len == 4)
- return(com_rf_3(sc, expr, add_r_ops));
-
- if (len > 4)
- {
- s7_rf_t rf;
- ptr_int loc;
- int first_len;
- xf_t *rc;
-
- first_len = (int)(len / 2);
- xf_init(2);
- xf_save_loc(loc);
- rf = add_rf_1(sc, expr, first_len + 1);
- if (rf)
- {
- int i;
- s7_pointer p;
- xf_store_at(loc, (s7_pointer)rf);
- xf_save_loc(loc);
- for (i = 0, p = expr; i < first_len; i++, p = cdr(p));
- rf = add_rf_1(sc, p, len - first_len);
- if (rf)
+ case T_RATIO:
+ /* no gmp here, but this can overflow: (< 9223372036 1/9223372036), but conversion to real is also problematic
+ */
+ if ((integer(x) >= 0) && (numerator(y) < 0)) goto NOT_LEQ; /* (< 1 -1/2), ratio numerator can't be 0 */
+ if ((integer(x) <= 0) && (numerator(y) > 0)) /* (< 0 1/2) */
{
- xf_store_at(loc, (s7_pointer)rf);
- return(add_rf_xx);
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_LEQ;
}
- else return(NULL);
- }
- else return(NULL);
- }
- return(NULL);
-}
-
-static s7_rf_t add_rf(s7_scheme *sc, s7_pointer expr)
-{
- return(add_rf_1(sc, expr, s7_list_length(sc, expr)));
-}
-
-
-static s7_int add_if_xx(s7_scheme *sc, s7_pointer **p)
-{
- s7_if_t r1, r2;
- s7_int x, y;
- r1 = (s7_if_t)(**p); (*p)++;
- x = r1(sc, p);
- r2 = (s7_if_t)(**p); (*p)++;
- y = r2(sc, p);
- return(x + y);
-}
-
-static s7_int add_if_rx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1;
- s7_if_t r1;
- s1 = **p; (*p)++;
- r1 = (s7_if_t)(**p); (*p)++;
- return(r1(sc, p) + integer(s1));
-}
-
-static s7_int add_if_sx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1;
- s7_if_t r1;
- s1 = slot_value(**p); (*p)++;
- r1 = (s7_if_t)(**p); (*p)++;
- return(r1(sc, p) + integer(s1));
-}
-
-static s7_int add_if_ss(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1, s2;
- s1 = slot_value(**p); (*p)++;
- s2 = slot_value(**p); (*p)++;
- return(integer(s1) + integer(s2));
-}
-
-static s7_int add_if_rs(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer c1, s1;
- s1 = slot_value(**p); (*p)++;
- c1 = **p; (*p)++;
- return(integer(c1) + integer(s1));
-}
-
-
-static s7_int add_if_xxx(s7_scheme *sc, s7_pointer **p)
-{
- s7_if_t r1, r2, r3;
- s7_int x, y, z;
- r1 = (s7_if_t)(**p); (*p)++;
- x = r1(sc, p);
- r2 = (s7_if_t)(**p); (*p)++;
- y = r2(sc, p);
- r3 = (s7_if_t)(**p); (*p)++;
- z = r3(sc, p);
- return(x + y + z);
-}
-
-static s7_int add_if_rxx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer c1;
- s7_if_t r1, r2;
- s7_int x, y;
- c1 = **p; (*p)++;
- r1 = (s7_if_t)(**p); (*p)++;
- x = r1(sc, p);
- r2 = (s7_if_t)(**p); (*p)++;
- y = r2(sc, p);
- return(x + y + integer(c1));
-}
-
-static s7_int add_if_sxx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1;
- s7_if_t r1, r2;
- s7_int x, y;
- s1 = slot_value(**p); (*p)++;
- r1 = (s7_if_t)(**p); (*p)++;
- x = r1(sc, p);
- r2 = (s7_if_t)(**p); (*p)++;
- y = r2(sc, p);
- return(x + y + integer(s1));
-}
-
-static s7_int add_if_rsx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer c1, s1;
- s7_if_t r1;
- s7_int x;
- s1 = slot_value(**p); (*p)++;
- c1 = **p; (*p)++;
- r1 = (s7_if_t)(**p); (*p)++;
- x = r1(sc, p);
- return(x + integer(c1) + integer(s1));
-}
-
-static s7_int add_if_ssx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1, s2;
- s7_if_t r1;
- s7_int x;
- s1 = slot_value(**p); (*p)++;
- s2 = slot_value(**p); (*p)++;
- r1 = (s7_if_t)(**p); (*p)++;
- x = r1(sc, p);
- return(x + integer(s1) + integer(s2));
-}
-
-static s7_int add_if_sss(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1, s2, s3;
- s1 = slot_value(**p); (*p)++;
- s2 = slot_value(**p); (*p)++;
- s3 = slot_value(**p); (*p)++;
- return(integer(s1) + integer(s2) + integer(s3));
-}
+ if ((integer(x) < s7_int32_max) &&
+ (integer(x) > s7_int32_min) &&
+ (denominator(y) < s7_int32_max))
+ {
+ if ((integer(x) * denominator(y)) > numerator(y)) goto NOT_LEQ;
+ }
+ else
+ {
+ if (integer(x) > fraction(y)) goto NOT_LEQ;
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_LEQ;
-static s7_int add_if_rss(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer c1, s1, s2;
- s1 = slot_value(**p); (*p)++;
- s2 = slot_value(**p); (*p)++;
- c1 = **p; (*p)++;
- return(integer(c1) + integer(s1) + integer(s2));
-}
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_LEQ;
+ if (integer(x) > real(y)) goto NOT_LEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_LEQ;
-static s7_if_t add_if_1(s7_scheme *sc, s7_pointer expr, int len)
-{
- if (len == 3)
- return(com_if_2(sc, expr, add_i_ops));
- if (len == 4)
- return(com_if_3(sc, expr, add_i_ops));
+ default:
+ method_or_bust(sc, y, sc->leq_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
- if (len > 4)
- {
- s7_if_t xf;
- ptr_int loc;
- int first_len;
- xf_t *rc;
- xf_init(2);
- xf_save_loc(loc);
- first_len = (int)(len / 2);
- xf = add_if_1(sc, expr, first_len + 1);
- if (xf)
+ case T_RATIO:
+ RATIO_LEQ:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
{
- int i;
- s7_pointer p;
- xf_store_at(loc, (s7_pointer)xf);
- xf_save_loc(loc);
- for (i = 0, p = expr; i < first_len; i++, p = cdr(p));
- xf = add_if_1(sc, p, len - first_len);
- if (xf)
+ case T_INTEGER:
+ if ((numerator(x) > 0) && (integer(y) <= 0)) goto NOT_LEQ;
+ if ((numerator(x) < 0) && (integer(y) >= 0))
+ {
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_LEQ;
+ }
+ if ((integer(y) < s7_int32_max) &&
+ (integer(y) > s7_int32_min) &&
+ (denominator(x) < s7_int32_max))
+ {
+ if (numerator(x) > (integer(y) * denominator(x))) goto NOT_LEQ;
+ }
+ else
{
- xf_store_at(loc, (s7_pointer)xf);
- return(add_if_xx);
+ if (fraction(x) > integer(y)) goto NOT_LEQ;
}
- else return(NULL);
- }
- else return(NULL);
- }
- return(NULL);
-}
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_LEQ;
-static s7_if_t add_if(s7_scheme *sc, s7_pointer expr)
-{
- return(add_if_1(sc, expr, s7_list_length(sc, expr)));
-}
+ case T_RATIO:
+ {
+ s7_int d1, d2, n1, n2;
+ d1 = denominator(x);
+ n1 = numerator(x);
+ d2 = denominator(y);
+ n2 = numerator(y);
+ if (d1 == d2)
+ {
+ if (n1 > n2) goto NOT_LEQ;
+ }
+ else
+ {
+#if HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(n1, d2, &n1)) ||
+ (multiply_overflow(n2, d1, &n2)))
+ {
+ if (fraction(x) > fraction(y)) goto NOT_LEQ;
+ }
+ else
+ {
+ if (n1 > n2) goto NOT_LEQ;
+ }
+#else
+ if ((n1 * d2) > (n2 * d1)) goto NOT_LEQ;
+#endif
+ }
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_LEQ;
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_LEQ;
+ if (fraction(x) > real(y)) goto NOT_LEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_LEQ;
-static void init_add_ops(void)
-{
- add_r_ops = (rf_ops *)calloc(1, sizeof(rf_ops));
- add_r_ops->r = rf_c;
- add_r_ops->s = rf_s;
+ default:
+ method_or_bust(sc, y, sc->leq_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
- add_r_ops->rs = add_rf_rs;
- add_r_ops->rp = add_rf_rx;
- add_r_ops->sp = add_rf_sx;
- add_r_ops->ss = add_rf_ss;
- add_r_ops->pp = add_rf_xx;
- add_r_ops->rss = add_rf_rss;
- add_r_ops->rsp = add_rf_rsx;
- add_r_ops->rpp = add_rf_rxx;
- add_r_ops->sss = add_rf_sss;
- add_r_ops->ssp = add_rf_ssx;
- add_r_ops->spp = add_rf_sxx;
- add_r_ops->ppp = add_rf_xxx;
+ case T_REAL:
+ if (is_NaN(real(x))) goto NOT_LEQ;
- add_i_ops = (if_ops *)calloc(1, sizeof(if_ops));
- add_i_ops->r = if_c;
- add_i_ops->s = if_s;
+ REAL_LEQ:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (real(x) > integer(y)) goto NOT_LEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_LEQ;
- add_i_ops->rs = add_if_rs;
- add_i_ops->rp = add_if_rx;
- add_i_ops->sp = add_if_sx;
- add_i_ops->ss = add_if_ss;
- add_i_ops->pp = add_if_xx;
+ case T_RATIO:
+ if (real(x) > fraction(y)) goto NOT_LEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_LEQ;
- add_i_ops->rss = add_if_rss;
- add_i_ops->rsp = add_if_rsx;
- add_i_ops->rpp = add_if_rxx;
- add_i_ops->sss = add_if_sss;
- add_i_ops->ssp = add_if_ssx;
- add_i_ops->spp = add_if_sxx;
- add_i_ops->ppp = add_if_xxx;
-}
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_LEQ;
+ if (real(x) > real(y)) goto NOT_LEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_LEQ;
-#if WITH_ADD_PF
-static s7_pointer c_add_pf2(s7_scheme *sc, s7_pointer **p)
-{
- s7_pf_t pf;
- s7_pointer x, y;
- pf = (s7_pf_t)(**p); (*p)++;
- x = pf(sc, p);
- xf_push(sc, x);
- pf = (s7_pf_t)(**p); (*p)++;
- y = pf(sc, p);
- x = g_add_2(sc, set_plist_2(sc, x, y));
- xf_pop(sc);
- return(x);
-}
+ default:
+ method_or_bust(sc, y, sc->leq_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
-static s7_pf_t add_pf(s7_scheme *sc, s7_pointer expr)
-{
- int len;
- len = s7_list_length(sc, expr);
- if (len == 3)
- {
- if ((s7_arg_to_pf(sc, cadr(expr))) &&
- (s7_arg_to_pf(sc, caddr(expr))))
- return(c_add_pf2);
+ default:
+ method_or_bust(sc, x, sc->leq_symbol, args, T_REAL, 1);
}
- return(NULL);
-}
-#endif
-#endif
+ NOT_LEQ:
+ for (; is_pair(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->leq_symbol, position_of(p, args), car(p), T_REAL));
+ return(sc->F);
+}
-/* ---------------------------------------- subtract ---------------------------------------- */
-static s7_pointer g_subtract(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_greater(s7_scheme *sc, s7_pointer args)
{
- #define H_subtract "(- x1 ...) subtracts its trailing arguments from the first, or negates the first if only one it is given"
- #define Q_subtract pcl_n
-
- s7_pointer x, p;
- s7_int num_a, den_a;
- s7_double rl_a, im_a;
+ #define H_greater "(> x1 ...) returns #t if its arguments are in decreasing order"
+ #define Q_greater s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_real_symbol)
+ s7_pointer x, y, p;
x = car(args);
p = cdr(args);
-#if (!WITH_GMP)
- if (is_null(p))
- {
- if (!is_number(x))
- method_or_bust_with_type(sc, x, sc->subtract_symbol, args, a_number_string, 0);
- return(s7_negate(sc, x));
- }
-#endif
-
switch (type(x))
{
case T_INTEGER:
- num_a = integer(x);
-
- SUBTRACT_INTEGERS:
-#if WITH_GMP
- if ((num_a > s7_int32_max) ||
- (num_a < s7_int32_min))
- return(big_subtract(sc, cons(sc, s7_int_to_big_integer(sc, num_a), p)));
-#endif
- x = car(p);
+ INTEGER_GREATER:
+ y = car(p);
p = cdr(p);
-
- switch (type(x))
+ switch (type(y))
{
case T_INTEGER:
-#if HAVE_OVERFLOW_CHECKS
- if (subtract_overflow(num_a, integer(x), &den_a))
+ if (integer(x) <= integer(y)) goto NOT_GREATER;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_GREATER;
+
+ case T_RATIO:
+ /* no gmp here, but this can overflow: (< 9223372036 1/9223372036), but conversion to real is also problematic
+ */
+ if ((integer(x) <= 0) && (numerator(y) > 0)) goto NOT_GREATER;
+ if ((integer(x) >= 0) && (numerator(y) < 0))
{
- rl_a = (s7_double)num_a - (s7_double)integer(x);
- if (is_null(p)) return(make_real(sc, rl_a));
- goto SUBTRACT_REALS;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_GREATER;
}
-#else
- den_a = num_a - integer(x);
- if (den_a < 0)
+ if ((integer(x) < s7_int32_max) &&
+ (integer(x) > s7_int32_min) &&
+ (denominator(y) < s7_int32_max))
{
- if ((num_a > 0) && (integer(x) < 0))
- {
- rl_a = (s7_double)num_a - (s7_double)integer(x);
- if (is_null(p)) return(make_real(sc, rl_a));
- goto SUBTRACT_REALS;
- }
- /* (- most-positive-fixnum most-negative-fixnum) -> -1 (1.8446744073709551615E19)
- */
+ if ((integer(x) * denominator(y)) <= numerator(y)) goto NOT_GREATER;
}
else
{
- if ((num_a < 0) && (integer(x) > 0))
- {
- rl_a = (s7_double)num_a - (s7_double)integer(x);
- if (is_null(p)) return(make_real(sc, rl_a));
- goto SUBTRACT_REALS;
- }
- /* (- most-negative-fixnum most-positive-fixnum) -> 1 (-1.8446744073709551615E19)
- */
+ if (integer(x) <= fraction(y)) goto NOT_GREATER;
}
-#endif
- if (is_null(p)) return(make_integer(sc, den_a));
- num_a = den_a;
- goto SUBTRACT_INTEGERS;
-
- case T_RATIO:
- {
- s7_int dn;
- den_a = denominator(x);
-#if HAVE_OVERFLOW_CHECKS
- if ((multiply_overflow(num_a, den_a, &dn)) ||
- (subtract_overflow(dn, numerator(x), &dn)))
- {
- if (is_null(p)) return(make_real(sc, num_a - fraction(x)));
- rl_a = (s7_double)num_a - fraction(x);
- goto SUBTRACT_REALS;
- }
-#else
- if ((integer_length(num_a) + integer_length(den_a) + integer_length(numerator(x))) > s7_int_bits)
- {
- if (is_null(p)) return(make_real(sc, num_a - fraction(x)));
- rl_a = (s7_double)num_a - fraction(x);
- goto SUBTRACT_REALS;
- }
- dn = (num_a * den_a) - numerator(x);
-#endif
- if (is_null(p)) return(s7_make_ratio(sc, dn, den_a));
- num_a = dn;
- if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
- goto SUBTRACT_INTEGERS;
- goto SUBTRACT_RATIOS;
- }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_GREATER;
case T_REAL:
- if (is_null(p)) return(make_real(sc, num_a - real(x)));
- rl_a = (s7_double)num_a - real(x);
- goto SUBTRACT_REALS;
-
- case T_COMPLEX:
- if (is_null(p)) return(s7_make_complex(sc, num_a - real_part(x), -imag_part(x)));
- rl_a = (s7_double)num_a - real_part(x);
- im_a = -imag_part(x);
- goto SUBTRACT_COMPLEX;
+ if (is_NaN(real(y))) goto NOT_GREATER;
+ if (integer(x) <= real(y)) goto NOT_GREATER;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_GREATER;
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(sc, y, sc->gt_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
- break;
+
case T_RATIO:
- num_a = numerator(x);
- den_a = denominator(x);
- SUBTRACT_RATIOS:
-#if WITH_GMP
- if ((num_a > s7_int32_max) ||
- (den_a > s7_int32_max) ||
- (num_a < s7_int32_min))
- return(big_subtract(sc, cons(sc, s7_ratio_to_big_ratio(sc, num_a, den_a), p)));
-#endif
- x = car(p);
+ RATIO_GREATER:
+ y = car(p);
p = cdr(p);
-
- switch (type(x))
+ switch (type(y))
{
case T_INTEGER:
-#if HAVE_OVERFLOW_CHECKS
- {
- s7_int di;
- if ((multiply_overflow(den_a, integer(x), &di)) ||
- (subtract_overflow(num_a, di, &di)))
- {
- if (is_null(p)) return(make_real(sc, ((long double)num_a / (long double)den_a) - integer(x)));
- rl_a = ((long double)num_a / (long double)den_a) - integer(x);
- goto SUBTRACT_REALS;
- }
- if (is_null(p)) return(s7_make_ratio(sc, di, den_a));
- num_a = di;
- }
-#else
- if ((integer_length(integer(x)) + integer_length(num_a) + integer_length(den_a)) > s7_int_bits)
+ if ((numerator(x) < 0) && (integer(y) >= 0)) goto NOT_GREATER;
+ if ((numerator(x) > 0) && (integer(y) <= 0))
{
- if (is_null(p)) return(make_real(sc, ((long double)num_a / (long double)den_a) - integer(x)));
- rl_a = ((long double)num_a / (long double)den_a) - integer(x);
- goto SUBTRACT_REALS;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_GREATER;
}
- if (is_null(p)) return(s7_make_ratio(sc, num_a - (den_a * integer(x)), den_a));
- num_a -= (den_a * integer(x));
-#endif
- if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
- goto SUBTRACT_INTEGERS;
- goto SUBTRACT_RATIOS;
+ if ((integer(y) < s7_int32_max) &&
+ (integer(y) > s7_int32_min) &&
+ (denominator(x) < s7_int32_max))
+ {
+ if (numerator(x) <= (integer(y) * denominator(x))) goto NOT_GREATER;
+ }
+ else
+ {
+ if (fraction(x) <= integer(y)) goto NOT_GREATER;
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_GREATER;
case T_RATIO:
{
s7_int d1, d2, n1, n2;
- d1 = den_a;
- n1 = num_a;
- d2 = denominator(x);
- n2 = numerator(x);
- if (d1 == d2) /* the easy case -- if overflow here, it matches the int case */
+ d1 = denominator(x);
+ n1 = numerator(x);
+ d2 = denominator(y);
+ n2 = numerator(y);
+ if (d1 == d2)
{
- if (is_null(p))
- return(s7_make_ratio(sc, n1 - n2, d1));
- num_a -= n2; /* d1 can't be zero */
+ if (n1 <= n2) goto NOT_GREATER;
}
else
{
-#if (!WITH_GMP)
#if HAVE_OVERFLOW_CHECKS
- s7_int n1d2, n2d1;
- if ((multiply_overflow(d1, d2, &den_a)) ||
- (multiply_overflow(n1, d2, &n1d2)) ||
- (multiply_overflow(n2, d1, &n2d1)) ||
- (subtract_overflow(n1d2, n2d1, &num_a)))
+ if ((multiply_overflow(n1, d2, &n1)) ||
+ (multiply_overflow(n2, d1, &n2)))
{
- if (is_null(p))
- return(make_real(sc, ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2)));
- rl_a = ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2);
- goto SUBTRACT_REALS;
+ if (fraction(x) <= fraction(y)) goto NOT_GREATER;
}
-#else
- if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
- (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
- (n1 < s7_int32_min) || (n2 < s7_int32_min))
+ else
{
- int d1bits, d2bits;
- d1bits = integer_length(d1);
- d2bits = integer_length(d2);
- if (((d1bits + d2bits) > s7_int_bits) ||
- ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
- ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
- {
- if (is_null(p))
- return(make_real(sc, ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2)));
- rl_a = ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2);
- goto SUBTRACT_REALS;
- }
+ if (n1 <= n2) goto NOT_GREATER;
}
- num_a = n1 * d2 - n2 * d1;
- den_a = d1 * d2;
-#endif
#else
- num_a = n1 * d2 - n2 * d1;
- den_a = d1 * d2;
+ if ((n1 * d2) <= (n2 * d1)) goto NOT_GREATER;
#endif
- if (is_null(p))
- return(s7_make_ratio(sc, num_a, den_a));
}
- if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
- goto SUBTRACT_INTEGERS;
- goto SUBTRACT_RATIOS;
}
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_GREATER;
case T_REAL:
- if (is_null(p)) return(make_real(sc, ((long double)num_a / (long double)den_a) - real(x)));
- rl_a = ((long double)num_a / (long double)den_a) - real(x);
- goto SUBTRACT_REALS;
-
- case T_COMPLEX:
- if (is_null(p)) return(s7_make_complex(sc, ((long double)num_a / (long double)den_a) - real_part(x), -imag_part(x)));
- rl_a = ((long double)num_a / (long double)den_a) - real_part(x);
- im_a = -imag_part(x);
- goto SUBTRACT_COMPLEX;
+ if (is_NaN(real(y))) goto NOT_GREATER;
+ if (fraction(x) <= real(y)) goto NOT_GREATER;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_GREATER;
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(sc, y, sc->gt_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
- break;
+
case T_REAL:
- rl_a = real(x);
+ if (is_NaN(real(x))) goto NOT_GREATER;
- SUBTRACT_REALS:
- x = car(p);
+ REAL_GREATER:
+ y = car(p);
p = cdr(p);
-
- switch (type(x))
+ switch (type(y))
{
case T_INTEGER:
- if (is_null(p)) return(make_real(sc, rl_a - integer(x)));
- rl_a -= (s7_double)integer(x);
- goto SUBTRACT_REALS;
+ if (real(x) <= integer(y)) goto NOT_GREATER;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_GREATER;
case T_RATIO:
- if (is_null(p)) return(make_real(sc, rl_a - fraction(x)));
- rl_a -= (s7_double)fraction(x);
- goto SUBTRACT_REALS;
+ if (real(x) <= fraction(y)) goto NOT_GREATER;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_GREATER;
case T_REAL:
- if (is_null(p)) return(make_real(sc, rl_a - real(x)));
- rl_a -= real(x);
- goto SUBTRACT_REALS;
-
- case T_COMPLEX:
- if (is_null(p)) return(s7_make_complex(sc, rl_a - real_part(x), -imag_part(x)));
- rl_a -= real_part(x);
- im_a = -imag_part(x);
- goto SUBTRACT_COMPLEX;
+ if (is_NaN(real(y))) goto NOT_GREATER;
+ if (real(x) <= real(y)) goto NOT_GREATER;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_GREATER;
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(sc, y, sc->gt_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
- break;
- case T_COMPLEX:
- rl_a = real_part(x);
- im_a = imag_part(x);
+ default:
+ method_or_bust(sc, x, sc->gt_symbol, args, T_REAL, 1);
+ }
- SUBTRACT_COMPLEX:
- x = car(p);
- p = cdr(p);
-
- switch (type(x))
- {
- case T_INTEGER:
- if (is_null(p)) return(s7_make_complex(sc, rl_a - integer(x), im_a));
- rl_a -= (s7_double)integer(x);
- goto SUBTRACT_COMPLEX;
-
- case T_RATIO:
- if (is_null(p)) return(s7_make_complex(sc, rl_a - fraction(x), im_a));
- rl_a -= (s7_double)fraction(x);
- goto SUBTRACT_COMPLEX;
-
- case T_REAL:
- if (is_null(p)) return(s7_make_complex(sc, rl_a - real(x), im_a));
- rl_a -= real(x);
- goto SUBTRACT_COMPLEX;
-
- case T_COMPLEX:
- if (is_null(p)) return(s7_make_complex(sc, rl_a - real_part(x), im_a - imag_part(x)));
- rl_a -= real_part(x);
- im_a -= imag_part(x);
- if (im_a == 0.0)
- goto SUBTRACT_REALS;
- 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);
- }
- break;
+ NOT_GREATER:
+ for (; is_pair(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->gt_symbol, position_of(p, args), car(p), T_REAL));
- default:
- method_or_bust_with_type(sc, x, sc->subtract_symbol, args, a_number_string, 1);
- }
+ return(sc->F);
}
-static s7_pointer subtract_1, subtract_s1, subtract_cs1, subtract_2, subtract_csn;
-static s7_pointer g_subtract_1(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_greater_or_equal(s7_scheme *sc, s7_pointer args)
{
- s7_pointer p;
+ #define H_greater_or_equal "(>= x1 ...) returns #t if its arguments are in decreasing order"
+ #define Q_greater_or_equal s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_real_symbol)
+ /* (>= 1+i 1+i) is an error which seems unfortunate */
+ s7_pointer x, y, p;
- p = car(args);
- switch (type(p))
+ x = car(args);
+ p = cdr(args);
+
+ switch (type(x))
{
case T_INTEGER:
- if (integer(p) == s7_int_min)
-#if WITH_GMP
- return(big_negate(sc, set_plist_1(sc, promote_number(sc, T_BIG_INTEGER, p))));
-#else
- return(make_integer(sc, s7_int_max));
-#endif
- return(make_integer(sc, -integer(p)));
-
- case T_RATIO:
- return(s7_make_ratio(sc, -numerator(p), denominator(p)));
-
- case T_REAL:
- return(make_real(sc, -real(p)));
+ INTEGER_GEQ:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(x) < integer(y)) goto NOT_GEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_GEQ;
- case T_COMPLEX:
- return(s7_make_complex(sc, -real_part(p), -imag_part(p)));
+ case T_RATIO:
+ /* no gmp here, but this can overflow: (< 9223372036 1/9223372036), but conversion to real is also problematic
+ */
+ if ((integer(x) <= 0) && (numerator(y) > 0)) goto NOT_GEQ;
+ if ((integer(x) >= 0) && (numerator(y) < 0))
+ {
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_GEQ;
+ }
+ if ((integer(x) < s7_int32_max) &&
+ (integer(x) > s7_int32_min) &&
+ (denominator(y) < s7_int32_max))
+ {
+ if ((integer(x) * denominator(y)) < numerator(y)) goto NOT_GEQ;
+ }
+ else
+ {
+ if (integer(x) < fraction(y)) goto NOT_GEQ;
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_GEQ;
- default:
- method_or_bust_with_type(sc, p, sc->subtract_symbol, args, a_number_string, 1);
- }
-}
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_GEQ;
+ if (integer(x) < real(y)) goto NOT_GEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_GEQ;
-static s7_pointer g_subtract_2(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer x, y;
+ default:
+ method_or_bust(sc, y, sc->geq_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
- x = car(args);
- y = cadr(args);
- if (type(x) == type(y))
- {
- if (is_t_real(x))
- return(make_real(sc, real(x) - real(y)));
- else
+ case T_RATIO:
+ RATIO_GEQ:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
{
- switch (type(x))
+ case T_INTEGER:
+ if ((numerator(x) < 0) && (integer(y) >= 0)) goto NOT_GEQ;
+ if ((numerator(x) > 0) && (integer(y) <= 0))
{
-#if HAVE_OVERFLOW_CHECKS
- case T_INTEGER:
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_GEQ;
+ }
+ if ((integer(y) < s7_int32_max) &&
+ (integer(y) > s7_int32_min) &&
+ (denominator(x) < s7_int32_max))
+ {
+ if (numerator(x) < (integer(y) * denominator(x))) goto NOT_GEQ;
+ }
+ else
+ {
+ if (fraction(x) < integer(y)) goto NOT_GEQ;
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_GEQ;
+
+ case T_RATIO:
+ {
+ s7_int d1, d2, n1, n2;
+ d1 = denominator(x);
+ n1 = numerator(x);
+ d2 = denominator(y);
+ n2 = numerator(y);
+ if (d1 == d2)
{
- s7_int val;
- if (subtract_overflow(integer(x), integer(y), &val))
- return(make_real(sc, (double)integer(x) - (double)integer(y)));
- return(make_integer(sc, val));
+ if (n1 < n2) goto NOT_GEQ;
}
+ else
+ {
+#if HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(n1, d2, &n1)) ||
+ (multiply_overflow(n2, d1, &n2)))
+ {
+ if (fraction(x) < fraction(y)) goto NOT_GEQ;
+ }
+ else
+ {
+ if (n1 < n2) goto NOT_GEQ;
+ }
#else
- case T_INTEGER: return(make_integer(sc, integer(x) - integer(y)));
+ if ((n1 * d2) < (n2 * d1)) goto NOT_GEQ;
#endif
- case T_RATIO: return(g_subtract(sc, args));
- case T_REAL: return(make_real(sc, real(x) - real(y)));
- case T_COMPLEX: return(make_complex(sc, real_part(x) - real_part(y), imag_part(x) - imag_part(y)));
- default:
- if (!is_number(x))
- method_or_bust_with_type(sc, x, sc->subtract_symbol, args, a_number_string, 1);
- method_or_bust_with_type(sc, y, sc->subtract_symbol, args, a_number_string, 2);
- }
- }
- }
+ }
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_GEQ;
- switch (type(x))
- {
- case T_INTEGER:
- switch (type(y))
- {
- case T_INTEGER: return(make_integer(sc, integer(x) - integer(y)));
- case T_RATIO: return(g_subtract(sc, args));
- case T_REAL: return(make_real(sc, integer(x) - real(y)));
- case T_COMPLEX: return(make_complex(sc, integer(x) - real_part(y), -imag_part(y)));
- default:
- method_or_bust_with_type(sc, y, sc->subtract_symbol, args, a_number_string, 2);
- }
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_GEQ;
+ if (fraction(x) < real(y)) goto NOT_GEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_GEQ;
- case T_RATIO:
- switch (type(y))
- {
- case T_INTEGER:
- case T_RATIO: return(g_subtract(sc, args));
- case T_REAL: return(make_real(sc, fraction(x) - real(y)));
- case T_COMPLEX: return(s7_make_complex(sc, fraction(x) - real_part(y), -imag_part(y)));
default:
- method_or_bust_with_type(sc, y, sc->subtract_symbol, args, a_number_string, 2);
+ method_or_bust(sc, y, sc->geq_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
+
case T_REAL:
- switch (type(y))
- {
- case T_INTEGER: return(make_real(sc, real(x) - integer(y)));
- case T_RATIO: return(make_real(sc, real(x) - fraction(y)));
- case T_REAL: return(make_real(sc, real(x) - real(y)));
- case T_COMPLEX: return(make_complex(sc, real(x) - real_part(y), -imag_part(y)));
- default:
- method_or_bust_with_type(sc, y, sc->subtract_symbol, args, a_number_string, 2);
- }
+ if (is_NaN(real(x))) goto NOT_GEQ;
- case T_COMPLEX:
+ REAL_GEQ:
+ y = car(p);
+ p = cdr(p);
switch (type(y))
{
- case T_INTEGER: return(s7_make_complex(sc, real_part(x) - integer(y), imag_part(x)));
- case T_RATIO: return(s7_make_complex(sc, real_part(x) - fraction(y), imag_part(x)));
- case T_REAL: return(s7_make_complex(sc, real_part(x) - real(y), imag_part(x)));
- case T_COMPLEX: return(make_complex(sc, real_part(x) - real_part(y), imag_part(x) - imag_part(y)));
+ case T_INTEGER:
+ if (real(x) < integer(y)) goto NOT_GEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_GEQ;
+
+ case T_RATIO:
+ if (real(x) < fraction(y)) goto NOT_GEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_GEQ;
+
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_GEQ;
+ if (real(x) < real(y)) goto NOT_GEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_GEQ;
+
default:
- method_or_bust_with_type(sc, y, sc->subtract_symbol, args, a_number_string, 2);
+ method_or_bust(sc, y, sc->geq_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
default:
- method_or_bust_with_type(sc, x, sc->subtract_symbol, args, a_number_string, 1);
+ method_or_bust(sc, x, sc->geq_symbol, args, T_REAL, 1);
}
- return(x);
+
+ NOT_GEQ:
+ for (; is_pair(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->geq_symbol, position_of(p, args), car(p), T_REAL));
+
+ return(sc->F);
+
}
-static s7_pointer g_subtract_cs1(s7_scheme *sc, s7_pointer args)
+static s7_pointer less_s_ic, less_s0;
+static s7_pointer g_less_s0(s7_scheme *sc, s7_pointer args)
{
s7_pointer x;
- x = find_symbol_checked(sc, car(args));
+ x = car(args);
if (is_integer(x))
- return(make_integer(sc, integer(x) - 1));
-
- switch (type(x))
- {
-#if HAVE_OVERFLOW_CHECKS
- case T_INTEGER:
- {
- s7_int val;
- if (subtract_overflow(integer(x), 1, &val))
- return(make_real(sc, (double)integer(x) - 1.0));
- return(make_integer(sc, val));
- }
-#else
- case T_INTEGER: return(make_integer(sc, integer(x) - 1));
-#endif
- case T_RATIO: return(subtract_ratios(sc, x, small_int(1)));
- case T_REAL: return(make_real(sc, real(x) - 1.0));
- case T_COMPLEX: return(s7_make_complex(sc, real_part(x) - 1.0, imag_part(x)));
- default:
- method_or_bust_with_type(sc, x, sc->subtract_symbol, list_2(sc, x, small_int(1)), a_number_string, 1);
- }
- return(x);
+ return(make_boolean(sc, integer(x) < 0));
+ if (is_real(x))
+ return(make_boolean(sc, s7_is_negative(x)));
+ method_or_bust(sc, x, sc->lt_symbol, args, T_REAL, 1);
}
-static s7_pointer g_subtract_s1(s7_scheme *sc, s7_pointer args)
+static bool ratio_lt_pi(s7_pointer x, s7_int y)
{
- s7_pointer x;
- x = car(args);
- /* this one seems to hit reals as often as integers */
- switch (type(x))
- {
-#if HAVE_OVERFLOW_CHECKS
- case T_INTEGER:
- {
- s7_int val;
- if (subtract_overflow(integer(x), 1, &val))
- return(make_real(sc, (double)integer(x) - 1.0));
- return(make_integer(sc, val));
- }
-#else
- case T_INTEGER: return(make_integer(sc, integer(x) - 1));
-#endif
- case T_RATIO: return(subtract_ratios(sc, x, small_int(1)));
- case T_REAL: return(make_real(sc, real(x) - 1.0));
- case T_COMPLEX: return(s7_make_complex(sc, real_part(x) - 1.0, imag_part(x)));
- default:
- method_or_bust_with_type(sc, x, sc->subtract_symbol, args, a_number_string, 1);
- }
- return(x);
+ if ((y >= 0) && (numerator(x) < 0))
+ return(true);
+ if ((y <= 0) && (numerator(x) > 0))
+ return(false);
+ if (denominator(x) < s7_int32_max)
+ return(numerator(x) < (y * denominator(x)));
+ return(fraction(x) < y);
}
-static s7_pointer g_subtract_csn(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_less_s_ic(s7_scheme *sc, s7_pointer args)
{
+ s7_int y;
s7_pointer x;
- s7_int n;
- x = find_symbol_checked(sc, car(args));
- n = s7_integer(cadr(args));
- if (is_integer(x))
- return(make_integer(sc, integer(x) - n));
+ x = car(args);
+ y = integer(cadr(args));
- switch (type(x))
- {
-#if HAVE_OVERFLOW_CHECKS
- case T_INTEGER:
- {
- s7_int val;
- if (subtract_overflow(integer(x), n, &val))
- return(make_real(sc, (double)integer(x) - (double)n));
- return(make_integer(sc, val));
- }
-#else
- case T_INTEGER: return(make_integer(sc, integer(x) - n));
-#endif
- case T_RATIO: return(subtract_ratios(sc, x, cadr(args)));
- case T_REAL: return(make_real(sc, real(x) - n));
- case T_COMPLEX: return(s7_make_complex(sc, real_part(x) - n, imag_part(x)));
- default:
- method_or_bust_with_type(sc, x, sc->subtract_symbol, list_2(sc, x, cadr(args)), a_number_string, 1);
- }
- return(x);
+ if (type(x) == T_INTEGER)
+ return(make_boolean(sc, integer(x) < y));
+ if (type(x) == T_REAL)
+ return(make_boolean(sc, real(x) < y));
+ if (type(x) == T_RATIO)
+ return(make_boolean(sc, ratio_lt_pi(x, y)));
+ method_or_bust(sc, x, sc->lt_symbol, args, T_REAL, 1);
}
-static s7_pointer subtract_sf;
-static s7_pointer g_subtract_sf(s7_scheme *sc, s7_pointer args)
+static s7_pointer less_length_ic;
+static s7_pointer g_less_length_ic(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
- s7_double n;
+ s7_int ilen;
+ s7_pointer val;
- x = find_symbol_checked(sc, car(args));
- n = real(cadr(args));
- switch (type(x))
+ val = find_symbol_unchecked(sc, cadar(args));
+ ilen = s7_integer(cadr(args));
+
+ switch (type(val))
{
- case T_INTEGER: return(make_real(sc, integer(x) - n));
- case T_RATIO: return(make_real(sc, fraction(x) - n));
- case T_REAL: return(make_real(sc, real(x) - n));
- case T_COMPLEX: return(s7_make_complex(sc, real_part(x) - n, imag_part(x)));
- default:
- method_or_bust_with_type(sc, x, sc->subtract_symbol, list_2(sc, x, cadr(args)), a_number_string, 1);
+ case T_PAIR: return(make_boolean(sc, s7_list_length(sc, val) < ilen));
+ case T_NIL: return(make_boolean(sc, ilen > 0));
+ 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_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:
+ case T_VECTOR: return(make_boolean(sc, vector_length(val) < ilen));
+ case T_CLOSURE:
+ case T_CLOSURE_STAR: if (has_methods(val)) return(make_boolean(sc, closure_length(sc, val) < ilen));
+ default: return(simple_wrong_type_argument_with_type(sc, sc->length_symbol, val, a_sequence_string)); /* no check method here because we checked above */
}
- return(x);
+ return(sc->F);
}
-static s7_pointer subtract_2f;
-static s7_pointer g_subtract_2f(s7_scheme *sc, s7_pointer args)
+static s7_pointer c_less_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- s7_pointer x;
- s7_double n;
-
- x = car(args);
- n = real(cadr(args));
- switch (type(x))
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
{
- case T_INTEGER: return(make_real(sc, integer(x) - n));
- case T_RATIO: return(make_real(sc, fraction(x) - n));
- case T_REAL: return(make_real(sc, real(x) - n));
- case T_COMPLEX: return(s7_make_complex(sc, real_part(x) - n, imag_part(x)));
- default:
- method_or_bust_with_type(sc, x, sc->subtract_symbol, args, a_number_string, 1);
+ if (type(x) == T_INTEGER)
+ return(make_boolean(sc, integer(x) < integer(y)));
+ if (type(x) == T_REAL)
+ return(make_boolean(sc, real(x) < real(y)));
+ if (type(x) == T_RATIO)
+ return(make_boolean(sc, fraction(x) < fraction(y)));
}
- return(x);
-}
-
-static s7_pointer subtract_fs;
-static s7_pointer g_subtract_fs(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer x;
- s7_double n;
+#endif
- x = find_symbol_checked(sc, cadr(args));
- n = real(car(args));
switch (type(x))
{
- case T_INTEGER: return(make_real(sc, n - integer(x)));
- case T_RATIO: return(make_real(sc, n - fraction(x)));
- case T_REAL: return(make_real(sc, n - real(x)));
- case T_COMPLEX: return(s7_make_complex(sc, n - real_part(x), -imag_part(x)));
- default:
- method_or_bust_with_type(sc, x, sc->subtract_symbol, list_2(sc, car(args), x), a_number_string, 2);
- }
- return(x);
-}
+ case T_INTEGER:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ return(make_boolean(sc, integer(x) < integer(y)));
-static s7_pointer subtract_f_sqr;
-static s7_pointer g_subtract_f_sqr(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer x;
- s7_double y;
+ case T_RATIO:
+ return(g_less(sc, set_plist_2(sc, x, y)));
- y = real(car(args));
- x = find_symbol_checked(sc, cadr(cadr(args)));
- if (is_t_real(x))
- return(make_real(sc, y - (real(x) * real(x))));
+ case T_REAL:
+ if (is_NaN(real(y))) return(sc->F);
+ return(make_boolean(sc, integer(x) < real(y)));
- switch (type(x))
- {
- case T_INTEGER: return(make_real(sc, y - (integer(x) * integer(x))));
- case T_RATIO: return(make_real(sc, y - (fraction(x) * fraction(x))));
- case T_REAL: return(make_real(sc, y - (real(x) * real(x))));
- case T_COMPLEX: return(s7_make_complex(sc, y - real_part(x) * real_part(x) + imag_part(x) * imag_part(x), 2.0 * real_part(x) * imag_part(x)));
- default:
- /* complicated -- look for * method, if any get (* x x), then go to g_subtract_2 with that and the original y
- * can't use check_method here because it returns from the caller.
- */
- {
- s7_pointer func;
- if ((func = find_method(sc, find_let(sc, x), sc->multiply_symbol)) != sc->undefined)
- return(g_subtract_2(sc, set_plist_2(sc, car(args), s7_apply_function(sc, func, list_2(sc, x, x)))));
- return(wrong_type_argument_with_type(sc, sc->multiply_symbol, 1, x, a_number_string));
- }
- }
- return(x);
-}
+ default:
+ method_or_bust(sc, y, sc->lt_symbol, list_2(sc, x, y), T_REAL, 2);
+ }
+ break;
-#if (!WITH_GMP)
-/* (define (hi) (- (random 100) 50)) (define (ho) (- (random 1.0) 0.5)) */
-static s7_pointer sub_random_ic, sub_random_rc;
-static s7_pointer g_sub_random_ic(s7_scheme *sc, s7_pointer args)
-{
- return(make_integer(sc, ((s7_int)(integer(cadar(args)) * next_random(sc->default_rng))) - integer(cadr(args))));
-}
+ case T_RATIO:
+ return(g_less(sc, set_plist_2(sc, x, y)));
-static s7_pointer g_sub_random_rc(s7_scheme *sc, s7_pointer args)
-{
- return(make_real(sc, real(cadar(args)) * next_random(sc->default_rng) - real(cadr(args))));
-}
+ case T_REAL:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (is_NaN(real(x))) return(sc->F);
+ return(make_boolean(sc, real(x) < integer(y)));
+ case T_RATIO:
+ if (is_NaN(real(x))) return(sc->F);
+ return(make_boolean(sc, real(x) < fraction(y)));
-static s7_int negate_if_c(s7_scheme *sc, s7_pointer **p) {s7_pointer x; x = (**p); (*p)++; return(-integer(x));}
-static s7_int negate_if_s(s7_scheme *sc, s7_pointer **p) {s7_pointer x; x = slot_value(**p); (*p)++; return(-integer(x));}
-static s7_int negate_if_p(s7_scheme *sc, s7_pointer **p) {s7_if_t f; f = (s7_if_t)(**p); (*p)++; return(f(sc, p));}
+ case T_REAL:
+ if (is_NaN(real(x))) return(sc->F);
+ /* if (is_NaN(real(y))) return(sc->F); */
+ return(make_boolean(sc, real(x) < real(y)));
-static s7_int sub_if_cc(s7_scheme *sc, s7_pointer **p) {s7_pointer x, y; x = (**p); (*p)++; y = (**p); (*p)++; return(integer(x) - integer(y));}
-static s7_int sub_if_cs(s7_scheme *sc, s7_pointer **p) {s7_pointer x, y; x = (**p); (*p)++; y = slot_value(**p); (*p)++; return(integer(x) - integer(y));}
-static s7_int sub_if_ss(s7_scheme *sc, s7_pointer **p) {s7_pointer x, y; x = slot_value(**p); (*p)++; y = slot_value(**p); (*p)++; return(integer(x) - integer(y));}
-static s7_int sub_if_sc(s7_scheme *sc, s7_pointer **p) {s7_pointer x, y; x = slot_value(**p); (*p)++; y = (**p); (*p)++; return(integer(x) - integer(y));}
+ default:
+ method_or_bust(sc, y, sc->lt_symbol, list_2(sc, x, y), T_REAL, 2);
+ }
+ break;
-static s7_int sub_if_cp(s7_scheme *sc, s7_pointer **p)
-{
- s7_if_t xf;
- s7_pointer x;
- x = (**p); (*p)++;
- xf = (s7_if_t)(**p); (*p)++;
- return(integer(x) - xf(sc, p));
+ default:
+ method_or_bust(sc, x, sc->lt_symbol, list_2(sc, x, y), T_REAL, 1);
+ }
+ return(sc->T);
}
-static s7_int sub_if_pc(s7_scheme *sc, s7_pointer **p)
-{
- s7_if_t xf;
- s7_int x;
- s7_pointer y;
- xf = (s7_if_t)(**p); (*p)++; x = xf(sc,p);
- y = (**p); (*p)++;
- return(x - integer(y));
-}
+static s7_pointer less_p_pp(s7_pointer p1, s7_pointer p2) {return(c_less_2(cur_sc, p1, p2));}
-static s7_int sub_if_sp(s7_scheme *sc, s7_pointer **p)
-{
- s7_if_t xf;
- s7_pointer x;
- x = slot_value(**p); (*p)++;
- xf = (s7_if_t)(**p); (*p)++;
- return(integer(x) - xf(sc, p));
-}
+static s7_pointer less_2;
+static s7_pointer g_less_2(s7_scheme *sc, s7_pointer args) {return(c_less_2(sc, car(args), cadr(args)));}
-static s7_int sub_if_ps(s7_scheme *sc, s7_pointer **p)
+static bool ratio_leq_pi(s7_pointer x, s7_int y)
{
- s7_if_t xf;
- s7_int x;
- s7_pointer y;
- xf = (s7_if_t)(**p); (*p)++; x = xf(sc,p);
- y = slot_value(**p); (*p)++;
- return(x - integer(y));
+ if ((y >= 0) && (numerator(x) <= 0))
+ return(true);
+ if ((y <= 0) && (numerator(x) > 0))
+ return(false);
+ if (denominator(x) < s7_int32_max)
+ return(numerator(x) <= (y * denominator(x)));
+ return(fraction(x) <= y);
}
-static s7_int sub_if_pp(s7_scheme *sc, s7_pointer **p)
+static s7_pointer leq_s_ic;
+static s7_pointer g_leq_s_ic(s7_scheme *sc, s7_pointer args)
{
- s7_if_t xf;
- s7_int x, y;
- xf = (s7_if_t)(**p); (*p)++; x = xf(sc,p);
- xf = (s7_if_t)(**p); (*p)++; y = xf(sc,p);
- return(x - y);
+ s7_int y;
+ s7_pointer x;
+
+ x = car(args);
+ y = s7_integer(cadr(args));
+
+ if (type(x) == T_INTEGER)
+ return(make_boolean(sc, integer(x) <= y));
+ if (type(x) == T_REAL)
+ return(make_boolean(sc, real(x) <= y));
+ if (type(x) == T_RATIO)
+ return(make_boolean(sc, ratio_leq_pi(x, y)));
+ method_or_bust(sc, x, sc->leq_symbol, args, T_REAL, 1);
}
-static s7_if_t subtract_if(s7_scheme *sc, s7_pointer expr)
+static s7_pointer c_leq_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- s7_pointer a1, a2, slot;
- xf_t *rc;
- if (!is_pair(cdr(expr))) return(NULL);
-
- xf_init(2);
- a1 = cadr(expr);
- if (is_null(cddr(expr)))
+
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
{
- if (is_t_integer(a1))
- {
- xf_store(a1);
- return(negate_if_c);
- }
- if (is_symbol(a1))
- {
- s7_pointer s1;
- s1 = s7_slot(sc, a1);
- if ((!is_slot(s1)) || (is_unsafe_stepper(s1)) || (!is_t_integer(slot_value(s1)))) return(NULL);
- xf_store(s1);
- return(negate_if_s);
- }
- if ((is_pair(a1)) &&
- (s7_arg_to_if(sc, a1)))
- return(negate_if_p);
- return(NULL);
+ if (type(x) == T_INTEGER)
+ return(make_boolean(sc, integer(x) <= integer(y)));
+ if (type(x) == T_REAL)
+ return(make_boolean(sc, real(x) <= real(y)));
+ if (type(x) == T_RATIO)
+ return(make_boolean(sc, fraction(x) <= fraction(y)));
}
-
- a2 = caddr(expr);
- if (is_null(cdddr(expr)))
+#endif
+
+ switch (type(x))
{
- if (is_t_integer(a1))
+ case T_INTEGER:
+ switch (type(y))
{
- xf_store(a1);
- if (is_t_integer(a2))
- {
- xf_store(a2);
- return(sub_if_cc);
- }
- if (is_symbol(a2))
- {
- slot = s7_slot(sc, a2);
- if ((!slot) || (!is_t_integer(slot_value(slot))) || (is_unsafe_stepper(slot))) return(NULL);
- xf_store(slot);
- return(sub_if_cs);
- }
- if ((is_pair(a2)) &&
- (s7_arg_to_if(sc, a2)))
- return(sub_if_cp);
- return(NULL);
- }
- if (is_symbol(a1))
- {
- slot = s7_slot(sc, a1);
- if ((!slot) || (!is_t_integer(slot_value(slot))) || (is_unsafe_stepper(slot))) return(NULL);
- xf_store(slot);
- if (is_t_integer(a2))
- {
- xf_store(a2);
- return(sub_if_sc);
- }
- if (is_symbol(a2))
- {
- slot = s7_slot(sc, a2);
- if ((!slot) || (!is_t_integer(slot_value(slot))) || (is_unsafe_stepper(slot))) return(NULL);
- xf_store(slot);
- return(sub_if_ss);
- }
- if ((is_pair(a2)) &&
- (s7_arg_to_if(sc, a2)))
- return(sub_if_sp);
- return(NULL);
+ case T_INTEGER:
+ return(make_boolean(sc, integer(x) <= integer(y)));
+
+ case T_RATIO:
+ return(g_less_or_equal(sc, set_plist_2(sc, x, y)));
+
+ case T_REAL:
+ if (is_NaN(real(y))) return(sc->F);
+ return(make_boolean(sc, integer(x) <= real(y)));
+
+ default:
+ method_or_bust(sc, y, sc->leq_symbol, list_2(sc, x, y), T_REAL, 2);
}
- if (is_pair(a1) &&
- (s7_arg_to_if(sc, a1)))
+ break;
+
+ case T_RATIO:
+ return(g_less_or_equal(sc, set_plist_2(sc, x, y)));
+
+ case T_REAL:
+ switch (type(y))
{
- if (is_t_integer(a2))
- {
- xf_store(a2);
- return(sub_if_pc);
- }
- if (is_symbol(a2))
- {
- slot = s7_slot(sc, a2);
- if ((!slot) || (!is_t_integer(slot_value(slot))) || (is_unsafe_stepper(slot))) return(NULL);
- xf_store(slot);
- return(sub_if_ps);
- }
- if ((is_pair(a2)) &&
- (s7_arg_to_if(sc, a2)))
- return(sub_if_pp);
- }
- return(NULL);
- }
-
- {
- s7_if_t xf, res;
- ptr_int loc;
-
- if (is_t_integer(a1))
- {
- xf_store(a1);
- res = sub_if_cp;
- }
- else
- {
- if (is_symbol(a1))
- {
- slot = s7_slot(sc, a1);
- if ((!slot) || (!is_t_integer(slot_value(slot))) || (is_unsafe_stepper(slot))) return(NULL);
- xf_store(slot);
- res = sub_if_sp;
- }
- else
- {
- if ((!is_pair(a1)) || (!s7_arg_to_if(sc, a1))) return(NULL);
- res = sub_if_pp;
- }
- }
-
- xf_save_loc(loc);
- xf = add_if(sc, cdr(expr));
- if (xf)
- {
- xf_store_at(loc, (s7_pointer)xf);
- return(res);
- }
- }
- return(NULL);
-}
+ case T_INTEGER:
+ if (is_NaN(real(x))) return(sc->F);
+ return(make_boolean(sc, real(x) <= integer(y)));
+
+ case T_RATIO:
+ if (is_NaN(real(x))) return(sc->F);
+ return(make_boolean(sc, real(x) <= fraction(y)));
+ case T_REAL:
+ if (is_NaN(real(x))) return(sc->F);
+ /* if (is_NaN(real(y))) return(sc->F); */
+ return(make_boolean(sc, real(x) <= real(y)));
-static s7_double negate_rf_c(s7_scheme *sc, s7_pointer **p) {s7_pointer x; x = (**p); (*p)++; return(-(real_to_double(sc, x, "-")));}
-static s7_double negate_rf_s(s7_scheme *sc, s7_pointer **p) {s7_pointer x; x = slot_value(**p); (*p)++; return(-(real_to_double(sc, x, "-")));}
-static s7_double negate_rf_p(s7_scheme *sc, s7_pointer **p) {s7_rf_t f; f = (s7_rf_t)(**p); (*p)++; return(f(sc, p));}
+ default:
+ method_or_bust(sc, y, sc->leq_symbol, list_2(sc, x, y), T_REAL, 2);
+ }
+ break;
-static s7_double sub_rf_cc(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer x, y;
- x = (**p); (*p)++;
- y = (**p); (*p)++;
- return(real(x) - real_to_double(sc, y, "-"));
+ default:
+ method_or_bust(sc, x, sc->leq_symbol, list_2(sc, x, y), T_REAL, 1);
+ }
+ return(sc->T);
}
-static s7_double sub_rf_cs(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer x, y;
- x = (**p); (*p)++;
- y = slot_value(**p); (*p)++;
- return(real(x) - real_to_double(sc, y, "-"));
-}
+static s7_pointer leq_p_pp(s7_pointer p1, s7_pointer p2) {return(c_leq_2(cur_sc, p1, p2));}
-static s7_double sub_rf_ss(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer x, y;
- s7_double x1;
- x = slot_value(**p); (*p)++;
- y = slot_value(**p); (*p)++;
- x1 = real_to_double(sc, x, "-");
- return(x1 - real_to_double(sc, y, "-"));
-}
+static s7_pointer leq_2;
+static s7_pointer g_leq_2(s7_scheme *sc, s7_pointer args) {return(c_leq_2(sc, car(args), cadr(args)));}
-static s7_double sub_rf_sc(s7_scheme *sc, s7_pointer **p)
+static s7_pointer greater_s_ic, greater_s_fc;
+static s7_pointer g_greater_s_ic(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x, y;
- x = slot_value(**p); (*p)++;
- y = (**p); (*p)++;
- return(real_to_double(sc, x, "-") - real(y));
-}
+ s7_int y;
+ s7_pointer x;
-static s7_double sub_rf_cp(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t rf;
- s7_pointer x;
- x = (**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- return(real_to_double(sc, x, "-") - rf(sc, p));
-}
+ x = car(args);
+ y = integer(cadr(args));
-static s7_double sub_rf_pc(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t rf;
- s7_double x;
- s7_pointer y;
- rf = (s7_rf_t)(**p); (*p)++; x = rf(sc,p);
- y = (**p); (*p)++;
- return(x - real_to_double(sc, y, "-"));
+ if (type(x) == T_INTEGER)
+ return(make_boolean(sc, integer(x) > y));
+ if (type(x) == T_REAL)
+ return(make_boolean(sc, real(x) > y));
+ if (type(x) == T_RATIO)
+ return(make_boolean(sc, !ratio_leq_pi(x, y)));
+ method_or_bust_with_type(sc, x, sc->gt_symbol, args, a_number_string, 1);
}
-static s7_double sub_rf_sp(s7_scheme *sc, s7_pointer **p)
+static s7_pointer g_greater_s_fc(s7_scheme *sc, s7_pointer args)
{
- s7_rf_t rf;
- s7_pointer x;
- x = slot_value(**p); (*p)++;
- rf = (s7_rf_t)(**p); (*p)++;
- return(real_to_double(sc, x, "-") - rf(sc, p));
-}
+ s7_double y;
+ s7_pointer x;
-static s7_double sub_rf_ps(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t rf;
- s7_double x;
- s7_pointer y;
- rf = (s7_rf_t)(**p); (*p)++; x = rf(sc,p);
- y = slot_value(**p); (*p)++;
- return(x - real_to_double(sc, y, "-"));
-}
+ x = car(args);
+ y = real(cadr(args));
-static s7_double sub_rf_pp(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t rf;
- s7_double x, y;
- rf = (s7_rf_t)(**p); (*p)++; x = rf(sc,p);
- rf = (s7_rf_t)(**p); (*p)++; y = rf(sc,p);
- return(x - y);
-}
+ if (is_t_real(x))
+ return(make_boolean(sc, real(x) > y));
-static s7_rf_t subtract_rf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer a1, a2, slot1, slot2;
- xf_t *rc;
- if (!is_pair(cdr(expr))) return(NULL);
-
- xf_init(2);
- a1 = cadr(expr);
- if (is_null(cddr(expr)))
- {
- if (is_t_real(a1))
- {
- xf_store(a1);
- return(negate_rf_c);
- }
- if (is_symbol(a1))
- {
- slot1 = s7_slot(sc, a1);
- if ((!is_slot(slot1)) || (is_unsafe_stepper(slot1)) || (!(is_real(slot_value(slot1))))) return(NULL);
- xf_store(slot1);
- return(negate_rf_s);
- }
- if ((is_pair(a1)) &&
- (s7_arg_to_if(sc, a1)))
- return(negate_rf_p);
- return(NULL);
- }
-
- a2 = caddr(expr);
- if (is_null(cdddr(expr)))
+ switch (type(x))
{
- if (is_t_real(a1))
- {
- xf_store(a1);
- if (is_real(a2))
- {
- xf_store(a2);
- return(sub_rf_cc);
- }
- if (is_symbol(a2))
- {
- slot2 = s7_slot(sc, a2);
- if ((!slot2) || (!is_real(slot_value(slot2))) || (is_unsafe_stepper(slot2))) return(NULL);
- xf_store(slot2);
- return(sub_rf_cs);
- }
- if ((is_pair(a2)) &&
- (s7_arg_to_if(sc, a2)))
- return(sub_rf_cp);
- return(NULL);
- }
- if (is_symbol(a1))
- {
- slot1 = s7_slot(sc, a1);
- if ((!slot1) || (!is_real(slot_value(slot1))) || (is_unsafe_stepper(slot1))) return(NULL);
- xf_store(slot1);
- if (is_t_real(a2))
- {
- xf_store(a2);
- return(sub_rf_sc);
- }
- if (is_symbol(a2))
- {
- slot2 = s7_slot(sc, a2);
- if ((!slot2) || (!is_real(slot_value(slot2))) || (is_unsafe_stepper(slot2))) return(NULL);
- if ((!is_t_real(slot_value(slot1))) && (!is_t_real(slot_value(slot2)))) return(NULL);
- xf_store(slot2);
- return(sub_rf_ss);
- }
- if ((is_pair(a2)) &&
- (s7_arg_to_rf(sc, a2)))
- return(sub_rf_sp);
- return(NULL);
- }
- if (is_pair(a1) &&
- (s7_arg_to_rf(sc, a1)))
- {
- if (is_real(a2))
- {
- xf_store(a2);
- return(sub_rf_pc);
- }
- if (is_symbol(a2))
- {
- slot2 = s7_slot(sc, a2);
- if ((!slot2) || (!is_real(slot_value(slot2))) || (is_unsafe_stepper(slot2))) return(NULL);
- xf_store(slot2);
- return(sub_rf_ps);
- }
- if ((is_pair(a2)) &&
- (s7_arg_to_rf(sc, a2)))
- return(sub_rf_pp);
- }
- return(NULL);
- }
-
- {
- s7_rf_t rf, res;
- ptr_int loc;
-
- if (is_real(a1))
- {
- xf_store(a1);
- res = sub_rf_cp;
- }
- else
- {
- if (is_symbol(a1))
- {
- slot1 = s7_slot(sc, a1);
- if ((!slot1) || (!is_t_integer(slot_value(slot1))) || (is_unsafe_stepper(slot1))) return(NULL);
- xf_store(slot1);
- res = sub_rf_sp;
- }
- else
- {
- if ((!is_pair(a1)) || (!s7_arg_to_rf(sc, a1))) return(NULL);
- res = sub_rf_pp;
- }
- }
-
- xf_save_loc(loc);
- rf = add_rf(sc, cdr(expr));
- if (rf)
- {
- xf_store_at(loc, (s7_pointer)rf);
- return(res);
- }
- }
- return(NULL);
-}
+ case T_INTEGER:
+ return(make_boolean(sc, integer(x) > y));
-#if WITH_ADD_PF
-static s7_pointer c_subtract_pf2(s7_scheme *sc, s7_pointer **p)
-{
- s7_pf_t pf;
- s7_pointer x, y;
- pf = (s7_pf_t)(**p); (*p)++;
- x = pf(sc, p);
- xf_push(sc, x);
- pf = (s7_pf_t)(**p); (*p)++;
- y = pf(sc, p);
- x = g_subtract_2(sc, set_plist_2(sc, x, y));
- xf_pop(sc);
- return(x);
-}
+ case T_RATIO:
+ /* (> 9223372036854775807/9223372036854775806 1.0) */
+ if (denominator(x) < s7_int32_max) /* y range check was handled in greater_chooser */
+ return(make_boolean(sc, (numerator(x) > (y * denominator(x)))));
+ return(make_boolean(sc, fraction(x) > y));
-static s7_pf_t subtract_pf(s7_scheme *sc, s7_pointer expr)
-{
- int len;
- len = s7_list_length(sc, expr);
- if (len == 3)
- {
- if ((s7_arg_to_pf(sc, cadr(expr))) &&
- (s7_arg_to_pf(sc, caddr(expr))))
- return(c_subtract_pf2);
+ case T_REAL:
+ return(make_boolean(sc, real(x) > y));
+
+ default:
+ method_or_bust_with_type(sc, x, sc->gt_symbol, args, a_number_string, 1);
}
- return(NULL);
+ return(sc->T);
}
-#endif
-#endif
-/* ---------------------------------------- multiply ---------------------------------------- */
-
-static s7_pointer g_multiply(s7_scheme *sc, s7_pointer args)
+static s7_pointer c_greater_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- #define H_multiply "(* ...) multiplies its arguments"
- #define Q_multiply pcl_n
-
- s7_pointer x, p;
- s7_int num_a, den_a;
- s7_double rl_a, im_a;
-
-#if (!WITH_GMP)
- if (is_null(args))
- return(small_int(1));
-#endif
-
- x = car(args);
- p = cdr(args);
- if (is_null(p))
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
{
- if (!is_number(x))
- method_or_bust_with_type(sc, x, sc->multiply_symbol, args, a_number_string, 0);
- return(x);
+ if (type(x) == T_INTEGER)
+ return(make_boolean(sc, integer(x) > integer(y)));
+ if (type(x) == T_REAL)
+ return(make_boolean(sc, real(x) > real(y)));
+ if (type(x) == T_RATIO)
+ return(make_boolean(sc, fraction(x) > fraction(y)));
}
+#endif
switch (type(x))
{
case T_INTEGER:
- num_a = integer(x);
-
- MULTIPLY_INTEGERS:
-#if WITH_GMP
- if ((num_a > s7_int32_max) ||
- (num_a < s7_int32_min))
- return(big_multiply(sc, cons(sc, s7_int_to_big_integer(sc, num_a), p)));
-#endif
- x = car(p);
- p = cdr(p);
- switch (type(x))
+ switch (type(y))
{
case T_INTEGER:
-#if WITH_GMP
- if ((integer(x) > s7_int32_max) ||
- (integer(x) < s7_int32_min))
- return(big_multiply(sc, cons(sc, s7_int_to_big_integer(sc, num_a), cons(sc, x, p))));
-#endif
-
-#if HAVE_OVERFLOW_CHECKS
- {
- s7_int dn;
- if (multiply_overflow(num_a, integer(x), &dn))
- {
- if (is_null(p)) return(make_real(sc, (s7_double)num_a * (s7_double)integer(x)));
- rl_a = (s7_double)num_a * (s7_double)integer(x);
- goto MULTIPLY_REALS;
- }
- num_a = dn;
- }
-#else
- /* perhaps put all the math-safety stuff on the 'safety switch?
- * (* 256 17179869184 4194304) -> 0 which is annoying
- * (* 134217728 137438953472) -> 0
- */
- if ((integer_length(num_a) + integer_length(integer(x))) >= s7_int_bits)
- {
- if (is_null(p)) return(make_real(sc, (s7_double)num_a * (s7_double)integer(x)));
- rl_a = (s7_double)num_a * (s7_double)integer(x);
- goto MULTIPLY_REALS;
- }
- num_a *= integer(x);
-#endif
- if (is_null(p)) return(make_integer(sc, num_a));
- goto MULTIPLY_INTEGERS;
+ return(make_boolean(sc, integer(x) > integer(y)));
case T_RATIO:
-#if HAVE_OVERFLOW_CHECKS
- {
- s7_int dn;
- if (multiply_overflow(numerator(x), num_a, &dn))
- {
- if (is_null(p))
- return(make_real(sc, (s7_double)num_a * fraction(x)));
- rl_a = (s7_double)num_a * fraction(x);
- goto MULTIPLY_REALS;
- }
- num_a = dn;
- }
-#else
- if ((integer_length(num_a) + integer_length(numerator(x))) >= s7_int_bits)
- {
- if (is_null(p))
- return(make_real(sc, (s7_double)num_a * fraction(x)));
- rl_a = (s7_double)num_a * fraction(x);
- goto MULTIPLY_REALS;
- }
- num_a *= numerator(x);
-#endif
- den_a = denominator(x);
- if (is_null(p)) return(s7_make_ratio(sc, num_a, den_a));
- if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
- goto MULTIPLY_INTEGERS;
- goto MULTIPLY_RATIOS;
+ return(g_greater(sc, set_plist_2(sc, x, y)));
case T_REAL:
- if (is_null(p)) return(make_real(sc, num_a * real(x)));
- rl_a = num_a * real(x);
- goto MULTIPLY_REALS;
-
- case T_COMPLEX:
- if (is_null(p)) return(s7_make_complex(sc, num_a * real_part(x), num_a * imag_part(x)));
- rl_a = num_a * real_part(x);
- im_a = num_a * imag_part(x);
- goto MULTIPLY_COMPLEX;
+ if (is_NaN(real(y))) return(sc->F);
+ return(make_boolean(sc, integer(x) > real(y)));
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(sc, y, sc->gt_symbol, list_2(sc, x, y), T_REAL, 2);
}
break;
case T_RATIO:
- num_a = numerator(x);
- den_a = denominator(x);
- MULTIPLY_RATIOS:
-#if WITH_GMP
- if ((num_a > s7_int32_max) ||
- (den_a > s7_int32_max) ||
- (num_a < s7_int32_min))
- return(big_multiply(sc, cons(sc, s7_ratio_to_big_ratio(sc, num_a, den_a), p)));
-#endif
- x = car(p);
- p = cdr(p);
+ return(g_greater(sc, set_plist_2(sc, x, y)));
- switch (type(x))
+ case T_REAL:
+ switch (type(y))
{
case T_INTEGER:
- /* as in +, this can overflow:
- * (* 8 -9223372036854775807 8) -> 64
- * (* 3/4 -9223372036854775807 8) -> 6
- * (* 8 -9223372036854775808 8) -> 0
- * (* -1 9223372036854775806 8) -> 16
- * (* -9223372036854775808 8 1e+308) -> 0.0
- */
-#if HAVE_OVERFLOW_CHECKS
- {
- s7_int dn;
- if (multiply_overflow(integer(x), num_a, &dn))
- {
- if (is_null(p))
- return(make_real(sc, ((s7_double)integer(x) / (s7_double)den_a) * (s7_double)num_a));
- rl_a = ((s7_double)integer(x) / (s7_double)den_a) * (s7_double)num_a;
- goto MULTIPLY_REALS;
- }
- num_a = dn;
- }
-#else
- if ((integer_length(num_a) + integer_length(integer(x))) >= s7_int_bits)
- {
- if (is_null(p))
- return(make_real(sc, ((s7_double)integer(x) / (s7_double)den_a) * (s7_double)num_a));
- rl_a = ((s7_double)integer(x) / (s7_double)den_a) * (s7_double)num_a;
- goto MULTIPLY_REALS;
- }
- num_a *= integer(x);
-#endif
- if (is_null(p)) return(s7_make_ratio(sc, num_a, den_a));
- if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
- goto MULTIPLY_INTEGERS;
- goto MULTIPLY_RATIOS;
+ if (is_NaN(real(x))) return(sc->F);
+ return(make_boolean(sc, real(x) > integer(y)));
case T_RATIO:
- {
-#if (!WITH_GMP)
- s7_int d1, n1;
-#endif
- s7_int d2, n2;
- d2 = denominator(x);
- n2 = numerator(x);
-#if (!WITH_GMP)
- d1 = den_a;
- n1 = num_a;
-#if HAVE_OVERFLOW_CHECKS
- if ((multiply_overflow(n1, n2, &num_a)) ||
- (multiply_overflow(d1, d2, &den_a)))
- {
- if (is_null(p))
- return(make_real(sc, ((long double)n1 / (long double)d1) * ((long double)n2 / (long double)d2)));
- rl_a = ((long double)n1 / (long double)d1) * ((long double)n2 / (long double)d2);
- goto MULTIPLY_REALS;
- }
-#else
- if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
- (n1 > s7_int32_max) || (n2 > s7_int32_max) || /* (* 1/524288 1/19073486328125) for example */
- (n1 < s7_int32_min) || (n2 < s7_int32_min))
- {
- if ((integer_length(d1) + integer_length(d2) > s7_int_bits) ||
- (integer_length(n1) + integer_length(n2) > s7_int_bits))
- {
- if (is_null(p))
- return(make_real(sc, ((long double)n1 / (long double)d1) * ((long double)n2 / (long double)d2)));
- rl_a = ((long double)n1 / (long double)d1) * ((long double)n2 / (long double)d2);
- goto MULTIPLY_REALS;
- }
- }
- num_a *= n2;
- den_a *= d2;
-#endif
-#else
- num_a *= n2;
- den_a *= d2;
-#endif
- if (is_null(p)) return(s7_make_ratio(sc, num_a, den_a));
- if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
- goto MULTIPLY_INTEGERS;
- goto MULTIPLY_RATIOS;
- }
+ if (is_NaN(real(x))) return(sc->F);
+ return(make_boolean(sc, real(x) > fraction(y)));
case T_REAL:
- if (is_null(p)) return(make_real(sc, ((long double)num_a / (long double)den_a) * real(x)));
- rl_a = ((long double)num_a / (long double)den_a) * real(x);
- goto MULTIPLY_REALS;
-
- case T_COMPLEX:
- {
- s7_double frac;
- frac = ((long double)num_a / (long double)den_a);
- if (is_null(p)) return(s7_make_complex(sc, frac * real_part(x), frac * imag_part(x)));
- rl_a = frac * real_part(x);
- im_a = frac * imag_part(x);
- goto MULTIPLY_COMPLEX;
- }
+ if (is_NaN(real(x))) return(sc->F);
+ /* if (is_NaN(real(y))) return(sc->F); */
+ return(make_boolean(sc, real(x) > real(y)));
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(sc, y, sc->gt_symbol, list_2(sc, x, y), T_REAL, 2);
}
break;
- case T_REAL:
- rl_a = real(x);
+ default:
+ method_or_bust(sc, x, sc->gt_symbol, list_2(sc, x, y), T_REAL, 1);
+ }
+ return(sc->T);
+}
- MULTIPLY_REALS:
- x = car(p);
- p = cdr(p);
+static s7_pointer greater_p_pp(s7_pointer p1, s7_pointer p2) {return(c_greater_2(cur_sc, p1, p2));}
- switch (type(x))
+static s7_pointer greater_2;
+static s7_pointer g_greater_2(s7_scheme *sc, s7_pointer args) {return(c_greater_2(sc, car(args), cadr(args)));}
+
+static s7_pointer c_geq_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
+ {
+ if (type(x) == T_INTEGER)
+ return(make_boolean(sc, integer(x) >= integer(y)));
+ if (type(x) == T_REAL)
+ return(make_boolean(sc, real(x) >= real(y)));
+ if (type(x) == T_RATIO)
+ return(make_boolean(sc, fraction(x) >= fraction(y)));
+ }
+#endif
+
+ switch (type(x))
+ {
+ case T_INTEGER:
+ switch (type(y))
{
case T_INTEGER:
- if (is_null(p)) return(make_real(sc, rl_a * integer(x)));
- rl_a *= integer(x);
- goto MULTIPLY_REALS;
+ return(make_boolean(sc, integer(x) >= integer(y)));
case T_RATIO:
- if (is_null(p)) return(make_real(sc, rl_a * fraction(x)));
- rl_a *= (s7_double)fraction(x);
- goto MULTIPLY_REALS;
+ return(g_greater_or_equal(sc, set_plist_2(sc, x, y)));
case T_REAL:
- if (is_null(p)) return(make_real(sc, rl_a * real(x)));
- rl_a *= real(x);
- goto MULTIPLY_REALS;
-
- case T_COMPLEX:
- if (is_null(p)) return(s7_make_complex(sc, rl_a * real_part(x), rl_a * imag_part(x)));
- im_a = rl_a * imag_part(x);
- rl_a *= real_part(x);
- goto MULTIPLY_COMPLEX;
+ if (is_NaN(real(y))) return(sc->F);
+ return(make_boolean(sc, integer(x) >= real(y)));
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(sc, y, sc->geq_symbol, list_2(sc, x, y), T_REAL, 2);
}
break;
- case T_COMPLEX:
- rl_a = real_part(x);
- im_a = imag_part(x);
-
- MULTIPLY_COMPLEX:
- x = car(p);
- p = cdr(p);
+ case T_RATIO:
+ return(g_greater_or_equal(sc, set_plist_2(sc, x, y)));
- switch (type(x))
+ case T_REAL:
+ switch (type(y))
{
case T_INTEGER:
- if (is_null(p)) return(s7_make_complex(sc, rl_a * integer(x), im_a * integer(x)));
- rl_a *= integer(x);
- im_a *= integer(x);
- goto MULTIPLY_COMPLEX;
+ if (is_NaN(real(x))) return(sc->F);
+ return(make_boolean(sc, real(x) >= integer(y)));
case T_RATIO:
- {
- s7_double frac;
- frac = fraction(x);
- if (is_null(p)) return(s7_make_complex(sc, rl_a * frac, im_a * frac));
- rl_a *= frac;
- im_a *= frac;
- goto MULTIPLY_COMPLEX;
- }
+ if (is_NaN(real(x))) return(sc->F);
+ return(make_boolean(sc, real(x) >= fraction(y)));
case T_REAL:
- if (is_null(p)) return(s7_make_complex(sc, rl_a * real(x), im_a * real(x)));
- rl_a *= real(x);
- im_a *= real(x);
- goto MULTIPLY_COMPLEX;
-
- case T_COMPLEX:
- {
- s7_double r1, r2, i1, i2;
- r1 = rl_a;
- i1 = im_a;
- r2 = real_part(x);
- i2 = imag_part(x);
- if (is_null(p))
- return(s7_make_complex(sc, r1 * r2 - i1 * i2, r1 * i2 + r2 * i1));
- rl_a = r1 * r2 - i1 * i2;
- im_a = r1 * i2 + r2 * i1;
- if (im_a == 0.0)
- goto MULTIPLY_REALS;
- goto MULTIPLY_COMPLEX;
- }
+ if (is_NaN(real(x))) return(sc->F);
+ /* if (is_NaN(real(y))) return(sc->F); */
+ return(make_boolean(sc, real(x) >= real(y)));
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(sc, y, sc->geq_symbol, list_2(sc, x, y), T_REAL, 2);
}
break;
default:
- method_or_bust_with_type(sc, x, sc->multiply_symbol, args, a_number_string, 1);
+ method_or_bust(sc, x, sc->geq_symbol, list_2(sc, x, y), T_REAL, 1);
}
+ return(sc->T);
}
+static s7_pointer geq_p_pp(s7_pointer p1, s7_pointer p2) {return(c_geq_2(cur_sc, p1, p2));}
+
+#endif
+
+static s7_pointer geq_2 = NULL;
#if (!WITH_GMP)
-static s7_pointer multiply_2, multiply_fs, multiply_sf, multiply_is, multiply_si;
+static s7_pointer g_geq_2(s7_scheme *sc, s7_pointer args) {return(c_geq_2(sc, car(args), cadr(args)));}
-static s7_pointer g_multiply_2(s7_scheme *sc, s7_pointer args)
+static s7_pointer geq_s_fc;
+static s7_pointer g_geq_s_fc(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x, y;
+ s7_double y;
+ s7_pointer x;
+
x = car(args);
- y = cadr(args);
+ y = real(cadr(args));
- if (type(x) == type(y))
- {
- if (is_t_real(x))
- return(make_real(sc, real(x) * real(y)));
- else
- {
- switch (type(x))
- {
-#if HAVE_OVERFLOW_CHECKS
- case T_INTEGER:
- {
- s7_int n;
- if (multiply_overflow(integer(x), integer(y), &n))
- return(make_real(sc, ((s7_double)integer(x)) * ((s7_double)integer(y))));
- return(make_integer(sc, n));
- }
-#else
- case T_INTEGER: return(make_integer(sc, integer(x) * integer(y)));
-#endif
- case T_RATIO: return(g_multiply(sc, args));
- case T_REAL: return(make_real(sc, real(x) * real(y)));
- case T_COMPLEX:
- {
- s7_double r1, r2, i1, i2;
- r1 = real_part(x);
- r2 = real_part(y);
- i1 = imag_part(x);
- i2 = imag_part(y);
- return(s7_make_complex(sc, r1 * r2 - i1 * i2, r1 * i2 + r2 * i1));
- }
- default:
- if (!is_number(x))
- method_or_bust_with_type(sc, x, sc->multiply_symbol, args, a_number_string, 1);
- method_or_bust_with_type(sc, y, sc->multiply_symbol, args, a_number_string, 2);
- }
- }
- }
-
- switch (type(x))
- {
- case T_INTEGER:
- switch (type(y))
- {
- case T_INTEGER: return(make_integer(sc, integer(x) * integer(y)));
- case T_RATIO: return(g_multiply(sc, args));
- case T_REAL: return(make_real(sc, integer(x) * real(y)));
- case T_COMPLEX: return(s7_make_complex(sc, integer(x) * real_part(y), integer(x) * imag_part(y)));
- default:
- method_or_bust_with_type(sc, y, sc->multiply_symbol, args, a_number_string, 2);
- }
-
- case T_RATIO:
- switch (type(y))
- {
- case T_INTEGER:
- case T_RATIO: return(g_multiply(sc, args));
- case T_REAL: return(make_real(sc, fraction(x) * real(y)));
- case T_COMPLEX:
- {
- s7_double frac;
- frac = fraction(x);
- return(s7_make_complex(sc, frac * real_part(y), frac * imag_part(y)));
- }
- default:
- method_or_bust_with_type(sc, y, sc->multiply_symbol, args, a_number_string, 2);
- }
-
- case T_REAL:
- switch (type(y))
- {
- case T_INTEGER: return(make_real(sc, real(x) * integer(y)));
- case T_RATIO: return(make_real(sc, real(x) * fraction(y)));
- case T_REAL: return(make_real(sc, real(x) * real(y)));
- case T_COMPLEX: return(s7_make_complex(sc, real(x) * real_part(y), real(x) * imag_part(y)));
- default:
- method_or_bust_with_type(sc, y, sc->multiply_symbol, args, a_number_string, 2);
- }
-
- case T_COMPLEX:
- switch (type(y))
- {
- case T_INTEGER: return(s7_make_complex(sc, real_part(x) * integer(y), imag_part(x) * integer(y)));
- case T_RATIO:
- {
- s7_double frac;
- frac = fraction(y);
- return(s7_make_complex(sc, real_part(x) * frac, imag_part(x) * frac));
- }
- case T_REAL: return(s7_make_complex(sc, real_part(x) * real(y), imag_part(x) * real(y)));
- case T_COMPLEX:
- {
- s7_double r1, r2, i1, i2;
- r1 = real_part(x);
- r2 = real_part(y);
- i1 = imag_part(x);
- i2 = imag_part(y);
- return(s7_make_complex(sc, r1 * r2 - i1 * i2, r1 * i2 + r2 * i1));
- }
- default:
- method_or_bust_with_type(sc, y, sc->multiply_symbol, args, a_number_string, 2);
- }
-
- default:
- method_or_bust_with_type(sc, x, sc->multiply_symbol, args, a_number_string, 1);
- }
- return(x);
+ if (is_t_real(x))
+ return(make_boolean(sc, real(x) >= y));
+ return(g_geq_2(sc, args));
}
-/* all of these mess up if overflows occur
- * (let () (define (f x) (* x 9223372036854775806)) (f -63)) -> -9223372036854775682, but (* -63 9223372036854775806) -> -5.810724383218509e+20
- * how to catch this? (affects * - +)
- */
-
-static s7_pointer g_multiply_si(s7_scheme *sc, s7_pointer args)
+static s7_pointer geq_s_ic;
+static s7_pointer g_geq_s_ic(s7_scheme *sc, s7_pointer args)
{
+ s7_int y;
s7_pointer x;
- s7_int n;
- x = find_symbol_checked(sc, car(args));
- n = integer(cadr(args));
+ x = car(args);
+ y = s7_integer(cadr(args));
- switch (type(x))
- {
-#if HAVE_OVERFLOW_CHECKS
- case T_INTEGER:
- {
- s7_int val;
- if (multiply_overflow(integer(x), n, &val))
- return(make_real(sc, (double)integer(x) * (double)n));
- return(make_integer(sc, val));
- }
- case T_RATIO:
- {
- s7_int val;
- if (multiply_overflow(numerator(x), n, &val))
- return(make_real(sc, fraction(x) * (double)n));
- return(s7_make_ratio(sc, val, denominator(x)));
- }
-#else
- case T_INTEGER: return(make_integer(sc, integer(x) * n));
- case T_RATIO: return(s7_make_ratio(sc, numerator(x) * n, denominator(x)));
-#endif
- case T_REAL: return(make_real(sc, real(x) * n));
- case T_COMPLEX: return(s7_make_complex(sc, real_part(x) * n, imag_part(x) * n));
- default:
- method_or_bust_with_type(sc, x, sc->multiply_symbol, list_2(sc, x, cadr(args)), a_number_string, 1);
- }
- return(x);
+ if (type(x) == T_INTEGER)
+ return(make_boolean(sc, integer(x) >= y));
+ if (type(x) == T_REAL)
+ return(make_boolean(sc, real(x) >= y));
+ if (type(x) == T_RATIO)
+ return(make_boolean(sc, !ratio_lt_pi(x, y)));
+ method_or_bust(sc, x, sc->geq_symbol, args, T_REAL, 1);
}
-static s7_pointer g_multiply_is(s7_scheme *sc, s7_pointer args)
+static bool lt_b_pp(s7_pointer x, s7_pointer y)
{
- s7_pointer x;
- s7_int n;
-
- x = find_symbol_checked(sc, cadr(args));
- n = integer(car(args));
-
- switch (type(x))
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
{
-#if HAVE_OVERFLOW_CHECKS
- case T_INTEGER:
- {
- s7_int val;
- if (multiply_overflow(integer(x), n, &val))
- return(make_real(sc, (double)integer(x) * (double)n));
- return(make_integer(sc, val));
- }
- case T_RATIO:
- {
- s7_int val;
- if (multiply_overflow(numerator(x), n, &val))
- return(make_real(sc, fraction(x) * (double)n));
- return(s7_make_ratio(sc, val, denominator(x)));
- }
-#else
- case T_INTEGER: return(make_integer(sc, integer(x) * n));
- case T_RATIO: return(s7_make_ratio(sc, numerator(x) * n, denominator(x)));
-#endif
- case T_REAL: return(make_real(sc, real(x) * n));
- case T_COMPLEX: return(s7_make_complex(sc, real_part(x) * n, imag_part(x) * n));
- default:
- method_or_bust_with_type(sc, x, sc->multiply_symbol, list_2(sc, car(args), x), a_number_string, 2);
+ if (type(x) == T_INTEGER)
+ return(integer(x) < integer(y));
+ if (type(x) == T_REAL)
+ return(real(x) < real(y));
+ if (type(x) == T_RATIO)
+ return(fraction(x) < fraction(y));
}
- return(x);
+#endif
+ return(c_less_2(cur_sc, x, y) != cur_sc->F);
}
-static s7_pointer g_multiply_fs(s7_scheme *sc, s7_pointer args)
+static bool leq_b_pp(s7_pointer x, s7_pointer y)
{
- s7_pointer x;
- s7_double scl;
-
- scl = real(car(args));
- x = find_symbol_checked(sc, cadr(args));
-
- switch (type(x))
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
{
- case T_INTEGER: return(make_real(sc, integer(x) * scl));
- case T_RATIO: return(make_real(sc, numerator(x) * scl / denominator(x)));
- case T_REAL: return(make_real(sc, real(x) * scl));
- case T_COMPLEX: return(s7_make_complex(sc, real_part(x) * scl, imag_part(x) * scl));
- default:
- method_or_bust_with_type(sc, x, sc->multiply_symbol, list_2(sc, car(args), x), a_number_string, 1);
+ if (type(x) == T_INTEGER)
+ return(integer(x) <= integer(y));
+ if (type(x) == T_REAL)
+ return(real(x) <= real(y));
+ if (type(x) == T_RATIO)
+ return(fraction(x) <= fraction(y));
}
- return(x);
+#endif
+ return(c_leq_2(cur_sc, x, y) != cur_sc->F);
}
-static s7_pointer g_multiply_sf(s7_scheme *sc, s7_pointer args)
+static bool gt_b_pp(s7_pointer x, s7_pointer y)
{
- s7_pointer x;
- s7_double scl;
-
- scl = real(cadr(args));
- x = find_symbol_checked(sc, car(args));
-
- switch (type(x))
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
{
- case T_INTEGER: return(make_real(sc, integer(x) * scl));
- case T_RATIO: return(make_real(sc, numerator(x) * scl / denominator(x)));
- case T_REAL: return(make_real(sc, real(x) * scl));
- case T_COMPLEX: return(s7_make_complex(sc, real_part(x) * scl, imag_part(x) * scl));
- default:
- method_or_bust_with_type(sc, x, sc->multiply_symbol, list_2(sc, x, cadr(args)), a_number_string, 2);
+ if (type(x) == T_INTEGER)
+ return(integer(x) > integer(y));
+ if (type(x) == T_REAL)
+ return(real(x) > real(y));
+ if (type(x) == T_RATIO)
+ return(fraction(x) > fraction(y));
}
- return(x);
+#endif
+ return(c_greater_2(cur_sc, x, y) != cur_sc->F);
}
-static s7_pointer sqr_ss;
-static s7_pointer g_sqr_ss(s7_scheme *sc, s7_pointer args)
+static bool geq_b_pp(s7_pointer x, s7_pointer y)
{
- s7_pointer x;
- x = find_symbol_checked(sc, car(args));
-
- switch (type(x))
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
{
-#if HAVE_OVERFLOW_CHECKS
- case T_INTEGER:
- {
- s7_int val;
- if (multiply_overflow(integer(x), integer(x), &val))
- return(make_real(sc, (double)integer(x) * (double)integer(x)));
- return(make_integer(sc, val));
- }
- case T_RATIO:
- {
- s7_int num, den;
- if ((multiply_overflow(numerator(x), numerator(x), &num)) ||
- (multiply_overflow(denominator(x), denominator(x), &den)))
- return(make_real(sc, fraction(x) * fraction(x)));
- return(s7_make_ratio(sc, num, den));
- }
-#else
- case T_INTEGER: return(s7_make_integer(sc, integer(x) * integer(x)));
- case T_RATIO: return(s7_make_ratio(sc, numerator(x) * numerator(x), denominator(x) * denominator(x)));
-#endif
- case T_REAL: return(make_real(sc, real(x) * real(x)));
- case T_COMPLEX: return(s7_make_complex(sc, real_part(x) * real_part(x) - imag_part(x) * imag_part(x), 2.0 * real_part(x) * imag_part(x)));
- default:
- method_or_bust_with_type(sc, x, sc->multiply_symbol, list_2(sc, x, x), a_number_string, 1);
+ if (type(x) == T_INTEGER)
+ return(integer(x) >= integer(y));
+ if (type(x) == T_REAL)
+ return(real(x) >= real(y));
+ if (type(x) == T_RATIO)
+ return(fraction(x) >= fraction(y));
}
- return(x);
+#endif
+ return(c_geq_2(cur_sc, x, y) != cur_sc->F);
}
-static s7_pointer mul_1ss;
-static s7_pointer g_mul_1ss(s7_scheme *sc, s7_pointer args)
+static bool req_b_pp(s7_pointer x, s7_pointer y)
{
- /* (* (- 1.0 x) y) */
- s7_pointer x, y;
-
- x = find_symbol_checked(sc, caddr(car(args)));
- y = find_symbol_checked(sc, cadr(args));
-
- if ((is_t_real(x)) &&
- (is_t_real(y)))
- return(make_real(sc, real(y) * (1.0 - real(x))));
-
- if ((is_real(x)) &&
- (is_real(y)))
- {
- s7_double x1;
- x1 = real_to_double(sc, y, "*");
- return(make_real(sc, x1 * (1.0 - real_to_double(sc, x, "*"))));
- }
- else
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
{
- s7_double r1, r2, i1, i2;
- if (!is_number(x))
- {
- s7_pointer func;
- if ((func = find_method(sc, find_let(sc, x), sc->subtract_symbol)) != sc->undefined)
- return(g_multiply_2(sc, set_plist_2(sc, s7_apply_function(sc, func, list_2(sc, real_one, x)), y)));
- return(wrong_type_argument_with_type(sc, sc->subtract_symbol, 2, x, a_number_string));
- }
- if (!is_number(y))
- {
- s7_pointer func;
- if ((func = find_method(sc, find_let(sc, y), sc->multiply_symbol)) != sc->undefined)
- return(s7_apply_function(sc, func, list_2(sc, g_subtract(sc, list_2(sc, real_one, x)), y)));
- return(wrong_type_argument_with_type(sc, sc->multiply_symbol, 2, y, a_number_string));
- }
-
- r1 = 1.0 - s7_real_part(x);
- r2 = s7_real_part(y);
- i1 = -s7_imag_part(x);
- i2 = s7_imag_part(y);
- return(s7_make_complex(sc, r1 * r2 - i1 * i2, r1 * i2 + r2 * i1));
+ if (type(x) == T_INTEGER)
+ return(integer(x) == integer(y));
+ if (type(x) == T_REAL)
+ return(real(x) == real(y));
+ if (type(x) == T_RATIO)
+ return(fraction(x) == fraction(y));
}
+#endif
+ return(c_equal_2(cur_sc, x, y) != cur_sc->F);
}
-static s7_pointer multiply_cs_cos;
-static s7_pointer g_multiply_cs_cos(s7_scheme *sc, s7_pointer args)
-{
- /* ([*] -2.0 r (cos x)) */
- s7_pointer r, x;
-
- r = find_symbol_checked(sc, cadr(args));
- x = find_symbol_checked(sc, cadr(caddr(args)));
-
- if ((is_t_real(r)) &&
- (is_t_real(x)))
- return(make_real(sc, real(car(args)) * real(r) * cos(real(x))));
+static bool req_b_pi(s7_pointer i1, s7_int i2) {return(equal_b_pi(cur_sc, i1, i2));}
- if ((is_real(r)) &&
- (is_real(x)))
- return(make_real(sc, real(car(args)) * real_to_double(sc, r, "*") * cos(real_to_double(sc, x, "*"))));
- return(g_multiply(sc, set_plist_3(sc, car(args), r, g_cos(sc, set_plist_1(sc, x)))));
-}
-
-static s7_pointer mul_s_sin_s, mul_s_cos_s;
-static s7_pointer g_mul_s_sin_s(s7_scheme *sc, s7_pointer args)
+static bool lt_b_pi(s7_pointer p1, s7_int p2)
{
- /* (* s (sin s)) */
- s7_pointer x, y;
-
- x = find_symbol_checked(sc, car(args));
- y = find_symbol_checked(sc, cadadr(args));
-
- if ((is_real(x)) && (is_real(y)))
- return(make_real(sc, real_to_double(sc, x, "*") * sin(real_to_double(sc, y, "sin"))));
-
- return(g_multiply(sc, set_plist_2(sc, x, g_sin(sc, set_plist_1(sc, y)))));
+ if (is_integer(p1)) return(integer(p1) < p2);
+ if (is_t_real(p1)) return(real(p1) < p2);
+ if (is_t_ratio(p1)) return(ratio_lt_pi(p1, p2));
+ simple_wrong_type_argument(cur_sc, cur_sc->lt_symbol, p1, T_REAL);
+ return(false);
}
-static s7_pointer g_mul_s_cos_s(s7_scheme *sc, s7_pointer args)
-{
- /* (* s (cos s)) */
- s7_pointer x, y;
-
- x = find_symbol_checked(sc, car(args));
- y = find_symbol_checked(sc, cadadr(args));
-
- if ((is_real(x)) && (is_real(y)))
- return(make_real(sc, real_to_double(sc, x, "*") * cos(real_to_double(sc, y, "cos"))));
+static s7_pointer lt_p_pi(s7_pointer p1, s7_int p2) {return(make_boolean(cur_sc, lt_b_pi(p1, p2)));}
- return(g_multiply(sc, set_plist_2(sc, x, g_cos(sc, set_plist_1(sc, y)))));
+static bool leq_b_pi(s7_pointer p1, s7_int p2)
+{
+ if (is_integer(p1)) return(integer(p1) <= p2);
+ if (is_t_real(p1)) return(real(p1) <= p2);
+ if (is_t_ratio(p1)) return(ratio_leq_pi(p1, p2));
+ simple_wrong_type_argument(cur_sc, cur_sc->leq_symbol, p1, T_REAL);
+ return(false);
}
+static s7_pointer leq_p_pi(s7_pointer p1, s7_int p2) {return(make_boolean(cur_sc, leq_b_pi(p1, p2)));}
-static s7_double multiply_rf_xx(s7_scheme *sc, s7_pointer **p)
+static bool gt_b_pi(s7_pointer p1, s7_int p2)
{
- s7_rf_t r1, r2;
- s7_double x, y;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- r2 = (s7_rf_t)(**p); (*p)++;
- y = r2(sc, p);
- return(x * y);
+ if (is_integer(p1)) return(integer(p1) > p2);
+ if (is_t_real(p1)) return(real(p1) > p2);
+ if (is_t_ratio(p1)) return(!ratio_leq_pi(p1, p2));
+ simple_wrong_type_argument(cur_sc, cur_sc->gt_symbol, p1, T_REAL);
+ return(false);
}
-static s7_double multiply_rf_rx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer c1;
- s7_rf_t r1;
- s7_double x;
- c1 = **p; (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- return(x * real_to_double(sc, c1, "*"));
-}
+static s7_pointer gt_p_pi(s7_pointer p1, s7_int p2) {return(make_boolean(cur_sc, gt_b_pi(p1, p2)));}
-static s7_double multiply_rf_sx(s7_scheme *sc, s7_pointer **p)
+static bool geq_b_pi(s7_pointer p1, s7_int p2)
{
- s7_pointer s1;
- s7_rf_t r1;
- s7_double x;
- s1 = slot_value(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- return(x * real_to_double(sc, s1, "*"));
+ if (is_integer(p1)) return(integer(p1) >= p2);
+ if (is_t_real(p1)) return(real(p1) >= p2);
+ if (is_t_ratio(p1)) return(!ratio_lt_pi(p1, p2));
+ simple_wrong_type_argument(cur_sc, cur_sc->geq_symbol, p1, T_REAL);
+ return(false);
}
-static s7_double multiply_rf_ss(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1, s2;
- s7_double x1;
- s1 = slot_value(**p); (*p)++;
- x1 = real_to_double(sc, s1, "*");
- s2 = slot_value(**p); (*p)++;
- return(x1 * real_to_double(sc, s2, "*"));
-}
+static s7_pointer geq_p_pi(s7_pointer p1, s7_int p2) {return(make_boolean(cur_sc, geq_b_pi(p1, p2)));}
+#endif
+/* end (!WITH_GMP) */
-static s7_double multiply_rf_rs(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer c1, s1;
- s7_double x1;
- s1 = slot_value(**p); (*p)++;
- c1 = **p; (*p)++;
- x1 = real_to_double(sc, c1, "*");
- return(x1 * real_to_double(sc, s1, "*"));
-}
+static bool req_b_ii(s7_int i1, s7_int i2) {return(i1 == i2);}
+static bool lt_b_ii(s7_int i1, s7_int i2) {return(i1 < i2);}
+static bool leq_b_ii(s7_int i1, s7_int i2) {return(i1 <= i2);}
+static bool gt_b_ii(s7_int i1, s7_int i2) {return(i1 > i2);}
+static bool geq_b_ii(s7_int i1, s7_int i2) {return(i1 >= i2);}
+static bool req_b_dd(s7_double i1, s7_double i2) {return(i1 == i2);}
+static bool lt_b_dd(s7_double i1, s7_double i2) {return(i1 < i2);}
+static bool leq_b_dd(s7_double i1, s7_double i2) {return(i1 <= i2);}
+static bool gt_b_dd(s7_double i1, s7_double i2) {return(i1 > i2);}
+static bool geq_b_dd(s7_double i1, s7_double i2) {return(i1 >= i2);}
-static s7_double multiply_rf_xxx(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t r1, r2, r3;
- s7_double x, y, z;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- r2 = (s7_rf_t)(**p); (*p)++;
- y = r2(sc, p);
- r3 = (s7_rf_t)(**p); (*p)++;
- z = r3(sc, p);
- return(x * y * z);
-}
+/* ---------------------------------------- real-part imag-part ---------------------------------------- */
-static s7_double multiply_rf_rxx(s7_scheme *sc, s7_pointer **p)
+s7_double s7_real_part(s7_pointer x)
{
- s7_pointer c1;
- s7_rf_t r1, r2;
- s7_double x, y;
- c1 = **p; (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- r2 = (s7_rf_t)(**p); (*p)++;
- y = r2(sc, p);
- return(x * y * real_to_double(sc, c1, "*"));
+ switch(type(x))
+ {
+ case T_INTEGER: return((s7_double)integer(x));
+ case T_RATIO: return(fraction(x));
+ case T_REAL: return(real(x));
+ case T_COMPLEX: return(real_part(x));
+#if WITH_GMP
+ case T_BIG_INTEGER: return((s7_double)big_integer_to_s7_int(big_integer(x)));
+ case T_BIG_RATIO: return((s7_double)((long double)big_integer_to_s7_int(mpq_numref(big_ratio(x))) / (long double)big_integer_to_s7_int(mpq_denref(big_ratio(x)))));
+ case T_BIG_REAL: return((s7_double)mpfr_get_d(big_real(x), GMP_RNDN));
+ case T_BIG_COMPLEX: return((s7_double)mpfr_get_d(mpc_realref(big_complex(x)), GMP_RNDN));
+#endif
+ }
+ return(0.0);
}
-static s7_double multiply_rf_sxx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1;
- s7_rf_t r1, r2;
- s7_double x, y;
- s1 = slot_value(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- r2 = (s7_rf_t)(**p); (*p)++;
- y = r2(sc, p);
- return(x * y * real_to_double(sc, s1, "*"));
-}
-static s7_double multiply_rf_rsx(s7_scheme *sc, s7_pointer **p)
+s7_double s7_imag_part(s7_pointer x)
{
- s7_pointer c1, s1;
- s7_rf_t r1;
- s7_double x, x1;
- s1 = slot_value(**p); (*p)++;
- c1 = **p; (*p)++;
- x1 = real_to_double(sc, c1, "*");
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- return(x * x1 * real_to_double(sc, s1, "*"));
+ switch (type(x))
+ {
+ case T_COMPLEX: return(imag_part(x));
+#if WITH_GMP
+ case T_BIG_COMPLEX: return((s7_double)mpfr_get_d(mpc_imagref(big_complex(x)), GMP_RNDN));
+#endif
+ }
+ return(0.0);
}
-static s7_double multiply_rf_ssx(s7_scheme *sc, s7_pointer **p)
+static s7_pointer g_real_part(s7_scheme *sc, s7_pointer args)
{
- s7_pointer s1, s2;
- s7_rf_t r1;
- s7_double x, x1;
- s1 = slot_value(**p); (*p)++;
- x1 = real_to_double(sc, s1, "*");
- s2 = slot_value(**p); (*p)++;
- r1 = (s7_rf_t)(**p); (*p)++;
- x = r1(sc, p);
- return(x * x1 * real_to_double(sc, s2, "*"));
-}
+ #define H_real_part "(real-part num) returns the real part of num"
+ #define Q_real_part s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_number_symbol)
-static s7_double multiply_rf_sss(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1, s2, s3;
- s7_double x1, x2, x3;
- s1 = slot_value(**p); (*p)++;
- x1 = real_to_double(sc, s1, "*");
- s2 = slot_value(**p); (*p)++;
- x2 = real_to_double(sc, s2, "*");
- s3 = slot_value(**p); (*p)++;
- x3 = real_to_double(sc, s3, "*");
- return(x1 * x2 * x3);
-}
+ s7_pointer p;
+ p = car(args);
+ switch (type(p))
+ {
+ case T_INTEGER:
+ case T_RATIO:
+ case T_REAL:
+ return(p);
-static s7_double multiply_rf_rss(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer c1, s1, s2;
- s7_double x1, x2, x3;
- s1 = slot_value(**p); (*p)++;
- x1 = real_to_double(sc, s1, "*");
- s2 = slot_value(**p); (*p)++;
- x2 = real_to_double(sc, s2, "*");
- c1 = **p; (*p)++;
- x3 = real_to_double(sc, c1, "*");
- return(x1 * x2 * x3);
-}
+ case T_COMPLEX:
+ return(make_real(sc, real_part(p)));
-static s7_rf_t multiply_rf_1(s7_scheme *sc, s7_pointer expr, int len)
-{
- if (len == 3)
- return(com_rf_2(sc, expr, multiply_r_ops));
- if (len == 4)
- return(com_rf_3(sc, expr, multiply_r_ops));
+#if WITH_GMP
+ case T_BIG_INTEGER:
+ case T_BIG_RATIO:
+ case T_BIG_REAL:
+ return(p);
- if (len > 4)
- {
- s7_rf_t rf;
- ptr_int loc;
- xf_t *rc;
- int first_len;
+ case T_BIG_COMPLEX:
+ {
+ s7_pointer x;
- xf_init(2);
- first_len = (int)(len / 2);
- xf_save_loc(loc);
- rf = multiply_rf_1(sc, expr, first_len + 1);
- if (rf)
- {
- int i;
- s7_pointer p;
- xf_store_at(loc, (s7_pointer)rf);
- xf_save_loc(loc);
- for (i = 0, p = expr; i < first_len; i++, p = cdr(p));
- rf = multiply_rf_1(sc, p, len - first_len);
- if (rf)
- {
- xf_store_at(loc, (s7_pointer)rf);
- return(multiply_rf_xx);
- }
- else return(NULL);
- }
- else return(NULL);
+ new_cell(sc, x, T_BIG_REAL);
+ add_bigreal(sc, x);
+ mpfr_init(big_real(x));
+ mpc_real(big_real(x), big_complex(p), GMP_RNDN);
+
+ return(x);
+ }
+#endif
+
+ default:
+ method_or_bust_with_type_one_arg(sc, p, sc->real_part_symbol, args, a_number_string);
}
- return(NULL);
}
-static s7_rf_t multiply_rf(s7_scheme *sc, s7_pointer expr)
+
+static s7_pointer g_imag_part(s7_scheme *sc, s7_pointer args)
{
- return(multiply_rf_1(sc, expr, s7_list_length(sc, expr)));
-}
+ #define H_imag_part "(imag-part num) returns the imaginary part of num"
+ #define Q_imag_part s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_number_symbol)
+ s7_pointer p;
+ /* currently (imag-part nan.0) -> 0.0 ? it's true but maybe confusing */
+ p = car(args);
+ switch (type(p))
+ {
+ case T_INTEGER:
+ case T_RATIO:
+ return(small_int(0));
-static s7_int multiply_if_xx(s7_scheme *sc, s7_pointer **p)
-{
- s7_if_t r1, r2;
- s7_int x, y;
- r1 = (s7_if_t)(**p); (*p)++;
- x = r1(sc, p);
- r2 = (s7_if_t)(**p); (*p)++;
- y = r2(sc, p);
- return(x * y);
-}
+ case T_REAL:
+ return(real_zero);
-static s7_int multiply_if_rx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer c1;
- s7_if_t r1;
- s7_int x;
- c1 = **p; (*p)++;
- r1 = (s7_if_t)(**p); (*p)++;
- x = r1(sc, p);
- return(x * integer(c1));
-}
+ case T_COMPLEX:
+ return(make_real(sc, imag_part(p)));
-static s7_int multiply_if_sx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1;
- s7_if_t r1;
- s7_int x;
- s1 = slot_value(**p); (*p)++;
- r1 = (s7_if_t)(**p); (*p)++;
- x = r1(sc, p);
- return(x * integer(s1));
-}
+#if WITH_GMP
+ case T_BIG_INTEGER:
+ case T_BIG_RATIO:
+ return(small_int(0));
-static s7_int multiply_if_ss(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1, s2;
- s1 = slot_value(**p); (*p)++;
- s2 = slot_value(**p); (*p)++;
- return(integer(s1) * integer(s2));
-}
+ case T_BIG_REAL:
+ return(real_zero);
-static s7_int multiply_if_rs(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer c1, s1;
- s1 = slot_value(**p); (*p)++;
- c1 = **p; (*p)++;
- return(integer(c1) * integer(s1));
-}
+ case T_BIG_COMPLEX:
+ {
+ s7_pointer x;
+ new_cell(sc, x, T_BIG_REAL);
+ add_bigreal(sc, x);
+ mpfr_init(big_real(x));
+ mpc_imag(big_real(x), big_complex(p), GMP_RNDN);
+ return(x);
+ }
+#endif
-static s7_int multiply_if_xxx(s7_scheme *sc, s7_pointer **p)
-{
- s7_if_t r1, r2, r3;
- s7_int x, y, z;
- r1 = (s7_if_t)(**p); (*p)++;
- x = r1(sc, p);
- r2 = (s7_if_t)(**p); (*p)++;
- y = r2(sc, p);
- r3 = (s7_if_t)(**p); (*p)++;
- z = r3(sc, p);
- return(x * y * z);
+ default:
+ method_or_bust_with_type_one_arg(sc, p, sc->imag_part_symbol, args, a_number_string);
+ }
}
-static s7_int multiply_if_rxx(s7_scheme *sc, s7_pointer **p)
+#if (!WITH_GMP)
+static s7_double real_part_d_p(s7_pointer p)
{
- s7_pointer c1;
- s7_if_t r1, r2;
- s7_int x, y;
- c1 = **p; (*p)++;
- r1 = (s7_if_t)(**p); (*p)++;
- x = r1(sc, p);
- r2 = (s7_if_t)(**p); (*p)++;
- y = r2(sc, p);
- return(x * y * integer(c1));
+ if (!is_number(p))
+ simple_wrong_type_argument_with_type(cur_sc, cur_sc->real_part_symbol, p, a_number_string);
+ return(s7_real_part(p));
}
-static s7_int multiply_if_sxx(s7_scheme *sc, s7_pointer **p)
+static s7_double imag_part_d_p(s7_pointer p)
{
- s7_pointer s1;
- s7_if_t r1, r2;
- s7_int x, y;
- s1 = slot_value(**p); (*p)++;
- r1 = (s7_if_t)(**p); (*p)++;
- x = r1(sc, p);
- r2 = (s7_if_t)(**p); (*p)++;
- y = r2(sc, p);
- return(x * y * integer(s1));
+ if (!is_number(p))
+ simple_wrong_type_argument_with_type(cur_sc, cur_sc->imag_part_symbol, p, a_number_string);
+ return(s7_imag_part(p));
}
+#endif
-static s7_int multiply_if_rsx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer c1, s1;
- s7_if_t r1;
- s7_int x;
- s1 = slot_value(**p); (*p)++;
- c1 = **p; (*p)++;
- r1 = (s7_if_t)(**p); (*p)++;
- x = r1(sc, p);
- return(x * integer(c1) * integer(s1));
-}
-static s7_int multiply_if_ssx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1, s2;
- s7_if_t r1;
- s7_int x;
- s1 = slot_value(**p); (*p)++;
- s2 = slot_value(**p); (*p)++;
- r1 = (s7_if_t)(**p); (*p)++;
- x = r1(sc, p);
- return(x * integer(s1) * integer(s2));
-}
+/* ---------------------------------------- numerator denominator ---------------------------------------- */
-static s7_int multiply_if_sss(s7_scheme *sc, s7_pointer **p)
+static s7_pointer g_numerator(s7_scheme *sc, s7_pointer args)
{
- s7_pointer s1, s2, s3;
- s1 = slot_value(**p); (*p)++;
- s2 = slot_value(**p); (*p)++;
- s3 = slot_value(**p); (*p)++;
- return(integer(s1) * integer(s2) * integer(s3));
+ #define H_numerator "(numerator rat) returns the numerator of the rational number rat"
+ #define Q_numerator s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_rational_symbol)
+
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_RATIO: return(make_integer(sc, numerator(x)));
+ case T_INTEGER: return(x);
+#if WITH_GMP
+ case T_BIG_INTEGER: return(x);
+ case T_BIG_RATIO: return(mpz_to_big_integer(sc, mpq_numref(big_ratio(x))));
+#endif
+ default: method_or_bust_with_type_one_arg(sc, x, sc->numerator_symbol, args, a_rational_string);
+ }
}
-static s7_int multiply_if_rss(s7_scheme *sc, s7_pointer **p)
+static s7_int numerator_i(s7_pointer p)
{
- s7_pointer c1, s1, s2;
- s1 = slot_value(**p); (*p)++;
- s2 = slot_value(**p); (*p)++;
- c1 = **p; (*p)++;
- return(integer(c1) * integer(s1) * integer(s2));
+ if (!is_rational(p))
+ simple_wrong_type_argument(cur_sc, cur_sc->numerator_symbol, p, T_RATIO);
+ return(numerator(p));
}
-static s7_if_t multiply_if_1(s7_scheme *sc, s7_pointer expr, int len)
+static s7_pointer g_denominator(s7_scheme *sc, s7_pointer args)
{
- if (len == 3)
- return(com_if_2(sc, expr, multiply_i_ops));
- if (len == 4)
- return(com_if_3(sc, expr, multiply_i_ops));
+ #define H_denominator "(denominator rat) returns the denominator of the rational number rat"
+ #define Q_denominator s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_rational_symbol)
- if (len > 4)
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
{
- s7_if_t xf;
- xf_t *rc;
- ptr_int loc;
- int first_len;
-
- xf_init(2);
- first_len = (int)(len / 2);
- xf_save_loc(loc);
- xf = multiply_if_1(sc, expr, first_len + 1);
- if (xf)
- {
- int i;
- s7_pointer p;
- xf_store_at(loc, (s7_pointer)xf);
- xf_save_loc(loc);
- for (i = 0, p = expr; i < first_len; i++, p = cdr(p));
- xf = multiply_if_1(sc, p, len - first_len);
- if (xf)
- {
- xf_store_at(loc, (s7_pointer)xf);
- return(multiply_if_xx);
- }
- else return(NULL);
- }
- else return(NULL);
+ case T_RATIO: return(make_integer(sc, denominator(x)));
+ case T_INTEGER: return(small_int(1));
+#if WITH_GMP
+ case T_BIG_INTEGER: return(small_int(1));
+ case T_BIG_RATIO: return(mpz_to_big_integer(sc, mpq_denref(big_ratio(x))));
+#endif
+ default: method_or_bust_with_type_one_arg(sc, x, sc->denominator_symbol, args, a_rational_string);
}
- return(NULL);
}
-static s7_if_t multiply_if(s7_scheme *sc, s7_pointer expr)
+static s7_int denominator_i(s7_pointer p)
{
- return(multiply_if_1(sc, expr, s7_list_length(sc, expr)));
+ if (!is_rational(p))
+ simple_wrong_type_argument(cur_sc, cur_sc->denominator_symbol, p, T_RATIO);
+ if (is_integer(p))
+ return(1);
+ return(denominator(p));
}
-static void init_multiply_ops(void)
+/* ---------------------------------------- nan? infinite? ---------------------------------------- */
+
+static s7_pointer g_is_nan(s7_scheme *sc, s7_pointer args)
{
- multiply_r_ops = (rf_ops *)calloc(1, sizeof(rf_ops));
- multiply_r_ops->r = rf_c;
- multiply_r_ops->s = rf_s;
+ #define H_is_nan "(nan? obj) returns #t if obj is a NaN"
+ #define Q_is_nan pl_bn
- multiply_r_ops->rs = multiply_rf_rs;
- multiply_r_ops->rp = multiply_rf_rx;
- multiply_r_ops->sp = multiply_rf_sx;
- multiply_r_ops->ss = multiply_rf_ss;
- multiply_r_ops->pp = multiply_rf_xx;
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ case T_RATIO:
+ return(sc->F);
- multiply_r_ops->rss = multiply_rf_rss;
- multiply_r_ops->rsp = multiply_rf_rsx;
- multiply_r_ops->rpp = multiply_rf_rxx;
- multiply_r_ops->sss = multiply_rf_sss;
- multiply_r_ops->ssp = multiply_rf_ssx;
- multiply_r_ops->spp = multiply_rf_sxx;
- multiply_r_ops->ppp = multiply_rf_xxx;
+ case T_REAL:
+ return(make_boolean(sc, is_NaN(real(x))));
- multiply_i_ops = (if_ops *)calloc(1, sizeof(if_ops));
- multiply_i_ops->r = if_c;
- multiply_i_ops->s = if_s;
+ case T_COMPLEX:
+ return(make_boolean(sc, (is_NaN(real_part(x))) || (is_NaN(imag_part(x)))));
- multiply_i_ops->rs = multiply_if_rs;
- multiply_i_ops->rp = multiply_if_rx;
- multiply_i_ops->sp = multiply_if_sx;
- multiply_i_ops->ss = multiply_if_ss;
- multiply_i_ops->pp = multiply_if_xx;
+#if WITH_GMP
+ case T_BIG_INTEGER:
+ case T_BIG_RATIO:
+ return(sc->F);
- multiply_i_ops->rss = multiply_if_rss;
- multiply_i_ops->rsp = multiply_if_rsx;
- multiply_i_ops->rpp = multiply_if_rxx;
- multiply_i_ops->sss = multiply_if_sss;
- multiply_i_ops->ssp = multiply_if_ssx;
- multiply_i_ops->spp = multiply_if_sxx;
- multiply_i_ops->ppp = multiply_if_xxx;
-}
+ case T_BIG_REAL:
+ return(make_boolean(sc, is_NaN(s7_real_part(x))));
-#if WITH_ADD_PF
-static s7_pointer c_mul_pf2(s7_scheme *sc, s7_pointer **p)
-{
- s7_pf_t pf;
- s7_pointer x, y;
- pf = (s7_pf_t)(**p); (*p)++;
- x = pf(sc, p);
- xf_push(sc, x);
- pf = (s7_pf_t)(**p); (*p)++;
- y = pf(sc, p);
- x = g_multiply_2(sc, set_plist_2(sc, x, y));
- xf_pop(sc);
- return(x);
-}
+ case T_BIG_COMPLEX:
+ return(make_boolean(sc, (is_NaN(s7_real_part(x))) || (is_NaN(s7_imag_part(x)))));
+#endif
-static s7_pf_t multiply_pf(s7_scheme *sc, s7_pointer expr)
-{
- int len;
- len = s7_list_length(sc, expr);
- if (len == 3)
- {
- if ((s7_arg_to_pf(sc, cadr(expr))) &&
- (s7_arg_to_pf(sc, caddr(expr))))
- return(c_mul_pf2);
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->is_nan_symbol, list_1(sc, x), a_number_string);
}
- return(NULL);
}
-#endif
-
-#endif /* with-gmp */
+static bool is_nan_b(s7_pointer p) {return(g_is_nan(cur_sc, set_plist_1(cur_sc, p)) != cur_sc->F);}
-/* ---------------------------------------- divide ---------------------------------------- */
-
-static bool is_number_via_method(s7_scheme *sc, s7_pointer p)
-{
- if (s7_is_number(p))
- return(true);
- if (has_methods(p))
- {
- s7_pointer f;
- f = find_method(sc, find_let(sc, p), sc->is_number_symbol);
- if (f != sc->undefined)
- return(is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->nil))));
- }
- return(false);
-}
-
-static s7_pointer g_divide(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_is_infinite(s7_scheme *sc, s7_pointer args)
{
- #define H_divide "(/ x1 ...) divides its first argument by the rest, or inverts the first if there is only one argument"
- #define Q_divide pcl_n
-
- s7_pointer x, p;
- s7_int num_a, den_a;
- s7_double rl_a, im_a;
+ #define H_is_infinite "(infinite? obj) returns #t if obj is an infinite real"
+ #define Q_is_infinite pl_bn
+ s7_pointer x;
x = car(args);
- p = cdr(args);
- if (is_null(p))
- {
- if (!is_number(x))
- method_or_bust_with_type(sc, x, sc->divide_symbol, args, a_number_string, 0);
- if (s7_is_zero(x))
- return(division_by_zero_error(sc, sc->divide_symbol, args));
- return(s7_invert(sc, x));
- }
-
switch (type(x))
{
case T_INTEGER:
- num_a = integer(x);
- if (num_a == 0)
- {
- bool return_nan = false, return_real_zero = false;
- for (; is_pair(p); p = cdr(p))
- {
- s7_pointer n;
- n = car(p);
- if (!s7_is_number(n))
- {
- n = check_values(sc, n, p);
- if (!s7_is_number(n))
- return(wrong_type_argument_with_type(sc, sc->divide_symbol, position_of(p, args), n, a_number_string));
- }
- if (s7_is_zero(n))
- return(division_by_zero_error(sc, sc->divide_symbol, args));
- if (type(n) > T_RATIO)
- {
- return_real_zero = true;
- if (is_NaN(s7_real_part(n)))
- return_nan = true;
- }
- }
- if (return_nan)
- return(real_NaN);
- if (return_real_zero)
- return(real_zero);
- return(small_int(0));
- }
-
- DIVIDE_INTEGERS:
-#if WITH_GMP
- if ((num_a > s7_int32_max) ||
- (num_a < s7_int32_min))
- return(big_divide(sc, cons(sc, s7_int_to_big_integer(sc, num_a), p)));
-#endif
- x = car(p);
- p = cdr(p);
-
- switch (type(x))
- {
- case T_INTEGER:
- if (integer(x) == 0)
- return(division_by_zero_error(sc, sc->divide_symbol, args));
-
- /* to be consistent, I suppose we should search first for NaNs in the divisor list.
- * (* 0 0/0) is NaN, so (/ 1 0 0/0) should equal (/ 1 0/0) = NaN. But the whole
- * thing is ridiculous.
- */
- if (is_null(p))
- return(s7_make_ratio(sc, num_a, integer(x)));
-
- den_a = integer(x);
- if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
- goto DIVIDE_INTEGERS;
- goto DIVIDE_RATIOS;
-
- case T_RATIO:
- den_a = denominator(x);
-#if HAVE_OVERFLOW_CHECKS
- {
- s7_int dn;
- if (multiply_overflow(num_a, den_a, &dn))
- {
- if (is_null(p)) return(make_real(sc, num_a * inverted_fraction(x)));
- rl_a = (s7_double)num_a * inverted_fraction(x);
- goto DIVIDE_REALS;
- }
- num_a = dn;
- }
-#else
- if ((integer_length(num_a) + integer_length(den_a)) > s7_int_bits)
- {
- if (is_null(p)) return(make_real(sc, num_a * inverted_fraction(x)));
- rl_a = (s7_double)num_a * inverted_fraction(x);
- goto DIVIDE_REALS;
- }
- num_a *= den_a;
-#endif
- den_a = numerator(x);
- if (is_null(p)) return(s7_make_ratio(sc, num_a, den_a));
- if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
- goto DIVIDE_INTEGERS;
- goto DIVIDE_RATIOS;
-
- case T_REAL:
- rl_a = (s7_double)num_a;
- if (real(x) == 0.0)
- return(division_by_zero_error(sc, sc->divide_symbol, args));
- if (is_null(p)) return(make_real(sc, rl_a / real(x)));
- rl_a /= real(x);
- goto DIVIDE_REALS;
+ case T_RATIO:
+ return(sc->F);
- case T_COMPLEX:
- {
- s7_double i2, r2, den;
- rl_a = (s7_double)num_a;
- r2 = real_part(x);
- i2 = imag_part(x);
- den = 1.0 / (r2 * r2 + i2 * i2);
- /* we could avoid the squaring (see Knuth II p613 16)
- * not a big deal: (/ 1.0e308+1.0e308i 2.0e308+2.0e308i) => nan
- * (gmp case is ok here)
- */
- if (is_null(p))
- return(s7_make_complex(sc, rl_a * r2 * den, -(rl_a * i2 * den)));
- im_a = -rl_a * i2 * den;
- rl_a *= r2 * den;
- goto DIVIDE_COMPLEX;
- }
+ case T_REAL:
+ return(make_boolean(sc, is_inf(real(x))));
- 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);
- }
- break;
+ case T_COMPLEX:
+ return(make_boolean(sc, (is_inf(real_part(x))) || (is_inf(imag_part(x)))));
- case T_RATIO:
- num_a = numerator(x);
- den_a = denominator(x);
- DIVIDE_RATIOS:
#if WITH_GMP
- if ((num_a > s7_int32_max) ||
- (den_a > s7_int32_max) ||
- (num_a < s7_int32_min))
- return(big_divide(sc, cons(sc, s7_ratio_to_big_ratio(sc, num_a, den_a), p)));
-#endif
- x = car(p);
- p = cdr(p);
+ case T_BIG_INTEGER:
+ case T_BIG_RATIO:
+ return(sc->F);
- switch (type(x))
- {
- case T_INTEGER:
- if (integer(x) == 0)
- return(division_by_zero_error(sc, sc->divide_symbol, args));
-#if HAVE_OVERFLOW_CHECKS
- {
- s7_int dn;
- if (multiply_overflow(den_a, integer(x), &dn))
- {
- if (is_null(p)) return(make_real(sc, (long double)num_a / ((long double)den_a * (s7_double)integer(x))));
- rl_a = (long double)num_a / ((long double)den_a * (s7_double)integer(x));
- goto DIVIDE_REALS;
- }
- den_a = dn;
- }
-#else
- if ((integer_length(integer(x)) + integer_length(den_a)) > s7_int_bits)
- {
- if (is_null(p)) return(make_real(sc, (long double)num_a / ((long double)den_a * (s7_double)integer(x))));
- rl_a = (long double)num_a / ((long double)den_a * (s7_double)integer(x));
- goto DIVIDE_REALS;
- }
- den_a *= integer(x);
-#endif
- if (is_null(p)) return(s7_make_ratio(sc, num_a, den_a));
- if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
- goto DIVIDE_INTEGERS;
- goto DIVIDE_RATIOS;
+ case T_BIG_REAL:
+ return(make_boolean(sc, mpfr_inf_p(big_real(x)) != 0));
- case T_RATIO:
- {
- s7_int d1, d2, n1, n2;
- d1 = den_a;
- n1 = num_a;
- d2 = denominator(x);
- n2 = numerator(x);
- if (d1 == d2)
- {
- if (is_null(p))
- return(s7_make_ratio(sc, n1, n2));
- den_a = n2;
- }
- else
- {
-#if (!WITH_GMP)
-#if HAVE_OVERFLOW_CHECKS
- if ((multiply_overflow(n1, d2, &n1)) ||
- (multiply_overflow(n2, d1, &d1)))
- {
- s7_double r1, r2;
- r1 = ((long double)num_a / (long double)den_a);
- r2 = inverted_fraction(x);
- if (is_null(p)) return(make_real(sc, r1 * r2));
- rl_a = r1 * r2;
- goto DIVIDE_REALS;
- }
- num_a = n1;
- den_a = d1;
-#else
- if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
- (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
- (n1 < s7_int32_min) || (n2 < s7_int32_min))
- {
- if ((integer_length(d1) + integer_length(n2) > s7_int_bits) ||
- (integer_length(d2) + integer_length(n1) > s7_int_bits))
- {
- s7_double r1, r2;
- r1 = ((long double)num_a / (long double)den_a);
- r2 = inverted_fraction(x);
- if (is_null(p)) return(make_real(sc, r1 * r2));
- rl_a = r1 * r2;
- goto DIVIDE_REALS;
- }
- }
- num_a *= d2;
- den_a *= n2;
-#endif
-#else
- num_a *= d2;
- den_a *= n2;
+ case T_BIG_COMPLEX:
+ return(make_boolean(sc,
+ (mpfr_inf_p(big_real(g_real_part(sc, list_1(sc, x)))) != 0) ||
+ (mpfr_inf_p(big_real(g_imag_part(sc, list_1(sc, x)))) != 0)));
#endif
- if (is_null(p))
- return(s7_make_ratio(sc, num_a, den_a));
- }
- if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
- goto DIVIDE_INTEGERS;
- goto DIVIDE_RATIOS;
- }
-
- case T_REAL:
- {
- s7_double r1;
- if (real(x) == 0.0)
- return(division_by_zero_error(sc, sc->divide_symbol, args));
- r1 = ((long double)num_a / (long double)den_a);
- if (is_null(p)) return(make_real(sc, r1 / real(x)));
- rl_a = r1 / real(x);
- goto DIVIDE_REALS;
- }
-
- case T_COMPLEX:
- {
- s7_double den, i2, r2;
- rl_a = ((long double)num_a / (long double)den_a);
- r2 = real_part(x);
- i2 = imag_part(x);
- den = 1.0 / (r2 * r2 + i2 * i2);
- if (is_null(p))
- return(s7_make_complex(sc, rl_a * r2 * den, -rl_a * i2 * den));
- im_a = -rl_a * i2 * den;
- rl_a *= r2 * den;
- goto DIVIDE_COMPLEX;
- }
-
- 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);
- }
- break;
-
- case T_REAL:
- rl_a = real(x);
- if (rl_a == 0)
- {
- bool return_nan = false;
- for (; is_pair(p); p = cdr(p))
- {
- s7_pointer n;
- n = car(p);
- if (!s7_is_number(n))
- {
- n = check_values(sc, n, p);
- if (!s7_is_number(n))
- return(wrong_type_argument_with_type(sc, sc->divide_symbol, position_of(p, args), n, a_number_string));
- }
- if (s7_is_zero(n))
- return(division_by_zero_error(sc, sc->divide_symbol, args));
- if ((is_t_real(n)) &&
- (is_NaN(real(n))))
- return_nan = true;
- }
- if (return_nan)
- return(real_NaN);
- return(real_zero);
- }
-
- DIVIDE_REALS:
- x = car(p);
- p = cdr(p);
- switch (type(x))
- {
- case T_INTEGER:
- if (integer(x) == 0)
- return(division_by_zero_error(sc, sc->divide_symbol, args));
- if (is_null(p)) return(make_real(sc, rl_a / integer(x)));
- rl_a /= (s7_double)integer(x);
- goto DIVIDE_REALS;
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->is_infinite_symbol, list_1(sc, x), a_number_string);
+ }
+}
- case T_RATIO:
- if (is_null(p)) return(make_real(sc, rl_a * inverted_fraction(x)));
- rl_a *= (s7_double)inverted_fraction(x);
- goto DIVIDE_REALS;
+static bool is_infinite_b(s7_pointer p) {return(g_is_infinite(cur_sc, set_plist_1(cur_sc, p)) != cur_sc->F);}
- case T_REAL:
- if (real(x) == 0.0)
- return(division_by_zero_error(sc, sc->divide_symbol, args));
- if (is_null(p)) return(make_real(sc, rl_a / real(x)));
- rl_a /= real(x);
- goto DIVIDE_REALS;
- case T_COMPLEX:
- {
- s7_double den, r2, i2;
- r2 = real_part(x);
- i2 = imag_part(x);
- den = 1.0 / (r2 * r2 + i2 * i2);
- if (is_null(p))
- return(s7_make_complex(sc, rl_a * r2 * den, -rl_a * i2 * den));
- im_a = -rl_a * i2 * den;
- rl_a *= r2 * den;
- goto DIVIDE_COMPLEX;
- }
+/* ---------------------------------------- number? complex? integer? rational? real? ---------------------------------------- */
- 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);
- }
- break;
+static s7_pointer g_is_number(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_number "(number? obj) returns #t if obj is a number"
+ #define Q_is_number pl_bt
+ check_boolean_method(sc, s7_is_number, sc->is_number_symbol, args); /* we need the s7_* versions here for the GMP case */
+}
- case T_COMPLEX:
- rl_a = real_part(x);
- im_a = imag_part(x);
- DIVIDE_COMPLEX:
- x = car(p);
- p = cdr(p);
+static s7_pointer g_is_integer(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_integer "(integer? obj) returns #t if obj is an integer"
+ #define Q_is_integer pl_bt
+ check_boolean_method(sc, s7_is_integer, sc->is_integer_symbol, args);
+}
- switch (type(x))
- {
- case T_INTEGER:
- {
- s7_double r1;
- if (integer(x) == 0)
- return(division_by_zero_error(sc, sc->divide_symbol, args));
- r1 = 1.0 / (s7_double)integer(x);
- if (is_null(p)) return(s7_make_complex(sc, rl_a * r1, im_a * r1));
- rl_a *= r1;
- im_a *= r1;
- goto DIVIDE_COMPLEX;
- }
- case T_RATIO:
- {
- s7_double frac;
- frac = inverted_fraction(x);
- if (is_null(p)) return(s7_make_complex(sc, rl_a * frac, im_a * frac));
- rl_a *= frac;
- im_a *= frac;
- goto DIVIDE_COMPLEX;
- }
+static s7_pointer g_is_real(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_real "(real? obj) returns #t if obj is a real number"
+ #define Q_is_real pl_bt
+ check_boolean_method(sc, s7_is_real, sc->is_real_symbol, args);
+}
- case T_REAL:
- {
- s7_double r1;
- if (real(x) == 0.0)
- return(division_by_zero_error(sc, sc->divide_symbol, args));
- r1 = 1.0 / real(x);
- if (is_null(p)) return(s7_make_complex(sc, rl_a * r1, im_a * r1));
- rl_a *= r1;
- im_a *= r1;
- goto DIVIDE_COMPLEX;
- }
- case T_COMPLEX:
- {
- s7_double r1, r2, i1, i2, den;
- r1 = rl_a;
- i1 = im_a;
- r2 = real_part(x);
- i2 = imag_part(x);
- den = 1.0 / (r2 * r2 + i2 * i2);
- if (is_null(p))
- return(s7_make_complex(sc, (r1 * r2 + i1 * i2) * den, (r2 * i1 - r1 * i2) * den));
- rl_a = (r1 * r2 + i1 * i2) * den;
- im_a = (r2 * i1 - r1 * i2) * den;
- goto DIVIDE_COMPLEX;
- }
+static s7_pointer g_is_complex(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_complex "(complex? obj) returns #t if obj is a number"
+ #define Q_is_complex pl_bt
+ check_boolean_method(sc, s7_is_number, sc->is_complex_symbol, 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);
- }
- break;
- default:
- method_or_bust_with_type(sc, x, sc->divide_symbol, args, a_number_string, 1);
- }
+static s7_pointer g_is_rational(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_rational "(rational? obj) returns #t if obj is a rational number (either an integer or a ratio)"
+ #define Q_is_rational pl_bt
+ check_boolean_method(sc, s7_is_rational, sc->is_rational_symbol, args);
+ /* in the non-gmp case, (rational? 455702434782048082459/86885567283849955830) -> #f, not #t
+ * and similarly for exact? etc.
+ */
}
-#if (!WITH_GMP)
-static s7_pointer invert_1;
+/* ---------------------------------------- even? odd?---------------------------------------- */
-static s7_pointer g_invert_1(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_is_even(s7_scheme *sc, s7_pointer args)
{
+ #define H_is_even "(even? int) returns #t if the integer int is even"
+ #define Q_is_even s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_integer_symbol)
+
s7_pointer p;
p = car(args);
switch (type(p))
{
- case T_INTEGER:
- if (integer(p) != 0)
- return(s7_make_ratio(sc, 1, integer(p))); /* a already checked, not 0 */
- return(division_by_zero_error(sc, sc->divide_symbol, args));
-
- case T_RATIO:
- return(s7_make_ratio(sc, denominator(p), numerator(p)));
-
- case T_REAL:
- if (real(p) != 0.0)
- return(make_real(sc, 1.0 / real(p)));
- return(division_by_zero_error(sc, sc->divide_symbol, args));
-
- case T_COMPLEX:
- {
- s7_double r2, i2, den;
- r2 = real_part(p);
- i2 = imag_part(p);
- den = (r2 * r2 + i2 * i2);
- return(s7_make_complex(sc, r2 / den, -i2 / den));
- }
-
- default:
- method_or_bust_with_type(sc, p, sc->divide_symbol, args, a_number_string, 1);
+ case T_INTEGER: return(make_boolean(sc, ((integer(p) & 1) == 0)));
+#if WITH_GMP
+ case T_BIG_INTEGER: return(make_boolean(sc, mpz_even_p(big_integer(p))));
+#endif
+ default: method_or_bust_one_arg(sc, p, sc->is_even_symbol, list_1(sc, p), T_INTEGER);
}
}
-
-static s7_pointer divide_1r;
-static s7_pointer g_divide_1r(s7_scheme *sc, s7_pointer args)
+static bool is_even_b(s7_pointer p)
{
- if (s7_is_real(cadr(args)))
- {
- s7_double rl;
- rl = real_to_double(sc, cadr(args), "/");
- if (rl == 0.0)
- return(division_by_zero_error(sc, sc->divide_symbol, args));
- return(make_real(sc, 1.0 / rl));
- }
- return(g_divide(sc, args));
+ if (!s7_is_integer(p))
+ simple_wrong_type_argument(cur_sc, cur_sc->is_even_symbol, p, T_INTEGER);
+ return((integer(p) & 1) == 0);
}
+static bool is_even_i(s7_int i1) {return((i1 & 1) == 0);}
-static s7_double c_dbl_invert(s7_scheme *sc, s7_double x)
-{
- if (x == 0.0) division_by_zero_error(sc, sc->divide_symbol, set_elist_1(sc, real_zero));
- return(1.0 / x);
-}
-static s7_double c_dbl_divide_2(s7_scheme *sc, s7_double x, s7_double y)
+static s7_pointer g_is_odd(s7_scheme *sc, s7_pointer args)
{
- if (y == 0.0) division_by_zero_error(sc, sc->divide_symbol, set_elist_2(sc, make_real(sc, x), real_zero));
- return(x / y);
+ #define H_is_odd "(odd? int) returns #t if the integer int is odd"
+ #define Q_is_odd s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_integer_symbol)
+
+ s7_pointer p;
+ p = car(args);
+ switch (type(p))
+ {
+ case T_INTEGER: return(make_boolean(sc, ((integer(p) & 1) == 1)));
+#if WITH_GMP
+ case T_BIG_INTEGER: return(make_boolean(sc, mpz_odd_p(big_integer(p))));
+#endif
+ default: method_or_bust_one_arg(sc, p, sc->is_odd_symbol, list_1(sc, p), T_INTEGER);
+ }
}
-static s7_double c_dbl_divide_3(s7_scheme *sc, s7_double x, s7_double y, s7_double z)
+static bool is_odd_b(s7_pointer p)
{
- s7_double d;
- d = y * z;
- if (d == 0.0) division_by_zero_error(sc, sc->divide_symbol, set_elist_3(sc, make_real(sc, x), make_real(sc, y), make_real(sc, z)));
- return(x / d);
+ if (!s7_is_integer(p))
+ simple_wrong_type_argument(cur_sc, cur_sc->is_odd_symbol, p, T_INTEGER);
+ return((integer(p) & 1) == 1);
}
-RF_3_TO_RF(divide, c_dbl_invert, c_dbl_divide_2, c_dbl_divide_3)
-#endif
+static bool is_odd_i(s7_int i1) {return((i1 & 1) == 1);}
-/* ---------------------------------------- max/min ---------------------------------------- */
-static bool is_real_via_method_1(s7_scheme *sc, s7_pointer p)
-{
- s7_pointer f;
- f = find_method(sc, find_let(sc, p), sc->is_real_symbol);
- if (f != sc->undefined)
- return(is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->nil))));
- return(false);
-}
+/* ---------------------------------------- zero? ---------------------------------------- */
-#define is_real_via_method(sc, p) ((s7_is_real(p)) || ((has_methods(p)) && (is_real_via_method_1(sc, p))))
-
-
-static s7_pointer g_max(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_is_zero(s7_scheme *sc, s7_pointer args)
{
- #define H_max "(max ...) returns the maximum of its arguments"
- #define Q_max pcl_r
-
- s7_pointer x, y, p;
- s7_int num_a, num_b, den_a, den_b;
-
+ #define H_is_zero "(zero? num) returns #t if the number num is zero"
+ #define Q_is_zero pl_bn
+ s7_pointer x;
x = car(args);
- p = cdr(args);
-
switch (type(x))
{
- case T_INTEGER:
- MAX_INTEGERS:
- if (is_null(p)) return(x);
- y = car(p);
- p = cdr(p);
- /* fprintf(stderr, "%d: %s %s\n", __LINE__, DISPLAY(x), DISPLAY(y)); */
-
- switch (type(y))
- {
- case T_INTEGER:
- if (integer(x) < integer(y)) x = y;
- goto MAX_INTEGERS;
-
- case T_RATIO:
- num_a = integer(x);
- den_a = 1;
- num_b = numerator(y);
- den_b = denominator(y);
- goto RATIO_MAX_RATIO;
-
- case T_REAL:
- if (is_NaN(real(y)))
- {
- for (; is_not_null(p); p = cdr(p))
- if (!is_real_via_method(sc, car(p)))
- return(wrong_type_argument(sc, sc->max_symbol, position_of(p, args), car(p), T_REAL));
- return(y);
- }
- if (integer(x) < real(y))
- {
- x = y;
- goto MAX_REALS;
- }
- 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);
- }
-
-
+ case T_INTEGER: return(make_boolean(sc, integer(x) == 0));
+ case T_REAL: return(make_boolean(sc, real(x) == 0.0));
case T_RATIO:
- MAX_RATIOS:
- if (is_null(p)) return(x);
- y = car(p);
- p = cdr(p);
- /* fprintf(stderr, "%d: %s %s\n", __LINE__, DISPLAY(x), DISPLAY(y)); */
-
- switch (type(y))
- {
- case T_INTEGER:
- num_a = numerator(x);
- den_a = denominator(x);
- num_b = integer(y);
- den_b = 1;
- goto RATIO_MAX_RATIO;
-
- case T_RATIO:
- num_a = numerator(x);
- den_a = denominator(x);
- num_b = numerator(y);
- den_b = denominator(y);
-
- RATIO_MAX_RATIO:
- /* there are tricky cases here where long ints outrun doubles:
- * (max 92233720368547758/9223372036854775807 92233720368547757/9223372036854775807)
- * which should be 92233720368547758/9223372036854775807) but first the fraction gets reduced
- * to 13176245766935394/1317624576693539401, so we fall into the double comparison, and
- * there we should be comparing
- * 9.999999999999999992410584792601468961145E-3 and
- * 9.999999999999999883990367544051025548645E-3
- * but if using doubles we get
- * 0.010000000000000000208166817117 and
- * 0.010000000000000000208166817117
- * that is, we can't distinguish these two fractions once they're coerced to doubles.
- *
- * Even long doubles fail in innocuous-looking cases:
- * (min 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
- * (max 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
- *
- * Another consequence: outside gmp, we can't handle cases like
- * (max 9223372036854776/9223372036854775807 #i9223372036854775/9223372036854775000)
- * (max #i9223372036854776/9223372036854775807 9223372036854775/9223372036854775000)
- * I guess if the user is using "inexact" numbers (#i...), he accepts their inexactness.
- */
-
- if ((num_a < 0) && (num_b >= 0)) /* x < 0, y >= 0 -> y */
- x = y;
- else
- {
- if ((num_a < 0) || (num_b >= 0))
- {
- if (den_a == den_b)
- {
- if (num_a < num_b)
- x = y;
- }
- else
- {
- if (num_a == num_b)
- {
- if (((num_a >= 0) &&
- (den_a > den_b)) ||
- ((num_a < 0) &&
- (den_a < den_b)))
- x = y;
- }
- else
- {
- s7_int vala, valb;
- vala = num_a / den_a;
- valb = num_b / den_b;
- /* fprintf(stderr, "val: %lld %lld %d %d\n", vala, valb, -1/2, 0); */
-
- if (!((vala > valb) ||
- ((vala == valb) && (is_t_integer(y)))))
- {
- if ((valb > vala) ||
- ((vala == valb) && (is_t_integer(x))) ||
- /* sigh -- both are ratios and the int parts are equal */
- (((long double)(num_a % den_a) / (long double)den_a) <= ((long double)(num_b % den_b) / (long double)den_b)))
- x = y;
- }
- }
- }
- }
- }
- if (is_t_ratio(x))
- goto MAX_RATIOS;
- goto MAX_INTEGERS;
-
- case T_REAL:
- /* (max 3/4 nan.0) should probably return NaN */
- if (is_NaN(real(y)))
- {
- for (; is_not_null(p); p = cdr(p))
- if (!is_real_via_method(sc, car(p)))
- return(wrong_type_argument(sc, sc->max_symbol, position_of(p, args), car(p), T_REAL));
- return(y);
- }
-
- if (fraction(x) < real(y))
- {
- x = y;
- goto MAX_REALS;
- }
- 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);
- }
-
-
- case T_REAL:
- if (is_NaN(real(x)))
- {
- for (; is_not_null(p); p = cdr(p))
- if (!is_real_via_method(sc, car(p)))
- return(wrong_type_argument(sc, sc->max_symbol, position_of(p, args), car(p), T_REAL));
- return(x);
- }
-
- MAX_REALS:
- if (is_null(p)) return(x);
- y = car(p);
- p = cdr(p);
+ case T_COMPLEX: return(sc->F); /* ratios and complex numbers are already collapsed into integers and reals */
+#if WITH_GMP
+ case T_BIG_INTEGER: return(make_boolean(sc, mpz_cmp_ui(big_integer(x), 0) == 0));
+ case T_BIG_REAL: return(make_boolean(sc, mpfr_zero_p(big_real(x))));
+ case T_BIG_RATIO:
+ case T_BIG_COMPLEX: return(sc->F);
+#endif
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->is_zero_symbol, list_1(sc, x), a_number_string);
+ }
+}
- switch (type(y))
- {
- case T_INTEGER:
- if (real(x) < integer(y))
- {
- x = y;
- goto MAX_INTEGERS;
- }
- goto MAX_REALS;
+static bool is_zero_b(s7_pointer p)
+{
+ if (!is_number(p))
+ simple_wrong_type_argument_with_type(cur_sc, cur_sc->is_zero_symbol, p, a_number_string);
+ if (is_t_integer(p))
+ return(integer(p) == 0);
+ if (is_t_real(p))
+ return(real(p) == 0.0);
+ return(false);
+}
- case T_RATIO:
- if (real(x) < fraction(y))
- {
- x = y;
- goto MAX_RATIOS;
- }
- goto MAX_REALS;
+static bool is_zero_i(s7_int p) {return(p == 0);}
+static bool is_zero_d(s7_double p) {return(p == 0.0);}
- case T_REAL:
- if (is_NaN(real(y)))
- {
- for (; is_not_null(p); p = cdr(p))
- if (!is_real_via_method(sc, car(p)))
- return(wrong_type_argument(sc, sc->max_symbol, position_of(p, args), car(p), T_REAL));
- return(y);
- }
- if (real(x) < real(y)) x = y;
- 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);
- }
+/* -------------------------------- positive? -------------------------------- */
+static s7_pointer g_is_positive(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_positive "(positive? num) returns #t if the real number num is positive (greater than 0)"
+ #define Q_is_positive s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_real_symbol)
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_boolean(sc, integer(x) > 0));
+ case T_RATIO: return(make_boolean(sc, numerator(x) > 0));
+ case T_REAL: return(make_boolean(sc, real(x) > 0.0));
+#if WITH_GMP
+ case T_BIG_INTEGER: return(make_boolean(sc, (mpz_cmp_ui(big_integer(x), 0) > 0)));
+ case T_BIG_RATIO: return(make_boolean(sc, (mpq_cmp_ui(big_ratio(x), 0, 1) > 0)));
+ case T_BIG_REAL: return(make_boolean(sc, (mpfr_cmp_ui(big_real(x), 0) > 0)));
+#endif
default:
- method_or_bust(sc, x, sc->max_symbol, cons(sc, x, p), T_REAL, 1);
+ method_or_bust_one_arg(sc, x, sc->is_positive_symbol, list_1(sc, x), T_REAL);
}
}
-#if (!WITH_GMP)
-static s7_pointer max_f2;
-static s7_pointer g_max_f2(s7_scheme *sc, s7_pointer args)
+static bool is_positive_b(s7_pointer p)
{
- s7_pointer x, y;
- x = car(args);
- y = cadr(args);
- if (is_t_real(y))
- return((real(x) >= real(y)) ? x : y);
- if (is_real(y))
- return((real(x) >= real_to_double(sc, y, "max")) ? x : y);
- method_or_bust(sc, y, sc->max_symbol, args, T_REAL, 2);
+ if (!is_real(p))
+ simple_wrong_type_argument(cur_sc, cur_sc->is_positive_symbol, p, T_REAL);
+ if (is_t_integer(p))
+ return(integer(p) > 0);
+ if (is_t_real(p))
+ return(real(p) > 0.0);
+ return(numerator(p) > 0);
}
-#endif
-static s7_pointer g_min(s7_scheme *sc, s7_pointer args)
-{
- #define H_min "(min ...) returns the minimum of its arguments"
- #define Q_min pcl_r
+static bool is_positive_i(s7_int p) {return(p > 0);}
+static bool is_positive_d(s7_double p) {return(p > 0.0);}
- s7_pointer x, y, p;
- s7_int num_a, num_b, den_a, den_b;
- x = car(args);
- p = cdr(args);
+/* -------------------------------- negative? -------------------------------- */
+static s7_pointer g_is_negative(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_negative "(negative? num) returns #t if the real number num is negative (less than 0)"
+ #define Q_is_negative s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_real_symbol)
+ s7_pointer x;
+ x = car(args);
switch (type(x))
{
- case T_INTEGER:
- MIN_INTEGERS:
- if (is_null(p)) return(x);
- y = car(p);
- p = cdr(p);
-
- switch (type(y))
- {
- case T_INTEGER:
- if (integer(x) > integer(y)) x = y;
- goto MIN_INTEGERS;
+ case T_INTEGER: return(make_boolean(sc, integer(x) < 0));
+ case T_RATIO: return(make_boolean(sc, numerator(x) < 0));
+ case T_REAL: return(make_boolean(sc, real(x) < 0.0));
+#if WITH_GMP
+ case T_BIG_INTEGER: return(make_boolean(sc, (mpz_cmp_ui(big_integer(x), 0) < 0)));
+ case T_BIG_RATIO: return(make_boolean(sc, (mpq_cmp_ui(big_ratio(x), 0, 1) < 0)));
+ case T_BIG_REAL: return(make_boolean(sc, (mpfr_cmp_ui(big_real(x), 0) < 0)));
+#endif
+ default:
+ method_or_bust_one_arg(sc, x, sc->is_negative_symbol, list_1(sc, x), T_REAL);
+ }
+}
- case T_RATIO:
- num_a = integer(x);
- den_a = 1;
- num_b = numerator(y);
- den_b = denominator(y);
- goto RATIO_MIN_RATIO;
+static bool is_negative_b(s7_pointer p)
+{
+ if (!is_real(p))
+ simple_wrong_type_argument(cur_sc, cur_sc->is_negative_symbol, p, T_REAL);
+ if (is_t_integer(p))
+ return(integer(p) < 0);
+ if (is_t_real(p))
+ return(real(p) < 0.0);
+ return(numerator(p) < 0);
+}
- case T_REAL:
- if (is_NaN(real(y)))
- {
- for (; is_not_null(p); p = cdr(p))
- if (!is_real_via_method(sc, car(p)))
- return(wrong_type_argument(sc, sc->min_symbol, position_of(p, args), car(p), T_REAL));
- return(y);
- }
- if (integer(x) > real(y))
- {
- x = y;
- goto MIN_REALS;
- }
- goto MIN_INTEGERS;
+static bool is_negative_i(s7_int p) {return(p < 0);}
+static bool is_negative_d(s7_double p) {return(p < 0.0);}
- default:
- method_or_bust(sc, y, sc->min_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
- }
- case T_RATIO:
- MIN_RATIOS:
- if (is_null(p)) return(x);
- y = car(p);
- p = cdr(p);
+bool s7_is_ulong(s7_pointer arg)
+{
+ return(is_integer(arg));
+}
- switch (type(y))
- {
- case T_INTEGER:
- num_a = numerator(x);
- den_a = denominator(x);
- num_b = integer(y);
- den_b = 1;
- goto RATIO_MIN_RATIO;
- case T_RATIO:
- num_a = numerator(x);
- den_a = denominator(x);
- num_b = numerator(y);
- den_b = denominator(y);
+unsigned long s7_ulong(s7_pointer p)
+{
+ return((_NFre(p))->object.number.ul_value);
+}
- RATIO_MIN_RATIO:
- if ((num_a >= 0) && (num_b < 0))
- x = y;
- else
- {
- if ((num_a >= 0) || (num_b < 0))
- {
- if (den_a == den_b)
- {
- if (num_a > num_b)
- x = y;
- }
- else
- {
- if (num_a == num_b)
- {
- if (((num_a >= 0) &&
- (den_a < den_b)) ||
- ((num_a < 0) &&
- (den_a > den_b)))
- x = y;
- }
- else
- {
- s7_int vala, valb;
- vala = num_a / den_a;
- valb = num_b / den_b;
-
- if (!((vala < valb) ||
- ((vala == valb) && (is_t_integer(x)))))
- {
- if ((valb < vala) ||
- ((vala == valb) && (is_t_integer(y))) ||
- (((long double)(num_a % den_a) / (long double)den_a) >= ((long double)(num_b % den_b) / (long double)den_b)))
- x = y;
- }
- }
- }
- }
- }
- if (is_t_ratio(x))
- goto MIN_RATIOS;
- goto MIN_INTEGERS;
- case T_REAL:
- /* (min 3/4 nan.0) should probably return NaN */
- if (is_NaN(real(y)))
- {
- for (; is_not_null(p); p = cdr(p))
- if (!is_real_via_method(sc, car(p)))
- return(wrong_type_argument(sc, sc->min_symbol, position_of(p, args), car(p), T_REAL));
- return(y);
- }
- if (fraction(x) > real(y))
- {
- x = y;
- goto MIN_REALS;
- }
- goto MIN_RATIOS;
+s7_pointer s7_make_ulong(s7_scheme *sc, unsigned long n)
+{
+ s7_pointer x;
+ new_cell(sc, x, T_INTEGER);
+ x->object.number.ul_value = n;
+ return(x);
+}
- default:
- method_or_bust(sc, y, sc->min_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
- }
+bool s7_is_ulong_long(s7_pointer arg)
+{
+ return(is_integer(arg));
+}
- case T_REAL:
- if (is_NaN(real(x)))
- {
- for (; is_not_null(p); p = cdr(p))
- if (!is_real_via_method(sc, car(p)))
- return(wrong_type_argument(sc, sc->min_symbol, position_of(p, args), car(p), T_REAL));
- return(x);
- }
- MIN_REALS:
- if (is_null(p)) return(x);
- y = car(p);
- p = cdr(p);
+unsigned long long s7_ulong_long(s7_pointer p)
+{
+ return((_NFre(p))->object.number.ull_value);
+}
- switch (type(y))
- {
- case T_INTEGER:
- if (real(x) > integer(y))
- {
- x = y;
- goto MIN_INTEGERS;
- }
- goto MIN_REALS;
- case T_RATIO:
- if (real(x) > fraction(y))
- {
- x = y;
- goto MIN_RATIOS;
- }
- goto MIN_REALS;
+s7_pointer s7_make_ulong_long(s7_scheme *sc, unsigned long long n)
+{
+ s7_pointer x;
+ new_cell(sc, x, T_INTEGER);
+ x->object.number.ull_value = n;
+ return(x);
+}
- case T_REAL:
- if (is_NaN(real(y)))
- {
- for (; is_not_null(p); p = cdr(p))
- if (!is_real_via_method(sc, car(p)))
- return(wrong_type_argument(sc, sc->min_symbol, position_of(p, args), car(p), T_REAL));
- return(y);
- }
- if (real(x) > real(y)) x = y;
- 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);
- }
+#if (!WITH_PURE_S7)
+#if (!WITH_GMP)
+/* ---------------------------------------- exact<->inexact exact? inexact? ---------------------------------------- */
- default:
- method_or_bust(sc, x, sc->min_symbol, cons(sc, x, p), T_REAL, 1);
- }
+static s7_pointer g_exact_to_inexact(s7_scheme *sc, s7_pointer args)
+{
+ #define H_exact_to_inexact "(exact->inexact num) converts num to an inexact number; (exact->inexact 3/2) = 1.5"
+ #define Q_exact_to_inexact pcl_r
+ return(exact_to_inexact(sc, car(args)));
}
-#if (!WITH_GMP)
-static s7_pointer min_f2;
-static s7_pointer g_min_f2(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_inexact_to_exact(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x, y;
- x = car(args);
- y = cadr(args);
- if (is_t_real(y))
- return((real(x) <= real(y)) ? x : y);
- if (is_real(y))
- return((real(x) <= real_to_double(sc, y, "min")) ? x : y);
- method_or_bust(sc, y, sc->min_symbol, args, T_REAL, 2);
+ #define H_inexact_to_exact "(inexact->exact num) converts num to an exact number; (inexact->exact 1.5) = 3/2"
+ #define Q_inexact_to_exact s7_make_signature(sc, 2, sc->is_rational_symbol, sc->is_real_symbol)
+ return(inexact_to_exact(sc, car(args), WITH_OVERFLOW_ERROR));
}
-
-static s7_int c_max_i1(s7_scheme *sc, s7_int x) {return(x);}
-static s7_int c_max_i2(s7_scheme *sc, s7_int x, s7_int y) {return((x >= y) ? x : y);}
-static s7_int c_max_i3(s7_scheme *sc, s7_int x, s7_int y, s7_int z) {return(((x >= y) ? ((x >= z) ? x : z) : ((y >= z) ? y : z)));}
-IF_3_TO_IF(max, c_max_i1, c_max_i2, c_max_i3)
-
-static s7_int c_min_i1(s7_scheme *sc, s7_int x) {return(x);}
-static s7_int c_min_i2(s7_scheme *sc, s7_int x, s7_int y) {return((x <= y) ? x : y);}
-static s7_int c_min_i3(s7_scheme *sc, s7_int x, s7_int y, s7_int z) {return(((x <= y) ? ((x <= z) ? x : z) : ((y <= z) ? y : z)));}
-IF_3_TO_IF(min, c_min_i1, c_min_i2, c_min_i3)
-
-static s7_double c_max_r1(s7_scheme *sc, s7_double x) {return(x);}
-static s7_double c_max_r2(s7_scheme *sc, s7_double x, s7_double y) {return((x >= y) ? x : y);}
-static s7_double c_max_r3(s7_scheme *sc, s7_double x, s7_double y, s7_double z) {return(((x >= y) ? ((x >= z) ? x : z) : ((y >= z) ? y : z)));}
-RF_3_TO_RF(max, c_max_r1, c_max_r2, c_max_r3)
-
-static s7_double c_min_r1(s7_scheme *sc, s7_double x) {return(x);}
-static s7_double c_min_r2(s7_scheme *sc, s7_double x, s7_double y) {return((x <= y) ? x : y);}
-static s7_double c_min_r3(s7_scheme *sc, s7_double x, s7_double y, s7_double z) {return(((x <= y) ? ((x <= z) ? x : z) : ((y <= z) ? y : z)));}
-RF_3_TO_RF(min, c_min_r1, c_min_r2, c_min_r3)
#endif
+/* (!WITH_GMP) */
-
-/* ---------------------------------------- = > < >= <= ---------------------------------------- */
-
-static s7_pointer g_equal(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_is_exact(s7_scheme *sc, s7_pointer args)
{
- #define H_equal "(= z1 ...) returns #t if all its arguments are equal"
- #define Q_equal s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_number_symbol)
- s7_pointer x, p;
- s7_int num_a, den_a;
- s7_double rl_a, im_a;
+ #define H_is_exact "(exact? num) returns #t if num is exact (an integer or a ratio)"
+ #define Q_is_exact pl_bn
+ s7_pointer x;
x = car(args);
- p = cdr(args);
-
switch (type(x))
{
case T_INTEGER:
- num_a = integer(x);
- while (true)
- {
- x = car(p);
- p = cdr(p);
- switch (type(x))
- {
- case T_INTEGER:
- if (num_a != integer(x)) goto NOT_EQUAL;
- break;
-
- case T_RATIO:
- case T_COMPLEX:
- goto NOT_EQUAL;
-
- case T_REAL:
- if (num_a != real(x)) goto NOT_EQUAL;
- break;
+ case T_RATIO: return(sc->T);
+ case T_REAL:
+ case T_COMPLEX: return(sc->F);
+#if WITH_GMP
+ case T_BIG_INTEGER:
+ case T_BIG_RATIO: return(sc->T);
+ case T_BIG_REAL:
+ case T_BIG_COMPLEX: return(sc->F);
+#endif
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->is_exact_symbol, args, a_number_string);
+ }
+}
- 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);
- }
- if (is_null(p))
- return(sc->T);
- }
+static bool is_exact_b(s7_pointer p)
+{
+ if (!is_number(p))
+ simple_wrong_type_argument_with_type(cur_sc, cur_sc->is_exact_symbol, p, a_number_string);
+ return(is_rational(p));
+}
- case T_RATIO:
- num_a = numerator(x);
- den_a = denominator(x);
- rl_a = 0.0;
- while (true)
- {
- x = car(p);
- p = cdr(p);
- switch (type(x))
- {
- case T_INTEGER:
- case T_COMPLEX:
- goto NOT_EQUAL;
- case T_RATIO:
- if ((num_a != numerator(x)) || (den_a != denominator(x))) goto NOT_EQUAL; /* hidden cast here */
- break;
+static s7_pointer g_is_inexact(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_inexact "(inexact? num) returns #t if num is inexact (neither an integer nor a ratio)"
+ #define Q_is_inexact pl_bn
- case T_REAL:
- if (rl_a == 0.0)
- rl_a = ((long double)num_a) / ((long double)den_a);
- if (rl_a != real(x)) goto NOT_EQUAL;
- break;
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ case T_RATIO: return(sc->F);
+ case T_REAL:
+ case T_COMPLEX: return(sc->T);
+#if WITH_GMP
+ case T_BIG_INTEGER:
+ case T_BIG_RATIO: return(sc->F);
+ case T_BIG_REAL:
+ case T_BIG_COMPLEX: return(sc->T);
+#endif
+ default:
+ method_or_bust_with_type_one_arg(sc, x, sc->is_inexact_symbol, args, a_number_string);
+ }
+}
- 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);
- }
- if (is_null(p))
- return(sc->T);
- }
+static bool is_inexact_b(s7_pointer p)
+{
+ if (!is_number(p))
+ simple_wrong_type_argument_with_type(cur_sc, cur_sc->is_inexact_symbol, p, a_number_string);
+ return(!is_rational(p));
+}
- case T_REAL:
- rl_a = real(x);
- while (true)
- {
- x = car(p);
- p = cdr(p);
- switch (type(x))
- {
- case T_INTEGER:
- if (rl_a != integer(x)) goto NOT_EQUAL;
- break;
- case T_RATIO:
- if (rl_a != (double)fraction(x)) goto NOT_EQUAL;
- /* the cast to double is needed because rl_a is s7_double and we want (= ratio real) to be the same as (= real ratio):
- * (= 1.0 9223372036854775807/9223372036854775806)
- * (= 9223372036854775807/9223372036854775806 1.0)
- */
- break;
+/* ---------------------------------------- integer-length, integer-decode-float ---------------------------------------- */
- case T_REAL:
- if (rl_a != real(x)) goto NOT_EQUAL;
- break;
+static int integer_length(s7_int a)
+{
+ static const int bits[256] =
+ {0, 1, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
+ 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
+ 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
+ 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
+ 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8};
- case T_COMPLEX:
- goto NOT_EQUAL;
+ #define I_8 256LL
+ #define I_16 65536LL
+ #define I_24 16777216LL
+ #define I_32 4294967296LL
+ #define I_40 1099511627776LL
+ #define I_48 281474976710656LL
+ #define I_56 72057594037927936LL
- 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);
- }
- if (is_null(p))
- return(sc->T);
- }
+ /* a might be most-negative-fixnum! in Clisp: (integer-length -9223372036854775808) -> 63
+ */
+ if (a < 0)
+ {
+ if (a == s7_int_min) return(63);
+ a = -a;
+ }
+ if (a < I_8) return(bits[a]);
+ if (a < I_16) return(8 + bits[a >> 8]);
+ if (a < I_24) return(16 + bits[a >> 16]);
+ if (a < I_32) return(24 + bits[a >> 24]);
+ if (a < I_40) return(32 + bits[a >> 32]);
+ if (a < I_48) return(40 + bits[a >> 40]);
+ if (a < I_56) return(48 + bits[a >> 48]);
+ return(56 + bits[a >> 56]);
+}
- case T_COMPLEX:
- rl_a = real_part(x);
- im_a = imag_part(x);
- while (true)
- {
- x = car(p);
- p = cdr(p);
- switch (type(x))
- {
- case T_INTEGER:
- case T_RATIO:
- case T_REAL:
- goto NOT_EQUAL;
- break;
+static s7_pointer g_integer_length(s7_scheme *sc, s7_pointer args)
+{
+ #define H_integer_length "(integer-length arg) returns the number of bits required to represent the integer 'arg': (ceiling (log (abs arg) 2))"
+ #define Q_integer_length pcl_i
- case T_COMPLEX:
- if ((rl_a != real_part(x)) || (im_a != imag_part(x)))
- goto NOT_EQUAL;
- break;
+ s7_int x;
+ s7_pointer p;
- 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);
- }
- if (is_null(p))
- return(sc->T);
- }
+ p = car(args);
+ if (!s7_is_integer(p))
+ method_or_bust_one_arg(sc, p, sc->integer_length_symbol, args, T_INTEGER);
- default:
- method_or_bust_with_type(sc, x, sc->eq_symbol, args, a_number_string, 1);
- }
- NOT_EQUAL:
- for (; is_pair(p); p = cdr(p))
- if (!is_number_via_method(sc, car(p)))
- return(wrong_type_argument_with_type(sc, sc->eq_symbol, position_of(p, args), car(p), a_number_string));
+ x = s7_integer(p);
+ if (x < 0)
+ return(make_integer(sc, integer_length(-(x + 1))));
+ return(make_integer(sc, integer_length(x)));
+}
- return(sc->F);
+static s7_int integer_length_i_i(s7_int x)
+{
+ if (x < 0)
+ return(integer_length(-(x + 1)));
+ return(integer_length(x));
}
+#endif /* !pure s7 */
-static s7_pointer equal_s_ic, equal_2;
-static s7_pointer g_equal_s_ic(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_integer_decode_float(s7_scheme *sc, s7_pointer args)
{
- s7_int y;
- s7_pointer val;
+ #define H_integer_decode_float "(integer-decode-float x) returns a list containing the significand, exponent, and \
+sign of 'x' (1 = positive, -1 = negative). (integer-decode-float 0.0): (0 0 1)"
+ #define Q_integer_decode_float s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_float_symbol)
- val = find_symbol_checked(sc, car(args));
- y = s7_integer(cadr(args));
- if (is_integer(val))
- return(make_boolean(sc, integer(val) == y));
+ /* no matter what s7_double is, integer-decode-float acts as if x is a C double */
- switch (type(val))
+ typedef struct decode_float_t {
+ union {
+ long long int ix;
+ double fx;
+ } value;
+ } decode_float_t;
+
+ decode_float_t num;
+ s7_pointer x;
+ x = car(args);
+
+ switch (type(x))
{
- case T_INTEGER: return(make_boolean(sc, integer(val) == y));
- case T_RATIO: return(sc->F);
- case T_REAL: return(make_boolean(sc, real(val) == y));
- case T_COMPLEX: return(sc->F);
+ case T_REAL:
+ num.value.fx = (double)real(x);
+ break;
+
+#if WITH_GMP
+ case T_BIG_REAL:
+ num.value.fx = (double)real_to_double(sc, x, "integer-decode-float");
+ break;
+#endif
+
default:
- method_or_bust_with_type(sc, val, sc->eq_symbol, list_2(sc, val, cadr(args)), a_number_string, 1);
+ method_or_bust_with_type_one_arg(sc, x, sc->integer_decode_float_symbol, args, make_string_wrapper(sc, "a non-rational real"));
}
- return(sc->T);
+
+ if (num.value.fx == 0.0)
+ return(list_3(sc, small_int(0), small_int(0), small_int(1)));
+
+ return(list_3(sc,
+ make_integer(sc, (s7_int)((num.value.ix & 0xfffffffffffffLL) | 0x10000000000000LL)),
+ make_integer(sc, (s7_int)(((num.value.ix & 0x7fffffffffffffffLL) >> 52) - 1023 - 52)),
+ make_integer(sc, ((num.value.ix & 0x8000000000000000LL) != 0) ? -1 : 1)));
}
-static s7_int object_length_to_int(s7_scheme *sc, s7_pointer obj);
-#if (!WITH_GMP)
-static s7_pointer equal_length_ic;
-static s7_pointer g_equal_length_ic(s7_scheme *sc, s7_pointer args)
-{
- /* avoid make_integer (and telescope opts), we get here with car=length expr, cadr=int */
- s7_int ilen;
- s7_pointer val;
- val = find_symbol_checked(sc, cadar(args));
- ilen = s7_integer(cadr(args));
+/* -------------------------------- logior -------------------------------- */
+static s7_pointer g_logior(s7_scheme *sc, s7_pointer args)
+{
+ #define H_logior "(logior int ...) returns the bitwise OR of its integer arguments (the bits that are on in any of the arguments)"
+ #define Q_logior pcl_i
+ s7_int result = 0;
+ s7_pointer x;
- switch (type(val))
+ for (x = args; is_not_null(x); x = cdr(x))
{
- case T_PAIR: return(make_boolean(sc, s7_list_length(sc, val) == ilen));
- case T_NIL: return(make_boolean(sc, ilen == 0));
- 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_LET: return(make_boolean(sc, let_length(sc, val) == ilen));
- case T_INT_VECTOR:
- case T_FLOAT_VECTOR:
- case T_VECTOR: return(make_boolean(sc, vector_length(val) == ilen));
- case T_CLOSURE:
- case T_CLOSURE_STAR: if (has_methods(val)) return(make_boolean(sc, closure_length(sc, val) == ilen));
- default: return(simple_wrong_type_argument_with_type(sc, sc->length_symbol, val, a_sequence_string));
- /* here we already lost because we checked for the length above */
+ if (!s7_is_integer(car(x)))
+ method_or_bust(sc, car(x), sc->logior_symbol, cons(sc, make_integer(sc, result), x), T_INTEGER, position_of(x, args));
+ result |= s7_integer(car(x));
}
- return(sc->F);
+ return(make_integer(sc, result));
}
-#endif
+
+static s7_int logior_i_ii(s7_int i1, s7_int i2) {return(i1 | i2);}
-static s7_pointer c_equal_2_1(s7_scheme *sc, s7_pointer x, s7_pointer y)
+/* -------------------------------- logxor -------------------------------- */
+static s7_pointer g_logxor(s7_scheme *sc, s7_pointer args)
{
- switch (type(x))
- {
- case T_INTEGER:
- switch (type(y))
- {
- case T_INTEGER: return(make_boolean(sc, integer(x) == integer(y)));
- case T_RATIO: return(sc->F);
- case T_REAL: return(make_boolean(sc, integer(x) == real(y)));
- case T_COMPLEX: return(sc->F);
- default:
- method_or_bust_with_type(sc, y, sc->eq_symbol, list_2(sc, x, y), a_number_string, 2);
- }
- break;
+ #define H_logxor "(logxor int ...) returns the bitwise XOR of its integer arguments (the bits that are on in an odd number of the arguments)"
+ #define Q_logxor pcl_i
+ s7_int result = 0;
+ s7_pointer x;
- case T_RATIO:
- switch (type(y))
- {
- case T_INTEGER: return(sc->F);
- case T_RATIO: return(make_boolean(sc, (numerator(x) == numerator(y)) && (denominator(x) == denominator(y))));
- case T_REAL: return(make_boolean(sc, fraction(x) == real(y))); /* this could avoid the divide via numerator == denominator * x */
- case T_COMPLEX: return(sc->F);
- default:
- method_or_bust_with_type(sc, y, sc->eq_symbol, list_2(sc, x, y), a_number_string, 2);
- }
- break;
+ for (x = args; is_not_null(x); x = cdr(x))
+ {
+ if (!s7_is_integer(car(x)))
+ method_or_bust(sc, car(x), sc->logxor_symbol, cons(sc, make_integer(sc, result), x), T_INTEGER, position_of(x, args));
+ result ^= s7_integer(car(x));
+ }
+ return(make_integer(sc, result));
+}
- case T_REAL:
- switch (type(y))
- {
- case T_INTEGER: return(make_boolean(sc, real(x) == integer(y)));
- case T_RATIO: return(make_boolean(sc, real(x) == fraction(y)));
- case T_REAL: return(make_boolean(sc, real(x) == real(y)));
- case T_COMPLEX: return(sc->F);
- default:
- method_or_bust_with_type(sc, y, sc->eq_symbol, list_2(sc, x, y), a_number_string, 2);
- }
- break;
+static s7_int logxor_i_ii(s7_int i1, s7_int i2) {return(i1 ^ i2);}
- case T_COMPLEX:
- switch (type(y))
- {
- case T_INTEGER:
- case T_RATIO:
- case T_REAL:
- return(sc->F);
-#if (!MS_WINDOWS)
- case T_COMPLEX:
- return(make_boolean(sc, (real_part(x) == real_part(y)) && (imag_part(x) == imag_part(y))));
-#else
- case T_COMPLEX:
- if ((real_part(x) == real_part(y)) && (imag_part(x) == imag_part(y))) return(sc->T); else return(sc->F);
-#endif
- default:
- method_or_bust_with_type(sc, y, sc->eq_symbol, list_2(sc, x, y), a_number_string, 2);
- }
- break;
+/* -------------------------------- logand -------------------------------- */
+static s7_pointer g_logand(s7_scheme *sc, s7_pointer args)
+{
+ #define H_logand "(logand int ...) returns the bitwise AND of its integer arguments (the bits that are on in every argument)"
+ #define Q_logand pcl_i
+ s7_int result = -1;
+ s7_pointer x;
- default:
- method_or_bust_with_type(sc, x, sc->eq_symbol, list_2(sc, x, y), a_number_string, 1);
+ for (x = args; is_not_null(x); x = cdr(x))
+ {
+ if (!s7_is_integer(car(x)))
+ method_or_bust(sc, car(x), sc->logand_symbol, cons(sc, make_integer(sc, result), x), T_INTEGER, position_of(x, args));
+ result &= s7_integer(car(x));
}
- return(sc->F);
+ return(make_integer(sc, result));
}
+static s7_int logand_i_ii(s7_int i1, s7_int i2) {return(i1 & i2);}
-static s7_pointer c_equal_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
+
+/* -------------------------------- lognot -------------------------------- */
+
+static s7_pointer g_lognot(s7_scheme *sc, s7_pointer args)
{
-#if (!MS_WINDOWS)
- if (type(x) == type(y))
- {
- if (is_integer(x))
- return(make_boolean(sc, integer(x) == integer(y)));
- switch (type(x))
- {
- case T_INTEGER: return(make_boolean(sc, integer(x) == integer(y)));
- case T_RATIO: return(make_boolean(sc, (numerator(x) == numerator(y)) && (denominator(x) == denominator(y))));
- case T_REAL: return(make_boolean(sc, real(x) == real(y)));
- case T_COMPLEX: return(make_boolean(sc, (real_part(x) == real_part(y)) && (imag_part(x) == imag_part(y))));
- }
- }
-#endif
- return(c_equal_2_1(sc, x, y));
+ #define H_lognot "(lognot num) returns the bitwise negation (the complement, the bits that are not on) in num: (lognot 0) -> -1"
+ #define Q_lognot pcl_i
+ if (!s7_is_integer(car(args)))
+ method_or_bust_one_arg(sc, car(args), sc->lognot_symbol, args, T_INTEGER);
+ return(make_integer(sc, ~s7_integer(car(args))));
}
+static s7_int lognot_i_i(s7_int i1) {return(~i1);}
+
+
+/* -------------------------------- logbit? -------------------------------- */
+/* logbit? CL is (logbitp index int) using 2^index, but that order strikes me as backwards
+ * at least gmp got the arg order right!
+ */
-static s7_pointer g_equal_2(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_logbit(s7_scheme *sc, s7_pointer args)
{
+ #define H_logbit "(logbit? int index) returns #t if the index-th bit is on in int, otherwise #f. The argument \
+order here follows gmp, and is the opposite of the CL convention. (logbit? int bit) is the same as (not (zero? (logand int (ash 1 bit))))."
+ #define Q_logbit s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_integer_symbol)
+
s7_pointer x, y;
+ s7_int index; /* index in gmp is mp_bitcnt which is an unsigned long int */
x = car(args);
y = cadr(args);
-#if (!MS_WINDOWS)
- if (type(x) == type(y))
- {
- if (is_integer(x))
- return(make_boolean(sc, integer(x) == integer(y)));
- switch (type(x))
- {
- case T_INTEGER: return(make_boolean(sc, integer(x) == integer(y)));
- case T_RATIO: return(make_boolean(sc, (numerator(x) == numerator(y)) && (denominator(x) == denominator(y))));
- case T_REAL: return(make_boolean(sc, real(x) == real(y)));
- case T_COMPLEX: return(make_boolean(sc, (real_part(x) == real_part(y)) && (imag_part(x) == imag_part(y))));
- }
- }
+ if (!s7_is_integer(x))
+ method_or_bust(sc, x, sc->logbit_symbol, args, T_INTEGER, 1);
+ if (!s7_is_integer(y))
+ method_or_bust(sc, y, sc->logbit_symbol, args, T_INTEGER, 2);
+
+ index = s7_integer(y);
+ if (index < 0)
+ return(out_of_range(sc, sc->logbit_symbol, small_int(2), y, its_negative_string));
+
+#if WITH_GMP
+ if (is_t_big_integer(x))
+ return(make_boolean(sc, (mpz_tstbit(big_integer(x), index) != 0)));
#endif
- return(c_equal_2_1(sc, x, y));
-}
-#if (!WITH_GMP)
-static s7_pointer equal_i2(s7_scheme *sc, s7_pointer **p)
-{
- s7_if_t f;
- s7_int x, y;
- f = (s7_if_t)(**p); (*p)++; x = f(sc, p);
- f = (s7_if_t)(**p); (*p)++; y = f(sc, p);
- return(make_boolean(sc, x == y));
-}
+ if (index >= s7_int_bits) /* not sure about the >: (logbit? -1 64) ?? */
+ return(make_boolean(sc, integer(x) < 0));
-static s7_pointer equal_i2_ic(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer x, y;
- (*p)++;
- x = slot_value(**p); (*p) += 2;
- y = (**p); (*p)++;
- if (!is_integer(x))
- return(c_equal_2_1(sc, x, y));
- return(make_boolean(sc, integer(x) == integer(y)));
-}
+ /* :(zero? (logand most-positive-fixnum (ash 1 63)))
+ * -> ash argument 2, 63, is out of range (shift is too large)
+ * so logbit? has a wider range than the logand/ash shuffle above.
+ */
-static s7_pointer equal_i2_ii(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer x, y;
- (*p)++;
- x = slot_value(**p); (*p) += 2;
- y = slot_value(**p); (*p)++;
- if (!is_integer(x))
- return(c_equal_2_1(sc, x, y));
- return(make_boolean(sc, integer(x) == integer(y)));
+ /* all these long long ints are necessary, else C turns it into an int, gets confused about signs etc */
+ return(make_boolean(sc, ((((long long int)(1LL << (long long int)index)) & (long long int)integer(x)) != 0)));
}
-static s7_pointer equal_r2(s7_scheme *sc, s7_pointer **p)
+static bool logbit_b_ii(s7_int i1, s7_int i2)
{
- s7_rf_t f;
- s7_double x, y;
- f = (s7_rf_t)(**p); (*p)++; x = f(sc, p);
- f = (s7_rf_t)(**p); (*p)++; y = f(sc, p);
- return(make_boolean(sc, x == y));
+ if (i2 < 0)
+ simple_out_of_range(cur_sc, cur_sc->logbit_symbol, make_integer(cur_sc, i2), its_negative_string);
+ if (i1 >= s7_int_bits)
+ return(i1 < 0);
+ return((((long long int)(1LL << i2)) & i1) != 0);
}
-static s7_pointer equal_p2(s7_scheme *sc, s7_pointer **p)
-{
- s7_pf_t f;
- s7_pointer x, y;
- f = (s7_pf_t)(**p); (*p)++; x = f(sc, p);
- f = (s7_pf_t)(**p); (*p)++; y = f(sc, p);
- return(c_equal_2(sc, x, y));
-}
-static s7_pf_t equal_pf(s7_scheme *sc, s7_pointer expr)
+/* -------------------------------- ash -------------------------------- */
+static s7_int c_ash(s7_scheme *sc, s7_int arg1, s7_int arg2)
{
- if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))))
+ if (arg1 == 0) return(0);
+
+ if (arg2 >= s7_int_bits)
+ out_of_range(sc, sc->ash_symbol, small_int(2), make_integer(sc, arg2), its_too_large_string);
+
+ if (arg2 < -s7_int_bits)
+ {
+ if (arg1 < 0) /* (ash -31 -100) */
+ return(-1);
+ return(0);
+ }
+
+ /* I can't see any point in protecting this: (ash 9223372036854775807 1) -> -2, but anyone using ash must know something about bits */
+ if (arg2 >= 0)
{
- ptr_int loc;
- s7_pointer a1, a2;
- a1 = cadr(expr);
- a2 = caddr(expr);
- loc = rc_loc(sc);
- if ((s7_arg_to_if(sc, cadr(expr))) && (s7_arg_to_if(sc, caddr(expr))))
+ if (arg1 < 0)
{
- if (is_symbol(a1))
- {
- if (is_integer(a2)) return(equal_i2_ic);
- if (is_symbol(a2)) return(equal_i2_ii);
- }
- return(equal_i2);
+ unsigned long long int z;
+ z = (unsigned long long int)arg1;
+ return((s7_int)(z << arg2));
}
- sc->cur_rf->cur = rc_go(sc, loc);
- if ((s7_arg_to_rf(sc, cadr(expr))) && (s7_arg_to_rf(sc, caddr(expr)))) return(equal_r2);
- sc->cur_rf->cur = rc_go(sc, loc);
- if ((s7_arg_to_pf(sc, cadr(expr))) && (s7_arg_to_pf(sc, caddr(expr)))) return(equal_p2);
+ return(arg1 << arg2);
}
- return(NULL);
+ return(arg1 >> -arg2);
}
-
-static s7_pointer g_less(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_ash(s7_scheme *sc, s7_pointer args)
{
- #define H_less "(< x1 ...) returns #t if its arguments are in increasing order"
- #define Q_less s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_real_symbol)
-
- s7_pointer x, y, p;
+ #define H_ash "(ash i1 i2) returns i1 shifted right or left i2 times, i1 << i2, (ash 1 3) -> 8, (ash 8 -3) -> 1"
+ #define Q_ash pcl_i
+ s7_pointer x, y;
x = car(args);
- p = cdr(args);
+ if (!s7_is_integer(x))
+ method_or_bust(sc, x, sc->ash_symbol, args, T_INTEGER, 1);
- switch (type(x))
- {
- case T_INTEGER:
- INTEGER_LESS:
- y = car(p);
- p = cdr(p);
- switch (type(y))
- {
- case T_INTEGER:
- if (integer(x) >= integer(y)) goto NOT_LESS;
- if (is_null(p)) return(sc->T);
- x = y;
- goto INTEGER_LESS;
+ y = cadr(args);
+ if (!s7_is_integer(y))
+ method_or_bust(sc, y, sc->ash_symbol, args, T_INTEGER, 2);
- case T_RATIO:
- /* no gmp here, but this can overflow: (< 9223372036 1/9223372036), but conversion to real is also problematic
- */
- if ((integer(x) >= 0) && (numerator(y) < 0)) goto NOT_LESS; /* (< 1 -1/2), ratio numerator can't be 0 */
- if ((integer(x) <= 0) && (numerator(y) > 0)) /* (< 0 1/2) */
- {
- if (is_null(p)) return(sc->T);
- x = y;
- goto RATIO_LESS;
- }
- if ((integer(x) < s7_int32_max) &&
- (integer(x) > s7_int32_min) &&
- (denominator(y) < s7_int32_max))
- {
- if ((integer(x) * denominator(y)) >= numerator(y)) goto NOT_LESS;
- }
- else
- {
- if (integer(x) >= fraction(y)) goto NOT_LESS;
- }
- if (is_null(p)) return(sc->T);
- x = y;
- goto RATIO_LESS;
+ return(make_integer(sc, c_ash(sc, s7_integer(x), s7_integer(y))));
+}
- case T_REAL:
- if (is_NaN(real(y))) goto NOT_LESS;
- if (integer(x) >= real(y)) goto NOT_LESS;
- if (is_null(p)) return(sc->T);
- x = y;
- goto REAL_LESS;
+static s7_int ash_i_ii(s7_int i1, s7_int i2) {return(c_ash(cur_sc, i1, i2));}
- default:
- method_or_bust(sc, y, sc->lt_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
- }
+/* ---------------------------------------- random ---------------------------------------- */
- case T_RATIO:
- RATIO_LESS:
- y = car(p);
- p = cdr(p);
- switch (type(y))
- {
- case T_INTEGER:
- if ((numerator(x) > 0) && (integer(y) <= 0)) goto NOT_LESS;
- if ((numerator(x) < 0) && (integer(y) >= 0))
- {
- if (is_null(p)) return(sc->T);
- x = y;
- goto INTEGER_LESS;
- }
- if ((integer(y) < s7_int32_max) &&
- (integer(y) > s7_int32_min) &&
- (denominator(x) < s7_int32_max))
- {
- if (numerator(x) >= (integer(y) * denominator(x))) goto NOT_LESS;
- }
- else
- {
- if (fraction(x) >= integer(y)) goto NOT_LESS;
- }
- if (is_null(p)) return(sc->T);
- x = y;
- goto INTEGER_LESS;
+/* random numbers. The simple version used in clm.c is probably adequate,
+ * but here I'll use Marsaglia's MWC algorithm.
+ * (random num) -> a number (0..num), if num == 0 return 0, use global default state
+ * (random num state) -> same but use this state
+ * (random-state seed) -> make a new state
+ * to save the current seed, use copy
+ * to save it across load, random-state->list and list->random-state.
+ * random-state? returns #t if its arg is one of these guys
+ */
- case T_RATIO:
- /* conversion to real and >= is not safe here (see comment under g_greater) */
- {
- s7_int d1, d2, n1, n2;
- d1 = denominator(x);
- n1 = numerator(x);
- d2 = denominator(y);
- n2 = numerator(y);
- if (d1 == d2)
- {
- if (n1 >= n2) goto NOT_LESS;
- }
- else
- {
-#if HAVE_OVERFLOW_CHECKS
- if ((multiply_overflow(n1, d2, &n1)) ||
- (multiply_overflow(n2, d1, &n2)))
- {
- if (fraction(x) >= fraction(y)) goto NOT_LESS;
- }
- else
- {
- if (n1 >= n2) goto NOT_LESS;
- }
-#else
- if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
- (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
- (n1 < s7_int32_min) || (n2 < s7_int32_min))
- {
- int d1bits, d2bits;
- d1bits = integer_length(d1);
- d2bits = integer_length(d2);
- if (((d1bits + d2bits) > s7_int_bits) ||
- ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
- ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
- {
- if (fraction(x) >= fraction(y)) goto NOT_LESS;
-
- /* (< 21053343141/6701487259 3587785776203/1142027682075) -> #f because even long doubles aren't enough here
- * (= 21053343141/6701487259 3587785776203/1142027682075) is #f because it checks the actual ints and
- * (> 21053343141/6701487259 3587785776203/1142027682075) is #f just like the < case.
- * similarly
- * (min 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
- * (max 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
- *
- * if we print the long double results as integers, both are -3958705157555305931
- * so there's not a lot I can do in the non-gmp case.
- */
- }
- else
- {
- if ((n1 * d2) >= (n2 * d1)) goto NOT_LESS;
- }
- }
- else
- {
- if ((n1 * d2) >= (n2 * d1)) goto NOT_LESS;
- }
-#endif
- }
- }
- if (is_null(p)) return(sc->T);
- x = y;
- goto RATIO_LESS;
+#if (!WITH_GMP)
+s7_pointer s7_random_state(s7_scheme *sc, s7_pointer args)
+{
+ #define H_random_state "(random-state seed (carry plausible-default)) returns a new random number state initialized with 'seed'. \
+Pass this as the second argument to 'random' to get a repeatable random number sequence:\n\
+ (let ((seed (random-state 1234))) (random 1.0 seed))"
+ #define Q_random_state s7_make_circular_signature(sc, 1, 2, sc->is_random_state_symbol, sc->is_integer_symbol)
- case T_REAL:
- if (is_NaN(real(y))) goto NOT_LESS;
- if (fraction(x) >= real(y)) goto NOT_LESS;
- if (is_null(p)) return(sc->T);
- x = y;
- goto REAL_LESS;
+ s7_pointer r1, r2, p;
+ s7_int i1, i2;
- default:
- method_or_bust(sc, y, sc->lt_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
- }
+ r1 = car(args);
+ if (!s7_is_integer(r1))
+ method_or_bust(sc, r1, sc->random_state_symbol, args, T_INTEGER, 1);
+ i1 = s7_integer(r1);
+ if (i1 < 0)
+ return(out_of_range(sc, sc->random_state_symbol, small_int(1), r1, its_negative_string));
+
+ if (is_null(cdr(args)))
+ {
+ new_cell(sc, p, T_RANDOM_STATE);
+ random_seed(p) = (unsigned long long int)i1;
+ random_carry(p) = 1675393560; /* should this be dependent on the seed? */
+ return(p);
+ }
+ r2 = cadr(args);
+ if (!s7_is_integer(r2))
+ method_or_bust(sc, r2, sc->random_state_symbol, args, T_INTEGER, 2);
+ i2 = s7_integer(r2);
+ if (i2 < 0)
+ return(out_of_range(sc, sc->random_state_symbol, small_int(2), r2, its_negative_string));
- case T_REAL:
- if (is_NaN(real(x))) goto NOT_LESS;
+ new_cell(sc, p, T_RANDOM_STATE);
+ random_seed(p) = (unsigned long long int)i1;
+ random_carry(p) = (unsigned long long int)i2;
+ return(p);
+}
- REAL_LESS:
- y = car(p);
- p = cdr(p);
- switch (type(y))
- {
- case T_INTEGER:
- if (real(x) >= integer(y)) goto NOT_LESS;
- if (is_null(p)) return(sc->T);
- x = y;
- goto INTEGER_LESS;
+#define g_random_state s7_random_state
+#endif
- case T_RATIO:
- if (real(x) >= fraction(y)) goto NOT_LESS;
- if (is_null(p)) return(sc->T);
- x = y;
- goto RATIO_LESS;
+static s7_pointer rng_copy(s7_scheme *sc, s7_pointer args)
+{
+#if WITH_GMP
+ return(sc->F); /* I can't find a way to copy a gmp random generator */
+#else
+ s7_pointer obj;
+ obj = car(args);
+ if (is_random_state(obj))
+ {
+ s7_pointer new_r;
+ new_cell(sc, new_r, T_RANDOM_STATE);
+ random_seed(new_r) = random_seed(obj);
+ random_carry(new_r) = random_carry(obj);
+ return(new_r);
+ }
+ return(sc->F);
+#endif
+}
- case T_REAL:
- if (is_NaN(real(y))) goto NOT_LESS;
- if (real(x) >= real(y)) goto NOT_LESS;
- if (is_null(p)) return(sc->T);
- x = y;
- 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);
- }
+static s7_pointer g_is_random_state(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_random_state "(random-state? obj) returns #t if obj is a random-state object (from random-state)."
+ #define Q_is_random_state pl_bt
+ check_boolean_method(sc, is_random_state, sc->is_random_state_symbol, args);
+}
- default:
- method_or_bust(sc, x, sc->lt_symbol, args, T_REAL, 1);
+static bool is_random_state_b(s7_pointer p) {return(type(p) == T_RANDOM_STATE);}
+
+s7_pointer s7_random_state_to_list(s7_scheme *sc, s7_pointer args)
+{
+ #define H_random_state_to_list "(random-state->list r) returns the random state object as a list.\
+You can later apply random-state to this list to continue a random number sequence from any point."
+ #define Q_random_state_to_list s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_random_state_symbol)
+
+#if WITH_GMP
+ if ((is_pair(args)) &&
+ (!is_random_state(car(args))))
+ method_or_bust_with_type(sc, car(args), sc->random_state_to_list_symbol, args, a_random_state_object_string, 1);
+ return(sc->nil);
+#else
+ s7_pointer r;
+ if (is_null(args))
+ r = sc->default_rng;
+ else
+ {
+ r = car(args);
+ if (!is_random_state(r))
+ method_or_bust_with_type(sc, r, sc->random_state_to_list_symbol, args, a_random_state_object_string, 1);
}
+ return(list_2(sc, make_integer(sc, random_seed(r)), make_integer(sc, random_carry(r))));
+#endif
+}
- NOT_LESS:
- for (; is_pair(p); p = cdr(p))
- if (!is_real_via_method(sc, car(p)))
- return(wrong_type_argument(sc, sc->lt_symbol, position_of(p, args), car(p), T_REAL));
+#define g_random_state_to_list s7_random_state_to_list
- return(sc->F);
+void s7_set_default_random_state(s7_scheme *sc, s7_int seed, s7_int carry)
+{
+#if (!WITH_GMP)
+ s7_pointer p;
+ new_cell(sc, p, T_RANDOM_STATE);
+ random_seed(p) = (unsigned long long int)seed;
+ random_carry(p) = (unsigned long long int)carry;
+ sc->default_rng = p;
+#endif
}
+#if (!WITH_GMP)
+/* -------------------------------- random -------------------------------- */
-static s7_pointer g_less_or_equal(s7_scheme *sc, s7_pointer args)
+static double next_random(s7_pointer r)
{
- #define H_less_or_equal "(<= x1 ...) returns #t if its arguments are in increasing order"
- #define Q_less_or_equal s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_real_symbol)
+ /* The multiply-with-carry generator for 32-bit integers:
+ * x(n)=a*x(n-1) + carry mod 2^32
+ * Choose multiplier a from this list:
+ * 1791398085 1929682203 1683268614 1965537969 1675393560
+ * 1967773755 1517746329 1447497129 1655692410 1606218150
+ * 2051013963 1075433238 1557985959 1781943330 1893513180
+ * 1631296680 2131995753 2083801278 1873196400 1554115554
+ * ( or any 'a' for which both a*2^32-1 and a*2^31-1 are prime)
+ */
+ double result;
+ unsigned long long int temp;
+ #define RAN_MULT 2131995753UL
- s7_pointer x, y, p;
+ temp = random_seed(r) * RAN_MULT + random_carry(r);
+ random_seed(r) = (temp & 0xffffffffUL);
+ random_carry(r) = (temp >> 32);
+ result = (double)((unsigned int)(random_seed(r))) / 4294967295.5;
+ /* divisor was 2^32-1 = 4294967295.0, but somehow this can round up once in a billion tries?
+ * do we want the double just less than 2^32?
+ */
- x = car(args);
- p = cdr(args);
+ /* (let ((mx 0) (mn 1000)) (do ((i 0 (+ i 1))) ((= i 10000)) (let ((val (random 123))) (set! mx (max mx val)) (set! mn (min mn val)))) (list mn mx)) */
+ return(result);
+}
- switch (type(x))
- {
- case T_INTEGER:
- INTEGER_LEQ:
- y = car(p);
- p = cdr(p);
- switch (type(y))
- {
- case T_INTEGER:
- if (integer(x) > integer(y)) goto NOT_LEQ;
- if (is_null(p)) return(sc->T);
- x = y;
- goto INTEGER_LEQ;
- case T_RATIO:
- /* no gmp here, but this can overflow: (< 9223372036 1/9223372036), but conversion to real is also problematic
- */
- if ((integer(x) >= 0) && (numerator(y) < 0)) goto NOT_LEQ; /* (< 1 -1/2), ratio numerator can't be 0 */
- if ((integer(x) <= 0) && (numerator(y) > 0)) /* (< 0 1/2) */
- {
- if (is_null(p)) return(sc->T);
- x = y;
- goto RATIO_LEQ;
- }
- if ((integer(x) < s7_int32_max) &&
- (integer(x) > s7_int32_min) &&
- (denominator(y) < s7_int32_max))
- {
- if ((integer(x) * denominator(y)) > numerator(y)) goto NOT_LEQ;
- }
- else
- {
- if (integer(x) > fraction(y)) goto NOT_LEQ;
- }
- if (is_null(p)) return(sc->T);
- x = y;
- goto RATIO_LEQ;
+s7_double s7_random(s7_scheme *sc, s7_pointer state)
+{
+ if (!state)
+ return(next_random(sc->default_rng));
+ return(next_random(state));
+}
- case T_REAL:
- if (is_NaN(real(y))) goto NOT_LEQ;
- if (integer(x) > real(y)) goto NOT_LEQ;
- if (is_null(p)) return(sc->T);
- x = y;
- 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);
- }
+static s7_pointer g_random(s7_scheme *sc, s7_pointer args)
+{
+ #define H_random "(random num (state #f)) returns a random number between 0 and num (0 if num=0)."
+ #define Q_random s7_make_signature(sc, 3, sc->is_number_symbol, sc->is_number_symbol, sc->is_random_state_symbol)
+ s7_pointer r, num;
+ num = car(args);
+ if (!s7_is_number(num))
+ method_or_bust_with_type(sc, num, sc->random_symbol, args, a_number_string, 1);
- case T_RATIO:
- RATIO_LEQ:
- y = car(p);
- p = cdr(p);
- switch (type(y))
- {
- case T_INTEGER:
- if ((numerator(x) > 0) && (integer(y) <= 0)) goto NOT_LEQ;
- if ((numerator(x) < 0) && (integer(y) >= 0))
- {
- if (is_null(p)) return(sc->T);
- x = y;
- goto INTEGER_LEQ;
- }
- if ((integer(y) < s7_int32_max) &&
- (integer(y) > s7_int32_min) &&
- (denominator(x) < s7_int32_max))
- {
- if (numerator(x) > (integer(y) * denominator(x))) goto NOT_LEQ;
- }
- else
- {
- if (fraction(x) > integer(y)) goto NOT_LEQ;
- }
- if (is_null(p)) return(sc->T);
- x = y;
- goto INTEGER_LEQ;
+ if (is_not_null(cdr(args)))
+ {
+ r = cadr(args);
+ if (!is_random_state(r))
+ method_or_bust_with_type(sc, r, sc->random_symbol, args, a_random_state_object_string, 2);
+ }
+ else r = sc->default_rng;
- case T_RATIO:
+ switch (type(num))
+ {
+ case T_INTEGER:
+ return(make_integer(sc, (s7_int)(integer(num) * next_random(r))));
+
+ case T_RATIO:
+ {
+ s7_double x, error;
+ s7_int numer = 0, denom = 1;
+ /* the error here needs to take the size of the fraction into account. Otherwise, if
+ * error is (say) 1e-6 and the fraction is (say) 9000000/9223372036854775807,
+ * c_rationalize will always return 0. But even that isn't foolproof:
+ * (random 1/562949953421312) -> 1/376367230475000
+ */
+ x = fraction(num);
+ if ((x < 1.0e-10) && (x > -1.0e-10))
{
- s7_int d1, d2, n1, n2;
- d1 = denominator(x);
- n1 = numerator(x);
- d2 = denominator(y);
- n2 = numerator(y);
- if (d1 == d2)
- {
- if (n1 > n2) goto NOT_LEQ;
- }
+ /* 1e-12 is not tight enough:
+ * (random 1/2251799813685248) -> 1/2250240579436280
+ * (random -1/4503599627370496) -> -1/4492889778435526
+ * (random 1/140737488355328) -> 1/140730223985746
+ * (random -1/35184372088832) -> -1/35183145492420
+ * (random -1/70368744177664) -> -1/70366866392738
+ * (random 1/4398046511104) -> 1/4398033095756
+ * (random 1/137438953472) -> 1/137438941127
+ */
+ if (numerator(num) < -10)
+ numer = -(s7_int)(floor(-numerator(num) * next_random(r)));
else
{
-#if HAVE_OVERFLOW_CHECKS
- if ((multiply_overflow(n1, d2, &n1)) ||
- (multiply_overflow(n2, d1, &n2)))
- {
- if (fraction(x) > fraction(y)) goto NOT_LEQ;
- }
- else
- {
- if (n1 > n2) goto NOT_LEQ;
- }
-#else
- if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
- (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
- (n1 < s7_int32_min) || (n2 < s7_int32_min))
- {
- int d1bits, d2bits;
- d1bits = integer_length(d1);
- d2bits = integer_length(d2);
- if (((d1bits + d2bits) > s7_int_bits) ||
- ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
- ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
- {
- if (fraction(x) > fraction(y)) goto NOT_LEQ;
- }
- else
- {
- if ((n1 * d2) > (n2 * d1)) goto NOT_LEQ;
- }
- }
+ if (numerator(num) > 10)
+ numer = (s7_int)floor(numerator(num) * next_random(r));
else
{
- if ((n1 * d2) > (n2 * d1)) goto NOT_LEQ;
+ long long int diff;
+ numer = numerator(num);
+ diff = s7_int_max - denominator(num);
+ if (diff < 100)
+ return(s7_make_ratio(sc, numer, denominator(num)));
+ denom = denominator(num) + (s7_int)floor(diff * next_random(r));
+ return(s7_make_ratio(sc, numer, denom));
}
-#endif
}
+ return(s7_make_ratio(sc, numer, denominator(num)));
}
- if (is_null(p)) return(sc->T);
- x = y;
- goto RATIO_LEQ;
-
- case T_REAL:
- if (is_NaN(real(y))) goto NOT_LEQ;
- if (fraction(x) > real(y)) goto NOT_LEQ;
- if (is_null(p)) return(sc->T);
- x = y;
- 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);
- }
-
+ if ((x < 1e-6) && (x > -1e-6))
+ error = 1e-18;
+ else error = 1e-12;
+ c_rationalize(x * next_random(r), error, &numer, &denom);
+ return(s7_make_ratio(sc, numer, denom));
+ }
case T_REAL:
- if (is_NaN(real(x))) goto NOT_LEQ;
-
- REAL_LEQ:
- y = car(p);
- p = cdr(p);
- switch (type(y))
- {
- case T_INTEGER:
- if (real(x) > integer(y)) goto NOT_LEQ;
- if (is_null(p)) return(sc->T);
- x = y;
- goto INTEGER_LEQ;
-
- case T_RATIO:
- if (real(x) > fraction(y)) goto NOT_LEQ;
- if (is_null(p)) return(sc->T);
- x = y;
- goto RATIO_LEQ;
-
- case T_REAL:
- if (is_NaN(real(y))) goto NOT_LEQ;
- if (real(x) > real(y)) goto NOT_LEQ;
- if (is_null(p)) return(sc->T);
- x = y;
- 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);
- }
+ return(make_real(sc, real(num) * next_random(r)));
- default:
- method_or_bust(sc, x, sc->leq_symbol, args, T_REAL, 1);
+ case T_COMPLEX:
+ return(s7_make_complex(sc, real_part(num) * next_random(r), imag_part(num) * next_random(r)));
}
+ return(sc->F);
+}
- NOT_LEQ:
- for (; is_pair(p); p = cdr(p))
- if (!is_real_via_method(sc, car(p)))
- return(wrong_type_argument(sc, sc->leq_symbol, position_of(p, args), car(p), T_REAL));
+static s7_double random_d_d(s7_double x)
+{
+ return(x * next_random(cur_sc->default_rng));
+}
- return(sc->F);
+static s7_int random_i_i(s7_int i)
+{
+ return((s7_int)(i * next_random(cur_sc->default_rng)));
+}
+
+static s7_pointer random_p_p(s7_pointer p)
+{
+ return(g_random(cur_sc, set_plist_1(cur_sc, p)));
}
+static s7_pointer random_ic, random_rc;
-static s7_pointer g_greater(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_random_ic(s7_scheme *sc, s7_pointer args)
{
- #define H_greater "(> x1 ...) returns #t if its arguments are in decreasing order"
- #define Q_greater s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_real_symbol)
+ return(make_integer(sc, (s7_int)(integer(car(args)) * next_random(sc->default_rng))));
+}
- s7_pointer x, y, p;
- x = car(args);
- p = cdr(args);
+static s7_pointer g_random_rc(s7_scheme *sc, s7_pointer args)
+{
+ return(make_real(sc, real(car(args)) * next_random(sc->default_rng)));
+}
- switch (type(x))
+static s7_pointer random_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
+{
+ if (!ops) return(f);
+ if (args == 1)
{
- case T_INTEGER:
- INTEGER_GREATER:
- y = car(p);
- p = cdr(p);
- switch (type(y))
+ s7_pointer arg1;
+ arg1 = cadr(expr);
+ if (s7_is_integer(arg1))
{
- case T_INTEGER:
- if (integer(x) <= integer(y)) goto NOT_GREATER;
- if (is_null(p)) return(sc->T);
- x = y;
- goto INTEGER_GREATER;
-
- case T_RATIO:
- /* no gmp here, but this can overflow: (< 9223372036 1/9223372036), but conversion to real is also problematic
- */
- if ((integer(x) <= 0) && (numerator(y) > 0)) goto NOT_GREATER;
- if ((integer(x) >= 0) && (numerator(y) < 0))
- {
- if (is_null(p)) return(sc->T);
- x = y;
- goto RATIO_GREATER;
- }
- if ((integer(x) < s7_int32_max) &&
- (integer(x) > s7_int32_min) &&
- (denominator(y) < s7_int32_max))
- {
- if ((integer(x) * denominator(y)) <= numerator(y)) goto NOT_GREATER;
- }
- else
- {
- if (integer(x) <= fraction(y)) goto NOT_GREATER;
- }
- if (is_null(p)) return(sc->T);
- x = y;
- goto RATIO_GREATER;
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(random_ic);
+ }
+ if (is_float(arg1))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(random_rc);
+ }
+ }
+ return(f);
+}
+#endif /* gmp */
- case T_REAL:
- if (is_NaN(real(y))) goto NOT_GREATER;
- if (integer(x) <= real(y)) goto NOT_GREATER;
- if (is_null(p)) return(sc->T);
- x = y;
- 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);
- }
+/* -------------------------------- characters -------------------------------- */
- case T_RATIO:
- RATIO_GREATER:
- y = car(p);
- p = cdr(p);
- switch (type(y))
- {
- case T_INTEGER:
- if ((numerator(x) < 0) && (integer(y) >= 0)) goto NOT_GREATER;
- if ((numerator(x) > 0) && (integer(y) <= 0))
- {
- if (is_null(p)) return(sc->T);
- x = y;
- goto INTEGER_GREATER;
- }
- if ((integer(y) < s7_int32_max) &&
- (integer(y) > s7_int32_min) &&
- (denominator(x) < s7_int32_max))
- {
- if (numerator(x) <= (integer(y) * denominator(x))) goto NOT_GREATER;
- }
- else
- {
- if (fraction(x) <= integer(y)) goto NOT_GREATER;
- }
- if (is_null(p)) return(sc->T);
- x = y;
- goto INTEGER_GREATER;
+#define NUM_CHARS 256
- case T_RATIO:
- {
- s7_int d1, d2, n1, n2;
- d1 = denominator(x);
- n1 = numerator(x);
- d2 = denominator(y);
- n2 = numerator(y);
- if (d1 == d2)
- {
- if (n1 <= n2) goto NOT_GREATER;
- }
- else
- {
-#if HAVE_OVERFLOW_CHECKS
- if ((multiply_overflow(n1, d2, &n1)) ||
- (multiply_overflow(n2, d1, &n2)))
- {
- if (fraction(x) <= fraction(y)) goto NOT_GREATER;
- }
- else
- {
- if (n1 <= n2) goto NOT_GREATER;
- }
-#else
- if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
- (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
- (n1 < s7_int32_min) || (n2 < s7_int32_min))
- {
- int d1bits, d2bits;
- d1bits = integer_length(d1);
- d2bits = integer_length(d2);
- if (((d1bits + d2bits) > s7_int_bits) ||
- ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
- ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
- {
- if (fraction(x) <= fraction(y)) goto NOT_GREATER;
-
- /* (< 21053343141/6701487259 3587785776203/1142027682075) -> #f because even long doubles aren't enough here
- * (= 21053343141/6701487259 3587785776203/1142027682075) is #f because it checks the actual ints and
- * (> 21053343141/6701487259 3587785776203/1142027682075) is #f just like the < case.
- * similarly
- * (min 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
- * (max 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
- *
- * if we print the long double results as integers, both are -3958705157555305931
- * so there's not a lot I can do in the non-gmp case.
- */
- }
- else
- {
- if ((n1 * d2) <= (n2 * d1)) goto NOT_GREATER;
- }
- }
- else
- {
- if ((n1 * d2) <= (n2 * d1)) goto NOT_GREATER;
- }
-#endif
- }
- }
- if (is_null(p)) return(sc->T);
- x = y;
- goto RATIO_GREATER;
+static s7_pointer g_char_to_integer(s7_scheme *sc, s7_pointer args)
+{
+ #define H_char_to_integer "(char->integer c) converts the character c to an integer"
+ #define Q_char_to_integer s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_char_symbol)
- case T_REAL:
- if (is_NaN(real(y))) goto NOT_GREATER;
- if (fraction(x) <= real(y)) goto NOT_GREATER;
- if (is_null(p)) return(sc->T);
- x = y;
- goto REAL_GREATER;
+ if (!s7_is_character(car(args)))
+ method_or_bust_one_arg(sc, car(args), sc->char_to_integer_symbol, args, T_CHARACTER);
+ return(small_int(character(car(args))));
+}
- default:
- method_or_bust(sc, y, sc->gt_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
- }
+static s7_int char_to_integer_i(s7_pointer p)
+{
+ if (!s7_is_character(p))
+ simple_wrong_type_argument(cur_sc, cur_sc->char_to_integer_symbol, p, T_CHARACTER);
+ return(character(p));
+}
- case T_REAL:
- if (is_NaN(real(x))) goto NOT_GREATER;
+static s7_pointer g_integer_to_char(s7_scheme *sc, s7_pointer args)
+{
+ #define H_integer_to_char "(integer->char i) converts the non-negative integer i to a character"
+ #define Q_integer_to_char s7_make_signature(sc, 2, sc->is_char_symbol, sc->is_integer_symbol)
- REAL_GREATER:
- y = car(p);
- p = cdr(p);
- switch (type(y))
- {
- case T_INTEGER:
- if (real(x) <= integer(y)) goto NOT_GREATER;
- if (is_null(p)) return(sc->T);
- x = y;
- goto INTEGER_GREATER;
+ s7_pointer x;
+ s7_int ind;
- case T_RATIO:
- if (real(x) <= fraction(y)) goto NOT_GREATER;
- if (is_null(p)) return(sc->T);
- x = y;
- goto RATIO_GREATER;
+ x = car(args);
+ if (!s7_is_integer(x))
+ method_or_bust_one_arg(sc, x, sc->integer_to_char_symbol, list_1(sc, x), T_INTEGER);
+ ind = s7_integer(x);
+ if ((ind < 0) || (ind >= NUM_CHARS))
+ return(simple_wrong_type_argument_with_type(sc, sc->integer_to_char_symbol, x, make_string_wrapper(sc, "an integer that can represent a character")));
+ return(s7_make_character(sc, (unsigned char)ind));
+}
- case T_REAL:
- if (is_NaN(real(y))) goto NOT_GREATER;
- if (real(x) <= real(y)) goto NOT_GREATER;
- if (is_null(p)) return(sc->T);
- x = y;
- goto REAL_GREATER;
+static s7_pointer integer_to_char_p_p(s7_pointer x)
+{
+ s7_int ind;
+ if (!s7_is_integer(x))
+ simple_wrong_type_argument(cur_sc, cur_sc->integer_to_char_symbol, x, T_INTEGER);
+ ind = s7_integer(x);
+ if ((ind < 0) || (ind >= NUM_CHARS))
+ return(simple_wrong_type_argument_with_type(cur_sc, cur_sc->integer_to_char_symbol, x, make_string_wrapper(cur_sc, "an integer that can represent a character")));
+ return(s7_make_character(cur_sc, (unsigned char)ind));
+}
- default:
- method_or_bust(sc, y, sc->gt_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
- }
- default:
- method_or_bust(sc, x, sc->gt_symbol, args, T_REAL, 1);
+static unsigned char uppers[256], lowers[256];
+static void init_uppers(void)
+{
+ int i;
+ for (i = 0; i < 256; i++)
+ {
+ uppers[i] = (unsigned char)toupper(i);
+ lowers[i] = (unsigned char)tolower(i);
}
+}
- NOT_GREATER:
- for (; is_pair(p); p = cdr(p))
- if (!is_real_via_method(sc, car(p)))
- return(wrong_type_argument(sc, sc->gt_symbol, position_of(p, args), car(p), T_REAL));
-
- return(sc->F);
+static s7_pointer g_char_upcase(s7_scheme *sc, s7_pointer args)
+{
+ #define H_char_upcase "(char-upcase c) converts the character c to upper case"
+ #define Q_char_upcase pcl_c
+ if (!s7_is_character(car(args)))
+ method_or_bust_one_arg(sc, car(args), sc->char_upcase_symbol, args, T_CHARACTER);
+ return(s7_make_character(sc, upper_character(car(args))));
}
+static s7_pointer g_char_downcase(s7_scheme *sc, s7_pointer args)
+{
+ #define H_char_downcase "(char-downcase c) converts the character c to lower case"
+ #define Q_char_downcase pcl_c
+ if (!s7_is_character(car(args)))
+ method_or_bust_one_arg(sc, car(args), sc->char_downcase_symbol, args, T_CHARACTER);
+ return(s7_make_character(sc, lowers[character(car(args))]));
+}
-static s7_pointer g_greater_or_equal(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_is_char_alphabetic(s7_scheme *sc, s7_pointer args)
{
- #define H_greater_or_equal "(>= x1 ...) returns #t if its arguments are in decreasing order"
- #define Q_greater_or_equal s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_real_symbol)
- /* (>= 1+i 1+i) is an error which seems unfortunate */
- s7_pointer x, y, p;
+ #define H_is_char_alphabetic "(char-alphabetic? c) returns #t if the character c is alphabetic"
+ #define Q_is_char_alphabetic pl_bc
+ if (!s7_is_character(car(args)))
+ method_or_bust_one_arg(sc, car(args), sc->is_char_alphabetic_symbol, args, T_CHARACTER);
+ return(make_boolean(sc, is_char_alphabetic(car(args))));
- x = car(args);
- p = cdr(args);
+ /* isalpha returns #t for (integer->char 226) and others in that range */
+}
- switch (type(x))
- {
- case T_INTEGER:
- INTEGER_GEQ:
- y = car(p);
- p = cdr(p);
- switch (type(y))
- {
- case T_INTEGER:
- if (integer(x) < integer(y)) goto NOT_GEQ;
- if (is_null(p)) return(sc->T);
- x = y;
- goto INTEGER_GEQ;
+static bool is_char_alphabetic_b(s7_pointer c) {return((s7_is_character(c)) && (is_char_alphabetic(c)));}
- case T_RATIO:
- /* no gmp here, but this can overflow: (< 9223372036 1/9223372036), but conversion to real is also problematic
- */
- if ((integer(x) <= 0) && (numerator(y) > 0)) goto NOT_GEQ;
- if ((integer(x) >= 0) && (numerator(y) < 0))
- {
- if (is_null(p)) return(sc->T);
- x = y;
- goto RATIO_GEQ;
- }
- if ((integer(x) < s7_int32_max) &&
- (integer(x) > s7_int32_min) &&
- (denominator(y) < s7_int32_max))
- {
- if ((integer(x) * denominator(y)) < numerator(y)) goto NOT_GEQ;
- }
- else
- {
- if (integer(x) < fraction(y)) goto NOT_GEQ;
- }
- if (is_null(p)) return(sc->T);
- x = y;
- goto RATIO_GEQ;
- case T_REAL:
- if (is_NaN(real(y))) goto NOT_GEQ;
- if (integer(x) < real(y)) goto NOT_GEQ;
- if (is_null(p)) return(sc->T);
- x = y;
- goto REAL_GEQ;
+static s7_pointer g_is_char_numeric(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer arg;
+ #define H_is_char_numeric "(char-numeric? c) returns #t if the character c is a digit"
+ #define Q_is_char_numeric pl_bc
- default:
- method_or_bust(sc, y, sc->geq_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
- }
+ arg = car(args);
+ if (!s7_is_character(arg))
+ method_or_bust_one_arg(sc, arg, sc->is_char_numeric_symbol, set_plist_1(sc, arg), T_CHARACTER);
+ return(make_boolean(sc, is_char_numeric(arg)));
+}
+static bool is_char_numeric_b(s7_pointer c) {return((s7_is_character(c)) && (is_char_numeric(c)));}
- case T_RATIO:
- RATIO_GEQ:
- y = car(p);
- p = cdr(p);
- switch (type(y))
- {
- case T_INTEGER:
- if ((numerator(x) < 0) && (integer(y) >= 0)) goto NOT_GEQ;
- if ((numerator(x) > 0) && (integer(y) <= 0))
- {
- if (is_null(p)) return(sc->T);
- x = y;
- goto INTEGER_GEQ;
- }
- if ((integer(y) < s7_int32_max) &&
- (integer(y) > s7_int32_min) &&
- (denominator(x) < s7_int32_max))
- {
- if (numerator(x) < (integer(y) * denominator(x))) goto NOT_GEQ;
- }
- else
- {
- if (fraction(x) < integer(y)) goto NOT_GEQ;
- }
- if (is_null(p)) return(sc->T);
- x = y;
- goto INTEGER_GEQ;
- case T_RATIO:
- {
- s7_int d1, d2, n1, n2;
- d1 = denominator(x);
- n1 = numerator(x);
- d2 = denominator(y);
- n2 = numerator(y);
- if (d1 == d2)
- {
- if (n1 < n2) goto NOT_GEQ;
- }
- else
- {
-#if HAVE_OVERFLOW_CHECKS
- if ((multiply_overflow(n1, d2, &n1)) ||
- (multiply_overflow(n2, d1, &n2)))
- {
- if (fraction(x) < fraction(y)) goto NOT_GEQ;
- }
- else
- {
- if (n1 < n2) goto NOT_GEQ;
- }
-#else
- if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
- (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
- (n1 < s7_int32_min) || (n2 < s7_int32_min))
- {
- int d1bits, d2bits;
- d1bits = integer_length(d1);
- d2bits = integer_length(d2);
- if (((d1bits + d2bits) > s7_int_bits) ||
- ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
- ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
- {
- if (fraction(x) < fraction(y)) goto NOT_GEQ;
- }
- else
- {
- if ((n1 * d2) < (n2 * d1)) goto NOT_GEQ;
- }
- }
- else
- {
- if ((n1 * d2) < (n2 * d1)) goto NOT_GEQ;
- }
-#endif
- }
- }
- if (is_null(p)) return(sc->T);
- x = y;
- goto RATIO_GEQ;
+static s7_pointer g_is_char_whitespace(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer arg;
+ #define H_is_char_whitespace "(char-whitespace? c) returns #t if the character c is non-printing character"
+ #define Q_is_char_whitespace pl_bc
- case T_REAL:
- if (is_NaN(real(y))) goto NOT_GEQ;
- if (fraction(x) < real(y)) goto NOT_GEQ;
- if (is_null(p)) return(sc->T);
- x = y;
- goto REAL_GEQ;
+ arg = car(args);
+ if (!s7_is_character(arg))
+ method_or_bust_one_arg(sc, arg, sc->is_char_whitespace_symbol, set_plist_1(sc, arg), T_CHARACTER);
+ return(make_boolean(sc, is_char_whitespace(arg)));
+}
- default:
- method_or_bust(sc, y, sc->geq_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
- }
+static bool is_char_whitespace_b(s7_pointer c) {return((s7_is_character(c)) && (is_char_whitespace(c)));}
- case T_REAL:
- if (is_NaN(real(x))) goto NOT_GEQ;
+static s7_pointer g_is_char_upper_case(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer arg;
+ #define H_is_char_upper_case "(char-upper-case? c) returns #t if the character c is in upper case"
+ #define Q_is_char_upper_case pl_bc
+
+ arg = car(args);
+ if (!s7_is_character(arg))
+ method_or_bust_one_arg(sc, arg, sc->is_char_upper_case_symbol, set_plist_1(sc, arg), T_CHARACTER);
+ return(make_boolean(sc, is_char_uppercase(arg)));
+}
- REAL_GEQ:
- y = car(p);
- p = cdr(p);
- switch (type(y))
- {
- case T_INTEGER:
- if (real(x) < integer(y)) goto NOT_GEQ;
- if (is_null(p)) return(sc->T);
- x = y;
- goto INTEGER_GEQ;
+static bool is_char_upper_case_b(s7_pointer c)
+{
+ if (!s7_is_character(c))
+ simple_wrong_type_argument(cur_sc, cur_sc->is_char_upper_case_symbol, c, T_CHARACTER);
+ return(is_char_uppercase(c));
+}
- case T_RATIO:
- if (real(x) < fraction(y)) goto NOT_GEQ;
- if (is_null(p)) return(sc->T);
- x = y;
- goto RATIO_GEQ;
- case T_REAL:
- if (is_NaN(real(y))) goto NOT_GEQ;
- if (real(x) < real(y)) goto NOT_GEQ;
- if (is_null(p)) return(sc->T);
- x = y;
- goto REAL_GEQ;
+static s7_pointer g_is_char_lower_case(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer arg;
+ #define H_is_char_lower_case "(char-lower-case? c) returns #t if the character c is in lower case"
+ #define Q_is_char_lower_case pl_bc
+
+ arg = car(args);
+ if (!s7_is_character(arg))
+ method_or_bust_one_arg(sc, arg, sc->is_char_lower_case_symbol, set_plist_1(sc, arg), T_CHARACTER);
+ return(make_boolean(sc, is_char_lowercase(arg)));
+}
- default:
- method_or_bust(sc, y, sc->geq_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
- }
+static bool is_char_lower_case_b(s7_pointer c)
+{
+ if (!s7_is_character(c))
+ simple_wrong_type_argument(cur_sc, cur_sc->is_char_lower_case_symbol, c, T_CHARACTER);
+ return(is_char_lowercase(c));
+}
- default:
- method_or_bust(sc, x, sc->geq_symbol, args, T_REAL, 1);
- }
- NOT_GEQ:
- for (; is_pair(p); p = cdr(p))
- if (!is_real_via_method(sc, car(p)))
- return(wrong_type_argument(sc, sc->geq_symbol, position_of(p, args), car(p), T_REAL));
+static s7_pointer g_is_char(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_char "(char? obj) returns #t if obj is a character"
+ #define Q_is_char pl_bt
+ check_boolean_method(sc, s7_is_character, sc->is_char_symbol, args);
+}
- return(sc->F);
+s7_pointer s7_make_character(s7_scheme *sc, unsigned int c)
+{
+ return(chars[c]);
}
-static s7_pointer less_s_ic, less_s0;
-static s7_pointer g_less_s0(s7_scheme *sc, s7_pointer args)
+bool s7_is_character(s7_pointer p)
{
- s7_pointer x;
- x = car(args);
- if (is_integer(x))
- return(make_boolean(sc, integer(x) < 0));
- if (is_real(x))
- return(make_boolean(sc, s7_is_negative(x)));
- method_or_bust(sc, x, sc->lt_symbol, args, T_REAL, 1);
+ return(type(p) == T_CHARACTER);
}
-static s7_pointer g_less_s_ic(s7_scheme *sc, s7_pointer args)
-{
- s7_int y;
- s7_pointer x;
- x = car(args);
- y = integer(cadr(args));
- if (is_integer(x))
- return(make_boolean(sc, integer(x) < y));
+char s7_character(s7_pointer p)
+{
+ return(character(p));
+}
- switch (type(x))
- {
- case T_INTEGER:
- return(make_boolean(sc, integer(x) < y));
- case T_RATIO:
- if ((y >= 0) && (numerator(x) < 0))
- return(sc->T);
- if ((y <= 0) && (numerator(x) > 0))
- return(sc->F);
- if (denominator(x) < s7_int32_max)
- return(make_boolean(sc, (numerator(x) < (y * denominator(x)))));
- return(make_boolean(sc, fraction(x) < y));
+static int charcmp(unsigned char c1, unsigned char c2)
+{
+ return((c1 == c2) ? 0 : (c1 < c2) ? -1 : 1);
+ /* not tolower here -- the single case is apparently supposed to be upper case
+ * this matters in a case like (char-ci<? #\_ #\e) which Guile and Gauche say is #f
+ * although (char<? #\_ #\e) is #t -- the spec does not say how to interpret this!
+ */
+}
- case T_REAL:
- return(make_boolean(sc, real(x) < y));
- case T_COMPLEX:
- default:
- method_or_bust(sc, x, sc->lt_symbol, args, T_REAL, 1);
+static bool is_character_via_method(s7_scheme *sc, s7_pointer p)
+{
+ if (s7_is_character(p))
+ return(true);
+ if (has_methods(p))
+ {
+ s7_pointer f;
+ f = find_method(sc, find_let(sc, p), sc->is_char_symbol);
+ if (f != sc->undefined)
+ return(is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->nil))));
}
- return(sc->T);
+ return(false);
}
-static s7_pointer less_length_ic;
-static s7_pointer g_less_length_ic(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer g_char_cmp(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
{
- s7_int ilen;
- s7_pointer val;
+ s7_pointer x, y;
- val = find_symbol_checked(sc, cadar(args));
- ilen = s7_integer(cadr(args));
+ y = car(args);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sym, args, T_CHARACTER, 1);
- switch (type(val))
+ for (x = cdr(args); is_pair(x); x = cdr(x))
{
- case T_PAIR: return(make_boolean(sc, s7_list_length(sc, val) < ilen));
- case T_NIL: return(make_boolean(sc, ilen > 0));
- 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_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:
- case T_VECTOR: return(make_boolean(sc, vector_length(val) < ilen));
- case T_CLOSURE:
- case T_CLOSURE_STAR: if (has_methods(val)) return(make_boolean(sc, closure_length(sc, val) < ilen));
- default: return(simple_wrong_type_argument_with_type(sc, sc->length_symbol, val, a_sequence_string)); /* no check method here because we checked above */
- }
- return(sc->F);
-}
-
-static s7_pointer c_less_2_1(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- switch (type(x))
- {
- case T_INTEGER:
- switch (type(y))
- {
- case T_INTEGER:
- return(make_boolean(sc, integer(x) < integer(y)));
-
- case T_RATIO:
- return(g_less(sc, list_2(sc, x, y)));
-
- case T_REAL:
- if (is_NaN(real(y))) return(sc->F);
- return(make_boolean(sc, integer(x) < real(y)));
-
- default:
- method_or_bust(sc, y, sc->lt_symbol, list_2(sc, x, y), T_REAL, 2);
- }
- break;
-
- case T_RATIO:
- return(g_less(sc, list_2(sc, x, y)));
+ if (!s7_is_character(car(x)))
+ method_or_bust(sc, car(x), sym, cons(sc, y, x), T_CHARACTER, position_of(x, args));
- case T_REAL:
- switch (type(y))
+ if (charcmp(character(y), character(car(x))) != val)
{
- case T_INTEGER:
- if (is_NaN(real(x))) return(sc->F);
- return(make_boolean(sc, real(x) < integer(y)));
-
- case T_RATIO:
- if (is_NaN(real(x))) return(sc->F);
- return(make_boolean(sc, real(x) < fraction(y)));
-
- case T_REAL:
- if (is_NaN(real(x))) return(sc->F);
- if (is_NaN(real(y))) return(sc->F);
- return(make_boolean(sc, real(x) < real(y)));
-
- default:
- method_or_bust(sc, y, sc->lt_symbol, list_2(sc, x, y), T_REAL, 2);
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_character_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_CHARACTER));
+ return(sc->F);
}
- break;
-
- default:
- method_or_bust(sc, x, sc->lt_symbol, list_2(sc, x, y), T_REAL, 1);
+ y = car(x);
}
return(sc->T);
}
-static s7_pointer c_less_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
-#if (!MS_WINDOWS)
- if (type(x) == type(y))
- {
- switch (type(x))
- {
- case T_INTEGER: return(make_boolean(sc, integer(x) < integer(y)));
- case T_RATIO: return(make_boolean(sc, fraction(x) < fraction(y)));
- case T_REAL: return(make_boolean(sc, real(x) < real(y)));
- }
- }
-#endif
- return(c_less_2_1(sc, x, y));
-}
-static s7_pointer less_2;
-static s7_pointer g_less_2(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_char_cmp_not(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
{
s7_pointer x, y;
- x = car(args);
- y = cadr(args);
+ y = car(args);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sym, args, T_CHARACTER, 1);
-#if (!MS_WINDOWS)
- if (type(x) == type(y))
+ for (x = cdr(args); is_pair(x); x = cdr(x))
{
- switch (type(x))
+ if (!s7_is_character(car(x)))
+ method_or_bust(sc, car(x), sym, cons(sc, y, x), T_CHARACTER, position_of(x, args));
+
+ if (charcmp(character(y), character(car(x))) == val)
{
- case T_INTEGER: return(make_boolean(sc, integer(x) < integer(y)));
- case T_RATIO: return(make_boolean(sc, fraction(x) < fraction(y)));
- case T_REAL: return(make_boolean(sc, real(x) < real(y)));
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_character_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_CHARACTER));
+ return(sc->F);
}
- }
-#endif
- return(c_less_2_1(sc, x, y));
-}
-
-static s7_pointer c_less_i(s7_scheme *sc, s7_int x, s7_int y) {return(make_boolean(sc, x < y));}
-static s7_pointer c_less_r(s7_scheme *sc, s7_double x, s7_double y) {return(make_boolean(sc, x < y));}
-XF2_TO_PF(less, c_less_i, c_less_r, c_less_2)
-
-
-static s7_pointer leq_s_ic;
-static s7_pointer g_leq_s_ic(s7_scheme *sc, s7_pointer args)
-{
- s7_int y;
- s7_pointer x;
-
- x = car(args);
- y = s7_integer(cadr(args));
-
- switch (type(x))
- {
- case T_INTEGER:
- return(make_boolean(sc, integer(x) <= y));
-
- case T_RATIO:
- if ((y >= 0) && (numerator(x) <= 0))
- return(sc->T);
- if ((y <= 0) && (numerator(x) > 0))
- return(sc->F);
- if (denominator(x) < s7_int32_max)
- return(make_boolean(sc, (numerator(x) <= (y * denominator(x)))));
- return(make_boolean(sc, fraction(x) <= y));
-
- case T_REAL:
- return(make_boolean(sc, real(x) <= y));
-
- default:
- method_or_bust(sc, x, sc->leq_symbol, args, T_REAL, 1);
+ y = car(x);
}
return(sc->T);
}
-static s7_pointer c_leq_2_1(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_pointer g_chars_are_equal(s7_scheme *sc, s7_pointer args)
{
- switch (type(x))
- {
- case T_INTEGER:
- switch (type(y))
- {
- case T_INTEGER:
- return(make_boolean(sc, integer(x) <= integer(y)));
-
- case T_RATIO:
- return(g_less_or_equal(sc, list_2(sc, x, y)));
+ #define H_chars_are_equal "(char=? char ...) returns #t if all the character arguments are equal"
+ #define Q_chars_are_equal pcl_bc
- case T_REAL:
- if (is_NaN(real(y))) return(sc->F);
- return(make_boolean(sc, integer(x) <= real(y)));
+ s7_pointer x, y;
- default:
- method_or_bust(sc, y, sc->leq_symbol, list_2(sc, x, y), T_REAL, 2);
- }
- break;
+ y = car(args);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sc->char_eq_symbol, args, T_CHARACTER, 1);
- case T_RATIO:
- return(g_less_or_equal(sc, list_2(sc, x, y)));
+ for (x = cdr(args); is_pair(x); x = cdr(x))
+ {
+ if (!s7_is_character(car(x)))
+ method_or_bust(sc, car(x), sc->char_eq_symbol, cons(sc, y, x), T_CHARACTER, position_of(x, args));
- case T_REAL:
- switch (type(y))
+ if (car(x) != y)
{
- case T_INTEGER:
- if (is_NaN(real(x))) return(sc->F);
- return(make_boolean(sc, real(x) <= integer(y)));
-
- case T_RATIO:
- if (is_NaN(real(x))) return(sc->F);
- return(make_boolean(sc, real(x) <= fraction(y)));
-
- case T_REAL:
- if (is_NaN(real(x))) return(sc->F);
- if (is_NaN(real(y))) return(sc->F);
- return(make_boolean(sc, real(x) <= real(y)));
-
- default:
- method_or_bust(sc, y, sc->leq_symbol, list_2(sc, x, y), T_REAL, 2);
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_character_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sc->char_eq_symbol, position_of(y, args), car(y), T_CHARACTER));
+ return(sc->F);
}
- break;
-
- default:
- method_or_bust(sc, x, sc->leq_symbol, list_2(sc, x, y), T_REAL, 1);
}
return(sc->T);
}
-static s7_pointer c_leq_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
-#if (!MS_WINDOWS)
- if (type(x) == type(y))
- {
- switch (type(x))
- {
- case T_INTEGER: return(make_boolean(sc, integer(x) <= integer(y)));
- case T_RATIO: return(make_boolean(sc, fraction(x) <= fraction(y)));
- case T_REAL: return(make_boolean(sc, real(x) <= real(y)));
- }
- }
-#endif
- return(c_leq_2_1(sc, x, y));
-}
-static s7_pointer leq_2;
-static s7_pointer g_leq_2(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_chars_are_less(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x, y;
-
- x = car(args);
- y = cadr(args);
+ #define H_chars_are_less "(char<? char ...) returns #t if all the character arguments are increasing"
+ #define Q_chars_are_less pcl_bc
-#if (!MS_WINDOWS)
- if (type(x) == type(y))
- {
- switch (type(x))
- {
- case T_INTEGER: return(make_boolean(sc, integer(x) <= integer(y)));
- case T_RATIO: return(make_boolean(sc, fraction(x) <= fraction(y)));
- case T_REAL: return(make_boolean(sc, real(x) <= real(y)));
- }
- }
-#endif
- return(c_leq_2_1(sc, x, y));
+ return(g_char_cmp(sc, args, -1, sc->char_lt_symbol));
}
-static s7_pointer c_leq_i(s7_scheme *sc, s7_int x, s7_int y) {return(make_boolean(sc, x <= y));}
-static s7_pointer c_leq_r(s7_scheme *sc, s7_double x, s7_double y) {return(make_boolean(sc, x <= y));}
-XF2_TO_PF(leq, c_leq_i, c_leq_r, c_leq_2)
-
-static s7_pointer greater_s_ic, greater_s_fc;
-static s7_pointer g_greater_s_ic(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_chars_are_greater(s7_scheme *sc, s7_pointer args)
{
- s7_int y;
- s7_pointer x;
+ #define H_chars_are_greater "(char>? char ...) returns #t if all the character arguments are decreasing"
+ #define Q_chars_are_greater pcl_bc
- x = car(args);
- y = integer(cadr(args));
- switch (type(x))
- {
- case T_INTEGER:
- return(make_boolean(sc, integer(x) > y));
+ return(g_char_cmp(sc, args, 1, sc->char_gt_symbol));
+}
- case T_RATIO:
- if (denominator(x) < s7_int32_max) /* y has already been checked for range */
- return(make_boolean(sc, (numerator(x) > (y * denominator(x)))));
- return(make_boolean(sc, fraction(x) > y));
- case T_REAL:
- return(make_boolean(sc, real(x) > y));
+static s7_pointer g_chars_are_geq(s7_scheme *sc, s7_pointer args)
+{
+ #define H_chars_are_geq "(char>=? char ...) returns #t if all the character arguments are equal or decreasing"
+ #define Q_chars_are_geq pcl_bc
- default:
- method_or_bust_with_type(sc, x, sc->gt_symbol, args, a_number_string, 1);
- }
- return(sc->T);
+ return(g_char_cmp_not(sc, args, -1, sc->char_geq_symbol));
}
-static s7_pointer g_greater_s_fc(s7_scheme *sc, s7_pointer args)
-{
- s7_double y;
- s7_pointer x;
-
- x = car(args);
- y = real(cadr(args));
- if (is_t_real(x))
- return(make_boolean(sc, real(x) > y));
+static s7_pointer g_chars_are_leq(s7_scheme *sc, s7_pointer args)
+{
+ #define H_chars_are_leq "(char<=? char ...) returns #t if all the character arguments are equal or increasing"
+ #define Q_chars_are_leq pcl_bc
- switch (type(x))
- {
- case T_INTEGER:
- return(make_boolean(sc, integer(x) > y));
+ return(g_char_cmp_not(sc, args, 1, sc->char_leq_symbol));
+}
- case T_RATIO:
- /* (> 9223372036854775807/9223372036854775806 1.0) */
- if (denominator(x) < s7_int32_max) /* y range check was handled in greater_chooser */
- return(make_boolean(sc, (numerator(x) > (y * denominator(x)))));
- return(make_boolean(sc, fraction(x) > y));
+static s7_pointer simple_char_eq;
+static s7_pointer g_simple_char_eq(s7_scheme *sc, s7_pointer args)
+{
+ return(make_boolean(sc, character(car(args)) == character(cadr(args))));
+}
- case T_REAL:
- return(make_boolean(sc, real(x) > y));
- default:
- method_or_bust_with_type(sc, x, sc->gt_symbol, args, a_number_string, 1);
- }
- return(sc->T);
+static void check_char2_args(s7_scheme *sc, s7_pointer caller, s7_pointer p1, s7_pointer p2)
+{
+ if (!s7_is_character(p1))
+ simple_wrong_type_argument(sc, caller, p1, T_CHARACTER);
+ if (!s7_is_character(p2))
+ simple_wrong_type_argument(sc, caller, p2, T_CHARACTER);
}
+static bool char_lt_b_direct(s7_pointer p1, s7_pointer p2) {return(character(p1) < character(p2));}
+static bool char_lt_b(s7_pointer p1, s7_pointer p2)
+{
+ check_char2_args(cur_sc, cur_sc->char_lt_symbol, p1, p2);
+ return(character(p1) < character(p2));
+}
-static s7_pointer c_greater_2_1(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static bool char_leq_b_direct(s7_pointer p1, s7_pointer p2) {return(character(p1) <= character(p2));}
+static bool char_leq_b(s7_pointer p1, s7_pointer p2)
{
- switch (type(x))
- {
- case T_INTEGER:
- switch (type(y))
- {
- case T_INTEGER:
- return(make_boolean(sc, integer(x) > integer(y)));
+ check_char2_args(cur_sc, cur_sc->char_leq_symbol, p1, p2);
+ return(character(p1) <= character(p2));
+}
- case T_RATIO:
- return(g_greater(sc, list_2(sc, x, y)));
+static bool char_gt_b_direct(s7_pointer p1, s7_pointer p2) {return(character(p1) > character(p2));}
+static bool char_gt_b(s7_pointer p1, s7_pointer p2)
+{
+ check_char2_args(cur_sc, cur_sc->char_gt_symbol, p1, p2);
+ return(character(p1) > character(p2));
+}
- case T_REAL:
- if (is_NaN(real(y))) return(sc->F);
- return(make_boolean(sc, integer(x) > real(y)));
+static bool char_geq_b_direct(s7_pointer p1, s7_pointer p2) {return(character(p1) >= character(p2));}
+static bool char_geq_b(s7_pointer p1, s7_pointer p2)
+{
+ check_char2_args(cur_sc, cur_sc->char_geq_symbol, p1, p2);
+ return(character(p1) >= character(p2));
+}
- default:
- method_or_bust(sc, y, sc->gt_symbol, list_2(sc, x, y), T_REAL, 2);
- }
- break;
+static bool char_eq_b_direct(s7_pointer p1, s7_pointer p2) {return(character(p1) == character(p2));}
+static bool char_eq_b(s7_pointer p1, s7_pointer p2)
+{
+ check_char2_args(cur_sc, cur_sc->char_eq_symbol, p1, p2);
+ return(character(p1) == character(p2));
+}
- case T_RATIO:
- return(g_greater(sc, list_2(sc, x, y)));
- case T_REAL:
- switch (type(y))
- {
- case T_INTEGER:
- if (is_NaN(real(x))) return(sc->F);
- return(make_boolean(sc, real(x) > integer(y)));
+static s7_pointer char_equal_s_ic, char_equal_2;
+static s7_pointer g_char_equal_s_ic(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer c;
+ c = find_symbol_unchecked(sc, car(args));
+ if (c == cadr(args))
+ return(sc->T);
+ if (s7_is_character(c))
+ return(sc->F);
+ method_or_bust(sc, c, sc->char_eq_symbol, list_2(sc, c, cadr(args)), T_CHARACTER, 1);
+}
- case T_RATIO:
- if (is_NaN(real(x))) return(sc->F);
- return(make_boolean(sc, real(x) > fraction(y)));
+static s7_pointer g_char_equal_2(s7_scheme *sc, s7_pointer args)
+{
+ if (!s7_is_character(car(args)))
+ method_or_bust(sc, car(args), sc->char_eq_symbol, args, T_CHARACTER, 1);
+ if (car(args) == cadr(args))
+ return(sc->T);
+ if (!s7_is_character(cadr(args)))
+ method_or_bust(sc, cadr(args), sc->char_eq_symbol, args, T_CHARACTER, 2);
+ return(sc->F);
+}
- case T_REAL:
- if (is_NaN(real(x))) return(sc->F);
- if (is_NaN(real(y))) return(sc->F);
- return(make_boolean(sc, real(x) > real(y)));
+static s7_pointer char_less_2;
+static s7_pointer g_char_less_2(s7_scheme *sc, s7_pointer args)
+{
+ if (!s7_is_character(car(args)))
+ method_or_bust(sc, car(args), sc->char_lt_symbol, args, T_CHARACTER, 1);
+ if (!s7_is_character(cadr(args)))
+ method_or_bust(sc, cadr(args), sc->char_lt_symbol, args, T_CHARACTER, 2);
+ return(make_boolean(sc, character(car(args)) < character(cadr(args))));
+}
- default:
- method_or_bust(sc, y, sc->gt_symbol, list_2(sc, x, y), T_REAL, 2);
- }
- break;
- default:
- method_or_bust(sc, x, sc->gt_symbol, list_2(sc, x, y), T_REAL, 1);
- }
- return(sc->T);
+static s7_pointer char_greater_2;
+static s7_pointer g_char_greater_2(s7_scheme *sc, s7_pointer args)
+{
+ if (!s7_is_character(car(args)))
+ method_or_bust(sc, car(args), sc->char_gt_symbol, args, T_CHARACTER, 1);
+ if (!s7_is_character(cadr(args)))
+ method_or_bust(sc, cadr(args), sc->char_gt_symbol, args, T_CHARACTER, 2);
+ return(make_boolean(sc, character(car(args)) > character(cadr(args))));
}
-static s7_pointer c_greater_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
+#if (!WITH_PURE_S7)
+static s7_pointer g_char_cmp_ci(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
{
-#if (!MS_WINDOWS)
- if (type(x) == type(y))
+ s7_pointer x, y;
+
+ y = car(args);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sym, args, T_CHARACTER, 1);
+
+ for (x = cdr(args); is_pair(x); x = cdr(x))
{
- switch (type(x))
+ if (!s7_is_character(car(x)))
+ method_or_bust(sc, car(x), sym, cons(sc, y, x), T_CHARACTER, position_of(x, args));
+ if (charcmp(upper_character(y), upper_character(car(x))) != val)
{
- case T_INTEGER: return(make_boolean(sc, integer(x) > integer(y)));
- case T_RATIO: return(make_boolean(sc, fraction(x) > fraction(y)));
- case T_REAL: return(make_boolean(sc, real(x) > real(y)));
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_character_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_CHARACTER));
+ return(sc->F);
}
+ y = car(x);
}
-#endif
- return(c_greater_2_1(sc, x, y));
+ return(sc->T);
}
-static s7_pointer greater_2;
-static s7_pointer g_greater_2(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_char_cmp_ci_not(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
{
s7_pointer x, y;
- x = car(args);
- y = cadr(args);
-
-#if (!MS_WINDOWS)
- if (type(x) == type(y))
+ y = car(args);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sym, args, T_CHARACTER, 1);
+ for (x = cdr(args); is_pair(x); x = cdr(x))
{
- switch (type(x))
+ if (!s7_is_character(car(x)))
+ method_or_bust(sc, car(x), sym, cons(sc, y, x), T_CHARACTER, position_of(x, args));
+ if (charcmp(upper_character(y), upper_character(car(x))) == val)
{
- case T_INTEGER: return(make_boolean(sc, integer(x) > integer(y)));
- case T_RATIO: return(make_boolean(sc, fraction(x) > fraction(y)));
- case T_REAL: return(make_boolean(sc, real(x) > real(y)));
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_character_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_CHARACTER));
+ return(sc->F);
}
+ y = car(x);
}
-#endif
- return(c_greater_2_1(sc, x, y));
+ return(sc->T);
}
-static s7_pointer c_gt_i(s7_scheme *sc, s7_int x, s7_int y) {return(make_boolean(sc, x > y));}
-static s7_pointer c_gt_r(s7_scheme *sc, s7_double x, s7_double y) {return(make_boolean(sc, x > y));}
-XF2_TO_PF(gt, c_gt_i, c_gt_r, c_greater_2)
-
-static s7_pointer greater_2_f;
-static s7_pointer g_greater_2_f(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_chars_are_ci_equal(s7_scheme *sc, s7_pointer args)
{
- return(make_boolean(sc, real(car(args)) > real(cadr(args))));
-}
+ #define H_chars_are_ci_equal "(char-ci=? char ...) returns #t if all the character arguments are equal, ignoring case"
+ #define Q_chars_are_ci_equal pcl_bc
+ return(g_char_cmp_ci(sc, args, 0, sc->char_ci_eq_symbol));
+}
-static s7_pointer c_geq_2_1(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_pointer g_chars_are_ci_less(s7_scheme *sc, s7_pointer args)
{
- switch (type(x))
- {
- case T_INTEGER:
- switch (type(y))
- {
- case T_INTEGER:
- return(make_boolean(sc, integer(x) >= integer(y)));
+ #define H_chars_are_ci_less "(char-ci<? char ...) returns #t if all the character arguments are increasing, ignoring case"
+ #define Q_chars_are_ci_less pcl_bc
- case T_RATIO:
- return(g_greater_or_equal(sc, list_2(sc, x, y)));
+ return(g_char_cmp_ci(sc, args, -1, sc->char_ci_lt_symbol));
+}
- case T_REAL:
- if (is_NaN(real(y))) return(sc->F);
- return(make_boolean(sc, integer(x) >= real(y)));
+static s7_pointer g_chars_are_ci_greater(s7_scheme *sc, s7_pointer args)
+{
+ #define H_chars_are_ci_greater "(char-ci>? char ...) returns #t if all the character arguments are decreasing, ignoring case"
+ #define Q_chars_are_ci_greater pcl_bc
- default:
- method_or_bust(sc, y, sc->geq_symbol, list_2(sc, x, y), T_REAL, 2);
- }
- break;
+ return(g_char_cmp_ci(sc, args, 1, sc->char_ci_gt_symbol));
+}
- case T_RATIO:
- return(g_greater_or_equal(sc, list_2(sc, x, y)));
+static s7_pointer g_chars_are_ci_geq(s7_scheme *sc, s7_pointer args)
+{
+ #define H_chars_are_ci_geq "(char-ci>=? char ...) returns #t if all the character arguments are equal or decreasing, ignoring case"
+ #define Q_chars_are_ci_geq pcl_bc
- case T_REAL:
- switch (type(y))
- {
- case T_INTEGER:
- if (is_NaN(real(x))) return(sc->F);
- return(make_boolean(sc, real(x) >= integer(y)));
+ return(g_char_cmp_ci_not(sc, args, -1, sc->char_ci_geq_symbol));
+}
- case T_RATIO:
- if (is_NaN(real(x))) return(sc->F);
- return(make_boolean(sc, real(x) >= fraction(y)));
+static s7_pointer g_chars_are_ci_leq(s7_scheme *sc, s7_pointer args)
+{
+ #define H_chars_are_ci_leq "(char-ci<=? char ...) returns #t if all the character arguments are equal or increasing, ignoring case"
+ #define Q_chars_are_ci_leq pcl_bc
- case T_REAL:
- if (is_NaN(real(x))) return(sc->F);
- if (is_NaN(real(y))) return(sc->F);
- return(make_boolean(sc, real(x) >= real(y)));
+ return(g_char_cmp_ci_not(sc, args, 1, sc->char_ci_leq_symbol));
+}
- default:
- method_or_bust(sc, y, sc->geq_symbol, list_2(sc, x, y), T_REAL, 2);
- }
- break;
- default:
- method_or_bust(sc, x, sc->geq_symbol, list_2(sc, x, y), T_REAL, 1);
- }
- return(sc->T);
+static bool char_ci_lt_b_direct(s7_pointer p1, s7_pointer p2) {return(upper_character(p1) < upper_character(p2));}
+static bool char_ci_lt_b(s7_pointer p1, s7_pointer p2)
+{
+ check_char2_args(cur_sc, cur_sc->char_ci_lt_symbol, p1, p2);
+ return(upper_character(p1) < upper_character(p2));
}
-static s7_pointer c_geq_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static bool char_ci_leq_b_direct(s7_pointer p1, s7_pointer p2) {return(upper_character(p1) <= upper_character(p2));}
+static bool char_ci_leq_b(s7_pointer p1, s7_pointer p2)
{
-#if (!MS_WINDOWS)
- if (type(x) == type(y))
- {
- switch (type(x))
- {
- case T_INTEGER: return(make_boolean(sc, integer(x) >= integer(y)));
- case T_RATIO: return(make_boolean(sc, fraction(x) >= fraction(y)));
- case T_REAL: return(make_boolean(sc, real(x) >= real(y)));
- }
- }
-#endif
- return(c_geq_2_1(sc, x, y));
+ check_char2_args(cur_sc, cur_sc->char_ci_leq_symbol, p1, p2);
+ return(upper_character(p1) <= upper_character(p2));
}
-#endif
-static s7_pointer geq_2 = NULL;
-
-#if (!WITH_GMP)
-static s7_pointer g_geq_2(s7_scheme *sc, s7_pointer args)
+static bool char_ci_gt_b_direct(s7_pointer p1, s7_pointer p2) {return(upper_character(p1) > upper_character(p2));}
+static bool char_ci_gt_b(s7_pointer p1, s7_pointer p2)
{
- s7_pointer x, y;
-
- x = car(args);
- y = cadr(args);
-
-#if (!MS_WINDOWS)
- if (type(x) == type(y))
- {
- if (is_integer(x))
- return(make_boolean(sc, integer(x) >= integer(y)));
- switch (type(x))
- {
- case T_INTEGER: return(make_boolean(sc, integer(x) >= integer(y)));
- case T_RATIO: return(make_boolean(sc, fraction(x) >= fraction(y)));
- case T_REAL: return(make_boolean(sc, real(x) >= real(y)));
- }
- }
-#endif
- return(c_geq_2_1(sc, x, y));
+ check_char2_args(cur_sc, cur_sc->char_ci_gt_symbol, p1, p2);
+ return(upper_character(p1) > upper_character(p2));
}
-static s7_pointer c_geq_i(s7_scheme *sc, s7_int x, s7_int y) {return(make_boolean(sc, x >= y));}
-static s7_pointer c_geq_r(s7_scheme *sc, s7_double x, s7_double y) {return(make_boolean(sc, x >= y));}
-XF2_TO_PF(geq, c_geq_i, c_geq_r, c_geq_2)
-
-
-static s7_pointer geq_s_fc;
-static s7_pointer g_geq_s_fc(s7_scheme *sc, s7_pointer args)
+static bool char_ci_geq_b_direct(s7_pointer p1, s7_pointer p2) {return(upper_character(p1) >= upper_character(p2));}
+static bool char_ci_geq_b(s7_pointer p1, s7_pointer p2)
{
- s7_double y;
- s7_pointer x;
-
- x = car(args);
- y = real(cadr(args));
-
- if (is_t_real(x))
- return(make_boolean(sc, real(x) >= y));
- return(g_geq_2(sc, args));
+ check_char2_args(cur_sc, cur_sc->char_ci_geq_symbol, p1, p2);
+ return(upper_character(p1) >= upper_character(p2));
}
-
-static s7_pointer geq_length_ic;
-static s7_pointer g_geq_length_ic(s7_scheme *sc, s7_pointer args)
+static bool char_ci_eq_b_direct(s7_pointer p1, s7_pointer p2) {return(upper_character(p1) == upper_character(p2));}
+static bool char_ci_eq_b(s7_pointer p1, s7_pointer p2)
{
- return(make_boolean(sc, is_false(sc, g_less_length_ic(sc, args))));
+ check_char2_args(cur_sc, cur_sc->char_ci_eq_symbol, p1, p2);
+ return(upper_character(p1) == upper_character(p2));
}
+#endif /* not pure s7 */
-static s7_pointer geq_s_ic;
-static s7_pointer g_geq_s_ic(s7_scheme *sc, s7_pointer args)
-{
- s7_int y;
- s7_pointer x;
-
- x = car(args);
- y = s7_integer(cadr(args));
- switch (type(x))
- {
- case T_INTEGER:
- return(make_boolean(sc, integer(x) >= y));
- case T_RATIO:
- if ((y >= 0) && (numerator(x) < 0))
- return(sc->F);
- if ((y <= 0) && (numerator(x) >= 0))
- return(sc->T);
- if ((y < s7_int32_max) &&
- (y > s7_int32_min) &&
- (denominator(x) < s7_int32_max))
- return(make_boolean(sc, (numerator(x) >= (y * denominator(x)))));
- return(make_boolean(sc, fraction(x) >= y));
+static s7_pointer g_char_position(s7_scheme *sc, s7_pointer args)
+{
+ #define H_char_position "(char-position char-or-str str (start 0)) returns the position of the first occurrence of char in str, or #f"
+ #define Q_char_position s7_make_signature(sc, 4, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_boolean_symbol), s7_make_signature(sc, 2, sc->is_char_symbol, sc->is_string_symbol), sc->is_string_symbol, sc->is_integer_symbol)
- case T_REAL:
- return(make_boolean(sc, real(x) >= y));
+ const char *porig, *pset;
+ s7_int start, pos, len; /* not "int" because start arg might be most-negative-fixnum */
+ s7_pointer arg1, arg2;
- default:
- method_or_bust(sc, x, sc->geq_symbol, args, T_REAL, 1);
- }
- return(sc->T);
-}
-#endif
-/* end (!WITH_GMP) */
+ arg1 = car(args);
+ if ((!s7_is_character(arg1)) &&
+ (!is_string(arg1)))
+ method_or_bust(sc, arg1, sc->char_position_symbol, args, T_CHARACTER, 1);
+ arg2 = cadr(args);
+ if (!is_string(arg2))
+ method_or_bust(sc, arg2, sc->char_position_symbol, args, T_STRING, 2);
-/* ---------------------------------------- real-part imag-part ---------------------------------------- */
+ porig = string_value(arg2);
+ len = string_length(arg2);
-s7_double s7_real_part(s7_pointer x)
-{
- switch(type(x))
+ if (is_pair(cddr(args)))
{
- case T_INTEGER: return((s7_double)integer(x));
- case T_RATIO: return(fraction(x));
- case T_REAL: return(real(x));
- case T_COMPLEX: return(real_part(x));
-#if WITH_GMP
- case T_BIG_INTEGER: return((s7_double)big_integer_to_s7_int(big_integer(x)));
- case T_BIG_RATIO: return((s7_double)((long double)big_integer_to_s7_int(mpq_numref(big_ratio(x))) / (long double)big_integer_to_s7_int(mpq_denref(big_ratio(x)))));
- case T_BIG_REAL: return((s7_double)mpfr_get_d(big_real(x), GMP_RNDN));
- case T_BIG_COMPLEX: return((s7_double)mpfr_get_d(mpc_realref(big_complex(x)), GMP_RNDN));
-#endif
+ s7_pointer arg3;
+ arg3 = caddr(args);
+ if (!s7_is_integer(arg3))
+ {
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, arg3, cddr(args))))
+ method_or_bust(sc, arg3, sc->char_position_symbol, args, T_INTEGER, 3);
+ arg3 = p;
+ }
+ start = s7_integer(arg3);
+ if (start < 0)
+ return(wrong_type_argument_with_type(sc, sc->char_position_symbol, 3, arg3, a_non_negative_integer_string));
}
- return(0.0);
-}
-
+ else start = 0;
+ if (start >= len) return(sc->F);
-s7_double s7_imag_part(s7_pointer x)
-{
- switch (type(x))
+ if (s7_is_character(arg1))
{
- case T_COMPLEX: return(imag_part(x));
-#if WITH_GMP
- case T_BIG_COMPLEX: return((s7_double)mpfr_get_d(mpc_imagref(big_complex(x)), GMP_RNDN));
-#endif
+ char c;
+ const char *p;
+ c = character(arg1);
+ p = strchr((const char *)(porig + start), (int)c); /* use strchrnul in Gnu C to catch embedded null case */
+ if (p)
+ return(make_integer(sc, p - porig));
+ return(sc->F);
}
- return(0.0);
+
+ if (string_length(arg1) == 0)
+ return(sc->F);
+ pset = string_value(arg1);
+
+ pos = strcspn((const char *)(porig + start), (const char *)pset);
+ if ((pos + start) < len)
+ return(make_integer(sc, pos + start));
+
+ /* but if the string has an embedded null, we can get erroneous results here --
+ * perhaps check for null at pos+start? What about a searched-for string that
+ * also has embedded nulls?
+ *
+ * The embedded nulls are for byte-vector usages, where presumably you're not talking
+ * about chars and strings, so I think I'll ignore these cases. In unicode, you'd
+ * want to use unicode-aware searchers, so that also is irrelevant.
+ */
+ return(sc->F);
}
-static s7_pointer g_real_part(s7_scheme *sc, s7_pointer args)
+static s7_pointer char_position_p_ppi(s7_pointer p1, s7_pointer p2, s7_int start)
{
- #define H_real_part "(real-part num) returns the real part of num"
- #define Q_real_part s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_number_symbol)
-
- s7_pointer p;
- p = car(args);
- switch (type(p))
- {
- case T_INTEGER:
- case T_RATIO:
- case T_REAL:
- return(p);
+ /* p1 is char, p2 is string, p3 is int */
+ const char *porig, *p;
+ char c;
+ s7_int len;
+ c = character(p1);
+ if (!is_string(p2))
+ simple_wrong_type_argument(cur_sc, cur_sc->char_position_symbol, p2, T_STRING);
+ len = string_length(p2);
+ porig = string_value(p2);
+ if (start >= len) return(cur_sc->F);
+ p = strchr((const char *)(porig + start), (int)c);
+ if (p) return(make_integer(cur_sc, p - porig));
+ return(cur_sc->F);
+}
- case T_COMPLEX:
- return(make_real(sc, real_part(p)));
-#if WITH_GMP
- case T_BIG_INTEGER:
- case T_BIG_RATIO:
- case T_BIG_REAL:
- return(p);
+static s7_pointer char_position_csi;
+static s7_pointer g_char_position_csi(s7_scheme *sc, s7_pointer args)
+{
+ /* assume char arg1, no end */
+ const char *porig, *p;
+ char c;
+ s7_pointer arg2;
+ s7_int start, len;
- case T_BIG_COMPLEX:
- {
- s7_pointer x;
+ c = character(car(args));
+ arg2 = cadr(args);
- new_cell(sc, x, T_BIG_REAL);
- add_bigreal(sc, x);
- mpfr_init(big_real(x));
- mpc_real(big_real(x), big_complex(p), GMP_RNDN);
+ if (!is_string(arg2))
+ return(g_char_position(sc, args));
- return(x);
- }
-#endif
+ len = string_length(arg2); /* can't return #f here if len==0 -- need start error check first */
+ porig = string_value(arg2);
- default:
- method_or_bust_with_type(sc, p, sc->real_part_symbol, args, a_number_string, 0);
+ if (is_pair(cddr(args)))
+ {
+ s7_pointer arg3;
+ arg3 = caddr(args);
+ if (!s7_is_integer(arg3))
+ return(g_char_position(sc, args));
+ start = s7_integer(arg3);
+ if (start < 0)
+ return(wrong_type_argument_with_type(sc, sc->char_position_symbol, 3, arg3, a_non_negative_integer_string));
+ if (start >= len) return(sc->F);
}
-}
+ else start = 0;
-#if (!WITH_GMP)
-static s7_double c_real_part(s7_scheme *sc, s7_pointer x) {return(real(g_real_part(sc, set_plist_1(sc, x))));}
-PF_TO_RF(real_part, c_real_part)
-#endif
+ if (len == 0) return(sc->F);
+ p = strchr((const char *)(porig + start), (int)c);
+ if (p)
+ return(make_integer(sc, p - porig));
+ return(sc->F);
+}
-static s7_pointer g_imag_part(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_string_position(s7_scheme *sc, s7_pointer args)
{
- #define H_imag_part "(imag-part num) returns the imaginary part of num"
- #define Q_imag_part s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_number_symbol)
- s7_pointer p;
- /* currently (imag-part nan.0) -> 0.0 ? it's true but maybe confusing */
+ #define H_string_position "(string-position str1 str2 (start 0)) returns the starting position of str1 in str2 or #f"
+ #define Q_string_position s7_make_signature(sc, 4, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_boolean_symbol), sc->is_string_symbol, sc->is_string_symbol, sc->is_integer_symbol)
+ const char *s1, *s2, *p2;
+ s7_int start = 0;
+ s7_pointer s1p, s2p;
- p = car(args);
- switch (type(p))
- {
- case T_INTEGER:
- case T_RATIO:
- return(small_int(0));
+ s1p = car(args);
+ if (!is_string(s1p))
+ method_or_bust(sc, s1p, sc->string_position_symbol, args, T_STRING, 1);
- case T_REAL:
- return(real_zero);
+ s2p = cadr(args);
+ if (!is_string(s2p))
+ method_or_bust(sc, s2p, sc->string_position_symbol, args, T_STRING, 2);
- case T_COMPLEX:
- return(make_real(sc, imag_part(p)));
+ if (is_pair(cddr(args)))
+ {
+ s7_pointer arg3;
+ arg3 = caddr(args);
+ if (!s7_is_integer(arg3))
+ {
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, arg3, cddr(args))))
+ method_or_bust(sc, arg3, sc->string_position_symbol, args, T_INTEGER, 3);
+ arg3 = p;
+ }
+ start = s7_integer(arg3);
+ if (start < 0)
+ return(wrong_type_argument_with_type(sc, sc->string_position_symbol, 3, arg3, a_non_negative_integer_string));
+ }
-#if WITH_GMP
- case T_BIG_INTEGER:
- case T_BIG_RATIO:
- return(small_int(0));
+ if (string_length(s1p) == 0)
+ return(sc->F);
+ s1 = string_value(s1p);
+ s2 = string_value(s2p);
+ if (start >= string_length(s2p))
+ return(sc->F);
- case T_BIG_REAL:
- return(real_zero);
+ p2 = strstr((const char *)(s2 + start), s1);
+ if (!p2) return(sc->F);
+ return(make_integer(sc, p2 - s2));
+}
- case T_BIG_COMPLEX:
- {
- s7_pointer x;
- new_cell(sc, x, T_BIG_REAL);
- add_bigreal(sc, x);
- mpfr_init(big_real(x));
- mpc_imag(big_real(x), big_complex(p), GMP_RNDN);
- return(x);
- }
-#endif
+/* -------------------------------- strings -------------------------------- */
- default:
- method_or_bust_with_type(sc, p, sc->imag_part_symbol, args, a_number_string, 0);
- }
+static void resize_strings(s7_scheme *sc)
+{
+ sc->strings_size *= 2;
+ sc->strings = (s7_pointer *)realloc(sc->strings, sc->strings_size * sizeof(s7_pointer));
}
-#if (!WITH_GMP)
-static s7_double c_imag_part(s7_scheme *sc, s7_pointer x) {return(real(g_imag_part(sc, set_plist_1(sc, x))));}
-PF_TO_RF(imag_part, c_imag_part)
-#endif
+s7_pointer s7_make_string_with_length(s7_scheme *sc, const char *str, int len)
+{
+ s7_pointer x;
+ new_cell(sc, x, T_STRING | T_SAFE_PROCEDURE);
+ string_value(x) = alloc_string(sc, len);
+ if (len != 0) /* memcpy can segfault if string_value(x) is NULL */
+ memcpy((void *)string_value(x), (void *)str, len);
+ string_value(x)[len] = 0;
+ string_length(x) = len;
+ string_hash(x) = 0;
+ string_needs_free(x) = true;
+ if (sc->strings_loc == sc->strings_size) resize_strings(sc);
+ sc->strings[sc->strings_loc++] = x;
+ return(x);
+}
-/* ---------------------------------------- numerator denominator ---------------------------------------- */
-static s7_pointer g_numerator(s7_scheme *sc, s7_pointer args)
+static s7_pointer make_string_uncopied_with_length(s7_scheme *sc, char *str, int len)
{
- #define H_numerator "(numerator rat) returns the numerator of the rational number rat"
- #define Q_numerator s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_rational_symbol)
-
s7_pointer x;
- x = car(args);
- switch (type(x))
+ new_cell(sc, x, T_STRING | T_SAFE_PROCEDURE);
+ string_value(x) = str;
+ string_length(x) = len;
+ string_hash(x) = 0;
+ string_needs_free(x) = true;
+ if (sc->strings1_loc == sc->strings1_size)
{
- case T_RATIO: return(make_integer(sc, numerator(x)));
- case T_INTEGER: return(x);
-#if WITH_GMP
- case T_BIG_INTEGER: return(x);
- case T_BIG_RATIO: return(mpz_to_big_integer(sc, mpq_numref(big_ratio(x))));
-#endif
- default: method_or_bust_with_type(sc, x, sc->numerator_symbol, args, a_rational_string, 0);
+ sc->strings1_size *= 2;
+ sc->strings1 = (s7_pointer *)realloc(sc->strings1, sc->strings1_size * sizeof(s7_pointer));
}
+ sc->strings1[sc->strings1_loc++] = x;
+ return(x);
}
-#if (!WITH_GMP)
-static s7_int c_numerator(s7_scheme *sc, s7_pointer x) {return(s7_numerator(x));}
-PF_TO_IF(numerator, c_numerator)
-#endif
-
-static s7_pointer g_denominator(s7_scheme *sc, s7_pointer args)
+static s7_pointer make_string_wrapper_with_length(s7_scheme *sc, const char *str, int len)
{
- #define H_denominator "(denominator rat) returns the denominator of the rational number rat"
- #define Q_denominator s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_rational_symbol)
-
s7_pointer x;
- x = car(args);
- switch (type(x))
- {
- case T_RATIO: return(make_integer(sc, denominator(x)));
- case T_INTEGER: return(small_int(1));
-#if WITH_GMP
- case T_BIG_INTEGER: return(small_int(1));
- case T_BIG_RATIO: return(mpz_to_big_integer(sc, mpq_denref(big_ratio(x))));
-#endif
- default: method_or_bust_with_type(sc, x, sc->denominator_symbol, args, a_rational_string, 0);
- }
+ new_cell(sc, x, T_STRING | T_IMMUTABLE | T_SAFE_PROCEDURE);
+ string_value(x) = (char *)str;
+ string_length(x) = len;
+ string_hash(x) = 0;
+ string_needs_free(x) = false;
+ return(x);
}
-#if (!WITH_GMP)
-static s7_int c_denominator(s7_scheme *sc, s7_pointer x) {return(s7_denominator(x));}
-PF_TO_IF(denominator, c_denominator)
-#endif
+static s7_pointer make_string_wrapper(s7_scheme *sc, const char *str)
+{
+ return(make_string_wrapper_with_length(sc, str, safe_strlen(str)));
+}
-/* ---------------------------------------- nan? infinite? ---------------------------------------- */
-static s7_pointer g_is_nan(s7_scheme *sc, s7_pointer args)
+static s7_pointer make_empty_string(s7_scheme *sc, int len, char fill)
{
- #define H_is_nan "(nan? obj) returns #t if obj is a NaN"
- #define Q_is_nan pl_bn
-
s7_pointer x;
- x = car(args);
- switch (type(x))
- {
- case T_INTEGER:
- case T_RATIO:
- return(sc->F);
-
- case T_REAL:
- return(make_boolean(sc, is_NaN(real(x))));
-
- case T_COMPLEX:
- return(make_boolean(sc, (is_NaN(real_part(x))) || (is_NaN(imag_part(x)))));
+ new_cell(sc, x, T_STRING);
+ string_value(x) = alloc_string(sc, len);
+ if (fill != 0)
+ memset((void *)(string_value(x)), fill, len);
+ string_value(x)[len] = 0;
+ string_hash(x) = 0;
+ string_length(x) = len;
+ string_needs_free(x) = true;
+ if (sc->strings_loc == sc->strings_size) resize_strings(sc);
+ sc->strings[sc->strings_loc++] = x;
+ return(x);
+}
-#if WITH_GMP
- case T_BIG_INTEGER:
- case T_BIG_RATIO:
- return(sc->F);
- case T_BIG_REAL:
- return(make_boolean(sc, is_NaN(s7_real_part(x))));
+s7_pointer s7_make_string(s7_scheme *sc, const char *str)
+{
+ if (str)
+ return(s7_make_string_with_length(sc, str, safe_strlen(str)));
+ return(make_empty_string(sc, 0, 0));
+}
- case T_BIG_COMPLEX:
- return(make_boolean(sc, (is_NaN(s7_real_part(x))) || (is_NaN(s7_imag_part(x)))));
-#endif
- default:
- method_or_bust_with_type(sc, x, sc->is_nan_symbol, list_1(sc, x), a_number_string, 0);
- }
+static char *make_permanent_c_string(const char *str)
+{
+ char *x;
+ int len;
+ len = safe_strlen(str);
+ x = (char *)malloc((len + 1) * sizeof(char));
+ memcpy((void *)x, (void *)str, len);
+ x[len] = 0;
+ return(x);
}
-#if (!WITH_GMP)
-static s7_pointer c_is_nan(s7_scheme *sc, s7_double x) {return((is_NaN(x)) ? sc->T : sc->F);}
-RF_TO_PF(is_nan, c_is_nan)
-#endif
-
-static s7_pointer g_is_infinite(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_make_permanent_string(const char *str)
{
- #define H_is_infinite "(infinite? obj) returns #t if obj is an infinite real"
- #define Q_is_infinite pl_bn
-
+ /* for the symbol table which is never GC'd */
s7_pointer x;
- x = car(args);
- switch (type(x))
+ x = alloc_pointer();
+ unheap(x);
+ set_type(x, T_STRING | T_IMMUTABLE);
+ if (str)
{
- case T_INTEGER:
- case T_RATIO:
- return(sc->F);
-
- case T_REAL:
- return(make_boolean(sc, is_inf(real(x))));
-
- case T_COMPLEX:
- return(make_boolean(sc, (is_inf(real_part(x))) || (is_inf(imag_part(x)))));
-
-#if WITH_GMP
- case T_BIG_INTEGER:
- case T_BIG_RATIO:
- return(sc->F);
-
- case T_BIG_REAL:
- return(make_boolean(sc, mpfr_inf_p(big_real(x)) != 0));
-
- case T_BIG_COMPLEX:
- return(make_boolean(sc,
- (mpfr_inf_p(big_real(g_real_part(sc, list_1(sc, x)))) != 0) ||
- (mpfr_inf_p(big_real(g_imag_part(sc, list_1(sc, x)))) != 0)));
-#endif
-
- default:
- method_or_bust_with_type(sc, x, sc->is_infinite_symbol, list_1(sc, x), a_number_string, 0);
+ unsigned int len;
+ len = safe_strlen(str);
+ string_length(x) = len;
+ string_value(x) = (char *)malloc((len + 1) * sizeof(char));
+ memcpy((void *)string_value(x), (void *)str, len);
+ string_value(x)[len] = 0;
+ }
+ else
+ {
+ string_value(x) = NULL;
+ string_length(x) = 0;
}
+ string_hash(x) = 0;
+ string_needs_free(x) = false;
+ return(x);
}
-#if (!WITH_GMP)
-static s7_pointer c_is_infinite(s7_scheme *sc, s7_double x) {return((is_inf(x)) ? sc->T : sc->F);}
-RF_TO_PF(is_infinite, c_is_infinite)
-#endif
-
+static s7_pointer make_permanent_string_wrapper(void)
+{
+ s7_pointer x;
+ x = alloc_pointer();
+ unheap(x);
+ set_type(x, T_STRING);
+ string_value(x) = NULL;
+ string_length(x) = 0;
+ string_hash(x) = 0;
+ string_needs_free(x) = false;
+ return(x);
+}
-/* ---------------------------------------- number? complex? integer? rational? real? ---------------------------------------- */
-static s7_pointer g_is_number(s7_scheme *sc, s7_pointer args)
+static s7_pointer make_temporary_string(s7_scheme *sc, const char *str, int len)
{
- #define H_is_number "(number? obj) returns #t if obj is a number"
- #define Q_is_number pl_bt
- check_boolean_method(sc, s7_is_number, sc->is_number_symbol, args); /* we need the s7_* versions here for the GMP case */
+ s7_pointer p;
+ p = sc->tmp_strs[0];
+ prepare_temporary_string(sc, len + 1, 0);
+ string_length(p) = len;
+ if (len > 0)
+ memmove((void *)(string_value(p)), (void *)str, len); /* not memcpy because str might be a temp string (i.e. sc->tmp_str_chars -> itself) */
+ string_value(p)[len] = 0;
+ return(p);
}
-static s7_pointer g_is_integer(s7_scheme *sc, s7_pointer args)
+bool s7_is_string(s7_pointer p)
{
- #define H_is_integer "(integer? obj) returns #t if obj is an integer"
- #define Q_is_integer pl_bt
- check_boolean_method(sc, s7_is_integer, sc->is_integer_symbol, args);
+ return(is_string(p));
}
-static s7_pointer g_is_real(s7_scheme *sc, s7_pointer args)
+const char *s7_string(s7_pointer p)
{
- #define H_is_real "(real? obj) returns #t if obj is a real number"
- #define Q_is_real pl_bt
- check_boolean_method(sc, s7_is_real, sc->is_real_symbol, args);
+ return(string_value(p));
}
-static s7_pointer g_is_complex(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_is_string(s7_scheme *sc, s7_pointer args)
{
- #define H_is_complex "(complex? obj) returns #t if obj is a number"
- #define Q_is_complex pl_bt
- check_boolean_method(sc, s7_is_number, sc->is_complex_symbol, args);
+ #define H_is_string "(string? obj) returns #t if obj is a string"
+ #define Q_is_string pl_bt
+
+ check_boolean_method(sc, is_string, sc->is_string_symbol, args);
}
-static s7_pointer g_is_rational(s7_scheme *sc, s7_pointer args)
+/* -------------------------------- make-string -------------------------------- */
+static s7_pointer g_make_string(s7_scheme *sc, s7_pointer args)
{
- #define H_is_rational "(rational? obj) returns #t if obj is a rational number (either an integer or a ratio)"
- #define Q_is_rational pl_bt
- check_boolean_method(sc, s7_is_rational, sc->is_rational_symbol, args);
- /* in the non-gmp case, (rational? 455702434782048082459/86885567283849955830) -> #f, not #t
- * and similarly for exact? etc.
- */
-}
+ #define H_make_string "(make-string len (val #\\space)) makes a string of length len filled with the character val (default: space)"
+ #define Q_make_string s7_make_signature(sc, 3, sc->is_string_symbol, sc->is_integer_symbol, sc->is_char_symbol)
+ s7_pointer n;
+ s7_int len;
+ char fill = ' ';
-/* ---------------------------------------- even? odd?---------------------------------------- */
+ n = car(args);
+ if (!s7_is_integer(n))
+ {
+ check_two_methods(sc, n, sc->make_string_symbol, sc->make_byte_vector_symbol, args);
+ return(wrong_type_argument(sc, sc->make_string_symbol, 1, n, T_INTEGER));
+ }
-static s7_pointer g_is_even(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_even "(even? int) returns #t if the integer int is even"
- #define Q_is_even s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_integer_symbol)
+ len = s7_integer(n);
+ if ((len < 0) || (len > sc->max_string_length))
+ return(out_of_range(sc, sc->make_string_symbol, small_int(1), n, (len < 0) ? its_negative_string : its_too_large_string));
- s7_pointer p;
- p = car(args);
- switch (type(p))
+ if (is_not_null(cdr(args)))
{
- case T_INTEGER: return(make_boolean(sc, ((integer(p) & 1) == 0)));
-#if WITH_GMP
- case T_BIG_INTEGER: return(make_boolean(sc, mpz_even_p(big_integer(p))));
-#endif
- default: method_or_bust(sc, p, sc->is_even_symbol, list_1(sc, p), T_INTEGER, 0);
+ if (!s7_is_character(cadr(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);
+ if (fill == '\0')
+ memset((void *)string_value(n), 0, (int)len);
+ return(n);
}
-#if (!WITH_GMP)
-static s7_pointer c_is_even(s7_scheme *sc, s7_int arg) {return(((arg & 1) == 0) ? sc->T : sc->F);}
-IF_TO_PF(is_even, c_is_even)
-#endif
-
-static s7_pointer g_is_odd(s7_scheme *sc, s7_pointer args)
+#if (!WITH_PURE_S7)
+static s7_pointer g_string_length(s7_scheme *sc, s7_pointer args)
{
- #define H_is_odd "(odd? int) returns #t if the integer int is odd"
- #define Q_is_odd s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_integer_symbol)
-
+ #define H_string_length "(string-length str) returns the length of the string str"
+ #define Q_string_length s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_string_symbol)
s7_pointer p;
p = car(args);
- switch (type(p))
- {
- case T_INTEGER: return(make_boolean(sc, ((integer(p) & 1) == 1)));
-#if WITH_GMP
- case T_BIG_INTEGER: return(make_boolean(sc, mpz_odd_p(big_integer(p))));
-#endif
- default: method_or_bust(sc, p, sc->is_odd_symbol, list_1(sc, p), T_INTEGER, 0);
- }
+ if (!is_string(p))
+ method_or_bust_one_arg(sc, p, sc->string_length_symbol, args, T_STRING);
+ return(make_integer(sc, string_length(p)));
}
-#if (!WITH_GMP)
-static s7_pointer c_is_odd(s7_scheme *sc, s7_int arg) {return(((arg & 1) == 0) ? sc->F : sc->T);}
-IF_TO_PF(is_odd, c_is_odd)
+static s7_int string_length_i(s7_pointer p)
+{
+ if (!is_string(p))
+ simple_wrong_type_argument(cur_sc, cur_sc->string_length_symbol, p, T_STRING);
+ return(string_length(p));
+}
#endif
-/* ---------------------------------------- zero? ---------------------------------------- */
-static s7_pointer c_is_zero(s7_scheme *sc, s7_pointer x)
+/* -------------------------------- string-up|downcase -------------------------------- */
+static s7_pointer g_string_downcase(s7_scheme *sc, s7_pointer args)
{
- switch (type(x))
- {
- case T_INTEGER: return(make_boolean(sc, integer(x) == 0));
- case T_REAL: return(make_boolean(sc, real(x) == 0.0));
- case T_RATIO:
- case T_COMPLEX: return(sc->F); /* ratios and complex numbers are already collapsed into integers and reals */
-#if WITH_GMP
- case T_BIG_INTEGER: return(make_boolean(sc, mpz_cmp_ui(big_integer(x), 0) == 0));
- case T_BIG_REAL: return(make_boolean(sc, mpfr_zero_p(big_real(x))));
- case T_BIG_RATIO:
- case T_BIG_COMPLEX: return(sc->F);
-#endif
- default:
- method_or_bust_with_type(sc, x, sc->is_zero_symbol, list_1(sc, x), a_number_string, 0);
- }
-}
+ #define H_string_downcase "(string-downcase str) returns the lower case version of str."
+ #define Q_string_downcase pcl_s
-static s7_pointer g_is_zero(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_zero "(zero? num) returns #t if the number num is zero"
- #define Q_is_zero pl_bn
+ s7_pointer p, newstr;
+ int i, len;
+ unsigned char *nstr, *ostr;
- return(c_is_zero(sc, car(args)));
-}
+ 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);
-static s7_pointer c_is_zero_i(s7_scheme *sc, s7_int x) {return(make_boolean(sc, x == 0));}
-static s7_pointer c_is_zero_r(s7_scheme *sc, s7_double x) {return(make_boolean(sc, x == 0.0));}
-XF_TO_PF(is_zero, c_is_zero_i, c_is_zero_r, c_is_zero)
+ 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]];
-/* -------------------------------- positive? -------------------------------- */
-static s7_pointer c_is_positive(s7_scheme *sc, s7_pointer x)
-{
- switch (type(x))
- {
- case T_INTEGER: return(make_boolean(sc, integer(x) > 0));
- case T_RATIO: return(make_boolean(sc, numerator(x) > 0));
- case T_REAL: return(make_boolean(sc, real(x) > 0.0));
-#if WITH_GMP
- case T_BIG_INTEGER: return(make_boolean(sc, (mpz_cmp_ui(big_integer(x), 0) > 0)));
- case T_BIG_RATIO: return(make_boolean(sc, (mpq_cmp_ui(big_ratio(x), 0, 1) > 0)));
- case T_BIG_REAL: return(make_boolean(sc, (mpfr_cmp_ui(big_real(x), 0) > 0)));
-#endif
- default:
- method_or_bust(sc, x, sc->is_positive_symbol, list_1(sc, x), T_REAL, 0);
- }
+ return(newstr);
}
-static s7_pointer g_is_positive(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_string_upcase(s7_scheme *sc, s7_pointer args)
{
- #define H_is_positive "(positive? num) returns #t if the real number num is positive (greater than 0)"
- #define Q_is_positive s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_real_symbol)
+ #define H_string_upcase "(string-upcase str) returns the upper case version of str."
+ #define Q_string_upcase pcl_s
+
+ s7_pointer p, newstr;
+ int i, len;
+ unsigned char *nstr, *ostr;
- return(c_is_positive(sc, car(args)));
+ 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);
+
+ 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]];
+
+ return(newstr);
}
-static s7_pointer c_is_positive_i(s7_scheme *sc, s7_int x) {return(make_boolean(sc, x > 0));}
-static s7_pointer c_is_positive_r(s7_scheme *sc, s7_double x) {return(make_boolean(sc, x > 0.0));}
-XF_TO_PF(is_positive, c_is_positive_i, c_is_positive_r, c_is_positive)
+unsigned int s7_string_length(s7_pointer str)
+{
+ return(string_length(str));
+}
-/* -------------------------------- negative? -------------------------------- */
-static s7_pointer c_is_negative(s7_scheme *sc, s7_pointer x)
+/* -------------------------------- string-ref -------------------------------- */
+static s7_pointer string_ref_1(s7_scheme *sc, s7_pointer strng, s7_pointer index)
{
- switch (type(x))
+ /* every use of this has already checked for the byte-vector case */
+ char *str;
+ s7_int ind;
+
+ if (!s7_is_integer(index))
{
- case T_INTEGER: return(make_boolean(sc, integer(x) < 0));
- case T_RATIO: return(make_boolean(sc, numerator(x) < 0));
- case T_REAL: return(make_boolean(sc, real(x) < 0.0));
-#if WITH_GMP
- case T_BIG_INTEGER: return(make_boolean(sc, (mpz_cmp_ui(big_integer(x), 0) < 0)));
- case T_BIG_RATIO: return(make_boolean(sc, (mpq_cmp_ui(big_ratio(x), 0, 1) < 0)));
- case T_BIG_REAL: return(make_boolean(sc, (mpfr_cmp_ui(big_real(x), 0) < 0)));
-#endif
- default:
- method_or_bust(sc, x, sc->is_negative_symbol, list_1(sc, x), T_REAL, 0);
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, index, cons(sc, index, sc->nil))))
+ method_or_bust(sc, index, sc->string_ref_symbol, list_2(sc, strng, index), T_INTEGER, 2);
+ index = p;
}
+ ind = s7_integer(index);
+ if (ind < 0)
+ return(wrong_type_argument_with_type(sc, sc->string_ref_symbol, 2, index, a_non_negative_integer_string));
+ if (ind >= string_length(strng))
+ return(out_of_range(sc, sc->string_ref_symbol, small_int(2), index, its_too_large_string));
+
+ str = string_value(strng);
+ return(s7_make_character(sc, ((unsigned char *)str)[ind]));
}
-static s7_pointer g_is_negative(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer g_string_ref_2(s7_scheme *sc, s7_pointer strng, s7_pointer args, s7_pointer caller)
{
- #define H_is_negative "(negative? num) returns #t if the real number num is negative (less than 0)"
- #define Q_is_negative s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_real_symbol)
+ s7_pointer index, p;
+ char *str;
+ s7_int ind;
+
+ index = cadr(args);
+ if (!s7_is_integer(index))
+ {
+ if (!s7_is_integer(p = check_values(sc, index, cdr(args))))
+ method_or_bust(sc, index, caller, args, T_INTEGER, 2);
+ index = p;
+ }
+ ind = s7_integer(index);
+ if (ind < 0)
+ return(wrong_type_argument_with_type(sc, caller, 2, index, a_non_negative_integer_string));
+ if (ind >= string_length(strng))
+ return(out_of_range(sc, caller, small_int(2), index, its_too_large_string));
- return(c_is_negative(sc, car(args)));
+ str = string_value(strng);
+ if (is_byte_vector(strng))
+ return(small_int((unsigned char)(str[ind])));
+ return(s7_make_character(sc, ((unsigned char *)str)[ind]));
}
-static s7_pointer c_is_negative_i(s7_scheme *sc, s7_int x) {return(make_boolean(sc, x < 0));}
-static s7_pointer c_is_negative_r(s7_scheme *sc, s7_double x) {return(make_boolean(sc, x < 0.0));}
-XF_TO_PF(is_negative, c_is_negative_i, c_is_negative_r, c_is_negative)
+static s7_pointer g_string_ref(s7_scheme *sc, s7_pointer args)
+{
+ #define H_string_ref "(string-ref str index) returns the character at the index-th element of the string str"
+ #define Q_string_ref s7_make_signature(sc, 3, sc->is_char_symbol, sc->is_string_symbol, sc->is_integer_symbol)
+ s7_pointer strng;
+ strng = car(args);
+ if (!is_string(strng))
+ method_or_bust(sc, strng, sc->string_ref_symbol, args, T_STRING, 1);
+ return(g_string_ref_2(sc, strng, args, sc->string_ref_symbol));
+}
-bool s7_is_ulong(s7_pointer arg)
+static s7_pointer g_byte_vector_ref(s7_scheme *sc, s7_pointer args)
{
- return(is_integer(arg));
+ #define H_byte_vector_ref "(byte-vector-ref vect index) returns the byte at the index-th element of the byte-vector vect"
+ #define Q_byte_vector_ref s7_make_signature(sc, 3, sc->is_integer_symbol, sc->is_byte_vector_symbol, sc->is_integer_symbol)
+
+ s7_pointer v;
+ v = car(args);
+ if (!is_byte_vector(v))
+ method_or_bust(sc, v, sc->byte_vector_ref_symbol, args, T_STRING, 1);
+ return(g_string_ref_2(sc, v, args, sc->byte_vector_ref_symbol));
}
-unsigned long s7_ulong(s7_pointer p)
+
+/* -------------------------------- string-set! -------------------------------- */
+static s7_pointer g_string_set_2(s7_scheme *sc, s7_pointer x, s7_pointer args, s7_pointer caller)
{
- return((_NFre(p))->object.number.ul_value);
-}
+ s7_pointer c, index;
+ char *str;
+ s7_int ind;
+
+ index = cadr(args);
+ if (!s7_is_integer(index))
+ {
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, index, cdr(args))))
+ method_or_bust(sc, index, caller, args, T_INTEGER, 2);
+ index = p;
+ }
+ ind = s7_integer(index);
+ if (ind < 0)
+ return(wrong_type_argument_with_type(sc, caller, 2, index, a_non_negative_integer_string));
+ if (ind >= string_length(x))
+ return(out_of_range(sc, caller, small_int(2), index, its_too_large_string));
+ str = string_value(_TSet(x));
+ c = caddr(args);
+ if ((typeflag(x) & T_BYTE_VECTOR) == 0)
+ {
+ if (!s7_is_character(c))
+ method_or_bust(sc, c, caller, list_3(sc, x, index, c), T_CHARACTER, 3);
+ str[ind] = (char)s7_character(c);
+ }
+ else
+ {
+ s7_int ic; /* not int here! */
+ if (!(s7_is_integer(c)))
+ method_or_bust(sc, c, caller, list_3(sc, x, index, c), T_INTEGER, 3);
+ ic = s7_integer(c);
+ if ((ic < 0) || (ic > 255))
+ return(wrong_type_argument_with_type(sc, caller, 3, c, an_unsigned_byte_string));
+ str[ind] = (char)ic;
+ }
+ return(c);
+}
-s7_pointer s7_make_ulong(s7_scheme *sc, unsigned long n)
+static s7_pointer g_string_set(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
- new_cell(sc, x, T_INTEGER);
- x->object.number.ul_value = n;
- return(x);
-}
+ #define H_string_set "(string-set! str index chr) sets the index-th element of the string str to the character chr"
+ #define Q_string_set s7_make_signature(sc, 4, sc->is_char_symbol, sc->is_string_symbol, sc->is_integer_symbol, sc->is_char_symbol)
+ s7_pointer strng;
+ strng = car(args);
+ if (!is_string(strng))
+ method_or_bust(sc, strng, sc->string_set_symbol, args, T_STRING, 1);
+ return(g_string_set_2(sc, strng, args, sc->string_set_symbol));
+}
-bool s7_is_ulong_long(s7_pointer arg)
+static s7_pointer g_byte_vector_set(s7_scheme *sc, s7_pointer args)
{
- return(is_integer(arg));
+ #define H_byte_vector_set "(byte-vector-set! vect index byte) sets the index-th element of the byte-vector vect to the integer byte"
+ #define Q_byte_vector_set s7_make_signature(sc, 4, sc->is_integer_symbol, sc->is_byte_vector_symbol, sc->is_integer_symbol, sc->is_integer_symbol)
+
+ s7_pointer v;
+ v = car(args);
+ if (!is_byte_vector(v))
+ method_or_bust(sc, v, sc->byte_vector_set_symbol, args, T_STRING, 1);
+ return(g_string_set_2(sc, v, args, sc->byte_vector_set_symbol));
}
+static s7_pointer string_ref_p_pi(s7_pointer p1, s7_int i1)
+{
+ if (!is_string(p1))
+ simple_wrong_type_argument(cur_sc, cur_sc->string_ref_symbol, p1, T_STRING);
+ if ((i1 < 0) || (i1 >= string_length(p1)))
+ out_of_range(cur_sc, cur_sc->string_ref_symbol, small_int(2), make_integer(cur_sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string);
+ return(chars[((unsigned char *)string_value(p1))[i1]]);
+}
-unsigned long long s7_ulong_long(s7_pointer p)
+static s7_pointer string_ref_p_pi_direct(s7_pointer p1, s7_int i1)
{
- return((_NFre(p))->object.number.ull_value);
+ if ((i1 < 0) || (i1 >= string_length(p1)))
+ out_of_range(cur_sc, cur_sc->string_ref_symbol, small_int(2), make_integer(cur_sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string);
+ return(chars[((unsigned char *)string_value(p1))[i1]]);
}
+static s7_pointer string_ref_unchecked(s7_pointer p1, s7_int i1) {return(chars[((unsigned char *)string_value(p1))[i1]]);}
-s7_pointer s7_make_ulong_long(s7_scheme *sc, unsigned long long n)
+static s7_pointer string_set_p_pip(s7_pointer p1, s7_int i1, s7_pointer p2)
{
- s7_pointer x;
- new_cell(sc, x, T_INTEGER);
- x->object.number.ull_value = n;
- return(x);
+ if (!is_string(p1))
+ simple_wrong_type_argument(cur_sc, cur_sc->string_set_symbol, p1, T_STRING);
+ if (!s7_is_character(p2))
+ simple_wrong_type_argument(cur_sc, cur_sc->string_set_symbol, p2, T_CHARACTER);
+ if ((i1 < 0) || (i1 >= string_length(p1)))
+ out_of_range(cur_sc, cur_sc->string_set_symbol, small_int(2), make_integer(cur_sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string);
+ string_value(p1)[i1] = s7_character(p2);
+ return(p2);
}
+static s7_pointer string_set_p_pip_direct(s7_pointer p1, s7_int i1, s7_pointer p2)
+{
+ if ((i1 < 0) || (i1 >= string_length(p1)))
+ out_of_range(cur_sc, cur_sc->string_set_symbol, small_int(2),make_integer(cur_sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string);
+ string_value(p1)[i1] = s7_character(p2);
+ return(p2);
+}
-#if (!WITH_PURE_S7)
-#if (!WITH_GMP)
-/* ---------------------------------------- exact<->inexact exact? inexact? ---------------------------------------- */
+static s7_pointer string_set_unchecked(s7_pointer p1, s7_int i1, s7_pointer p2) {string_value(p1)[i1] = s7_character(p2); return(p2);}
-static s7_pointer g_exact_to_inexact(s7_scheme *sc, s7_pointer args)
+static s7_int byte_vector_ref_i(s7_pointer p1, s7_int i1)
{
- #define H_exact_to_inexact "(exact->inexact num) converts num to an inexact number; (exact->inexact 3/2) = 1.5"
- #define Q_exact_to_inexact pcl_r
- return(exact_to_inexact(sc, car(args)));
+ if (!is_byte_vector(p1))
+ simple_wrong_type_argument_with_type(cur_sc, cur_sc->byte_vector_ref_symbol, p1, s7_make_string(cur_sc, "a byte-vector"));
+ if ((i1 < 0) || (i1 >= string_length(p1)))
+ out_of_range(cur_sc, cur_sc->byte_vector_ref_symbol, small_int(2), make_integer(cur_sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string);
+ return((s7_int)((unsigned char)(string_value(p1)[i1])));
}
-
-static s7_pointer g_inexact_to_exact(s7_scheme *sc, s7_pointer args)
+static s7_int byte_vector_set_i(s7_pointer p1, s7_int i1, s7_int i2)
{
- #define H_inexact_to_exact "(inexact->exact num) converts num to an exact number; (inexact->exact 1.5) = 3/2"
- #define Q_inexact_to_exact s7_make_signature(sc, 2, sc->is_rational_symbol, sc->is_real_symbol)
- return(inexact_to_exact(sc, car(args), WITH_OVERFLOW_ERROR));
+ if (!is_byte_vector(p1))
+ simple_wrong_type_argument_with_type(cur_sc, cur_sc->byte_vector_set_symbol, p1, s7_make_string(cur_sc, "a byte-vector"));
+ if ((i2 < 0) || (i2 > 255))
+ simple_wrong_type_argument_with_type(cur_sc, cur_sc->byte_vector_set_symbol, make_integer(cur_sc, i2), an_unsigned_byte_string);
+ if ((i1 < 0) || (i1 >= string_length(p1)))
+ simple_out_of_range(cur_sc, cur_sc->byte_vector_set_symbol, make_integer(cur_sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string);
+ string_value(p1)[i1] = (char)i2;
+ return(i2);
}
-#endif
-/* (!WITH_GMP) */
-static s7_pointer g_is_exact(s7_scheme *sc, s7_pointer args)
+
+/* -------------------------------- string-append -------------------------------- */
+static s7_pointer g_string_append_1(s7_scheme *sc, s7_pointer args, bool use_temp)
{
- #define H_is_exact "(exact? num) returns #t if num is exact (an integer or a ratio)"
- #define Q_is_exact pl_bn
+ s7_int len = 0;
+ s7_pointer x, newstr;
+ char *pos;
- s7_pointer x;
- x = car(args);
- switch (type(x))
+ if (is_null(args))
+ return(s7_make_string_with_length(sc, "", 0));
+
+ /* get length for new string */
+ for (x = args; is_not_null(x); x = cdr(x))
{
- case T_INTEGER:
- case T_RATIO: return(sc->T);
- case T_REAL:
- case T_COMPLEX: return(sc->F);
-#if WITH_GMP
- case T_BIG_INTEGER:
- case T_BIG_RATIO: return(sc->T);
- case T_BIG_REAL:
- case T_BIG_COMPLEX: return(sc->F);
-#endif
- default:
- method_or_bust_with_type(sc, x, sc->is_exact_symbol, args, a_number_string, 0);
+ s7_pointer p;
+ p = car(x);
+ if (!is_string(p))
+ {
+ /* look for string-append and if found, cobble up a plausible intermediate call */
+ if (has_methods(p))
+ {
+ s7_pointer func;
+ func = find_method(sc, find_let(sc, p), sc->string_append_symbol);
+ if (func != sc->undefined)
+ {
+ s7_pointer y;
+ if (len == 0)
+ return(s7_apply_function(sc, func, args));
+ newstr = make_empty_string(sc, len, 0);
+ for (pos = string_value(newstr), y = args; y != x; pos += string_length(car(y)), y = cdr(y))
+ memcpy(pos, string_value(car(y)), string_length(car(y)));
+ return(s7_apply_function(sc, func, cons(sc, newstr, x)));
+ }
+ }
+ return(wrong_type_argument(sc, sc->string_append_symbol, position_of(x, args), p, T_STRING));
+ }
+ len += string_length(p);
}
-}
-
-
-static s7_pointer g_is_inexact(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_inexact "(inexact? num) returns #t if num is inexact (neither an integer nor a ratio)"
- #define Q_is_inexact pl_bn
- s7_pointer x;
- x = car(args);
- switch (type(x))
+ if (len > sc->max_string_length)
+ return(s7_error(sc, sc->out_of_range_symbol,
+ set_elist_3(sc, make_string_wrapper(sc, "string-append new string length, ~D, is larger than (*s7* 'max-string-length): ~D"),
+ make_integer(sc, len),
+ make_integer(sc, sc->max_string_length))));
+ if (use_temp)
{
- case T_INTEGER:
- case T_RATIO: return(sc->F);
- case T_REAL:
- case T_COMPLEX: return(sc->T);
-#if WITH_GMP
- case T_BIG_INTEGER:
- case T_BIG_RATIO: return(sc->F);
- case T_BIG_REAL:
- case T_BIG_COMPLEX: return(sc->T);
-#endif
- default:
- method_or_bust_with_type(sc, x, sc->is_inexact_symbol, args, a_number_string, 0);
+ newstr = sc->tmp_strs[0];
+ prepare_temporary_string(sc, len + 1, 0);
+ string_length(newstr) = len;
+ string_value(newstr)[len] = 0;
}
-}
+ else
+ {
+ /* store the contents of the argument strings into the new string */
+ newstr = make_empty_string(sc, len, 0);
+ }
+ for (pos = string_value(newstr), x = args; is_not_null(x); pos += string_length(car(x)), x = cdr(x))
+ memcpy(pos, string_value(car(x)), string_length(car(x)));
+ if (is_byte_vector(car(args)))
+ set_byte_vector(newstr);
-/* ---------------------------------------- integer-length, integer-decode-float ---------------------------------------- */
+ return(newstr);
+}
-static s7_pointer g_integer_length(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_string_append(s7_scheme *sc, s7_pointer args)
{
- #define H_integer_length "(integer-length arg) returns the number of bits required to represent the integer 'arg': (ceiling (log (abs arg) 2))"
- #define Q_integer_length pcl_i
-
- s7_int x;
- s7_pointer p;
+ #define H_string_append "(string-append str1 ...) appends all its string arguments into one string"
+ #define Q_string_append pcl_s
+ return(g_string_append_1(sc, args, false));
+}
- p = car(args);
- if (!s7_is_integer(p))
- method_or_bust(sc, p, sc->integer_length_symbol, args, T_INTEGER, 0);
+static s7_pointer string_append_to_temp;
+static s7_pointer g_string_append_to_temp(s7_scheme *sc, s7_pointer args)
+{
+ return(g_string_append_1(sc, args, true));
+}
- x = s7_integer(p);
- if (x < 0)
- return(make_integer(sc, integer_length(-(x + 1))));
- return(make_integer(sc, integer_length(x)));
+#if (!WITH_PURE_S7)
+static s7_pointer g_string_copy(s7_scheme *sc, s7_pointer args)
+{
+ #define H_string_copy "(string-copy str) returns a copy of its string argument"
+ #define Q_string_copy s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_string_symbol)
+ s7_pointer p;
+ p = car(args);
+ if (!is_string(p))
+ method_or_bust(sc, p, sc->string_copy_symbol, args, T_STRING, 1);
+ return(s7_make_string_with_length(sc, string_value(p), string_length(p)));
}
-
-#if (!WITH_GMP)
-static s7_int c_integer_length(s7_scheme *sc, s7_int arg) {return((arg < 0) ? integer_length(-(arg + 1)) : integer_length(arg));}
-IF_TO_IF(integer_length, c_integer_length)
#endif
-#endif /* !pure s7 */
-static s7_pointer g_integer_decode_float(s7_scheme *sc, s7_pointer args)
+/* -------------------------------- substring -------------------------------- */
+static s7_pointer start_and_end(s7_scheme *sc, s7_pointer caller, s7_pointer fallback,
+ s7_pointer start_and_end_args, s7_pointer args, int position, s7_int *start, s7_int *end)
{
- #define H_integer_decode_float "(integer-decode-float x) returns a list containing the significand, exponent, and \
-sign of 'x' (1 = positive, -1 = negative). (integer-decode-float 0.0): (0 0 1)"
- #define Q_integer_decode_float s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_float_symbol)
-
- /* no matter what s7_double is, integer-decode-float acts as if x is a C double */
-
- typedef struct decode_float_t {
- union {
- long long int ix;
- double fx;
- } value;
- } decode_float_t;
-
- decode_float_t num;
- s7_pointer x;
- x = car(args);
+ /* we assume that *start=0 and *end=length, that end is "exclusive"
+ * return true if the start/end points are not changed.
+ */
+ s7_pointer pstart, pend, p;
+ s7_int index;
- switch (type(x))
+#if DEBUGGING
+ if (is_null(start_and_end_args))
{
- case T_REAL:
- num.value.fx = (double)real(x);
- break;
-
-#if WITH_GMP
- case T_BIG_REAL:
- num.value.fx = (double)real_to_double(sc, x, "integer-decode-float");
- break;
+ fprintf(stderr, "start_and_end_args is null\n");
+ return(sc->gc_nil);
+ }
#endif
- default:
- method_or_bust_with_type(sc, x, sc->integer_decode_float_symbol, args, make_string_wrapper(sc, "a non-rational real"), 0);
+ pstart = car(start_and_end_args);
+ if (!s7_is_integer(pstart))
+ {
+ if (!s7_is_integer(p = check_values(sc, pstart, start_and_end_args)))
+ {
+ check_two_methods(sc, pstart, caller, fallback, args);
+ return(wrong_type_argument(sc, caller, position, pstart, T_INTEGER));
+ }
+ else pstart = p;
}
- if (num.value.fx == 0.0)
- return(list_3(sc, small_int(0), small_int(0), small_int(1)));
-
- return(list_3(sc,
- make_integer(sc, (s7_int)((num.value.ix & 0xfffffffffffffLL) | 0x10000000000000LL)),
- make_integer(sc, (s7_int)(((num.value.ix & 0x7fffffffffffffffLL) >> 52) - 1023 - 52)),
- make_integer(sc, ((num.value.ix & 0x8000000000000000LL) != 0) ? -1 : 1)));
-}
-
+ index = s7_integer(pstart);
+ if ((index < 0) ||
+ (index > *end)) /* *end == length here */
+ return(out_of_range(sc, caller, small_int(position), pstart, (index < 0) ? its_negative_string : its_too_large_string));
+ *start = index;
-/* -------------------------------- logior -------------------------------- */
-static s7_pointer g_logior(s7_scheme *sc, s7_pointer args)
-{
- #define H_logior "(logior int ...) returns the bitwise OR of its integer arguments (the bits that are on in any of the arguments)"
- #define Q_logior pcl_i
- s7_int result = 0;
- s7_pointer x;
+ if (is_null(cdr(start_and_end_args)))
+ return(sc->gc_nil);
- for (x = args; is_not_null(x); x = cdr(x))
+ pend = cadr(start_and_end_args);
+ if (!s7_is_integer(pend))
{
- if (!s7_is_integer(car(x)))
- method_or_bust(sc, car(x), sc->logior_symbol, cons(sc, make_integer(sc, result), x), T_INTEGER, position_of(x, args));
- result |= s7_integer(car(x));
+ if (!s7_is_integer(p = check_values(sc, pend, cdr(start_and_end_args))))
+ {
+ check_two_methods(sc, pend, caller, fallback,
+ (position == 2) ? list_3(sc, car(args), pstart, pend) : list_4(sc, car(args), cadr(args), pstart, pend));
+ return(wrong_type_argument(sc, caller, position + 1, pend, T_INTEGER));
+ }
+ else pend = p;
}
- return(make_integer(sc, result));
+ index = s7_integer(pend);
+ if ((index < *start) ||
+ (index > *end))
+ return(out_of_range(sc, caller, small_int(position + 1), pend, (index < *start) ? its_too_small_string : its_too_large_string));
+ *end = index;
+ return(sc->gc_nil);
}
-#if (!WITH_GMP)
-static s7_int c_logior(s7_scheme *sc, s7_int x, s7_int y) {return(x | y);}
-IF2_TO_IF(logior, c_logior)
-#endif
-
-/* -------------------------------- logxor -------------------------------- */
-static s7_pointer g_logxor(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_substring(s7_scheme *sc, s7_pointer args)
{
- #define H_logxor "(logxor int ...) returns the bitwise XOR of its integer arguments (the bits that are on in an odd number of the arguments)"
- #define Q_logxor pcl_i
- s7_int result = 0;
- s7_pointer x;
+ #define H_substring "(substring str start (end (length str))) returns the portion of the string str between start and \
+end: (substring \"01234\" 1 2) -> \"1\""
+ #define Q_substring s7_make_circular_signature(sc, 2, 3, sc->is_string_symbol, sc->is_string_symbol, sc->is_integer_symbol)
- for (x = args; is_not_null(x); x = cdr(x))
+ s7_pointer x, str;
+ s7_int start = 0, end;
+ int len;
+ char *s;
+
+ str = car(args);
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->substring_symbol, args, T_STRING, 1);
+
+ end = string_length(str);
+ if (!is_null(cdr(args)))
{
- if (!s7_is_integer(car(x)))
- method_or_bust(sc, car(x), sc->logxor_symbol, cons(sc, make_integer(sc, result), x), T_INTEGER, position_of(x, args));
- result ^= s7_integer(car(x));
+ x = start_and_end(sc, sc->substring_symbol, NULL, cdr(args), args, 2, &start, &end);
+ if (x != sc->gc_nil) return(x);
}
- return(make_integer(sc, result));
+ s = string_value(str);
+ len = (int)(end - start);
+ x = s7_make_string_with_length(sc, (char *)(s + start), len);
+ string_value(x)[len] = 0;
+ return(x);
}
-#if (!WITH_GMP)
-static s7_int c_logxor(s7_scheme *sc, s7_int x, s7_int y) {return(x ^ y);}
-IF2_TO_IF(logxor, c_logxor)
-#endif
-
-/* -------------------------------- logand -------------------------------- */
-static s7_pointer g_logand(s7_scheme *sc, s7_pointer args)
+static s7_pointer substring_to_temp;
+static s7_pointer g_substring_to_temp(s7_scheme *sc, s7_pointer args)
{
- #define H_logand "(logand int ...) returns the bitwise AND of its integer arguments (the bits that are on in every argument)"
- #define Q_logand pcl_i
- s7_int result = -1;
- s7_pointer x;
+ s7_pointer str;
+ s7_int start = 0, end;
- for (x = args; is_not_null(x); x = cdr(x))
+ str = car(args);
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->substring_symbol, args, T_STRING, 1);
+
+ end = string_length(str);
+ if (!is_null(cdr(args)))
{
- if (!s7_is_integer(car(x)))
- method_or_bust(sc, car(x), sc->logand_symbol, cons(sc, make_integer(sc, result), x), T_INTEGER, position_of(x, args));
- result &= s7_integer(car(x));
+ s7_pointer x;
+ x = start_and_end(sc, sc->substring_symbol, NULL, cdr(args), args, 2, &start, &end);
+ if (x != sc->gc_nil) return(x);
}
- return(make_integer(sc, result));
+ return(make_temporary_string(sc, (const char *)(string_value(str) + start), (int)(end - start)));
}
-#if (!WITH_GMP)
-static s7_int c_logand(s7_scheme *sc, s7_int x, s7_int y) {return(x & y);}
-IF2_TO_IF(logand, c_logand)
-#endif
-
-
-/* -------------------------------- lognot -------------------------------- */
-static s7_pointer g_lognot(s7_scheme *sc, s7_pointer args)
+/* -------------------------------- object->string -------------------------------- */
+static use_write_t write_choice(s7_scheme *sc, s7_pointer arg)
{
- #define H_lognot "(lognot num) returns the bitwise negation (the complement, the bits that are not on) in num: (lognot 0) -> -1"
- #define Q_lognot pcl_i
- if (!s7_is_integer(car(args)))
- method_or_bust(sc, car(args), sc->lognot_symbol, args, T_INTEGER, 0);
- return(make_integer(sc, ~s7_integer(car(args))));
+ if (arg == sc->F) return(USE_DISPLAY);
+ if (arg == sc->T) return(USE_WRITE);
+ if (arg == sc->key_readable_symbol) return(USE_READABLE_WRITE);
+ return(USE_WRITE_WRONG);
}
-#if (!WITH_GMP)
-static s7_int c_lognot(s7_scheme *sc, s7_int arg) {return(~arg);}
-IF_TO_IF(lognot, c_lognot)
-#endif
-
-
-/* -------------------------------- logbit? -------------------------------- */
-/* logbit? CL is (logbitp index int) using 2^index, but that order strikes me as backwards
- * at least gmp got the arg order right!
- */
-
-static s7_pointer g_logbit(s7_scheme *sc, s7_pointer args)
-{
- #define H_logbit "(logbit? int index) returns #t if the index-th bit is on in int, otherwise #f. The argument \
-order here follows gmp, and is the opposite of the CL convention. (logbit? int bit) is the same as (not (zero? (logand int (ash 1 bit))))."
- #define Q_logbit s7_make_circular_signature(sc, 1, 2, sc->is_boolean_symbol, sc->is_integer_symbol)
-
- s7_pointer x, y;
- s7_int index; /* index in gmp is mp_bitcnt which is an unsigned long int */
-
- x = car(args);
- y = cadr(args);
-
- if (!s7_is_integer(x))
- method_or_bust(sc, x, sc->logbit_symbol, args, T_INTEGER, 1);
- if (!s7_is_integer(y))
- method_or_bust(sc, y, sc->logbit_symbol, args, T_INTEGER, 2);
-
- index = s7_integer(y);
- if (index < 0)
- return(out_of_range(sc, sc->logbit_symbol, small_int(2), y, its_negative_string));
-
-#if WITH_GMP
- if (is_t_big_integer(x))
- return(make_boolean(sc, (mpz_tstbit(big_integer(x), index) != 0)));
-#endif
-
- if (index >= s7_int_bits) /* not sure about the >: (logbit? -1 64) ?? */
- return(make_boolean(sc, integer(x) < 0));
-
- /* :(zero? (logand most-positive-fixnum (ash 1 63)))
- * -> ash argument 2, 63, is out of range (shift is too large)
- * so logbit? has a wider range than the logand/ash shuffle above.
- */
+#define DONT_USE_DISPLAY(Choice) ((Choice == USE_DISPLAY) ? USE_WRITE : Choice)
- /* all these long long ints are necessary, else C turns it into an int, gets confused about signs etc */
- return(make_boolean(sc, ((((long long int)(1LL << (long long int)index)) & (long long int)integer(x)) != 0)));
-}
+static char *s7_object_to_c_string_1(s7_scheme *sc, s7_pointer obj, use_write_t use_write, int *nlen);
-/* -------------------------------- ash -------------------------------- */
-static s7_int c_ash(s7_scheme *sc, s7_int arg1, s7_int arg2)
+static s7_pointer g_object_to_string(s7_scheme *sc, s7_pointer args)
{
- if (arg1 == 0) return(0);
+ #define H_object_to_string "(object->string obj (write #t) (max-len most-positive-fixnum)) returns a string representation of obj."
+ #define Q_object_to_string s7_make_signature(sc, 4, sc->is_string_symbol, sc->T, s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_keyword_symbol), sc->is_integer_symbol)
- if (arg2 >= s7_int_bits)
- out_of_range(sc, sc->ash_symbol, small_int(2), make_integer(sc, arg2), its_too_large_string);
+ use_write_t choice;
+ char *str;
+ s7_pointer obj;
+ int out_len = 0;
+ sc->objstr_max_len = s7_int_max;
- if (arg2 < -s7_int_bits)
+ if (is_not_null(cdr(args)))
{
- if (arg1 < 0) /* (ash -31 -100) */
- return(-1);
- return(0);
- }
+ choice = write_choice(sc, cadr(args));
+ if (choice == USE_WRITE_WRONG)
+ method_or_bust(sc, cadr(args), sc->object_to_string_symbol, args, T_BOOLEAN, 2);
- /* I can't see any point in protecting this: (ash 9223372036854775807 1) -> -2, but anyone using ash must know something about bits */
- if (arg2 >= 0)
- {
- if (arg1 < 0)
+ if (is_not_null(cddr(args)))
{
- unsigned long long int z;
- z = (unsigned long long int)arg1;
- return((s7_int)(z << arg2));
+ if (!is_integer(caddr(args)))
+ return(wrong_type_argument(sc, sc->object_to_string_symbol, 3, caddr(args), T_INTEGER));
+ sc->objstr_max_len = integer(caddr(args));
}
- return(arg1 << arg2);
}
- return(arg1 >> -arg2);
-}
-
-static s7_pointer g_ash(s7_scheme *sc, s7_pointer args)
-{
- #define H_ash "(ash i1 i2) returns i1 shifted right or left i2 times, i1 << i2, (ash 1 3) -> 8, (ash 8 -3) -> 1"
- #define Q_ash pcl_i
- s7_pointer x, y;
-
- x = car(args);
- if (!s7_is_integer(x))
- method_or_bust(sc, x, sc->ash_symbol, args, T_INTEGER, 1);
-
- y = cadr(args);
- if (!s7_is_integer(y))
- method_or_bust(sc, y, sc->ash_symbol, args, T_INTEGER, 2);
+ else choice = USE_WRITE;
+ /* can't use s7_object_to_string here anymore because it assumes use_write arg is a boolean */
- return(make_integer(sc, c_ash(sc, s7_integer(x), s7_integer(y))));
+ obj = car(args);
+ check_method(sc, obj, sc->object_to_string_symbol, args);
+ str = s7_object_to_c_string_1(sc, obj, choice, &out_len);
+ sc->objstr_max_len = s7_int_max;
+ if (str)
+ return(make_string_uncopied_with_length(sc, str, out_len));
+ return(s7_make_string_with_length(sc, "", 0));
}
-#if (!WITH_GMP)
-IF2_TO_IF(ash, c_ash)
-#endif
+/* -------------------------------- string comparisons -------------------------------- */
+static int scheme_strcmp(s7_pointer s1, s7_pointer s2)
+{
+ /* tricky here because str[i] must be treated as unsigned
+ * (string<? (string (integer->char #xf0)) (string (integer->char #x70)))
+ * also null or lack thereof does not say anything about the string end
+ * so we have to go by its length.
+ */
+ int i, len, len1, len2;
+ char *str1, *str2;
-/* ---------------------------------------- random ---------------------------------------- */
+ len1 = string_length(s1);
+ len2 = string_length(s2);
+ if (len1 > len2)
+ len = len2;
+ else len = len1;
-/* random numbers. The simple version used in clm.c is probably adequate,
- * but here I'll use Marsaglia's MWC algorithm.
- * (random num) -> a number (0..num), if num == 0 return 0, use global default state
- * (random num state) -> same but use this state
- * (random-state seed) -> make a new state
- * to save the current seed, use copy
- * to save it across load, random-state->list and list->random-state.
- * random-state? returns #t if its arg is one of these guys
- */
+ str1 = string_value(s1);
+ str2 = string_value(s2);
-#if (!WITH_GMP)
-s7_pointer s7_random_state(s7_scheme *sc, s7_pointer args)
-{
- #define H_random_state "(random-state seed (carry plausible-default)) returns a new random number state initialized with 'seed'. \
-Pass this as the second argument to 'random' to get a repeatable random number sequence:\n\
- (let ((seed (random-state 1234))) (random 1.0 seed))"
- #define Q_random_state s7_make_circular_signature(sc, 1, 2, sc->is_random_state_symbol, sc->is_integer_symbol)
+ for (i = 0; i < len; i++)
+ if ((unsigned char)(str1[i]) < (unsigned char )(str2[i]))
+ return(-1);
+ else
+ {
+ if ((unsigned char)(str1[i]) > (unsigned char)(str2[i]))
+ return(1);
+ }
- s7_pointer r1, r2, p;
- s7_int i1, i2;
+ if (len1 < len2)
+ return(-1);
+ if (len1 > len2)
+ return(1);
+ return(0);
+}
- r1 = car(args);
- if (!s7_is_integer(r1))
- method_or_bust(sc, r1, sc->random_state_symbol, args, T_INTEGER, 1);
- i1 = s7_integer(r1);
- if (i1 < 0)
- return(out_of_range(sc, sc->random_state_symbol, small_int(1), r1, its_negative_string));
- if (is_null(cdr(args)))
+static bool is_string_via_method(s7_scheme *sc, s7_pointer p)
+{
+ if (s7_is_string(p))
+ return(true);
+ if (has_methods(p))
{
- new_cell(sc, p, T_RANDOM_STATE);
- random_seed(p) = (unsigned long long int)i1;
- random_carry(p) = 1675393560; /* should this be dependent on the seed? */
- return(p);
+ s7_pointer f;
+ f = find_method(sc, find_let(sc, p), sc->is_string_symbol);
+ if (f != sc->undefined)
+ return(is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->nil))));
}
-
- r2 = cadr(args);
- if (!s7_is_integer(r2))
- method_or_bust(sc, r2, sc->random_state_symbol, args, T_INTEGER, 2);
- i2 = s7_integer(r2);
- if (i2 < 0)
- return(out_of_range(sc, sc->random_state_symbol, small_int(2), r2, its_negative_string));
-
- new_cell(sc, p, T_RANDOM_STATE);
- random_seed(p) = (unsigned long long int)i1;
- random_carry(p) = (unsigned long long int)i2;
- return(p);
+ return(false);
}
-#define g_random_state s7_random_state
+static s7_pointer g_string_cmp(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
+{
+ s7_pointer x, y;
-static s7_pointer c_random_state(s7_scheme *sc, s7_pointer x) {return(s7_random_state(sc, set_plist_1(sc, x)));}
-PF_TO_PF(random_state, c_random_state)
-#endif
+ y = car(args);
+ if (!is_string(y))
+ method_or_bust(sc, y, sym, args, T_STRING, 1);
-static s7_pointer rng_copy(s7_scheme *sc, s7_pointer args)
-{
-#if WITH_GMP
- return(sc->F); /* I can't find a way to copy a gmp random generator */
-#else
- s7_pointer obj;
- obj = car(args);
- if (is_random_state(obj))
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
{
- s7_pointer new_r;
- new_cell(sc, new_r, T_RANDOM_STATE);
- random_seed(new_r) = random_seed(obj);
- random_carry(new_r) = random_carry(obj);
- return(new_r);
+ if (!is_string(car(x)))
+ method_or_bust(sc, car(x), sym, cons(sc, y, x), T_STRING, position_of(x, args));
+ if (scheme_strcmp(y, car(x)) != val)
+ {
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_string_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_STRING));
+ return(sc->F);
+ }
+ y = car(x);
}
- return(sc->F);
-#endif
+ return(sc->T);
}
-static s7_pointer g_is_random_state(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_string_cmp_not(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
{
- #define H_is_random_state "(random-state? obj) returns #t if obj is a random-state object (from random-state)."
- #define Q_is_random_state pl_bt
- check_boolean_method(sc, is_random_state, sc->is_random_state_symbol, args);
-}
+ s7_pointer x, y;
-s7_pointer s7_random_state_to_list(s7_scheme *sc, s7_pointer args)
-{
- #define H_random_state_to_list "(random-state->list r) returns the random state object as a list.\
-You can later apply random-state to this list to continue a random number sequence from any point."
- #define Q_random_state_to_list s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_random_state_symbol)
+ y = car(args);
+ if (!is_string(y))
+ method_or_bust(sc, y, sym, args, T_STRING, 1);
-#if WITH_GMP
- if ((is_pair(args)) &&
- (!is_random_state(car(args))))
- method_or_bust_with_type(sc, car(args), sc->random_state_to_list_symbol, args, a_random_state_object_string, 1);
- return(sc->nil);
-#else
- s7_pointer r;
- if (is_null(args))
- r = sc->default_rng;
- else
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
{
- r = car(args);
- if (!is_random_state(r))
- method_or_bust_with_type(sc, r, sc->random_state_to_list_symbol, args, a_random_state_object_string, 1);
+ if (!is_string(car(x)))
+ method_or_bust(sc, car(x), sym, cons(sc, y, x), T_STRING, position_of(x, args));
+ if (scheme_strcmp(y, car(x)) == val)
+ {
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_string_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_STRING));
+ return(sc->F);
+ }
+ y = car(x);
}
- return(list_2(sc, make_integer(sc, random_seed(r)), make_integer(sc, random_carry(r))));
-#endif
+ return(sc->T);
}
-#define g_random_state_to_list s7_random_state_to_list
-
-static s7_pointer c_random_state_to_list(s7_scheme *sc, s7_pointer x) {return(s7_random_state_to_list(sc, set_plist_1(sc, x)));}
-PF_TO_PF(random_state_to_list, c_random_state_to_list)
-
-void s7_set_default_random_state(s7_scheme *sc, s7_int seed, s7_int carry)
+static bool scheme_strings_are_equal(s7_pointer x, s7_pointer y)
{
-#if (!WITH_GMP)
- s7_pointer p;
- new_cell(sc, p, T_RANDOM_STATE);
- random_seed(p) = (unsigned long long int)seed;
- random_carry(p) = (unsigned long long int)carry;
- sc->default_rng = p;
-#endif
+ return((string_length(x) == string_length(y)) &&
+ (strings_are_equal_with_length(string_value(x), string_value(y), string_length(x))));
}
-#if (!WITH_GMP)
-/* -------------------------------- random -------------------------------- */
-static double next_random(s7_pointer r)
+static s7_pointer g_strings_are_equal(s7_scheme *sc, s7_pointer args)
{
- /* The multiply-with-carry generator for 32-bit integers:
- * x(n)=a*x(n-1) + carry mod 2^32
- * Choose multiplier a from this list:
- * 1791398085 1929682203 1683268614 1965537969 1675393560
- * 1967773755 1517746329 1447497129 1655692410 1606218150
- * 2051013963 1075433238 1557985959 1781943330 1893513180
- * 1631296680 2131995753 2083801278 1873196400 1554115554
- * ( or any 'a' for which both a*2^32-1 and a*2^31-1 are prime)
- */
- double result;
- unsigned long long int temp;
- #define RAN_MULT 2131995753UL
+ #define H_strings_are_equal "(string=? str ...) returns #t if all the string arguments are equal"
+ #define Q_strings_are_equal pcl_bs
- temp = random_seed(r) * RAN_MULT + random_carry(r);
- random_seed(r) = (temp & 0xffffffffUL);
- random_carry(r) = (temp >> 32);
- result = (double)((unsigned int)(random_seed(r))) / 4294967295.5;
- /* divisor was 2^32-1 = 4294967295.0, but somehow this can round up once in a billion tries?
- * do we want the double just less than 2^32?
+ /* C-based check stops at null, but we can have embedded nulls.
+ * (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2))
*/
+ s7_pointer x, y;
+ bool happy = true;
- /* (let ((mx 0) (mn 1000)) (do ((i 0 (+ i 1))) ((= i 10000)) (let ((val (random 123))) (set! mx (max mx val)) (set! mn (min mn val)))) (list mn mx)) */
- return(result);
+ y = car(args);
+ if (!is_string(y))
+ method_or_bust(sc, y, sc->string_eq_symbol, args, T_STRING, 1);
+
+ for (x = cdr(args); is_pair(x); x = cdr(x))
+ {
+ s7_pointer p;
+ p = car(x);
+ if (y != p)
+ {
+ if (!is_string(p))
+ method_or_bust(sc, p, sc->string_eq_symbol, cons(sc, y, x), T_STRING, position_of(x, args));
+ if (happy)
+ happy = scheme_strings_are_equal(p, y);
+ }
+ }
+ if (!happy)
+ return(sc->F);
+ return(sc->T);
}
-s7_double s7_random(s7_scheme *sc, s7_pointer state)
+static s7_pointer g_strings_are_less(s7_scheme *sc, s7_pointer args)
{
- if (!state)
- return(next_random(sc->default_rng));
- return(next_random(state));
+ #define H_strings_are_less "(string<? str ...) returns #t if all the string arguments are increasing"
+ #define Q_strings_are_less pcl_bs
+
+ return(g_string_cmp(sc, args, -1, sc->string_lt_symbol));
}
-static s7_pointer g_random(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_strings_are_greater(s7_scheme *sc, s7_pointer args)
{
- #define H_random "(random num (state #f)) returns a random number between 0 and num (0 if num=0)."
- #define Q_random s7_make_signature(sc, 3, sc->is_number_symbol, sc->is_number_symbol, sc->is_random_state_symbol)
- s7_pointer r, num;
-
- num = car(args);
- if (!s7_is_number(num))
- method_or_bust_with_type(sc, num, sc->random_symbol, args, a_number_string, 1);
-
- if (is_not_null(cdr(args)))
- {
- r = cadr(args);
- if (!is_random_state(r))
- method_or_bust_with_type(sc, r, sc->random_symbol, args, a_random_state_object_string, 2);
- }
- else r = sc->default_rng;
+ #define H_strings_are_greater "(string>? str ...) returns #t if all the string arguments are decreasing"
+ #define Q_strings_are_greater pcl_bs
- switch (type(num))
- {
- case T_INTEGER:
- return(make_integer(sc, (s7_int)(integer(num) * next_random(r))));
+ return(g_string_cmp(sc, args, 1, sc->string_gt_symbol));
+}
- case T_RATIO:
- {
- s7_double x, error;
- s7_int numer = 0, denom = 1;
- /* the error here needs to take the size of the fraction into account. Otherwise, if
- * error is (say) 1e-6 and the fraction is (say) 9000000/9223372036854775807,
- * c_rationalize will always return 0. But even that isn't foolproof:
- * (random 1/562949953421312) -> 1/376367230475000
- */
- x = fraction(num);
- if ((x < 1.0e-10) && (x > -1.0e-10))
- {
- /* 1e-12 is not tight enough:
- * (random 1/2251799813685248) -> 1/2250240579436280
- * (random -1/4503599627370496) -> -1/4492889778435526
- * (random 1/140737488355328) -> 1/140730223985746
- * (random -1/35184372088832) -> -1/35183145492420
- * (random -1/70368744177664) -> -1/70366866392738
- * (random 1/4398046511104) -> 1/4398033095756
- * (random 1/137438953472) -> 1/137438941127
- */
- if (numerator(num) < -10)
- numer = -(s7_int)(floor(-numerator(num) * next_random(r)));
- else
- {
- if (numerator(num) > 10)
- numer = (s7_int)floor(numerator(num) * next_random(r));
- else
- {
- long long int diff;
- numer = numerator(num);
- diff = s7_int_max - denominator(num);
- if (diff < 100)
- return(s7_make_ratio(sc, numer, denominator(num)));
- denom = denominator(num) + (s7_int)floor(diff * next_random(r));
- return(s7_make_ratio(sc, numer, denom));
- }
- }
- return(s7_make_ratio(sc, numer, denominator(num)));
- }
- if ((x < 1e-6) && (x > -1e-6))
- error = 1e-18;
- else error = 1e-12;
- c_rationalize(x * next_random(r), error, &numer, &denom);
- return(s7_make_ratio(sc, numer, denom));
- }
- case T_REAL:
- return(make_real(sc, real(num) * next_random(r)));
+static s7_pointer g_strings_are_geq(s7_scheme *sc, s7_pointer args)
+{
+ #define H_strings_are_geq "(string>=? str ...) returns #t if all the string arguments are equal or decreasing"
+ #define Q_strings_are_geq pcl_bs
- case T_COMPLEX:
- return(s7_make_complex(sc, real_part(num) * next_random(r), imag_part(num) * next_random(r)));
- }
- return(sc->F);
+ return(g_string_cmp_not(sc, args, -1, sc->string_geq_symbol));
}
-static s7_int c_random_i(s7_scheme *sc, s7_int arg) {return((s7_int)(arg * next_random(sc->default_rng)));} /* not round! */
-IF_TO_IF(random, c_random_i)
-static s7_double c_random_r(s7_scheme *sc, s7_double arg) {return(arg * next_random(sc->default_rng));}
-RF_TO_RF(random, c_random_r)
-
-static s7_pointer random_ic, random_rc, random_i;
-static s7_pointer g_random_ic(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_strings_are_leq(s7_scheme *sc, s7_pointer args)
{
- return(make_integer(sc, (s7_int)(integer(car(args)) * next_random(sc->default_rng))));
-}
+ #define H_strings_are_leq "(string<=? str ...) returns #t if all the string arguments are equal or increasing"
+ #define Q_strings_are_leq pcl_bs
-static s7_pointer g_random_i(s7_scheme *sc, s7_pointer args)
-{
- return(make_integer(sc, (s7_int)(integer(slot_value(global_slot(car(args)))) * next_random(sc->default_rng))));
+ return(g_string_cmp_not(sc, args, 1, sc->string_leq_symbol));
}
-static s7_pointer g_random_rc(s7_scheme *sc, s7_pointer args)
+static s7_pointer string_equal_2;
+static s7_pointer g_string_equal_2(s7_scheme *sc, s7_pointer args)
{
- return(make_real(sc, real(car(args)) * next_random(sc->default_rng)));
+ if (!is_string(car(args)))
+ method_or_bust(sc, car(args), sc->string_eq_symbol, args, T_STRING, 1);
+ if (!is_string(cadr(args)))
+ method_or_bust(sc, cadr(args), sc->string_eq_symbol, args, T_STRING, 2);
+ return(make_boolean(sc, scheme_strings_are_equal(car(args), cadr(args))));
}
-static s7_pointer random_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+
+static s7_pointer string_less_2;
+static s7_pointer g_string_less_2(s7_scheme *sc, s7_pointer args)
{
- if (args == 1)
- {
- s7_pointer arg1;
- arg1 = cadr(expr);
- if (s7_is_integer(arg1))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(random_ic);
- }
- if ((is_real(arg1)) &&
- (!is_rational(arg1)))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(random_rc);
- }
- if ((is_symbol(arg1)) &&
- (is_immutable_symbol(arg1)) &&
- (is_global(arg1)) &&
- (is_integer(slot_value(global_slot(arg1)))))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(random_i);
- }
- }
- return(f);
+ if (!is_string(car(args)))
+ method_or_bust(sc, car(args), sc->string_lt_symbol, args, T_STRING, 1);
+ if (!is_string(cadr(args)))
+ method_or_bust(sc, cadr(args), sc->string_lt_symbol, args, T_STRING, 2);
+ return(make_boolean(sc, scheme_strcmp(car(args), cadr(args)) == -1));
}
-#endif /* gmp */
-
-/* -------------------------------- characters -------------------------------- */
-
-#define NUM_CHARS 256
-
-static s7_pointer g_char_to_integer(s7_scheme *sc, s7_pointer args)
+static s7_pointer string_greater_2;
+static s7_pointer g_string_greater_2(s7_scheme *sc, s7_pointer args)
{
- #define H_char_to_integer "(char->integer c) converts the character c to an integer"
- #define Q_char_to_integer s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_char_symbol)
-
- if (!s7_is_character(car(args)))
- method_or_bust(sc, car(args), sc->char_to_integer_symbol, args, T_CHARACTER, 0);
- return(small_int(character(car(args))));
+ if (!is_string(car(args)))
+ method_or_bust(sc, car(args), sc->string_gt_symbol, args, T_STRING, 1);
+ if (!is_string(cadr(args)))
+ method_or_bust(sc, cadr(args), sc->string_gt_symbol, args, T_STRING, 2);
+ return(make_boolean(sc, scheme_strcmp(car(args), cadr(args)) == 1));
}
-#define int_method_or_bust(Sc, Obj, Method, Args, Type, Num) \
- { \
- s7_pointer func; \
- if ((has_methods(Obj)) && ((func = find_method(Sc, find_let(Sc, Obj), Method)) != Sc->undefined)) \
- return(integer(s7_apply_function(Sc, func, Args))); \
- if (Num == 0) simple_wrong_type_argument(Sc, Method, Obj, Type); \
- wrong_type_argument(Sc, Method, Num, Obj, Type); \
- }
-
-static s7_int c_char_to_integer(s7_scheme *sc, s7_pointer p)
+static void check_string2_args(s7_scheme *sc, s7_pointer caller, s7_pointer p1, s7_pointer p2)
{
- if (!s7_is_character(p))
- int_method_or_bust(sc, p, sc->char_to_integer_symbol, set_plist_1(sc, p), T_CHARACTER, 0);
- return(character(p));
+ if (!is_string(p1))
+ simple_wrong_type_argument(sc, caller, p1, T_STRING);
+ if (!s7_is_string(p2))
+ simple_wrong_type_argument(sc, caller, p2, T_STRING);
}
-PF_TO_IF(char_to_integer, c_char_to_integer)
-
-
-static s7_pointer c_int_to_char(s7_scheme *sc, s7_int ind)
+static bool string_lt_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcmp(p1, p2) == -1);}
+static bool string_lt_b(s7_pointer p1, s7_pointer p2)
{
- if ((ind < 0) || (ind >= NUM_CHARS))
- return(simple_wrong_type_argument_with_type(sc, sc->integer_to_char_symbol, make_integer(sc, ind),
- make_string_wrapper(sc, "an integer that can represent a character")));
- return(s7_make_character(sc, (unsigned char)ind));
+ check_string2_args(cur_sc, cur_sc->string_lt_symbol, p1, p2);
+ return(scheme_strcmp(p1, p2) == -1);
}
-static s7_pointer c_integer_to_char(s7_scheme *sc, s7_pointer x)
+static bool string_leq_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcmp(p1, p2) != 1);}
+static bool string_leq_b(s7_pointer p1, s7_pointer p2)
{
- s7_int ind;
- if (!s7_is_integer(x))
- method_or_bust(sc, x, sc->integer_to_char_symbol, list_1(sc, x), T_INTEGER, 0);
- ind = s7_integer(x);
- if ((ind < 0) || (ind >= NUM_CHARS))
- return(simple_wrong_type_argument_with_type(sc, sc->integer_to_char_symbol, x, make_string_wrapper(sc, "an integer that can represent a character")));
- return(s7_make_character(sc, (unsigned char)ind));
+ check_string2_args(cur_sc, cur_sc->string_leq_symbol, p1, p2);
+ return(scheme_strcmp(p1, p2) != 1);
}
-static s7_pointer g_integer_to_char(s7_scheme *sc, s7_pointer args)
+static bool string_gt_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcmp(p1, p2) == 1);}
+static bool string_gt_b(s7_pointer p1, s7_pointer p2)
{
- #define H_integer_to_char "(integer->char i) converts the non-negative integer i to a character"
- #define Q_integer_to_char s7_make_signature(sc, 2, sc->is_char_symbol, sc->is_integer_symbol)
- return(c_integer_to_char(sc, car(args)));
+ check_string2_args(cur_sc, cur_sc->string_gt_symbol, p1, p2);
+ return(scheme_strcmp(p1, p2) == 1);
}
-IF_TO_PF(integer_to_char, c_int_to_char)
-
-
-static unsigned char uppers[256], lowers[256];
-static void init_uppers(void)
+static bool string_geq_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcmp(p1, p2) != -1);}
+static bool string_geq_b(s7_pointer p1, s7_pointer p2)
{
- int i;
- for (i = 0; i < 256; i++)
- {
- uppers[i] = (unsigned char)toupper(i);
- lowers[i] = (unsigned char)tolower(i);
- }
+ check_string2_args(cur_sc, cur_sc->string_geq_symbol, p1, p2);
+ return(scheme_strcmp(p1, p2) != -1);
}
-static s7_pointer c_char_upcase(s7_scheme *sc, s7_pointer arg)
+static bool string_eq_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strings_are_equal(p1, p2));}
+static bool string_eq_b(s7_pointer p1, s7_pointer p2)
{
- if (!s7_is_character(arg))
- method_or_bust(sc, arg, sc->char_upcase_symbol, set_plist_1(sc, arg), T_CHARACTER, 0);
- return(s7_make_character(sc, upper_character(arg)));
+ check_string2_args(cur_sc, cur_sc->string_eq_symbol, p1, p2);
+ return(scheme_strings_are_equal(p1, p2));
}
-static s7_pointer g_char_upcase(s7_scheme *sc, s7_pointer args)
-{
- #define H_char_upcase "(char-upcase c) converts the character c to upper case"
- #define Q_char_upcase pcl_c
- if (!s7_is_character(car(args)))
- method_or_bust(sc, car(args), sc->char_upcase_symbol, args, T_CHARACTER, 0);
- return(s7_make_character(sc, upper_character(car(args))));
-}
-
-PF_TO_PF(char_upcase, c_char_upcase)
+#if (!WITH_PURE_S7)
-static s7_pointer c_char_downcase(s7_scheme *sc, s7_pointer arg)
+static int scheme_strcasecmp(s7_pointer s1, s7_pointer s2)
{
- if (!s7_is_character(arg))
- method_or_bust(sc, arg, sc->char_downcase_symbol, set_plist_1(sc, arg), T_CHARACTER, 0);
- return(s7_make_character(sc, lowers[(int)character(arg)]));
-}
+ /* same as scheme_strcmp -- watch out for unwanted sign! and lack of trailing null (length sets string end).
+ */
+ int i, len, len1, len2;
+ unsigned char *str1, *str2;
-static s7_pointer g_char_downcase(s7_scheme *sc, s7_pointer args)
-{
- #define H_char_downcase "(char-downcase c) converts the character c to lower case"
- #define Q_char_downcase pcl_c
- if (!s7_is_character(car(args)))
- method_or_bust(sc, car(args), sc->char_downcase_symbol, args, T_CHARACTER, 0);
- return(s7_make_character(sc, lowers[character(car(args))]));
-}
+ len1 = string_length(s1);
+ len2 = string_length(s2);
+ if (len1 > len2)
+ len = len2;
+ else len = len1;
-PF_TO_PF(char_downcase, c_char_downcase)
+ str1 = (unsigned char *)string_value(s1);
+ str2 = (unsigned char *)string_value(s2);
+ for (i = 0; i < len; i++)
+ if (uppers[(int)str1[i]] < uppers[(int)str2[i]])
+ return(-1);
+ else
+ {
+ if (uppers[(int)str1[i]] > uppers[(int)str2[i]])
+ return(1);
+ }
-static s7_pointer c_is_char_alphabetic(s7_scheme *sc, s7_pointer arg)
-{
- if (!s7_is_character(arg))
- method_or_bust(sc, arg, sc->is_char_alphabetic_symbol, set_plist_1(sc, arg), T_CHARACTER, 0);
- return(make_boolean(sc, is_char_alphabetic(arg)));
+ if (len1 < len2)
+ return(-1);
+ if (len1 > len2)
+ return(1);
+ return(0);
}
-static s7_pointer g_is_char_alphabetic(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_char_alphabetic "(char-alphabetic? c) returns #t if the character c is alphabetic"
- #define Q_is_char_alphabetic pl_bc
- if (!s7_is_character(car(args)))
- method_or_bust(sc, car(args), sc->is_char_alphabetic_symbol, args, T_CHARACTER, 0);
- return(make_boolean(sc, is_char_alphabetic(car(args))));
- /* isalpha returns #t for (integer->char 226) and others in that range */
-}
+static bool scheme_strequal_ci(s7_pointer s1, s7_pointer s2)
+{
+ /* same as scheme_strcmp -- watch out for unwanted sign! */
+ int i, len, len2;
+ unsigned char *str1, *str2;
-PF_TO_PF(is_char_alphabetic, c_is_char_alphabetic)
+ len = string_length(s1);
+ len2 = string_length(s2);
+ if (len != len2)
+ return(false);
+ str1 = (unsigned char *)string_value(s1);
+ str2 = (unsigned char *)string_value(s2);
-static s7_pointer c_is_char_numeric(s7_scheme *sc, s7_pointer arg)
-{
- if (!s7_is_character(arg))
- method_or_bust(sc, arg, sc->is_char_numeric_symbol, set_plist_1(sc, arg), T_CHARACTER, 0);
- return(make_boolean(sc, is_char_numeric(arg)));
+ for (i = 0; i < len; i++)
+ if (uppers[(int)str1[i]] != uppers[(int)str2[i]])
+ return(false);
+ return(true);
}
-static s7_pointer g_is_char_numeric(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_char_numeric "(char-numeric? c) returns #t if the character c is a digit"
- #define Q_is_char_numeric pl_bc
- return(c_is_char_numeric(sc, car(args)));
-}
-PF_TO_PF(is_char_numeric, c_is_char_numeric)
+static s7_pointer g_string_ci_cmp(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
+{
+ s7_pointer x, y;
+ y = car(args);
+ if (!is_string(y))
+ method_or_bust(sc, y, sym, args, T_STRING, 1);
-static s7_pointer c_is_char_whitespace(s7_scheme *sc, s7_pointer arg)
-{
- if (!s7_is_character(arg))
- method_or_bust(sc, arg, sc->is_char_whitespace_symbol, set_plist_1(sc, arg), T_CHARACTER, 0);
- return(make_boolean(sc, is_char_whitespace(arg)));
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
+ {
+ if (!is_string(car(x)))
+ method_or_bust(sc, car(x), sym, cons(sc, y, x), T_STRING, position_of(x, args));
+ if (val == 0)
+ {
+ if (!scheme_strequal_ci(y, car(x)))
+ {
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_string_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_STRING));
+ return(sc->F);
+ }
+ }
+ else
+ {
+ if (scheme_strcasecmp(y, car(x)) != val)
+ {
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_string_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_STRING));
+ return(sc->F);
+ }
+ }
+ y = car(x);
+ }
+ return(sc->T);
}
-static s7_pointer g_is_char_whitespace(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_char_whitespace "(char-whitespace? c) returns #t if the character c is non-printing character"
- #define Q_is_char_whitespace pl_bc
- return(c_is_char_whitespace(sc, car(args)));
-}
-PF_TO_PF(is_char_whitespace, c_is_char_whitespace)
+static s7_pointer g_string_ci_cmp_not(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
+{
+ s7_pointer x, y;
+ y = car(args);
+ if (!is_string(y))
+ method_or_bust(sc, y, sym, args, T_STRING, 1);
-static s7_pointer c_is_char_upper_case(s7_scheme *sc, s7_pointer arg)
-{
- if (!s7_is_character(arg))
- method_or_bust(sc, arg, sc->is_char_upper_case_symbol, set_plist_1(sc, arg), T_CHARACTER, 0);
- return(make_boolean(sc, is_char_uppercase(arg)));
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
+ {
+ if (!is_string(car(x)))
+ method_or_bust(sc, car(x), sym, cons(sc, y, x), T_STRING, position_of(x, args));
+ if (scheme_strcasecmp(y, car(x)) == val)
+ {
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_string_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_STRING));
+ return(sc->F);
+ }
+ y = car(x);
+ }
+ return(sc->T);
}
-static s7_pointer g_is_char_upper_case(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer g_strings_are_ci_equal(s7_scheme *sc, s7_pointer args)
{
- #define H_is_char_upper_case "(char-upper-case? c) returns #t if the character c is in upper case"
- #define Q_is_char_upper_case pl_bc
- return(c_is_char_upper_case(sc, car(args)));
+ #define H_strings_are_ci_equal "(string-ci=? str ...) returns #t if all the string arguments are equal, ignoring case"
+ #define Q_strings_are_ci_equal pcl_bs
+ return(g_string_ci_cmp(sc, args, 0, sc->string_ci_eq_symbol));
}
-PF_TO_PF(is_char_upper_case, c_is_char_upper_case)
-
-static s7_pointer c_is_char_lower_case(s7_scheme *sc, s7_pointer arg)
+static s7_pointer g_strings_are_ci_less(s7_scheme *sc, s7_pointer args)
{
- if (!s7_is_character(arg))
- method_or_bust(sc, arg, sc->is_char_lower_case_symbol, set_plist_1(sc, arg), T_CHARACTER, 0);
- return(make_boolean(sc, is_char_lowercase(arg)));
+ #define H_strings_are_ci_less "(string-ci<? str ...) returns #t if all the string arguments are increasing, ignoring case"
+ #define Q_strings_are_ci_less pcl_bs
+ return(g_string_ci_cmp(sc, args, -1, sc->string_ci_lt_symbol));
}
-static s7_pointer g_is_char_lower_case(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer g_strings_are_ci_greater(s7_scheme *sc, s7_pointer args)
{
- #define H_is_char_lower_case "(char-lower-case? c) returns #t if the character c is in lower case"
- #define Q_is_char_lower_case pl_bc
- return(c_is_char_lower_case(sc, car(args)));
+ #define H_strings_are_ci_greater "(string-ci>? str ...) returns #t if all the string arguments are decreasing, ignoring case"
+ #define Q_strings_are_ci_greater pcl_bs
+ return(g_string_ci_cmp(sc, args, 1, sc->string_ci_gt_symbol));
}
-PF_TO_PF(is_char_lower_case, c_is_char_lower_case)
-
-
-static s7_pointer g_is_char(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_strings_are_ci_geq(s7_scheme *sc, s7_pointer args)
{
- #define H_is_char "(char? obj) returns #t if obj is a character"
- #define Q_is_char pl_bt
- check_boolean_method(sc, s7_is_character, sc->is_char_symbol, args);
+ #define H_strings_are_ci_geq "(string-ci>=? str ...) returns #t if all the string arguments are equal or decreasing, ignoring case"
+ #define Q_strings_are_ci_geq pcl_bs
+ return(g_string_ci_cmp_not(sc, args, -1, sc->string_ci_geq_symbol));
}
-s7_pointer s7_make_character(s7_scheme *sc, unsigned int c)
+static s7_pointer g_strings_are_ci_leq(s7_scheme *sc, s7_pointer args)
{
- return(chars[c]);
+ #define H_strings_are_ci_leq "(string-ci<=? str ...) returns #t if all the string arguments are equal or increasing, ignoring case"
+ #define Q_strings_are_ci_leq pcl_bs
+ return(g_string_ci_cmp_not(sc, args, 1, sc->string_ci_leq_symbol));
}
-bool s7_is_character(s7_pointer p)
+static bool string_ci_lt_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcasecmp(p1, p2) == -1);}
+static bool string_ci_lt_b(s7_pointer p1, s7_pointer p2)
{
- return(type(p) == T_CHARACTER);
+ check_string2_args(cur_sc, cur_sc->string_ci_lt_symbol, p1, p2);
+ return(scheme_strcasecmp(p1, p2) == -1);
}
-
-char s7_character(s7_pointer p)
+static bool string_ci_leq_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcasecmp(p1, p2) != 1);}
+static bool string_ci_leq_b(s7_pointer p1, s7_pointer p2)
{
- return(character(p));
+ check_string2_args(cur_sc, cur_sc->string_ci_leq_symbol, p1, p2);
+ return(scheme_strcasecmp(p1, p2) != 1);
}
-
-static int charcmp(unsigned char c1, unsigned char c2)
+static bool string_ci_gt_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcasecmp(p1, p2) == 1);}
+static bool string_ci_gt_b(s7_pointer p1, s7_pointer p2)
{
- return((c1 == c2) ? 0 : (c1 < c2) ? -1 : 1);
- /* not tolower here -- the single case is apparently supposed to be upper case
- * this matters in a case like (char-ci<? #\_ #\e) which Guile and Gauche say is #f
- * although (char<? #\_ #\e) is #t -- the spec does not say how to interpret this!
- */
+ check_string2_args(cur_sc, cur_sc->string_ci_gt_symbol, p1, p2);
+ return(scheme_strcasecmp(p1, p2) == 1);
}
-
-static bool is_character_via_method(s7_scheme *sc, s7_pointer p)
+static bool string_ci_geq_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcasecmp(p1, p2) != -1);}
+static bool string_ci_geq_b(s7_pointer p1, s7_pointer p2)
{
- if (s7_is_character(p))
- return(true);
- if (has_methods(p))
- {
- s7_pointer f;
- f = find_method(sc, find_let(sc, p), sc->is_char_symbol);
- if (f != sc->undefined)
- return(is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->nil))));
- }
- return(false);
+ check_string2_args(cur_sc, cur_sc->string_ci_geq_symbol, p1, p2);
+ return(scheme_strcasecmp(p1, p2) != -1);
}
-
-static s7_pointer g_char_cmp(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
+static bool string_ci_eq_b_direct(s7_pointer p1, s7_pointer p2) {return(scheme_strcasecmp(p1, p2) == 0);}
+static bool string_ci_eq_b(s7_pointer p1, s7_pointer p2)
{
- s7_pointer x, y;
+ check_string2_args(cur_sc, cur_sc->string_ci_eq_symbol, p1, p2);
+ return(scheme_strcasecmp(p1, p2) == 0);
+}
- y = car(args);
- if (!s7_is_character(y))
- method_or_bust(sc, y, sym, args, T_CHARACTER, 1);
+#endif /* pure s7 */
- for (x = cdr(args); is_pair(x); x = cdr(x))
- {
- if (!s7_is_character(car(x)))
- method_or_bust(sc, car(x), sym, cons(sc, y, x), T_CHARACTER, position_of(x, args));
- if (charcmp(character(y), character(car(x))) != val)
- {
- for (y = cdr(x); is_pair(y); y = cdr(y))
- if (!is_character_via_method(sc, car(y)))
- return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_CHARACTER));
- return(sc->F);
- }
- y = car(x);
- }
- return(sc->T);
-}
+static s7_pointer g_string_fill(s7_scheme *sc, s7_pointer args)
+{
+ #define H_string_fill "(string-fill! str chr start end) fills the string str with the character chr"
+ #define Q_string_fill s7_make_circular_signature(sc, 3, 4, s7_make_signature(sc, 2, sc->is_char_symbol, sc->is_integer_symbol), sc->is_string_symbol, sc->is_char_symbol, sc->is_integer_symbol)
+ s7_pointer x, chr;
+ s7_int start = 0, end, byte = 0;
+ x = car(args);
-static s7_pointer g_char_cmp_not(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
-{
- s7_pointer x, y;
+ if (!is_string(x))
+ method_or_bust(sc, x, sc->string_fill_symbol, args, T_STRING, 1); /* not two methods here */
- y = car(args);
- if (!s7_is_character(y))
- method_or_bust(sc, y, sym, args, T_CHARACTER, 1);
+ if ((sc->safety > NO_SAFETY) &&
+ (is_immutable_string(x)))
+ return(s7_error(sc, sc->error_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't fill! ~S (it is immutable)"), x)));
- for (x = cdr(args); is_pair(x); x = cdr(x))
+ chr = cadr(args);
+ if (!is_byte_vector(x))
{
- if (!s7_is_character(car(x)))
- method_or_bust(sc, car(x), sym, cons(sc, y, x), T_CHARACTER, position_of(x, args));
-
- if (charcmp(character(y), character(car(x))) == val)
+ if (!s7_is_character(chr))
{
- for (y = cdr(x); is_pair(y); y = cdr(y))
- if (!is_character_via_method(sc, car(y)))
- return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_CHARACTER));
- return(sc->F);
+ check_two_methods(sc, chr, sc->string_fill_symbol, sc->fill_symbol, args);
+ return(wrong_type_argument(sc, sc->string_fill_symbol, 2, chr, T_CHARACTER));
}
- y = car(x);
}
- return(sc->T);
-}
-
-
-static s7_pointer g_chars_are_equal(s7_scheme *sc, s7_pointer args)
-{
- #define H_chars_are_equal "(char=? char ...) returns #t if all the character arguments are equal"
- #define Q_chars_are_equal pcl_bc
-
- s7_pointer x, y;
-
- y = car(args);
- if (!s7_is_character(y))
- method_or_bust(sc, y, sc->char_eq_symbol, args, T_CHARACTER, 1);
-
- for (x = cdr(args); is_pair(x); x = cdr(x))
+ else
{
- if (!s7_is_character(car(x)))
- method_or_bust(sc, car(x), sc->char_eq_symbol, cons(sc, y, x), T_CHARACTER, position_of(x, args));
-
- if (car(x) != y)
+ if (!is_integer(chr))
{
- for (y = cdr(x); is_pair(y); y = cdr(y))
- if (!is_character_via_method(sc, car(y)))
- return(wrong_type_argument(sc, sc->char_eq_symbol, position_of(y, args), car(y), T_CHARACTER));
- return(sc->F);
+ check_two_methods(sc, chr, sc->string_fill_symbol, sc->fill_symbol, args);
+ return(wrong_type_argument(sc, sc->fill_symbol, 2, chr, T_INTEGER));
}
+ byte = integer(chr);
+ if ((byte < 0) || (byte > 255))
+ return(simple_wrong_type_argument_with_type(sc, sc->string_fill_symbol, chr, an_unsigned_byte_string));
}
- return(sc->T);
-}
+ end = string_length(x);
+ if (!is_null(cddr(args)))
+ {
+ s7_pointer p;
+ p = start_and_end(sc, sc->string_fill_symbol, sc->fill_symbol, cddr(args), args, 3, &start, &end);
+ if (p != sc->gc_nil) return(p);
+ if (start == end) return(chr);
+ }
+ if (end == 0) return(chr);
-static s7_pointer g_chars_are_less(s7_scheme *sc, s7_pointer args)
-{
- #define H_chars_are_less "(char<? char ...) returns #t if all the character arguments are increasing"
- #define Q_chars_are_less pcl_bc
+ if (!is_byte_vector(x))
+ memset((void *)(string_value(x) + start), (int)character(chr), end - start);
+ else memset((void *)(string_value(x) + start), (int)byte, end - start);
- return(g_char_cmp(sc, args, -1, sc->char_lt_symbol));
+ return(chr);
}
-static s7_pointer g_chars_are_greater(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_string_1(s7_scheme *sc, s7_pointer args, s7_pointer sym)
{
- #define H_chars_are_greater "(char>? char ...) returns #t if all the character arguments are decreasing"
- #define Q_chars_are_greater pcl_bc
+ int i, len;
+ s7_pointer x, newstr;
+ char *str;
- return(g_char_cmp(sc, args, 1, sc->char_gt_symbol));
+ /* get length for new string and check arg types */
+ for (len = 0, x = args; is_not_null(x); len++, x = cdr(x))
+ {
+ s7_pointer p;
+ p = car(x);
+ if (!s7_is_character(p))
+ {
+ if (has_methods(p))
+ {
+ s7_pointer func;
+ func = find_method(sc, find_let(sc, p), sym);
+ if (func != sc->undefined)
+ {
+ s7_pointer y;
+ if (len == 0)
+ return(s7_apply_function(sc, func, args));
+ newstr = make_empty_string(sc, len, 0);
+ str = string_value(newstr);
+ for (i = 0, y = args; y != x; i++, y = cdr(y))
+ str[i] = character(car(y));
+ return(g_string_append(sc, set_plist_2(sc, newstr, s7_apply_function(sc, func, x))));
+ }
+ }
+ return(wrong_type_argument(sc, sym, len + 1, car(x), T_CHARACTER));
+ }
+ }
+ newstr = make_empty_string(sc, len, 0);
+ str = string_value(newstr);
+ for (i = 0, x = args; is_not_null(x); i++, x = cdr(x))
+ str[i] = character(car(x));
+
+ return(newstr);
}
-static s7_pointer g_chars_are_geq(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_string(s7_scheme *sc, s7_pointer args)
{
- #define H_chars_are_geq "(char>=? char ...) returns #t if all the character arguments are equal or decreasing"
- #define Q_chars_are_geq pcl_bc
+ #define H_string "(string chr...) appends all its character arguments into one string"
+ #define Q_string s7_make_circular_signature(sc, 1, 2, sc->is_string_symbol, sc->is_char_symbol)
- return(g_char_cmp_not(sc, args, -1, sc->char_geq_symbol));
+ if (is_null(args)) /* (string) but not (string ()) */
+ return(s7_make_string_with_length(sc, "", 0));
+ return(g_string_1(sc, args, sc->string_symbol));
}
-static s7_pointer g_chars_are_leq(s7_scheme *sc, s7_pointer args)
+#if (!WITH_PURE_S7)
+static s7_pointer g_list_to_string(s7_scheme *sc, s7_pointer args)
{
- #define H_chars_are_leq "(char<=? char ...) returns #t if all the character arguments are equal or increasing"
- #define Q_chars_are_leq pcl_bc
+ #define H_list_to_string "(list->string lst) appends all the list's characters into one string; (apply string lst)"
+ #define Q_list_to_string s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_proper_list_symbol)
- return(g_char_cmp_not(sc, args, 1, sc->char_leq_symbol));
-}
+ if (is_null(car(args)))
+ return(s7_make_string_with_length(sc, "", 0));
-static s7_pointer simple_char_eq;
-static s7_pointer g_simple_char_eq(s7_scheme *sc, s7_pointer args)
-{
- return(make_boolean(sc, character(car(args)) == character(cadr(args))));
+ if (!is_proper_list(sc, car(args)))
+ method_or_bust_with_type_one_arg(sc, car(args), sc->list_to_string_symbol, args, make_string_wrapper(sc, "a (proper, non-circular) list of characters"));
+ return(g_string_1(sc, car(args), sc->list_to_string_symbol));
}
+#endif
-static s7_pointer c_char_eq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_pointer s7_string_to_list(s7_scheme *sc, const char *str, int len)
{
- if (!s7_is_character(x))
- method_or_bust(sc, x, sc->char_eq_symbol, list_2(sc, x, y), T_CHARACTER, 1);
- if (!s7_is_character(y))
- method_or_bust(sc, y, sc->char_eq_symbol, list_2(sc, x, y), T_CHARACTER, 2);
- return(make_boolean(sc, x == y));
-}
+ int i;
+ s7_pointer result;
-static s7_pointer s7_procedure_signature(s7_scheme *sc, s7_pointer x);
-static bool char_check(s7_scheme *sc, s7_pointer obj)
-{
- if (s7_is_character(obj)) return(true);
- if ((is_pair(obj)) && (is_symbol(car(obj))))
+ if (len == 0)
+ return(sc->nil);
+ if (len >= (sc->free_heap_top - sc->free_heap))
{
- s7_pointer sig;
- sig = s7_procedure_signature(sc, s7_symbol_value(sc, car(obj)));
- return((sig) && (is_pair(sig)) && (car(sig) == sc->is_char_symbol));
+ gc(sc);
+ while (len >= (sc->free_heap_top - sc->free_heap))
+ resize_heap(sc);
}
- return(false);
-}
-
-PF2_TO_PF_X(char_eq, char_check, c_char_eq, c_is_eq)
-
-static s7_pointer char_equal_s_ic, char_equal_2;
-static s7_pointer g_char_equal_s_ic(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer c;
- c = find_symbol_checked(sc, car(args));
- if (c == cadr(args))
- return(sc->T);
- if (s7_is_character(c))
- return(sc->F);
- method_or_bust(sc, c, sc->char_eq_symbol, list_2(sc, c, cadr(args)), T_CHARACTER, 1);
+ sc->v = sc->nil;
+ for (i = len - 1; i >= 0; i--)
+ sc->v = cons_unchecked(sc, s7_make_character(sc, ((unsigned char)str[i])), sc->v);
+ result = sc->v;
+ sc->v = sc->nil;
+ return(result);
}
-static s7_pointer g_char_equal_2(s7_scheme *sc, s7_pointer args)
+#if (!WITH_PURE_S7)
+static s7_pointer g_string_to_list(s7_scheme *sc, s7_pointer args)
{
- if (!s7_is_character(car(args)))
- method_or_bust(sc, car(args), sc->char_eq_symbol, args, T_CHARACTER, 1);
- if (car(args) == cadr(args))
- return(sc->T);
- if (!s7_is_character(cadr(args)))
- method_or_bust(sc, cadr(args), sc->char_eq_symbol, args, T_CHARACTER, 2);
- return(sc->F);
-}
+ #define H_string_to_list "(string->list str start end) returns the elements of the string str in a list; (map values str)"
+ #define Q_string_to_list s7_make_circular_signature(sc, 2, 3, sc->is_proper_list_symbol, sc->is_string_symbol, sc->is_integer_symbol)
+ s7_int i, start = 0, end;
+ s7_pointer p, str;
-static s7_pointer char_less_s_ic, char_less_2;
-static s7_pointer g_char_less_s_ic(s7_scheme *sc, s7_pointer args)
-{
- if (!s7_is_character(car(args)))
- method_or_bust(sc, car(args), sc->char_lt_symbol, args, T_CHARACTER, 1);
- return(make_boolean(sc, character(car(args)) < character(cadr(args))));
-}
+ str = car(args);
+ if (!is_string(str))
+ method_or_bust_one_arg(sc, str, sc->string_to_list_symbol, args, T_STRING);
-static s7_pointer g_char_less_2(s7_scheme *sc, s7_pointer args)
-{
- if (!s7_is_character(car(args)))
- method_or_bust(sc, car(args), sc->char_lt_symbol, args, T_CHARACTER, 1);
- if (!s7_is_character(cadr(args)))
- method_or_bust(sc, cadr(args), sc->char_lt_symbol, args, T_CHARACTER, 2);
- return(make_boolean(sc, character(car(args)) < character(cadr(args))));
-}
+ end = string_length(str);
+ if (!is_null(cdr(args)))
+ {
+ p = start_and_end(sc, sc->string_to_list_symbol, NULL, cdr(args), args, 2, &start, &end);
+ if (p != sc->gc_nil) return(p);
+ if (start == end) return(sc->nil);
+ }
+ else
+ {
+ if (end == 0) return(sc->nil);
+ }
+ if ((start == 0) && (end == string_length(str)))
+ return(s7_string_to_list(sc, string_value(str), string_length(str)));
-static s7_pointer c_char_lt(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- if (!s7_is_character(x))
- method_or_bust(sc, x, sc->char_lt_symbol, list_2(sc, x, y), T_CHARACTER, 1);
- if (!s7_is_character(y))
- method_or_bust(sc, y, sc->char_lt_symbol, list_2(sc, x, y), T_CHARACTER, 2);
- return(make_boolean(sc, character(x) < character(y)));
-}
+ sc->w = sc->nil;
+ for (i = end - 1; i >= start; i--)
+ sc->w = cons(sc, s7_make_character(sc, ((unsigned char)string_value(str)[i])), sc->w);
-static s7_pointer c_clt(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- return(make_boolean(sc, character(x) < character(y)));
+ p = sc->w;
+ sc->w = sc->nil;
+ return(p);
}
-
-PF2_TO_PF_X(char_lt, char_check, c_char_lt, c_clt)
+#endif
-static s7_pointer char_greater_s_ic, char_greater_2;
-static s7_pointer g_char_greater_s_ic(s7_scheme *sc, s7_pointer args)
-{
- if (!s7_is_character(car(args)))
- method_or_bust(sc, car(args), sc->char_gt_symbol, args, T_CHARACTER, 1);
- return(make_boolean(sc, character(car(args)) > character(cadr(args))));
-}
+/* -------------------------------- byte-vectors --------------------------------
+ *
+ * these are just strings with the T_BYTE_VECTOR bit set.
+ */
-static s7_pointer g_char_greater_2(s7_scheme *sc, s7_pointer args)
-{
- if (!s7_is_character(car(args)))
- method_or_bust(sc, car(args), sc->char_gt_symbol, args, T_CHARACTER, 1);
- if (!s7_is_character(cadr(args)))
- method_or_bust(sc, cadr(args), sc->char_gt_symbol, args, T_CHARACTER, 2);
- return(make_boolean(sc, character(car(args)) > character(cadr(args))));
-}
+static bool s7_is_byte_vector(s7_pointer b) {return((is_string(b)) && (is_byte_vector(b)));}
-static s7_pointer c_char_gt(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_pointer g_is_byte_vector(s7_scheme *sc, s7_pointer args)
{
- if (!s7_is_character(x))
- method_or_bust(sc, x, sc->char_gt_symbol, list_2(sc, x, y), T_CHARACTER, 1);
- if (!s7_is_character(y))
- method_or_bust(sc, y, sc->char_gt_symbol, list_2(sc, x, y), T_CHARACTER, 2);
- return(make_boolean(sc, character(x) > character(y)));
-}
+ #define H_is_byte_vector "(byte-vector? obj) returns #t if obj is a byte-vector"
+ #define Q_is_byte_vector pl_bt
-static s7_pointer c_cgt(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- return(make_boolean(sc, character(x) > character(y)));
+ check_boolean_method(sc, s7_is_byte_vector, sc->is_byte_vector_symbol, args);
}
-PF2_TO_PF_X(char_gt, char_check, c_char_gt, c_cgt)
-
-static s7_pointer c_char_geq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+/* 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)
{
- if (!s7_is_character(x))
- method_or_bust(sc, x, sc->char_geq_symbol, list_2(sc, x, y), T_CHARACTER, 1);
- if (!s7_is_character(y))
- method_or_bust(sc, y, sc->char_geq_symbol, list_2(sc, x, y), T_CHARACTER, 2);
- return(make_boolean(sc, character(x) >= character(y)));
+ #define H_string_to_byte_vector "(string->byte-vector obj) turns a string into a byte-vector."
+ #define Q_string_to_byte_vector s7_make_signature(sc, 2, sc->is_byte_vector_symbol, sc->is_string_symbol)
+ s7_pointer str;
+ str = car(args);
+ if (is_integer(str))
+ str = s7_make_string_with_length(sc, (const char *)(&(integer(str))), sizeof(s7_int));
+ else
+ {
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->string_to_byte_vector_symbol, set_plist_1(sc, str), T_STRING, 1);
+ }
+ set_byte_vector(str);
+ return(str);
}
-PF2_TO_PF(char_geq, c_char_geq)
-
-
-static s7_pointer c_char_leq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_pointer g_make_byte_vector(s7_scheme *sc, s7_pointer args)
{
- if (!s7_is_character(x))
- method_or_bust(sc, x, sc->char_leq_symbol, list_2(sc, x, y), T_CHARACTER, 1);
- if (!s7_is_character(y))
- method_or_bust(sc, y, sc->char_leq_symbol, list_2(sc, x, y), T_CHARACTER, 2);
- return(make_boolean(sc, character(x) <= character(y)));
-}
-
-PF2_TO_PF(char_leq, c_char_leq)
-
+ #define H_make_byte_vector "(make-byte-vector len (byte 0)) makes a byte-vector of length len filled with byte."
+ #define Q_make_byte_vector s7_make_circular_signature(sc, 1, 2, sc->is_byte_vector_symbol, sc->is_integer_symbol)
-#if (!WITH_PURE_S7)
-static s7_pointer g_char_cmp_ci(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
-{
- s7_pointer x, y;
+ s7_pointer str;
+ if (is_null(cdr(args)))
+ {
+ str = g_make_string(sc, args);
+ if (is_string(str))
+ memclr((void *)(string_value(str)), string_length(str));
+ }
+ else
+ {
+ s7_pointer len, byte;
+ s7_int b;
+ len = car(args);
+ if (!is_integer(len))
+ method_or_bust(sc, len, sc->make_byte_vector_symbol, args, T_INTEGER, 1);
- y = car(args);
- if (!s7_is_character(y))
- method_or_bust(sc, y, sym, args, T_CHARACTER, 1);
+ byte = cadr(args);
+ if (!s7_is_integer(byte))
+ method_or_bust(sc, byte, sc->make_byte_vector_symbol, args, T_INTEGER, 2);
- for (x = cdr(args); is_pair(x); x = cdr(x))
- {
- if (!s7_is_character(car(x)))
- method_or_bust(sc, car(x), sym, cons(sc, y, x), T_CHARACTER, position_of(x, args));
- if (charcmp(upper_character(y), upper_character(car(x))) != val)
- {
- for (y = cdr(x); is_pair(y); y = cdr(y))
- if (!is_character_via_method(sc, car(y)))
- return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_CHARACTER));
- return(sc->F);
- }
- y = car(x);
+ b = s7_integer(byte);
+ if ((b < 0) || (b > 255))
+ return(simple_wrong_type_argument_with_type(sc, sc->make_byte_vector_symbol, byte, an_unsigned_byte_string));
+ str = g_make_string(sc, set_plist_2(sc, len, chars[b]));
}
- return(sc->T);
+ set_byte_vector(str);
+ return(str);
}
-static s7_pointer g_char_cmp_ci_not(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
+static s7_pointer g_byte_vector(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x, y;
+ #define H_byte_vector "(byte-vector ...) returns a byte-vector whose elements are the arguments"
+ #define Q_byte_vector s7_make_circular_signature(sc, 1, 2, sc->is_byte_vector_symbol, sc->is_integer_symbol)
- y = car(args);
- if (!s7_is_character(y))
- method_or_bust(sc, y, sym, args, T_CHARACTER, 1);
- for (x = cdr(args); is_pair(x); x = cdr(x))
+ s7_int i, len;
+ s7_pointer vec, x;
+ char *str;
+
+ len = s7_list_length(sc, args);
+ vec = make_empty_string(sc, len, 0);
+ str = string_value(vec);
+
+ for (i = 0, x = args; is_pair(x); i++, x = cdr(x))
{
- if (!s7_is_character(car(x)))
- method_or_bust(sc, car(x), sym, cons(sc, y, x), T_CHARACTER, position_of(x, args));
- if (charcmp(upper_character(y), upper_character(car(x))) == val)
+ s7_pointer byte;
+ s7_int b;
+ byte = car(x);
+ if (!s7_is_integer(byte))
{
- for (y = cdr(x); is_pair(y); y = cdr(y))
- if (!is_character_via_method(sc, car(y)))
- return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_CHARACTER));
- return(sc->F);
+ if (has_methods(byte))
+ {
+ s7_pointer func;
+ func = find_method(sc, find_let(sc, byte), sc->byte_vector_symbol);
+ if (func != sc->undefined)
+ {
+ if (i == 0)
+ return(s7_apply_function(sc, func, args));
+ string_length(vec) = i;
+ vec = g_string_append(sc, set_plist_2(sc, vec, s7_apply_function(sc, func, x)));
+ set_byte_vector(vec);
+ return(vec);
+ }
+ }
+ return(wrong_type_argument(sc, sc->byte_vector_symbol, i + 1, byte, T_INTEGER));
}
- y = car(x);
+ b = s7_integer(byte);
+ if ((b < 0) || (b > 255))
+ return(simple_wrong_type_argument_with_type(sc, sc->byte_vector_symbol, byte, an_unsigned_byte_string));
+ str[i] = (unsigned char)b;
}
- return(sc->T);
-}
-
-
-static s7_pointer g_chars_are_ci_equal(s7_scheme *sc, s7_pointer args)
-{
- #define H_chars_are_ci_equal "(char-ci=? char ...) returns #t if all the character arguments are equal, ignoring case"
- #define Q_chars_are_ci_equal pcl_bc
-
- return(g_char_cmp_ci(sc, args, 0, sc->char_ci_eq_symbol));
+ set_byte_vector(vec);
+ return(vec);
}
-static s7_pointer c_char_ci_eq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_pointer byte_vector_to_list(s7_scheme *sc, const char *str, int len)
{
- if (!s7_is_character(x))
- method_or_bust(sc, x, sc->char_ci_eq_symbol, list_2(sc, x, y), T_CHARACTER, 1);
- if (!s7_is_character(y))
- method_or_bust(sc, y, sc->char_ci_eq_symbol, list_2(sc, x, y), T_CHARACTER, 2);
- return(make_boolean(sc, upper_character(x) == upper_character(y)));
+ int i;
+ s7_pointer p;
+ if (len == 0) return(sc->nil);
+ sc->w = sc->nil;
+ for (i = len - 1; i >= 0; i--)
+ sc->w = cons(sc, small_int((unsigned int)((unsigned char)(str[i]))), sc->w); /* extra cast is not redundant! */
+ p = sc->w;
+ sc->w = sc->nil;
+ return(p);
}
-PF2_TO_PF(char_ci_eq, c_char_ci_eq)
-
-static s7_pointer g_chars_are_ci_less(s7_scheme *sc, s7_pointer args)
-{
- #define H_chars_are_ci_less "(char-ci<? char ...) returns #t if all the character arguments are increasing, ignoring case"
- #define Q_chars_are_ci_less pcl_bc
- return(g_char_cmp_ci(sc, args, -1, sc->char_ci_lt_symbol));
-}
+/* -------------------------------- ports --------------------------------
+ *
+ * originally nil served as stdin and friends, but that made it impossible to catch an error
+ * like (read-line (current-output-port)) when the latter was stdout. So we now have
+ * the built-in constant ports *stdin*, *stdout*, and *stderr*. Some way is needed to
+ * refer to these directly so that (read-line *stdin*) for example can insist on reading
+ * from the terminal, or whatever stdin is.
+ */
-static s7_pointer c_char_ci_lt(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_pointer g_is_port_closed(s7_scheme *sc, s7_pointer args)
{
- if (!s7_is_character(x))
- method_or_bust(sc, x, sc->char_ci_lt_symbol, list_2(sc, x, y), T_CHARACTER, 1);
- if (!s7_is_character(y))
- method_or_bust(sc, y, sc->char_ci_lt_symbol, list_2(sc, x, y), T_CHARACTER, 2);
- return(make_boolean(sc, upper_character(x) < upper_character(y)));
-}
-
-PF2_TO_PF(char_ci_lt, c_char_ci_lt)
-
+ #define H_is_port_closed "(port-closed? p) returns #t if the port p is closed."
+ #define Q_is_port_closed pl_bt
+ s7_pointer x;
-static s7_pointer g_chars_are_ci_greater(s7_scheme *sc, s7_pointer args)
-{
- #define H_chars_are_ci_greater "(char-ci>? char ...) returns #t if all the character arguments are decreasing, ignoring case"
- #define Q_chars_are_ci_greater pcl_bc
+ x = car(args);
+ if ((is_input_port(x)) || (is_output_port(x)))
+ return(make_boolean(sc, port_is_closed(x)));
- return(g_char_cmp_ci(sc, args, 1, sc->char_ci_gt_symbol));
+ method_or_bust_with_type_one_arg(sc, x, sc->is_port_closed_symbol, args, make_string_wrapper(sc, "a port"));
}
-static s7_pointer c_char_ci_gt(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static bool is_port_closed_b(s7_pointer x)
{
- if (!s7_is_character(x))
- method_or_bust(sc, x, sc->char_ci_gt_symbol, list_2(sc, x, y), T_CHARACTER, 1);
- if (!s7_is_character(y))
- method_or_bust(sc, y, sc->char_ci_gt_symbol, list_2(sc, x, y), T_CHARACTER, 2);
- return(make_boolean(sc, upper_character(x) > upper_character(y)));
+ if ((!is_input_port(x)) && (!is_output_port(x)))
+ simple_wrong_type_argument_with_type(cur_sc, cur_sc->is_port_closed_symbol, x, make_string_wrapper(cur_sc, "a port"));
+ return(port_is_closed(x));
}
-PF2_TO_PF(char_ci_gt, c_char_ci_gt)
-
-static s7_pointer g_chars_are_ci_geq(s7_scheme *sc, s7_pointer args)
+static s7_pointer c_port_line_number(s7_scheme *sc, s7_pointer x)
{
- #define H_chars_are_ci_geq "(char-ci>=? char ...) returns #t if all the character arguments are equal or decreasing, ignoring case"
- #define Q_chars_are_ci_geq pcl_bc
-
- return(g_char_cmp_ci_not(sc, args, -1, sc->char_ci_geq_symbol));
+ if ((!(is_input_port(x))) ||
+ (port_is_closed(x)))
+ method_or_bust_with_type_one_arg(sc, x, sc->port_line_number_symbol, list_1(sc, x), an_input_port_string);
+ return(make_integer(sc, port_line_number(x)));
}
-static s7_pointer c_char_ci_geq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_pointer g_port_line_number(s7_scheme *sc, s7_pointer args)
{
- if (!s7_is_character(x))
- method_or_bust(sc, x, sc->char_ci_geq_symbol, list_2(sc, x, y), T_CHARACTER, 1);
- if (!s7_is_character(y))
- method_or_bust(sc, y, sc->char_ci_geq_symbol, list_2(sc, x, y), T_CHARACTER, 2);
- return(make_boolean(sc, upper_character(x) >= upper_character(y)));
-}
-
-PF2_TO_PF(char_ci_geq, c_char_ci_geq)
+ #define H_port_line_number "(port-line-number input-file-port) returns the current read line number of port"
+ #define Q_port_line_number s7_make_signature(sc, 2, sc->is_integer_symbol, s7_make_signature(sc, 2, sc->is_input_port_symbol, sc->is_null_symbol))
+ if ((is_null(args)) || (is_null(car(args))))
+ return(c_port_line_number(sc, sc->input_port));
+ return(c_port_line_number(sc, car(args)));
+}
-static s7_pointer g_chars_are_ci_leq(s7_scheme *sc, s7_pointer args)
+int s7_port_line_number(s7_pointer p)
{
- #define H_chars_are_ci_leq "(char-ci<=? char ...) returns #t if all the character arguments are equal or increasing, ignoring case"
- #define Q_chars_are_ci_leq pcl_bc
-
- return(g_char_cmp_ci_not(sc, args, 1, sc->char_ci_leq_symbol));
+ if (!(is_input_port(p)))
+ simple_wrong_type_argument(cur_sc, cur_sc->port_line_number_symbol, p, T_INPUT_PORT);
+ return(port_line_number(p));
}
-static s7_pointer c_char_ci_leq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_int port_line_number_i_p(s7_pointer p)
{
- if (!s7_is_character(x))
- method_or_bust(sc, x, sc->char_ci_leq_symbol, list_2(sc, x, y), T_CHARACTER, 1);
- if (!s7_is_character(y))
- method_or_bust(sc, y, sc->char_ci_leq_symbol, list_2(sc, x, y), T_CHARACTER, 2);
- return(make_boolean(sc, upper_character(x) <= upper_character(y)));
+ return(s7_port_line_number(p));
}
-PF2_TO_PF(char_ci_leq, c_char_ci_leq)
-#endif /* not pure s7 */
-
-
-static s7_pointer g_char_position(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_set_port_line_number(s7_scheme *sc, s7_pointer args)
{
- #define H_char_position "(char-position char-or-str str (start 0)) returns the position of the first occurrence of char in str, or #f"
- #define Q_char_position s7_make_signature(sc, 4, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_boolean_symbol), s7_make_signature(sc, 2, sc->is_char_symbol, sc->is_string_symbol), sc->is_string_symbol, sc->is_integer_symbol)
-
- const char *porig, *pset;
- s7_int start, pos, len; /* not "int" because start arg might be most-negative-fixnum */
- s7_pointer arg1, arg2;
-
- arg1 = car(args);
- if ((!s7_is_character(arg1)) &&
- (!is_string(arg1)))
- method_or_bust(sc, arg1, sc->char_position_symbol, args, T_CHARACTER, 1);
-
- arg2 = cadr(args);
- if (!is_string(arg2))
- method_or_bust(sc, arg2, sc->char_position_symbol, args, T_STRING, 2);
-
- porig = string_value(arg2);
- len = string_length(arg2);
-
- if (is_pair(cddr(args)))
- {
- s7_pointer arg3;
- arg3 = caddr(args);
- if (!s7_is_integer(arg3))
- {
- s7_pointer p;
- if (!s7_is_integer(p = check_values(sc, arg3, cddr(args))))
- method_or_bust(sc, arg3, sc->char_position_symbol, args, T_INTEGER, 3);
- arg3 = p;
- }
- start = s7_integer(arg3);
- if (start < 0)
- return(wrong_type_argument_with_type(sc, sc->char_position_symbol, 3, arg3, a_non_negative_integer_string));
- }
- else start = 0;
- if (start >= len) return(sc->F);
+ s7_pointer p, line;
- if (s7_is_character(arg1))
+ if ((is_null(car(args))) ||
+ ((is_null(cdr(args))) && (is_integer(car(args)))))
+ p = sc->input_port;
+ else
{
- char c;
- const char *p;
- c = character(arg1);
- p = strchr((const char *)(porig + start), (int)c); /* use strchrnul in Gnu C to catch embedded null case */
- if (p)
- return(make_integer(sc, p - porig));
- return(sc->F);
+ p = car(args);
+ if (!(is_input_port(p)))
+ return(s7_wrong_type_arg_error(sc, "set! port-line-number", 1, p, "an input port"));
}
- if (string_length(arg1) == 0)
- return(sc->F);
- pset = string_value(arg1);
-
- pos = strcspn((const char *)(porig + start), (const char *)pset);
- if ((pos + start) < len)
- return(make_integer(sc, pos + start));
-
- /* but if the string has an embedded null, we can get erroneous results here --
- * perhaps check for null at pos+start? What about a searched-for string that
- * also has embedded nulls?
- *
- * The embedded nulls are for byte-vector usages, where presumably you're not talking
- * about chars and strings, so I think I'll ignore these cases. In unicode, you'd
- * want to use unicode-aware searchers, so that also is irrelevant.
- */
- return(sc->F);
+ line = (is_null(cdr(args)) ? car(args) : cadr(args));
+ if (!is_integer(line))
+ return(s7_wrong_type_arg_error(sc, "set! port-line-number", 2, line, "an integer"));
+ port_line_number(p) = integer(line);
+ return(line);
}
-static s7_pointer c_char_position_ppi(s7_scheme *sc, s7_pointer x, s7_pointer y, s7_int z) {return(g_char_position(sc, set_plist_3(sc, x, y, make_integer(sc, z))));}
-static s7_pointer c_char_position_pp(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_char_position(sc, set_plist_2(sc, x, y)));}
-PPIF_TO_PF(char_position, c_char_position_pp, c_char_position_ppi)
-
-static s7_pointer char_position_csi;
-static s7_pointer g_char_position_csi(s7_scheme *sc, s7_pointer args)
+const char *s7_port_filename(s7_pointer x)
{
- /* assume char arg1, no end */
- const char *porig, *p;
- char c;
- s7_pointer arg2;
- s7_int start, len;
-
- c = character(car(args));
- arg2 = cadr(args);
-
- if (!is_string(arg2))
- return(g_char_position(sc, args));
+ if (((is_input_port(x)) ||
+ (is_output_port(x))) &&
+ (!port_is_closed(x)))
+ return(port_filename(x));
+ return(NULL);
+}
- len = string_length(arg2); /* can't return #f here if len==0 -- need start error check first */
- porig = string_value(arg2);
- if (is_pair(cddr(args)))
+static s7_pointer c_port_filename(s7_scheme *sc, s7_pointer x)
+{
+ if (((is_input_port(x)) ||
+ (is_output_port(x))) &&
+ (!port_is_closed(x)))
{
- s7_pointer arg3;
- arg3 = caddr(args);
- if (!s7_is_integer(arg3))
- return(g_char_position(sc, args));
- start = s7_integer(arg3);
- if (start < 0)
- return(wrong_type_argument_with_type(sc, sc->char_position_symbol, 3, arg3, a_non_negative_integer_string));
- if (start >= len) return(sc->F);
+ if (port_filename(x))
+ return(make_string_wrapper_with_length(sc, port_filename(x), port_filename_length(x)));
+ return(s7_make_string_with_length(sc, "", 0));
+ /* otherwise (eval-string (port-filename)) and (string->symbol (port-filename)) segfault */
}
- else start = 0;
-
- if (len == 0) return(sc->F);
- p = strchr((const char *)(porig + start), (int)c);
- if (p)
- return(make_integer(sc, p - porig));
- return(sc->F);
+ method_or_bust_with_type_one_arg(sc, x, sc->port_filename_symbol, list_1(sc, x), an_open_port_string);
}
-
-static s7_pointer g_string_position(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_port_filename(s7_scheme *sc, s7_pointer args)
{
- #define H_string_position "(string-position str1 str2 (start 0)) returns the starting position of str1 in str2 or #f"
- #define Q_string_position s7_make_signature(sc, 4, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_boolean_symbol), sc->is_string_symbol, sc->is_string_symbol, sc->is_integer_symbol)
- const char *s1, *s2, *p2;
- s7_int start = 0;
- s7_pointer s1p, s2p;
+ #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)
- s1p = car(args);
- if (!is_string(s1p))
- method_or_bust(sc, s1p, sc->string_position_symbol, args, T_STRING, 1);
+ if (is_null(args))
+ return(c_port_filename(sc, sc->input_port));
+ return(c_port_filename(sc, car(args)));
+}
- s2p = cadr(args);
- if (!is_string(s2p))
- method_or_bust(sc, s2p, sc->string_position_symbol, args, T_STRING, 2);
- if (is_pair(cddr(args)))
- {
- s7_pointer arg3;
- arg3 = caddr(args);
- if (!s7_is_integer(arg3))
- {
- s7_pointer p;
- if (!s7_is_integer(p = check_values(sc, arg3, cddr(args))))
- method_or_bust(sc, arg3, sc->string_position_symbol, args, T_INTEGER, 3);
- arg3 = p;
- }
- start = s7_integer(arg3);
- if (start < 0)
- return(wrong_type_argument_with_type(sc, sc->string_position_symbol, 3, arg3, a_non_negative_integer_string));
- }
+bool s7_is_input_port(s7_scheme *sc, s7_pointer p)
+{
+ return(is_input_port(p));
+}
- if (string_length(s1p) == 0)
- return(sc->F);
- s1 = string_value(s1p);
- s2 = string_value(s2p);
- if (start >= string_length(s2p))
- return(sc->F);
+static bool is_input_port_b(s7_pointer p) {return(is_input_port(p));}
- p2 = strstr((const char *)(s2 + start), s1);
- if (!p2) return(sc->F);
- return(make_integer(sc, p2 - s2));
+
+static s7_pointer g_is_input_port(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_input_port "(input-port? p) returns #t if p is an input port"
+ #define Q_is_input_port pl_bt
+ check_boolean_method(sc, is_input_port, sc->is_input_port_symbol, args);
}
-static s7_pointer c_string_position_ppi(s7_scheme *sc, s7_pointer x, s7_pointer y, s7_int z) {return(g_string_position(sc, set_plist_3(sc, x, y, make_integer(sc, z))));}
-static s7_pointer c_string_position_pp(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_string_position(sc, set_plist_2(sc, x, y)));}
-PPIF_TO_PF(string_position, c_string_position_pp, c_string_position_ppi)
+bool s7_is_output_port(s7_scheme *sc, s7_pointer p)
+{
+ return(is_output_port(p));
+}
+static bool is_output_port_b(s7_pointer p) {return(is_output_port(p));}
-/* -------------------------------- strings -------------------------------- */
-s7_pointer s7_make_string_with_length(s7_scheme *sc, const char *str, int len)
+static s7_pointer g_is_output_port(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
- new_cell(sc, x, T_STRING | T_SAFE_PROCEDURE);
- string_value(x) = (char *)malloc((len + 1) * sizeof(char));
- if (len != 0) /* memcpy can segfault if string_value(x) is NULL */
- memcpy((void *)string_value(x), (void *)str, len);
- string_value(x)[len] = 0;
- string_length(x) = len;
- string_hash(x) = 0;
- string_needs_free(x) = true;
- Add_String(x);
- return(x);
+ #define H_is_output_port "(output-port? p) returns #t if p is an output port"
+ #define Q_is_output_port pl_bt
+ check_boolean_method(sc, is_output_port, sc->is_output_port_symbol, args);
}
-static s7_pointer make_string_uncopied_with_length(s7_scheme *sc, char *str, int len)
+s7_pointer s7_current_input_port(s7_scheme *sc)
{
- s7_pointer x;
- new_cell(sc, x, T_STRING | T_SAFE_PROCEDURE);
- string_value(x) = str;
- string_length(x) = len;
- string_hash(x) = 0;
- string_needs_free(x) = true;
- add_string(sc, x);
- return(x);
+ return(sc->input_port);
}
-static s7_pointer make_string_wrapper_with_length(s7_scheme *sc, const char *str, int len)
+static s7_pointer g_current_input_port(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
- new_cell(sc, x, T_STRING | T_IMMUTABLE | T_SAFE_PROCEDURE);
- string_value(x) = (char *)str;
- string_length(x) = len;
- string_hash(x) = 0;
- string_needs_free(x) = false;
- return(x);
+ #define H_current_input_port "(current-input-port) returns the current input port"
+ #define Q_current_input_port s7_make_signature(sc, 1, sc->is_input_port_symbol)
+ return(sc->input_port);
}
-static s7_pointer make_string_wrapper(s7_scheme *sc, const char *str)
+#if (!WITH_PURE_S7)
+static s7_pointer g_set_current_input_port(s7_scheme *sc, s7_pointer args)
{
- return(make_string_wrapper_with_length(sc, str, safe_strlen(str)));
+ #define H_set_current_input_port "(set-current-input-port port) sets the current-input port to port and returns the previous value of the input port"
+ #define Q_set_current_input_port s7_make_signature(sc, 2, sc->is_input_port_symbol, sc->is_input_port_symbol)
+
+ s7_pointer old_port, port;
+ old_port = sc->input_port;
+ port = car(args);
+ if ((is_input_port(port)) &&
+ (!port_is_closed(port)))
+ sc->input_port = port;
+ else
+ {
+ check_method(sc, port, s7_make_symbol(sc, "set-current-input-port"), args);
+ return(s7_wrong_type_arg_error(sc, "set-current-input-port", 0, port, "an open input port"));
+ }
+ return(old_port);
}
+#endif
-static s7_pointer make_empty_string(s7_scheme *sc, int len, char fill)
+s7_pointer s7_set_current_input_port(s7_scheme *sc, s7_pointer port)
{
- s7_pointer x;
- new_cell(sc, x, T_STRING);
- string_value(x) = (char *)malloc((len + 1) * sizeof(char));
- if (fill != 0)
- memset((void *)(string_value(x)), fill, len);
- string_value(x)[len] = 0;
- string_hash(x) = 0;
- string_length(x) = len;
- string_needs_free(x) = true;
- add_string(sc, x);
- return(x);
+ s7_pointer old_port;
+ old_port = sc->input_port;
+ sc->input_port = port;
+ return(old_port);
}
-s7_pointer s7_make_string(s7_scheme *sc, const char *str)
+s7_pointer s7_current_output_port(s7_scheme *sc)
{
- if (str)
- return(s7_make_string_with_length(sc, str, safe_strlen(str)));
- return(make_empty_string(sc, 0, 0));
+ return(sc->output_port);
}
-static char *make_permanent_string(const char *str)
+s7_pointer s7_set_current_output_port(s7_scheme *sc, s7_pointer port)
{
- char *x;
- int len;
- len = safe_strlen(str);
- x = (char *)malloc((len + 1) * sizeof(char));
- memcpy((void *)x, (void *)str, len);
- x[len] = 0;
- return(x);
+ s7_pointer old_port;
+ old_port = sc->output_port;
+ sc->output_port = port;
+ return(old_port);
}
-s7_pointer s7_make_permanent_string(const char *str)
+static s7_pointer g_current_output_port(s7_scheme *sc, s7_pointer args)
{
- /* for the symbol table which is never GC'd */
- s7_pointer x;
- x = alloc_pointer();
- unheap(x);
- set_type(x, T_STRING | T_IMMUTABLE);
- if (str)
- {
- unsigned int len;
- len = safe_strlen(str);
- string_length(x) = len;
- string_value(x) = (char *)malloc((len + 1) * sizeof(char));
- memcpy((void *)string_value(x), (void *)str, len);
- string_value(x)[len] = 0;
- }
+ #define H_current_output_port "(current-output-port) returns the current output port"
+ #define Q_current_output_port s7_make_signature(sc, 1, sc->is_output_port_symbol)
+ return(sc->output_port);
+}
+
+#if (!WITH_PURE_S7)
+static s7_pointer g_set_current_output_port(s7_scheme *sc, s7_pointer args)
+{
+ #define H_set_current_output_port "(set-current-output-port port) sets the current-output port to port and returns the previous value of the output port"
+ #define Q_set_current_output_port s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->is_output_port_symbol)
+
+ s7_pointer old_port, port;
+ old_port = sc->output_port;
+ port = car(args);
+ if (((is_output_port(port)) &&
+ (!port_is_closed(port))) ||
+ (port == sc->F))
+ sc->output_port = port;
else
{
- string_value(x) = NULL;
- string_length(x) = 0;
+ check_method(sc, port, s7_make_symbol(sc, "set-current-output-port"), args);
+ return(s7_wrong_type_arg_error(sc, "set-current-output-port", 0, port, "an open output port"));
}
- string_hash(x) = 0;
- string_needs_free(x) = false;
- return(x);
+ return(old_port);
}
+#endif
-
-static s7_pointer make_temporary_string(s7_scheme *sc, const char *str, int len)
+s7_pointer s7_current_error_port(s7_scheme *sc)
{
- s7_pointer p;
- p = sc->tmp_strs[0];
- prepare_temporary_string(sc, len + 1, 0);
- string_length(p) = len;
- if (len > 0)
- memmove((void *)(string_value(p)), (void *)str, len); /* not memcpy because str might be a temp string (i.e. sc->tmp_str_chars -> itself) */
- string_value(p)[len] = 0;
- return(p);
+ return(sc->error_port);
}
-bool s7_is_string(s7_pointer p)
+s7_pointer s7_set_current_error_port(s7_scheme *sc, s7_pointer port)
{
- return(is_string(p));
+ s7_pointer old_port;
+ old_port = sc->error_port;
+ sc->error_port = port;
+ return(old_port);
}
-const char *s7_string(s7_pointer p)
+static s7_pointer g_current_error_port(s7_scheme *sc, s7_pointer args)
{
- return(string_value(p));
+ #define H_current_error_port "(current-error-port) returns the current error port"
+ #define Q_current_error_port s7_make_signature(sc, 1, sc->is_output_port_symbol)
+ return(sc->error_port);
}
-static s7_pointer g_is_string(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_set_current_error_port(s7_scheme *sc, s7_pointer args)
{
- #define H_is_string "(string? obj) returns #t if obj is a string"
- #define Q_is_string pl_bt
+ #define H_set_current_error_port "(set-current-error-port port) sets the current-error port to port and returns the previous value of the error port"
+ #define Q_set_current_error_port s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->is_output_port_symbol)
+ s7_pointer old_port, port;
- check_boolean_method(sc, is_string, sc->is_string_symbol, args);
+ old_port = sc->error_port;
+ port = car(args);
+ if (((is_output_port(port)) &&
+ (!port_is_closed(port))) ||
+ (port == sc->F))
+ sc->error_port = port;
+ else
+ {
+ check_method(sc, port, s7_make_symbol(sc, "set-current-error-port"), args);
+ return(s7_wrong_type_arg_error(sc, "set-current-error-port", 0, port, "an open output port"));
+ }
+ return(old_port);
}
-/* -------------------------------- make-string -------------------------------- */
-static s7_pointer g_make_string(s7_scheme *sc, s7_pointer args)
+#if (!WITH_PURE_S7)
+static s7_pointer g_is_char_ready(s7_scheme *sc, s7_pointer args)
{
- #define H_make_string "(make-string len (val #\\space)) makes a string of length len filled with the character val (default: space)"
- #define Q_make_string s7_make_signature(sc, 3, sc->is_string_symbol, sc->is_integer_symbol, sc->is_char_symbol)
-
- s7_pointer n;
- s7_int len;
- char fill = ' ';
-
- n = car(args);
- if (!s7_is_integer(n))
+ #define H_is_char_ready "(char-ready? (port (current-input-port))) returns #t if a character is ready for input on the given port"
+ #define Q_is_char_ready s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_input_port_symbol)
+ if (is_not_null(args))
{
- check_two_methods(sc, n, sc->make_string_symbol, sc->make_byte_vector_symbol, args);
- return(wrong_type_argument(sc, sc->make_string_symbol, 1, n, T_INTEGER));
- }
-
- len = s7_integer(n);
- if ((len < 0) || (len > sc->max_string_length))
- return(out_of_range(sc, sc->make_string_symbol, small_int(1), n, (len < 0) ? its_negative_string : its_too_large_string));
+ s7_pointer pt = car(args);
+ if (!is_input_port(pt))
+ method_or_bust_with_type_one_arg(sc, pt, sc->is_char_ready_symbol, args, an_input_port_string);
+ if (port_is_closed(pt))
+ return(simple_wrong_type_argument_with_type(sc, sc->is_char_ready_symbol, pt, an_open_port_string));
- if (is_not_null(cdr(args)))
- {
- if (!s7_is_character(cadr(args)))
- method_or_bust(sc, cadr(args), sc->make_string_symbol, args, T_CHARACTER, 2);
- fill = s7_character(cadr(args));
+ if (is_function_port(pt))
+ return((*(port_input_function(pt)))(sc, S7_IS_CHAR_READY, pt));
+ return(make_boolean(sc, is_string_port(pt)));
}
- n = make_empty_string(sc, (int)len, fill);
- if (fill == '\0')
- memset((void *)string_value(n), 0, (int)len);
- return(n);
+ return(make_boolean(sc, (is_input_port(sc->input_port)) && (is_string_port(sc->input_port))));
}
-static s7_pointer c_make_string(s7_scheme *sc, s7_int len) {return(make_empty_string(sc, (int)len, ' '));}
-IF_TO_PF(make_string, c_make_string)
-
+static bool is_char_ready_b_p(s7_pointer p) {return(g_is_char_ready(cur_sc, set_plist_1(cur_sc, p)) != cur_sc->F);}
+#endif
-#if (!WITH_PURE_S7)
-static s7_pointer g_string_length(s7_scheme *sc, s7_pointer args)
-{
- #define H_string_length "(string-length str) returns the length of the string str"
- #define Q_string_length s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_string_symbol)
- s7_pointer p;
- p = car(args);
- if (!is_string(p))
- method_or_bust(sc, p, sc->string_length_symbol, args, T_STRING, 0);
- return(make_integer(sc, string_length(p)));
-}
-static s7_int c_string_length(s7_scheme *sc, s7_pointer p)
+static s7_pointer g_is_eof_object(s7_scheme *sc, s7_pointer args)
{
- if (!is_string(p))
- int_method_or_bust(sc, p, sc->string_length_symbol, set_plist_1(sc, p), T_STRING, 0);
- return(string_length(p));
+ #define H_is_eof_object "(eof-object? val) returns #t if val is the end-of-file object"
+ #define Q_is_eof_object pl_bt
+ check_boolean_method(sc, is_eof, sc->is_eof_object_symbol, args);
}
-PF_TO_IF(string_length, c_string_length)
-#endif
+static bool s7_is_eof_object(s7_pointer p) {return(p == cur_sc->eof_object);}
-/* -------------------------------- string-up|downcase -------------------------------- */
+static int closed_port_read_char(s7_scheme *sc, s7_pointer port);
+static s7_pointer closed_port_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied);
+static void closed_port_write_char(s7_scheme *sc, int c, s7_pointer port);
+static void closed_port_write_string(s7_scheme *sc, const char *str, int len, s7_pointer port);
+static void closed_port_display(s7_scheme *sc, const char *s, s7_pointer port);
-static s7_pointer c_string_downcase(s7_scheme *sc, s7_pointer p)
+void s7_close_input_port(s7_scheme *sc, s7_pointer p)
{
- s7_pointer newstr;
- int i, len;
- unsigned char *nstr, *ostr;
-
- sc->temp3 = p;
- if (!is_string(p))
- method_or_bust(sc, p, sc->string_downcase_symbol, list_1(sc, p), T_STRING, 0);
+#if DEBUGGING
+ if (!is_input_port(p))
+ fprintf(stderr, "s7_close_input_port: %s\n", DISPLAY(p));
+#endif
+ if ((is_immutable_port(p)) ||
+ ((is_input_port(p)) && (port_is_closed(p))))
+ return;
- len = string_length(p);
- newstr = make_empty_string(sc, len, 0);
+ if (port_filename(p))
+ {
+ free(port_filename(p));
+ port_filename(p) = NULL;
+ }
- ostr = (unsigned char *)string_value(p);
- nstr = (unsigned char *)string_value(newstr);
- for (i = 0; i < len; i++)
- nstr[i] = lowers[(int)ostr[i]];
+ if (is_file_port(p))
+ {
+ if (port_file(p))
+ {
+ fclose(port_file(p));
+ port_file(p) = NULL;
+ }
+ }
+ else
+ {
+ if ((is_string_port(p)) &&
+ (port_gc_loc(p) != -1))
+ s7_gc_unprotect_at(sc, port_gc_loc(p));
+ }
+ if (port_needs_free(p))
+ {
+ if (port_data(p))
+ {
+ free(port_data(p));
+ port_data(p) = NULL;
+ port_data_size(p) = 0;
+ }
+ port_needs_free(p) = false;
+ }
- return(newstr);
+ port_read_character(p) = closed_port_read_char;
+ port_read_line(p) = closed_port_read_line;
+ port_write_character(p) = closed_port_write_char;
+ port_write_string(p) = closed_port_write_string;
+ port_display(p) = closed_port_display;
+ port_is_closed(p) = true;
}
-static s7_pointer g_string_downcase(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer g_close_input_port(s7_scheme *sc, s7_pointer args)
{
- #define H_string_downcase "(string-downcase str) returns the lower case version of str."
- #define Q_string_downcase pcl_s
- return(c_string_downcase(sc, car(args)));
-}
+ s7_pointer pt;
+ #define H_close_input_port "(close-input-port port) closes the port"
+ #define Q_close_input_port s7_make_signature(sc, 2, sc->is_unspecified_symbol, sc->is_input_port_symbol)
-PF_TO_PF(string_downcase, c_string_downcase)
+ pt = car(args);
+ if (!is_input_port(pt))
+ method_or_bust_with_type_one_arg(sc, pt, sc->close_input_port_symbol, set_plist_1(sc, pt), an_input_port_string);
+ if (!is_immutable_port(pt))
+ s7_close_input_port(sc, pt);
+ return(sc->unspecified);
+}
-static s7_pointer c_string_upcase(s7_scheme *sc, s7_pointer p)
+void s7_flush_output_port(s7_scheme *sc, s7_pointer p)
{
- s7_pointer newstr;
- int i, len;
- unsigned char *nstr, *ostr;
+ if ((!is_output_port(p)) ||
+ (!is_file_port(p)) ||
+ (port_is_closed(p)) ||
+ (p == sc->F))
+ return;
- sc->temp3 = p;
- if (!is_string(p))
- method_or_bust(sc, p, sc->string_upcase_symbol, list_1(sc, p), T_STRING, 0);
+ if (port_file(p))
+ {
+ if (port_position(p) > 0)
+ {
+ if (fwrite((void *)(port_data(p)), 1, port_position(p), port_file(p)) != port_position(p))
+ s7_warn(sc, 64, "fwrite trouble in flush-output-port\n");
+ port_position(p) = 0;
+ }
+ fflush(port_file(p));
+ }
+}
- len = string_length(p);
- newstr = make_empty_string(sc, len, 0);
+static s7_pointer g_flush_output_port(s7_scheme *sc, s7_pointer args)
+{
+ #define H_flush_output_port "(flush-output-port port) flushes the port"
+ #define Q_flush_output_port s7_make_signature(sc, 2, sc->T, sc->is_output_port_symbol)
+ s7_pointer pt;
- ostr = (unsigned char *)string_value(p);
- nstr = (unsigned char *)string_value(newstr);
- for (i = 0; i < len; i++)
- nstr[i] = uppers[(int)ostr[i]];
+ if (is_null(args))
+ pt = sc->output_port;
+ else pt = car(args);
- return(newstr);
+ if (!is_output_port(pt))
+ {
+ if (pt == sc->F) return(pt);
+ method_or_bust_with_type_one_arg(sc, pt, sc->flush_output_port_symbol, args, an_output_port_string);
+ }
+ s7_flush_output_port(sc, pt);
+ return(pt);
}
-static s7_pointer g_string_upcase(s7_scheme *sc, s7_pointer args)
-{
- #define H_string_upcase "(string-upcase str) returns the upper case version of str."
- #define Q_string_upcase pcl_s
- return(c_string_upcase(sc, car(args)));
-}
-PF_TO_PF(string_upcase, c_string_upcase)
+static void close_output_port(s7_scheme *sc, s7_pointer p)
+{
+ if (is_file_port(p))
+ {
+ if (port_filename(p)) /* only a file (output) port has a filename */
+ {
+ free(port_filename(p));
+ port_filename(p) = NULL;
+ port_filename_length(p) = 0;
+ }
+ if (port_file(p))
+ {
+ if (port_position(p) > 0)
+ {
+ if (fwrite((void *)(port_data(p)), 1, port_position(p), port_file(p)) != port_position(p))
+ s7_warn(sc, 64, "fwrite trouble in close-output-port\n");
+ port_position(p) = 0;
+ }
+ free(port_data(p));
+ fflush(port_file(p));
+ fclose(port_file(p));
+ port_file(p) = NULL;
+ }
+ }
+ else
+ {
+ if ((is_string_port(p)) &&
+ (port_data(p)))
+ {
+ free(port_data(p));
+ port_data(p) = NULL;
+ port_data_size(p) = 0;
+ port_needs_free(p) = false;
+ }
+ }
+ port_read_character(p) = closed_port_read_char;
+ port_read_line(p) = closed_port_read_line;
+ port_write_character(p) = closed_port_write_char;
+ port_write_string(p) = closed_port_write_string;
+ port_display(p) = closed_port_display;
+ port_is_closed(p) = true;
+}
-unsigned int s7_string_length(s7_pointer str)
+void s7_close_output_port(s7_scheme *sc, s7_pointer p)
{
- return(string_length(str));
+ if ((is_immutable_port(p)) ||
+ ((is_output_port(p)) && (port_is_closed(p))) ||
+ (p == sc->F))
+ return;
+ close_output_port(sc, p);
}
-/* -------------------------------- string-ref -------------------------------- */
-static s7_pointer string_ref_1(s7_scheme *sc, s7_pointer strng, s7_pointer index)
+static s7_pointer g_close_output_port(s7_scheme *sc, s7_pointer args)
{
- /* every use of this has already checked for the byte-vector case */
- char *str;
- s7_int ind;
+ s7_pointer pt;
+ #define H_close_output_port "(close-output-port port) closes the port"
+ #define Q_close_output_port s7_make_signature(sc, 2, sc->is_unspecified_symbol, sc->is_output_port_symbol)
- if (!s7_is_integer(index))
+ pt = car(args);
+ if (!is_output_port(pt))
{
- s7_pointer p;
- if (!s7_is_integer(p = check_values(sc, index, cons(sc, index, sc->nil))))
- method_or_bust(sc, index, sc->string_ref_symbol, list_2(sc, strng, index), T_INTEGER, 2);
- index = p;
+ if (pt == sc->F) return(sc->unspecified);
+ method_or_bust_with_type_one_arg(sc, pt, sc->close_output_port_symbol, set_plist_1(sc, pt), an_output_port_string);
}
- ind = s7_integer(index);
- if (ind < 0)
- return(wrong_type_argument_with_type(sc, sc->string_ref_symbol, 2, index, a_non_negative_integer_string));
- if (ind >= string_length(strng))
- return(out_of_range(sc, sc->string_ref_symbol, small_int(2), index, its_too_large_string));
+ if (!(is_immutable_port(pt)))
+ s7_close_output_port(sc, pt);
+ return(sc->unspecified);
+}
- str = string_value(strng);
- return(s7_make_character(sc, ((unsigned char *)str)[ind]));
+
+/* -------- read character functions -------- */
+
+static int file_read_char(s7_scheme *sc, s7_pointer port)
+{
+ return(fgetc(port_file(port)));
}
-static s7_pointer g_string_ref_2(s7_scheme *sc, s7_pointer args, s7_pointer caller)
+static int function_read_char(s7_scheme *sc, s7_pointer port)
{
- s7_pointer strng, index, p;
- char *str;
- s7_int ind;
+ return(character((*(port_input_function(port)))(sc, S7_READ_CHAR, port)));
+}
- strng = car(args);
- if (!is_string(strng))
- method_or_bust(sc, strng, caller, args, T_STRING, 1);
- index = cadr(args);
- if (!s7_is_integer(index))
- {
- if (!s7_is_integer(p = check_values(sc, index, cdr(args))))
- method_or_bust(sc, index, caller, args, T_INTEGER, 2);
- index = p;
- }
- ind = s7_integer(index);
- if (ind < 0)
- return(wrong_type_argument_with_type(sc, caller, 2, index, a_non_negative_integer_string));
- if (ind >= string_length(strng))
- return(out_of_range(sc, caller, small_int(2), index, its_too_large_string));
+static int string_read_char(s7_scheme *sc, s7_pointer port)
+{
+ if (port_data_size(port) <= port_position(port)) /* port_string_length is 0 if no port string */
+ return(EOF);
+ return((unsigned char)port_data(port)[port_position(port)++]);
+}
- str = string_value(strng);
- if (is_byte_vector(strng))
- return(small_int((unsigned char)(str[ind])));
- return(s7_make_character(sc, ((unsigned char *)str)[ind]));
+
+static int output_read_char(s7_scheme *sc, s7_pointer port)
+{
+ simple_wrong_type_argument_with_type(sc, sc->read_char_symbol, port, an_input_port_string);
+ return(0);
}
-static s7_pointer g_string_ref(s7_scheme *sc, s7_pointer args)
+
+static int closed_port_read_char(s7_scheme *sc, s7_pointer port)
{
- #define H_string_ref "(string-ref str index) returns the character at the index-th element of the string str"
- #define Q_string_ref s7_make_signature(sc, 3, sc->is_char_symbol, sc->is_string_symbol, sc->is_integer_symbol)
- return(g_string_ref_2(sc, args, sc->string_ref_symbol));
+ simple_wrong_type_argument_with_type(sc, sc->read_char_symbol, port, an_open_port_string);
+ return(0);
}
-static s7_pointer g_byte_vector_ref(s7_scheme *sc, s7_pointer args)
+
+
+/* -------- read line functions -------- */
+
+static s7_pointer output_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
{
- #define H_byte_vector_ref "(byte-vector-ref vect index) returns the byte at the index-th element of the byte-vector vect"
- #define Q_byte_vector_ref s7_make_signature(sc, 3, sc->is_integer_symbol, sc->is_byte_vector_symbol, sc->is_integer_symbol)
- return(g_string_ref_2(sc, args, sc->byte_vector_ref_symbol));
+ return(simple_wrong_type_argument_with_type(sc, sc->read_line_symbol, port, an_input_port_string));
}
-static s7_pointer c_string_ref(s7_scheme *sc, s7_pointer str, s7_int ind)
+
+static s7_pointer closed_port_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
{
- if (!is_string(str))
- method_or_bust(sc, str, sc->string_ref_symbol, list_2(sc, str, make_integer(sc, ind)), T_STRING, 1);
- if (ind < 0)
- return(wrong_type_argument_with_type(sc, sc->string_ref_symbol, 2, make_integer(sc, ind), a_non_negative_integer_string));
- if (ind >= string_length(str))
- return(out_of_range(sc, sc->string_ref_symbol, small_int(2), make_integer(sc, ind), its_too_large_string));
- if (is_byte_vector(str))
- return(small_int(((unsigned char *)string_value(str))[ind]));
- return(s7_make_character(sc, ((unsigned char *)string_value(str))[ind]));
+ return(simple_wrong_type_argument_with_type(sc, sc->read_line_symbol, port, an_open_port_string));
}
-PIF_TO_PF(string_ref, c_string_ref)
+
+static s7_pointer function_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
+{
+ return((*(port_input_function(port)))(sc, S7_READ_LINE, port));
+}
-/* -------------------------------- string-set! -------------------------------- */
-static s7_pointer g_string_set_2(s7_scheme *sc, s7_pointer args, s7_pointer caller)
+static s7_pointer stdin_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
{
- s7_pointer x, c, index;
- char *str;
- s7_int ind;
+ if (!sc->read_line_buf)
+ {
+ sc->read_line_buf_size = 1024;
+ sc->read_line_buf = (char *)malloc(sc->read_line_buf_size * sizeof(char));
+ }
- x = car(args);
- if (!is_string(x))
- method_or_bust(sc, x, caller, args, T_STRING, 1);
+ if (fgets(sc->read_line_buf, sc->read_line_buf_size, stdin))
+ return(s7_make_string(sc, sc->read_line_buf)); /* fgets adds the trailing '\0' */
+ return(s7_make_string_with_length(sc, NULL, 0));
+}
- index = cadr(args);
- if (!s7_is_integer(index))
+
+static s7_pointer file_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
+{
+ char *buf;
+ int read_size, previous_size = 0;
+
+ if (!sc->read_line_buf)
{
- s7_pointer p;
- if (!s7_is_integer(p = check_values(sc, index, cdr(args))))
- method_or_bust(sc, index, caller, args, T_INTEGER, 2);
- index = p;
+ sc->read_line_buf_size = 1024;
+ sc->read_line_buf = (char *)malloc(sc->read_line_buf_size * sizeof(char));
}
- ind = s7_integer(index);
- if (ind < 0)
- return(wrong_type_argument_with_type(sc, caller, 2, index, a_non_negative_integer_string));
- if (ind >= string_length(x))
- return(out_of_range(sc, caller, small_int(2), index, its_too_large_string));
- str = string_value(_TSet(x));
- c = caddr(args);
- if (!s7_is_character(c))
+ buf = sc->read_line_buf;
+ read_size = sc->read_line_buf_size;
+
+ while (true)
{
- if ((is_byte_vector(x)) &&
- (s7_is_integer(c)))
+ char *p, *rtn;
+ size_t len;
+
+ p = fgets(buf, read_size, port_file(port));
+ if (!p)
+ return(sc->eof_object);
+
+ rtn = strchr(buf, (int)'\n');
+ if (rtn)
{
- s7_int ic; /* not int here! */
- ic = s7_integer(c);
- if ((ic < 0) || (ic > 255))
- return(wrong_type_argument_with_type(sc, caller, 3, c, an_unsigned_byte_string));
- str[ind] = (char)ic;
- return(c);
+ port_line_number(port)++;
+ return(s7_make_string_with_length(sc, sc->read_line_buf, (with_eol) ? (previous_size + rtn - p + 1) : (previous_size + rtn - p)));
}
- method_or_bust(sc, c, caller, list_3(sc, x, index, c), T_CHARACTER, 3);
+ /* if no newline, then either at eof or need bigger buffer */
+ len = strlen(sc->read_line_buf);
+
+ if ((len + 1) < sc->read_line_buf_size)
+ return(s7_make_string_with_length(sc, sc->read_line_buf, len));
+
+ previous_size = sc->read_line_buf_size;
+ sc->read_line_buf_size *= 2;
+ sc->read_line_buf = (char *)realloc(sc->read_line_buf, sc->read_line_buf_size * sizeof(char));
+ read_size = previous_size;
+ previous_size -= 1;
+ buf = (char *)(sc->read_line_buf + previous_size);
}
- str[ind] = (char)s7_character(c);
- return(c);
+ return(sc->eof_object);
}
-static s7_pointer g_string_set(s7_scheme *sc, s7_pointer args)
-{
- #define H_string_set "(string-set! str index chr) sets the index-th element of the string str to the character chr"
- #define Q_string_set s7_make_signature(sc, 4, sc->is_char_symbol, sc->is_string_symbol, sc->is_integer_symbol, sc->is_char_symbol)
- return(g_string_set_2(sc, args, sc->string_set_symbol));
-}
-static s7_pointer g_byte_vector_set(s7_scheme *sc, s7_pointer args)
+static s7_pointer string_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
{
- #define H_byte_vector_set "(byte-vector-set! vect index byte) sets the index-th element of the byte-vector vect to the integer byte"
- #define Q_byte_vector_set s7_make_signature(sc, 4, sc->is_integer_symbol, sc->is_byte_vector_symbol, sc->is_integer_symbol, sc->is_integer_symbol)
- return(g_string_set_2(sc, args, sc->byte_vector_set_symbol));
+ unsigned int i, port_start;
+ unsigned char *port_str, *cur, *start;
+
+ port_start = port_position(port);
+ port_str = port_data(port);
+ start = (unsigned char *)(port_str + port_start);
+
+ cur = (unsigned char *)strchr((const char *)start, (int)'\n'); /* this can run off the end making valgrind unhappy, but I think it's innocuous */
+ if (cur)
+ {
+ port_line_number(port)++;
+ i = cur - port_str;
+ port_position(port) = i + 1;
+ if (copied)
+ return(s7_make_string_with_length(sc, (const char *)start, ((with_eol) ? i + 1 : i) - port_start));
+ return(make_string_wrapper_with_length(sc, (char *)start, ((with_eol) ? i + 1 : i) - port_start));
+ }
+ i = port_data_size(port);
+ port_position(port) = i;
+ if (i <= port_start) /* the < part can happen -- if not caught we try to create a string of length -1 -> segfault */
+ return(sc->eof_object);
+
+ if (copied)
+ return(s7_make_string_with_length(sc, (const char *)start, i - port_start));
+ return(make_string_wrapper_with_length(sc, (char *)start, i - port_start));
}
-static int c_string_tester(s7_scheme *sc, s7_pointer expr)
+
+/* -------- write character functions -------- */
+
+static void resize_port_data(s7_pointer pt, unsigned int new_size)
{
- s7_pointer a1;
- a1 = cadr(expr);
- if (is_symbol(a1))
+ unsigned int loc;
+ loc = port_data_size(pt);
+ if (new_size < loc)
{
- s7_pointer table;
- table = s7_slot(sc, a1);
- if ((is_slot(table)) &&
- ((is_immutable_symbol(a1)) || (!is_stepper(table))) &&
- (is_string(slot_value(table))))
- {
- s7_pointer a2;
- s7_xf_store(sc, slot_value(table));
- a2 = caddr(expr);
- if (is_symbol(a2))
- {
- s7_pointer slot;
- slot = s7_slot(sc, a2);
- if ((is_slot(slot)) &&
- (is_integer(slot_value(slot))))
- {
- s7_xf_store(sc, slot);
- return(TEST_SS);
- }
- }
- else
- {
- if (s7_arg_to_if(sc, a1))
- return(TEST_SI);
- }
- return(TEST_SQ);
- }
+#if DEBUGGING
+ fprintf(stderr, "%s[%d], old: %u, new: %u\n", __func__, __LINE__, loc, new_size);
+#endif
+ return;
}
- return(TEST_NO_S);
+ 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);
}
-static s7_pointer c_string_set_s(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer val)
+static void string_write_char(s7_scheme *sc, int c, s7_pointer pt)
{
- if ((index < 0) ||
- (index >= string_length(vec)))
- return(out_of_range(sc, sc->string_set_symbol, small_int(2), make_integer(sc, index), (index < 0) ? its_negative_string : its_too_large_string));
+ if (port_position(pt) >= port_data_size(pt))
+ resize_port_data(pt, port_data_size(pt) * 2);
+ port_data(pt)[port_position(pt)++] = c;
+}
- if (!s7_is_character(val))
- {
- if ((is_byte_vector(vec)) &&
- (s7_is_integer(val)))
- {
- s7_int ic; /* not int here! */
- ic = s7_integer(val);
- if ((ic < 0) || (ic > 255))
- return(wrong_type_argument_with_type(sc, sc->string_set_symbol, 3, val, an_unsigned_byte_string));
- string_value(vec)[index] = (char)ic;
- return(val);
- }
- method_or_bust(sc, val, sc->string_set_symbol, list_3(sc, vec, make_integer(sc, index), val), T_CHARACTER, 3);
- }
- string_value(vec)[index] = (char)character(val);
- return(val);
+static void stdout_write_char(s7_scheme *sc, int c, s7_pointer port)
+{
+ fputc(c, stdout);
}
-static s7_pointer c_string_set(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer val)
+static void stderr_write_char(s7_scheme *sc, int c, s7_pointer port)
{
- if (!s7_is_string(vec))
- method_or_bust(sc, vec, sc->string_set_symbol, set_plist_3(sc, vec, make_integer(sc, index), val), T_STRING, 1);
- return(c_string_set_s(sc, vec, index, val));
+ fputc(c, stderr);
}
-PIPF_TO_PF(string_set, c_string_set_s, c_string_set, c_string_tester)
+static void function_write_char(s7_scheme *sc, int c, s7_pointer port)
+{
+ (*(port_output_function(port)))(sc, c, port);
+}
-/* -------------------------------- string-append -------------------------------- */
-static s7_pointer g_string_append_1(s7_scheme *sc, s7_pointer args, bool use_temp)
+#define PORT_DATA_SIZE 256
+static void file_write_char(s7_scheme *sc, int c, s7_pointer port)
{
- int len = 0;
- s7_pointer x, newstr;
- char *pos;
+ if (port_position(port) == PORT_DATA_SIZE)
+ {
+ if (fwrite((void *)(port_data(port)), 1, PORT_DATA_SIZE, port_file(port)) != PORT_DATA_SIZE)
+ s7_warn(sc, 64, "fwrite trouble during write-char\n");
+ port_position(port) = 0;
+ }
+ port_data(port)[port_position(port)++] = (unsigned char)c;
+}
- if (is_null(args))
- return(s7_make_string_with_length(sc, "", 0));
- /* get length for new string */
- for (x = args; is_not_null(x); x = cdr(x))
- {
- s7_pointer p;
- p = car(x);
- if (!is_string(p))
- {
- /* look for string-append and if found, cobble up a plausible intermediate call */
- if (has_methods(p))
- {
- s7_pointer func;
- func = find_method(sc, find_let(sc, p), sc->string_append_symbol);
- if (func != sc->undefined)
- {
- s7_pointer y;
- if (len == 0)
- return(s7_apply_function(sc, func, args));
- newstr = make_empty_string(sc, len, 0);
- for (pos = string_value(newstr), y = args; y != x; pos += string_length(car(y)), y = cdr(y))
- memcpy(pos, string_value(car(y)), string_length(car(y)));
- return(s7_apply_function(sc, func, cons(sc, newstr, x)));
- }
- }
- return(wrong_type_argument(sc, sc->string_append_symbol, position_of(x, args), p, T_STRING));
- }
- len += string_length(p);
- }
-
- if (use_temp)
- {
- newstr = sc->tmp_strs[0];
- prepare_temporary_string(sc, len + 1, 0);
- string_length(newstr) = len;
- string_value(newstr)[len] = 0;
- }
- else
- {
- /* store the contents of the argument strings into the new string */
- newstr = make_empty_string(sc, len, 0);
- }
- for (pos = string_value(newstr), x = args; is_not_null(x); pos += string_length(car(x)), x = cdr(x))
- memcpy(pos, string_value(car(x)), string_length(car(x)));
+static void input_write_char(s7_scheme *sc, int c, s7_pointer port)
+{
+ simple_wrong_type_argument_with_type(sc, sc->write_char_symbol, port, an_output_port_string);
+}
- if (is_byte_vector(car(args)))
- set_byte_vector(newstr);
- return(newstr);
+static void closed_port_write_char(s7_scheme *sc, int c, s7_pointer port)
+{
+ simple_wrong_type_argument_with_type(sc, sc->write_char_symbol, port, an_open_port_string);
}
-static s7_pointer g_string_append(s7_scheme *sc, s7_pointer args)
+
+
+/* -------- write string functions -------- */
+
+static void input_write_string(s7_scheme *sc, const char *str, int len, s7_pointer port)
{
- #define H_string_append "(string-append str1 ...) appends all its string arguments into one string"
- #define Q_string_append pcl_s
- return(g_string_append_1(sc, args, false));
+ simple_wrong_type_argument_with_type(sc, sc->write_symbol, port, an_output_port_string);
}
-static s7_pointer string_append_to_temp;
-static s7_pointer g_string_append_to_temp(s7_scheme *sc, s7_pointer args)
+
+static void closed_port_write_string(s7_scheme *sc, const char *str, int len, s7_pointer port)
{
- return(g_string_append_1(sc, args, true));
+ simple_wrong_type_argument_with_type(sc, sc->write_symbol, port, an_open_port_string);
}
-#if (!WITH_PURE_S7)
-static s7_pointer g_string_copy(s7_scheme *sc, s7_pointer args)
+static void input_display(s7_scheme *sc, const char *s, s7_pointer port)
{
- #define H_string_copy "(string-copy str) returns a copy of its string argument"
- #define Q_string_copy s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_string_symbol)
- s7_pointer p;
- p = car(args);
- if (!is_string(p))
- method_or_bust(sc, p, sc->string_copy_symbol, args, T_STRING, 1);
- return(s7_make_string_with_length(sc, string_value(p), string_length(p)));
+ simple_wrong_type_argument_with_type(sc, sc->write_symbol, port, an_output_port_string);
}
-#endif
-
-/* -------------------------------- substring -------------------------------- */
-static s7_pointer start_and_end(s7_scheme *sc, s7_pointer caller, s7_pointer fallback,
- s7_pointer start_and_end_args, s7_pointer args, int position, s7_int *start, s7_int *end)
+static void closed_port_display(s7_scheme *sc, const char *s, s7_pointer port)
{
- /* we assume that *start=0 and *end=length, that end is "exclusive"
- * return true if the start/end points are not changed.
- */
- s7_pointer pstart, pend, p;
- s7_int index;
+ simple_wrong_type_argument_with_type(sc, sc->write_symbol, port, an_open_port_string);
+}
-#if DEBUGGING
- if (is_null(start_and_end_args))
+static void stdout_write_string(s7_scheme *sc, const char *str, int len, s7_pointer port)
+{
+ if (str[len] == '\0')
+ fputs(str, stdout);
+ else
{
- fprintf(stderr, "start_and_end args is null\n");
- return(sc->gc_nil);
+ int i;
+ for (i = 0; i < len; i++)
+ fputc(str[i], stdout);
}
-#endif
+}
- pstart = car(start_and_end_args);
- if (!s7_is_integer(pstart))
+static void stderr_write_string(s7_scheme *sc, const char *str, int len, s7_pointer port)
+{
+ if (str[len] == '\0')
+ fputs(str, stderr);
+ else
{
- if (!s7_is_integer(p = check_values(sc, pstart, start_and_end_args)))
- {
- check_two_methods(sc, pstart, caller, fallback, args);
- return(wrong_type_argument(sc, caller, position, pstart, T_INTEGER));
- }
- else pstart = p;
+ int i;
+ for (i = 0; i < len; i++)
+ fputc(str[i], stderr);
}
+}
- index = s7_integer(pstart);
- if ((index < 0) ||
- (index > *end)) /* *end == length here */
- return(out_of_range(sc, caller, small_int(position), pstart, (index < 0) ? its_negative_string : its_too_large_string));
- *start = index;
+static void string_write_string(s7_scheme *sc, const char *str, int len, s7_pointer pt)
+{
+ unsigned int new_len; /* len is known to be non-zero */
- if (is_null(cdr(start_and_end_args)))
- return(sc->gc_nil);
+ new_len = port_position(pt) + (unsigned int)len;
+ if (new_len >= port_data_size(pt))
+ resize_port_data(pt, new_len * 2);
+ memcpy((void *)(port_data(pt) + port_position(pt)), (void *)str, len);
+ /* memcpy is much faster than the equivalent while loop, and faster than using the 4-bytes-at-a-time shuffle */
+ port_position(pt) = new_len;
+}
- pend = cadr(start_and_end_args);
- if (!s7_is_integer(pend))
+
+static s7_pointer write_string_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
+{
+ check_for_substring_temp(sc, expr);
+ return(f);
+}
+
+
+static void file_display(s7_scheme *sc, const char *s, s7_pointer port)
+{
+ if (s)
{
- if (!s7_is_integer(p = check_values(sc, pend, cdr(start_and_end_args))))
+ if (port_position(port) > 0)
{
- check_two_methods(sc, pend, caller, fallback,
- (position == 2) ? list_3(sc, car(args), pstart, pend) : list_4(sc, car(args), cadr(args), pstart, pend));
- return(wrong_type_argument(sc, caller, position + 1, pend, T_INTEGER));
+ if (fwrite((void *)(port_data(port)), 1, port_position(port), port_file(port)) != port_position(port))
+ s7_warn(sc, 64, "fwrite trouble in display\n");
+ port_position(port) = 0;
}
- else pend = p;
+ if (fputs(s, port_file(port)) == EOF)
+ s7_warn(sc, 64, "write to %s: %s\n", port_filename(port), strerror(errno));
}
- index = s7_integer(pend);
- if ((index < *start) ||
- (index > *end))
- return(out_of_range(sc, caller, small_int(position + 1), pend, (index < *start) ? its_too_small_string : its_too_large_string));
- *end = index;
- return(sc->gc_nil);
}
-
-static s7_pointer g_substring(s7_scheme *sc, s7_pointer args)
+static void file_write_string(s7_scheme *sc, const char *str, int len, s7_pointer pt)
{
- #define H_substring "(substring str start (end (length str))) returns the portion of the string str between start and \
-end: (substring \"01234\" 1 2) -> \"1\""
- #define Q_substring s7_make_circular_signature(sc, 2, 3, sc->is_string_symbol, sc->is_string_symbol, sc->is_integer_symbol)
-
- s7_pointer x, str;
- s7_int start = 0, end;
- int len;
- char *s;
-
- str = car(args);
- if (!is_string(str))
- method_or_bust(sc, str, sc->substring_symbol, args, T_STRING, 1);
-
- end = string_length(str);
- if (!is_null(cdr(args)))
+ int new_len;
+ new_len = port_position(pt) + len;
+ if (new_len >= PORT_DATA_SIZE)
{
- x = start_and_end(sc, sc->substring_symbol, NULL, cdr(args), args, 2, &start, &end);
- if (x != sc->gc_nil) return(x);
+ if (port_position(pt) > 0)
+ {
+ if (fwrite((void *)(port_data(pt)), 1, port_position(pt), port_file(pt)) != port_position(pt))
+ s7_warn(sc, 64, "fwrite trouble in write-string\n");
+ port_position(pt) = 0;
+ }
+ if (fwrite((void *)str, 1, len, port_file(pt)) != (size_t)len)
+ s7_warn(sc, 64, "fwrite trouble in write-string\n");
+ }
+ else
+ {
+ memcpy((void *)(port_data(pt) + port_position(pt)), (void *)str, len);
+ port_position(pt) = new_len;
}
- s = string_value(str);
- len = (int)(end - start);
- x = s7_make_string_with_length(sc, (char *)(s + start), len);
- string_value(x)[len] = 0;
- return(x);
}
-
-static s7_pointer substring_to_temp;
-static s7_pointer g_substring_to_temp(s7_scheme *sc, s7_pointer args)
+static void string_display(s7_scheme *sc, const char *s, s7_pointer port)
{
- s7_pointer str;
- s7_int start = 0, end;
+ if (s)
+ string_write_string(sc, s, safe_strlen(s), port);
+}
- str = car(args);
- if (!is_string(str))
- method_or_bust(sc, str, sc->substring_symbol, args, T_STRING, 1);
- end = string_length(str);
- if (!is_null(cdr(args)))
+static void function_display(s7_scheme *sc, const char *s, s7_pointer port)
+{
+ if (s)
{
- s7_pointer x;
- x = start_and_end(sc, sc->substring_symbol, NULL, cdr(args), args, 2, &start, &end);
- if (x != sc->gc_nil) return(x);
+ for (; *s; s++)
+ (*(port_output_function(port)))(sc, *s, port);
}
- return(make_temporary_string(sc, (const char *)(string_value(str) + start), (int)(end - start)));
}
+static void function_write_string(s7_scheme *sc, const char *str, int len, s7_pointer pt)
+{
+ int i;
+ for (i = 0; i < len; i++)
+ (*(port_output_function(pt)))(sc, str[i], pt);
+}
-/* -------------------------------- object->string -------------------------------- */
-static use_write_t write_choice(s7_scheme *sc, s7_pointer arg)
+static void stdout_display(s7_scheme *sc, const char *s, s7_pointer port)
{
- if (arg == sc->F) return(USE_DISPLAY);
- if (arg == sc->T) return(USE_WRITE);
- if (arg == sc->key_readable_symbol) return(USE_READABLE_WRITE);
- return(USE_WRITE_WRONG);
+ if (s) fputs(s, stdout);
}
-#define DONT_USE_DISPLAY(Choice) ((Choice == USE_DISPLAY) ? USE_WRITE : Choice)
-static char *s7_object_to_c_string_1(s7_scheme *sc, s7_pointer obj, use_write_t use_write, int *nlen);
+static void stderr_display(s7_scheme *sc, const char *s, s7_pointer port)
+{
+ if (s) fputs(s, stderr);
+}
-static s7_pointer g_object_to_string(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer g_write_string(s7_scheme *sc, s7_pointer args)
{
- #define H_object_to_string "(object->string obj (write #t)) returns a string representation of obj."
- #define Q_object_to_string s7_make_signature(sc, 3, sc->is_string_symbol, sc->T, s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_keyword_symbol))
+ #define H_write_string "(write-string str port start end) writes str to port."
+ #define Q_write_string s7_make_circular_signature(sc, 3, 4, sc->is_string_symbol, sc->is_string_symbol, sc->is_output_port_symbol, sc->is_integer_symbol)
+ s7_pointer str, port;
+ s7_int start = 0, end;
- use_write_t choice;
- char *str;
- s7_pointer obj;
- int len = 0;
+ str = car(args);
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->write_string_symbol, args, T_STRING, 1);
- if (is_not_null(cdr(args)))
+ end = string_length(str);
+ if (!is_null(cdr(args)))
{
- choice = write_choice(sc, cadr(args));
- if (choice == USE_WRITE_WRONG)
- method_or_bust(sc, cadr(args), sc->object_to_string_symbol, args, T_BOOLEAN, 2);
+ s7_pointer inds;
+ port = cadr(args);
+ inds = cddr(args);
+ if (!is_null(inds))
+ {
+ s7_pointer p;
+ p = start_and_end(sc, sc->write_string_symbol, NULL, inds, args, 3, &start, &end);
+ if (p != sc->gc_nil) return(p);
+ }
+ }
+ else port = sc->output_port;
+ if (!is_output_port(port))
+ {
+ if (port == sc->F)
+ {
+ s7_pointer x;
+ int len;
+ if ((start == 0) && (end == string_length(str)))
+ return(str);
+ len = (int)(end - start);
+ x = s7_make_string_with_length(sc, (char *)(string_value(str) + start), len);
+ string_value(x)[len] = 0;
+ return(x);
+ }
+ method_or_bust_with_type(sc, port, sc->write_string_symbol, args, an_output_port_string, 2);
}
- else choice = USE_WRITE;
- /* can't use s7_object_to_string here anymore because it assumes use_write arg is a boolean */
- obj = car(args);
- check_method(sc, obj, sc->object_to_string_symbol, args);
- str = s7_object_to_c_string_1(sc, obj, choice, &len);
- if (str)
- return(make_string_uncopied_with_length(sc, str, len));
- return(s7_make_string_with_length(sc, "", 0));
+ if (start == 0)
+ port_write_string(port)(sc, string_value(str), end, port);
+ else port_write_string(port)(sc, (char *)(string_value(str) + start), (end - start), port);
+ return(str);
}
-static s7_pointer c_object_to_string(s7_scheme *sc, s7_pointer x) {return(g_object_to_string(sc, set_plist_1(sc, x)));}
-PF_TO_PF(object_to_string, c_object_to_string)
+/* -------- skip to newline readers -------- */
-/* -------------------------------- string comparisons -------------------------------- */
-static int scheme_strcmp(s7_pointer s1, s7_pointer s2)
+static token_t file_read_semicolon(s7_scheme *sc, s7_pointer pt)
{
- /* tricky here because str[i] must be treated as unsigned
- * (string<? (string (integer->char #xf0)) (string (integer->char #x70)))
- * also null or lack thereof does not say anything about the string end
- * so we have to go by its length.
- */
- int i, len, len1, len2;
- char *str1, *str2;
-
- len1 = string_length(s1);
- len2 = string_length(s2);
- if (len1 > len2)
- len = len2;
- else len = len1;
-
- str1 = string_value(s1);
- str2 = string_value(s2);
-
- for (i = 0; i < len; i++)
- if ((unsigned char)(str1[i]) < (unsigned char )(str2[i]))
- return(-1);
- else
- {
- if ((unsigned char)(str1[i]) > (unsigned char)(str2[i]))
- return(1);
- }
-
- if (len1 < len2)
- return(-1);
- if (len1 > len2)
- return(1);
- return(0);
+ int c;
+ do (c = fgetc(port_file(pt))); while ((c != '\n') && (c != EOF));
+ port_line_number(pt)++;
+ if (c == EOF)
+ return(TOKEN_EOF);
+ return(token(sc));
}
-static bool is_string_via_method(s7_scheme *sc, s7_pointer p)
+static token_t string_read_semicolon(s7_scheme *sc, s7_pointer pt)
{
- if (s7_is_string(p))
- return(true);
- if (has_methods(p))
+ const char *orig_str, *str;
+ str = (const char *)(port_data(pt) + port_position(pt));
+ orig_str = strchr(str, (int)'\n');
+ if (!orig_str)
{
- s7_pointer f;
- f = find_method(sc, find_let(sc, p), sc->is_string_symbol);
- if (f != sc->undefined)
- return(is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->nil))));
+ port_position(pt) = port_data_size(pt);
+ return(TOKEN_EOF);
}
- return(false);
+ port_position(pt) += (orig_str - str + 1); /* + 1 because strchr leaves orig_str pointing at the newline */
+ port_line_number(pt)++;
+ return(token(sc));
}
-static s7_pointer g_string_cmp(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
-{
- s7_pointer x, y;
- y = car(args);
- if (!is_string(y))
- method_or_bust(sc, y, sym, args, T_STRING, 1);
+/* -------- white space readers -------- */
- for (x = cdr(args); is_not_null(x); x = cdr(x))
- {
- if (!is_string(car(x)))
- method_or_bust(sc, car(x), sym, cons(sc, y, x), T_STRING, position_of(x, args));
- if (scheme_strcmp(y, car(x)) != val)
- {
- for (y = cdr(x); is_pair(y); y = cdr(y))
- if (!is_string_via_method(sc, car(y)))
- return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_STRING));
- return(sc->F);
- }
- y = car(x);
- }
- return(sc->T);
+static int file_read_white_space(s7_scheme *sc, s7_pointer port)
+{
+ int c;
+ while (is_white_space(c = fgetc(port_file(port))))
+ if (c == '\n')
+ port_line_number(port)++;
+ return(c);
}
-static s7_pointer g_string_cmp_not(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
+static int terminated_string_read_white_space(s7_scheme *sc, s7_pointer pt)
{
- s7_pointer x, y;
-
- y = car(args);
- if (!is_string(y))
- method_or_bust(sc, y, sym, args, T_STRING, 1);
+ const unsigned char *str;
+ unsigned char c;
+ /* here we know we have null termination and white_space[#\null] is false.
+ */
+ str = (const unsigned char *)(port_data(pt) + port_position(pt));
- for (x = cdr(args); is_not_null(x); x = cdr(x))
- {
- if (!is_string(car(x)))
- method_or_bust(sc, car(x), sym, cons(sc, y, x), T_STRING, position_of(x, args));
- if (scheme_strcmp(y, car(x)) == val)
- {
- for (y = cdr(x); is_pair(y); y = cdr(y))
- if (!is_string_via_method(sc, car(y)))
- return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_STRING));
- return(sc->F);
- }
- y = car(x);
- }
- return(sc->T);
+ while (white_space[c = *str++]) /* (let ((ÿa 1)) ÿa) -- 255 is not -1 = EOF */
+ if (c == '\n')
+ port_line_number(pt)++;
+ if (c)
+ port_position(pt) = str - port_data(pt);
+ else port_position(pt) = port_data_size(pt);
+ return((int)c);
}
-static bool scheme_strings_are_equal(s7_pointer x, s7_pointer y)
+/* name (alphanumeric token) readers */
+
+static void resize_strbuf(s7_scheme *sc, unsigned int needed_size)
{
- return((string_length(x) == string_length(y)) &&
- (strings_are_equal_with_length(string_value(x), string_value(y), string_length(x))));
+ unsigned int i, old_size;
+ old_size = sc->strbuf_size;
+ while (sc->strbuf_size <= needed_size) sc->strbuf_size *= 2;
+ sc->strbuf = (char *)realloc(sc->strbuf, sc->strbuf_size * sizeof(char));
+ for (i = old_size; i < sc->strbuf_size; i++) sc->strbuf[i] = '\0';
}
-static s7_pointer g_strings_are_equal(s7_scheme *sc, s7_pointer args)
+static s7_pointer file_read_name_or_sharp(s7_scheme *sc, s7_pointer pt, bool atom_case)
{
- #define H_strings_are_equal "(string=? str ...) returns #t if all the string arguments are equal"
- #define Q_strings_are_equal pcl_bs
+ int c;
+ unsigned int i = 1;
+ /* sc->strbuf[0] has the first char of the string we're reading */
- /* C-based check stops at null, but we can have embedded nulls.
- * (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2))
- */
- s7_pointer x, y;
- bool happy = true;
+ do {
+ c = fgetc(port_file(pt)); /* might return EOF */
+ if (c == '\n')
+ port_line_number(pt)++;
- y = car(args);
- if (!is_string(y))
- method_or_bust(sc, y, sc->string_eq_symbol, args, T_STRING, 1);
+ sc->strbuf[i++] = c;
+ if (i >= sc->strbuf_size)
+ resize_strbuf(sc, i);
+ } while ((c != EOF) && (char_ok_in_a_name[c]));
- for (x = cdr(args); is_pair(x); x = cdr(x))
+ if ((i == 2) &&
+ (sc->strbuf[0] == '\\'))
+ sc->strbuf[2] = '\0';
+ else
{
- s7_pointer p;
- p = car(x);
- if (y != p)
+ if (c != EOF)
{
- if (!is_string(p))
- method_or_bust(sc, p, sc->string_eq_symbol, cons(sc, y, x), T_STRING, position_of(x, args));
- if (happy)
- happy = scheme_strings_are_equal(p, y);
+ if (c == '\n')
+ port_line_number(pt)--;
+ ungetc(c, port_file(pt));
}
+ sc->strbuf[i - 1] = '\0';
}
- if (!happy)
- return(sc->F);
- return(sc->T);
-}
-
-static s7_pointer c_string_eq(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- if (!is_string(x))
- method_or_bust(sc, x, sc->string_eq_symbol, list_2(sc, x, y), T_STRING, 1);
- if (!is_string(y))
- method_or_bust(sc, y, sc->string_eq_symbol, list_2(sc, x, y), T_STRING, 2);
- return(make_boolean(sc, ((string_length(x) == string_length(y)) &&
- (strings_are_equal_with_length(string_value(x), string_value(y), string_length(x))))));
-}
-PF2_TO_PF(string_eq, c_string_eq)
+ if (atom_case)
+ return(make_atom(sc, sc->strbuf, BASE_10, SYMBOL_OK, WITH_OVERFLOW_ERROR));
+ return(make_sharp_constant(sc, sc->strbuf, BASE_10, WITH_OVERFLOW_ERROR));
+}
-static s7_pointer g_strings_are_less(s7_scheme *sc, s7_pointer args)
+static s7_pointer file_read_name(s7_scheme *sc, s7_pointer pt)
{
- #define H_strings_are_less "(string<? str ...) returns #t if all the string arguments are increasing"
- #define Q_strings_are_less pcl_bs
-
- return(g_string_cmp(sc, args, -1, sc->string_lt_symbol));
+ return(file_read_name_or_sharp(sc, pt, true));
}
-static s7_pointer c_string_lt(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_pointer file_read_sharp(s7_scheme *sc, s7_pointer pt)
{
- if (!is_string(x))
- method_or_bust(sc, x, sc->string_lt_symbol, list_2(sc, x, y), T_STRING, 1);
- if (!is_string(y))
- method_or_bust(sc, y, sc->string_lt_symbol, list_2(sc, x, y), T_STRING, 2);
- return(make_boolean(sc, scheme_strcmp(x, y) == -1));
+ return(file_read_name_or_sharp(sc, pt, false));
}
-PF2_TO_PF(string_lt, c_string_lt)
-
-static s7_pointer g_strings_are_greater(s7_scheme *sc, s7_pointer args)
+static s7_pointer string_read_name_no_free(s7_scheme *sc, s7_pointer pt)
{
- #define H_strings_are_greater "(string>? str ...) returns #t if all the string arguments are decreasing"
- #define Q_strings_are_greater pcl_bs
-
- return(g_string_cmp(sc, args, 1, sc->string_gt_symbol));
-}
+ /* sc->strbuf[0] has the first char of the string we're reading */
+ unsigned int k;
+ char *str, *orig_str;
-static s7_pointer c_string_gt(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- if (!is_string(x))
- method_or_bust(sc, x, sc->string_gt_symbol, list_2(sc, x, y), T_STRING, 1);
- if (!is_string(y))
- method_or_bust(sc, y, sc->string_gt_symbol, list_2(sc, x, y), T_STRING, 2);
- return(make_boolean(sc, scheme_strcmp(x, y) == 1));
-}
+ str = (char *)(port_data(pt) + port_position(pt));
-PF2_TO_PF(string_gt, c_string_gt)
+ if (!char_ok_in_a_name[(unsigned char)*str])
+ {
+ s7_pointer result;
+ result = sc->singletons[(unsigned char)(sc->strbuf[0])];
+ if (!result)
+ {
+ sc->strbuf[1] = '\0';
+ result = make_symbol_with_length(sc, sc->strbuf, 1);
+ sc->singletons[(unsigned char)(sc->strbuf[0])] = result;
+ }
+ return(result);
+ }
+ orig_str = (char *)(str - 1);
+ str++;
+ while (char_ok_in_a_name[(unsigned char)(*str)]) {str++;}
+ k = str - orig_str;
+ if (*str != 0)
+ port_position(pt) += (k - 1);
+ else port_position(pt) = port_data_size(pt);
-static s7_pointer g_strings_are_geq(s7_scheme *sc, s7_pointer args)
-{
- #define H_strings_are_geq "(string>=? str ...) returns #t if all the string arguments are equal or decreasing"
- #define Q_strings_are_geq pcl_bs
+ /* this is equivalent to:
+ * str = strpbrk(str, "(); \"\t\r\n");
+ * if (!str)
+ * {
+ * k = strlen(orig_str);
+ * str = (char *)(orig_str + k);
+ * }
+ * else k = str - orig_str;
+ * but slightly faster.
+ */
- return(g_string_cmp_not(sc, args, -1, sc->string_geq_symbol));
-}
+ if (!number_table[(unsigned char)(*orig_str)])
+ return(make_symbol_with_length(sc, orig_str, k));
-static s7_pointer c_string_geq(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- if (!is_string(x))
- method_or_bust(sc, x, sc->string_geq_symbol, list_2(sc, x, y), T_STRING, 1);
- if (!is_string(y))
- method_or_bust(sc, y, sc->string_geq_symbol, list_2(sc, x, y), T_STRING, 2);
- return(make_boolean(sc, scheme_strcmp(x, y) != -1));
-}
+ /* eval_c_string string is a constant so we can't set and unset the token's end char */
+ if ((k + 1) >= sc->strbuf_size)
+ resize_strbuf(sc, k + 1);
-PF2_TO_PF(string_geq, c_string_geq)
+ memcpy((void *)(sc->strbuf), (void *)orig_str, k);
+ sc->strbuf[k] = '\0';
+ return(make_atom(sc, sc->strbuf, BASE_10, SYMBOL_OK, WITH_OVERFLOW_ERROR));
+}
-static s7_pointer g_strings_are_leq(s7_scheme *sc, s7_pointer args)
+static s7_pointer string_read_sharp(s7_scheme *sc, s7_pointer pt)
{
- #define H_strings_are_leq "(string<=? str ...) returns #t if all the string arguments are equal or increasing"
- #define Q_strings_are_leq pcl_bs
+ /* sc->strbuf[0] has the first char of the string we're reading.
+ * since a *#readers* function might want to get further input, we can't mess with the input even when it is otherwise safe
+ */
+ unsigned int k;
+ char *orig_str, *str;
- return(g_string_cmp_not(sc, args, 1, sc->string_leq_symbol));
-}
+ str = (char *)(port_data(pt) + port_position(pt));
-static s7_pointer c_string_leq(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- if (!is_string(x))
- method_or_bust(sc, x, sc->string_leq_symbol, list_2(sc, x, y), T_STRING, 1);
- if (!is_string(y))
- method_or_bust(sc, y, sc->string_leq_symbol, list_2(sc, x, y), T_STRING, 2);
- return(make_boolean(sc, scheme_strcmp(x, y) != 1));
-}
+ if (!char_ok_in_a_name[(unsigned char)*str])
+ {
+ if (sc->strbuf[0] == 'f')
+ return(sc->F);
+ if (sc->strbuf[0] == 't')
+ return(sc->T);
+ if (sc->strbuf[0] == '\\')
+ {
+ /* must be from #\( and friends -- a character that happens to be not ok-in-a-name */
+ sc->strbuf[1] = str[0];
+ sc->strbuf[2] = '\0';
+ port_position(pt)++;
+ }
+ else sc->strbuf[1] = '\0';
+ return(make_sharp_constant(sc, sc->strbuf, BASE_10, WITH_OVERFLOW_ERROR));
+ }
-PF2_TO_PF(string_leq, c_string_leq)
+ orig_str = (char *)(str - 1);
+ str++;
+ while (char_ok_in_a_name[(unsigned char)(*str)]) {str++;}
+ k = str - orig_str;
+ if (*str != 0)
+ port_position(pt) += (k - 1);
+ else port_position(pt) += k;
+ if ((k + 1) >= sc->strbuf_size)
+ resize_strbuf(sc, k + 1);
-static s7_pointer string_equal_s_ic, string_equal_2;
-static s7_pointer g_string_equal_s_ic(s7_scheme *sc, s7_pointer args)
-{
- if (!is_string(car(args)))
- method_or_bust(sc, car(args), sc->string_eq_symbol, args, T_STRING, 1);
- return(make_boolean(sc, scheme_strings_are_equal(car(args), cadr(args))));
+ memcpy((void *)(sc->strbuf), (void *)orig_str, k);
+ sc->strbuf[k] = '\0';
+ return(make_sharp_constant(sc, sc->strbuf, BASE_10, WITH_OVERFLOW_ERROR));
}
-static s7_pointer g_string_equal_2(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer string_read_name(s7_scheme *sc, s7_pointer pt)
{
- if (!is_string(car(args)))
- method_or_bust(sc, car(args), sc->string_eq_symbol, args, T_STRING, 1);
- if (!is_string(cadr(args)))
- method_or_bust(sc, cadr(args), sc->string_eq_symbol, args, T_STRING, 2);
- return(make_boolean(sc, scheme_strings_are_equal(car(args), cadr(args))));
-}
+ /* port_string was allocated (and read from a file) so we can mess with it directly */
+ s7_pointer result;
+ unsigned int k;
+ char *orig_str, *str;
+ char endc;
+ str = (char *)(port_data(pt) + port_position(pt));
+ if (!char_ok_in_a_name[(unsigned char)*str])
+ {
+ s7_pointer result;
+ result = sc->singletons[(unsigned char)(sc->strbuf[0])];
+ if (!result)
+ {
+ sc->strbuf[1] = '\0';
+ result = make_symbol_with_length(sc, sc->strbuf, 1);
+ sc->singletons[(unsigned char)(sc->strbuf[0])] = result;
+ }
+ return(result);
+ }
-static s7_pointer string_less_2;
-static s7_pointer g_string_less_2(s7_scheme *sc, s7_pointer args)
-{
- if (!is_string(car(args)))
- method_or_bust(sc, car(args), sc->string_lt_symbol, args, T_STRING, 1);
- if (!is_string(cadr(args)))
- method_or_bust(sc, cadr(args), sc->string_lt_symbol, args, T_STRING, 2);
- return(make_boolean(sc, scheme_strcmp(car(args), cadr(args)) == -1));
+ orig_str = (char *)(str - 1);
+ str++;
+ while (char_ok_in_a_name[(unsigned char)(*str)]) {str++;}
+ k = str - orig_str;
+ if (*str != 0)
+ port_position(pt) += (k - 1);
+ else port_position(pt) = port_data_size(pt);
+
+ if (!number_table[(unsigned char)(*orig_str)])
+ return(make_symbol_with_length(sc, orig_str, k));
+
+ endc = (*str);
+ (*str) = '\0';
+ result = make_atom(sc, orig_str, BASE_10, SYMBOL_OK, WITH_OVERFLOW_ERROR);
+ (*str) = endc;
+ return(result);
}
-static s7_pointer string_greater_2;
-static s7_pointer g_string_greater_2(s7_scheme *sc, s7_pointer args)
+static s7_pointer read_file(s7_scheme *sc, FILE *fp, const char *name, long max_size, const char *caller)
{
- if (!is_string(car(args)))
- method_or_bust(sc, car(args), sc->string_gt_symbol, args, T_STRING, 1);
- if (!is_string(cadr(args)))
- method_or_bust(sc, cadr(args), sc->string_gt_symbol, args, T_STRING, 2);
- return(make_boolean(sc, scheme_strcmp(car(args), cadr(args)) == 1));
-}
+ s7_pointer port;
+#if (!MS_WINDOWS)
+ long size;
+#endif
+ unsigned int port_loc;
+
+ new_cell(sc, port, T_INPUT_PORT);
+ port_loc = s7_gc_protect(sc, port);
+ port_port(port) = alloc_port(sc);
+ port_is_closed(port) = false;
+ port_original_input_string(port) = sc->nil;
+ port_write_character(port) = input_write_char;
+ port_write_string(port) = input_write_string;
+ /* if we're constantly opening files, and each open saves the file name in permanent
+ * memory, we gradually core-up.
+ */
+ port_filename_length(port) = safe_strlen(name);
+ port_filename(port) = copy_string_with_length(name, port_filename_length(port));
+ port_line_number(port) = 1; /* first line is numbered 1 */
+ add_input_port(sc, port);
-#if (!WITH_PURE_S7)
+#if (!MS_WINDOWS)
+ /* this doesn't work in MS C */
+ fseek(fp, 0, SEEK_END);
+ size = ftell(fp);
+ rewind(fp);
-static int scheme_strcasecmp(s7_pointer s1, s7_pointer s2)
-{
- /* same as scheme_strcmp -- watch out for unwanted sign! and lack of trailing null (length sets string end).
+ /* pseudo files (under /proc for example) have size=0, but we can read them, so don't assume a 0 length file is empty
*/
- int i, len, len1, len2;
- unsigned char *str1, *str2;
- len1 = string_length(s1);
- len2 = string_length(s2);
- if (len1 > len2)
- len = len2;
- else len = len1;
+ 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)))
+ {
+ size_t bytes;
+ unsigned char *content;
- str1 = (unsigned char *)string_value(s1);
- str2 = (unsigned char *)string_value(s2);
+ content = (unsigned char *)malloc((size + 2) * sizeof(unsigned char));
+ bytes = fread(content, sizeof(unsigned char), size, fp);
+ if (bytes != (size_t)size)
+ {
+ char tmp[256];
+ int len;
+ len = snprintf(tmp, 256, "(%s \"%s\") read %ld bytes of an expected %ld?", caller, name, (long)bytes, size);
+ port_write_string(sc->output_port)(sc, tmp, len, sc->output_port);
+ size = bytes;
+ }
+ content[size] = '\0';
+ content[size + 1] = '\0';
+ fclose(fp);
- for (i = 0; i < len; i++)
- if (uppers[(int)str1[i]] < uppers[(int)str2[i]])
- return(-1);
- else
- {
- if (uppers[(int)str1[i]] > uppers[(int)str2[i]])
- return(1);
- }
+ port_type(port) = STRING_PORT;
+ port_data(port) = content;
+ port_data_size(port) = size;
+ port_position(port) = 0;
+ port_needs_free(port) = true;
+ port_gc_loc(port) = -1;
+ port_read_character(port) = string_read_char;
+ port_read_line(port) = string_read_line;
+ port_display(port) = input_display;
+ port_read_semicolon(port) = string_read_semicolon;
+ port_read_white_space(port) = terminated_string_read_white_space;
+ port_read_name(port) = string_read_name;
+ port_read_sharp(port) = string_read_sharp;
+ }
+ else
+ {
+ port_file(port) = fp;
+ port_type(port) = FILE_PORT;
+ port_needs_free(port) = false;
+ port_read_character(port) = file_read_char;
+ port_read_line(port) = file_read_line;
+ port_display(port) = input_display;
+ port_read_semicolon(port) = file_read_semicolon;
+ port_read_white_space(port) = file_read_white_space;
+ port_read_name(port) = file_read_name;
+ port_read_sharp(port) = file_read_sharp; /* was string_read_sharp?? */
+ }
+#else
+ /* _stat64 is no better than the fseek/ftell route, and
+ * GetFileSizeEx and friends requires Windows.h which makes hash of everything else.
+ * fread until done takes too long on big files, so use a file port
+ */
+ port_file(port) = fp;
+ port_type(port) = FILE_PORT;
+ port_needs_free(port) = false;
+ port_read_character(port) = file_read_char;
+ port_read_line(port) = file_read_line;
+ port_display(port) = input_display;
+ port_read_semicolon(port) = file_read_semicolon;
+ port_read_white_space(port) = file_read_white_space;
+ port_read_name(port) = file_read_name;
+ port_read_sharp(port) = file_read_sharp;
+#endif
- if (len1 < len2)
- return(-1);
- if (len1 > len2)
- return(1);
- return(0);
+ s7_gc_unprotect_at(sc, port_loc);
+ return(port);
}
-static bool scheme_strequal_ci(s7_pointer s1, s7_pointer s2)
+static s7_pointer make_input_file(s7_scheme *sc, const char *name, FILE *fp)
{
- /* same as scheme_strcmp -- watch out for unwanted sign! */
- int i, len, len2;
- unsigned char *str1, *str2;
-
- len = string_length(s1);
- len2 = string_length(s2);
- if (len != len2)
- return(false);
+ #define MAX_SIZE_FOR_STRING_PORT 5000000
+ return(read_file(sc, fp, name, MAX_SIZE_FOR_STRING_PORT, "open"));
+}
- str1 = (unsigned char *)string_value(s1);
- str2 = (unsigned char *)string_value(s2);
+#if (!MS_WINDOWS)
+#include <sys/stat.h>
+#endif
- for (i = 0; i < len; i++)
- if (uppers[(int)str1[i]] != uppers[(int)str2[i]])
- return(false);
- return(true);
+static bool is_directory(const char *filename)
+{
+#if (!MS_WINDOWS)
+ #ifdef S_ISDIR
+ struct stat statbuf;
+ return((stat(filename, &statbuf) >= 0) &&
+ (S_ISDIR(statbuf.st_mode)));
+ #endif
+#endif
+ return(false);
}
-static s7_pointer g_string_ci_cmp(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
+static s7_pointer open_input_file_1(s7_scheme *sc, const char *name, const char *mode, const char *caller)
{
- s7_pointer x, y;
+ FILE *fp;
+ /* see if we can open this file before allocating a port */
- y = car(args);
- if (!is_string(y))
- method_or_bust(sc, y, sym, args, T_STRING, 1);
+ if (is_directory(name))
+ return(file_error(sc, caller, "is a directory", name));
- for (x = cdr(args); is_not_null(x); x = cdr(x))
+ errno = 0;
+ fp = fopen(name, mode);
+ if (!fp)
{
- if (!is_string(car(x)))
- method_or_bust(sc, car(x), sym, cons(sc, y, x), T_STRING, position_of(x, args));
- if (val == 0)
- {
- if (!scheme_strequal_ci(y, car(x)))
- {
- for (y = cdr(x); is_pair(y); y = cdr(y))
- if (!is_string_via_method(sc, car(y)))
- return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_STRING));
- return(sc->F);
- }
- }
- else
+#if (!MS_WINDOWS)
+ if (errno == EINVAL)
+ return(file_error(sc, caller, "invalid mode", mode));
+ #if WITH_GCC
+ /* catch one special case, "~/..." */
+ if ((name[0] == '~') &&
+ (name[1] == '/'))
{
- if (scheme_strcasecmp(y, car(x)) != val)
+ char *home;
+ home = getenv("HOME");
+ if (home)
{
- for (y = cdr(x); is_pair(y); y = cdr(y))
- if (!is_string_via_method(sc, car(y)))
- return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_STRING));
- return(sc->F);
+ char *filename;
+ int len;
+ len = safe_strlen(name) + safe_strlen(home) + 1;
+ tmpbuf_malloc(filename, len);
+ snprintf(filename, len, "%s%s", home, (char *)(name + 1));
+ fp = fopen(filename, "r");
+ tmpbuf_free(filename, len);
+ if (fp)
+ return(make_input_file(sc, name, fp));
}
}
- y = car(x);
+ #endif
+#endif
+ return(file_error(sc, caller, strerror(errno), name));
}
- return(sc->T);
+ return(make_input_file(sc, name, fp));
}
-static s7_pointer g_string_ci_cmp_not(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
+s7_pointer s7_open_input_file(s7_scheme *sc, const char *name, const char *mode)
{
- s7_pointer x, y;
-
- y = car(args);
- if (!is_string(y))
- method_or_bust(sc, y, sym, args, T_STRING, 1);
-
- for (x = cdr(args); is_not_null(x); x = cdr(x))
- {
- if (!is_string(car(x)))
- method_or_bust(sc, car(x), sym, cons(sc, y, x), T_STRING, position_of(x, args));
- if (scheme_strcasecmp(y, car(x)) == val)
- {
- for (y = cdr(x); is_pair(y); y = cdr(y))
- if (!is_string_via_method(sc, car(y)))
- return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_STRING));
- return(sc->F);
- }
- y = car(x);
- }
- return(sc->T);
+ return(open_input_file_1(sc, name, mode, "open-input-file"));
}
-static s7_pointer g_strings_are_ci_equal(s7_scheme *sc, s7_pointer args)
-{
- #define H_strings_are_ci_equal "(string-ci=? str ...) returns #t if all the string arguments are equal, ignoring case"
- #define Q_strings_are_ci_equal pcl_bs
- return(g_string_ci_cmp(sc, args, 0, sc->string_ci_eq_symbol));
-}
-
-static s7_pointer c_string_ci_eq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_pointer g_open_input_file(s7_scheme *sc, s7_pointer args)
{
- if (!is_string(x))
- method_or_bust(sc, x, sc->string_ci_eq_symbol, list_2(sc, x, y), T_STRING, 1);
- if (!is_string(y))
- method_or_bust(sc, y, sc->string_ci_eq_symbol, list_2(sc, x, y), T_STRING, 2);
- return(make_boolean(sc, scheme_strcasecmp(x, y) == 0));
-}
-
-PF2_TO_PF(string_ci_eq, c_string_ci_eq)
+ #define H_open_input_file "(open-input-file filename (mode \"r\")) opens filename for reading"
+ #define Q_open_input_file s7_make_signature(sc, 3, sc->is_input_port_symbol, sc->is_string_symbol, sc->is_string_symbol)
+ s7_pointer name = car(args);
+ /* open-input-file can create a new output file if the file to be opened does not exist, and the "a" mode is given */
+ if (!is_string(name))
+ method_or_bust(sc, name, sc->open_input_file_symbol, args, T_STRING, 1);
+ /* what if the file name is a byte-vector? currently we accept it */
-static s7_pointer g_strings_are_ci_less(s7_scheme *sc, s7_pointer args)
-{
- #define H_strings_are_ci_less "(string-ci<? str ...) returns #t if all the string arguments are increasing, ignoring case"
- #define Q_strings_are_ci_less pcl_bs
- return(g_string_ci_cmp(sc, args, -1, sc->string_ci_lt_symbol));
+ if (is_pair(cdr(args)))
+ {
+ s7_pointer mode;
+ mode = cadr(args);
+ if (!is_string(mode))
+ method_or_bust_with_type(sc, mode, sc->open_input_file_symbol, args, make_string_wrapper(sc, "a string (a mode such as \"r\")"), 2);
+ /* since scheme allows embedded nulls, dumb stuff is accepted here: (open-input-file file "a\x00b") -- should this be an error? */
+ return(open_input_file_1(sc, string_value(name), string_value(mode), "open-input-file"));
+ }
+ return(open_input_file_1(sc, string_value(name), "r", "open-input-file"));
}
-static s7_pointer c_string_ci_lt(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static void make_standard_ports(s7_scheme *sc)
{
- if (!is_string(x))
- method_or_bust(sc, x, sc->string_ci_lt_symbol, list_2(sc, x, y), T_STRING, 1);
- if (!is_string(y))
- method_or_bust(sc, y, sc->string_ci_lt_symbol, list_2(sc, x, y), T_STRING, 2);
- return(make_boolean(sc, scheme_strcasecmp(x, y) == -1));
-}
+ s7_pointer x;
+
+ /* standard output */
+ x = alloc_pointer();
+ unheap(x);
+ set_type(x, T_OUTPUT_PORT | T_IMMUTABLE);
+ port_port(x) = (port_t *)calloc(1, sizeof(port_t));
+ port_type(x) = FILE_PORT;
+ port_data(x) = NULL;
+ port_is_closed(x) = false;
+ port_filename_length(x) = 8;
+ port_filename(x) = copy_string_with_length("*stdout*", 8);
+ port_file_number(x) = remember_file_name(sc, port_filename(x)); /* these numbers need to be correct for the evaluator (__FUNC__ data) */
+ port_line_number(x) = 0;
+ port_file(x) = stdout;
+ port_needs_free(x) = false;
+ port_read_character(x) = output_read_char;
+ port_read_line(x) = output_read_line;
+ port_display(x) = stdout_display;
+ port_write_character(x) = stdout_write_char;
+ port_write_string(x) = stdout_write_string;
+ sc->standard_output = x;
-PF2_TO_PF(string_ci_lt, c_string_ci_lt)
+ /* standard error */
+ x = alloc_pointer();
+ unheap(x);
+ set_type(x, T_OUTPUT_PORT | T_IMMUTABLE);
+ port_port(x) = (port_t *)calloc(1, sizeof(port_t));
+ port_type(x) = FILE_PORT;
+ port_data(x) = NULL;
+ port_is_closed(x) = false;
+ port_filename_length(x) = 8;
+ port_filename(x) = copy_string_with_length("*stderr*", 8);
+ port_file_number(x) = remember_file_name(sc, port_filename(x));
+ port_line_number(x) = 0;
+ port_file(x) = stderr;
+ port_needs_free(x) = false;
+ port_read_character(x) = output_read_char;
+ port_read_line(x) = output_read_line;
+ port_display(x) = stderr_display;
+ port_write_character(x) = stderr_write_char;
+ port_write_string(x) = stderr_write_string;
+ sc->standard_error = x;
+ /* standard input */
+ x = alloc_pointer();
+ unheap(x);
+ set_type(x, T_INPUT_PORT | T_IMMUTABLE);
+ port_port(x) = (port_t *)calloc(1, sizeof(port_t));
+ port_type(x) = FILE_PORT;
+ port_is_closed(x) = false;
+ port_original_input_string(x) = sc->nil;
+ port_filename_length(x) = 7;
+ port_filename(x) = copy_string_with_length("*stdin*", 7);
+ port_file_number(x) = remember_file_name(sc, port_filename(x));
+ port_line_number(x) = 0;
+ port_file(x) = stdin;
+ port_needs_free(x) = false;
+ port_read_character(x) = file_read_char;
+ port_read_line(x) = stdin_read_line;
+ port_display(x) = input_display;
+ port_read_semicolon(x) = file_read_semicolon;
+ port_read_white_space(x) = file_read_white_space;
+ port_read_name(x) = file_read_name;
+ port_read_sharp(x) = file_read_sharp;
+ port_write_character(x) = input_write_char;
+ port_write_string(x) = input_write_string;
+ sc->standard_input = x;
-static s7_pointer g_strings_are_ci_greater(s7_scheme *sc, s7_pointer args)
-{
- #define H_strings_are_ci_greater "(string-ci>? str ...) returns #t if all the string arguments are decreasing, ignoring case"
- #define Q_strings_are_ci_greater pcl_bs
- return(g_string_ci_cmp(sc, args, 1, sc->string_ci_gt_symbol));
-}
+ s7_define_constant(sc, "*stdin*", sc->standard_input);
+ s7_define_constant(sc, "*stdout*", sc->standard_output);
+ s7_define_constant(sc, "*stderr*", sc->standard_error);
-static s7_pointer c_string_ci_gt(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- if (!is_string(x))
- method_or_bust(sc, x, sc->string_ci_gt_symbol, list_2(sc, x, y), T_STRING, 1);
- if (!is_string(y))
- method_or_bust(sc, y, sc->string_ci_gt_symbol, list_2(sc, x, y), T_STRING, 2);
- return(make_boolean(sc, scheme_strcasecmp(x, y) == 1));
+ sc->input_port = sc->standard_input;
+ sc->output_port = sc->standard_output;
+ sc->error_port = sc->standard_error;
+ sc->current_file = NULL;
+ sc->current_line = -1;
}
-PF2_TO_PF(string_ci_gt, c_string_ci_gt)
-
-static s7_pointer g_strings_are_ci_geq(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_open_output_file(s7_scheme *sc, const char *name, const char *mode)
{
- #define H_strings_are_ci_geq "(string-ci>=? str ...) returns #t if all the string arguments are equal or decreasing, ignoring case"
- #define Q_strings_are_ci_geq pcl_bs
- return(g_string_ci_cmp_not(sc, args, -1, sc->string_ci_geq_symbol));
-}
+ FILE *fp;
+ s7_pointer x;
+ /* see if we can open this file before allocating a port */
-static s7_pointer c_string_ci_geq(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- if (!is_string(x))
- method_or_bust(sc, x, sc->string_ci_geq_symbol, list_2(sc, x, y), T_STRING, 1);
- if (!is_string(y))
- method_or_bust(sc, y, sc->string_ci_geq_symbol, list_2(sc, x, y), T_STRING, 2);
- return(make_boolean(sc, scheme_strcasecmp(x, y) != -1));
-}
-
-PF2_TO_PF(string_ci_geq, c_string_ci_geq)
-
-
-static s7_pointer g_strings_are_ci_leq(s7_scheme *sc, s7_pointer args)
-{
- #define H_strings_are_ci_leq "(string-ci<=? str ...) returns #t if all the string arguments are equal or increasing, ignoring case"
- #define Q_strings_are_ci_leq pcl_bs
- return(g_string_ci_cmp_not(sc, args, 1, sc->string_ci_leq_symbol));
-}
+ errno = 0;
+ fp = fopen(name, mode);
+ if (!fp)
+ {
+#if (!MS_WINDOWS)
+ if (errno == EINVAL)
+ return(file_error(sc, "open-output-file", "invalid mode", mode));
+#endif
+ return(file_error(sc, "open-output-file", strerror(errno), name));
+ }
-static s7_pointer c_string_ci_leq(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- if (!is_string(x))
- method_or_bust(sc, x, sc->string_ci_leq_symbol, list_2(sc, x, y), T_STRING, 1);
- if (!is_string(y))
- method_or_bust(sc, y, sc->string_ci_leq_symbol, list_2(sc, x, y), T_STRING, 2);
- return(make_boolean(sc, scheme_strcasecmp(x, y) != 1));
+ new_cell(sc, x, T_OUTPUT_PORT);
+ port_port(x) = alloc_port(sc);
+ port_type(x) = FILE_PORT;
+ port_is_closed(x) = false;
+ port_filename_length(x) = safe_strlen(name);
+ port_filename(x) = copy_string_with_length(name, port_filename_length(x));
+ port_line_number(x) = 1;
+ port_file(x) = fp;
+ port_needs_free(x) = false;
+ port_read_character(x) = output_read_char;
+ port_read_line(x) = output_read_line;
+ port_display(x) = file_display;
+ port_write_character(x) = file_write_char;
+ port_write_string(x) = file_write_string;
+ port_position(x) = 0;
+ port_data_size(x) = PORT_DATA_SIZE;
+ port_data(x) = (unsigned char *)malloc(PORT_DATA_SIZE); /* was +8? */
+ add_output_port(sc, x);
+ return(x);
}
-PF2_TO_PF(string_ci_leq, c_string_ci_leq)
-#endif /* pure s7 */
-
-static s7_pointer g_string_fill(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_open_output_file(s7_scheme *sc, s7_pointer args)
{
- #define H_string_fill "(string-fill! str chr start end) fills the string str with the character chr"
- #define Q_string_fill s7_make_circular_signature(sc, 3, 4, s7_make_signature(sc, 2, sc->is_char_symbol, sc->is_integer_symbol), sc->is_string_symbol, sc->is_char_symbol, sc->is_integer_symbol)
-
- s7_pointer x, chr;
- s7_int start = 0, end, byte = 0;
- x = car(args);
-
- if (!is_string(x))
- method_or_bust(sc, x, sc->string_fill_symbol, args, T_STRING, 1); /* not two methods here */
+ #define H_open_output_file "(open-output-file filename (mode \"w\")) opens filename for writing"
+ #define Q_open_output_file s7_make_signature(sc, 3, sc->is_output_port_symbol, sc->is_string_symbol, sc->is_string_symbol)
+ s7_pointer name = car(args);
- chr = cadr(args);
- if (!is_byte_vector(x))
- {
- if (!s7_is_character(chr))
- {
- check_two_methods(sc, chr, sc->string_fill_symbol, sc->fill_symbol, args);
- return(wrong_type_argument(sc, sc->string_fill_symbol, 2, chr, T_CHARACTER));
- }
- }
- else
- {
- if (!is_integer(chr))
- {
- check_two_methods(sc, chr, sc->string_fill_symbol, sc->fill_symbol, args);
- return(wrong_type_argument(sc, sc->fill_symbol, 2, chr, T_INTEGER));
- }
- byte = integer(chr);
- if ((byte < 0) || (byte > 255))
- return(simple_wrong_type_argument_with_type(sc, sc->string_fill_symbol, chr, an_unsigned_byte_string));
- }
+ if (!is_string(name))
+ method_or_bust(sc, name, sc->open_output_file_symbol, args, T_STRING, 1);
- end = string_length(x);
- if (!is_null(cddr(args)))
+ if (is_pair(cdr(args)))
{
- s7_pointer p;
- p = start_and_end(sc, sc->string_fill_symbol, sc->fill_symbol, cddr(args), args, 3, &start, &end);
- if (p != sc->gc_nil) return(p);
- if (start == end) return(chr);
+ if (!is_string(cadr(args)))
+ method_or_bust_with_type(sc, cadr(args), sc->open_output_file_symbol, args, make_string_wrapper(sc, "a string (a mode such as \"w\")"), 2);
+ return(s7_open_output_file(sc, string_value(name), string_value(cadr(args))));
}
- if (end == 0) return(chr);
-
- if (!is_byte_vector(x))
- memset((void *)(string_value(x) + start), (int)character(chr), end - start);
- else memset((void *)(string_value(x) + start), (int)byte, end - start);
-
- return(chr);
+ return(s7_open_output_file(sc, string_value(name), "w"));
}
-#if (!WITH_PURE_S7)
-static s7_pointer c_string_fill(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_string_fill(sc, set_plist_2(sc, x, y)));}
-PF2_TO_PF(string_fill, c_string_fill)
+static s7_pointer open_input_string(s7_scheme *sc, const char *input_string, int len)
+{
+ s7_pointer x;
+ new_cell(sc, x, T_INPUT_PORT);
+ port_port(x) = alloc_port(sc);
+ port_type(x) = STRING_PORT;
+ port_is_closed(x) = false;
+ port_original_input_string(x) = sc->nil;
+ port_data(x) = (unsigned char *)input_string;
+ port_data_size(x) = len;
+ port_position(x) = 0;
+ port_filename_length(x) = 0;
+ port_filename(x) = NULL;
+ port_file_number(x) = 0; /* unsigned int */
+ port_line_number(x) = 0;
+ port_needs_free(x) = false;
+ port_gc_loc(x) = -1;
+ port_read_character(x) = string_read_char;
+ port_read_line(x) = string_read_line;
+ port_display(x) = input_display;
+ port_read_semicolon(x) = string_read_semicolon;
+#if DEBUGGING
+ if (input_string[len] != '\0')
+ fprintf(stderr, "read_white_space string is not terminated: %s", input_string);
#endif
+ port_read_white_space(x) = terminated_string_read_white_space;
+ port_read_name(x) = string_read_name_no_free;
+ port_read_sharp(x) = string_read_sharp;
+ port_write_character(x) = input_write_char;
+ port_write_string(x) = input_write_string;
+ add_input_port(sc, x);
+ return(x);
+}
-static s7_pointer g_string_1(s7_scheme *sc, s7_pointer args, s7_pointer sym)
+static s7_pointer open_and_protect_input_string(s7_scheme *sc, s7_pointer str)
{
- int i, len;
- s7_pointer x, newstr;
- char *str;
+ s7_pointer p;
+ p = open_input_string(sc, string_value(str), string_length(str));
+ port_gc_loc(p) = s7_gc_protect(sc, str);
+ return(p);
+}
- /* get length for new string and check arg types */
- for (len = 0, x = args; is_not_null(x); len++, x = cdr(x))
- {
- s7_pointer p;
- p = car(x);
- if (!s7_is_character(p))
- {
- if (has_methods(p))
- {
- s7_pointer func;
- func = find_method(sc, find_let(sc, p), sym);
- if (func != sc->undefined)
- {
- s7_pointer y;
- if (len == 0)
- return(s7_apply_function(sc, func, args));
- newstr = make_empty_string(sc, len, 0);
- str = string_value(newstr);
- for (i = 0, y = args; y != x; i++, y = cdr(y))
- str[i] = character(car(y));
- return(g_string_append(sc, set_plist_2(sc, newstr, s7_apply_function(sc, func, x))));
- }
- }
- return(wrong_type_argument(sc, sym, len + 1, car(x), T_CHARACTER));
- }
- }
- newstr = make_empty_string(sc, len, 0);
- str = string_value(newstr);
- for (i = 0, x = args; is_not_null(x); i++, x = cdr(x))
- str[i] = character(car(x));
- return(newstr);
+s7_pointer s7_open_input_string(s7_scheme *sc, const char *input_string)
+{
+ return(open_input_string(sc, input_string, safe_strlen(input_string)));
}
-static s7_pointer g_string(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_open_input_string(s7_scheme *sc, s7_pointer args)
{
- #define H_string "(string chr...) appends all its character arguments into one string"
- #define Q_string s7_make_circular_signature(sc, 1, 2, sc->is_string_symbol, sc->is_char_symbol)
+ #define H_open_input_string "(open-input-string str) opens an input port reading str"
+ #define Q_open_input_string s7_make_signature(sc, 2, sc->is_input_port_symbol, sc->is_string_symbol)
+ s7_pointer input_string, port;
- if (is_null(args)) /* (string) but not (string ()) */
- return(s7_make_string_with_length(sc, "", 0));
- return(g_string_1(sc, args, sc->string_symbol));
+ input_string = car(args);
+ if (!is_string(input_string))
+ method_or_bust_one_arg(sc, input_string, sc->open_input_string_symbol, args, T_STRING);
+ port = open_and_protect_input_string(sc, input_string);
+ return(port);
}
-#if (!WITH_PURE_S7)
-static s7_pointer g_list_to_string(s7_scheme *sc, s7_pointer args)
+#define FORMAT_PORT_LENGTH 128
+/* the large majority (> 99% in my tests) of the output strings have less than 128 chars when the port is finally closed
+ * 256 is slightly slower (the calloc time below dominates the realloc time in string_write_string)
+ * 64 is much slower (realloc dominates)
+ */
+
+static s7_pointer open_output_string(s7_scheme *sc, int len)
{
- #define H_list_to_string "(list->string lst) appends all the list's characters into one string; (apply string lst)"
- #define Q_list_to_string s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_proper_list_symbol)
+ s7_pointer x;
+ new_cell(sc, x, T_OUTPUT_PORT);
+ port_port(x) = alloc_port(sc);
+ port_type(x) = STRING_PORT;
+ port_is_closed(x) = false;
+ port_data_size(x) = len;
+ port_data(x) = (unsigned char *)malloc(len * sizeof(unsigned char)); /* was +8? */
+ port_data(x)[0] = '\0'; /* in case s7_get_output_string before any output */
+ port_position(x) = 0;
+ port_needs_free(x) = true;
+ port_read_character(x) = output_read_char;
+ port_read_line(x) = output_read_line;
+ port_display(x) = string_display;
+ port_write_character(x) = string_write_char;
+ port_write_string(x) = string_write_string;
+ add_output_port(sc, x);
+ return(x);
+}
- if (is_null(car(args)))
- return(s7_make_string_with_length(sc, "", 0));
+s7_pointer s7_open_output_string(s7_scheme *sc) {return(open_output_string(sc, sc->initial_string_port_length));}
- if (!is_proper_list(sc, car(args)))
- method_or_bust_with_type(sc, car(args), sc->list_to_string_symbol, args, make_string_wrapper(sc, "a (proper, non-circular) list of characters"), 0);
- return(g_string_1(sc, car(args), sc->list_to_string_symbol));
-}
-#endif
+static s7_pointer open_output_string_p(void) {return(s7_open_output_string(cur_sc));}
-static s7_pointer s7_string_to_list(s7_scheme *sc, const char *str, int len)
+static s7_pointer g_open_output_string(s7_scheme *sc, s7_pointer args)
{
- int i;
- s7_pointer result;
+ #define H_open_output_string "(open-output-string) opens an output string port"
+ #define Q_open_output_string s7_make_signature(sc, 1, sc->is_output_port_symbol)
+ return(s7_open_output_string(sc));
+}
- if (len == 0)
- return(sc->nil);
- if (len >= (sc->free_heap_top - sc->free_heap))
- {
- gc(sc);
- while (len >= (sc->free_heap_top - sc->free_heap))
- resize_heap(sc);
- }
- sc->v = sc->nil;
- for (i = len - 1; i >= 0; i--)
- sc->v = cons_unchecked(sc, s7_make_character(sc, ((unsigned char)str[i])), sc->v);
- result = sc->v;
- sc->v = sc->nil;
- return(result);
+const char *s7_get_output_string(s7_scheme *sc, s7_pointer p)
+{
+ port_data(p)[port_position(p)] = '\0';
+ return((const char *)port_data(p));
}
-#if (!WITH_PURE_S7)
-static s7_pointer g_string_to_list(s7_scheme *sc, s7_pointer args)
-{
- #define H_string_to_list "(string->list str start end) returns the elements of the string str in a list; (map values str)"
- #define Q_string_to_list s7_make_circular_signature(sc, 2, 3, sc->is_proper_list_symbol, sc->is_string_symbol, sc->is_integer_symbol)
- s7_int i, start = 0, end;
- s7_pointer p, str;
+static s7_pointer g_get_output_string(s7_scheme *sc, s7_pointer args)
+{
+ #define H_get_output_string "(get-output-string port clear-port) returns the output accumulated in port. \
+If the optional 'clear-port' is #t, the current string is flushed."
+ #define Q_get_output_string s7_make_signature(sc, 3, sc->is_string_symbol, sc->is_output_port_symbol, sc->is_boolean_symbol)
- str = car(args);
- if (!is_string(str))
- method_or_bust(sc, str, sc->string_to_list_symbol, args, T_STRING, 0);
+ s7_pointer p, result;
+ bool clear_port = false;
- end = string_length(str);
- if (!is_null(cdr(args)))
+ if (is_pair(cdr(args)))
{
- p = start_and_end(sc, sc->string_to_list_symbol, NULL, cdr(args), args, 2, &start, &end);
- if (p != sc->gc_nil) return(p);
- if (start == end) return(sc->nil);
+ p = cadr(args);
+ if (!s7_is_boolean(p))
+ return(wrong_type_argument(sc, sc->get_output_string_symbol, 2, p, T_BOOLEAN));
+ clear_port = (p == sc->T);
}
- else
+ p = car(args);
+ if ((!is_output_port(p)) ||
+ (!is_string_port(p)))
{
- if (end == 0) return(sc->nil);
+ if (p == sc->F) return(make_empty_string(sc, 0, 0));
+ method_or_bust_with_type_one_arg(sc, p, sc->get_output_string_symbol, args, make_string_wrapper(sc, "an output string port"));
}
- if ((start == 0) && (end == string_length(str)))
- return(s7_string_to_list(sc, string_value(str), string_length(str)));
-
- sc->w = sc->nil;
- for (i = end - 1; i >= start; i--)
- sc->w = cons(sc, s7_make_character(sc, ((unsigned char)string_value(str)[i])), sc->w);
+ if (port_is_closed(p))
+ return(simple_wrong_type_argument_with_type(sc, sc->get_output_string_symbol, p, make_string_wrapper(sc, "an active (open) string port")));
- p = sc->w;
- sc->w = sc->nil;
- return(p);
+ result = s7_make_string_with_length(sc, (const char *)port_data(p), port_position(p));
+ if (clear_port)
+ {
+ port_position(p) = 0;
+ port_data(p)[0] = '\0';
+ }
+ return(result);
}
-static s7_pointer c_string_to_list(s7_scheme *sc, s7_pointer x) {return(g_string_to_list(sc, set_plist_1(sc, x)));}
-PF_TO_PF(string_to_list, c_string_to_list)
-#endif
+s7_pointer s7_open_input_function(s7_scheme *sc, s7_pointer (*function)(s7_scheme *sc, s7_read_t read_choice, s7_pointer port))
+{
+ s7_pointer x;
+ new_cell(sc, x, T_INPUT_PORT);
+ port_port(x) = alloc_port(sc);
+ port_type(x) = FUNCTION_PORT;
+ port_is_closed(x) = false;
+ port_original_input_string(x) = sc->nil;
+ port_needs_free(x) = false;
+ port_input_function(x) = function;
+ port_read_character(x) = function_read_char;
+ port_read_line(x) = function_read_line;
+ port_display(x) = input_display;
+ port_write_character(x) = input_write_char;
+ port_write_string(x) = input_write_string;
+ add_input_port(sc, x);
+ return(x);
+}
-/* -------------------------------- byte_vectors --------------------------------
- *
- * these are just strings with the T_BYTE_VECTOR bit set.
- */
+s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, unsigned char c, s7_pointer port))
+{
+ s7_pointer x;
+ new_cell(sc, x, T_OUTPUT_PORT);
+ port_port(x) = alloc_port(sc);
+ port_type(x) = FUNCTION_PORT;
+ port_data(x) = NULL;
+ port_is_closed(x) = false;
+ port_needs_free(x) = false;
+ port_output_function(x) = function;
+ port_read_character(x) = output_read_char;
+ port_read_line(x) = output_read_line;
+ port_display(x) = function_display;
+ port_write_character(x) = function_write_char;
+ port_write_string(x) = function_write_string;
+ add_output_port(sc, x);
+ return(x);
+}
-static bool s7_is_byte_vector(s7_pointer b) {return((is_string(b)) && (is_byte_vector(b)));}
-static s7_pointer g_is_byte_vector(s7_scheme *sc, s7_pointer args)
+static void push_input_port(s7_scheme *sc, s7_pointer new_port)
{
- #define H_is_byte_vector "(byte-vector? obj) returns #t if obj is a byte-vector"
- #define Q_is_byte_vector pl_bt
-
- check_boolean_method(sc, s7_is_byte_vector, sc->is_byte_vector_symbol, args);
+ sc->input_port_stack = cons(sc, sc->input_port, sc->input_port_stack);
+ sc->input_port = new_port;
}
-static s7_pointer g_string_to_byte_vector(s7_scheme *sc, s7_pointer args)
+static void pop_input_port(s7_scheme *sc)
{
- #define H_string_to_byte_vector "(string->byte-vector obj) turns a string into a byte-vector."
- #define Q_string_to_byte_vector s7_make_signature(sc, 2, sc->is_byte_vector_symbol, sc->is_string_symbol)
- s7_pointer str;
- str = car(args);
- if (is_integer(str))
- str = s7_make_string_with_length(sc, (const char *)(&(integer(str))), sizeof(s7_int));
- else
+ if (is_pair(sc->input_port_stack))
{
- if (!is_string(str))
- method_or_bust(sc, str, sc->string_to_byte_vector_symbol, set_plist_1(sc, str), T_STRING, 1);
+ s7_pointer nxt;
+ sc->input_port = car(sc->input_port_stack);
+ nxt = cdr(sc->input_port_stack);
+ /* is this safe? */
+ free_cell(sc, sc->input_port_stack);
+ sc->input_port_stack = nxt;
}
- set_byte_vector(str);
- return(str);
+ else sc->input_port = sc->standard_input;
}
-static s7_pointer c_string_to_byte_vector(s7_scheme *sc, s7_pointer str) {return(g_string_to_byte_vector(sc, set_plist_1(sc, str)));}
-
-PF_TO_PF(string_to_byte_vector, c_string_to_byte_vector)
-
-
-static s7_pointer g_make_byte_vector(s7_scheme *sc, s7_pointer args)
+#if DEBUGGING && (0)
+static void print_input_stack(s7_scheme *sc)
{
- #define H_make_byte_vector "(make-byte-vector len (byte 0)) makes a byte-vector of length len filled with byte."
- #define Q_make_byte_vector s7_make_circular_signature(sc, 1, 2, sc->is_byte_vector_symbol, sc->is_integer_symbol)
-
- s7_pointer str;
- if (is_null(cdr(args)))
+ if (is_null(sc->input_port_stack))
+ fprintf(stderr, "no input stack\n");
+ else
{
- str = g_make_string(sc, args);
- if (is_string(str))
- memclr((void *)(string_value(str)), string_length(str));
+ s7_pointer p;
+ for (p = sc->input_port_stack; is_pair(p); p = cdr(p))
+ fprintf(stderr, "%s\n", s7_object_to_c_string(sc, car(p)));
}
+}
+#endif
+
+
+static int inchar(s7_pointer pt)
+{
+ int c;
+ if (is_file_port(pt))
+ c = fgetc(port_file(pt)); /* not unsigned char! -- could be EOF */
else
{
- s7_pointer len, byte;
- s7_int b;
- len = car(args);
- if (!is_integer(len))
- method_or_bust(sc, len, sc->make_byte_vector_symbol, args, T_INTEGER, 1);
+ if (port_data_size(pt) <= port_position(pt))
+ return(EOF);
+ c = (unsigned char)port_data(pt)[port_position(pt)++];
+ }
- byte = cadr(args);
- if (!s7_is_integer(byte))
- method_or_bust(sc, byte, sc->make_byte_vector_symbol, args, T_INTEGER, 2);
+ if (c == '\n')
+ port_line_number(pt)++;
- b = s7_integer(byte);
- if ((b < 0) || (b > 255))
- return(simple_wrong_type_argument_with_type(sc, sc->make_byte_vector_symbol, byte, an_unsigned_byte_string));
- str = g_make_string(sc, set_plist_2(sc, len, chars[b]));
- }
- set_byte_vector(str);
- return(str);
+ return(c);
}
-static s7_pointer g_byte_vector(s7_scheme *sc, s7_pointer args)
+static void backchar(char c, s7_pointer pt)
{
- #define H_byte_vector "(byte-vector ...) returns a byte-vector whose elements are the arguments"
- #define Q_byte_vector s7_make_circular_signature(sc, 1, 2, sc->is_byte_vector_symbol, sc->is_integer_symbol)
-
- s7_int i, len;
- s7_pointer vec, x;
- char *str;
-
- len = s7_list_length(sc, args);
- vec = make_empty_string(sc, len, 0);
- str = string_value(vec);
+ if (c == '\n')
+ port_line_number(pt)--;
- for (i = 0, x = args; is_pair(x); i++, x = cdr(x))
+ if (is_file_port(pt))
+ ungetc(c, port_file(pt));
+ else
{
- s7_pointer byte;
- s7_int b;
- byte = car(x);
- if (!s7_is_integer(byte))
- {
- if (has_methods(byte))
- {
- s7_pointer func;
- func = find_method(sc, find_let(sc, byte), sc->byte_vector_symbol);
- if (func != sc->undefined)
- {
- if (i == 0)
- return(s7_apply_function(sc, func, args));
- string_length(vec) = i;
- vec = g_string_append(sc, set_plist_2(sc, vec, s7_apply_function(sc, func, x)));
- set_byte_vector(vec);
- return(vec);
- }
- }
- return(wrong_type_argument(sc, sc->byte_vector_symbol, i + 1, byte, T_INTEGER));
- }
- b = s7_integer(byte);
- if ((b < 0) || (b > 255))
- return(simple_wrong_type_argument_with_type(sc, sc->byte_vector_symbol, byte, an_unsigned_byte_string));
- str[i] = (unsigned char)b;
+ if (port_position(pt) > 0)
+ port_position(pt)--;
}
- set_byte_vector(vec);
- return(vec);
}
-static s7_pointer byte_vector_to_list(s7_scheme *sc, const char *str, int len)
+
+int s7_read_char(s7_scheme *sc, s7_pointer port)
{
- int i;
- s7_pointer p;
- if (len == 0) return(sc->nil);
- sc->w = sc->nil;
- for (i = len - 1; i >= 0; i--)
- sc->w = cons(sc, small_int((unsigned int)((unsigned char)(str[i]))), sc->w); /* extra cast is not redundant! */
- p = sc->w;
- sc->w = sc->nil;
- return(p);
+ /* needs to be int return value so EOF=-1, but not 255 */
+ return(port_read_character(port)(sc, port));
}
-
-/* -------------------------------- ports --------------------------------
- *
- * originally nil served as stdin and friends, but that made it impossible to catch an error
- * like (read-line (current-output-port)) when the latter was stdout. So we now have
- * the built-in constant ports *stdin*, *stdout*, and *stderr*. Some way is needed to
- * refer to these directly so that (read-line *stdin*) for example can insist on reading
- * from the terminal, or whatever stdin is.
- */
-
-static s7_pointer g_is_port_closed(s7_scheme *sc, s7_pointer args)
+int s7_peek_char(s7_scheme *sc, s7_pointer port)
{
- #define H_is_port_closed "(port-closed? p) returns #t if the port p is closed."
- #define Q_is_port_closed pl_bt
- s7_pointer x;
-
- x = car(args);
- if ((is_input_port(x)) || (is_output_port(x)))
- return(make_boolean(sc, port_is_closed(x)));
-
- method_or_bust_with_type(sc, x, sc->is_port_closed_symbol, args, make_string_wrapper(sc, "a port"), 0);
+ int c; /* needs to be an int so EOF=-1, but not 255 */
+ c = port_read_character(port)(sc, port);
+ if (c != EOF)
+ backchar(c, port);
+ return(c);
}
-static s7_pointer c_port_line_number(s7_scheme *sc, s7_pointer x)
+void s7_write_char(s7_scheme *sc, int c, s7_pointer pt)
{
- if ((!(is_input_port(x))) ||
- (port_is_closed(x)))
- method_or_bust_with_type(sc, x, sc->port_line_number_symbol, list_1(sc, x), an_input_port_string, 0);
- return(make_integer(sc, port_line_number(x)));
+ if (pt != sc->F)
+ port_write_character(pt)(sc, c, pt);
}
-static s7_pointer g_port_line_number(s7_scheme *sc, s7_pointer args)
-{
- #define H_port_line_number "(port-line-number input-file-port) returns the current read line number of port"
- #define Q_port_line_number s7_make_signature(sc, 2, sc->is_integer_symbol, s7_make_signature(sc, 2, sc->is_input_port_symbol, sc->is_null_symbol))
- if ((is_null(args)) || (is_null(car(args))))
- return(c_port_line_number(sc, sc->input_port));
- return(c_port_line_number(sc, car(args)));
-}
-
-PF_TO_PF(port_line_number, c_port_line_number)
-
-int s7_port_line_number(s7_pointer p)
-{
- if (is_input_port(p))
- return(port_line_number(p));
- return(0);
-}
-
-static s7_pointer g_set_port_line_number(s7_scheme *sc, s7_pointer args)
+static s7_pointer input_port_if_not_loading(s7_scheme *sc)
{
- s7_pointer p, line;
-
- if ((is_null(car(args))) ||
- ((is_null(cdr(args))) && (is_integer(car(args)))))
- p = sc->input_port;
- else
+ s7_pointer port;
+ port = sc->input_port;
+ if (is_loader_port(port)) /* this flag is turned off by the reader macros, so we aren't in that context */
{
- p = car(args);
- if (!(is_input_port(p)))
- return(s7_wrong_type_arg_error(sc, "set! port-line-number", 1, p, "an input port"));
+ int c;
+ c = port_read_white_space(port)(sc, port);
+ if (c > 0) /* we can get either EOF or NULL at the end */
+ {
+ backchar(c, port);
+ return(NULL);
+ }
+ return(sc->standard_input);
}
-
- line = (is_null(cdr(args)) ? car(args) : cadr(args));
- if (!is_integer(line))
- return(s7_wrong_type_arg_error(sc, "set! port-line-number", 2, line, "an integer"));
- port_line_number(p) = integer(line);
- return(line);
+ return(port);
}
-
-const char *s7_port_filename(s7_pointer x)
+static s7_pointer g_read_char(s7_scheme *sc, s7_pointer args)
{
- if (((is_input_port(x)) ||
- (is_output_port(x))) &&
- (!port_is_closed(x)))
- return(port_filename(x));
- return(NULL);
-}
-
+ #define H_read_char "(read-char (port (current-input-port))) returns the next character in the input port"
+ #define Q_read_char s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_char_symbol, sc->is_eof_object_symbol), sc->is_input_port_symbol)
+ s7_pointer port;
-static s7_pointer c_port_filename(s7_scheme *sc, s7_pointer x)
-{
- if (((is_input_port(x)) ||
- (is_output_port(x))) &&
- (!port_is_closed(x)))
+ if (is_not_null(args))
+ port = car(args);
+ else
{
- if (port_filename(x))
- return(make_string_wrapper_with_length(sc, port_filename(x), port_filename_length(x)));
- return(s7_make_string_with_length(sc, "", 0));
- /* otherwise (eval-string (port-filename)) and (string->symbol (port-filename)) segfault */
+ port = input_port_if_not_loading(sc);
+ if (!port) return(sc->eof_object);
}
- method_or_bust_with_type(sc, x, sc->port_filename_symbol, list_1(sc, x), an_open_port_string, 0);
+ if (!is_input_port(port))
+ method_or_bust_with_type_one_arg(sc, port, sc->read_char_symbol, args, an_input_port_string);
+ return(chars[port_read_character(port)(sc, port)]);
}
-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)
- if (is_null(args))
- return(c_port_filename(sc, sc->input_port));
- return(c_port_filename(sc, car(args)));
-}
+static s7_pointer g_write_char(s7_scheme *sc, s7_pointer args)
+{
+ #define H_write_char "(write-char char (port (current-output-port))) writes char to the output port"
+ #define Q_write_char s7_make_signature(sc, 3, sc->is_char_symbol, sc->is_char_symbol, sc->is_output_port_symbol)
+ s7_pointer port, chr;
-PF_TO_PF(port_filename, c_port_filename)
+ chr = car(args);
+ if (!s7_is_character(chr))
+ method_or_bust(sc, chr, sc->write_char_symbol, args, T_CHARACTER, 1);
+ if (is_pair(cdr(args)))
+ port = cadr(args);
+ else port = sc->output_port;
+ if (port == sc->F) return(chr);
+ if (!is_output_port(port))
+ method_or_bust_with_type(sc, port, sc->write_char_symbol, args, an_output_port_string, 2);
-bool s7_is_input_port(s7_scheme *sc, s7_pointer p)
-{
- return(is_input_port(p));
+ port_write_character(port)(sc, s7_character(chr), port);
+ return(chr);
}
-
-static s7_pointer g_is_input_port(s7_scheme *sc, s7_pointer args)
+static s7_pointer write_char_p_p(s7_pointer c)
{
- #define H_is_input_port "(input-port? p) returns #t if p is an input port"
- #define Q_is_input_port pl_bt
- check_boolean_method(sc, is_input_port, sc->is_input_port_symbol, args);
+ if (!s7_is_character(c))
+ simple_wrong_type_argument(cur_sc, cur_sc->write_char_symbol, c, T_CHARACTER);
+ if (cur_sc->output_port == cur_sc->F) return(c);
+ port_write_character(cur_sc->output_port)(cur_sc, s7_character(c), cur_sc->output_port);
+ return(c);
}
-
-bool s7_is_output_port(s7_scheme *sc, s7_pointer p)
+static s7_pointer write_char_p_pp(s7_pointer c, s7_pointer port)
{
- return(is_output_port(p));
+ if (!s7_is_character(c))
+ simple_wrong_type_argument(cur_sc, cur_sc->write_char_symbol, c, T_CHARACTER);
+ if (port == cur_sc->F) return(c);
+ if (!is_output_port(port))
+ simple_wrong_type_argument_with_type(cur_sc, cur_sc->write_char_symbol, port, an_output_port_string);
+ port_write_character(port)(cur_sc, s7_character(c), port);
+ return(c);
}
-
-static s7_pointer g_is_output_port(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_output_port "(output-port? p) returns #t if p is an output port"
- #define Q_is_output_port pl_bt
- check_boolean_method(sc, is_output_port, sc->is_output_port_symbol, args);
-}
+/* (with-output-to-string (lambda () (write-char #\space))) -> " "
+ * (with-output-to-string (lambda () (write #\space))) -> "#\\space"
+ * (with-output-to-string (lambda () (display #\space))) -> " "
+ * is this correct? It's what Guile does. write-char is actually display-char.
+ */
-s7_pointer s7_current_input_port(s7_scheme *sc)
+static s7_pointer g_peek_char(s7_scheme *sc, s7_pointer args)
{
- return(sc->input_port);
-}
+ #define H_peek_char "(peek-char (port (current-input-port))) returns the next character in the input port, but does not remove it from the input stream"
+ #define Q_peek_char s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_char_symbol, sc->is_eof_object_symbol), sc->is_input_port_symbol)
+ s7_pointer port;
+ if (is_not_null(args))
+ port = car(args);
+ else port = sc->input_port;
-static s7_pointer g_current_input_port(s7_scheme *sc, s7_pointer args)
-{
- #define H_current_input_port "(current-input-port) returns the current input port"
- #define Q_current_input_port s7_make_signature(sc, 1, sc->is_input_port_symbol)
- return(sc->input_port);
+ if (!is_input_port(port))
+ method_or_bust_with_type_one_arg(sc, port, sc->peek_char_symbol, args, an_input_port_string);
+ if (port_is_closed(port))
+ return(simple_wrong_type_argument_with_type(sc, sc->peek_char_symbol, port, an_open_port_string));
+
+ if (is_function_port(port))
+ return((*(port_input_function(port)))(sc, S7_PEEK_CHAR, port));
+ return(chars[s7_peek_char(sc, port)]);
}
-#if (!WITH_PURE_S7)
-static s7_pointer g_set_current_input_port(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer g_read_byte(s7_scheme *sc, s7_pointer args)
{
- #define H_set_current_input_port "(set-current-input-port port) sets the current-input port to port and returns the previous value of the input port"
- #define Q_set_current_input_port s7_make_signature(sc, 2, sc->is_input_port_symbol, sc->is_input_port_symbol)
+ #define H_read_byte "(read-byte (port (current-input-port))): reads a byte from the input port"
+ #define Q_read_byte s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_eof_object_symbol), sc->is_input_port_symbol)
+ s7_pointer port;
+ int c;
- s7_pointer old_port, port;
- old_port = sc->input_port;
- port = car(args);
- if ((is_input_port(port)) &&
- (!port_is_closed(port)))
- sc->input_port = port;
+ if (is_not_null(args))
+ port = car(args);
else
{
- check_method(sc, port, s7_make_symbol(sc, "set-current-input-port"), args);
- return(s7_wrong_type_arg_error(sc, "set-current-input-port", 0, port, "an open input port"));
+ port = input_port_if_not_loading(sc);
+ if (!port) return(sc->eof_object);
}
- return(old_port);
-}
-#endif
+ if (!is_input_port(port))
+ method_or_bust_with_type_one_arg(sc, port, sc->read_byte_symbol, args, an_input_port_string);
-s7_pointer s7_set_current_input_port(s7_scheme *sc, s7_pointer port)
-{
- s7_pointer old_port;
- old_port = sc->input_port;
- sc->input_port = port;
- return(old_port);
+ c = port_read_character(port)(sc, port);
+ if (c == EOF)
+ return(sc->eof_object);
+ return(small_int(c));
}
-s7_pointer s7_current_output_port(s7_scheme *sc)
+static s7_pointer g_write_byte(s7_scheme *sc, s7_pointer args)
{
- return(sc->output_port);
-}
+ #define H_write_byte "(write-byte byte (port (current-output-port))): writes byte to the output port"
+ #define Q_write_byte s7_make_signature(sc, 3, sc->is_integer_symbol, sc->is_integer_symbol, sc->is_output_port_symbol)
+ s7_pointer port, b;
+ s7_int val;
+ b = car(args);
+ if (!s7_is_integer(b))
+ method_or_bust(sc, car(args), sc->write_byte_symbol, args, T_INTEGER, 1);
-s7_pointer s7_set_current_output_port(s7_scheme *sc, s7_pointer port)
-{
- s7_pointer old_port;
- old_port = sc->output_port;
- sc->output_port = port;
- return(old_port);
-}
+ val = s7_integer(b);
+ if ((val < 0) || (val > 255)) /* need to check this before port==#f, else (write-byte most-positive-fixnum #f) is not an error */
+ return(wrong_type_argument_with_type(sc, sc->write_byte_symbol, 1, b, an_unsigned_byte_string));
+ if (is_pair(cdr(args)))
+ port = cadr(args);
+ else port = sc->output_port;
-static s7_pointer g_current_output_port(s7_scheme *sc, s7_pointer args)
-{
- #define H_current_output_port "(current-output-port) returns the current output port"
- #define Q_current_output_port s7_make_signature(sc, 1, sc->is_output_port_symbol)
- return(sc->output_port);
+ if (!is_output_port(port))
+ {
+ if (port == sc->F) return(car(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);
+ return(b);
}
-#if (!WITH_PURE_S7)
-static s7_pointer g_set_current_output_port(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer g_read_line(s7_scheme *sc, s7_pointer args)
{
- #define H_set_current_output_port "(set-current-output-port port) sets the current-output port to port and returns the previous value of the output port"
- #define Q_set_current_output_port s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->is_output_port_symbol)
+ #define H_read_line "(read-line port (with-eol #f)) returns the next line from port, or #<eof>.\
+If 'with-eol' is not #f, read-line includes the trailing end-of-line character."
+ #define Q_read_line s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_eof_object_symbol), sc->is_input_port_symbol, sc->is_boolean_symbol)
- s7_pointer old_port, port;
- old_port = sc->output_port;
- port = car(args);
- if (((is_output_port(port)) &&
- (!port_is_closed(port))) ||
- (port == sc->F))
- sc->output_port = port;
+ s7_pointer port;
+ bool with_eol = false;
+
+ if (is_not_null(args))
+ {
+ port = car(args);
+ if (!is_input_port(port))
+ method_or_bust_with_type(sc, port, sc->read_line_symbol, args, an_input_port_string, 1);
+
+ if (is_not_null(cdr(args)))
+ with_eol = (cadr(args) != sc->F);
+ }
else
{
- check_method(sc, port, s7_make_symbol(sc, "set-current-output-port"), args);
- return(s7_wrong_type_arg_error(sc, "set-current-output-port", 0, port, "an open output port"));
+ port = input_port_if_not_loading(sc);
+ if (!port) return(sc->eof_object);
}
- return(old_port);
+ return(port_read_line(port)(sc, port, with_eol, true));
}
-#endif
-s7_pointer s7_current_error_port(s7_scheme *sc)
+static s7_pointer read_line_uncopied;
+static s7_pointer g_read_line_uncopied(s7_scheme *sc, s7_pointer args)
{
- return(sc->error_port);
+ s7_pointer port;
+ bool with_eol = false;
+ port = car(args);
+ if (!is_input_port(port))
+ return(g_read_line(sc, args));
+ if (is_not_null(cdr(args)))
+ with_eol = (cadr(args) != sc->F);
+ return(port_read_line(port)(sc, port, with_eol, false));
}
-s7_pointer s7_set_current_error_port(s7_scheme *sc, s7_pointer port)
+static s7_pointer g_read_string(s7_scheme *sc, s7_pointer args)
{
- s7_pointer old_port;
- old_port = sc->error_port;
- sc->error_port = port;
- return(old_port);
-}
+ /* read-chars would be a better name -- read-string could mean CL-style read-from-string (like eval-string)
+ * similarly read-bytes could return a byte-vector (rather than r7rs's read-bytevector)
+ * and write-string -> write-chars, write-bytevector -> write-bytes
+ */
+ #define H_read_string "(read-string k port) reads k characters from port into a new string and returns it."
+ #define Q_read_string s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_eof_object_symbol), sc->is_integer_symbol, sc->is_input_port_symbol)
+ s7_pointer k, port, s;
+ s7_int i, chars;
+ unsigned char *str;
+ k = car(args);
+ if (!s7_is_integer(k))
+ method_or_bust(sc, k, sc->read_string_symbol, args, T_INTEGER, 1);
+ chars = s7_integer(k);
-static s7_pointer g_current_error_port(s7_scheme *sc, s7_pointer args)
-{
- #define H_current_error_port "(current-error-port) returns the current error port"
- #define Q_current_error_port s7_make_signature(sc, 1, sc->is_output_port_symbol)
- return(sc->error_port);
-}
+ if (!is_null(cdr(args)))
+ port = cadr(args);
+ else port = input_port_if_not_loading(sc);
+
+ if (chars < 0)
+ return(wrong_type_argument_with_type(sc, sc->read_string_symbol, 1, make_integer(sc, chars), a_non_negative_integer_string));
+ if (chars > sc->max_string_length)
+ return(out_of_range(sc, sc->read_string_symbol, small_int(1), make_integer(sc, chars), its_too_large_string));
+ if (!port) return(sc->eof_object);
+ if (!is_input_port(port))
+ method_or_bust_with_type(sc, port, sc->read_string_symbol, list_2(sc, make_integer(sc, chars), port), an_input_port_string, 2);
-static s7_pointer g_set_current_error_port(s7_scheme *sc, s7_pointer args)
-{
- #define H_set_current_error_port "(set-current-error-port port) sets the current-error port to port and returns the previous value of the error port"
- #define Q_set_current_error_port s7_make_signature(sc, 2, sc->is_output_port_symbol, sc->is_output_port_symbol)
- s7_pointer old_port, port;
+ if (chars == 0)
+ return(make_empty_string(sc, 0, 0));
- old_port = sc->error_port;
- port = car(args);
- if (((is_output_port(port)) &&
- (!port_is_closed(port))) ||
- (port == sc->F))
- sc->error_port = port;
- else
+ s = make_empty_string(sc, chars, 0);
+ str = (unsigned char *)string_value(s);
+ for (i = 0; i < chars; i++)
{
- check_method(sc, port, s7_make_symbol(sc, "set-current-error-port"), args);
- return(s7_wrong_type_arg_error(sc, "set-current-error-port", 0, port, "an open output port"));
+ int c;
+ c = port_read_character(port)(sc, port);
+ if (c == EOF)
+ {
+ if (i == 0)
+ return(sc->eof_object);
+ string_length(s) = i;
+ return(s);
+ }
+ str[i] = (unsigned char)c;
}
- return(old_port);
+ return(s);
}
-#if (!WITH_PURE_S7)
-static s7_pointer g_is_char_ready(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_char_ready "(char-ready? (port (current-input-port))) returns #t if a character is ready for input on the given port"
- #define Q_is_char_ready s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_input_port_symbol)
- if (is_not_null(args))
- {
- s7_pointer pt = car(args);
- if (!is_input_port(pt))
- method_or_bust_with_type(sc, pt, sc->is_char_ready_symbol, args, an_input_port_string, 0);
- if (port_is_closed(pt))
- return(simple_wrong_type_argument_with_type(sc, sc->is_char_ready_symbol, pt, an_open_port_string));
-
- if (is_function_port(pt))
- return((*(port_input_function(pt)))(sc, S7_IS_CHAR_READY, pt));
- return(make_boolean(sc, is_string_port(pt)));
- }
- return(make_boolean(sc, (is_input_port(sc->input_port)) && (is_string_port(sc->input_port))));
-}
-#endif
+#define declare_jump_info() bool old_longjmp; int old_jump_loc, jump_loc; jmp_buf old_goto_start
+#define store_jump_info(Sc) \
+ do { \
+ old_longjmp = Sc->longjmp_ok; \
+ old_jump_loc = Sc->setjmp_loc; \
+ memcpy((void *)old_goto_start, (void *)(Sc->goto_start), sizeof(jmp_buf));\
+ } while (0)
-static s7_pointer g_is_eof_object(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_eof_object "(eof-object? val) returns #t if val is the end-of-file object"
- #define Q_is_eof_object pl_bt
- check_boolean_method(sc, is_eof, sc->is_eof_object_symbol, args);
-}
+#define restore_jump_info(Sc) \
+ do { \
+ Sc->longjmp_ok = old_longjmp; \
+ Sc->setjmp_loc = old_jump_loc; \
+ memcpy((void *)(Sc->goto_start), (void *)old_goto_start, sizeof(jmp_buf));\
+ if ((jump_loc == ERROR_JUMP) &&\
+ (sc->longjmp_ok))\
+ longjmp(sc->goto_start, ERROR_JUMP);\
+ } while (0)
+#define set_jump_info(Sc, Tag) \
+ do { \
+ sc->longjmp_ok = true; \
+ sc->setjmp_loc = Tag; \
+ jump_loc = setjmp(sc->goto_start); \
+ } while (0)
-static int closed_port_read_char(s7_scheme *sc, s7_pointer port);
-static s7_pointer closed_port_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied);
-static void closed_port_write_char(s7_scheme *sc, int c, s7_pointer port);
-static void closed_port_write_string(s7_scheme *sc, const char *str, int len, s7_pointer port);
-static void closed_port_display(s7_scheme *sc, const char *s, s7_pointer port);
-void s7_close_input_port(s7_scheme *sc, s7_pointer p)
+s7_pointer s7_read(s7_scheme *sc, s7_pointer port)
{
-#if DEBUGGING
- if (!is_input_port(p))
- fprintf(stderr, "s7_close_input_port: %s\n", DISPLAY(p));
-#endif
- if ((is_immutable_port(p)) ||
- ((is_input_port(p)) && (port_is_closed(p))))
- return;
-
- if (port_filename(p))
+ if (is_input_port(port))
{
- free(port_filename(p));
- port_filename(p) = NULL;
- }
+ s7_pointer old_envir;
+ declare_jump_info();
- if (is_file_port(p))
- {
- if (port_file(p))
+ old_envir = sc->envir;
+ sc->envir = sc->nil;
+ push_input_port(sc, port);
+
+ store_jump_info(sc);
+ set_jump_info(sc, READ_SET_JUMP);
+ if (jump_loc != NO_JUMP)
{
- fclose(port_file(p));
- port_file(p) = NULL;
+ if (jump_loc != ERROR_JUMP)
+ eval(sc, sc->op);
}
- }
- else
- {
- if ((is_string_port(p)) &&
- (port_gc_loc(p) != -1))
- s7_gc_unprotect_at(sc, port_gc_loc(p));
- }
- if (port_needs_free(p))
- {
- if (port_data(p))
+ else
{
- free(port_data(p));
- port_data(p) = NULL;
- port_data_size(p) = 0;
+ push_stack(sc, OP_BARRIER, port, sc->nil);
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+
+ eval(sc, OP_READ_INTERNAL);
+
+ if (sc->tok == TOKEN_EOF)
+ sc->value = sc->eof_object;
+
+ if ((sc->op == OP_EVAL_DONE) &&
+ (stack_op(sc->stack, s7_stack_top(sc) - 1) == OP_BARRIER))
+ pop_stack(sc);
}
- port_needs_free(p) = false;
- }
+ pop_input_port(sc);
+ sc->envir = old_envir;
- port_read_character(p) = closed_port_read_char;
- port_read_line(p) = closed_port_read_line;
- port_write_character(p) = closed_port_write_char;
- port_write_string(p) = closed_port_write_string;
- port_display(p) = closed_port_display;
- port_is_closed(p) = true;
+ restore_jump_info(sc);
+ return(sc->value);
+ }
+ return(simple_wrong_type_argument_with_type(sc, sc->read_symbol, port, an_input_port_string));
}
-static s7_pointer c_close_input_port(s7_scheme *sc, s7_pointer pt)
+static s7_pointer g_read(s7_scheme *sc, s7_pointer args)
{
- if (!is_input_port(pt))
- method_or_bust_with_type(sc, pt, sc->close_input_port_symbol, set_plist_1(sc, pt), an_input_port_string, 0);
- if (!is_immutable_port(pt))
- s7_close_input_port(sc, pt);
- return(sc->unspecified);
-}
+ /* would it be useful to add an environment arg here? (just set sc->envir at the end?)
+ * except for expansions, nothing is evaluated at read time, unless...
+ * say we set up a dot reader:
+ * (set! *#readers* (cons (cons #\. (lambda (str) (if (string=? str ".") (eval (read)) #f))) *#readers*))
+ * then
+ * (call-with-input-string "(+ 1 #.(+ 1 hiho))" (lambda (p) (read p)))
+ * evaluates hiho in the rootlet, but how to pass the env to the inner eval or read?
+ * (eval, eval-string and load already have an env arg)
+ */
+ #define H_read "(read (port (current-input-port))) returns the next object in the input port, or #<eof> at the end"
+ #define Q_read s7_make_signature(sc, 2, sc->T, sc->is_input_port_symbol)
+ s7_pointer port;
-static s7_pointer g_close_input_port(s7_scheme *sc, s7_pointer args)
-{
- #define H_close_input_port "(close-input-port port) closes the port"
- #define Q_close_input_port s7_make_signature(sc, 2, sc->is_unspecified_symbol, sc->is_input_port_symbol)
- return(c_close_input_port(sc, car(args)));
+ if (is_not_null(args))
+ port = car(args);
+ else
+ {
+ port = input_port_if_not_loading(sc);
+ if (!port) return(sc->eof_object);
+ }
+
+ if (!is_input_port(port))
+ method_or_bust_with_type_one_arg(sc, port, sc->read_symbol, args, an_input_port_string);
+
+ if (is_function_port(port))
+ return((*(port_input_function(port)))(sc, S7_READ, port));
+
+ if ((is_string_port(port)) &&
+ (port_data_size(port) <= port_position(port)))
+ 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);
+
+ return(port);
}
-PF_TO_PF(close_input_port, c_close_input_port)
+/* -------------------------------- load -------------------------------- */
+
+#if WITH_MULTITHREAD_CHECKS
+typedef struct {
+ s7_scheme* sc;
+ const int lock_count; /* Remember lock count in case we have skipped calls to leave_track_scope by longjmp-ing. */
+} lock_scope_t;
-void s7_flush_output_port(s7_scheme *sc, s7_pointer p)
+static lock_scope_t enter_lock_scope(s7_scheme *sc)
{
- if ((!is_output_port(p)) ||
- (!is_file_port(p)) ||
- (port_is_closed(p)) ||
- (p == sc->F))
- return;
+ if (pthread_mutex_trylock(&sc->lock) != 0) abort();
+ sc->lock_count++;
+ {
+ lock_scope_t st = {.sc = sc, .lock_count = sc->lock_count};
+ return(st);
+ }
+}
- if (port_file(p))
+static void leave_lock_scope(lock_scope_t *st)
+{
+ while (st->sc->lock_count > st->lock_count)
{
- if (port_position(p) > 0)
- {
- if (fwrite((void *)(port_data(p)), 1, port_position(p), port_file(p)) != port_position(p))
- s7_warn(sc, 64, "fwrite trouble in flush-output-port\n");
- port_position(p) = 0;
- }
- fflush(port_file(p));
+ st->sc->lock_count--;
+ pthread_mutex_unlock(&st->sc->lock);
}
}
+#define TRACK(Sc) lock_scope_t lock_scope __attribute__ ((__cleanup__(leave_lock_scope))) = enter_lock_scope(Sc)
+#else
+#define TRACK(Sc)
+#endif
-static s7_pointer g_flush_output_port(s7_scheme *sc, s7_pointer args)
+static FILE *search_load_path(s7_scheme *sc, const char *name)
{
- #define H_flush_output_port "(flush-output-port port) flushes the port"
- #define Q_flush_output_port s7_make_signature(sc, 2, sc->T, sc->is_output_port_symbol)
- s7_pointer pt;
-
- if (is_null(args))
- pt = sc->output_port;
- else pt = car(args);
+ int i, len;
+ s7_pointer lst;
- if (!is_output_port(pt))
+ lst = s7_load_path(sc);
+ len = s7_list_length(sc, lst);
+ for (i = 0; i < len; i++)
{
- if (pt == sc->F) return(pt);
- method_or_bust_with_type(sc, pt, sc->flush_output_port_symbol, args, an_output_port_string, 0);
+ const char *new_dir;
+ new_dir = string_value(s7_list_ref(sc, lst, i));
+ if (new_dir)
+ {
+ FILE *fp;
+ snprintf(sc->tmpbuf, TMPBUF_SIZE, "%s/%s", new_dir, name);
+ fp = fopen(sc->tmpbuf, "r");
+ if (fp) return(fp);
+ }
}
- s7_flush_output_port(sc, pt);
- return(pt);
+ return(NULL);
}
-static s7_pointer c_flush_output_port(s7_scheme *sc) {return(g_flush_output_port(sc, sc->nil));}
-PF_0(flush_output_port, c_flush_output_port)
-static void close_output_port(s7_scheme *sc, s7_pointer p)
+s7_pointer s7_load_with_environment(s7_scheme *sc, const char *filename, s7_pointer e)
{
- if (is_file_port(p))
- {
- if (port_filename(p)) /* only a file (output) port has a filename */
- {
- free(port_filename(p));
- port_filename(p) = NULL;
- port_filename_length(p) = 0;
- }
+ s7_pointer port;
+ FILE *fp;
+ char *new_filename = NULL;
+ declare_jump_info();
+ TRACK(sc);
- if (port_file(p))
- {
- if (port_position(p) > 0)
- {
- if (fwrite((void *)(port_data(p)), 1, port_position(p), port_file(p)) != port_position(p))
- s7_warn(sc, 64, "fwrite trouble in close-output-port\n");
- port_position(p) = 0;
- }
- free(port_data(p));
- fflush(port_file(p));
- fclose(port_file(p));
- port_file(p) = NULL;
- }
+ fp = fopen(filename, "r");
+ if (!fp)
+ {
+ fp = search_load_path(sc, filename);
+ if (fp)
+ new_filename = copy_string(sc->tmpbuf); /* (require libc.scm) for example needs the directory for cload in some cases */
}
- else
+ if (!fp)
+ return(file_error(sc, "load", "can't open", filename));
+
+ if (hook_has_functions(sc->load_hook))
+ s7_call(sc, sc->load_hook, list_1(sc, sc->temp4 = s7_make_string(sc, filename)));
+
+ port = read_file(sc, fp, (new_filename) ? (const char *)new_filename : filename, -1, "load"); /* -1 means always read its contents into a local string */
+ port_file_number(port) = remember_file_name(sc, filename);
+ if (new_filename) free(new_filename);
+ set_loader_port(port);
+ sc->temp6 = port;
+ push_input_port(sc, port);
+ sc->temp6 = sc->nil;
+
+ /* it's possible to call this recursively (s7_load is Xen_load_file which can be invoked via s7_call)
+ * but in that case, we actually want it to behave like g_load and continue the evaluation upon completion
+ */
+ sc->envir = e;
+ push_stack(sc, OP_LOAD_RETURN_IF_EOF, port, sc->code);
+
+ store_jump_info(sc);
+ set_jump_info(sc, LOAD_SET_JUMP);
+ if (jump_loc != NO_JUMP)
{
- if ((is_string_port(p)) &&
- (port_data(p)))
- {
- free(port_data(p));
- port_data(p) = NULL;
- port_data_size(p) = 0;
- port_needs_free(p) = false;
- }
+ if (jump_loc != ERROR_JUMP)
+ eval(sc, sc->op);
}
- port_read_character(p) = closed_port_read_char;
- port_read_line(p) = closed_port_read_line;
- port_write_character(p) = closed_port_write_char;
- port_write_string(p) = closed_port_write_string;
- port_display(p) = closed_port_display;
- port_is_closed(p) = true;
+ else eval(sc, OP_READ_INTERNAL);
+
+ pop_input_port(sc);
+ if (is_input_port(port))
+ s7_close_input_port(sc, port);
+
+ restore_jump_info(sc);
+ if (is_multiple_value(sc->value))
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+ return(sc->value);
}
-void s7_close_output_port(s7_scheme *sc, s7_pointer p)
+
+s7_pointer s7_load(s7_scheme *sc, const char *filename)
{
- if ((is_immutable_port(p)) ||
- ((is_output_port(p)) && (port_is_closed(p))) ||
- (p == sc->F))
- return;
- close_output_port(sc, p);
+ return(s7_load_with_environment(sc, filename, sc->nil));
}
-static s7_pointer c_close_output_port(s7_scheme *sc, s7_pointer pt)
+#if WITH_C_LOADER
+#include <dlfcn.h>
+
+static char *full_filename(const char *filename)
{
- if (!is_output_port(pt))
+ int len;
+ char *pwd, *rtn;
+ pwd = getcwd(NULL, 0); /* docs say this means it will return a new string of the right size */
+ len = safe_strlen(pwd) + safe_strlen(filename) + 8;
+ rtn = (char *)malloc(len * sizeof(char));
+ if (pwd)
{
- if (pt == sc->F) return(sc->unspecified);
- method_or_bust_with_type(sc, pt, sc->close_output_port_symbol, set_plist_1(sc, pt), an_output_port_string, 0);
+ snprintf(rtn, len, "%s/%s", pwd, filename);
+ free(pwd);
}
- if (!(is_immutable_port(pt)))
- s7_close_output_port(sc, pt);
- return(sc->unspecified);
+ else snprintf(rtn, len, "%s", filename);
+ return(rtn);
}
+#endif
-static s7_pointer g_close_output_port(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer g_load(s7_scheme *sc, s7_pointer args)
{
- #define H_close_output_port "(close-output-port port) closes the port"
- #define Q_close_output_port s7_make_signature(sc, 2, sc->is_unspecified_symbol, sc->is_output_port_symbol)
- return(c_close_output_port(sc, car(args)));
-}
+ #define H_load "(load file (env (rootlet))) loads the scheme file 'file'. The 'env' argument \
+defaults to the rootlet. To load into the current environment instead, pass (curlet)."
+ #define Q_load s7_make_signature(sc, 3, sc->values_symbol, sc->is_string_symbol, sc->is_let_symbol)
-PF_TO_PF(close_output_port, c_close_output_port)
+ FILE *fp = NULL;
+ s7_pointer name, port;
+ const char *fname;
+ name = car(args);
+ if (!is_string(name))
+ method_or_bust(sc, name, sc->load_symbol, args, T_STRING, 1);
-/* -------- read character functions -------- */
+ if (is_not_null(cdr(args)))
+ {
+ s7_pointer e;
+ e = cadr(args);
+ if (!is_let(e))
+ return(wrong_type_argument_with_type(sc, sc->load_symbol, 2, e, a_let_string));
+ if (e == sc->rootlet)
+ sc->envir = sc->nil;
+ else sc->envir = e;
+ }
+ else sc->envir = sc->nil;
-static int file_read_char(s7_scheme *sc, s7_pointer port)
-{
- return(fgetc(port_file(port)));
-}
+ fname = string_value(name);
+ if ((!fname) || (!(*fname))) /* fopen("", "r") returns a file pointer?? */
+ return(s7_error(sc, sc->out_of_range_symbol, set_elist_2(sc, make_string_wrapper(sc, "load's first argument, ~S, should be a filename"), name)));
+ if (is_directory(fname))
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "load argument, ~S, is a directory"), name)));
-static int function_read_char(s7_scheme *sc, s7_pointer port)
-{
- return(character((*(port_input_function(port)))(sc, S7_READ_CHAR, port)));
-}
+#if WITH_C_LOADER
+ /* if fname ends in .so, try loading it as a c shared object
+ * (load "/home/bil/cl/m_j0.so" (inlet (cons 'init_func 'init_m_j0)))
+ */
+ {
+ int fname_len;
+ fname_len = safe_strlen(fname);
+ if ((fname_len > 3) &&
+ (is_pair(cdr(args))) &&
+ (local_strcmp((const char *)(fname + (fname_len - 3)), ".so")))
+ {
+ s7_pointer init;
-static int string_read_char(s7_scheme *sc, s7_pointer port)
-{
- if (port_data_size(port) <= port_position(port)) /* port_string_length is 0 if no port string */
- return(EOF);
- return((unsigned char)port_data(port)[port_position(port)++]);
-}
+ init = g_let_ref(sc, set_plist_2(sc, sc->envir, s7_make_symbol(sc, "init_func")));
+ if (is_symbol(init))
+ {
+ void *library;
+ char *pwd_name = NULL;
+ if (fname[0] != '/')
+ pwd_name = full_filename(fname); /* this is necessary, at least in Linux -- we can't blithely dlopen whatever is passed to us */
+ library = dlopen((pwd_name) ? pwd_name : fname, RTLD_NOW);
+ if (library)
+ {
+ const char *init_name = NULL;
+ void *init_func;
-static int output_read_char(s7_scheme *sc, s7_pointer port)
-{
- simple_wrong_type_argument_with_type(sc, sc->read_char_symbol, port, an_input_port_string);
- return(0);
-}
+ init_name = symbol_name(init);
+ init_func = dlsym(library, init_name);
+ if (init_func)
+ {
+ typedef void *(*dl_func)(s7_scheme *sc);
+ ((dl_func)init_func)(sc);
+ if (pwd_name) free(pwd_name);
+ return(sc->T);
+ }
+ else
+ {
+ s7_warn(sc, 512, "loaded %s, but can't find %s (%s)?\n", fname, init_name, dlerror());
+ dlclose(library);
+ }
+ }
+ else s7_warn(sc, 512, "load %s failed: %s\n", (pwd_name) ? pwd_name : fname, dlerror());
+ if (pwd_name) free(pwd_name);
+ }
+ else s7_warn(sc, 512, "can't load %s: no init function\n", fname);
+ return(sc->F);
+ }
+ }
+#endif
+ fp = fopen(fname, "r");
-static int closed_port_read_char(s7_scheme *sc, s7_pointer port)
-{
- simple_wrong_type_argument_with_type(sc, sc->read_char_symbol, port, an_open_port_string);
- return(0);
-}
+#if WITH_GCC
+ if (!fp)
+ {
+ /* catch one special case, "~/..." since it causes 99.9% of the "can't load ..." errors */
+ if ((fname[0] == '~') &&
+ (fname[1] == '/'))
+ {
+ char *home;
+ home = getenv("HOME");
+ if (home)
+ {
+ char *filename;
+ int len;
+ len = safe_strlen(fname) + safe_strlen(home) + 1;
+ tmpbuf_malloc(filename, len);
+ snprintf(filename, len, "%s%s", home, (char *)(fname + 1));
+ fp = fopen(filename, "r");
+ tmpbuf_free(filename, len);
+ }
+ }
+ }
+#endif
+
+ if (!fp)
+ {
+ fp = search_load_path(sc, fname);
+ if (!fp)
+ return(file_error(sc, "load", "can't open", fname));
+ }
+ port = read_file(sc, fp, fname, -1, "load");
+ port_file_number(port) = remember_file_name(sc, fname);
+ set_loader_port(port);
+ sc->temp6 = port;
+ 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);
-/* -------- read line functions -------- */
+ /* 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.
+ */
-static s7_pointer output_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
-{
- return(simple_wrong_type_argument_with_type(sc, sc->read_line_symbol, port, an_input_port_string));
+ if (hook_has_functions(sc->load_hook))
+ s7_apply_function(sc, sc->load_hook, list_1(sc, sc->temp4 = s7_make_string(sc, fname)));
+
+ return(sc->unspecified);
}
-static s7_pointer closed_port_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
+s7_pointer s7_load_path(s7_scheme *sc)
{
- return(simple_wrong_type_argument_with_type(sc, sc->read_line_symbol, port, an_open_port_string));
+ return(s7_symbol_value(sc, sc->load_path_symbol));
}
-static s7_pointer function_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
+s7_pointer s7_add_to_load_path(s7_scheme *sc, const char *dir)
{
- return((*(port_input_function(port)))(sc, S7_READ_LINE, port));
+ s7_symbol_set_value(sc,
+ sc->load_path_symbol,
+ cons(sc,
+ s7_make_string(sc, dir),
+ s7_symbol_value(sc, sc->load_path_symbol)));
+ return(s7_symbol_value(sc, sc->load_path_symbol));
}
-static s7_pointer stdin_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
+static s7_pointer g_load_path_set(s7_scheme *sc, s7_pointer args)
{
- if (!sc->read_line_buf)
+ /* new value must be either () or a proper list of strings */
+ if (is_null(cadr(args))) return(cadr(args));
+ if (is_pair(cadr(args)))
{
- sc->read_line_buf_size = 1024;
- sc->read_line_buf = (char *)malloc(sc->read_line_buf_size * sizeof(char));
+ s7_pointer x;
+ for (x = cadr(args); is_pair(x); x = cdr(x))
+ if (!is_string(car(x)))
+ return(sc->error_symbol);
+ if (is_null(x))
+ return(cadr(args));
}
+ return(sc->error_symbol);
+}
- if (fgets(sc->read_line_buf, sc->read_line_buf_size, stdin))
- return(s7_make_string(sc, sc->read_line_buf)); /* fgets adds the trailing '\0' */
- return(s7_make_string_with_length(sc, NULL, 0));
+static s7_pointer g_cload_directory_set(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer cl_dir;
+ cl_dir = cadr(args);
+ if (!is_string(cl_dir))
+ return(sc->error_symbol);
+ s7_symbol_set_value(sc, sc->cload_directory_symbol, cl_dir);
+ if (safe_strlen(string_value(cl_dir)) > 0)
+ s7_add_to_load_path(sc, (const char *)(string_value(cl_dir)));
+ return(cl_dir);
}
-static s7_pointer file_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
+/* ---------------- autoload ---------------- */
+
+void s7_autoload_set_names(s7_scheme *sc, const char **names, int size)
{
- char *buf;
- int read_size, previous_size = 0;
+ /* the idea here is that by sticking to string constants we can handle 90% of the work at compile-time,
+ * with less start-up memory. Then eventually we'll add C libraries a la xg (gtk) as environments
+ * and every name in that library will come as an import once dlopen has picked up the library.
+ * So, hopefully, we can pre-declare as many names as we want from as many libraries as we want,
+ * without a bloated mess of a run-time image. And new libraries are easy to accommodate --
+ * add the names to be auto-exported to this list with the name of the scheme file that cloads
+ * the library and exports the given name. So, we'll need a separate such file for each library?
+ *
+ * the environment variable could use the library base name in *: *libm* or *libgtk*
+ * (*libm* 'j0)
+ * why not just predeclare these libraries? The caller could import what he wants via require.
+ * So the autoloader need only know which libraries, but this doesn't fit the current use of gtk in xg
+ * In fact, we only need to see *libm* -> libm.so etc, but we still need the arg/return types of each function, etc
+ * And libgtk is enormous -- seems too bad to tie-in everything via the FFI when we need less than 1% of it.
+ * Perhaps each module as an environment within the main one: ((*libgtk* *gtkwidget*) 'gtk_widget_new)?
+ * But that requires inside knowlege of the library, and changes without notice.
+ *
+ * Also we need to decide how to handle name collisions (by order of autoload lib setup)
+ * And (lastly?) how to handle different library versions?
+ *
+ *
+ * so autoload known libs here in s7 so we're indepentdent of snd
+ * (currently these are included in make-index.scm[line 575] -> snd-xref.c)
+ * for each module, include an env in the lib env (*libgtk* 'gtkwidget.h) or whatever that has the names in that header
+ * in autoload below, don't sort! -- just build a list of autoload tables and check each in order at autoload time (we want startup to be fast)
+ * for versions, include wrapper macro at end of each c-define choice
+ * in the xg case, there's no savings in delaying the defines
+ *
+ */
- if (!sc->read_line_buf)
+ if (!sc->autoload_names)
{
- sc->read_line_buf_size = 1024;
- sc->read_line_buf = (char *)malloc(sc->read_line_buf_size * sizeof(char));
+ sc->autoload_names = (const char ***)calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(const char **));
+ sc->autoload_names_sizes = (int *)calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(int));
+ sc->autoloaded_already = (bool **)calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(bool *));
+ sc->autoload_names_top = INITIAL_AUTOLOAD_NAMES_SIZE;
+ sc->autoload_names_loc = 0;
}
-
- buf = sc->read_line_buf;
- read_size = sc->read_line_buf_size;
-
- while (true)
+ else
{
- char *p, *rtn;
- size_t len;
-
- p = fgets(buf, read_size, port_file(port));
- if (!p)
- return(sc->eof_object);
-
- rtn = strchr(buf, (int)'\n');
- if (rtn)
+ if (sc->autoload_names_loc >= sc->autoload_names_top)
{
- port_line_number(port)++;
- return(s7_make_string_with_length(sc, sc->read_line_buf, (with_eol) ? (previous_size + rtn - p + 1) : (previous_size + rtn - p)));
+ int 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 = (int *)realloc(sc->autoload_names_sizes, sc->autoload_names_top * sizeof(int));
+ 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++)
+ {
+ sc->autoload_names[i] = NULL;
+ sc->autoload_names_sizes[i] = 0;
+ sc->autoloaded_already[i] = NULL;
+ }
}
- /* if no newline, then either at eof or need bigger buffer */
- len = strlen(sc->read_line_buf);
-
- if ((len + 1) < sc->read_line_buf_size)
- return(s7_make_string_with_length(sc, sc->read_line_buf, len));
-
- previous_size = sc->read_line_buf_size;
- sc->read_line_buf_size *= 2;
- sc->read_line_buf = (char *)realloc(sc->read_line_buf, sc->read_line_buf_size * sizeof(char));
- read_size = previous_size;
- previous_size -= 1;
- buf = (char *)(sc->read_line_buf + previous_size);
}
- return(sc->eof_object);
+
+ sc->autoload_names[sc->autoload_names_loc] = names;
+ sc->autoload_names_sizes[sc->autoload_names_loc] = size;
+ sc->autoloaded_already[sc->autoload_names_loc] = (bool *)calloc(size, sizeof(bool));
+ sc->autoload_names_loc++;
}
-static s7_pointer string_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
+static const char *find_autoload_name(s7_scheme *sc, s7_pointer symbol, bool *already_loaded, bool loading)
{
- unsigned int i, port_start;
- unsigned char *port_str, *cur, *start;
+ int l = 0, pos = -1, lib, libs;
+ const char *name, *this_name;
- port_start = port_position(port);
- port_str = port_data(port);
- start = (unsigned char *)(port_str + port_start);
+ name = symbol_name(symbol);
+ libs = sc->autoload_names_loc;
- cur = (unsigned char *)strchr((const char *)start, (int)'\n'); /* this can run off the end making valgrind unhappy, but I think it's innocuous */
- if (cur)
- {
- port_line_number(port)++;
- i = cur - port_str;
- port_position(port) = i + 1;
- if (copied)
- return(s7_make_string_with_length(sc, (const char *)start, ((with_eol) ? i + 1 : i) - port_start));
- return(make_string_wrapper_with_length(sc, (char *)start, ((with_eol) ? i + 1 : i) - port_start));
- }
- i = port_data_size(port);
- port_position(port) = i;
- if (i <= port_start) /* the < part can happen -- if not caught we try to create a string of length -1 -> segfault */
- return(sc->eof_object);
+ for (lib = 0; lib < libs; lib++)
+ {
+ const char **names;
+ int u;
+ u = sc->autoload_names_sizes[lib] - 1;
+ names = sc->autoload_names[lib];
- if (copied)
- return(s7_make_string_with_length(sc, (const char *)start, i - port_start));
- return(make_string_wrapper_with_length(sc, (char *)start, i - port_start));
+ while (true)
+ {
+ int comp;
+ if (u < l) break;
+ pos = (l + u) / 2;
+ this_name = names[pos * 2];
+ comp = strcmp(this_name, name);
+ if (comp == 0)
+ {
+ *already_loaded = sc->autoloaded_already[lib][pos];
+ if (loading) sc->autoloaded_already[lib][pos] = true;
+ return(names[pos * 2 + 1]); /* file name given func name */
+ }
+ if (comp < 0)
+ l = pos + 1;
+ else u = pos - 1;
+ }
+ }
+ return(NULL);
}
-/* -------- write character functions -------- */
-
-static void resize_port_data(s7_pointer pt, int new_size)
+s7_pointer s7_autoload(s7_scheme *sc, s7_pointer symbol, s7_pointer file_or_function)
{
- int loc;
- loc = port_data_size(pt);
- 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);
+ /* add '(symbol . file) to s7's autoload table */
+ if (is_null(sc->autoload_table))
+ sc->autoload_table = s7_make_hash_table(sc, sc->default_hash_table_length);
+ s7_hash_table_set(sc, sc->autoload_table, symbol, file_or_function);
+ return(file_or_function);
}
-static void string_write_char(s7_scheme *sc, int c, s7_pointer pt)
-{
- if (port_position(pt) >= port_data_size(pt))
- resize_port_data(pt, port_data_size(pt) * 2);
- port_data(pt)[port_position(pt)++] = c;
-}
-static void stdout_write_char(s7_scheme *sc, int c, s7_pointer port)
+static s7_pointer g_autoload(s7_scheme *sc, s7_pointer args)
{
- fputc(c, stdout);
-}
+ #define H_autoload "(autoload symbol file-or-function) adds the symbol to its table of autoloadable symbols. \
+If that symbol is encountered as an unbound variable, s7 either loads the file (following *load-path*), or calls \
+the function. The function takes one argument, the calling environment. Presumably the symbol is defined \
+in the file, or by the function."
+ #define Q_autoload s7_make_signature(sc, 3, sc->T, sc->is_symbol_symbol, sc->T)
-static void stderr_write_char(s7_scheme *sc, int c, s7_pointer port)
-{
- fputc(c, stderr);
-}
+ s7_pointer sym, value;
-static void function_write_char(s7_scheme *sc, int c, s7_pointer port)
-{
- (*(port_output_function(port)))(sc, c, port);
-}
-
-
-#define PORT_DATA_SIZE 256
-static void file_write_char(s7_scheme *sc, int c, s7_pointer port)
-{
- if (port_position(port) == PORT_DATA_SIZE)
+ sym = car(args);
+ if (is_string(sym))
{
- if (fwrite((void *)(port_data(port)), 1, PORT_DATA_SIZE, port_file(port)) != PORT_DATA_SIZE)
- s7_warn(sc, 64, "fwrite trouble during write-char\n");
- port_position(port) = 0;
+ if (string_length(sym) == 0) /* (autoload "" ...) */
+ return(s7_wrong_type_arg_error(sc, "autoload", 1, sym, "a symbol-name or a symbol"));
+ sym = make_symbol_with_length(sc, string_value(sym), string_length(sym));
}
- port_data(port)[port_position(port)++] = (unsigned char)c;
-}
+ if (!is_symbol(sym))
+ {
+ check_method(sc, sym, sc->autoload_symbol, args);
+ return(s7_wrong_type_arg_error(sc, "autoload", 1, sym, "a string (symbol-name) or a symbol"));
+ }
+ if (is_keyword(sym))
+ return(s7_wrong_type_arg_error(sc, "autoload", 1, sym, "a normal symbol (a keyword is never unbound)"));
+ value = cadr(args);
+ if (is_string(value))
+ return(s7_autoload(sc, sym, value));
+ if (((is_closure(value)) || (is_closure_star(value))) &&
+ (s7_is_aritable(sc, value, 1)))
+ return(s7_autoload(sc, sym, value));
-static void input_write_char(s7_scheme *sc, int c, s7_pointer port)
-{
- simple_wrong_type_argument_with_type(sc, sc->write_char_symbol, port, an_output_port_string);
+ check_method(sc, value, sc->autoload_symbol, args);
+ return(s7_wrong_type_arg_error(sc, "autoload", 2, value, "a string (file-name) or a thunk"));
}
-
-static void closed_port_write_char(s7_scheme *sc, int c, s7_pointer port)
+static s7_pointer g_autoloader(s7_scheme *sc, s7_pointer args)
{
- simple_wrong_type_argument_with_type(sc, sc->write_char_symbol, port, an_open_port_string);
-}
-
-
+ #define H_autoloader "(*autoload* sym) returns the autoload info for the symbol sym, or #f."
+ #define Q_autoloader s7_make_signature(sc, 2, sc->T, sc->is_symbol_symbol)
+ s7_pointer sym;
-/* -------- write string functions -------- */
+ sym = car(args);
+ if (!is_symbol(sym))
+ {
+ check_method(sc, sym, sc->autoloader_symbol, args);
+ return(s7_wrong_type_arg_error(sc, "*autoload*", 1, sym, "a symbol"));
+ }
+ if (sc->autoload_names)
+ {
+ const char *file;
+ bool loaded = false;
+ file = find_autoload_name(sc, sym, &loaded, false);
+ if (file)
+ return(s7_make_string(sc, file));
+ }
+ if (is_hash_table(sc->autoload_table))
+ return(s7_hash_table_ref(sc, sc->autoload_table, sym));
-static void input_write_string(s7_scheme *sc, const char *str, int len, s7_pointer port)
-{
- simple_wrong_type_argument_with_type(sc, sc->write_symbol, port, an_output_port_string);
+ return(sc->F);
}
-static void closed_port_write_string(s7_scheme *sc, const char *str, int len, s7_pointer port)
+static s7_pointer g_require(s7_scheme *sc, s7_pointer args)
{
- simple_wrong_type_argument_with_type(sc, sc->write_symbol, port, an_open_port_string);
+ #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\"."
+ #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);
+ for (p = args; is_pair(p); p = cdr(p))
+ {
+ s7_pointer sym;
+ if (is_symbol(car(p)))
+ sym = car(p);
+ else
+ {
+ if ((is_proper_quote(sc, car(p))) &&
+ (is_symbol(cadar(p))))
+ sym = cadar(p);
+ else return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "require: ~S is not a symbol"), car(p))));
+ }
+ if ((!is_slot(find_symbol(sc, sym))) &&
+ (sc->is_autoloading))
+ {
+ s7_pointer f;
+ f = g_autoloader(sc, list_1(sc, sym));
+ if (is_string(f))
+ s7_load_with_environment(sc, string_value(f), sc->envir);
+ else
+ {
+ sc->temp5 = sc->nil;
+ return(s7_error(sc, make_symbol(sc, "autoload-error"),
+ set_elist_2(sc, make_string_wrapper(sc, "require: no autoload info for ~S"), sym)));
+ }
+ }
+ }
+ sc->temp5 = cdr(sc->temp5); /* in-coming value */
+ return(sc->T);
}
-static void input_display(s7_scheme *sc, const char *s, s7_pointer port)
-{
- simple_wrong_type_argument_with_type(sc, sc->write_symbol, port, an_output_port_string);
-}
+/* -------------------------------- eval-string -------------------------------- */
-static void closed_port_display(s7_scheme *sc, const char *s, s7_pointer port)
+s7_pointer s7_eval_c_string_with_environment(s7_scheme *sc, const char *str, s7_pointer e)
{
- simple_wrong_type_argument_with_type(sc, sc->write_symbol, port, an_open_port_string);
+ s7_pointer code, port;
+ TRACK(sc);
+ port = s7_open_input_string(sc, str);
+ code = s7_read(sc, port);
+ s7_close_input_port(sc, port);
+ return(s7_eval(sc, _NFre(code), e));
}
-static void stdout_write_string(s7_scheme *sc, const char *str, int len, s7_pointer port)
+
+s7_pointer s7_eval_c_string(s7_scheme *sc, const char *str)
{
- if (str[len] == '\0')
- fputs(str, stdout);
- else
- {
- int i;
- for (i = 0; i < len; i++)
- fputc(str[i], stdout);
- }
+ return(s7_eval_c_string_with_environment(sc, str, sc->nil));
}
-static void stderr_write_string(s7_scheme *sc, const char *str, int len, s7_pointer port)
+static s7_pointer g_eval_string(s7_scheme *sc, s7_pointer args)
{
- if (str[len] == '\0')
- fputs(str, stderr);
- else
+ #define H_eval_string "(eval-string str (env (curlet))) returns the result of evaluating the string str as Scheme code"
+ #define Q_eval_string s7_make_signature(sc, 3, sc->values_symbol, sc->is_string_symbol, sc->is_let_symbol)
+ s7_pointer port, str;
+
+ str = car(args);
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->eval_string_symbol, args, T_STRING, 1);
+
+ if (is_not_null(cdr(args)))
{
- int i;
- for (i = 0; i < len; i++)
- fputc(str[i], stderr);
+ s7_pointer e;
+ e = cadr(args);
+ if (!is_let(e))
+ return(wrong_type_argument_with_type(sc, sc->eval_string_symbol, 2, e, a_let_string));
+ if (e == sc->rootlet)
+ sc->envir = sc->nil;
+ else sc->envir = e;
}
-}
-static void string_write_string(s7_scheme *sc, const char *str, int len, s7_pointer pt)
-{
- int new_len; /* len is known to be non-zero */
+ port = open_and_protect_input_string(sc, str);
+ push_input_port(sc, port);
- new_len = port_position(pt) + len;
- if (new_len >= (int)port_data_size(pt))
- resize_port_data(pt, new_len * 2);
+ sc->temp3 = sc->args;
+ push_stack(sc, OP_EVAL_STRING_1, args, sc->code);
+ push_stack(sc, OP_READ_INTERNAL, sc->nil, sc->nil);
- memcpy((void *)(port_data(pt) + port_position(pt)), (void *)str, len);
- /* memcpy is much faster than the equivalent while loop */
- port_position(pt) = new_len;
+ return(sc->F);
}
-
-static s7_pointer write_string_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer eval_string_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
check_for_substring_temp(sc, expr);
return(f);
}
-static void file_display(s7_scheme *sc, const char *s, s7_pointer port)
+static s7_pointer call_with_input(s7_scheme *sc, s7_pointer port, s7_pointer args)
{
- if (s)
- {
- if (port_position(port) > 0)
- {
- if (fwrite((void *)(port_data(port)), 1, port_position(port), port_file(port)) != port_position(port))
- s7_warn(sc, 64, "fwrite trouble in display\n");
- port_position(port) = 0;
- }
- if (fputs(s, port_file(port)) == EOF)
- s7_warn(sc, 64, "write to %s: %s\n", port_filename(port), strerror(errno));
- }
+ s7_pointer p;
+ p = cadr(args);
+ port_original_input_string(port) = car(args);
+ push_stack(sc, OP_UNWIND_INPUT, sc->input_port, port);
+ push_stack(sc, OP_APPLY, list_1(sc, port), p);
+ return(sc->F);
}
-static void file_write_string(s7_scheme *sc, const char *str, int len, s7_pointer pt)
-{
- int new_len;
- new_len = port_position(pt) + len;
- if (new_len >= PORT_DATA_SIZE)
- {
- if (port_position(pt) > 0)
- {
- if (fwrite((void *)(port_data(pt)), 1, port_position(pt), port_file(pt)) != port_position(pt))
- s7_warn(sc, 64, "fwrite trouble in write-string\n");
- port_position(pt) = 0;
- }
- if (fwrite((void *)str, 1, len, port_file(pt)) != (size_t)len)
- s7_warn(sc, 64, "fwrite trouble in write-string\n");
- }
- else
- {
- memcpy((void *)(port_data(pt) + port_position(pt)), (void *)str, len);
- port_position(pt) = new_len;
- }
-}
-static void string_display(s7_scheme *sc, const char *s, s7_pointer port)
+/* -------------------------------- call-with-input-string -------------------------------- */
+
+static s7_pointer g_call_with_input_string(s7_scheme *sc, s7_pointer args)
{
- if (s)
- string_write_string(sc, s, safe_strlen(s), port);
-}
+ s7_pointer str, proc;
+ #define H_call_with_input_string "(call-with-input-string str proc) opens a string port for str and applies proc to it"
+ #define Q_call_with_input_string pl_sf
+ /* (call-with-input-string "44" (lambda (p) (+ 1 (read p)))) -> 45 */
+ str = car(args);
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->call_with_input_string_symbol, args, T_STRING, 1);
-static void function_display(s7_scheme *sc, const char *s, s7_pointer port)
-{
- if (s)
- {
- for (; *s; s++)
- (*(port_output_function(port)))(sc, *s, port);
- }
-}
+ proc = cadr(args);
+ if (is_let(proc))
+ check_method(sc, proc, sc->call_with_input_string_symbol, args);
-static void function_write_string(s7_scheme *sc, const char *str, int len, s7_pointer pt)
-{
- int i;
- for (i = 0; i < len; i++)
- (*(port_output_function(pt)))(sc, str[i], pt);
-}
+ if (!s7_is_aritable(sc, proc, 1))
+ return(wrong_type_argument_with_type(sc, sc->call_with_input_string_symbol, 2, proc,
+ make_string_wrapper(sc, "a procedure of one argument (the port)")));
-static void stdout_display(s7_scheme *sc, const char *s, s7_pointer port)
-{
- if (s) fputs(s, stdout);
+ if ((is_continuation(proc)) || (is_goto(proc)))
+ return(wrong_type_argument_with_type(sc, sc->call_with_input_string_symbol, 2, proc, a_normal_procedure_string));
+
+ return(call_with_input(sc, open_and_protect_input_string(sc, str), args));
}
-static void stderr_display(s7_scheme *sc, const char *s, s7_pointer port)
-{
- if (s) fputs(s, stderr);
-}
+/* -------------------------------- call-with-input-file -------------------------------- */
-static s7_pointer g_write_string(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_call_with_input_file(s7_scheme *sc, s7_pointer args)
{
- #define H_write_string "(write-string str port start end) writes str to port."
- #define Q_write_string s7_make_circular_signature(sc, 3, 4, sc->is_string_symbol, sc->is_string_symbol, sc->is_output_port_symbol, sc->is_integer_symbol)
- s7_pointer str, port;
- s7_int start = 0, end;
+ #define H_call_with_input_file "(call-with-input-file filename proc) opens filename and calls proc with the input port as its argument"
+ #define Q_call_with_input_file pl_sf
+ s7_pointer str, proc;
str = car(args);
if (!is_string(str))
- method_or_bust(sc, str, sc->write_string_symbol, args, T_STRING, 1);
+ method_or_bust(sc, str, sc->call_with_input_file_symbol, args, T_STRING, 1);
- end = string_length(str);
- if (!is_null(cdr(args)))
- {
- s7_pointer inds;
- port = cadr(args);
- inds = cddr(args);
- if (!is_null(inds))
- {
- s7_pointer p;
- p = start_and_end(sc, sc->write_string_symbol, NULL, inds, args, 3, &start, &end);
- if (p != sc->gc_nil) return(p);
- }
- }
- else port = sc->output_port;
- if (!is_output_port(port))
- {
- if (port == sc->F)
- {
- s7_pointer x;
- int len;
- if ((start == 0) && (end == string_length(str)))
- return(str);
- len = (int)(end - start);
- x = s7_make_string_with_length(sc, (char *)(string_value(str) + start), len);
- string_value(x)[len] = 0;
- return(x);
- }
- method_or_bust_with_type(sc, port, sc->write_string_symbol, args, an_output_port_string, 2);
- }
+ proc = cadr(args);
+ if (!s7_is_aritable(sc, proc, 1))
+ return(wrong_type_argument_with_type(sc, sc->call_with_input_file_symbol, 2, proc,
+ make_string_wrapper(sc, "a procedure of one argument (the port)")));
+ if ((is_continuation(proc)) || (is_goto(proc)))
+ return(wrong_type_argument_with_type(sc, sc->call_with_input_file_symbol, 2, proc, a_normal_procedure_string));
- if (start == 0)
- port_write_string(port)(sc, string_value(str), end, port);
- else port_write_string(port)(sc, (char *)(string_value(str) + start), (end - start), port);
- return(str);
+ return(call_with_input(sc, open_input_file_1(sc, string_value(str), "r", "call-with-input-file"), args));
}
-static s7_pointer c_write_string(s7_scheme *sc, s7_pointer x) {return(g_write_string(sc, set_plist_1(sc, x)));}
-PF_TO_PF(write_string, c_write_string)
+static s7_pointer with_input(s7_scheme *sc, s7_pointer port, s7_pointer args)
+{
+ s7_pointer old_input_port, p;
+ old_input_port = sc->input_port;
+ sc->input_port = port;
+ port_original_input_string(port) = car(args);
+ push_stack(sc, OP_UNWIND_INPUT, old_input_port, port);
+ p = cadr(args);
+ push_stack(sc, OP_APPLY, sc->nil, p);
+ return(sc->F);
+}
-/* -------- skip to newline readers -------- */
+/* -------------------------------- with-input-from-string -------------------------------- */
-static token_t file_read_semicolon(s7_scheme *sc, s7_pointer pt)
+static s7_pointer g_with_input_from_string(s7_scheme *sc, s7_pointer args)
{
- int c;
- do (c = fgetc(port_file(pt))); while ((c != '\n') && (c != EOF));
- port_line_number(pt)++;
- if (c == EOF)
- return(TOKEN_EOF);
- return(token(sc));
-}
+ #define H_with_input_from_string "(with-input-from-string str thunk) opens str as the temporary current-input-port and calls thunk"
+ #define Q_with_input_from_string pl_sf
+ s7_pointer str;
+ str = car(args);
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->with_input_from_string_symbol, args, T_STRING, 1);
-static token_t string_read_semicolon(s7_scheme *sc, s7_pointer pt)
-{
- const char *orig_str, *str;
- str = (const char *)(port_data(pt) + port_position(pt));
- orig_str = strchr(str, (int)'\n');
- if (!orig_str)
- {
- port_position(pt) = port_data_size(pt);
- return(TOKEN_EOF);
- }
- port_position(pt) += (orig_str - str + 1); /* + 1 because strchr leaves orig_str pointing at the newline */
- port_line_number(pt)++;
- return(token(sc));
+ if (!is_thunk(sc, cadr(args)))
+ method_or_bust_with_type(sc, cadr(args), sc->with_input_from_string_symbol, args, a_thunk_string, 2);
+
+ /* since the arguments are evaluated before we get here, we can get some confusing situations:
+ * (with-input-from-string "#x2.1" (read))
+ * (read) -> whatever it can get from the current input port!
+ * ";with-input-from-string argument 2, #<eof>, is untyped but should be a thunk"
+ */
+ return(with_input(sc, open_and_protect_input_string(sc, str), args));
}
-/* -------- white space readers -------- */
-static int file_read_white_space(s7_scheme *sc, s7_pointer port)
+/* -------------------------------- with-input-from-file -------------------------------- */
+
+static s7_pointer g_with_input_from_file(s7_scheme *sc, s7_pointer args)
{
- int c;
- while (is_white_space(c = fgetc(port_file(port))))
- if (c == '\n')
- port_line_number(port)++;
- return(c);
-}
+ #define H_with_input_from_file "(with-input-from-file filename thunk) opens filename as the temporary current-input-port and calls thunk"
+ #define Q_with_input_from_file pl_sf
+ if (!is_string(car(args)))
+ method_or_bust(sc, car(args), sc->with_input_from_file_symbol, args, T_STRING, 1);
-static int 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.
- */
- str = (const unsigned char *)(port_data(pt) + port_position(pt));
+ if (!is_thunk(sc, cadr(args)))
+ method_or_bust_with_type(sc, cadr(args), sc->with_input_from_file_symbol, args, a_thunk_string, 2);
- while (white_space[c = *str++]) /* (let ((ÿa 1)) ÿa) -- 255 is not -1 = EOF */
- if (c == '\n')
- port_line_number(pt)++;
- if (c)
- port_position(pt) = str - port_data(pt);
- else port_position(pt) = port_data_size(pt);
- return((int)c);
+ return(with_input(sc, open_input_file_1(sc, string_value(car(args)), "r", "with-input-from-file"), args));
}
-/* name (alphanumeric token) readers */
-static void resize_strbuf(s7_scheme *sc, unsigned int needed_size)
+/* -------------------------------- iterators -------------------------------- */
+
+static s7_pointer g_is_iterator(s7_scheme *sc, s7_pointer args)
{
- unsigned int i, old_size;
- old_size = sc->strbuf_size;
- while (sc->strbuf_size <= needed_size) sc->strbuf_size *= 2;
- sc->strbuf = (char *)realloc(sc->strbuf, sc->strbuf_size * sizeof(char));
- for (i = old_size; i < sc->strbuf_size; i++) sc->strbuf[i] = '\0';
+ #define H_is_iterator "(iterator? obj) returns #t if obj is an iterator."
+ #define Q_is_iterator pl_bt
+ s7_pointer x;
+
+ x = car(args);
+ if (is_iterator(x)) return(sc->T);
+ check_closure_for(sc, x, sc->is_iterator_symbol);
+ check_boolean_method(sc, is_iterator, sc->is_iterator_symbol, args);
+ return(sc->F);
}
-static s7_pointer file_read_name_or_sharp(s7_scheme *sc, s7_pointer pt, bool atom_case)
+static s7_pointer iterator_copy(s7_scheme *sc, s7_pointer p)
{
- int c;
- unsigned int i = 1;
- /* sc->strbuf[0] has the first char of the string we're reading */
+ /* fields are obj cur [loc|lcur] [len|slow|hcur] next */
+ s7_pointer iter;
+ new_cell(sc, iter, T_ITERATOR | T_SAFE_PROCEDURE);
+ 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) */
+ iterator_current(iter) = iterator_current(p); /* cur */
+ iterator_next(iter) = iterator_next(p); /* next */
+ return(iter);
+}
- do {
- c = fgetc(port_file(pt)); /* might return EOF */
- if (c == '\n')
- port_line_number(pt)++;
- sc->strbuf[i++] = c;
- if (i >= sc->strbuf_size)
- resize_strbuf(sc, i);
- } while ((c != EOF) && (char_ok_in_a_name[c]));
+static s7_pointer iterator_finished(s7_scheme *sc, s7_pointer iterator)
+{
+ return(sc->ITERATOR_END);
+}
- if ((i == 2) &&
- (sc->strbuf[0] == '\\'))
- sc->strbuf[2] = '\0';
- else
+static s7_pointer let_iterate(s7_scheme *sc, s7_pointer iterator)
+{
+ s7_pointer slot;
+ slot = iterator_current_slot(iterator);
+ if (is_slot(slot))
{
- if (c != EOF)
+ iterator_set_current_slot(iterator, next_slot(slot));
+ if (iterator_let_cons(iterator))
{
- if (c == '\n')
- port_line_number(pt)--;
- ungetc(c, port_file(pt));
+ s7_pointer p;
+ p = iterator_let_cons(iterator);
+ set_car(p, slot_symbol(slot));
+ set_cdr(p, slot_value(slot));
+ return(p);
}
- sc->strbuf[i - 1] = '\0';
+ return(cons(sc, slot_symbol(slot), slot_value(slot)));
}
-
- if (atom_case)
- return(make_atom(sc, sc->strbuf, BASE_10, SYMBOL_OK, WITH_OVERFLOW_ERROR));
-
- return(make_sharp_constant(sc, sc->strbuf, UNNESTED_SHARP, BASE_10, WITH_OVERFLOW_ERROR));
-}
-
-static s7_pointer file_read_name(s7_scheme *sc, s7_pointer pt)
-{
- return(file_read_name_or_sharp(sc, pt, true));
+ iterator_next(iterator) = iterator_finished;
+ return(sc->ITERATOR_END);
}
-static s7_pointer file_read_sharp(s7_scheme *sc, s7_pointer pt)
+static s7_pointer rootlet_iterate(s7_scheme *sc, s7_pointer iterator)
{
- return(file_read_name_or_sharp(sc, pt, false));
+ s7_pointer slot;
+ slot = iterator_current(iterator);
+ if (is_slot(slot))
+ {
+ if (iterator_position(iterator) < sc->rootlet_entries)
+ {
+ iterator_position(iterator)++;
+ iterator_current(iterator) = vector_element(sc->rootlet, iterator_position(iterator));
+ }
+ else iterator_current(iterator) = sc->nil;
+ return(cons(sc, slot_symbol(slot), slot_value(slot)));
+ }
+ iterator_next(iterator) = iterator_finished;
+ return(sc->ITERATOR_END);
}
-
-static s7_pointer string_read_name_no_free(s7_scheme *sc, s7_pointer pt)
+static s7_pointer hash_table_iterate(s7_scheme *sc, s7_pointer iterator)
{
- /* sc->strbuf[0] has the first char of the string we're reading */
- unsigned int k;
- char *str, *orig_str;
-
- str = (char *)(port_data(pt) + port_position(pt));
+ s7_pointer table;
+ int loc, len;
+ hash_entry_t **elements;
+ hash_entry_t *lst;
- if (!char_ok_in_a_name[(unsigned char)*str])
+ lst = iterator_hash_current(iterator);
+ if (lst)
{
- s7_pointer result;
- result = sc->singletons[(unsigned char)(sc->strbuf[0])];
- if (!result)
+ iterator_hash_current(iterator) = lst->next;
+ if (iterator_current(iterator))
{
- sc->strbuf[1] = '\0';
- result = make_symbol_with_length(sc, sc->strbuf, 1);
- sc->singletons[(unsigned char)(sc->strbuf[0])] = result;
+ s7_pointer p;
+ p = iterator_current(iterator);
+ set_car(p, lst->key);
+ set_cdr(p, lst->value);
+ return(p);
}
- return(result);
+ return(cons(sc, lst->key, lst->value));
}
- orig_str = (char *)(str - 1);
- str++;
- while (char_ok_in_a_name[(unsigned char)(*str)]) {str++;}
- k = str - orig_str;
- if (*str != 0)
- port_position(pt) += (k - 1);
- else port_position(pt) = port_data_size(pt);
+ table = iterator_sequence(iterator); /* using iterator_length and hash_table_entries here was slightly slower */
+ len = hash_table_mask(table) + 1;
+ elements = hash_table_elements(table);
- /* this is equivalent to:
- * str = strpbrk(str, "(); \"\t\r\n");
- * if (!str)
- * {
- * k = strlen(orig_str);
- * str = (char *)(orig_str + k);
- * }
- * else k = str - orig_str;
- * but slightly faster.
- */
+ for (loc = iterator_position(iterator) + 1; loc < len; loc++)
+ {
+ hash_entry_t *x;
+ x = elements[loc];
+ if (x)
+ {
+ iterator_position(iterator) = loc;
+ iterator_hash_current(iterator) = x->next;
+ if (iterator_current(iterator))
+ {
+ s7_pointer p;
+ p = iterator_current(iterator);
+ set_car(p, x->key);
+ set_cdr(p, x->value);
+ return(p);
+ }
+ return(cons(sc, x->key, x->value));
+ }
+ }
+ iterator_next(iterator) = iterator_finished;
+ return(sc->ITERATOR_END);
+}
- if (!number_table[(unsigned char)(*orig_str)])
- return(make_symbol_with_length(sc, orig_str, k));
+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;
+ return(sc->ITERATOR_END);
+}
- /* eval_c_string string is a constant so we can't set and unset the token's end char */
- if ((k + 1) >= sc->strbuf_size)
- resize_strbuf(sc, k + 1);
+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;
+ return(sc->ITERATOR_END);
+}
- memcpy((void *)(sc->strbuf), (void *)orig_str, k);
- sc->strbuf[k] = '\0';
- return(make_atom(sc, sc->strbuf, BASE_10, SYMBOL_OK, WITH_OVERFLOW_ERROR));
+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;
+ return(sc->ITERATOR_END);
}
+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;
+ return(sc->ITERATOR_END);
+}
-static s7_pointer string_read_sharp(s7_scheme *sc, s7_pointer pt)
+static s7_pointer vector_iterate(s7_scheme *sc, s7_pointer obj)
{
- /* sc->strbuf[0] has the first char of the string we're reading.
- * since a *#readers* function might want to get further input, we can't mess with the input even when it is otherwise safe
- */
- unsigned int k;
- char *orig_str, *str;
+ if (iterator_position(obj) < iterator_length(obj))
+ return(vector_element(iterator_sequence(obj), iterator_position(obj)++));
+ iterator_next(obj) = iterator_finished;
+ return(sc->ITERATOR_END);
+}
- str = (char *)(port_data(pt) + port_position(pt));
+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;
+ return(result);
+}
- if (!char_ok_in_a_name[(unsigned char)*str])
+static s7_pointer c_object_direct_iterate(s7_scheme *sc, s7_pointer obj)
+{
+ if (iterator_position(obj) < iterator_length(obj))
{
- if (sc->strbuf[0] == 'f')
- return(sc->F);
- if (sc->strbuf[0] == 't')
- return(sc->T);
- if (sc->strbuf[0] == '\\')
- {
- /* must be from #\( and friends -- a character that happens to be not ok-in-a-name */
- sc->strbuf[1] = str[0];
- sc->strbuf[2] = '\0';
- port_position(pt)++;
- }
- else sc->strbuf[1] = '\0';
- return(make_sharp_constant(sc, sc->strbuf, UNNESTED_SHARP, BASE_10, WITH_OVERFLOW_ERROR));
+ s7_pointer result, p;
+ p = iterator_sequence(obj);
+ result = c_object_cref(p)(sc, p, iterator_position(obj));
+ iterator_position(obj)++;
+ if (result == sc->ITERATOR_END)
+ iterator_next(obj) = iterator_finished;
+ return(result);
}
+ iterator_next(obj) = iterator_finished;
+ return(sc->ITERATOR_END);
+}
- orig_str = (char *)(str - 1);
- str++;
- while (char_ok_in_a_name[(unsigned char)(*str)]) {str++;}
- k = str - orig_str;
- if (*str != 0)
- port_position(pt) += (k - 1);
- else port_position(pt) += k;
-
- if ((k + 1) >= sc->strbuf_size)
- resize_strbuf(sc, k + 1);
-
- memcpy((void *)(sc->strbuf), (void *)orig_str, k);
- sc->strbuf[k] = '\0';
- return(make_sharp_constant(sc, sc->strbuf, UNNESTED_SHARP, BASE_10, WITH_OVERFLOW_ERROR));
+static s7_pointer c_object_iterate(s7_scheme *sc, s7_pointer obj)
+{
+ if (iterator_position(obj) < iterator_length(obj))
+ {
+ s7_pointer result, p, cur;
+ p = iterator_sequence(obj);
+ cur = iterator_current(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);
+ 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;
+ return(result);
+ }
+ iterator_next(obj) = iterator_finished;
+ return(sc->ITERATOR_END);
}
-static s7_pointer string_read_name(s7_scheme *sc, s7_pointer pt)
+static s7_pointer pair_iterate_1(s7_scheme *sc, s7_pointer obj);
+static s7_pointer pair_iterate(s7_scheme *sc, s7_pointer obj)
{
- /* port_string was allocated (and read from a file) so we can mess with it directly */
- s7_pointer result;
- unsigned int k;
- char *orig_str, *str;
- char endc;
-
- str = (char *)(port_data(pt) + port_position(pt));
- if (!char_ok_in_a_name[(unsigned char)*str])
+ if (is_pair(iterator_current(obj)))
{
s7_pointer result;
- result = sc->singletons[(unsigned char)(sc->strbuf[0])];
- if (!result)
+ result = car(iterator_current(obj));
+ iterator_current(obj) = cdr(iterator_current(obj));
+ if (iterator_current(obj) == iterator_slow(obj))
{
- sc->strbuf[1] = '\0';
- result = make_symbol_with_length(sc, sc->strbuf, 1);
- sc->singletons[(unsigned char)(sc->strbuf[0])] = result;
+ iterator_next(obj) = iterator_finished;
+ return(result);
}
+ iterator_next(obj) = pair_iterate_1;
return(result);
}
-
- orig_str = (char *)(str - 1);
- str++;
- while (char_ok_in_a_name[(unsigned char)(*str)]) {str++;}
- k = str - orig_str;
- if (*str != 0)
- port_position(pt) += (k - 1);
- else port_position(pt) = port_data_size(pt);
-
- if (!number_table[(unsigned char)(*orig_str)])
- return(make_symbol_with_length(sc, orig_str, k));
-
- endc = (*str);
- (*str) = '\0';
- result = make_atom(sc, orig_str, BASE_10, SYMBOL_OK, WITH_OVERFLOW_ERROR);
- (*str) = endc;
- return(result);
+ iterator_next(obj) = iterator_finished;
+ return(sc->ITERATOR_END);
}
-
-static s7_pointer read_file(s7_scheme *sc, FILE *fp, const char *name, long max_size, const char *caller)
+static s7_pointer pair_iterate_1(s7_scheme *sc, s7_pointer obj)
{
- s7_pointer port;
-#ifndef _MSC_VER
- long size;
-#endif
- unsigned int port_loc;
-
- new_cell(sc, port, T_INPUT_PORT);
- port_loc = s7_gc_protect(sc, port);
- port_port(port) = alloc_port(sc);
- port_is_closed(port) = false;
- port_original_input_string(port) = sc->nil;
- port_write_character(port) = input_write_char;
- port_write_string(port) = input_write_string;
+ if (is_pair(iterator_current(obj)))
+ {
+ s7_pointer result;
+ result = car(iterator_current(obj));
+ iterator_current(obj) = cdr(iterator_current(obj));
+ if (iterator_current(obj) == iterator_slow(obj))
+ {
+ iterator_next(obj) = iterator_finished;
+ return(result);
+ }
+ iterator_set_slow(obj, cdr(iterator_slow(obj)));
+ iterator_next(obj) = pair_iterate;
+ return(result);
+ }
+ iterator_next(obj) = iterator_finished;
+ return(sc->ITERATOR_END);
+}
- /* if we're constantly opening files, and each open saves the file name in permanent
- * memory, we gradually core-up.
- */
- port_filename_length(port) = safe_strlen(name);
- port_filename(port) = copy_string_with_length(name, port_filename_length(port));
- port_line_number(port) = 1; /* first line is numbered 1 */
- add_input_port(sc, port);
+static s7_pointer iterator_method(s7_scheme *sc, s7_pointer e)
+{
+ s7_pointer func;
+ if ((has_methods(e)) &&
+ ((func = find_method(sc, find_let(sc, e), sc->make_iterator_symbol)) != sc->undefined))
+ {
+ s7_pointer it;
+ it = s7_apply_function(sc, func, list_1(sc, e));
+ if (!is_iterator(it))
+ return(s7_error(sc, sc->error_symbol, set_elist_2(sc, make_string_wrapper(sc, "make-iterator method must return an interator: ~S"), it)));
+ return(it);
+ }
+ return(NULL);
+}
-#ifndef _MSC_VER
- /* this doesn't work in MS C */
- fseek(fp, 0, SEEK_END);
- size = ftell(fp);
- rewind(fp);
+s7_pointer s7_make_iterator(s7_scheme *sc, s7_pointer e)
+{
+ s7_pointer iter;
- /* pseudo files (under /proc for example) have size=0, but we can read them, so don't assume a 0 length file is empty
- */
+ new_cell(sc, iter, T_ITERATOR | T_SAFE_PROCEDURE);
+ iterator_sequence(iter) = e;
+ iterator_position(iter) = 0;
- 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)))
+ switch (type(e))
{
- size_t bytes;
- unsigned char *content;
-
- content = (unsigned char *)malloc((size + 2) * sizeof(unsigned char));
- bytes = fread(content, sizeof(unsigned char), size, fp);
- if (bytes != (size_t)size)
+ case T_LET:
+ if (e == sc->rootlet)
{
- char tmp[256];
- int len;
- len = snprintf(tmp, 256, "(%s \"%s\") read %ld bytes of an expected %ld?", caller, name, (long)bytes, size);
- port_write_string(sc->output_port)(sc, tmp, len, sc->output_port);
- size = bytes;
+ iterator_current(iter) = vector_element(e, 0); /* unfortunately tricky -- let_iterate uses different fields */
+ iterator_next(iter) = rootlet_iterate;
}
- content[size] = '\0';
- content[size + 1] = '\0';
- fclose(fp);
+ else
+ {
+ s7_pointer f;
+ sc->temp6 = iter;
+ f = iterator_method(sc, e);
+ sc->temp6 = sc->nil;
+ if (f) {free_cell(sc, iter); return(f);}
+ iterator_set_current_slot(iter, let_slots(e));
+ iterator_next(iter) = let_iterate;
+ iterator_let_cons(iter) = NULL;
+ }
+ break;
- port_type(port) = STRING_PORT;
- port_data(port) = content;
- port_data_size(port) = size;
- port_position(port) = 0;
- port_needs_free(port) = true;
- port_gc_loc(port) = -1;
- port_read_character(port) = string_read_char;
- port_read_line(port) = string_read_line;
- port_display(port) = input_display;
- port_read_semicolon(port) = string_read_semicolon;
- port_read_white_space(port) = terminated_string_read_white_space;
- port_read_name(port) = string_read_name;
- port_read_sharp(port) = string_read_sharp;
- }
- else
- {
- port_file(port) = fp;
- port_type(port) = FILE_PORT;
- port_needs_free(port) = false;
- port_read_character(port) = file_read_char;
- port_read_line(port) = file_read_line;
- port_display(port) = input_display;
- port_read_semicolon(port) = file_read_semicolon;
- port_read_white_space(port) = file_read_white_space;
- port_read_name(port) = file_read_name;
- port_read_sharp(port) = file_read_sharp; /* was string_read_sharp?? */
- }
-#else
- /* _stat64 is no better than the fseek/ftell route, and
- * GetFileSizeEx and friends requires Windows.h which makes hash of everything else.
- * fread until done takes too long on big files, so use a file port
- */
- port_file(port) = fp;
- port_type(port) = FILE_PORT;
- port_needs_free(port) = false;
- port_read_character(port) = file_read_char;
- port_read_line(port) = file_read_line;
- port_display(port) = input_display;
- port_read_semicolon(port) = file_read_semicolon;
- port_read_white_space(port) = file_read_white_space;
- port_read_name(port) = file_read_name;
- port_read_sharp(port) = file_read_sharp;
-#endif
+ case T_HASH_TABLE:
+ iterator_hash_current(iter) = NULL;
+ iterator_current(iter) = NULL;
+ iterator_position(iter) = -1;
+ iterator_next(iter) = hash_table_iterate;
+ break;
- s7_gc_unprotect_at(sc, port_loc);
- return(port);
-}
+ case T_STRING:
+ iterator_length(iter) = string_length(e);
+ if (is_byte_vector(e))
+ iterator_next(iter) = byte_vector_iterate;
+ else iterator_next(iter) = string_iterate;
+ break;
+ case T_VECTOR:
+ iterator_length(iter) = vector_length(e);
+ iterator_next(iter) = vector_iterate;
+ break;
-static s7_pointer make_input_file(s7_scheme *sc, const char *name, FILE *fp)
-{
- #define MAX_SIZE_FOR_STRING_PORT 5000000
- return(read_file(sc, fp, name, MAX_SIZE_FOR_STRING_PORT, "open"));
-}
+ case T_INT_VECTOR:
+ iterator_length(iter) = vector_length(e);
+ iterator_next(iter) = int_vector_iterate;
+ break;
-#if (!MS_WINDOWS)
-#include <sys/stat.h>
-#endif
+ case T_FLOAT_VECTOR:
+ iterator_length(iter) = vector_length(e);
+ iterator_next(iter) = float_vector_iterate;
+ break;
-static bool is_directory(const char *filename)
-{
-#if (!MS_WINDOWS)
- #ifdef S_ISDIR
- struct stat statbuf;
- return((stat(filename, &statbuf) >= 0) &&
- (S_ISDIR(statbuf.st_mode)));
- #endif
-#endif
- return(false);
+ case T_PAIR:
+ iterator_current(iter) = e;
+ iterator_next(iter) = pair_iterate;
+ iterator_set_slow(iter, e);
+ break;
+
+ case T_MACRO: case T_MACRO_STAR:
+ case T_BACRO: case T_BACRO_STAR:
+ case T_CLOSURE: case T_CLOSURE_STAR:
+ {
+ s7_pointer p;
+ p = cons(sc, e, sc->nil);
+ if (g_is_iterator(sc, p) != sc->F)
+ {
+ set_car(p, small_int(0));
+ iterator_current(iter) = p;
+ set_mark_seq(iter);
+ iterator_next(iter) = closure_iterate;
+ if (has_methods(e))
+ iterator_length(iter) = closure_length(sc, e);
+ else iterator_length(iter) = s7_int_max;
+ }
+ else
+ {
+ free_cell(sc, iter);
+ return(simple_wrong_type_argument_with_type(sc, sc->make_iterator_symbol, e, make_string_wrapper(sc, "a closure/macro with an 'iterator local that is not #f")));
+ }
+ }
+ 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);
+ }
+ else
+ {
+ s7_pointer f;
+ sc->temp6 = iter;
+ f = iterator_method(sc, e);
+ sc->temp6 = sc->nil;
+ if (f) {free_cell(sc, iter); return(f);}
+ iterator_current(iter) = cons(sc, small_int(0), sc->nil);
+ set_mark_seq(iter);
+ iterator_next(iter) = c_object_iterate;
+ }
+ break;
+
+ default:
+ return(simple_wrong_type_argument_with_type(sc, sc->make_iterator_symbol, e, a_sequence_string));
+ }
+ return(iter);
}
-static s7_pointer open_input_file_1(s7_scheme *sc, const char *name, const char *mode, const char *caller)
+static s7_pointer g_make_iterator(s7_scheme *sc, s7_pointer args)
{
- FILE *fp;
- /* see if we can open this file before allocating a port */
-
- if (is_directory(name))
- return(file_error(sc, caller, "is a directory", name));
+ #define H_make_iterator "(make-iterator sequence) returns an iterator object that returns the next value \
+in the sequence each time it is called. When it reaches the end, it returns " ITERATOR_END_NAME "."
+ #define Q_make_iterator s7_make_signature(sc, 3, sc->is_iterator_symbol, sc->is_sequence_symbol, sc->is_pair_symbol)
+
+ s7_pointer seq;
+ seq = car(args);
- errno = 0;
- fp = fopen(name, mode);
- if (!fp)
+ if (is_pair(cdr(args)))
{
-#if (!MS_WINDOWS)
- if (errno == EINVAL)
- return(file_error(sc, caller, "invalid mode", mode));
- #if WITH_GCC
- /* catch one special case, "~/..." */
- if ((name[0] == '~') &&
- (name[1] == '/'))
+ if (is_pair(cadr(args)))
{
- char *home;
- home = getenv("HOME");
- if (home)
+ if (is_hash_table(seq))
{
- char *filename;
- int len;
- len = safe_strlen(name) + safe_strlen(home) + 1;
- tmpbuf_malloc(filename, len);
- snprintf(filename, len, "%s%s", home, (char *)(name + 1));
- fp = fopen(filename, "r");
- tmpbuf_free(filename, len);
- if (fp)
- return(make_input_file(sc, name, fp));
+ s7_pointer iter;
+ iter = s7_make_iterator(sc, seq);
+ iterator_current(iter) = cadr(args);
+ set_mark_seq(iter);
+ return(iter);
+ }
+ if ((is_let(seq)) && (seq != sc->rootlet))
+ {
+ s7_pointer iter;
+ iter = s7_make_iterator(sc, seq);
+ iterator_let_cons(iter) = cadr(args);
+ set_mark_seq(iter);
+ return(iter);
}
}
- #endif
-#endif
- return(file_error(sc, caller, strerror(errno), name));
+ else return(simple_wrong_type_argument(sc, sc->make_iterator_symbol, cadr(args), T_PAIR));
}
- return(make_input_file(sc, name, fp));
+ return(s7_make_iterator(sc, seq));
}
-
-s7_pointer s7_open_input_file(s7_scheme *sc, const char *name, const char *mode)
+static s7_pointer g_iterate(s7_scheme *sc, s7_pointer args)
{
- return(open_input_file_1(sc, name, mode, "open-input-file"));
-}
+ #define H_iterate "(iterate obj) returns the next element from the iterator obj, or " ITERATOR_END_NAME "."
+ #define Q_iterate s7_make_signature(sc, 2, sc->T, sc->is_iterator_symbol)
+ s7_pointer iter;
+ iter = car(args);
+ if (!is_iterator(iter))
+ method_or_bust_one_arg(sc, iter, sc->iterate_symbol, args, T_ITERATOR);
+ return((iterator_next(iter))(sc, iter));
+}
-static s7_pointer g_open_input_file(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_iterate(s7_scheme *sc, s7_pointer obj)
{
- #define H_open_input_file "(open-input-file filename (mode \"r\")) opens filename for reading"
- #define Q_open_input_file s7_make_signature(sc, 3, sc->is_input_port_symbol, sc->is_string_symbol, sc->is_string_symbol)
- s7_pointer name = car(args);
-
- if (!is_string(name))
- method_or_bust(sc, name, sc->open_input_file_symbol, args, T_STRING, 1);
- /* what if the file name is a byte-vector? currently we accept it */
-
- if (is_pair(cdr(args)))
- {
- s7_pointer mode;
- mode = cadr(args);
- if (!is_string(mode))
- method_or_bust_with_type(sc, mode, sc->open_input_file_symbol, args, make_string_wrapper(sc, "a string (a mode such as \"r\")"), 2);
- /* since scheme allows embedded nulls, dumb stuff is accepted here: (open-input-file file "a\x00b") -- should this be an error? */
- return(open_input_file_1(sc, string_value(name), string_value(mode), "open-input-file"));
- }
- return(open_input_file_1(sc, string_value(name), "r", "open-input-file"));
+ return((iterator_next(obj))(sc, obj));
}
-
-static void make_standard_ports(s7_scheme *sc)
+bool s7_is_iterator(s7_pointer obj)
{
- s7_pointer x;
-
- /* standard output */
- x = alloc_pointer();
- unheap(x);
- set_type(x, T_OUTPUT_PORT | T_IMMUTABLE);
- port_port(x) = (port_t *)calloc(1, sizeof(port_t));
- port_type(x) = FILE_PORT;
- port_data(x) = NULL;
- port_is_closed(x) = false;
- port_filename_length(x) = 8;
- port_filename(x) = copy_string_with_length("*stdout*", 8);
- port_file_number(x) = remember_file_name(sc, port_filename(x)); /* these numbers need to be correct for the evaluator (__FUNC__ data) */
- port_line_number(x) = 0;
- port_file(x) = stdout;
- port_needs_free(x) = false;
- port_read_character(x) = output_read_char;
- port_read_line(x) = output_read_line;
- port_display(x) = stdout_display;
- port_write_character(x) = stdout_write_char;
- port_write_string(x) = stdout_write_string;
- sc->standard_output = x;
-
- /* standard error */
- x = alloc_pointer();
- unheap(x);
- set_type(x, T_OUTPUT_PORT | T_IMMUTABLE);
- port_port(x) = (port_t *)calloc(1, sizeof(port_t));
- port_type(x) = FILE_PORT;
- port_data(x) = NULL;
- port_is_closed(x) = false;
- port_filename_length(x) = 8;
- port_filename(x) = copy_string_with_length("*stderr*", 8);
- port_file_number(x) = remember_file_name(sc, port_filename(x));
- port_line_number(x) = 0;
- port_file(x) = stderr;
- port_needs_free(x) = false;
- port_read_character(x) = output_read_char;
- port_read_line(x) = output_read_line;
- port_display(x) = stderr_display;
- port_write_character(x) = stderr_write_char;
- port_write_string(x) = stderr_write_string;
- sc->standard_error = x;
-
- /* standard input */
- x = alloc_pointer();
- unheap(x);
- set_type(x, T_INPUT_PORT | T_IMMUTABLE);
- port_port(x) = (port_t *)calloc(1, sizeof(port_t));
- port_type(x) = FILE_PORT;
- port_is_closed(x) = false;
- port_original_input_string(x) = sc->nil;
- port_filename_length(x) = 7;
- port_filename(x) = copy_string_with_length("*stdin*", 7);
- port_file_number(x) = remember_file_name(sc, port_filename(x));
- port_line_number(x) = 0;
- port_file(x) = stdin;
- port_needs_free(x) = false;
- port_read_character(x) = file_read_char;
- port_read_line(x) = stdin_read_line;
- port_display(x) = input_display;
- port_read_semicolon(x) = file_read_semicolon;
- port_read_white_space(x) = file_read_white_space;
- port_read_name(x) = file_read_name;
- port_read_sharp(x) = file_read_sharp;
- port_write_character(x) = input_write_char;
- port_write_string(x) = input_write_string;
- sc->standard_input = x;
-
- s7_define_constant(sc, "*stdin*", sc->standard_input);
- s7_define_constant(sc, "*stdout*", sc->standard_output);
- s7_define_constant(sc, "*stderr*", sc->standard_error);
-
- sc->input_port = sc->standard_input;
- sc->output_port = sc->standard_output;
- sc->error_port = sc->standard_error;
- sc->current_file = NULL;
- sc->current_line = -1;
+ return(is_iterator(obj));
}
+static bool is_iterator_b(s7_pointer obj) {return(g_is_iterator(cur_sc, set_plist_1(cur_sc, obj)) != cur_sc->F);}
-s7_pointer s7_open_output_file(s7_scheme *sc, const char *name, const char *mode)
+bool s7_iterator_is_at_end(s7_scheme *sc, s7_pointer obj)
{
- FILE *fp;
- s7_pointer x;
- /* see if we can open this file before allocating a port */
-
- errno = 0;
- fp = fopen(name, mode);
- if (!fp)
- {
-#if (!MS_WINDOWS)
- if (errno == EINVAL)
- return(file_error(sc, "open-output-file", "invalid mode", mode));
-#endif
- return(file_error(sc, "open-output-file", strerror(errno), name));
- }
-
- new_cell(sc, x, T_OUTPUT_PORT);
- port_port(x) = alloc_port(sc);
- port_type(x) = FILE_PORT;
- port_is_closed(x) = false;
- port_filename_length(x) = safe_strlen(name);
- port_filename(x) = copy_string_with_length(name, port_filename_length(x));
- port_line_number(x) = 1;
- port_file(x) = fp;
- port_needs_free(x) = false;
- port_read_character(x) = output_read_char;
- port_read_line(x) = output_read_line;
- port_display(x) = file_display;
- port_write_character(x) = file_write_char;
- port_write_string(x) = file_write_string;
- port_position(x) = 0;
- port_data_size(x) = PORT_DATA_SIZE;
- port_data(x) = (unsigned char *)malloc(PORT_DATA_SIZE); /* was +8? */
- add_output_port(sc, x);
- return(x);
+ if (!is_iterator(obj))
+ simple_wrong_type_argument(sc, sc->iterator_is_at_end_symbol, obj, T_ITERATOR);
+ return(iterator_is_at_end(obj));
}
-
-static s7_pointer g_open_output_file(s7_scheme *sc, s7_pointer args)
+bool iterator_is_at_end_b(s7_pointer obj)
{
- #define H_open_output_file "(open-output-file filename (mode \"w\")) opens filename for writing"
- #define Q_open_output_file s7_make_signature(sc, 3, sc->is_output_port_symbol, sc->is_string_symbol, sc->is_string_symbol)
- s7_pointer name = car(args);
-
- if (!is_string(name))
- method_or_bust(sc, name, sc->open_output_file_symbol, args, T_STRING, 1);
-
- if (is_pair(cdr(args)))
- {
- if (!is_string(cadr(args)))
- method_or_bust_with_type(sc, cadr(args), sc->open_output_file_symbol, args, make_string_wrapper(sc, "a string (a mode such as \"w\")"), 2);
- return(s7_open_output_file(sc, string_value(name), string_value(cadr(args))));
- }
- return(s7_open_output_file(sc, string_value(name), "w"));
+ 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));
}
-static s7_pointer open_input_string(s7_scheme *sc, const char *input_string, int len)
+static s7_pointer g_iterator_sequence(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
- new_cell(sc, x, T_INPUT_PORT);
- port_port(x) = alloc_port(sc);
- port_type(x) = STRING_PORT;
- port_is_closed(x) = false;
- port_original_input_string(x) = sc->nil;
- port_data(x) = (unsigned char *)input_string;
- port_data_size(x) = len;
- port_position(x) = 0;
- port_filename_length(x) = 0;
- port_filename(x) = NULL;
- port_file_number(x) = 0; /* unsigned int */
- port_line_number(x) = 0;
- port_needs_free(x) = false;
- port_gc_loc(x) = -1;
- port_read_character(x) = string_read_char;
- port_read_line(x) = string_read_line;
- port_display(x) = input_display;
- port_read_semicolon(x) = string_read_semicolon;
-#if DEBUGGING
- if (input_string[len] != '\0')
- fprintf(stderr, "read_white_space string is not terminated: %s", input_string);
-#endif
- port_read_white_space(x) = terminated_string_read_white_space;
- port_read_name(x) = string_read_name_no_free;
- port_read_sharp(x) = string_read_sharp;
- port_write_character(x) = input_write_char;
- port_write_string(x) = input_write_string;
- add_input_port(sc, x);
- return(x);
-}
+ #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;
-static s7_pointer open_and_protect_input_string(s7_scheme *sc, s7_pointer str)
-{
- s7_pointer p;
- p = open_input_string(sc, string_value(str), string_length(str));
- port_gc_loc(p) = s7_gc_protect(sc, str);
- return(p);
+ iter = car(args);
+ if (!is_iterator(iter))
+ return(simple_wrong_type_argument(sc, sc->iterator_sequence_symbol, iter, T_ITERATOR));
+ return(iterator_sequence(iter));
}
-
-s7_pointer s7_open_input_string(s7_scheme *sc, const char *input_string)
+static s7_pointer g_iterator_is_at_end(s7_scheme *sc, s7_pointer args)
{
- return(open_input_string(sc, input_string, safe_strlen(input_string)));
-}
+ #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 (!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)));
+}
-static s7_pointer g_open_input_string(s7_scheme *sc, s7_pointer args)
-{
- #define H_open_input_string "(open-input-string str) opens an input port reading str"
- #define Q_open_input_string s7_make_signature(sc, 2, sc->is_input_port_symbol, sc->is_string_symbol)
- s7_pointer input_string, port;
- input_string = car(args);
- if (!is_string(input_string))
- method_or_bust(sc, input_string, sc->open_input_string_symbol, args, T_STRING, 0);
- port = open_and_protect_input_string(sc, input_string);
- return(port);
-}
+/* -------------------------------------------------------------------------------- */
-#define FORMAT_PORT_LENGTH 128
-/* the large majority (> 99% in my tests) of the output strings have less than 128 chars when the port is finally closed
- * 256 is slightly slower (the calloc time below dominates the realloc time in string_write_string)
- * 64 is much slower (realloc dominates)
- */
+#define INITIAL_SHARED_INFO_SIZE 8
-static s7_pointer open_output_string(s7_scheme *sc, int len)
+static int shared_ref(shared_info *ci, s7_pointer p)
{
- s7_pointer x;
- new_cell(sc, x, T_OUTPUT_PORT);
- port_port(x) = alloc_port(sc);
- port_type(x) = STRING_PORT;
- port_is_closed(x) = false;
- port_data_size(x) = len;
- port_data(x) = (unsigned char *)malloc(len * sizeof(unsigned char)); /* was +8? */
- port_data(x)[0] = '\0'; /* in case s7_get_output_string before any output */
- port_position(x) = 0;
- port_needs_free(x) = true;
- port_read_character(x) = output_read_char;
- port_read_line(x) = output_read_line;
- port_display(x) = string_display;
- port_write_character(x) = string_write_char;
- port_write_string(x) = string_write_string;
- add_output_port(sc, x);
- return(x);
-}
+ /* from print after collecting refs, not called by equality check */
+ int i;
+ s7_pointer *objs;
-s7_pointer s7_open_output_string(s7_scheme *sc)
-{
- return(open_output_string(sc, sc->initial_string_port_length));
+ if (!is_collected(p)) return(0);
+
+ objs = ci->objs;
+ for (i = 0; i < ci->top; i++)
+ if (objs[i] == p)
+ {
+ int val;
+ val = ci->refs[i];
+ if (val > 0)
+ ci->refs[i] = -ci->refs[i];
+ return(val);
+ }
+ return(0);
}
-static s7_pointer g_open_output_string(s7_scheme *sc, s7_pointer args)
+static int peek_shared_ref(shared_info *ci, s7_pointer p)
{
- #define H_open_output_string "(open-output-string) opens an output string port"
- #define Q_open_output_string s7_make_signature(sc, 1, sc->is_output_port_symbol)
- return(s7_open_output_string(sc));
-}
+ /* returns 0 if not found, otherwise the ref value for p */
+ int i;
+ s7_pointer *objs;
+ objs = ci->objs;
+ for (i = 0; i < ci->top; i++)
+ if (objs[i] == p) return(ci->refs[i]);
-const char *s7_get_output_string(s7_scheme *sc, s7_pointer p)
-{
- port_data(p)[port_position(p)] = '\0';
- return((const char *)port_data(p));
+ return(0);
}
-static s7_pointer g_get_output_string(s7_scheme *sc, s7_pointer args)
+static void enlarge_shared_info(shared_info *ci)
{
- #define H_get_output_string "(get-output-string port clear-port) returns the output accumulated in port. \
-If the optional 'clear-port' is #t, the current string is flushed."
- #define Q_get_output_string s7_make_signature(sc, 3, sc->is_string_symbol, sc->is_output_port_symbol, sc->is_boolean_symbol)
-
- s7_pointer p, result;
- bool clear_port = false;
-
- if (is_pair(cdr(args)))
- {
- p = cadr(args);
- if (!s7_is_boolean(p))
- return(wrong_type_argument(sc, sc->get_output_string_symbol, 2, p, T_BOOLEAN));
- clear_port = (p == sc->T);
- }
- p = car(args);
- if ((!is_output_port(p)) ||
- (!is_string_port(p)))
- {
- if (p == sc->F) return(make_empty_string(sc, 0, 0));
- method_or_bust_with_type(sc, p, sc->get_output_string_symbol, args, make_string_wrapper(sc, "an output string port"), 0);
- }
- if (port_is_closed(p))
- return(simple_wrong_type_argument_with_type(sc, sc->get_output_string_symbol, p, make_string_wrapper(sc, "an active (open) string port")));
-
- result = s7_make_string_with_length(sc, (const char *)port_data(p), port_position(p));
- if (clear_port)
+ int i;
+ ci->size *= 2;
+ ci->objs = (s7_pointer *)realloc(ci->objs, ci->size * sizeof(s7_pointer));
+ ci->refs = (int *)realloc(ci->refs, ci->size * sizeof(int));
+ for (i = ci->top; i < ci->size; i++)
{
- port_position(p) = 0;
- port_data(p)[0] = '\0';
+ ci->refs[i] = 0;
+ ci->objs[i] = NULL;
}
- return(result);
}
-s7_pointer s7_open_input_function(s7_scheme *sc, s7_pointer (*function)(s7_scheme *sc, s7_read_t read_choice, s7_pointer port))
+static void add_shared_ref(shared_info *ci, s7_pointer x, int ref_x)
{
- s7_pointer x;
- new_cell(sc, x, T_INPUT_PORT);
- port_port(x) = alloc_port(sc);
- port_type(x) = FUNCTION_PORT;
- port_is_closed(x) = false;
- port_original_input_string(x) = sc->nil;
- port_needs_free(x) = false;
- port_input_function(x) = function;
- port_read_character(x) = function_read_char;
- port_read_line(x) = function_read_line;
- port_display(x) = input_display;
- port_write_character(x) = input_write_char;
- port_write_string(x) = input_write_string;
- add_input_port(sc, x);
- return(x);
-}
-
+ /* called only in equality check, not printer */
-s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, unsigned char c, s7_pointer port))
-{
- s7_pointer x;
- new_cell(sc, x, T_OUTPUT_PORT);
- port_port(x) = alloc_port(sc);
- port_type(x) = FUNCTION_PORT;
- port_data(x) = NULL;
- port_is_closed(x) = false;
- port_needs_free(x) = false;
- port_output_function(x) = function;
- port_read_character(x) = output_read_char;
- port_read_line(x) = output_read_line;
- port_display(x) = function_display;
- port_write_character(x) = function_write_char;
- port_write_string(x) = function_write_string;
- add_output_port(sc, x);
- return(x);
-}
+ if (ci->top == ci->size)
+ enlarge_shared_info(ci);
+ set_collected(x);
-static void push_input_port(s7_scheme *sc, s7_pointer new_port)
-{
- sc->temp6 = sc->input_port;
- sc->input_port = new_port;
- sc->input_port_stack = cons(sc, sc->temp6, sc->input_port_stack);
- sc->temp6 = sc->nil;
+ ci->objs[ci->top] = x;
+ ci->refs[ci->top++] = ref_x;
}
+static bool collect_shared_info(s7_scheme *sc, shared_info *ci, s7_pointer top, bool stop_at_print_length);
+static hash_entry_t *hash_equal(s7_scheme *sc, s7_pointer table, s7_pointer key);
-static void pop_input_port(s7_scheme *sc)
+static bool collect_vector_info(s7_scheme *sc, shared_info *ci, s7_pointer top, bool stop_at_print_length)
{
- if (is_pair(sc->input_port_stack))
+ s7_int i, plen;
+ bool cyclic = false;
+
+ if (stop_at_print_length)
{
- s7_pointer nxt;
- sc->input_port = car(sc->input_port_stack);
- nxt = cdr(sc->input_port_stack);
- /* is this safe? */
- free_cell(sc, sc->input_port_stack);
- sc->input_port_stack = nxt;
+ plen = sc->print_length;
+ if (plen > vector_length(top))
+ plen = vector_length(top);
}
- else sc->input_port = sc->standard_input;
+ else plen = vector_length(top);
+
+ for (i = 0; i < plen; i++)
+ if ((has_structure(vector_element(top, i))) &&
+ (collect_shared_info(sc, ci, vector_element(top, i), stop_at_print_length)))
+ cyclic = true;
+ return(cyclic);
}
-static int inchar(s7_pointer pt)
+static bool collect_shared_info(s7_scheme *sc, shared_info *ci, s7_pointer top, bool stop_at_print_length)
{
- int c;
- if (is_file_port(pt))
- c = fgetc(port_file(pt)); /* not unsigned char! -- could be EOF */
- else
+ /* look for top in current list.
+ *
+ * As we collect objects (guaranteed to have structure) we set the collected bit. If we ever
+ * 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;
+ if (is_collected_or_shared(top))
{
- if (port_data_size(pt) <= port_position(pt))
- return(EOF);
- c = (unsigned char)port_data(pt)[port_position(pt)++];
- }
+ s7_pointer *p, *objs_end;
+ int i;
+ if (is_shared(top))
+ return(false);
- if (c == '\n')
- port_line_number(pt)++;
+ 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(c);
+ /* top not seen before -- add it to the list */
+ set_collected(top);
+
+ if (ci->top == ci->size)
+ enlarge_shared_info(ci);
+ ci->objs[ci->top++] = top;
+
+ /* now search the rest of this structure */
+ switch (type(top))
+ {
+ case T_PAIR:
+ 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;
+ break;
+
+ case T_VECTOR:
+ if (collect_vector_info(sc, ci, top, stop_at_print_length))
+ top_cyclic = true;
+ break;
+
+ case T_ITERATOR:
+ if (collect_shared_info(sc, ci, iterator_sequence(top), stop_at_print_length))
+ top_cyclic = true;
+ break;
+
+ case T_HASH_TABLE:
+ if (hash_table_entries(top) > 0)
+ {
+ unsigned int i, len;
+ hash_entry_t **entries;
+ bool keys_safe;
+
+ 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++)
+ {
+ hash_entry_t *p;
+ for (p = entries[i]; p; p = p->next)
+ {
+ if ((!keys_safe) &&
+ (has_structure(p->key)) &&
+ (collect_shared_info(sc, ci, p->key, stop_at_print_length)))
+ top_cyclic = true;
+ if ((has_structure(p->value)) &&
+ (collect_shared_info(sc, ci, p->value, stop_at_print_length)))
+ top_cyclic = true;
+ }
+ }
+ }
+ break;
+
+ case T_SLOT:
+ if ((has_structure(slot_value(top))) &&
+ (collect_shared_info(sc, ci, slot_value(top), stop_at_print_length)))
+ top_cyclic = true;
+ break;
+
+ case T_LET:
+ if (top == sc->rootlet)
+ {
+ if (collect_vector_info(sc, ci, top, stop_at_print_length))
+ top_cyclic = true;
+ }
+ else
+ {
+ s7_pointer p;
+ for (p = let_slots(top); is_slot(p); p = next_slot(p))
+ if ((has_structure(slot_value(p))) &&
+ (collect_shared_info(sc, ci, slot_value(p), stop_at_print_length)))
+ top_cyclic = true;
+ }
+ break;
+ }
+ if (!top_cyclic)
+ set_shared(top);
+ return(top_cyclic);
}
-static void backchar(char c, s7_pointer pt)
+static shared_info *new_shared_info(s7_scheme *sc)
{
- if (c == '\n')
- port_line_number(pt)--;
-
- if (is_file_port(pt))
- ungetc(c, port_file(pt));
+ 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 = (int *)calloc(ci->size, sizeof(int)); /* finder expects 0 = unseen previously */
+ sc->circle_info = ci;
+ }
else
{
- if (port_position(pt) > 0)
- port_position(pt)--;
+ int 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]);
}
+ ci->top = 0;
+ ci->ref = 0;
+ ci->has_hits = false;
+ return(ci);
}
-int s7_read_char(s7_scheme *sc, s7_pointer port)
-{
- /* needs to be int return value so EOF=-1, but not 255 */
- return(port_read_character(port)(sc, port));
-}
-
-
-int s7_peek_char(s7_scheme *sc, s7_pointer port)
-{
- int c; /* needs to be an int so EOF=-1, but not 255 */
- c = port_read_character(port)(sc, port);
- if (c != EOF)
- backchar(c, port);
- return(c);
-}
-
-
-void s7_write_char(s7_scheme *sc, int c, s7_pointer pt)
+static shared_info *make_shared_info(s7_scheme *sc, s7_pointer top, bool stop_at_print_length)
{
- if (pt != sc->F)
- port_write_character(pt)(sc, c, pt);
-}
-
+ /* for the printer */
+ shared_info *ci;
+ int i, refs;
+ s7_pointer *ci_objs;
+ int *ci_refs;
+ bool no_problem = true, cyclic = false;
+ s7_int k, stop_len;
-static s7_pointer input_port_if_not_loading(s7_scheme *sc)
-{
- s7_pointer port;
- port = sc->input_port;
- if (is_loader_port(port)) /* this flag is turned off by the reader macros, so we aren't in that context */
+ /* check for simple cases first */
+ if (is_pair(top))
{
- int c;
- c = port_read_white_space(port)(sc, port);
- if (c > 0) /* we can get either EOF or NULL at the end */
+ s7_pointer x;
+ x = top;
+ if (stop_at_print_length)
{
- backchar(c, port);
- return(NULL);
+ s7_pointer slow;
+ stop_len = sc->print_length;
+ slow = top;
+ for (k = 0; k < stop_len; k += 2)
+ {
+ if (!is_pair(x))
+ break;
+ if (has_structure(car(x)))
+ {
+ no_problem = false;
+ break;
+ }
+ x = cdr(x);
+ if (!is_pair(x))
+ break;
+ if (has_structure(car(x)))
+ {
+ no_problem = false;
+ break;
+ }
+ x = cdr(x);
+ slow = cdr(slow);
+ if (x == slow)
+ {
+ no_problem = false;
+ break;
+ }
+ }
}
- return(sc->standard_input);
+ else
+ {
+ if (s7_list_length(sc, top) == 0) /* it is circular at the top level (following cdr) */
+ no_problem = false;
+ else
+ {
+ for (; is_pair(x); x = cdr(x))
+ if (has_structure(car(x)))
+ {
+ /* it can help a little in some cases to scan vectors here (and slots):
+ * if no element has structure, it's ok (maybe also hash_table_entries == 0)
+ */
+ no_problem = false;
+ break;
+ }
+ }
+ }
+ if ((no_problem) &&
+ (!is_null(x)) &&
+ (has_structure(x)))
+ no_problem = false;
+
+ if (no_problem)
+ return(NULL);
}
- return(port);
-}
-
-static s7_pointer g_read_char(s7_scheme *sc, s7_pointer args)
-{
- #define H_read_char "(read-char (port (current-input-port))) returns the next character in the input port"
- #define Q_read_char s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_char_symbol, sc->is_eof_object_symbol), sc->is_input_port_symbol)
- s7_pointer port;
-
- if (is_not_null(args))
- port = car(args);
else
{
- port = input_port_if_not_loading(sc);
- if (!port) return(sc->eof_object);
- }
- if (!is_input_port(port))
- method_or_bust_with_type(sc, port, sc->read_char_symbol, args, an_input_port_string, 0);
- return(chars[port_read_character(port)(sc, port)]);
-}
+ if (s7_is_vector(top))
+ {
+ if (!is_normal_vector(top))
+ return(NULL);
+ stop_len = vector_length(top);
+ if ((stop_at_print_length) &&
+ (stop_len > sc->print_length))
+ stop_len = sc->print_length;
-static s7_pointer read_char_0, read_char_1;
-static s7_pointer g_read_char_0(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer port;
- port = input_port_if_not_loading(sc);
- if (port)
- return(chars[port_read_character(port)(sc, port)]);
- return(sc->eof_object);
-}
+ for (k = 0; k < stop_len; k++)
+ if (has_structure(vector_element(top, k)))
+ {
+ no_problem = false;
+ break;
+ }
+ if (no_problem)
+ return(NULL);
+ }
+ }
+ ci = new_shared_info(sc);
-static s7_pointer g_read_char_1(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer port;
- port = car(args);
- if (!is_input_port(port))
- method_or_bust_with_type(sc, port, sc->read_char_symbol, args, an_input_port_string, 0);
- return(chars[port_read_character(port)(sc, port)]);
-}
+ /* collect all pointers associated with top */
+ cyclic = collect_shared_info(sc, ci, top, stop_at_print_length);
-static s7_pointer c_read_char(s7_scheme *sc)
-{
- int c;
- s7_pointer port;
- port = input_port_if_not_loading(sc);
- if (!port) return(sc->eof_object);
- c = port_read_character(port)(sc, port);
- if (c == EOF)
- return(sc->eof_object);
- return(chars[c]);
-}
+ for (i = 0; i < ci->top; i++)
+ {
+ s7_pointer p;
+ p = ci->objs[i];
+ clear_collected_and_shared(p);
+ }
+ if (!cyclic)
+ return(NULL);
-PF_0(read_char, c_read_char)
+ if (!(ci->has_hits))
+ return(NULL);
+ ci_objs = ci->objs;
+ ci_refs = ci->refs;
-static s7_pointer read_char_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
-{
- if (args == 0)
- return(read_char_0);
- if (args == 1)
- return(read_char_1);
- return(f);
+ /* find if any were referenced twice (once for just being there, so twice=shared)
+ * we know there's at least one such reference because has_hits is true.
+ */
+ for (i = 0, refs = 0; i < ci->top; i++)
+ if (ci_refs[i] > 0)
+ {
+ set_collected(ci_objs[i]);
+ if (i == refs)
+ refs++;
+ else
+ {
+ ci_objs[refs] = ci_objs[i];
+ ci_refs[refs++] = ci_refs[i];
+ ci_refs[i] = 0;
+ ci_objs[i] = NULL;
+ }
+ }
+ ci->top = refs;
+ return(ci);
}
+/* -------------------------------- cyclic-sequences -------------------------------- */
-static s7_pointer g_write_char(s7_scheme *sc, s7_pointer args)
+static s7_pointer cyclic_sequences(s7_scheme *sc, s7_pointer obj, bool return_list)
{
- #define H_write_char "(write-char char (port (current-output-port))) writes char to the output port"
- #define Q_write_char s7_make_signature(sc, 3, sc->is_char_symbol, sc->is_char_symbol, sc->is_output_port_symbol)
- s7_pointer port, chr;
-
- chr = car(args);
- if (!s7_is_character(chr))
- method_or_bust(sc, chr, sc->write_char_symbol, args, T_CHARACTER, 1);
-
- if (is_pair(cdr(args)))
- port = cadr(args);
- else port = sc->output_port;
- if (port == sc->F) return(chr);
- if (!is_output_port(port))
- method_or_bust_with_type(sc, port, sc->write_char_symbol, args, an_output_port_string, 2);
+ if (has_structure(obj))
+ {
+ shared_info *ci;
+ ci = make_shared_info(sc, obj, false); /* false=don't stop at print length (vectors etc) */
+ if (ci)
+ {
+ if (return_list)
+ {
+ int i;
+ s7_pointer lst;
+ sc->w = sc->nil;
+ for (i = 0; i < ci->top; i++)
+ sc->w = cons(sc, ci->objs[i], sc->w);
+ lst = sc->w;
+ sc->w = sc->nil;
+ return(lst);
+ }
+ else return(sc->T);
+ }
+ }
+ return(sc->nil);
+}
- port_write_character(port)(sc, s7_character(chr), port);
- return(chr);
+static s7_pointer g_cyclic_sequences(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cyclic_sequences "(cyclic-sequences obj) returns a list of elements that are cyclic."
+ #define Q_cyclic_sequences s7_make_signature(sc, 2, sc->is_proper_list_symbol, sc->T)
+ return(cyclic_sequences(sc, car(args), true));
}
-static s7_pointer c_write_char(s7_scheme *sc, s7_pointer chr)
+static int circular_list_entries(s7_pointer lst)
{
- if (!s7_is_character(chr))
- method_or_bust(sc, chr, sc->write_char_symbol, set_plist_1(sc, chr), T_CHARACTER, 1);
- if (sc->output_port == sc->F) return(chr);
- port_write_character(sc->output_port)(sc, s7_character(chr), sc->output_port);
- return(chr);
+ int i;
+ s7_pointer x;
+ for (i = 1, x = cdr(lst); ; i++, x = cdr(x))
+ {
+ int j;
+ s7_pointer y;
+ for (y = lst, j = 0; j < i; y = cdr(y), j++)
+ if (x == y)
+ return(i);
+ }
}
-static s7_pointer write_char_1;
-static s7_pointer g_write_char_1(s7_scheme *sc, s7_pointer args) {return(c_write_char(sc, car(args)));}
+static void object_to_port_with_circle_check(s7_scheme *sc, s7_pointer vr, s7_pointer port, use_write_t use_write, shared_info *ci);
+/* static void object_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci); */
-PF_TO_PF(write_char, c_write_char)
+static void (*display_functions[256])(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci);
+#define object_to_port(Sc, Obj, Port, Use_Write, Ci) (*display_functions[unchecked_type(Obj)])(Sc, Obj, Port, Use_Write, Ci)
+static s7_pointer object_out(s7_scheme *sc, s7_pointer obj, s7_pointer strport, use_write_t choice);
-static s7_pointer write_char_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static bool string_needs_slashification(const char *str, int len)
{
- if (args == 1)
- return(write_char_1);
- return(f);
+ /* we have to go by len (str len) not *s==0 because s7 strings can have embedded nulls */
+ unsigned char *p, *pend;
+ pend = (unsigned char *)(str + len);
+ for (p = (unsigned char *)str; p < pend; p++)
+ if (slashify_table[*p])
+ return(true);
+ return(false);
}
-/* (with-output-to-string (lambda () (write-char #\space))) -> " "
- * (with-output-to-string (lambda () (write #\space))) -> "#\\space"
- * (with-output-to-string (lambda () (display #\space))) -> " "
- * is this correct? It's what Guile does. write-char is actually display-char.
- */
-
+#define IN_QUOTES true
+#define NOT_IN_QUOTES false
-static s7_pointer g_peek_char(s7_scheme *sc, s7_pointer args)
+static char *slashify_string(s7_scheme *sc, const char *p, int len, bool quoted, int *nlen) /* do not free result */
{
- #define H_peek_char "(peek-char (port (current-input-port))) returns the next character in the input port, but does not remove it from the input stream"
- #define Q_peek_char s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_char_symbol, sc->is_eof_object_symbol), sc->is_input_port_symbol)
- s7_pointer port;
+ int j = 0, cur_size, size;
+ char *s;
+ unsigned char *pcur, *pend;
- if (is_not_null(args))
- port = car(args);
- else port = sc->input_port;
+ pend = (unsigned char *)(p + len);
+ size = len + 256;
+ if (size > sc->slash_str_size)
+ {
+ if (sc->slash_str) free(sc->slash_str);
+ sc->slash_str_size = size;
+ sc->slash_str = (char *)malloc(size);
+ }
+ else size = sc->slash_str_size;
+ cur_size = size - 2;
- if (!is_input_port(port))
- method_or_bust_with_type(sc, port, sc->peek_char_symbol, args, an_input_port_string, 0);
- if (port_is_closed(port))
- return(simple_wrong_type_argument_with_type(sc, sc->peek_char_symbol, port, an_open_port_string));
+ /* memset((void *)sc->slash_str, 0, size); */
+ s = sc->slash_str;
- if (is_function_port(port))
- return((*(port_input_function(port)))(sc, S7_PEEK_CHAR, port));
- return(chars[s7_peek_char(sc, port)]);
-}
+ if (quoted) s[j++] = '"';
-static s7_pointer c_peek_char(s7_scheme *sc) {return(chars[s7_peek_char(sc, sc->input_port)]);}
-PF_0(peek_char, c_peek_char)
+ /* what about the trailing nulls? Guile writes them out (as does s7 currently)
+ * but that is not ideal. I'd like to use ~S for error messages, so that
+ * strings are clearly identified via the double-quotes, but this way of
+ * writing them is ugly:
+ *
+ * :(let ((str (make-string 8 #\null))) (set! (str 0) #\a) str)
+ * "a\x00\x00\x00\x00\x00\x00\x00"
+ *
+ * but it would be misleading to omit them because:
+ *
+ * :(let ((str (make-string 8 #\null))) (set! (str 0) #\a) (string-append str "bc"))
+ * "a\x00\x00\x00\x00\x00\x00\x00bc"
+ */
+ for (pcur = (unsigned char *)p; pcur < pend; pcur++)
+ {
+ if (slashify_table[*pcur])
+ {
+ s[j++] = '\\';
+ switch (*pcur)
+ {
+ case '"':
+ s[j++] = '"';
+ break;
-static s7_pointer g_read_byte(s7_scheme *sc, s7_pointer args)
-{
- #define H_read_byte "(read-byte (port (current-input-port))): reads a byte from the input port"
- #define Q_read_byte s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_eof_object_symbol), sc->is_input_port_symbol)
- s7_pointer port;
- int c;
+ case '\\':
+ s[j++] = '\\';
+ break;
- if (is_not_null(args))
- port = car(args);
- else
- {
- port = input_port_if_not_loading(sc);
- if (!port) return(sc->eof_object);
+ default: /* this is the "\x01" stuff */
+ {
+ unsigned int n;
+ static char dignum[] = "0123456789abcdef";
+ s[j++] = 'x';
+ n = (unsigned int)(*pcur);
+ if (n < 16)
+ s[j++] = '0';
+ else s[j++] = dignum[(n / 16) % 16];
+ s[j++] = dignum[n % 16];
+ }
+ break;
+ }
+ }
+ else s[j++] = *pcur;
+ if (j >= cur_size) /* even with 256 extra, we can overflow (for example, inordinately many tabs in ALSA output) */
+ {
+ /* int k; */
+ size *= 2;
+ sc->slash_str = (char *)realloc(sc->slash_str, size * sizeof(char));
+ sc->slash_str_size = size;
+ cur_size = size - 2;
+ s = sc->slash_str;
+ /* for (k = j; k < size; k++) s[k] = 0; */
+ }
}
- if (!is_input_port(port))
- method_or_bust_with_type(sc, port, sc->read_byte_symbol, args, an_input_port_string, 0);
-
- c = port_read_character(port)(sc, port);
- if (c == EOF)
- return(sc->eof_object);
- return(small_int(c));
+ if (quoted) s[j++] = '"';
+ s[j] = '\0';
+ (*nlen) = j;
+ return(s);
}
-static s7_pointer c_read_byte(s7_scheme *sc)
+static void output_port_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
{
- int c;
- s7_pointer port;
- port = input_port_if_not_loading(sc);
- if (!port) return(sc->eof_object);
- c = port_read_character(port)(sc, port);
- if (c == EOF)
- return(sc->eof_object);
- return(small_int(c));
+ if ((obj == sc->standard_output) ||
+ (obj == sc->standard_error))
+ port_write_string(port)(sc, port_filename(obj), port_filename_length(obj), port);
+ else
+ {
+ int nlen;
+ if (use_write == USE_READABLE_WRITE)
+ {
+ if (port_is_closed(obj))
+ port_write_string(port)(sc, "(let ((p (open-output-string))) (close-output-port p) p)", 56, port);
+ else
+ {
+ char *str;
+ if (is_string_port(obj))
+ {
+ port_write_string(port)(sc, "(let ((p (open-output-string)))", 31, port);
+ if (port_position(obj) > 0)
+ {
+ port_write_string(port)(sc, " (display ", 10, port);
+ str = slashify_string(sc, (const char *)port_data(obj), port_position(obj), IN_QUOTES, &nlen);
+ port_write_string(port)(sc, str, nlen, port);
+ port_write_string(port)(sc, " p)", 3, port);
+ }
+ port_write_string(port)(sc, " p)", 3, port);
+ }
+ else
+ {
+ str = (char *)malloc(256 * sizeof(char));
+ nlen = snprintf(str, 256, "(open-output-file \"%s\" \"a\")", port_filename(obj));
+ port_write_string(port)(sc, str, nlen, port);
+ free(str);
+ }
+ }
+ }
+ else
+ {
+ if (is_string_port(obj))
+ port_write_string(port)(sc, "<output-string-port", 19, port);
+ else
+ {
+ if (is_file_port(obj))
+ port_write_string(port)(sc, "<output-file-port", 17, port);
+ else port_write_string(port)(sc, "<output-function-port", 21, port);
+ }
+ if (port_is_closed(obj))
+ port_write_string(port)(sc, " (closed)>", 10, port);
+ else port_write_character(port)(sc, '>', port);
+ }
+ }
}
-PF_0(read_byte, c_read_byte)
-
-
-static s7_pointer g_write_byte(s7_scheme *sc, s7_pointer args)
+static void input_port_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
{
- #define H_write_byte "(write-byte byte (port (current-output-port))): writes byte to the output port"
- #define Q_write_byte s7_make_signature(sc, 3, sc->is_integer_symbol, sc->is_integer_symbol, sc->is_output_port_symbol)
- s7_pointer port, b;
- s7_int val;
-
- b = car(args);
- if (!s7_is_integer(b))
- method_or_bust(sc, car(args), sc->write_byte_symbol, args, T_INTEGER, 1);
-
- val = s7_integer(b);
- if ((val < 0) || (val > 255)) /* need to check this before port==#f, else (write-byte most-positive-fixnum #f) is not an error */
- return(wrong_type_argument_with_type(sc, sc->write_byte_symbol, 1, b, an_unsigned_byte_string));
-
- if (is_pair(cdr(args)))
- port = cadr(args);
- else port = sc->output_port;
-
- if (!is_output_port(port))
+ if (obj == sc->standard_input)
+ port_write_string(port)(sc, port_filename(obj), port_filename_length(obj), port);
+ else
{
- if (port == sc->F) return(car(args));
- method_or_bust_with_type(sc, port, sc->write_byte_symbol, args, an_output_port_string, 0);
+ int nlen = 0;
+ if (use_write == USE_READABLE_WRITE)
+ {
+ if (port_is_closed(obj))
+ port_write_string(port)(sc, "(call-with-input-string \"\" (lambda (p) p))", 42, port);
+ else
+ {
+ if (is_function_port(obj))
+ port_write_string(port)(sc, "#<function input port>", 22, port);
+ else
+ {
+ char *str;
+ if (is_file_port(obj))
+ {
+ str = (char *)malloc(256 * sizeof(char));
+ nlen = snprintf(str, 256, "(open-input-file \"%s\")", port_filename(obj));
+ port_write_string(port)(sc, str, nlen, port);
+ free(str);
+ }
+ else
+ {
+ /* if the string is large, slashify_string is a problem. Usually this is actually
+ * a file port where the contents were read in one (up to 5MB) gulp, so the
+ * readable version could be: open file, read-char to the current port_position.
+ * s7_port_filename(port) has the char* name if any.
+ */
+ int data_len;
+ data_len = port_data_size(obj) - port_position(obj);
+ if (data_len > 100)
+ {
+ const char *filename;
+ filename = (const char *)s7_port_filename(obj);
+ if (filename)
+ {
+ #define DO_STR_LEN 1024
+ char *do_str;
+ int len;
+ do_str = (char *)malloc(DO_STR_LEN * sizeof(char));
+ if (port_position(obj) > 0)
+ {
+ len = snprintf(do_str, DO_STR_LEN, "(let ((port (open-input-file \"%s\")))", filename);
+ port_write_string(port)(sc, do_str, len, port);
+ len = snprintf(do_str, DO_STR_LEN, " (do ((i 0 (+ i 1)) (c (read-char port) (read-char port))) ((= i %u) port)))",
+ port_position(obj) - 1);
+ }
+ else len = snprintf(do_str, DO_STR_LEN, "(open-input-file \"%s\")", filename);
+ port_write_string(port)(sc, do_str, len, port);
+ free(do_str);
+ return;
+ }
+ }
+ port_write_string(port)(sc, "(open-input-string ", 19, port);
+ /* not port_write_string here because there might be embedded double-quotes */
+ str = slashify_string(sc, (const char *)(port_data(obj) + port_position(obj)), port_data_size(obj) - port_position(obj), IN_QUOTES, &nlen);
+ port_write_string(port)(sc, str, nlen, port);
+ port_write_character(port)(sc, ')', port);
+ }
+ }
+ }
+ }
+ else
+ {
+ if (is_string_port(obj))
+ port_write_string(port)(sc, "<input-string-port", 18, port);
+ else
+ {
+ if (is_file_port(obj))
+ port_write_string(port)(sc, "<input-file-port", 16, port);
+ else port_write_string(port)(sc, "<input-function-port", 20, port);
+ }
+ if (port_is_closed(obj))
+ port_write_string(port)(sc, " (closed)>", 10, port);
+ else port_write_character(port)(sc, '>', port);
+ }
}
-
- s7_write_char(sc, (int)(s7_integer(b)), port);
- return(b);
}
-static s7_int c_write_byte(s7_scheme *sc, s7_int x)
+static bool symbol_needs_slashification(s7_pointer obj)
{
- if ((x < 0) || (x > 255))
- wrong_type_argument_with_type(sc, sc->write_byte_symbol, 1, make_integer(sc, x), an_unsigned_byte_string);
- s7_write_char(sc, (int)x, sc->output_port);
- return(x);
+ unsigned char *p, *pend;
+ const char *str;
+ int len;
+ str = symbol_name(obj);
+ if (str[0] == '#')
+ return(true);
+ len = symbol_name_length(obj);
+ pend = (unsigned char *)(str + len);
+ for (p = (unsigned char *)str; p < pend; p++)
+ if (symbol_slashify_table[*p])
+ return(true);
+ set_clean_symbol(obj);
+ return(false);
}
-IF_TO_IF(write_byte, c_write_byte)
-
-
-static s7_pointer g_read_line(s7_scheme *sc, s7_pointer args)
+static void symbol_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
{
- #define H_read_line "(read-line port (with-eol #f)) returns the next line from port, or #<eof>.\
-If 'with-eol' is not #f, read-line includes the trailing end-of-line character."
- #define Q_read_line s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_eof_object_symbol), sc->is_input_port_symbol, sc->is_boolean_symbol)
-
- s7_pointer port;
- bool with_eol = false;
-
- if (is_not_null(args))
+ /* I think this is the only place we print a symbol's name
+ * but in the readable case, what about (symbol "1;3")? it actually seems ok!
+ */
+ if ((!is_clean_symbol(obj)) &&
+ (symbol_needs_slashification(obj)))
{
- port = car(args);
- if (!is_input_port(port))
- method_or_bust_with_type(sc, port, sc->read_line_symbol, args, an_input_port_string, 1);
-
- if (is_not_null(cdr(args)))
- with_eol = (cadr(args) != sc->F);
+ int nlen = 0;
+ char *str, *symstr;
+ str = slashify_string(sc, symbol_name(obj), symbol_name_length(obj), NOT_IN_QUOTES, &nlen);
+ nlen += 16;
+ tmpbuf_malloc(symstr, nlen);
+ nlen = snprintf(symstr, nlen, "(symbol \"%s\")", str);
+ port_write_string(port)(sc, symstr, nlen, port);
+ tmpbuf_free(symstr, nlen);
}
else
{
- port = input_port_if_not_loading(sc);
- if (!port) return(sc->eof_object);
+ if ((use_write == USE_READABLE_WRITE) &&
+ (!is_keyword(obj)))
+ port_write_character(port)(sc, '\'', port);
+ if (is_string_port(port))
+ {
+ unsigned int new_len;
+ new_len = port_position(port) + symbol_name_length(obj);
+ if (new_len >= port_data_size(port))
+ resize_port_data(port, new_len * 2);
+ memcpy((void *)(port_data(port) + port_position(port)), (void *)symbol_name(obj), symbol_name_length(obj));
+ port_position(port) = new_len;
+ }
+ else port_write_string(port)(sc, symbol_name(obj), symbol_name_length(obj), port);
}
- return(port_read_line(port)(sc, port, with_eol, true));
-}
-
-static s7_pointer c_read_line(s7_scheme *sc) {return(g_read_line(sc, sc->nil));}
-PF_0(read_line, c_read_line)
-
-
-static s7_pointer read_line_uncopied;
-static s7_pointer g_read_line_uncopied(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer port;
- bool with_eol = false;
- port = car(args);
- if (!is_input_port(port))
- return(g_read_line(sc, args));
- if (is_not_null(cdr(args)))
- with_eol = (cadr(args) != sc->F);
- return(port_read_line(port)(sc, port, with_eol, false));
}
-
-static s7_pointer c_read_string(s7_scheme *sc, s7_int chars, s7_pointer port)
+static void string_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write)
{
- s7_pointer s;
- s7_int i;
- unsigned char *str;
-
- if (chars < 0)
- return(wrong_type_argument_with_type(sc, sc->read_string_symbol, 1, make_integer(sc, chars), a_non_negative_integer_string));
- if (chars > sc->max_string_length)
- return(out_of_range(sc, sc->read_string_symbol, small_int(1), make_integer(sc, chars), its_too_large_string));
-
- if (!port) return(sc->eof_object);
- if (!is_input_port(port))
- method_or_bust_with_type(sc, port, sc->read_string_symbol, list_2(sc, make_integer(sc, chars), port), an_input_port_string, 2);
-
- if (chars == 0)
- return(make_empty_string(sc, 0, 0));
-
- s = make_empty_string(sc, chars, 0);
- str = (unsigned char *)string_value(s);
- for (i = 0; i < chars; i++)
+ if (string_length(obj) > 0)
{
- int c;
- c = port_read_character(port)(sc, port);
- if (c == EOF)
+ /* since string_length is a scheme length, not C, this write can embed nulls from C's point of view */
+ if (string_length(obj) > 10000)
{
- if (i == 0)
- return(sc->eof_object);
- string_length(s) = i;
- return(s);
+ size_t size;
+ char buf[128];
+ buf[0] = string_value(obj)[0];
+ buf[1] = '\0';
+ size = strspn((const char *)(string_value(obj) + 1), buf); /* if all #\null, this won't work */
+ if (size == string_length(obj) - 1)
+ {
+ int nlen;
+ s7_pointer c;
+ c = chars[(int)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);
+ port_write_character(port)(sc, ')', port);
+ return;
+ }
+ }
+ if (use_write == USE_DISPLAY)
+ port_write_string(port)(sc, string_value(obj), string_length(obj), port);
+ else
+ {
+ if (!string_needs_slashification(string_value(obj), string_length(obj)))
+ {
+ port_write_character(port)(sc, '"', port);
+ port_write_string(port)(sc, string_value(obj), string_length(obj), port);
+ port_write_character(port)(sc, '"', port);
+ }
+ else
+ {
+ char *str;
+ int nlen = 0;
+ str = slashify_string(sc, string_value(obj), string_length(obj), IN_QUOTES, &nlen);
+ port_write_string(port)(sc, str, nlen, port);
+ }
}
- str[i] = (unsigned char)c;
}
- return(s);
+ else
+ {
+ if (use_write != USE_DISPLAY)
+ port_write_string(port)(sc, "\"\"", 2, port);
+ }
}
-static s7_pointer g_read_string(s7_scheme *sc, s7_pointer args)
+
+static char *multivector_indices_to_string(s7_scheme *sc, s7_int index, s7_pointer vect, char *str, int cur_dim)
{
- /* read-chars would be a better name -- read-string could mean CL-style read-from-string (like eval-string)
- * similarly read-bytes could return a byte-vector (rather than r7rs's read-bytevector)
- * and write-string -> write-chars, write-bytevector -> write-bytes
- */
- #define H_read_string "(read-string k port) reads k characters from port into a new string and returns it."
- #define Q_read_string s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_eof_object_symbol), sc->is_integer_symbol, sc->is_input_port_symbol)
- s7_pointer k, port;
+ s7_int size, ind;
+ char buf[64];
- k = car(args);
- if (!s7_is_integer(k))
- method_or_bust(sc, k, sc->read_string_symbol, args, T_INTEGER, 1);
+ size = vector_dimension(vect, cur_dim);
+ ind = index % size;
+ if (cur_dim > 0)
+ multivector_indices_to_string(sc, (index - ind) / size, vect, str, cur_dim - 1);
- if (!is_null(cdr(args)))
- port = cadr(args);
- else port = input_port_if_not_loading(sc); /* port checked (for NULL) in c_read_string */
- return(c_read_string(sc, s7_integer(k), port));
+ snprintf(buf, 64, " %" LL_D, ind);
+#ifdef __OpenBSD__
+ strlcat(str, buf, 128); /* 128=length of str */
+#else
+ strcat(str, buf);
+#endif
+ return(str);
}
-static s7_pointer c_read_string_1(s7_scheme *sc, s7_int chars) {return(c_read_string(sc, chars, input_port_if_not_loading(sc)));}
-IF_TO_PF(read_string, c_read_string_1)
-
-#define declare_jump_info() bool old_longjmp; int old_jump_loc, jump_loc; jmp_buf old_goto_start
-
-#define store_jump_info(Sc) \
- do { \
- old_longjmp = Sc->longjmp_ok; \
- old_jump_loc = Sc->setjmp_loc; \
- memcpy((void *)old_goto_start, (void *)(Sc->goto_start), sizeof(jmp_buf));\
- } while (0)
-
-#define restore_jump_info(Sc) \
- do { \
- Sc->longjmp_ok = old_longjmp; \
- Sc->setjmp_loc = old_jump_loc; \
- memcpy((void *)(Sc->goto_start), (void *)old_goto_start, sizeof(jmp_buf));\
- if ((jump_loc == ERROR_JUMP) &&\
- (sc->longjmp_ok))\
- longjmp(sc->goto_start, ERROR_JUMP);\
- } while (0)
-
-#define set_jump_info(Sc, Tag) \
- do { \
- sc->longjmp_ok = true; \
- sc->setjmp_loc = Tag; \
- jump_loc = setjmp(sc->goto_start); \
- } while (0)
-
-s7_pointer s7_read(s7_scheme *sc, s7_pointer port)
+static int multivector_to_port(s7_scheme *sc, s7_pointer vec, s7_pointer port,
+ int out_len, int flat_ref, int dimension, int dimensions, bool *last,
+ use_write_t use_write, shared_info *ci)
{
- if (is_input_port(port))
- {
- s7_pointer old_envir;
- declare_jump_info();
+ int i;
- old_envir = sc->envir;
- sc->envir = sc->nil;
- push_input_port(sc, port);
+ if (use_write != USE_READABLE_WRITE)
+ {
+ if (*last)
+ port_write_string(port)(sc, " (", 2, port);
+ else port_write_character(port)(sc, '(', port);
+ (*last) = false;
+ }
- store_jump_info(sc);
- set_jump_info(sc, READ_SET_JUMP);
- if (jump_loc != NO_JUMP)
+ for (i = 0; i < vector_dimension(vec, dimension); i++)
+ {
+ if (dimension == (dimensions - 1))
{
- if (jump_loc != ERROR_JUMP)
- eval(sc, sc->op);
+ if (flat_ref < out_len)
+ {
+ if (use_write == USE_READABLE_WRITE)
+ {
+ int plen;
+ char buf[128];
+ char *indices;
+ /* need to translate flat_ref into a set of indices
+ */
+ tmpbuf_calloc(indices, 128);
+ plen = snprintf(buf, 128, "(set! ({v}%s) ", multivector_indices_to_string(sc, flat_ref, vec, indices, dimension));
+ port_write_string(port)(sc, buf, plen, port);
+ tmpbuf_free(indices, 128);
+ }
+ object_to_port_with_circle_check(sc, vector_getter(vec)(sc, vec, flat_ref), port, DONT_USE_DISPLAY(use_write), ci);
+
+ if (use_write == USE_READABLE_WRITE)
+ port_write_string(port)(sc, ") ", 2, port);
+ flat_ref++;
+ }
+ else
+ {
+ port_write_string(port)(sc, "...)", 4, port);
+ return(flat_ref);
+ }
+ if ((use_write != USE_READABLE_WRITE) &&
+ (i < (vector_dimension(vec, dimension) - 1)))
+ port_write_character(port)(sc, ' ', port);
}
- else
+ else
{
- push_stack(sc, OP_BARRIER, port, sc->nil);
- push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
-
- eval(sc, OP_READ_INTERNAL);
-
- if (sc->tok == TOKEN_EOF)
- sc->value = sc->eof_object;
-
- if ((sc->op == OP_EVAL_DONE) &&
- (stack_op(sc->stack, s7_stack_top(sc) - 1) == OP_BARRIER))
- pop_stack(sc);
+ if (flat_ref < out_len)
+ flat_ref = multivector_to_port(sc, vec, port, out_len, flat_ref, dimension + 1, dimensions, last, DONT_USE_DISPLAY(use_write), ci);
+ else
+ {
+ port_write_string(port)(sc, "...)", 4, port);
+ return(flat_ref);
+ }
}
- pop_input_port(sc);
- sc->envir = old_envir;
-
- restore_jump_info(sc);
- return(sc->value);
}
- return(simple_wrong_type_argument_with_type(sc, sc->read_symbol, port, an_input_port_string));
+ if (use_write != USE_READABLE_WRITE)
+ port_write_character(port)(sc, ')', port);
+ (*last) = true;
+ return(flat_ref);
}
-static s7_pointer g_read(s7_scheme *sc, s7_pointer args)
+static void make_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port)
{
- /* would it be useful to add an environment arg here? (just set sc->envir at the end?)
- * except for expansions, nothing is evaluated at read time, unless...
- * say we set up a dot reader:
- * (set! *#readers* (cons (cons #\. (lambda (str) (if (string=? str ".") (eval (read)) #f))) *#readers*))
- * then
- * (call-with-input-string "(+ 1 #.(+ 1 hiho))" (lambda (p) (read p)))
- * evaluates hiho in the rootlet, but how to pass the env to the inner eval or read?
- * (eval, eval-string and load already have an env arg)
- */
- #define H_read "(read (port (current-input-port))) returns the next object in the input port, or #<eof> at the end"
- #define Q_read s7_make_signature(sc, 2, sc->T, sc->is_input_port_symbol)
- s7_pointer port;
+ s7_int vlen;
+ int plen;
+ char buf[128];
+ const char* vtyp = "";
- if (is_not_null(args))
- port = car(args);
+ if (is_float_vector(vect))
+ vtyp = "float-";
else
{
- port = input_port_if_not_loading(sc);
- if (!port) return(sc->eof_object);
+ if (is_int_vector(vect))
+ vtyp = "int-";
}
- if (!is_input_port(port))
- method_or_bust_with_type(sc, port, sc->read_symbol, args, an_input_port_string, 0);
-
- if (is_function_port(port))
- return((*(port_input_function(port)))(sc, S7_READ, port));
-
- if ((is_string_port(port)) &&
- (port_data_size(port) <= port_position(port)))
- 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);
-
- return(port);
-}
-
-static s7_pointer c_read(s7_scheme *sc) {return(g_read(sc, sc->nil));}
-PF_0(read, c_read)
-
-
-/* -------------------------------- load -------------------------------- */
-
-static FILE *search_load_path(s7_scheme *sc, const char *name)
-{
- int i, len;
- s7_pointer lst;
-
- lst = s7_load_path(sc);
- len = s7_list_length(sc, lst);
- for (i = 0; i < len; i++)
+ vlen = vector_length(vect);
+ if (vector_rank(vect) == 1)
{
- const char *new_dir;
- new_dir = string_value(s7_list_ref(sc, lst, i));
- if (new_dir)
+ plen = snprintf(buf, 128, "(make-%svector %" LL_D " ", vtyp, vlen);
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ else
+ {
+ unsigned int dim;
+ plen = snprintf(buf, 128, "(make-%svector '(", vtyp);
+ port_write_string(port)(sc, buf, plen, port);
+ for (dim = 0; dim < vector_ndims(vect) - 1; dim++)
{
- FILE *fp;
- snprintf(sc->tmpbuf, TMPBUF_SIZE, "%s/%s", new_dir, name);
- fp = fopen(sc->tmpbuf, "r");
- if (fp) return(fp);
+ plen = snprintf(buf, 128, "%" LL_D " ", vector_dimension(vect, dim));
+ port_write_string(port)(sc, buf, plen, port);
}
+ plen = snprintf(buf, 128, "%" LL_D ") ", vector_dimension(vect, dim));
+ port_write_string(port)(sc, buf, plen, port);
}
- return(NULL);
}
-
-
-s7_pointer s7_load_with_environment(s7_scheme *sc, const char *filename, s7_pointer e)
+
+static void vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_write_t use_write, shared_info *ci)
{
- s7_pointer port;
- FILE *fp;
- char *new_filename = NULL;
- declare_jump_info();
+ s7_int i, len;
+ int plen;
+ bool too_long = false;
+ char buf[128];
- fp = fopen(filename, "r");
- if (!fp)
+ len = vector_length(vect);
+ if (len == 0)
{
- fp = search_load_path(sc, filename);
- if (fp)
- new_filename = copy_string(sc->tmpbuf); /* (require libc.scm) for example needs the directory for cload in some cases */
+ if (vector_rank(vect) > 1)
+ {
+ plen = snprintf(buf, 32, "#%uD()", vector_ndims(vect));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ else port_write_string(port)(sc, "#()", 3, port);
+ return;
}
- if (!fp)
- return(file_error(sc, "load", "can't open", filename));
-
- if (hook_has_functions(sc->load_hook))
- s7_call(sc, sc->load_hook, list_1(sc, sc->temp4 = s7_make_string(sc, filename)));
-
- port = read_file(sc, fp, (new_filename) ? (const char *)new_filename : filename, -1, "load"); /* -1 means always read its contents into a local string */
- port_file_number(port) = remember_file_name(sc, filename);
- if (new_filename) free(new_filename);
- set_loader_port(port);
- push_input_port(sc, port);
- /* it's possible to call this recursively (s7_load is Xen_load_file which can be invoked via s7_call)
- * but in that case, we actually want it to behave like g_load and continue the evaluation upon completion
- */
- sc->envir = e;
- push_stack(sc, OP_LOAD_RETURN_IF_EOF, port, sc->code);
+ if (use_write != USE_READABLE_WRITE)
+ {
+ if (sc->print_length <= 0)
+ {
+ if (vector_rank(vect) > 1)
+ {
+ plen = snprintf(buf, 32, "#%uD(...)", vector_ndims(vect));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ else port_write_string(port)(sc, "#(...)", 6, port);
+ return;
+ }
- store_jump_info(sc);
- set_jump_info(sc, LOAD_SET_JUMP);
- if (jump_loc != NO_JUMP)
+ if (len > sc->print_length)
+ {
+ too_long = true;
+ len = sc->print_length;
+ }
+ }
+ if ((!ci) &&
+ (len > 1000))
{
- if (jump_loc != ERROR_JUMP)
- eval(sc, sc->op);
+ s7_int vlen;
+ s7_pointer p0;
+ s7_pointer *els;
+ vlen = vector_length(vect);
+ els = vector_elements(vect);
+ p0 = els[0];
+ for (i = 1; i < vlen; i++)
+ if (els[i] != p0)
+ break;
+ if (i == vlen)
+ {
+ make_vector_to_port(sc, vect, port);
+ object_to_port(sc, p0, port, use_write, NULL);
+ port_write_character(port)(sc, ')', port);
+ }
+ return;
}
- else eval(sc, OP_READ_INTERNAL);
- pop_input_port(sc);
- if (is_input_port(port))
- s7_close_input_port(sc, port);
+ if (use_write == USE_READABLE_WRITE)
+ {
+ if ((ci) &&
+ (is_collected(vect)) &&
+ (peek_shared_ref(ci, vect) != 0))
+ {
+ port_write_string(port)(sc, "(let (({v} (make-vector ", 24, port);
+ if (vector_rank(vect) > 1)
+ {
+ unsigned int dim;
+ port_write_string(port)(sc, "'(", 2, port);
+ for (dim = 0; dim < vector_ndims(vect); dim++)
+ {
+ plen = snprintf(buf, 128, "%" LL_D " ", vector_dimension(vect, dim));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ port_write_string(port)(sc, ")))) ", 5, port);
+ }
+ else
+ {
+ plen = snprintf(buf, 128, "%" LL_D"))) ", vector_length(vect));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ if (shared_ref(ci, vect) < 0)
+ {
+ plen = snprintf(buf, 128, "(set! {%d} {v}) ", -shared_ref(ci, vect));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+
+ if (vector_rank(vect) > 1)
+ {
+ bool last = false;
+ multivector_to_port(sc, vect, port, len, 0, 0, vector_ndims(vect), &last, use_write, ci);
+ }
+ else
+ {
+ for (i = 0; i < len; i++)
+ {
+ port_write_string(port)(sc, "(set! ({v} ", 11, port);
+ plen = snprintf(buf, 128, "%" LL_D ") ", i);
+ port_write_string(port)(sc, buf, plen, port);
+ object_to_port_with_circle_check(sc, vector_element(vect, i), port, use_write, ci);
+ port_write_string(port)(sc, ") ", 2, port);
+ }
+ }
+ port_write_string(port)(sc, "{v})", 4, port);
+ }
+ else /* simple readable case */
+ {
+ if (vector_rank(vect) > 1)
+ port_write_string(port)(sc, "(make-shared-vector (vector", 27, port);
+ else port_write_string(port)(sc, "(vector", 7, port);
- restore_jump_info(sc);
- if (is_multiple_value(sc->value))
- sc->value = splice_in_values(sc, multiple_value(sc->value));
- return(sc->value);
-}
+ for (i = 0; i < len; i++)
+ {
+ port_write_character(port)(sc, ' ', port);
+ object_to_port_with_circle_check(sc, vector_element(vect, i), port, use_write, ci);
+ }
+ port_write_character(port)(sc, ')', port);
+ if (vector_rank(vect) > 1)
+ {
+ unsigned int dim;
+ port_write_string(port)(sc, " '(", 3, port);
+ for (dim = 0; dim < vector_ndims(vect) - 1; dim++)
+ {
+ plen = snprintf(buf, 128, "%" LL_D " ", vector_dimension(vect, dim));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ plen = snprintf(buf, 128, "%" LL_D, vector_dimension(vect, dim));
+ port_write_string(port)(sc, buf, plen, port);
+ port_write_string(port)(sc, "))", 2, port);
+ }
+ }
+ }
+ else
+ {
+ if (vector_rank(vect) > 1)
+ {
+ bool last = false;
+ if (vector_ndims(vect) > 1)
+ {
+ plen = snprintf(buf, 32, "#%uD", vector_ndims(vect));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ else port_write_character(port)(sc, '#', port);
+ multivector_to_port(sc, vect, port, len, 0, 0, vector_ndims(vect), &last, use_write, ci);
+ }
+ else
+ {
+ port_write_string(port)(sc, "#(", 2, port);
+ for (i = 0; i < len - 1; i++)
+ {
+ object_to_port_with_circle_check(sc, vector_element(vect, i), port, DONT_USE_DISPLAY(use_write), ci);
+ port_write_character(port)(sc, ' ', port);
+ }
+ object_to_port_with_circle_check(sc, vector_element(vect, i), port, DONT_USE_DISPLAY(use_write), ci);
-s7_pointer s7_load(s7_scheme *sc, const char *filename)
-{
- return(s7_load_with_environment(sc, filename, sc->nil));
+ if (too_long)
+ port_write_string(port)(sc, " ...)", 5, port);
+ else port_write_character(port)(sc, ')', port);
+ }
+ }
}
-#if WITH_C_LOADER
-#include <dlfcn.h>
-
-static char *full_filename(const char *filename)
+static void int_or_float_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_write_t use_write, shared_info *ignored)
{
- int len;
- char *pwd, *rtn;
- pwd = getcwd(NULL, 0); /* docs say this means it will return a new string of the right size */
- len = safe_strlen(pwd) + safe_strlen(filename) + 8;
- rtn = (char *)malloc(len * sizeof(char));
- if (pwd)
+ s7_int i, len;
+ int plen;
+ bool too_long = false;
+ char buf[128];
+
+ len = vector_length(vect);
+ if (len == 0)
{
- snprintf(rtn, len, "%s/%s", pwd, filename);
- free(pwd);
+ if (vector_rank(vect) > 1)
+ {
+ plen = snprintf(buf, 32, "#%c%uD()", (is_int_vector(vect)) ? 'i' : 'r', vector_ndims(vect));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ else port_write_string(port)(sc, "#()", 3, port);
+ return;
}
- else snprintf(rtn, len, "%s", filename);
- return(rtn);
-}
-#endif
+ if (use_write == USE_READABLE_WRITE)
+ plen = len;
+ else plen = sc->print_length;
-static s7_pointer g_load(s7_scheme *sc, s7_pointer args)
-{
- #define H_load "(load file (env (rootlet))) loads the scheme file 'file'. The 'env' argument \
-defaults to the rootlet. To load into the current environment instead, pass (curlet)."
- #define Q_load s7_make_signature(sc, 3, sc->values_symbol, sc->is_string_symbol, sc->is_let_symbol)
+ if (plen <= 0)
+ {
+ if (vector_rank(vect) > 1)
+ {
+ plen = snprintf(buf, 32, "#%c%uD(...)", (is_int_vector(vect)) ? 'i' : 'r', vector_ndims(vect));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ else
+ {
+ if (is_int_vector(vect))
+ port_write_string(port)(sc, "#i(...)", 7, port);
+ else port_write_string(port)(sc, "#r(...)", 7, port);
+ }
+ return;
+ }
- FILE *fp = NULL;
- s7_pointer name, port;
- const char *fname;
+ if (len > plen)
+ {
+ too_long = true;
+ len = plen;
+ }
- name = car(args);
- if (!is_string(name))
- method_or_bust(sc, name, sc->load_symbol, args, T_STRING, 1);
-
- if (is_not_null(cdr(args)))
+ if (len > 1000)
{
- s7_pointer e;
- e = cadr(args);
- if (!is_let(e))
- return(wrong_type_argument_with_type(sc, sc->load_symbol, 2, e, a_let_string));
- if (e == sc->rootlet)
- sc->envir = sc->nil;
- else sc->envir = e;
+ s7_int vlen;
+ vlen = vector_length(vect);
+ if (is_float_vector(vect))
+ {
+ s7_double first;
+ s7_double *els;
+ els = float_vector_elements(vect);
+ first = els[0];
+ for (i = 1; i < vlen; i++)
+ if (els[i] != first)
+ break;
+ }
+ else
+ {
+ s7_int first;
+ s7_int *els;
+ els = int_vector_elements(vect);
+ first = els[0];
+ for (i = 1; i < vlen; i++)
+ if (els[i] != first)
+ break;
+ }
+ if (i == vlen)
+ {
+ make_vector_to_port(sc, vect, port);
+ if (is_float_vector(vect))
+ plen = snprintf(buf, 128, float_format_g, float_format_precision, float_vector_element(vect, 0));
+ else plen = snprintf(buf, 128, "%" LL_D, int_vector_element(vect, 0));
+ port_write_string(port)(sc, buf, plen, port);
+ port_write_character(port)(sc, ')', port);
+ }
+ return;
}
- else sc->envir = sc->nil;
-
- fname = string_value(name);
- if ((!fname) || (!(*fname))) /* fopen("", "r") returns a file pointer?? */
- return(s7_error(sc, sc->out_of_range_symbol, set_elist_2(sc, make_string_wrapper(sc, "load's first argument, ~S, should be a filename"), name)));
-
- if (is_directory(fname))
- return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "load argument, ~S, is a directory"), name)));
-
-#if WITH_C_LOADER
- /* if fname ends in .so, try loading it as a c shared object
- * (load "/home/bil/cl/m_j0.so" (inlet (cons 'init_func 'init_m_j0)))
- */
- {
- int fname_len;
-
- fname_len = safe_strlen(fname);
- if ((fname_len > 3) &&
- (is_pair(cdr(args))) &&
- (local_strcmp((const char *)(fname + (fname_len - 3)), ".so")))
- {
- s7_pointer init;
-
- init = let_ref_1(sc, sc->envir, s7_make_symbol(sc, "init_func"));
- if (is_symbol(init))
- {
- void *library;
- char *pwd_name = NULL;
-
- if (fname[0] != '/')
- pwd_name = full_filename(fname); /* this is necessary, at least in Linux -- we can't blithely dlopen whatever is passed to us */
- library = dlopen((pwd_name) ? pwd_name : fname, RTLD_NOW);
- if (library)
- {
- const char *init_name = NULL;
- void *init_func;
-
- init_name = symbol_name(init);
- init_func = dlsym(library, init_name);
- if (init_func)
- {
- typedef void *(*dl_func)(s7_scheme *sc);
- ((dl_func)init_func)(sc);
- if (pwd_name) free(pwd_name);
- return(sc->T);
- }
- else
- {
- s7_warn(sc, 512, "loaded %s, but can't find %s (%s)?\n", fname, init_name, dlerror());
- dlclose(library);
- }
- }
- else s7_warn(sc, 512, "load %s failed: %s\n", (pwd_name) ? pwd_name : fname, dlerror());
- if (pwd_name) free(pwd_name);
- }
- else s7_warn(sc, 512, "can't load %s: no init function\n", fname);
- return(sc->F);
- }
- }
-#endif
-
- fp = fopen(fname, "r");
-#if WITH_GCC
- if (!fp)
+ if (vector_rank(vect) == 1)
{
- /* catch one special case, "~/..." since it causes 99.9% of the "can't load ..." errors */
- if ((fname[0] == '~') &&
- (fname[1] == '/'))
+ if (is_int_vector(vect))
{
- char *home;
- home = getenv("HOME");
- if (home)
+ port_write_string(port)(sc, "#i(", 3, port);
+ if (!is_string_port(port))
{
- char *filename;
- int len;
- len = safe_strlen(fname) + safe_strlen(home) + 1;
- tmpbuf_malloc(filename, len);
- snprintf(filename, len, "%s%s", home, (char *)(fname + 1));
- fp = fopen(filename, "r");
- tmpbuf_free(filename, len);
+ plen = snprintf(buf, 128, "%" LL_D, int_vector_element(vect, 0));
+ port_write_string(port)(sc, buf, plen, port);
+ for (i = 1; i < len; i++)
+ {
+ plen = snprintf(buf, 128, " %" LL_D, int_vector_element(vect, i));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ }
+ else
+ {
+ /* an experiment */
+ unsigned int new_len, next_len;
+ unsigned char *dbuf;
+ new_len = port_position(port);
+ next_len = port_data_size(port) - 128;
+ dbuf = port_data(port);
+
+ if (new_len >= next_len)
+ {
+ resize_port_data(port, port_data_size(port) * 2);
+ next_len = port_data_size(port) - 128;
+ dbuf = port_data(port);
+ }
+ plen = snprintf((char *)(dbuf + new_len), 128, "%" LL_D, int_vector_element(vect, 0));
+ new_len += plen;
+ for (i = 1; i < len; i++)
+ {
+ if (new_len >= next_len)
+ {
+ resize_port_data(port, port_data_size(port) * 2);
+ next_len = port_data_size(port) - 128;
+ dbuf = port_data(port);
+ }
+ plen = snprintf((char *)(dbuf + new_len), 128, " %" LL_D, int_vector_element(vect, i));
+ new_len += plen;
+ }
+ port_position(port) = new_len;
}
}
+ else
+ {
+ port_write_string(port)(sc, "#r(", 3, port);
+ plen = snprintf(buf, 124, float_format_g, float_format_precision, float_vector_element(vect, 0)); /* 124 so floatify has room */
+ floatify(buf, &plen);
+ port_write_string(port)(sc, buf, plen, port);
+ for (i = 1; i < len; i++)
+ {
+ port_write_character(port)(sc, ' ', port);
+ plen = snprintf(buf, 124, float_format_g, float_format_precision, float_vector_element(vect, i));
+ floatify(buf, &plen);
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ }
+
+ if (too_long)
+ port_write_string(port)(sc, " ...)", 5, port);
+ else port_write_character(port)(sc, ')', port);
+ return;
}
-#endif
-
- if (!fp)
- {
- fp = search_load_path(sc, fname);
- if (!fp)
- return(file_error(sc, "load", "can't open", fname));
- }
-
- port = read_file(sc, fp, fname, -1, "load");
- port_file_number(port) = remember_file_name(sc, fname);
- set_loader_port(port);
- push_input_port(sc, port);
-
- 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);
-
- /* 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.
- */
-
- if (hook_has_functions(sc->load_hook))
- s7_apply_function(sc, sc->load_hook, list_1(sc, sc->temp4 = s7_make_string(sc, fname)));
- return(sc->unspecified);
+ /* multidimensional case */
+ {
+ bool last = false;
+ plen = snprintf(buf, 32, "#%c%uD", (is_int_vector(vect)) ? 'i' : 'r', vector_ndims(vect));
+ port_write_string(port)(sc, buf, plen, port);
+ multivector_to_port(sc, vect, port, len, 0, 0, vector_ndims(vect), &last, USE_DISPLAY, NULL);
+ }
}
-s7_pointer s7_load_path(s7_scheme *sc)
+static void byte_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_write_t use_write)
{
- return(s7_symbol_value(sc, sc->load_path_symbol));
-}
+ s7_int i, len;
+ int plen;
+ bool too_long = false;
+ len = string_length(vect);
+ if (use_write == USE_READABLE_WRITE)
+ plen = len;
+ else plen = sc->print_length;
-s7_pointer s7_add_to_load_path(s7_scheme *sc, const char *dir)
-{
- s7_symbol_set_value(sc,
- sc->load_path_symbol,
- cons(sc,
- s7_make_string(sc, dir),
- s7_symbol_value(sc, sc->load_path_symbol)));
- return(s7_symbol_value(sc, sc->load_path_symbol));
-}
+ if (len == 0)
+ port_write_string(port)(sc, "#u8()", 5, port);
+ else
+ {
+ if (plen <= 0)
+ port_write_string(port)(sc, "#u8(...)", 8, port);
+ else
+ {
+ unsigned int nlen;
+ char *p;
+ if (len > plen)
+ {
+ too_long = true;
+ len = plen;
+ }
+
+ if (len > 1000)
+ {
+ unsigned int vlen;
+ char c;
+ char *data;
+ vlen = string_length(vect);
+ data = string_value(vect);
+ c = data[0];
+ for (i = 1; i < vlen; i++)
+ if (data[i] != c)
+ break;
+ if (i == vlen)
+ {
+ char buf[128];
+ plen = snprintf(buf, 128, "(make-byte-vector %u ", vlen);
+ port_write_string(port)(sc, buf, plen, port);
+ plen = snprintf(buf, 128, "%u)", (unsigned int)c);
+ port_write_string(port)(sc, buf, plen, port);
+ return;
+ }
+ }
+ 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, ' ');
+ 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' : ')');
+ port_write_string(port)(sc, p, nlen - 1, port);
-static s7_pointer g_load_path_set(s7_scheme *sc, s7_pointer args)
-{
- /* new value must be either () or a proper list of strings */
- if (is_null(cadr(args))) return(cadr(args));
- if (is_pair(cadr(args)))
- {
- s7_pointer x;
- for (x = cadr(args); is_pair(x); x = cdr(x))
- if (!is_string(car(x)))
- return(sc->error_symbol);
- if (is_null(x))
- return(cadr(args));
+ if (too_long)
+ port_write_string(port)(sc, " ...)", 5, port);
+ }
}
- return(sc->error_symbol);
-}
-
-static s7_pointer g_cload_directory_set(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer cl_dir;
- cl_dir = cadr(args);
- if (!is_string(cl_dir))
- return(sc->error_symbol);
- s7_symbol_set_value(sc, sc->cload_directory_symbol, cl_dir);
- if (safe_strlen(string_value(cl_dir)) > 0)
- s7_add_to_load_path(sc, (const char *)(string_value(cl_dir)));
- return(cl_dir);
}
-/* ---------------- autoload ---------------- */
-
-void s7_autoload_set_names(s7_scheme *sc, const char **names, int size)
+static void pair_to_port(s7_scheme *sc, s7_pointer lst, s7_pointer port, use_write_t use_write, shared_info *ci)
{
- /* the idea here is that by sticking to string constants we can handle 90% of the work at compile-time,
- * with less start-up memory. Then eventually we'll add C libraries a la xg (gtk) as environments
- * and every name in that library will come as an import once dlopen has picked up the library.
- * So, hopefully, we can pre-declare as many names as we want from as many libraries as we want,
- * without a bloated mess of a run-time image. And new libraries are easy to accommodate --
- * add the names to be auto-exported to this list with the name of the scheme file that cloads
- * the library and exports the given name. So, we'll need a separate such file for each library?
- *
- * the environment variable could use the library base name in *: *libm* or *libgtk*
- * (*libm* 'j0)
- * why not just predeclare these libraries? The caller could import what he wants via require.
- * So the autoloader need only know which libraries, but this doesn't fit the current use of gtk in xg
- * In fact, we only need to see *libm* -> libm.so etc, but we still need the arg/return types of each function, etc
- * And libgtk is enormous -- seems too bad to tie-in everything via the FFI when we need less than 1% of it.
- * Perhaps each module as an environment within the main one: ((*libgtk* *gtkwidget*) 'gtk_widget_new)?
- * But that requires inside knowlege of the library, and changes without notice.
- *
- * Also we need to decide how to handle name collisions (by order of autoload lib setup)
- * And (lastly?) how to handle different library versions?
- *
- *
- * so autoload known libs here in s7 so we're indepentdent of snd
- * (currently these are included in make-index.scm[line 575] -> snd-xref.c)
- * for each module, include an env in the lib env (*libgtk* 'gtkwidget.h) or whatever that has the names in that header
- * in autoload below, don't sort! -- just build a list of autoload tables and check each in order at autoload time (we want startup to be fast)
- * for versions, include wrapper macro at end of each c-define choice
- * in the xg case, there's no savings in delaying the defines
- *
- */
+ /* we need list_to_starboard... */
+ s7_pointer x;
+ s7_int i, len, true_len;
- if (!sc->autoload_names)
- {
- sc->autoload_names = (const char ***)calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(const char **));
- sc->autoload_names_sizes = (int *)calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(int));
- sc->autoloaded_already = (bool **)calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(bool *));
- sc->autoload_names_top = INITIAL_AUTOLOAD_NAMES_SIZE;
- sc->autoload_names_loc = 0;
- }
+ true_len = s7_list_length(sc, lst);
+ if (true_len < 0) /* a dotted list -- handle cars, then final cdr */
+ len = (-true_len + 1);
else
{
- if (sc->autoload_names_loc >= sc->autoload_names_top)
+ if (true_len == 0) /* either () or a circular list */
{
- int 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 = (int *)realloc(sc->autoload_names_sizes, sc->autoload_names_top * sizeof(int));
- 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++)
+ if (is_not_null(lst))
+ len = circular_list_entries(lst);
+ else
{
- sc->autoload_names[i] = NULL;
- sc->autoload_names_sizes[i] = 0;
- sc->autoloaded_already[i] = NULL;
+ port_write_string(port)(sc, "()", 2, port);
+ return;
}
}
+ else len = true_len;
}
- sc->autoload_names[sc->autoload_names_loc] = names;
- sc->autoload_names_sizes[sc->autoload_names_loc] = size;
- sc->autoloaded_already[sc->autoload_names_loc] = (bool *)calloc(size, sizeof(bool));
- sc->autoload_names_loc++;
-}
+ if (((car(lst) == sc->quote_symbol) ||
+ (car(lst) == sc->quote_unchecked_symbol)) && /* this can happen (see lint.scm) */
+ (true_len == 2))
+ {
+ /* len == 1 is important, otherwise (list 'quote 1 2) -> '1 2 which looks weird
+ * or (object->string (apply . `''1)) -> "'quote 1"
+ * so (quote x) = 'x but (quote x y z) should be left alone (if evaluated, it's an error)
+ */
+ port_write_character(port)(sc, '\'', port);
+ object_to_port_with_circle_check(sc, cadr(lst), port, USE_WRITE, ci);
+ return;
+ }
+ else port_write_character(port)(sc, '(', port);
+ if (is_multiple_value(lst))
+ port_write_string(port)(sc, "values ", 7, port);
-static const char *find_autoload_name(s7_scheme *sc, s7_pointer symbol, bool *already_loaded, bool loading)
-{
- int l = 0, pos = -1, lib, libs;
- const char *name, *this_name;
+ if (use_write == USE_READABLE_WRITE)
+ {
+ if (ci)
+ {
+ int plen;
+ char buf[128];
- name = symbol_name(symbol);
- libs = sc->autoload_names_loc;
+ port_write_string(port)(sc, "let (({lst} (make-list ", 23, port);
+ plen = snprintf(buf, 128, "%" LL_D "))) ", len);
+ port_write_string(port)(sc, buf, plen, port);
- for (lib = 0; lib < libs; lib++)
- {
- const char **names;
- int u;
- u = sc->autoload_names_sizes[lib] - 1;
- names = sc->autoload_names[lib];
+ if ((shared_ref(ci, lst) < 0))
+ {
+ plen = snprintf(buf, 128, "(set! {%d} {lst}) ", -shared_ref(ci, lst));
+ port_write_string(port)(sc, buf, plen, port);
+ }
- while (true)
+ port_write_string(port)(sc, "(let (({x} {lst})) ", 19, port);
+ for (i = 0, x = lst; (i < len) && (is_pair(x)); i++, x = cdr(x))
+ {
+ port_write_string(port)(sc, "(set-car! {x} ", 14, port);
+ object_to_port_with_circle_check(sc, car(x), port, use_write, ci);
+ port_write_string(port)(sc, ") ", 2, port);
+ if (i < len - 1)
+ port_write_string(port)(sc, "(set! {x} (cdr {x})) ", 21, port);
+ }
+ if (!is_null(x))
+ {
+ port_write_string(port)(sc, "(set-cdr! {x} ", 14, port);
+ object_to_port_with_circle_check(sc, x, port, use_write, ci);
+ port_write_string(port)(sc, ") ", 2, port);
+ }
+ port_write_string(port)(sc, ") {lst})", 8, port);
+ }
+ else
{
- int comp;
- if (u < l) break;
- pos = (l + u) / 2;
- this_name = names[pos * 2];
- comp = strcmp(this_name, name);
- if (comp == 0)
+ /* the easier cases: no circles or shared refs to patch up */
+ if (true_len > 0)
{
- *already_loaded = sc->autoloaded_already[lib][pos];
- if (loading) sc->autoloaded_already[lib][pos] = true;
- return(names[pos * 2 + 1]); /* file name given func name */
+ port_write_string(port)(sc, "list", 4, port);
+ for (x = lst; is_pair(x); x = cdr(x))
+ {
+ port_write_character(port)(sc, ' ', port);
+ object_to_port_with_circle_check(sc, car(x), port, use_write, ci);
+ }
+ port_write_character(port)(sc, ')', port);
+ }
+ else
+ {
+ port_write_string(port)(sc, "cons ", 5, port);
+ object_to_port_with_circle_check(sc, car(lst), port, use_write, ci);
+ for (x = cdr(lst); is_pair(x); x = cdr(x))
+ {
+ port_write_character(port)(sc, ' ', port);
+ port_write_string(port)(sc, "(cons ", 6, port);
+ object_to_port_with_circle_check(sc, car(x), port, use_write, ci);
+ }
+ port_write_character(port)(sc, ' ', port);
+ object_to_port_with_circle_check(sc, x, port, use_write, ci);
+ for (i = 1; i < len; i++)
+ port_write_character(port)(sc, ')', port);
}
- if (comp < 0)
- l = pos + 1;
- else u = pos - 1;
}
}
- return(NULL);
-}
-
-
-s7_pointer s7_autoload(s7_scheme *sc, s7_pointer symbol, s7_pointer file_or_function)
-{
- /* add '(symbol . file) to s7's autoload table */
- if (is_null(sc->autoload_table))
- sc->autoload_table = s7_make_hash_table(sc, sc->default_hash_table_length);
- s7_hash_table_set(sc, sc->autoload_table, symbol, file_or_function);
- return(file_or_function);
+ else
+ {
+ if (ci)
+ {
+ for (x = lst, i = 0; (is_pair(x)) && (i < len) && ((!ci) || (i == 0) || (!is_collected(x)) || (peek_shared_ref(ci, x) == 0)); i++, x = cdr(x))
+ {
+ object_to_port_with_circle_check(sc, car(x), port, DONT_USE_DISPLAY(use_write), ci);
+ if (i < (len - 1))
+ port_write_character(port)(sc, ' ', port);
+ }
+ if (is_not_null(x))
+ {
+ if ((true_len == 0) &&
+ (i == len))
+ port_write_string(port)(sc, " . ", 3, port);
+ else port_write_string(port)(sc, ". ", 2, port);
+ object_to_port_with_circle_check(sc, x, port, DONT_USE_DISPLAY(use_write), ci);
+ }
+ port_write_character(port)(sc, ')', port);
+ }
+ else
+ {
+ s7_int len1;
+ len1 = len - 1;
+ if (is_string_port(port))
+ {
+ for (x = lst, i = 0; (is_pair(x)) && (i < len1); i++, x = cdr(x))
+ {
+ object_to_port(sc, car(x), port, DONT_USE_DISPLAY(use_write), ci);
+ if (port_position(port) >= sc->objstr_max_len)
+ return;
+ if (port_position(port) >= port_data_size(port))
+ resize_port_data(port, port_data_size(port) * 2);
+ port_data(port)[port_position(port)++] = (unsigned char)' ';
+ }
+ }
+ else
+ {
+ for (x = lst, i = 0; (is_pair(x)) && (i < len1); i++, x = cdr(x))
+ {
+ object_to_port(sc, car(x), port, DONT_USE_DISPLAY(use_write), ci);
+ port_write_character(port)(sc, ' ', port);
+ }
+ }
+ if (is_pair(x))
+ {
+ object_to_port(sc, car(x), port, DONT_USE_DISPLAY(use_write), ci);
+ x = cdr(x);
+ }
+ if (is_not_null(x))
+ {
+ port_write_string(port)(sc, ". ", 2, port);
+ object_to_port(sc, x, port, DONT_USE_DISPLAY(use_write), ci);
+ }
+ port_write_character(port)(sc, ')', port);
+ }
+ }
}
-static s7_pointer g_autoload(s7_scheme *sc, s7_pointer args)
+static void hash_table_to_port(s7_scheme *sc, s7_pointer hash, s7_pointer port, use_write_t use_write, shared_info *ci)
{
- #define H_autoload "(autoload symbol file-or-function) adds the symbol to its table of autoloadable symbols. \
-If that symbol is encountered as an unbound variable, s7 either loads the file (following *load-path*), or calls \
-the function. The function takes one argument, the calling environment. Presumably the symbol is defined \
-in the file, or by the function."
- #define Q_autoload s7_make_signature(sc, 3, sc->T, sc->is_symbol_symbol, sc->T)
-
- s7_pointer sym, value;
+ int i, len;
+ unsigned int gc_iter;
+ bool too_long = false;
+ s7_pointer iterator, p;
- sym = car(args);
- if (is_string(sym))
+ /* if hash is a member of ci, just print its number
+ * (let ((ht (hash-table '(a . 1)))) (hash-table-set! ht 'b ht))
+ *
+ * since equal? does not care about the hash-table lengths, we can ignore that complication in the :readable case
+ */
+ len = hash_table_entries(hash);
+ if (len == 0)
{
- if (string_length(sym) == 0) /* (autoload "" ...) */
- return(s7_wrong_type_arg_error(sc, "autoload", 1, sym, "a symbol-name or a symbol"));
- sym = make_symbol_with_length(sc, string_value(sym), string_length(sym));
+ port_write_string(port)(sc, "(hash-table)", 12, port);
+ return;
}
- if (!is_symbol(sym))
+
+ if (use_write != USE_READABLE_WRITE)
{
- check_method(sc, sym, sc->autoload_symbol, args);
- return(s7_wrong_type_arg_error(sc, "autoload", 1, sym, "a string (symbol-name) or a symbol"));
+ s7_int plen;
+ plen = sc->print_length;
+ if (plen <= 0)
+ {
+ port_write_string(port)(sc, "(hash-table ...)", 16, port);
+ return;
+ }
+ if (len > plen)
+ {
+ too_long = true;
+ len = plen;
+ }
}
- if (is_keyword(sym))
- return(s7_wrong_type_arg_error(sc, "autoload", 1, sym, "a normal symbol (a keyword is never unbound)"));
- value = cadr(args);
- if (is_string(value))
- return(s7_autoload(sc, sym, value));
- if (((is_closure(value)) || (is_closure_star(value))) &&
- (s7_is_aritable(sc, value, 1)))
- return(s7_autoload(sc, sym, value));
-
- check_method(sc, value, sc->autoload_symbol, args);
- return(s7_wrong_type_arg_error(sc, "autoload", 2, value, "a string (file-name) or a thunk"));
-}
+ iterator = s7_make_iterator(sc, hash);
+ gc_iter = s7_gc_protect(sc, iterator);
+ p = cons(sc, sc->F, sc->F);
+ iterator_current(iterator) = p;
+ set_mark_seq(iterator);
+ if ((use_write == USE_READABLE_WRITE) &&
+ (ci) &&
+ (is_collected(hash)) &&
+ (peek_shared_ref(ci, hash) != 0))
+ {
+ port_write_string(port)(sc, "(let (({ht} (make-hash-table)))", 31, port);
+ if (shared_ref(ci, hash) < 0)
+ {
+ int plen;
+ char buf[64];
+ plen = snprintf(buf, 64, "(set! {%d} {ht}) ", -shared_ref(ci, hash));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ for (i = 0; i < len; i++)
+ {
+ s7_pointer key_val, key, val;
-static s7_pointer g_autoloader(s7_scheme *sc, s7_pointer args)
-{
- #define H_autoloader "(*autoload* sym) returns the autoload info for the symbol sym, or #f."
- #define Q_autoloader s7_make_signature(sc, 2, sc->T, sc->is_symbol_symbol)
- s7_pointer sym;
+ key_val = hash_table_iterate(sc, iterator);
+ key = car(key_val);
+ val = cdr(key_val);
- sym = car(args);
- if (!is_symbol(sym))
- {
- check_method(sc, sym, sc->autoloader_symbol, args);
- return(s7_wrong_type_arg_error(sc, "*autoload*", 1, sym, "a symbol"));
+ port_write_string(port)(sc, " (set! ({ht} ", 13, port);
+ if (key == hash)
+ port_write_string(port)(sc, "{ht}", 4, port);
+ else object_to_port_with_circle_check(sc, key, port, USE_READABLE_WRITE, ci);
+ port_write_string(port)(sc, ") ", 2, port);
+ if (val == hash)
+ port_write_string(port)(sc, "{ht}", 4, port);
+ else object_to_port_with_circle_check(sc, val, port, USE_READABLE_WRITE, ci);
+ port_write_character(port)(sc, ')', port);
+ }
+ port_write_string(port)(sc, " {ht})", 6, port);
}
- if (sc->autoload_names)
+ else
{
- const char *file;
- bool loaded = false;
- file = find_autoload_name(sc, sym, &loaded, false);
- if (file)
- return(s7_make_string(sc, file));
+ port_write_string(port)(sc, "(hash-table", 11, port);
+ for (i = 0; i < len; i++)
+ {
+ s7_pointer key_val;
+ if (use_write == USE_READABLE_WRITE)
+ port_write_character(port)(sc, ' ', port);
+ else port_write_string(port)(sc, " '", 2, port);
+ key_val = hash_table_iterate(sc, iterator);
+ object_to_port_with_circle_check(sc, key_val, port, DONT_USE_DISPLAY(use_write), ci);
+ }
+
+ if (too_long)
+ port_write_string(port)(sc, " ...)", 5, port);
+ else port_write_character(port)(sc, ')', port);
}
- if (is_hash_table(sc->autoload_table))
- return(s7_hash_table_ref(sc, sc->autoload_table, sym));
- return(sc->F);
+ s7_gc_unprotect_at(sc, gc_iter);
+ iterator_current(iterator) = sc->nil;
+ free_cell(sc, p);
+ free_cell(sc, iterator);
}
-static s7_pointer g_require(s7_scheme *sc, s7_pointer args)
+static int slot_to_port_1(s7_scheme *sc, s7_pointer x, s7_pointer port, use_write_t use_write, shared_info *ci, int n)
{
- #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\"."
- #define Q_require s7_make_circular_signature(sc, 1, 2, sc->T, sc->is_symbol_symbol)
+ if (is_slot(x))
+ {
+ n = slot_to_port_1(sc, next_slot(x), port, use_write, ci, n);
+ if (n <= sc->print_length)
+ {
+ port_write_character(port)(sc, ' ', port);
+ object_to_port_with_circle_check(sc, x, port, use_write, ci);
+ }
+ if (n == (sc->print_length + 1))
+ port_write_string(port)(sc, " ...", 4, port);
+ }
+ return(n + 1);
+}
- s7_pointer p;
- sc->temp5 = cons(sc, args, sc->temp5);
- for (p = args; is_pair(p); p = cdr(p))
+static void let_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ /* if outer env points to (say) method list, the object needs to specialize object->string itself */
+ if (has_methods(obj))
{
- s7_pointer sym;
- if (is_symbol(car(p)))
- sym = car(p);
- else
+ s7_pointer print_func;
+ print_func = find_method(sc, obj, sc->object_to_string_symbol);
+ if (print_func != sc->undefined)
{
- if ((is_pair(car(p))) &&
- (caar(p) == sc->quote_symbol) &&
- (is_symbol(cadar(p))))
- sym = cadar(p);
- else return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "require: ~S is not a symbol"), car(p))));
+ s7_pointer p;
+ /* what needs to be protected here? for one, the function might not return a string! */
+
+ clear_has_methods(obj);
+ if (use_write == USE_WRITE)
+ p = s7_apply_function(sc, print_func, list_1(sc, obj));
+ else p = s7_apply_function(sc, print_func, list_2(sc, obj, (use_write == USE_DISPLAY) ? sc->F : sc->key_readable_symbol));
+ set_has_methods(obj);
+
+ if ((is_string(p)) &&
+ (string_length(p) > 0))
+ port_write_string(port)(sc, string_value(p), string_length(p), port);
+ return;
}
- if ((!is_slot(find_symbol(sc, sym))) &&
- (sc->is_autoloading))
+ }
+ if (obj == sc->rootlet)
+ port_write_string(port)(sc, "(rootlet)", 9, port);
+ else
+ {
+ if (sc->short_print)
+ port_write_string(port)(sc, "#<let>", 6, port);
+ else
{
- s7_pointer f;
- f = g_autoloader(sc, list_1(sc, sym));
- if (is_string(f))
- s7_load_with_environment(sc, string_value(f), sc->envir);
+ /* circles can happen here:
+ * (let () (let ((b (curlet))) (curlet)))
+ * #<let 'b #<let>>
+ * or (let ((b #f)) (set! b (curlet)) (curlet))
+ * #1=#<let 'b #1#>
+ */
+ if ((use_write == USE_READABLE_WRITE) &&
+ (ci) &&
+ (is_collected(obj)) &&
+ (peek_shared_ref(ci, obj) != 0))
+ {
+ s7_pointer x;
+ port_write_string(port)(sc, "(let (({e} (inlet))) ", 21, port);
+ if ((ci) &&
+ (shared_ref(ci, obj) < 0))
+ {
+ int plen;
+ char buf[64];
+ plen = snprintf(buf, 64, "(set! {%d} {e}) ", -shared_ref(ci, obj));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+
+ port_write_string(port)(sc, "(apply varlet {e} (reverse (list ", 33, port);
+ for (x = let_slots(obj); is_slot(x); x = next_slot(x))
+ {
+ port_write_string(port)(sc, "(cons ", 6, port);
+ symbol_to_port(sc, slot_symbol(x), port, use_write, NULL);
+ port_write_character(port)(sc, ' ', port);
+ object_to_port_with_circle_check(sc, slot_value(x), port, use_write, ci);
+ port_write_character(port)(sc, ')', port);
+ }
+ port_write_string(port)(sc, "))) {e})", 8, port);
+ }
else
{
- sc->temp5 = sc->nil;
- return(s7_error(sc, make_symbol(sc, "autoload-error"),
- set_elist_2(sc, make_string_wrapper(sc, "require: no autoload info for ~S"), sym)));
+ port_write_string(port)(sc, "(inlet", 6, port);
+ slot_to_port_1(sc, let_slots(obj), port, use_write, ci, 0);
+ port_write_character(port)(sc, ')', port);
}
}
}
- sc->temp5 = cdr(sc->temp5); /* in-coming value */
- return(sc->T);
-}
-
-
-/* -------------------------------- eval-string -------------------------------- */
-
-s7_pointer s7_eval_c_string_with_environment(s7_scheme *sc, const char *str, s7_pointer e)
-{
- s7_pointer code, port;
- port = s7_open_input_string(sc, str);
- code = s7_read(sc, port);
- s7_close_input_port(sc, port);
- return(s7_eval(sc, _NFre(code), e));
}
-s7_pointer s7_eval_c_string(s7_scheme *sc, const char *str)
+static void write_macro_readably(s7_scheme *sc, s7_pointer obj, s7_pointer port)
{
- return(s7_eval_c_string_with_environment(sc, str, sc->nil));
-}
+ s7_pointer arglist, body, expr;
-static s7_pointer g_eval_string(s7_scheme *sc, s7_pointer args)
-{
- #define H_eval_string "(eval-string str (env (curlet))) returns the result of evaluating the string str as Scheme code"
- #define Q_eval_string s7_make_signature(sc, 3, sc->values_symbol, sc->is_string_symbol, sc->is_let_symbol)
- s7_pointer port, str;
-
- str = car(args);
- if (!is_string(str))
- method_or_bust(sc, str, sc->eval_string_symbol, args, T_STRING, 1);
+ body = closure_body(obj);
+ arglist = closure_args(obj);
- if (is_not_null(cdr(args)))
+ port_write_string(port)(sc, "(define-", 8, port);
+ port_write_string(port)(sc, ((is_macro(obj)) || (is_macro_star(obj))) ? "macro" : "bacro", 5, port);
+ if ((is_macro_star(obj)) || (is_bacro_star(obj)))
+ port_write_character(port)(sc, '*', port);
+ port_write_string(port)(sc, " (_m_", 5, port);
+ if (is_symbol(arglist))
{
- s7_pointer e;
- e = cadr(args);
- if (!is_let(e))
- return(wrong_type_argument_with_type(sc, sc->eval_string_symbol, 2, e, a_let_string));
- if (e == sc->rootlet)
- sc->envir = sc->nil;
- else sc->envir = e;
+ port_write_string(port)(sc, " . ", 3, port);
+ port_write_string(port)(sc, symbol_name(arglist), symbol_name_length(arglist), port);
}
+ else
+ {
+ if (is_pair(arglist))
+ {
+ for (expr = arglist; is_pair(expr); expr = cdr(expr))
+ {
+ port_write_character(port)(sc, ' ', port);
+ object_to_port(sc, car(expr), port, USE_WRITE, NULL);
+ }
+ if (!is_null(expr))
+ {
+ port_write_string(port)(sc, " . ", 3, port);
+ object_to_port(sc, expr, port, USE_WRITE, NULL);
+ }
+ }
+ }
+ port_write_string(port)(sc, ") ", 2, port);
+ for (expr = body; is_pair(expr); expr = cdr(expr))
+ object_to_port(sc, car(expr), port, USE_WRITE, NULL);
+ port_write_character(port)(sc, ')', port);
+}
- port = open_and_protect_input_string(sc, str);
- push_input_port(sc, port);
-
- sc->temp3 = sc->args;
- push_stack(sc, OP_EVAL_STRING_1, args, sc->code);
- push_stack(sc, OP_READ_INTERNAL, sc->nil, sc->nil);
- return(sc->F);
+static s7_pointer match_symbol(s7_scheme *sc, s7_pointer symbol, s7_pointer e)
+{
+ s7_pointer y, le;
+ for (le = e; is_let(le) && (le != sc->rootlet); le = outlet(le))
+ for (y = let_slots(le); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == symbol)
+ return(y);
+ return(NULL);
}
-static s7_pointer eval_string_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static bool slot_memq(s7_pointer symbol, s7_pointer symbols)
{
- check_for_substring_temp(sc, expr);
- return(f);
+ s7_pointer x;
+ for (x = symbols; is_pair(x); x = cdr(x))
+ if (slot_symbol(car(x)) == symbol)
+ return(true);
+ return(false);
}
-
-static s7_pointer call_with_input(s7_scheme *sc, s7_pointer port, s7_pointer args)
+static bool arg_memq(s7_pointer symbol, s7_pointer args)
{
- s7_pointer p;
- p = cadr(args);
- port_original_input_string(port) = car(args);
- push_stack(sc, OP_UNWIND_INPUT, sc->input_port, port);
- push_stack(sc, OP_APPLY, list_1(sc, port), p);
- return(sc->F);
+ s7_pointer x;
+ for (x = args; is_pair(x); x = cdr(x))
+ if ((car(x) == symbol) ||
+ ((is_pair(car(x))) &&
+ (caar(x) == symbol)))
+ return(true);
+ return(false);
}
-/* -------------------------------- call-with-input-string -------------------------------- */
-
-static s7_pointer g_call_with_input_string(s7_scheme *sc, s7_pointer args)
+static void collect_locals(s7_scheme *sc, s7_pointer body, s7_pointer e, s7_pointer args, unsigned int gc_loc)
{
- s7_pointer str, proc;
- #define H_call_with_input_string "(call-with-input-string str proc) opens a string port for str and applies proc to it"
- #define Q_call_with_input_string pl_sf
- /* (call-with-input-string "44" (lambda (p) (+ 1 (read p)))) -> 45 */
-
- str = car(args);
- if (!is_string(str))
- method_or_bust(sc, str, sc->call_with_input_string_symbol, args, T_STRING, 1);
-
- proc = cadr(args);
- if (is_let(proc))
- check_method(sc, proc, sc->call_with_input_string_symbol, args);
-
- if (!s7_is_aritable(sc, proc, 1))
- return(wrong_type_argument_with_type(sc, sc->call_with_input_string_symbol, 2, proc,
- make_string_wrapper(sc, "a procedure of one argument (the port)")));
-
- if ((is_continuation(proc)) || (is_goto(proc)))
- return(wrong_type_argument_with_type(sc, sc->call_with_input_string_symbol, 2, proc, a_normal_procedure_string));
-
- return(call_with_input(sc, open_and_protect_input_string(sc, str), args));
+ if (is_pair(body))
+ {
+ collect_locals(sc, car(body), e, args, gc_loc);
+ collect_locals(sc, cdr(body), e, args, gc_loc);
+ }
+ else
+ {
+ if ((is_symbol(body)) &&
+ (!arg_memq(body, args)) &&
+ (!slot_memq(body, gc_protected_at(sc, gc_loc))))
+ {
+ s7_pointer slot;
+ slot = match_symbol(sc, body, e);
+ if (slot)
+ gc_protected_at(sc, gc_loc) = cons(sc, slot, gc_protected_at(sc, gc_loc));
+ }
+ }
}
-static s7_pointer c_call_with_input_string(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_call_with_input_string(sc, set_plist_2(sc, x, y)));}
-PF2_TO_PF(call_with_input_string, c_call_with_input_string)
+static s7_pointer find_closure(s7_scheme *sc, s7_pointer closure, s7_pointer cur_env)
+{
+ s7_pointer e, y;
+ for (e = cur_env; is_let(e); e = outlet(e))
+ {
+ if ((is_funclet(e)) &&
+ (is_global(funclet_function(e))) && /* (define (f1) (lambda () 1)) shouldn't say the returned closure is named f1 */
+ (slot_value(global_slot(funclet_function(e))) == closure))
+ return(funclet_function(e));
-/* -------------------------------- call-with-input-file -------------------------------- */
+ for (y = let_slots(e); is_slot(y); y = next_slot(y))
+ if (slot_value(y) == closure)
+ return(slot_symbol(y));
+ }
+ return(sc->nil);
+}
-static s7_pointer g_call_with_input_file(s7_scheme *sc, s7_pointer args)
+static void write_closure_name(s7_scheme *sc, s7_pointer closure, s7_pointer port)
{
- #define H_call_with_input_file "(call-with-input-file filename proc) opens filename and calls proc with the input port as its argument"
- #define Q_call_with_input_file pl_sf
- s7_pointer str, proc;
-
- str = car(args);
- if (!is_string(str))
- method_or_bust(sc, str, sc->call_with_input_file_symbol, args, T_STRING, 1);
+ s7_pointer x;
+ x = find_closure(sc, closure, closure_let(closure));
+ /* this can be confusing! In some cases, the function is in its environment, and in other very similar-looking cases it isn't:
+ * (let ((a (lambda () 1))) a)
+ * #<lambda ()>
+ * (letrec ((a (lambda () 1))) a)
+ * a
+ * (let () (define (a) 1) a)
+ * a
+ */
+ if (is_symbol(x)) /* after find_closure */
+ {
+ port_write_string(port)(sc, symbol_name(x), symbol_name_length(x), port);
+ return;
+ }
+
+ /* names like #<closure> and #<macro> are useless -- try to be a bit more informative */
+ switch (type(closure))
+ {
+ case T_CLOSURE:
+ port_write_string(port)(sc, "#<lambda ", 9, port);
+ break;
- proc = cadr(args);
- if (!s7_is_aritable(sc, proc, 1))
- return(wrong_type_argument_with_type(sc, sc->call_with_input_file_symbol, 2, proc,
- make_string_wrapper(sc, "a procedure of one argument (the port)")));
- if ((is_continuation(proc)) || (is_goto(proc)))
- return(wrong_type_argument_with_type(sc, sc->call_with_input_file_symbol, 2, proc, a_normal_procedure_string));
+ case T_CLOSURE_STAR:
+ port_write_string(port)(sc, "#<lambda* ", 10, port);
+ break;
- return(call_with_input(sc, open_input_file_1(sc, string_value(str), "r", "call-with-input-file"), args));
-}
+ case T_MACRO:
+ if (is_expansion(closure))
+ port_write_string(port)(sc, "#<expansion ", 12, port);
+ else port_write_string(port)(sc, "#<macro ", 8, port);
+ break;
-static s7_pointer c_call_with_input_file(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_call_with_input_file(sc, set_plist_2(sc, x, y)));}
-PF2_TO_PF(call_with_input_file, c_call_with_input_file)
+ case T_MACRO_STAR:
+ port_write_string(port)(sc, "#<macro* ", 9, port);
+ break;
+
+ case T_BACRO:
+ port_write_string(port)(sc, "#<bacro ", 8, port);
+ break;
+ case T_BACRO_STAR:
+ port_write_string(port)(sc, "#<bacro* ", 9, port);
+ break;
+ }
-static s7_pointer with_input(s7_scheme *sc, s7_pointer port, s7_pointer args)
-{
- s7_pointer old_input_port, p;
- old_input_port = sc->input_port;
- sc->input_port = port;
- port_original_input_string(port) = car(args);
- push_stack(sc, OP_UNWIND_INPUT, old_input_port, port);
- p = cadr(args);
- push_stack(sc, OP_APPLY, sc->nil, p);
- return(sc->F);
+ if (is_null(closure_args(closure)))
+ port_write_string(port)(sc, "()>", 3, port);
+ else
+ {
+ s7_pointer args;
+ args = closure_args(closure);
+ if (is_symbol(args))
+ {
+ port_write_string(port)(sc, symbol_name(args), symbol_name_length(args), port);
+ port_write_character(port)(sc, '>', port); /* (lambda a a) -> #<lambda a> */
+ }
+ else
+ {
+ port_write_character(port)(sc, '(', port);
+ x = car(args);
+ if (is_pair(x)) x = car(x);
+ port_write_string(port)(sc, symbol_name(x), symbol_name_length(x), port);
+ if (!is_null(cdr(args)))
+ {
+ s7_pointer y;
+ port_write_character(port)(sc, ' ', port);
+ if (is_pair(cdr(args)))
+ {
+ y = cadr(args);
+ if (is_pair(y))
+ y = car(y);
+ else
+ {
+ if (y == sc->key_rest_symbol)
+ {
+ port_write_string(port)(sc, ":rest ", 6, port);
+ args = cdr(args);
+ y = cadr(args);
+ if (is_pair(y)) y = car(y);
+ }
+ }
+ }
+ else
+ {
+ port_write_string(port)(sc, ". ", 2, port);
+ y = cdr(args);
+ }
+ port_write_string(port)(sc, symbol_name(y), symbol_name_length(y), port);
+ if ((is_pair(cdr(args))) &&
+ (!is_null(cddr(args))))
+ port_write_string(port)(sc, " ...", 4, port);
+ }
+ port_write_string(port)(sc, ")>", 2, port);
+ }
+ }
}
-
-/* -------------------------------- with-input-from-string -------------------------------- */
-
-static s7_pointer g_with_input_from_string(s7_scheme *sc, s7_pointer args)
+static s7_pointer closure_name(s7_scheme *sc, s7_pointer closure)
{
- #define H_with_input_from_string "(with-input-from-string str thunk) opens str as the temporary current-input-port and calls thunk"
- #define Q_with_input_from_string pl_sf
- s7_pointer str;
+ /* this is used by the error handlers to get the current function name
+ */
+ s7_pointer x;
- str = car(args);
- if (!is_string(str))
- method_or_bust(sc, str, sc->with_input_from_string_symbol, args, T_STRING, 1);
+ x = find_closure(sc, closure, sc->envir);
+ if (is_symbol(x))
+ return(x);
- if (!is_thunk(sc, cadr(args)))
- method_or_bust_with_type(sc, cadr(args), sc->with_input_from_string_symbol, args, a_thunk_string, 2);
+ if (is_pair(current_code(sc)))
+ return(current_code(sc));
- /* since the arguments are evaluated before we get here, we can get some confusing situations:
- * (with-input-from-string "#x2.1" (read))
- * (read) -> whatever it can get from the current input port!
- * ";with-input-from-string argument 2, #<eof>, is untyped but should be a thunk"
- */
- return(with_input(sc, open_and_protect_input_string(sc, str), args));
+ return(closure); /* desperation -- the parameter list (caar here) will cause endless confusion in OP_APPLY errors! */
}
-static s7_pointer c_with_input_from_string(s7_scheme *sc, s7_pointer x) {return(g_with_input_from_string(sc, set_plist_1(sc, x)));}
-PF_TO_PF(with_input_from_string, c_with_input_from_string)
-
-
-/* -------------------------------- with-input-from-file -------------------------------- */
-static s7_pointer g_with_input_from_file(s7_scheme *sc, s7_pointer args)
+static void write_closure_readably_1(s7_scheme *sc, s7_pointer obj, s7_pointer arglist, s7_pointer body, s7_pointer port)
{
- #define H_with_input_from_file "(with-input-from-file filename thunk) opens filename as the temporary current-input-port and calls thunk"
- #define Q_with_input_from_file pl_sf
+ s7_int old_print_length;
+ s7_pointer p;
- if (!is_string(car(args)))
- method_or_bust(sc, car(args), sc->with_input_from_file_symbol, args, T_STRING, 1);
+ if (type(obj) == T_CLOSURE_STAR)
+ port_write_string(port)(sc, "(lambda* ", 9, port);
+ else port_write_string(port)(sc, "(lambda ", 8, port);
- if (!is_thunk(sc, cadr(args)))
- method_or_bust_with_type(sc, cadr(args), sc->with_input_from_file_symbol, args, a_thunk_string, 2);
+ if ((is_pair(arglist)) &&
+ (allows_other_keys(arglist)))
+ {
+ sc->temp9 = s7_append(sc, arglist, cons(sc, sc->key_allow_other_keys_symbol, sc->nil));
+ object_out(sc, sc->temp9, port, USE_WRITE);
+ sc->temp9 = sc->nil;
+ }
+ else object_out(sc, arglist, port, USE_WRITE); /* here we just want the straight output (a b) not (list 'a 'b) */
- return(with_input(sc, open_input_file_1(sc, string_value(car(args)), "r", "with-input-from-file"), args));
+ old_print_length = sc->print_length;
+ sc->print_length = 1048576;
+ for (p = body; is_pair(p); p = cdr(p))
+ {
+ port_write_character(port)(sc, ' ', port);
+ object_out(sc, car(p), port, USE_WRITE);
+ }
+ port_write_character(port)(sc, ')', port);
+ sc->print_length = old_print_length;
}
-static s7_pointer c_with_input_from_file(s7_scheme *sc, s7_pointer x) {return(g_with_input_from_file(sc, set_plist_1(sc, x)));}
-PF_TO_PF(with_input_from_file, c_with_input_from_file)
-
-
-
-/* -------------------------------- iterators -------------------------------- */
-
-static s7_pointer g_is_iterator(s7_scheme *sc, s7_pointer args)
+static void write_closure_readably(s7_scheme *sc, s7_pointer obj, s7_pointer port)
{
- #define H_is_iterator "(iterator? obj) returns #t if obj is an iterator."
- #define Q_is_iterator pl_bt
- s7_pointer x;
+ s7_pointer body, arglist, pe, local_slots, setter = NULL;
+ unsigned int gc_loc;
+
+ body = closure_body(obj);
+ arglist = closure_args(obj);
+ pe = closure_let(obj); /* perhaps check for documentation? */
- x = car(args);
- if (is_iterator(x)) return(sc->T);
- check_closure_for(sc, x, sc->is_iterator_symbol);
- check_boolean_method(sc, is_iterator, sc->is_iterator_symbol, args);
- return(sc->F);
+ gc_loc = s7_gc_protect(sc, sc->nil);
+ collect_locals(sc, body, pe, arglist, gc_loc); /* collect locals used only here */
+ if (s7_is_dilambda(obj))
+ {
+ setter = closure_setter(obj);
+ if ((!(has_closure_let(setter))) ||
+ (closure_let(setter) != pe))
+ setter = NULL;
+ }
+ if (setter)
+ collect_locals(sc, closure_body(setter), pe, closure_args(setter), gc_loc);
+ local_slots = _TLst(gc_protected_at(sc, gc_loc)); /* possibly a list of slots */
+
+ if (!is_null(local_slots))
+ {
+ s7_pointer x;
+ port_write_string(port)(sc, "(let (", 6, port);
+ for (x = local_slots; is_pair(x); x = cdr(x))
+ {
+ s7_pointer slot;
+ slot = car(x);
+ port_write_character(port)(sc, '(', port);
+ port_write_string(port)(sc, symbol_name(slot_symbol(slot)), symbol_name_length(slot_symbol(slot)), port);
+ port_write_character(port)(sc, ' ', port);
+ object_out(sc, slot_value(slot), port, USE_WRITE);
+ if (is_null(cdr(x)))
+ port_write_character(port)(sc, ')', port);
+ else port_write_string(port)(sc, ") ", 2, port);
+ }
+ port_write_string(port)(sc, ") ", 2, port);
+ }
+
+ if (setter)
+ port_write_string(port)(sc, "(dilambda ", 10, port);
+
+ write_closure_readably_1(sc, obj, arglist, body, port);
+
+ if (setter)
+ {
+ port_write_character(port)(sc, ' ', port);
+ write_closure_readably_1(sc, setter, closure_args(setter), closure_body(setter), port);
+ port_write_character(port)(sc, ')', port);
+ }
+
+ if (!is_null(local_slots))
+ port_write_character(port)(sc, ')', port);
+ s7_gc_unprotect_at(sc, gc_loc);
}
-static s7_pointer iterator_copy(s7_scheme *sc, s7_pointer p)
+#if TRAP_SEGFAULT
+#include <signal.h>
+static sigjmp_buf senv; /* global here is not a problem -- it is used only to protect s7_is_valid */
+static volatile sig_atomic_t can_jump = 0;
+static void segv(int ignored) {if (can_jump) siglongjmp(senv, 1);}
+#endif
+
+bool s7_is_valid(s7_scheme *sc, s7_pointer arg)
{
- /* fields are obj cur [loc|lcur] [len|slow|hcur] next */
- s7_pointer iter;
- new_cell(sc, iter, T_ITERATOR | T_SAFE_PROCEDURE);
- 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) */
- iterator_current(iter) = iterator_current(p); /* cur */
- iterator_next(iter) = iterator_next(p); /* next */
- return(iter);
+ bool result = false;
+ if (!arg) return(false);
+
+#if TRAP_SEGFAULT
+ if (sigsetjmp(senv, 1) == 0)
+ {
+ void (*old_segv)(int sig);
+ can_jump = 1;
+ old_segv = signal(SIGSEGV, segv);
+#endif
+ result = ((!is_free(arg)) &&
+ (type(arg) < NUM_TYPES) &&
+ (arg->hloc >= not_heap) &&
+ ((arg->hloc < 0) ||
+ ((arg->hloc < (int)sc->heap_size) && (sc->heap[arg->hloc] == arg))));
+
+#if TRAP_SEGFAULT
+ signal(SIGSEGV, old_segv);
+ }
+ else result = false;
+ can_jump = 0;
+#endif
+
+ return(result);
}
+enum {NO_ARTICLE, INDEFINITE_ARTICLE};
-static s7_pointer iterator_finished(s7_scheme *sc, s7_pointer iterator)
+static char *describe_type_bits(s7_scheme *sc, s7_pointer obj)
{
- return(sc->ITERATOR_END);
+ unsigned int full_typ;
+ unsigned char typ;
+ char *buf;
+
+ buf = (char *)malloc(512 * sizeof(char));
+ typ = unchecked_type(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%x%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,
+ /* bit 0 (the first 8 bits are easy...) */
+ ((full_typ & T_KEYWORD) != 0) ? " keyword" : "",
+ /* bit 1 */
+ ((full_typ & T_SYNTACTIC) != 0) ? " syntactic" : "",
+ /* bit 2 -- currently unused */
+ /* ((full_typ & T_LOCAL_SYMBOL) != 0) ? " local-symbol" : "", */
+ "",
+ /* bit 3 */
+ ((full_typ & T_OPTIMIZED) != 0) ? ((is_c_function(obj)) ? " scope-safe" :
+ ((is_pair(obj)) ? " optimized" :
+ " ?3?")) : "",
+ /* bit 4 */
+ ((full_typ & T_SAFE_CLOSURE) != 0) ? " safe-closure" : "",
+ /* bit 5 */
+ ((full_typ & T_DONT_EVAL_ARGS) != 0) ? " dont-eval-args" : "",
+ /* bit 6 */
+ ((full_typ & T_EXPANSION) != 0) ? " expansion" : "",
+ /* bit 7 */
+ ((full_typ & T_MULTIPLE_VALUE) != 0) ? " values-or-matched" : "",
+ /* bit 8 */
+ ((full_typ & T_GLOBAL) != 0) ? ((is_pair(obj)) ? " unsafe-do" :
+ ((is_symbol(obj)) ? " global" :
+ " ?8?")) : "",
+ /* bit 9 */
+ ((full_typ & T_COLLECTED) != 0) ? " collected" : "",
+ /* bit 10 */
+ ((full_typ & T_LINE_NUMBER) != 0) ? ((is_pair(obj)) ? " line-number" :
+ ((is_input_port(obj)) ? " loader-port" :
+ ((is_let(obj)) ? " with-let" :
+ ((is_c_function(obj)) ? " simple-defaults" :
+ (((is_symbol(obj)) || (is_slot(obj))) ? " has-accessor" :
+ " ?10?"))))) : "",
+ /* bit 11 */
+ ((full_typ & T_SHARED) != 0) ? " shared" : "",
+ /* bit 12 */
+ ((full_typ & T_OVERLAY) != 0) ? ((is_symbol(obj)) ? " local" :
+ ((is_pair(obj)) ? " overlay" :
+ " ?12?")) : "",
+ /* bit 13 */
+ ((full_typ & T_SAFE_PROCEDURE) != 0) ? " safe-procedure" : "",
+ /* bit 14 */
+ ((full_typ & T_CHECKED) != 0) ? " checked" : "",
+ /* bit 15 */
+ ((full_typ & T_UNSAFE) != 0) ? ((is_symbol(obj)) ? " clean-symbol" :
+ ((is_slot(obj)) ? " has-stepper" :
+ ((is_pair(obj)) ? " unsafe-or-no-float-opt" :
+ " ?15?"))) : "",
+ /* bit 16 */
+ ((full_typ & T_IMMUTABLE) != 0) ? " immutable" : "",
+ /* bit 17 */
+ ((full_typ & T_SETTER) != 0) ? ((is_symbol(obj)) ? " setter" :
+ ((is_pair(obj)) ? " allow-other-keys-or-has-all-x-or-no-int-opt" :
+ ((is_closure(obj)) ? " has-optlist" :
+ (((is_hash_table(obj)) || (is_let(obj))) ? " removed" :
+ " ?17?")))) : "",
+ /* bit 18 */
+ ((full_typ & T_MUTABLE) != 0) ? ((is_number(obj)) ? " mutable" :
+ ((is_string(obj)) ? " byte-vector" :
+ ((is_symbol(obj)) ? " has-keyword" :
+ ((is_let(obj)) ? " let-ref-fallback" :
+ ((is_iterator(obj)) ? " mark-sequence" :
+ ((is_slot(obj)) ? " step-end" :
+ ((is_let(obj)) ? " ref-fallback" :
+ (((is_pair(obj)) || (is_any_closure(obj))) ? " no-opt" :
+ " ?18?")))))))) : "",
+ /* bit 19 */
+ ((full_typ & T_SAFE_STEPPER) != 0) ? ((is_let(obj)) ? " set-fallback" :
+ ((is_slot(obj)) ? " safe-stepper" :
+ ((is_c_function(obj)) ? " maybe-safe" :
+ ((is_number(obj)) ? " print-name" :
+ " ?19?")))) : "",
+ /* bit 20 */
+ ((full_typ & T_COPY_ARGS) != 0) ? ((is_pair(obj))? " local-symbol" :
+ (((is_any_macro(obj)) || (is_any_closure(obj))) ? " copy-args" :
+ "?20?")) : "",
+ /* bit 21 */
+ ((full_typ & T_GENSYM) != 0) ? ((is_let(obj)) ? " funclet" :
+ ((is_pair(obj)) ? " list-in-use-or-simple-arg-defaults" :
+ ((is_symbol(obj)) ? " gensym" :
+ ((is_string(obj)) ? " documented-symbol" :
+ " ?21?")))) : "",
+ /* bit 22 */
+ ((full_typ & T_HAS_METHODS) != 0) ? " has-methods" : "",
+ /* bit 23 */
+ ((full_typ & T_GC_MARK) != 0) ? " gc-marked" : "");
+ return(buf);
}
-static s7_pointer let_iterate(s7_scheme *sc, s7_pointer iterator)
+
+void s7_show_let(s7_scheme *sc) /* debugging convenience */
{
- s7_pointer slot;
- slot = iterator_current_slot(iterator);
- if (is_slot(slot))
+ s7_pointer olet;
+ for (olet = sc->envir; (is_let(olet)) && (olet != sc->rootlet); olet = outlet(olet))
{
- iterator_set_current_slot(iterator, next_slot(slot));
- if (iterator_let_cons(iterator))
+ if (olet == sc->owlet)
+ fprintf(stderr, "(owlet): ");
+ else
{
- s7_pointer p;
- p = iterator_let_cons(iterator);
- set_car(p, slot_symbol(slot));
- set_cdr(p, slot_value(slot));
- return(p);
+ if (is_funclet(olet))
+ fprintf(stderr, "(%s funclet): ", DISPLAY(funclet_function(olet)));
+ else
+ {
+ if (olet == sc->shadow_rootlet)
+ fprintf(stderr, "(shadow rootlet): ");
+ }
}
- return(cons(sc, slot_symbol(slot), slot_value(slot)));
+ fprintf(stderr, "%s\n", DISPLAY(olet));
}
- iterator_next(iterator) = iterator_finished;
- return(sc->ITERATOR_END);
}
-static s7_pointer rootlet_iterate(s7_scheme *sc, s7_pointer iterator)
+#if DEBUGGING
+static const char *check_name(int typ)
{
- s7_pointer slot;
- slot = iterator_current(iterator);
- if (is_slot(slot))
+ if ((typ >= 0) && (typ < NUM_TYPES))
{
- if (iterator_position(iterator) < sc->rootlet_entries)
+ s7_pointer p;
+ p = prepackaged_type_names[typ];
+ if (is_string(p)) return(string_value(p));
+
+ switch (typ)
{
- iterator_position(iterator)++;
- iterator_current(iterator) = vector_element(sc->rootlet, iterator_position(iterator));
+ case T_C_OBJECT: return("a c-object");
+ case T_INPUT_PORT: return("an input port");
+ case T_OUTPUT_PORT: return("an output port");
}
- else iterator_current(iterator) = sc->nil;
- return(cons(sc, slot_symbol(slot), slot_value(slot)));
}
- iterator_next(iterator) = iterator_finished;
- return(sc->ITERATOR_END);
+ return("unknown type!");
}
-static s7_pointer hash_table_iterate(s7_scheme *sc, s7_pointer iterator)
+static s7_pointer check_seti(s7_scheme *sc, s7_pointer x, const char *func, int line)
{
- s7_pointer table;
- int loc, len;
- hash_entry_t **elements;
- hash_entry_t *lst;
-
- lst = iterator_hash_current(iterator);
- if (lst)
+ if (is_immutable(x)) /* can be vector|pair|string -- incomplete constant arg check I think, TODO: handle immutable vectors */
{
- iterator_hash_current(iterator) = lst->next;
- if (iterator_current(iterator))
- {
- s7_pointer p;
- p = iterator_current(iterator);
- set_car(p, lst->key);
- set_cdr(p, lst->value);
- return(p);
- }
- return(cons(sc, lst->key, lst->value));
+ fprintf(stderr, "%s%s[%d]: set! immutable %s: %s%s\n", BOLD_TEXT, func, line, type_name(sc, x, NO_ARTICLE), DISPLAY(x), UNBOLD_TEXT);
+ if (stop_at_error) abort();
}
+ return(x);
+}
- table = iterator_sequence(iterator); /* using iterator_length and hash_table_entries here was slightly slower */
- len = hash_table_mask(table) + 1;
- elements = hash_table_elements(table);
+static char *safe_object_to_string(s7_pointer p)
+{
+ int typ;
+ char *buf;
+ typ = unchecked_type(p);
+ if ((typ > T_FREE) && (typ < NUM_TYPES))
+ return(s7_object_to_c_string(cur_sc, p));
+ buf = (char *)calloc(128, sizeof(char));
+ snprintf(buf, 128, "type=%d", typ);
+ return(buf);
+}
- for (loc = iterator_position(iterator) + 1; loc < len; loc++)
+static s7_pointer check_ref(s7_pointer p, int expected_type, const char *func, int line, const char *func1, const char *func2)
+{
+ if (!p)
+ fprintf(stderr, "%s[%d]: null pointer passed to check_ref\n", func, line);
+ else
{
- hash_entry_t *x;
- x = elements[loc];
- if (x)
+ int typ;
+ typ = unchecked_type(p);
+ if (typ != expected_type)
{
- iterator_position(iterator) = loc;
- iterator_hash_current(iterator) = x->next;
- if (iterator_current(iterator))
+ if ((!func1) || (typ != T_FREE))
{
- s7_pointer p;
- p = iterator_current(iterator);
- set_car(p, x->key);
- set_cdr(p, x->value);
- return(p);
+ fprintf(stderr, "%s%s[%d]: not %s, but %s (%s)%s\n",
+ BOLD_TEXT,
+ func, line, check_name(expected_type), check_name(typ), safe_object_to_string(p),
+ UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ else
+ {
+ if ((strcmp(func, func1) != 0) &&
+ ((!func2) || (strcmp(func, func2) != 0)))
+ {
+ fprintf(stderr, "%s%s[%d]: free cell, not %s%s\n", BOLD_TEXT, func, line, check_name(expected_type), UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
}
- return(cons(sc, x->key, x->value));
}
}
- iterator_next(iterator) = iterator_finished;
- return(sc->ITERATOR_END);
+ return(p);
}
-static s7_pointer string_iterate(s7_scheme *sc, s7_pointer obj)
+static s7_pointer check_ref2(s7_pointer p, int expected_type, int other_type, const char *func, int line, const char *func1, const char *func2)
{
- 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;
- return(sc->ITERATOR_END);
+ if (!p)
+ fprintf(stderr, "%s[%d]: null pointer passed to check_ref2\n", func, line);
+ else
+ {
+ int typ;
+ typ = unchecked_type(p);
+ if ((typ != expected_type) && (typ != other_type))
+ return(check_ref(p, expected_type, func, line, func1, func2));
+ }
+ return(p);
}
-static s7_pointer byte_vector_iterate(s7_scheme *sc, s7_pointer obj)
+static s7_pointer check_ref3(s7_pointer p, const char *func, int line)
{
- 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;
- return(sc->ITERATOR_END);
+ int typ;
+ typ = unchecked_type(p);
+ if ((typ != T_INPUT_PORT) && (typ != T_OUTPUT_PORT) && (typ != T_FREE))
+ {
+ fprintf(stderr, "%s%s[%d]: not a port, but %s (%s)%s\n",
+ BOLD_TEXT,
+ func, line, check_name(typ), safe_object_to_string(p),
+ UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ return(p);
}
-static s7_pointer float_vector_iterate(s7_scheme *sc, s7_pointer obj)
+static s7_pointer check_ref4(s7_pointer p, const char *func, int line)
{
- 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;
- return(sc->ITERATOR_END);
+ int typ;
+ typ = unchecked_type(p);
+ if ((typ != T_VECTOR) && (typ != T_FLOAT_VECTOR) && (typ != T_INT_VECTOR) && (typ != T_FREE))
+ {
+ fprintf(stderr, "%s%s[%d]: not a vector, but %s (%s)%s\n",
+ BOLD_TEXT,
+ func, line, check_name(typ), safe_object_to_string(p),
+ UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ return(p);
}
-static s7_pointer int_vector_iterate(s7_scheme *sc, s7_pointer obj)
+static s7_pointer check_ref5(s7_pointer p, const char *func, int line)
{
- 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;
- return(sc->ITERATOR_END);
+ int typ;
+ typ = unchecked_type(p);
+ if (!t_has_closure_let[typ])
+ {
+ fprintf(stderr, "%s%s[%d]: not a closure, but %s (%s)%s\n",
+ BOLD_TEXT,
+ func, line, check_name(typ), safe_object_to_string(p),
+ UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ return(p);
}
-static s7_pointer vector_iterate(s7_scheme *sc, s7_pointer obj)
+static s7_pointer check_ref6(s7_pointer p, const char *func, int line)
{
- if (iterator_position(obj) < iterator_length(obj))
- return(vector_element(iterator_sequence(obj), iterator_position(obj)++));
- iterator_next(obj) = iterator_finished;
- return(sc->ITERATOR_END);
+ int typ;
+ typ = unchecked_type(p);
+ if ((typ < T_C_FUNCTION_STAR) && (typ != T_C_MACRO))
+ {
+ fprintf(stderr, "%s%s[%d]: not a c function, but %s (%s)%s\n",
+ BOLD_TEXT,
+ func, line, check_name(typ), safe_object_to_string(p),
+ UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ return(p);
}
-static s7_pointer closure_iterate(s7_scheme *sc, s7_pointer obj)
+static s7_pointer check_ref7(s7_pointer p, const char *func, int line)
{
- s7_pointer result;
- result = s7_apply_function(sc, iterator_sequence(obj), sc->nil);
- if (result == sc->ITERATOR_END)
- iterator_next(obj) = iterator_finished;
- return(result);
+ if ((!func) || (strcmp(func, "decribe_type_bits") != 0))
+ {
+ int typ;
+ typ = unchecked_type(p);
+ if ((typ < T_INTEGER) || (typ > T_COMPLEX))
+ {
+ fprintf(stderr, "%s%s[%d]: not a number, but %s (%s)%s\n",
+ BOLD_TEXT,
+ func, line, check_name(typ), safe_object_to_string(p),
+ UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ }
+ return(p);
}
-static s7_pointer c_object_direct_iterate(s7_scheme *sc, s7_pointer obj)
+static s7_pointer check_ref8(s7_pointer p, const char *func, int line)
{
- if (iterator_position(obj) < iterator_length(obj))
+ int typ;
+ typ = unchecked_type(p);
+ if ((!t_sequence_p[typ]) && (!t_structure_p[typ]) && (!is_any_closure(p))) /* closure calling itself an iterator?? */
{
- s7_pointer result, p;
- p = iterator_sequence(obj);
- result = c_object_cref(p)(sc, p, iterator_position(obj));
- iterator_position(obj)++;
- if (result == sc->ITERATOR_END)
- iterator_next(obj) = iterator_finished;
- return(result);
+ fprintf(stderr, "%s%s[%d]: not a sequence or structure, but %s (%s)%s\n",
+ BOLD_TEXT,
+ func, line, check_name(typ), safe_object_to_string(p),
+ UNBOLD_TEXT);
+ if (stop_at_error) abort();
}
- iterator_next(obj) = iterator_finished;
- return(sc->ITERATOR_END);
+ return(p);
}
-static s7_pointer c_object_iterate(s7_scheme *sc, s7_pointer obj)
+static s7_pointer check_ref9(s7_pointer p, const char *func, int line)
{
- if (iterator_position(obj) < iterator_length(obj))
+ int typ;
+ typ = unchecked_type(p);
+ if ((typ != T_LET) && (typ != T_C_OBJECT) && (!is_any_closure(p)) && (!is_any_macro(p)))
{
- s7_pointer result, p, cur;
- p = iterator_sequence(obj);
- cur = iterator_current(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);
- 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;
- return(result);
+ fprintf(stderr, "%s%s[%d]: not a possible method holder, but %s (%s)%s\n",
+ BOLD_TEXT,
+ func, line, check_name(typ), safe_object_to_string(p),
+ UNBOLD_TEXT);
+ if (stop_at_error) abort();
}
- iterator_next(obj) = iterator_finished;
- return(sc->ITERATOR_END);
+ return(p);
}
+static s7_pointer check_ref10(s7_pointer p, const char *func, int line)
+{
+ int typ;
+ typ = unchecked_type(p);
+ if ((typ != T_PAIR) && (typ != T_NIL) && (typ != T_SYMBOL))
+ {
+ fprintf(stderr, "%s%s[%d]: arglist is %s (%s)%s?\n",
+ BOLD_TEXT,
+ func, line, check_name(typ), safe_object_to_string(p),
+ UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ return(p);
+}
-static s7_pointer pair_iterate_1(s7_scheme *sc, s7_pointer obj);
-static s7_pointer pair_iterate(s7_scheme *sc, s7_pointer obj)
+static s7_pointer check_ref11(s7_pointer p, const char *func, int line)
{
- if (is_pair(iterator_current(obj)))
+ int typ;
+ typ = unchecked_type(p);
+ if ((typ < T_CLOSURE) && (typ != T_BOOLEAN)) /* actually #t is an error here */
{
- s7_pointer result;
- result = car(iterator_current(obj));
- iterator_current(obj) = cdr(iterator_current(obj));
- if (iterator_current(obj) == iterator_slow(obj))
- {
- iterator_next(obj) = iterator_finished;
- return(result);
- }
- iterator_next(obj) = pair_iterate_1;
- return(result);
+ fprintf(stderr, "%s%s[%d]: setter is %s (%s)%s?\n",
+ BOLD_TEXT,
+ func, line, check_name(typ), safe_object_to_string(p),
+ UNBOLD_TEXT);
+ if (stop_at_error) abort();
}
- iterator_next(obj) = iterator_finished;
- return(sc->ITERATOR_END);
+ return(p);
}
-static s7_pointer pair_iterate_1(s7_scheme *sc, s7_pointer obj)
+static s7_pointer check_sym(s7_scheme *sc, s7_pointer sym)
{
- if (is_pair(iterator_current(obj)))
+ if (!is_slot(local_slot(sym)))
+ fprintf(stderr, "%s local_slot: %s\n", DISPLAY(sym), DISPLAY(local_slot(sym)));
+ else
{
- s7_pointer result;
- result = car(iterator_current(obj));
- iterator_current(obj) = cdr(iterator_current(obj));
- if (iterator_current(obj) == iterator_slow(obj))
+ s7_pointer local_val, search_val;
+ local_val = slot_value(local_slot(sym));
+ search_val = find_symbol_checked(sc, sym);
+ if (local_val != search_val)
{
- iterator_next(obj) = iterator_finished;
- return(result);
+ fprintf(stderr, "local %s: %p %p ", symbol_name(sym), local_val, search_val);
+ fprintf(stderr, "%s ", DISPLAY_80(local_val));
+ fprintf(stderr, "%s", DISPLAY_80(search_val));
+ fprintf(stderr, "\n");
}
- iterator_set_slow(obj, cdr(iterator_slow(obj)));
- iterator_next(obj) = pair_iterate;
- return(result);
+ return(local_val);
}
- iterator_next(obj) = iterator_finished;
- return(sc->ITERATOR_END);
+ return(sc->nil);
}
-static s7_pointer iterator_method(s7_scheme *sc, s7_pointer e)
+static s7_pointer check_cell(s7_pointer p, const char *func, int line)
{
- s7_pointer func;
- if ((has_methods(e)) &&
- ((func = find_method(sc, find_let(sc, e), sc->make_iterator_symbol)) != sc->undefined))
+ int typ;
+ if (!p)
{
- s7_pointer it;
- it = s7_apply_function(sc, func, list_1(sc, e));
- if (!is_iterator(it))
- return(s7_error(sc, sc->error_symbol, set_elist_2(sc, make_string_wrapper(sc, "make-iterator method must return an interator: ~S"), it)));
- return(it);
+ fprintf(stderr, "%s%s[%d]: null pointer!%s\n", BOLD_TEXT, func, line, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ typ = unchecked_type(p);
+ if ((typ < 0) || (typ >= NUM_TYPES))
+ {
+ fprintf(stderr, "%s%s[%d]: attempt to use messed up cell (type: %d)%s\n", BOLD_TEXT, func, line, typ, UNBOLD_TEXT);
+ if (stop_at_error) abort();
}
- return(NULL);
+ return(p);
}
-s7_pointer s7_make_iterator(s7_scheme *sc, s7_pointer e)
+static s7_pointer check_nref(s7_pointer p, const char *func, int line)
{
- s7_pointer iter;
-
- new_cell(sc, iter, T_ITERATOR | T_SAFE_PROCEDURE);
- iterator_sequence(iter) = e;
- iterator_position(iter) = 0;
+ int typ;
+ check_cell(p, func, line);
+ typ = unchecked_type(p);
+ if (typ == T_FREE)
+ {
+ fprintf(stderr, "%s%s[%d]: attempt to use free cell%s\n", BOLD_TEXT, func, line, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ return(p);
+}
- switch (type(e))
+static void print_gc_info(s7_pointer obj, int line)
+{
+ if (!obj)
+ fprintf(stderr, "[%d]: obj is %p\n", line, obj);
+ else
{
- case T_LET:
- if (e == sc->rootlet)
- {
- iterator_current(iter) = vector_element(e, 0); /* unfortunately tricky -- let_iterate uses different fields */
- iterator_next(iter) = rootlet_iterate;
- }
+ if (unchecked_type(obj) != T_FREE)
+ fprintf(stderr, "[%d]: %p type is %d?\n", line, obj, type(obj));
else
{
- s7_pointer f;
- sc->temp6 = iter;
- f = iterator_method(sc, e);
- sc->temp6 = sc->nil;
- if (f) {free_cell(sc, iter); return(f);}
- iterator_set_current_slot(iter, let_slots(e));
- iterator_next(iter) = let_iterate;
- iterator_let_cons(iter) = NULL;
+ fprintf(stderr, "%s%p is free (line %d), current: %s[%d], previous: %s[%d], gc call: %s[%d], alloc: %s[%d]%s\n",
+ BOLD_TEXT,
+ obj, line,
+ obj->current_alloc_func, obj->current_alloc_line,
+ obj->previous_alloc_func, obj->previous_alloc_line,
+ obj->gc_func, obj->gc_line, obj->alloc_func, obj->alloc_line,
+ UNBOLD_TEXT);
}
- break;
+ }
+ abort();
+}
- case T_HASH_TABLE:
- iterator_hash_current(iter) = NULL;
- iterator_current(iter) = NULL;
- iterator_position(iter) = -1;
- iterator_next(iter) = hash_table_iterate;
- break;
+static const char *opt1_role_name(int role)
+{
+ if (role == E_FAST) return("opt_fast");
+ if (role == E_BACK) return("opt_back");
+ if (role == E_CFUNC) return("opt_cfunc");
+ if (role == E_LAMBDA) return("opt_lambda");
+ if (role == E_CLAUSE) return("opt_clause");
+ if (role == E_GOTO) return("opt_goto");
+ if (role == E_SYM) return("opt_sym1");
+ if (role == E_PAIR) return("opt_pair1");
+ if (role == E_CON) return("opt_con1");
+ if (role == E_ANY) return("opt_any1");
+ if (role == E_SLOT) return("opt_slot1");
+ return("unknown");
+}
+
+static const char *opt2_role_name(int role)
+{
+ if (role == F_CALL) return("c_call(ee)");
+ if (role == F_KEY) return("opt_key");
+ if (role == F_SLOW) return("opt_slow");
+ if (role == F_SYM) return("opt_sym2");
+ if (role == F_PAIR) return("opt_pair2");
+ if (role == F_CON) return("opt_con2");
+ if (role == F_LAMBDA) return("opt_lambda2");
+ return("unknown");
+}
+
+static const char *opt3_role_name(int 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_CTR) return("oops: unused bit!");
+ if (role == S_OP) return("s_op");
+ if (role == S_SYNOP) return("s_synop");
+ if (role == S_LEN) return("s_len");
+ if (role == S_LINE) return("s_line");
+ if (role == S_HASH) return("s_hash");
+ return("unknown");
+}
+
+static char* show_debugger_bits(unsigned int bits)
+{
+ char *bits_str;
+ bits_str = (char *)calloc(512, sizeof(char));
+ snprintf(bits_str, 512, " %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%s%s%s%s%s%s",
+ ((bits & E_SET) != 0) ? " e-set" : "",
+ ((bits & E_FAST) != 0) ? " opt_fast" : "",
+ ((bits & E_CFUNC) != 0) ? " opt_cfunc" : "",
+ ((bits & E_CLAUSE) != 0) ? " opt_clause" : "",
+ ((bits & E_BACK) != 0) ? " opt_back" : "",
+ ((bits & E_LAMBDA) != 0) ? " opt_lambda" : "",
+ ((bits & E_SYM) != 0) ? " opt_sym1" : "",
+ ((bits & E_PAIR) != 0) ? " opt_pair1" : "",
+ ((bits & E_CON) != 0) ? " opt_con1" : "",
+ ((bits & E_GOTO) != 0) ? " opt_goto" : "",
+ ((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_SLOW) != 0) ? " opt_slow" : "",
+ ((bits & F_SYM) != 0) ? " opt_sym2" : "",
+ ((bits & F_PAIR) != 0) ? " opt_pair2" : "",
+ ((bits & F_CON) != 0) ? " opt_con2" : "",
+ ((bits & F_CALL) != 0) ? " c_call(ee)" : "",
+ ((bits & F_LAMBDA) != 0) ? " opt_lambda2" : "",
+ ((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_CTR) != 0) ? " ???" : "",
+ ((bits & S_NAME) != 0) ? " raw-name" : "",
+ ((bits & S_HASH) != 0) ? " raw-hash" : "",
+ ((bits & S_LINE) != 0) ? " line" : "",
+ ((bits & S_LEN) != 0) ? " len" : "",
+ ((bits & S_OP) != 0) ? " op" : "",
+ ((bits & S_SYNOP) != 0) ? " syn-op" : "");
+ return(bits_str);
+}
+
+static void show_opt1_bits(s7_scheme *sc, s7_pointer p, const char *func, int line, unsigned int role)
+{
+ char *bits;
+ bits = show_debugger_bits(p->debugger_bits);
+ fprintf(stderr, "%s%s[%d]: opt1: %p->%p wants %s, debugger bits are %x%s but expects %x%s\n",
+ BOLD_TEXT,
+ func, line, p, p->object.cons.opt1,
+ opt1_role_name(role),
+ p->debugger_bits, bits, role,
+ UNBOLD_TEXT);
+ free(bits);
+}
- case T_STRING:
- iterator_length(iter) = string_length(e);
- if (is_byte_vector(e))
- iterator_next(iter) = byte_vector_iterate;
- else iterator_next(iter) = string_iterate;
- break;
+static s7_pointer opt1_1(s7_scheme *sc, s7_pointer p, unsigned int role, const char *func, int line)
+{
+ if ((!opt1_is_set(p)) ||
+ ((!opt1_role_matches(p, role)) &&
+ (role != E_ANY)))
+ {
+ show_opt1_bits(sc, p, func, line, role);
+ if (stop_at_error) abort();
+ }
+ return(p->object.cons.opt1);
+}
- case T_VECTOR:
- iterator_length(iter) = vector_length(e);
- iterator_next(iter) = vector_iterate;
- break;
+static s7_pointer set_opt1_1(s7_scheme *sc, s7_pointer p, s7_pointer x, unsigned int role, const char *func, int line)
+{
+ /* fprintf(stderr, "%s[%d]:%d set %p %p\n", func, line, role, p, x); */
+ p->object.cons.opt1 = x;
+ set_opt1_role(p, role);
+ set_opt1_is_set(p);
+ return(x);
+}
- case T_INT_VECTOR:
- iterator_length(iter) = vector_length(e);
- iterator_next(iter) = int_vector_iterate;
- break;
+static unsigned long long int s_hash_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
+{
+ if ((!opt1_is_set(p)) ||
+ (!opt1_role_matches(p, S_HASH)))
+ {
+ show_opt1_bits(sc, p, func, line, (unsigned int)S_HASH);
+ if (stop_at_error) abort();
+ }
+ return(p->object.sym_cons.hash);
+}
- case T_FLOAT_VECTOR:
- iterator_length(iter) = vector_length(e);
- iterator_next(iter) = float_vector_iterate;
- break;
+static void set_s_hash_1(s7_scheme *sc, s7_pointer p, unsigned long long int x, const char *func, int line)
+{
+ p->object.sym_cons.hash = x;
+ set_opt1_role(p, S_HASH);
+ set_opt1_is_set(p);
+}
- case T_PAIR:
- iterator_current(iter) = e;
- iterator_next(iter) = pair_iterate;
- iterator_set_slow(iter, e);
- break;
-
- case T_MACRO: case T_MACRO_STAR:
- case T_BACRO: case T_BACRO_STAR:
- case T_CLOSURE: case T_CLOSURE_STAR:
- {
- s7_pointer p;
- p = cons(sc, e, sc->nil);
- if (g_is_iterator(sc, p) != sc->F)
- {
- set_car(p, small_int(0));
- iterator_current(iter) = p;
- set_mark_seq(iter);
- iterator_next(iter) = closure_iterate;
- if (has_methods(e))
- iterator_length(iter) = closure_length(sc, e);
- else iterator_length(iter) = s7_int_max;
- }
- else
- {
- free_cell(sc, iter);
- return(simple_wrong_type_argument_with_type(sc, sc->make_iterator_symbol, e, make_string_wrapper(sc, "a closure/macro with an 'iterator local that is not #f")));
- }
- }
- 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);
- }
- else
- {
- s7_pointer f;
- sc->temp6 = iter;
- f = iterator_method(sc, e);
- sc->temp6 = sc->nil;
- if (f) {free_cell(sc, iter); return(f);}
- iterator_current(iter) = cons(sc, small_int(0), sc->nil);
- set_mark_seq(iter);
- iterator_next(iter) = c_object_iterate;
- }
- break;
+static void show_opt2_bits(s7_scheme *sc, s7_pointer p, const char *func, int line, unsigned int role)
+{
+ char *bits;
+ bits = show_debugger_bits(p->debugger_bits);
+ fprintf(stderr, "%s%s[%d]: opt2: %p->%p wants %s, debugger bits are %x%s but expects %x%s%s%s%s%s%s%s%s%s%s\n",
+ BOLD_TEXT,
+ func, line, p, p->object.cons.opt2,
+ opt2_role_name(role),
+ p->debugger_bits, bits, role,
+ ((role & F_SET) != 0) ? " f-set" : "",
+ ((role & F_KEY) != 0) ? " key" : "",
+ ((role & F_SLOW) != 0) ? " slow" : "",
+ ((role & F_SYM) != 0) ? " sym" : "",
+ ((role & F_PAIR) != 0) ? " pair" : "",
+ ((role & F_CON) != 0) ? " con" : "",
+ ((role & F_CALL) != 0) ? " call" : "",
+ ((role & F_LAMBDA) != 0) ? " lambda" : "",
+ ((role & S_NAME) != 0) ? " raw-name" : "",
+ UNBOLD_TEXT);
+ free(bits);
+}
- default:
- return(simple_wrong_type_argument_with_type(sc, sc->make_iterator_symbol, e, a_sequence_string));
+static s7_pointer opt2_1(s7_scheme *sc, s7_pointer p, unsigned int role, const char *func, int line)
+{
+ if ((!opt2_is_set(p)) ||
+ (!opt2_role_matches(p, role)))
+ {
+ show_opt2_bits(sc, p, func, line, role);
+ fprintf(stderr, "p: %s\n", DISPLAY(p));
+ if (stop_at_error) abort();
}
- return(iter);
+ return(p->object.cons.opt2);
}
-
-static s7_pointer g_make_iterator(s7_scheme *sc, s7_pointer args)
+static void set_opt2_1(s7_scheme *sc, s7_pointer p, s7_pointer x, unsigned int role, const char *func, int line)
{
- #define H_make_iterator "(make-iterator sequence) returns an iterator object that \
-returns the next value in the sequence each time it is called. When it reaches the end, it returns " ITERATOR_END_NAME "."
- #define Q_make_iterator s7_make_signature(sc, 3, sc->is_iterator_symbol, sc->is_sequence_symbol, sc->is_pair_symbol)
-
- s7_pointer seq;
- seq = car(args);
-
- if (is_pair(cdr(args)))
+ if ((role == F_CALL) &&
+ (x == NULL)) /* this happens apparently innocuously in check_and|or */
{
- if (is_pair(cadr(args)))
- {
- if (is_hash_table(seq))
- {
- s7_pointer iter;
- iter = s7_make_iterator(sc, seq);
- iterator_current(iter) = cadr(args);
- set_mark_seq(iter);
- return(iter);
- }
- if ((is_let(seq)) && (seq != sc->rootlet))
- {
- s7_pointer iter;
- iter = s7_make_iterator(sc, seq);
- iterator_let_cons(iter) = cadr(args);
- set_mark_seq(iter);
- return(iter);
- }
- }
- else return(simple_wrong_type_argument(sc, sc->make_iterator_symbol, cadr(args), T_PAIR));
+ if ((safe_strcmp(func, "check_and") != 0) &&
+ (safe_strcmp(func, "check_or") != 0))
+ fprintf(stderr, "%s[%d]: set c_call for %s to null\n", func, line, DISPLAY_80(p));
}
- return(s7_make_iterator(sc, seq));
+ p->object.cons.opt2 = x;
+ set_opt2_role(p, role);
+ set_opt2_is_set(p);
}
-PF_TO_PF(make_iterator, s7_make_iterator)
+static const char *s_name_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
+{
+ if ((!opt2_is_set(p)) ||
+ (!opt2_role_matches(p, S_NAME)))
+ {
+ show_opt2_bits(sc, p, func, line, (unsigned int)S_NAME);
+ if (stop_at_error) abort();
+ }
+ return(p->object.sym_cons.fstr);
+}
+static void set_s_name_1(s7_scheme *sc, s7_pointer p, const char *str, const char *func, int line)
+{
+ p->object.sym_cons.fstr = str;
+ set_opt2_role(p, S_NAME);
+ set_opt2_is_set(p);
+}
-static s7_pointer c_iterate(s7_scheme *sc, s7_pointer iter)
+static void show_opt3_bits(s7_scheme *sc, s7_pointer p, const char *func, int line, int role)
{
- if (!is_iterator(iter))
- method_or_bust(sc, iter, sc->iterate_symbol, list_1(sc, iter), T_ITERATOR, 0);
- return((iterator_next(iter))(sc, iter));
+ char *bits;
+ bits = show_debugger_bits(p->debugger_bits);
+ fprintf(stderr, "%s%s[%d]: opt3: %s %x%s%s\n",
+ BOLD_TEXT,
+ func, line, opt3_role_name(role), p->debugger_bits, bits,
+ UNBOLD_TEXT);
+ free(bits);
}
-static s7_pointer g_iterate(s7_scheme *sc, s7_pointer args)
+static s7_pointer opt3_1(s7_scheme *sc, s7_pointer p, unsigned int role, const char *func, int line)
{
- #define H_iterate "(iterate obj) returns the next element from the iterator obj, or " ITERATOR_END_NAME "."
- #define Q_iterate s7_make_signature(sc, 2, sc->T, sc->is_iterator_symbol)
+ if ((!opt3_is_set(p)) ||
+ (!opt3_role_matches(p, role)))
+ {
+ show_opt3_bits(sc, p, func, line, role);
+ if (stop_at_error) abort();
+ }
+ return(p->object.cons.opt3);
+}
- s7_pointer iter;
- iter = car(args);
- if (!is_iterator(iter))
- method_or_bust(sc, iter, sc->iterate_symbol, args, T_ITERATOR, 0);
- return((iterator_next(iter))(sc, iter));
+static void set_opt3_1(s7_scheme *sc, s7_pointer p, s7_pointer x, unsigned int role, const char *func, int line)
+{
+ typeflag(p) &= ~(T_OPTIMIZED | T_LINE_NUMBER);
+ p->object.cons.opt3 = x;
+ set_opt3_is_set(p);
+ set_opt3_role(p, role);
}
-static s7_pointer iterate_pf_p(s7_scheme *sc, s7_pointer **p)
+/* S_LINE */
+static unsigned int s_line_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
{
- s7_pf_t f;
- s7_pointer x;
- f = (s7_pf_t)(**p); (*p)++;
- x = f(sc, p);
- return(c_iterate(sc, x));
+ if ((!opt3_is_set(p)) ||
+ ((p->debugger_bits & S_LINE) == 0) ||
+ (!has_line_number(p)))
+ {
+ show_opt3_bits(sc, p, func, line, (unsigned int)S_LINE);
+ if (stop_at_error) abort();
+ }
+ return(p->object.sym_cons.line);
}
-static s7_pointer iterate_pf_s(s7_scheme *sc, s7_pointer **p)
+static void set_s_line_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line)
{
- pf_pf_t f;
- s7_pointer x;
- x = (s7_pointer)(**p); (*p)++;
- f = (pf_pf_t)(**p); (*p)++;
- return(f(sc, x));
+ p->object.sym_cons.line = x;
+ (p)->debugger_bits = (S_LINE | (p->debugger_bits & ~S_LEN)); /* turn on line, cancel len */
+ set_opt3_is_set(p);
}
-static s7_pf_t iterate_gf(s7_scheme *sc, s7_pointer expr)
+/* S_LEN (collides with S_LINE) */
+static unsigned int s_len_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
{
- if ((is_pair(cdr(expr))) && (is_null(cddr(expr))))
+ if ((!opt3_is_set(p)) ||
+ ((p->debugger_bits & S_LEN) == 0) ||
+ (has_line_number(p)))
{
- s7_pointer a1, obj;
- a1 = cadr(expr);
- if ((is_symbol(a1)) &&
- (!s7_xf_is_stepper(sc, a1)) &&
- (is_iterator(obj = s7_symbol_value(sc, a1))))
- {
- s7_xf_store(sc, obj);
- s7_xf_store(sc, (s7_pointer)iterator_next(obj));
- return(iterate_pf_s);
- }
- if (s7_arg_to_pf(sc, a1))
- return(iterate_pf_p);
+ show_opt3_bits(sc, p, func, line, (unsigned int)S_LEN);
+ if (stop_at_error) abort();
}
- return(NULL);
+ return(p->object.sym_cons.line);
+}
+
+static void set_s_len_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line)
+{
+ typeflag(p) &= ~(T_LINE_NUMBER);
+ p->object.sym_cons.line = x;
+ (p)->debugger_bits = (S_LEN | (p->debugger_bits & ~(S_LINE)));
+ set_opt3_is_set(p);
}
-static s7_pf_t iterate_pf(s7_scheme *sc, s7_pointer expr)
+/* S_OP */
+static unsigned int s_op_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
{
- if ((is_pair(cdr(expr))) && (is_null(cddr(expr))))
+ if ((!opt3_is_set(p)) ||
+ ((p->debugger_bits & (S_OP | S_SYNOP)) == 0))
{
- s7_pointer a1, obj;
- a1 = cadr(expr);
- if ((is_symbol(a1)) &&
- (!s7_xf_is_stepper(sc, a1)) &&
- (is_iterator(obj = s7_symbol_value(sc, a1))))
- {
- s7_pointer seq;
- seq = iterator_sequence(obj);
- if ((type(seq) == T_VECTOR) || (is_string(seq)) || (is_pair(seq)))
- {
- s7_xf_store(sc, obj);
- s7_xf_store(sc, (s7_pointer)iterator_next(obj));
- return(iterate_pf_s);
- }
- }
+ show_opt3_bits(sc, p, func, line, (unsigned int)S_SYNOP);
+ if (stop_at_error) abort();
}
- return(NULL);
+ return(p->object.sym_cons.op);
}
-s7_pointer s7_iterate(s7_scheme *sc, s7_pointer obj)
+static void set_s_op_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line)
{
- return((iterator_next(obj))(sc, obj));
+ p->object.sym_cons.op = x;
+ (p)->debugger_bits = (S_OP | (p->debugger_bits & ~(S_SYNOP)));
+ set_opt3_is_set(p);
}
-bool s7_is_iterator(s7_pointer obj)
+/* S_SYNOP (collides with S_OP, but the optimize bit needs to stay on) */
+static unsigned int s_syn_op_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
{
- return(is_iterator(obj));
+ if ((!opt3_is_set(p)) ||
+ ((p->debugger_bits & (S_SYNOP | S_OP)) == 0))
+ {
+ show_opt3_bits(sc, p, func, line, (unsigned int)S_OP);
+ if (stop_at_error) abort();
+ }
+ return(p->object.sym_cons.op);
}
-bool s7_iterator_is_at_end(s7_pointer obj)
+static void set_s_syn_op_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line)
{
- return(iterator_is_at_end(obj));
+ p->object.sym_cons.op = x;
+ (p)->debugger_bits = (S_SYNOP | (p->debugger_bits & ~(S_OP)));
+ set_opt3_is_set(p);
}
-
-static s7_pointer g_iterator_sequence(s7_scheme *sc, s7_pointer args)
+static void print_debugging_state(s7_scheme *sc, s7_pointer obj, s7_pointer port)
{
- #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)
+ /* show current state, current allocated state, and previous allocated state.
+ */
+ char *current_bits, *allocated_bits, *previous_bits, *str;
+ int save_typeflag, len, nlen;
+ const char *excl_name;
- s7_pointer iter;
+ if (is_free(obj))
+ excl_name = "free cell!";
+ else excl_name = "unknown object!";
- iter = car(args);
- if (!is_iterator(iter))
- return(simple_wrong_type_argument(sc, sc->iterator_sequence_symbol, iter, T_ITERATOR));
- return(iterator_sequence(iter));
-}
+ current_bits = describe_type_bits(sc, obj);
+ save_typeflag = typeflag(obj);
+ typeflag(obj) = obj->current_alloc_type;
+ allocated_bits = describe_type_bits(sc, obj);
+ typeflag(obj) = obj->previous_alloc_type;
+ previous_bits = describe_type_bits(sc, obj);
+ typeflag(obj) = save_typeflag;
-static s7_pointer c_iterator_sequence(s7_scheme *sc, s7_pointer iter)
-{
- if (!is_iterator(iter))
- return(simple_wrong_type_argument(sc, sc->iterator_sequence_symbol, iter, T_ITERATOR));
- return(iterator_sequence(iter));
-}
+ len = safe_strlen(excl_name) +
+ safe_strlen(current_bits) + safe_strlen(allocated_bits) + safe_strlen(previous_bits) +
+ safe_strlen(obj->previous_alloc_func) + safe_strlen(obj->current_alloc_func) + 512;
+ tmpbuf_malloc(str, len);
+
+ nlen = snprintf(str, len,
+ "\n<%s %s,\n current: %s[%d] %s,\n previous: %s[%d] %s\n hloc: %d (%d uses), free: %s[%d], alloc: %s[%d]>",
+ excl_name, current_bits,
+ obj->current_alloc_func, obj->current_alloc_line, allocated_bits,
+ obj->previous_alloc_func, obj->previous_alloc_line, previous_bits,
+ heap_location(obj), obj->uses,
+ obj->gc_func, obj->gc_line, obj->alloc_func, obj->alloc_line);
-PF_TO_PF(iterator_sequence, c_iterator_sequence)
+ free(current_bits);
+ free(allocated_bits);
+ free(previous_bits);
+ if (is_null(port))
+ fprintf(stderr, "%p: %s\n", obj, str);
+ else port_write_string(port)(sc, str, nlen, port);
+ tmpbuf_free(str, len);
+}
+#if DEBUGGING
+static s7_pointer g_is_local_symbol(s7_scheme *sc, s7_pointer p) {return(make_boolean(sc, is_local_symbol(car(p))));}
+#endif
-static s7_pointer g_iterator_is_at_end(s7_scheme *sc, s7_pointer args)
+static s7_pointer check_null_sym(s7_scheme *sc, s7_pointer p, s7_pointer sym, int line, const char *func)
{
- #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;
+ if (!p)
+ {
+ fprintf(stderr, "%s%s[%d]: %s unbound%s\n", BOLD_TEXT, func, line, symbol_name(sym), UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ return(p);
+}
- 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)));
+#if 0
+/* 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
+ * maybe T_SAFE_STEPPER for unsafe_locals
+ */
+static void check_pair_bits(s7_scheme *sc, s7_pointer p)
+{
+ /* if ((typeflag(p) & T_MUTABLE) != 0) fprintf(stderr, "mutable: %s\n", DISPLAY_80(p)); */ /* now no_opt flag */
+ if ((typeflag(p) & T_IMMUTABLE) != 0) fprintf(stderr, "immutable: %s\n", DISPLAY_80(p));
+ if ((typeflag(p) & T_GENSYM) != 0) fprintf(stderr, "gensym: %s\n", DISPLAY_80(p));
+ if ((typeflag(p) & T_SETTER) != 0) fprintf(stderr, "setter: %s\n", DISPLAY_80(p));
+ if ((typeflag(p) & T_COPY_ARGS) != 0) fprintf(stderr, "copy_args: %s\n", DISPLAY_80(p));
+ if ((typeflag(p) & T_SAFE_STEPPER) != 0) fprintf(stderr, "safe_stepper: %s\n", DISPLAY_80(p));
}
+#endif
+#endif
+static void iterator_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ if (use_write == USE_READABLE_WRITE)
+ {
+ if (iterator_is_at_end(obj))
+ port_write_string(port)(sc, "(make-iterator #())", 19, port);
+ else
+ {
+ s7_pointer seq;
+ seq = iterator_sequence(obj);
+ if ((is_string(seq)) && (!is_byte_vector(seq)))
+ {
+ port_write_string(port)(sc, "(make-iterator \"", 16, port);
+ port_write_string(port)(sc, (char *)(string_value(seq) + iterator_position(obj)), string_length(seq) - iterator_position(obj), port);
+ port_write_string(port)(sc, "\")", 2, port);
+ }
+ else
+ {
+ if (iterator_position(obj) > 0)
+ port_write_string(port)(sc, "(let ((iter (make-iterator ", 27, port);
+ else port_write_string(port)(sc, "(make-iterator ", 15, port);
+ object_to_port_with_circle_check(sc, iterator_sequence(obj), port, use_write, ci);
+ if (iterator_position(obj) > 0)
+ {
+ int nlen;
+ char *str;
+ str = (char *)malloc(128 * sizeof(char));
+ nlen = snprintf(str, 128, "))) (do ((i 0 (+ i 1))) ((= i %" LL_D ") iter) (iterate iter)))", iterator_position(obj));
+ port_write_string(port)(sc, str, nlen, port);
+ free(str);
+ }
+ else port_write_character(port)(sc, ')', port);
+ }
+ }
+ }
+ else
+ {
+ const char *str;
+ str = type_name(sc, iterator_sequence(obj), NO_ARTICLE);
+ port_write_string(port)(sc, "#<iterator: ", 12, port);
+ port_write_string(port)(sc, str, safe_strlen(str), port);
+ port_write_character(port)(sc, '>', port);
+ }
+}
+static void baffle_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ int nlen;
+ char buf[64];
+ nlen = snprintf(buf, 64, "#<baffle: %d>", baffle_key(obj));
+ port_write_string(port)(sc, buf, nlen, port);
+}
-/* -------------------------------------------------------------------------------- */
+static void c_pointer_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ int nlen;
+ char buf[64];
-#define INITIAL_SHARED_INFO_SIZE 8
+ if (use_write == USE_READABLE_WRITE)
+ nlen = snprintf(buf, 64, "(c-pointer " INT_FORMAT ")", (ptr_int)raw_pointer(obj));
+ else nlen = snprintf(buf, 64, "#<c_pointer %p>", raw_pointer(obj));
+ port_write_string(port)(sc, buf, nlen, port);
+}
-static int shared_ref(shared_info *ci, s7_pointer p)
+static void rng_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
{
- /* from print after collecting refs, not called by equality check */
- int i;
- s7_pointer *objs;
-
- if (!is_collected(p)) return(0);
+ int nlen;
+ char buf[128];
+#if WITH_GMP
+ if (use_write == USE_READABLE_WRITE)
+ nlen = snprintf(buf, 128, "#<unprint-readable object>");
+ else nlen = snprintf(buf, 128, "#<rng %p>", obj);
+#else
+ if (use_write == USE_READABLE_WRITE)
+ nlen = snprintf(buf, 128, "(random-state %" LL_U " %" LL_U ")", random_seed(obj), random_carry(obj));
+ else nlen = snprintf(buf, 128, "#<rng %" LL_U " %" LL_U ">", random_seed(obj), random_carry(obj));
+#endif
+ port_write_string(port)(sc, buf, nlen, port);
+}
- objs = ci->objs;
- for (i = 0; i < ci->top; i++)
- if (objs[i] == p)
- {
- int val;
- val = ci->refs[i];
- if (val > 0)
- ci->refs[i] = -ci->refs[i];
- return(val);
- }
- return(0);
+static void display_any(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+#if DEBUGGING
+ print_debugging_state(sc, obj, port);
+#else
+ {
+ char *str, *tmp;
+ int nlen, len;
+ tmp = describe_type_bits(sc, obj);
+ len = 32 + safe_strlen(tmp);
+ tmpbuf_malloc(str, len);
+ if (is_free(obj))
+ nlen = snprintf(str, len, "<free cell! %s>", tmp);
+ else nlen = snprintf(str, len, "<unknown object! %s>", tmp);
+ free(tmp);
+ port_write_string(port)(sc, str, nlen, port);
+ tmpbuf_free(str, len);
+ }
+#endif
}
+static void unique_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ port_write_string(port)(sc, unique_name(obj), unique_name_length(obj), port);
+}
-static int peek_shared_ref(shared_info *ci, s7_pointer p)
+static void eof_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
{
- /* returns 0 if not found, otherwise the ref value for p */
- int i;
- s7_pointer *objs;
- objs = ci->objs;
+ /* if file has #<eof> it causes read to return #<eof> -> end of read! what is readable version? '#<eof> or (begin #<eof>) as below
+ * but this is silly -- to fool read, the #<eof> has to be all by itself at the top-level!
+ * and the read of #<eof> does not affect the port, so if you know it's there, just ignore #<eof> and continue reading.
+ */
+ if (use_write == USE_READABLE_WRITE)
+ port_write_string(port)(sc, "(begin #<eof>)", 14, port);
+ else port_write_string(port)(sc, unique_name(obj), unique_name_length(obj), port);
+}
- if (!is_collected(p)) return(0);
- for (i = 0; i < ci->top; i++)
- if (objs[i] == p) return(ci->refs[i]);
+static void counter_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ port_write_string(port)(sc, "#<counter>", 10, port);
+}
- return(0);
+static void optlist_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ port_write_string(port)(sc, "#<optlist>", 10, port);
}
+static void integer_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ if (has_print_name(obj))
+ port_write_string(port)(sc, print_name(obj), print_name_length(obj), port);
+ else
+ {
+ int nlen;
+ char *str;
+ nlen = 0;
+ str = integer_to_string_base_10_no_width(obj, &nlen);
+ if (nlen > 0)
+ {
+ set_print_name(obj, str, nlen);
+ port_write_string(port)(sc, str, nlen, port);
+ }
+ else port_display(port)(sc, str, port);
+ }
+}
-static void enlarge_shared_info(shared_info *ci)
+static void number_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
{
- int i;
- ci->size *= 2;
- ci->objs = (s7_pointer *)realloc(ci->objs, ci->size * sizeof(s7_pointer));
- ci->refs = (int *)realloc(ci->refs, ci->size * sizeof(int));
- for (i = ci->top; i < ci->size; i++)
+ if (has_print_name(obj))
+ port_write_string(port)(sc, print_name(obj), print_name_length(obj), port);
+ else
{
- ci->refs[i] = 0;
- ci->objs[i] = NULL;
+ int nlen;
+ char *str;
+ nlen = 0;
+ str = number_to_string_base_10(obj, 0, float_format_precision, 'g', &nlen, use_write); /* was 14 */
+ set_print_name(obj, str, nlen);
+ port_write_string(port)(sc, str, nlen, port);
}
}
+#if WITH_GMP
+static void big_number_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ int nlen;
+ char *str;
+ nlen = 0;
+ str = big_number_to_string_with_radix(obj, BASE_10, 0, &nlen, use_write);
+ port_write_string(port)(sc, str, nlen, port);
+ free(str);
+}
+#endif
-static void add_equal_ref(shared_info *ci, s7_pointer x, s7_pointer y)
+static void syntax_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
{
- /* assume neither x nor y is in the table, and that they should share a ref value,
- * called only in equality check, not printer.
- */
+ port_display(port)(sc, symbol_name(syntax_symbol(obj)), port);
+}
- if ((ci->top + 2) >= ci->size)
- enlarge_shared_info(ci);
+static void string_to_port_1(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ if (is_byte_vector(obj))
+ byte_vector_to_port(sc, obj, port, use_write);
+ else string_to_port(sc, obj, port, use_write);
+}
- set_collected(x);
- set_collected(y);
+static void character_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ if (use_write == USE_DISPLAY)
+ port_write_character(port)(sc, character(obj), port);
+ else port_write_string(port)(sc, character_name(obj), character_name_length(obj), port);
+}
- ci->ref++;
- ci->objs[ci->top] = x;
- ci->refs[ci->top++] = ci->ref;
- ci->objs[ci->top] = y;
- ci->refs[ci->top++] = ci->ref;
+static void closure_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ if (has_methods(obj))
+ {
+ /* look for object->string method else fallback on ordinary case.
+ * can't use recursion on closure_let here because then the fallback name is #<let>.
+ */
+ s7_pointer print_func;
+ print_func = find_method(sc, closure_let(obj), sc->object_to_string_symbol);
+ if (print_func != sc->undefined)
+ {
+ s7_pointer p;
+ p = s7_apply_function(sc, print_func, list_1(sc, obj));
+ if (string_length(p) > 0)
+ port_write_string(port)(sc, string_value(p), string_length(p), port);
+ return;
+ }
+ }
+ if (use_write == USE_READABLE_WRITE)
+ write_closure_readably(sc, obj, port);
+ else write_closure_name(sc, obj, port);
}
+static void macro_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ if (use_write == USE_READABLE_WRITE)
+ write_macro_readably(sc, obj, port);
+ else write_closure_name(sc, obj, port);
+}
-static void add_shared_ref(shared_info *ci, s7_pointer x, int ref_x)
+static void c_function_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
{
- /* called only in equality check, not printer */
+ port_write_string(port)(sc, c_function_name(obj), c_function_name_length(obj), port);
+}
- if (ci->top == ci->size)
- enlarge_shared_info(ci);
+static void c_macro_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ port_write_string(port)(sc, c_macro_name(obj), c_macro_name_length(obj), port);
+}
- set_collected(x);
+static void continuation_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ if (use_write == USE_READABLE_WRITE)
+ port_write_string(port)(sc, "continuation", 12, port);
+ else port_write_string(port)(sc, "#<continuation>", 15, port);
+}
- ci->objs[ci->top] = x;
- ci->refs[ci->top++] = ref_x;
+static void goto_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ if (use_write == USE_READABLE_WRITE)
+ port_write_string(port)(sc, "goto", 4, port);
+ else port_write_string(port)(sc, "#<goto>", 7, port);
}
-static shared_info *collect_shared_info(s7_scheme *sc, shared_info *ci, s7_pointer top, bool stop_at_print_length, bool *cyclic);
-static hash_entry_t *hash_equal(s7_scheme *sc, s7_pointer table, s7_pointer key);
+static void catch_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ port_write_string(port)(sc, "#<catch>", 8, port);
+}
-static void collect_vector_info(s7_scheme *sc, shared_info *ci, s7_pointer top, bool stop_at_print_length, bool *cyclic)
+static void dynamic_wind_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
{
- s7_int i, plen;
+ /* this can happen because (*s7* 'stack) can involve dynamic-wind markers */
+ port_write_string(port)(sc, "#<dynamic-wind>", 15, port);
+}
- if (stop_at_print_length)
- {
- plen = sc->print_length;
- if (plen > vector_length(top))
- plen = vector_length(top);
- }
- else plen = vector_length(top);
+static void c_object_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ 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)));
+ port_display(port)(sc, str, port);
+ free(str);
+}
- for (i = 0; i < plen; i++)
- if (has_structure(vector_element(top, i)))
- collect_shared_info(sc, ci, vector_element(top, i), stop_at_print_length, cyclic);
+static void slot_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ if (use_write != USE_READABLE_WRITE)
+ port_write_character(port)(sc, '\'', port);
+ symbol_to_port(sc, slot_symbol(obj), port, use_write, ci);
+ port_write_character(port)(sc, ' ', port);
+ object_to_port_with_circle_check(sc, slot_value(obj), port, use_write, ci);
}
-static shared_info *collect_shared_info(s7_scheme *sc, shared_info *ci, s7_pointer top, bool stop_at_print_length, bool *cyclic)
+static void init_display_functions(void)
{
- /* look for top in current list.
- *
- * As we collect objects (guaranteed to have structure) we set the collected bit. If we ever
- * 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.
- */
- if (is_shared(top))
- return(ci);
+ int i;
+ for (i = 0; i < 256; i++) display_functions[i] = display_any;
+ display_functions[T_FLOAT_VECTOR] = int_or_float_vector_to_port;
+ display_functions[T_INT_VECTOR] = int_or_float_vector_to_port;
+ display_functions[T_VECTOR] = vector_to_port;
+ display_functions[T_PAIR] = pair_to_port;
+ display_functions[T_HASH_TABLE] = hash_table_to_port;
+ display_functions[T_ITERATOR] = iterator_to_port;
+ display_functions[T_LET] = let_to_port;
+ display_functions[T_BOOLEAN] = unique_to_port;
+ display_functions[T_NIL] = unique_to_port;
+ display_functions[T_UNSPECIFIED] = unique_to_port;
+ display_functions[T_UNDEFINED] = unique_to_port;
+ display_functions[T_EOF_OBJECT] = eof_to_port;
+ display_functions[T_INPUT_PORT] = input_port_to_port;
+ display_functions[T_OUTPUT_PORT] = output_port_to_port;
+ display_functions[T_COUNTER] = counter_to_port;
+ display_functions[T_OPTLIST] = optlist_to_port;
+ display_functions[T_BAFFLE] = baffle_to_port;
+ display_functions[T_INTEGER] = integer_to_port;
+ display_functions[T_RATIO] = number_to_port;
+ display_functions[T_REAL] = number_to_port;
+ display_functions[T_COMPLEX] = number_to_port;
+#if WITH_GMP
+ display_functions[T_BIG_INTEGER] = big_number_to_port;
+ display_functions[T_BIG_RATIO] = big_number_to_port;
+ display_functions[T_BIG_REAL] = big_number_to_port;
+ display_functions[T_BIG_COMPLEX] = big_number_to_port;
+#endif
+ display_functions[T_SYMBOL] = symbol_to_port;
+ display_functions[T_SYNTAX] = syntax_to_port;
+ display_functions[T_STRING] = string_to_port_1;
+ display_functions[T_CHARACTER] = character_to_port;
+ display_functions[T_CLOSURE] = closure_to_port;
+ display_functions[T_CLOSURE_STAR] = closure_to_port;
+ display_functions[T_MACRO] = macro_to_port;
+ display_functions[T_MACRO_STAR] = macro_to_port;
+ display_functions[T_BACRO] = macro_to_port;
+ display_functions[T_BACRO_STAR] = macro_to_port;
+ display_functions[T_C_OPT_ARGS_FUNCTION] = c_function_to_port;
+ display_functions[T_C_RST_ARGS_FUNCTION] = c_function_to_port;
+ display_functions[T_C_ANY_ARGS_FUNCTION] = c_function_to_port;
+ display_functions[T_C_FUNCTION] = c_function_to_port;
+ display_functions[T_C_FUNCTION_STAR] = c_function_to_port;
+ display_functions[T_C_MACRO] = c_macro_to_port;
+ display_functions[T_C_POINTER] = c_pointer_to_port;
+ display_functions[T_RANDOM_STATE] = rng_to_port;
+ display_functions[T_CONTINUATION] = continuation_to_port;
+ display_functions[T_GOTO] = goto_to_port;
+ display_functions[T_CATCH] = catch_to_port;
+ display_functions[T_DYNAMIC_WIND] = dynamic_wind_to_port;
+ display_functions[T_C_OBJECT] = c_object_to_port;
+ display_functions[T_SLOT] = slot_to_port;
+}
- if (is_collected(top))
+static void object_to_port_with_circle_check(s7_scheme *sc, s7_pointer vr, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ if ((ci) &&
+ (has_structure(vr)))
{
- s7_pointer *p, *objs_end;
- int i;
- *cyclic = true;
- 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;
- }
- }
- else
- {
- /* top not seen before -- add it to the list */
- bool top_cyclic = false;
- set_collected(top);
-
- if (ci->top == ci->size)
- enlarge_shared_info(ci);
- ci->objs[ci->top++] = top;
-
- /* now search the rest of this structure */
- switch (type(top))
+ int ref;
+ ref = shared_ref(ci, vr);
+ if (ref != 0)
{
- case T_PAIR:
- if (has_structure(car(top)))
- collect_shared_info(sc, ci, car(top), stop_at_print_length, &top_cyclic);
- if (has_structure(cdr(top)))
- collect_shared_info(sc, ci, cdr(top), stop_at_print_length, &top_cyclic);
- break;
-
- case T_VECTOR:
- collect_vector_info(sc, ci, top, stop_at_print_length, &top_cyclic);
- break;
-
- case T_ITERATOR:
- collect_shared_info(sc, ci, iterator_sequence(top), stop_at_print_length, &top_cyclic);
- break;
-
- case T_HASH_TABLE:
- if (hash_table_entries(top) > 0)
+ char buf[32];
+ int nlen;
+ char *p;
+ unsigned int len;
+ if (ref > 0)
{
- unsigned int i, len;
- hash_entry_t **entries;
- bool keys_safe;
-
- 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++)
+ if (use_write == USE_READABLE_WRITE)
{
- hash_entry_t *p;
- for (p = entries[i]; p; p = p->next)
- {
- if ((!keys_safe) &&
- (has_structure(p->key)))
- collect_shared_info(sc, ci, p->key, stop_at_print_length, &top_cyclic);
- if (has_structure(p->value))
- collect_shared_info(sc, ci, p->value, stop_at_print_length, &top_cyclic);
- }
+ nlen = snprintf(buf, 32, "(set! {%d} ", ref);
+ port_write_string(port)(sc, buf, nlen, port);
+ object_to_port(sc, vr, port, USE_READABLE_WRITE, ci);
+ port_write_character(port)(sc, ')', port);
+ }
+ else
+ {
+ p = pos_int_to_str((s7_int)ref, &len, '=');
+ *--p = '#';
+ port_write_string(port)(sc, p, len, port);
+ object_to_port(sc, vr, port, DONT_USE_DISPLAY(use_write), ci);
}
}
- break;
-
- case T_SLOT:
- if (has_structure(slot_value(top)))
- collect_shared_info(sc, ci, slot_value(top), stop_at_print_length, &top_cyclic);
- break;
-
- case T_LET:
- if (top == sc->rootlet)
- collect_vector_info(sc, ci, top, stop_at_print_length, &top_cyclic);
else
{
- s7_pointer p;
- for (p = let_slots(top); is_slot(p); p = next_slot(p))
- if (has_structure(slot_value(p)))
- collect_shared_info(sc, ci, slot_value(p), stop_at_print_length, &top_cyclic);
+ if (use_write == USE_READABLE_WRITE)
+ {
+ nlen = snprintf(buf, 32, "{%d}", -ref);
+ port_write_string(port)(sc, buf, nlen, port);
+ }
+ else
+ {
+ p = pos_int_to_str((s7_int)(-ref), &len, '#');
+ *--p = '#';
+ port_write_string(port)(sc, p, len, port);
+ }
}
- break;
+ return;
}
- if (!top_cyclic)
- set_shared(top);
- else *cyclic = true;
}
- return(ci);
+ object_to_port(sc, vr, port, use_write, ci);
}
-static shared_info *new_shared_info(s7_scheme *sc)
+static void setup_shared_reads(s7_scheme *sc, s7_pointer port, shared_info *ci)
{
- 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 = (int *)calloc(ci->size, sizeof(int)); /* finder expects 0 = unseen previously */
- sc->circle_info = ci;
- }
- else
+ int i;
+ char buf[64];
+
+ port_write_string(port)(sc, "(let (", 6, port);
+ for (i = 1; i <= ci->top; i++)
{
- int 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]);
+ int len;
+ len = snprintf(buf, 64, "({%d} #f)", i);
+ port_write_string(port)(sc, buf, len, port);
}
- ci->top = 0;
- ci->ref = 0;
- ci->has_hits = false;
- return(ci);
+ port_write_string(port)(sc, ") ", 2, port);
}
-
-static shared_info *make_shared_info(s7_scheme *sc, s7_pointer top, bool stop_at_print_length)
+static void finish_shared_reads(s7_scheme *sc, s7_pointer port, shared_info *ci)
{
- /* for the printer */
- shared_info *ci;
- int i, refs;
- s7_pointer *ci_objs;
- int *ci_refs;
- bool no_problem = true, cyclic = false;
-
- /* check for simple cases first */
- if (is_pair(top))
- {
- if (s7_list_length(sc, top) != 0) /* it is not circular at the top level (following cdr), so we can check each car(x) */
- {
- s7_pointer x;
- for (x = top; is_pair(x); x = cdr(x))
- if (has_structure(car(x)))
- {
- /* it can help a little in some cases to scan vectors here (and slots):
- * if no element has structure, it's ok (maybe also hash_table_entries == 0)
- */
- no_problem = false;
- break;
- }
- if ((no_problem) &&
- (!is_null(x)) &&
- (has_structure(x)))
- no_problem = false;
-
- if (no_problem)
- return(NULL);
- }
- }
- else
- {
- if (s7_is_vector(top))
- {
- if (type(top) != T_VECTOR)
- return(NULL);
-
- for (i = 0; i < vector_length(top); i++)
- if (has_structure(vector_element(top, i)))
- {
- no_problem = false;
- break;
- }
- if (no_problem)
- return(NULL);
- }
- }
-
- ci = new_shared_info(sc);
-
- /* collect all pointers associated with top */
- collect_shared_info(sc, ci, top, stop_at_print_length, &cyclic);
-
- for (i = 0; i < ci->top; i++)
- {
- s7_pointer p;
- p = ci->objs[i];
- clear_collected_and_shared(p);
- }
- if (!cyclic)
- return(NULL);
-
- if (!(ci->has_hits))
- return(NULL);
-
- ci_objs = ci->objs;
- ci_refs = ci->refs;
-
- /* find if any were referenced twice (once for just being there, so twice=shared)
- * we know there's at least one such reference because has_hits is true.
- */
- for (i = 0, refs = 0; i < ci->top; i++)
- if (ci_refs[i] > 0)
- {
- set_collected(ci_objs[i]);
- if (i == refs)
- refs++;
- else
- {
- ci_objs[refs] = ci_objs[i];
- ci_refs[refs++] = ci_refs[i];
- ci_refs[i] = 0;
- ci_objs[i] = NULL;
- }
- }
- ci->top = refs;
- return(ci);
+ port_write_character(port)(sc, ')', port);
}
-/* -------------------------------- cyclic-sequences -------------------------------- */
-
-static s7_pointer cyclic_sequences(s7_scheme *sc, s7_pointer obj, bool return_list)
+static s7_pointer object_out(s7_scheme *sc, s7_pointer obj, s7_pointer strport, use_write_t choice)
{
- if (has_structure(obj))
+ if ((has_structure(obj)) &&
+ (obj != sc->rootlet))
{
shared_info *ci;
- ci = make_shared_info(sc, obj, false); /* false=don't stop at print length (vectors etc) */
+ ci = make_shared_info(sc, obj, choice != USE_READABLE_WRITE);
if (ci)
{
- if (return_list)
+ if (choice == USE_READABLE_WRITE)
{
- int i;
- s7_pointer lst;
- sc->w = sc->nil;
- for (i = 0; i < ci->top; i++)
- sc->w = cons(sc, ci->objs[i], sc->w);
- lst = sc->w;
- sc->w = sc->nil;
- return(lst);
+ setup_shared_reads(sc, strport, ci);
+ object_to_port_with_circle_check(sc, obj, strport, choice, ci);
+ finish_shared_reads(sc, strport, ci);
}
- else return(sc->T);
+ else object_to_port_with_circle_check(sc, obj, strport, choice, ci);
+ return(obj);
}
}
- return(sc->nil);
+ object_to_port(sc, obj, strport, choice, NULL);
+ return(obj);
}
+
-static s7_pointer g_cyclic_sequences(s7_scheme *sc, s7_pointer args)
-{
- #define H_cyclic_sequences "(cyclic-sequences obj) returns a list of elements that are cyclic."
- #define Q_cyclic_sequences s7_make_signature(sc, 2, sc->is_proper_list_symbol, sc->T)
- return(cyclic_sequences(sc, car(args), true));
-}
+static s7_pointer format_ports = NULL;
-static int circular_list_entries(s7_pointer lst)
+static s7_pointer open_format_port(s7_scheme *sc)
{
- int i;
s7_pointer x;
- for (i = 1, x = cdr(lst); ; i++, x = cdr(x))
+ int len;
+
+ if (format_ports)
{
- int j;
- s7_pointer y;
- for (y = lst, j = 0; j < i; y = cdr(y), j++)
- if (x == y)
- return(i);
+ x = format_ports;
+ format_ports = (s7_pointer)(port_port(x)->next);
+ port_position(x) = 0;
+ port_data(x)[0] = '\0';
+ return(x);
}
+
+ len = FORMAT_PORT_LENGTH;
+ x = alloc_pointer();
+ set_type(x, T_OUTPUT_PORT);
+ port_port(x) = (port_t *)calloc(1, sizeof(port_t));
+ port_type(x) = STRING_PORT;
+ port_is_closed(x) = false;
+ port_data_size(x) = len;
+ port_data(x) = (unsigned char *)malloc(len * sizeof(unsigned char)); /* was +8 */
+ port_data(x)[0] = '\0';
+ port_position(x) = 0;
+ port_needs_free(x) = false;
+ port_read_character(x) = output_read_char;
+ port_read_line(x) = output_read_line;
+ port_display(x) = string_display;
+ port_write_character(x) = string_write_char;
+ port_write_string(x) = string_write_string;
+ return(x);
}
+static void close_format_port(s7_scheme *sc, s7_pointer port)
+{
+ port_port(port)->next = (void *)format_ports;
+ format_ports = port;
+}
-static void object_to_port_with_circle_check(s7_scheme *sc, s7_pointer vr, s7_pointer port, use_write_t use_write, shared_info *ci);
-static void object_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci);
-static s7_pointer object_out(s7_scheme *sc, s7_pointer obj, s7_pointer strport, use_write_t choice);
-static char *multivector_indices_to_string(s7_scheme *sc, s7_int index, s7_pointer vect, char *str, int cur_dim)
+static char *s7_object_to_c_string_1(s7_scheme *sc, s7_pointer obj, use_write_t use_write, int *nlen)
{
- s7_int size, ind;
- char buf[64];
+ char *str;
+ s7_pointer strport;
- size = vector_dimension(vect, cur_dim);
- ind = index % size;
- if (cur_dim > 0)
- multivector_indices_to_string(sc, (index - ind) / size, vect, str, cur_dim - 1);
+ strport = open_format_port(sc);
+ object_out(sc, obj, strport, use_write);
+ if (nlen) (*nlen) = port_position(strport);
- snprintf(buf, 64, " %lld", ind);
-#ifdef __OpenBSD__
- strlcat(str, buf, 128); /* 128=length of str */
-#else
- strcat(str, buf);
-#endif
- return(str);
+ str = (char *)malloc((port_position(strport) + 1) * sizeof(char));
+ memcpy((void *)str, (void *)port_data(strport), port_position(strport));
+ str[port_position(strport)] = '\0';
+ close_format_port(sc, strport);
+
+ return(str);
}
-static int multivector_to_port(s7_scheme *sc, s7_pointer vec, s7_pointer port,
- int out_len, int flat_ref, int dimension, int dimensions, bool *last,
- use_write_t use_write, shared_info *ci)
+char *s7_object_to_c_string(s7_scheme *sc, s7_pointer obj)
{
- int i;
+ TRACK(sc);
+ if ((sc->safety > NO_SAFETY) &&
+ (!s7_is_valid(sc, obj)))
+ fprintf(stderr, "bad arg to %s: %p\n", __func__, obj);
- if (use_write != USE_READABLE_WRITE)
- {
- if (*last)
- port_write_string(port)(sc, " (", 2, port);
- else port_write_character(port)(sc, '(', port);
- (*last) = false;
- }
+ return(s7_object_to_c_string_1(sc, obj, USE_WRITE, NULL));
+}
- for (i = 0; i < vector_dimension(vec, dimension); i++)
- {
- if (dimension == (dimensions - 1))
- {
- if (flat_ref < out_len)
- {
- if (use_write == USE_READABLE_WRITE)
- {
- int plen;
- char buf[128];
- char *indices;
- /* need to translate flat_ref into a set of indices
- */
- tmpbuf_calloc(indices, 128);
- plen = snprintf(buf, 128, "(set! ({v}%s) ", multivector_indices_to_string(sc, flat_ref, vec, indices, dimension));
- port_write_string(port)(sc, buf, plen, port);
- tmpbuf_free(indices, 128);
- }
- object_to_port_with_circle_check(sc, vector_element(vec, flat_ref), port, DONT_USE_DISPLAY(use_write), ci);
- if (use_write == USE_READABLE_WRITE)
- port_write_string(port)(sc, ") ", 2, port);
- flat_ref++;
- }
- else
- {
- port_write_string(port)(sc, "...)", 4, port);
- return(flat_ref);
- }
- if ((use_write != USE_READABLE_WRITE) &&
- (i < (vector_dimension(vec, dimension) - 1)))
- port_write_character(port)(sc, ' ', port);
- }
- else
- {
- if (flat_ref < out_len)
- flat_ref = multivector_to_port(sc, vec, port, out_len, flat_ref, dimension + 1, dimensions, last, DONT_USE_DISPLAY(use_write), ci);
- else
- {
- port_write_string(port)(sc, "...)", 4, port);
- return(flat_ref);
- }
- }
- }
- if (use_write != USE_READABLE_WRITE)
- port_write_character(port)(sc, ')', port);
- (*last) = true;
- return(flat_ref);
+s7_pointer s7_object_to_string(s7_scheme *sc, s7_pointer obj, bool use_write) /* unavoidable backwards compatibility rigidity here */
+{
+ char *str;
+ int len = 0;
+
+ if ((sc->safety > NO_SAFETY) &&
+ (!s7_is_valid(sc, obj)))
+ fprintf(stderr, "bad arg to %s: %p\n", __func__, obj);
+
+ str = s7_object_to_c_string_1(sc, obj, (use_write) ? USE_WRITE : USE_DISPLAY, &len);
+ if (str)
+ return(make_string_uncopied_with_length(sc, str, len));
+ return(s7_make_string_with_length(sc, "", 0));
}
-static void vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_write_t use_write, shared_info *ci)
+/* -------------------------------- newline -------------------------------- */
+void s7_newline(s7_scheme *sc, s7_pointer port)
{
- s7_int i, len;
- int plen;
- bool too_long = false;
- char buf[128];
+ s7_write_char(sc, '\n', port);
+}
- len = vector_length(vect);
- if (len == 0)
+static s7_pointer g_newline(s7_scheme *sc, s7_pointer args)
+{
+ #define H_newline "(newline (port (current-output-port))) writes a carriage return to the port"
+ #define Q_newline s7_make_signature(sc, 2, sc->is_unspecified_symbol, sc->is_output_port_symbol)
+ s7_pointer port;
+
+ if (is_not_null(args))
+ port = car(args);
+ else port = sc->output_port;
+ if (!is_output_port(port))
{
- if (vector_rank(vect) > 1)
- {
- plen = snprintf(buf, 32, "#%uD()", vector_ndims(vect));
- port_write_string(port)(sc, buf, plen, port);
- }
- else port_write_string(port)(sc, "#()", 3, port);
- return;
+ if (port == sc->F) return(sc->unspecified);
+ method_or_bust_with_type_one_arg(sc, port, sc->newline_symbol, args, an_output_port_string);
}
+ s7_newline(sc, port);
+ return(sc->unspecified);
+}
- if (use_write != USE_READABLE_WRITE)
- {
- plen = sc->print_length;
- if (plen <= 0)
- {
- if (vector_rank(vect) > 1)
- {
- plen = snprintf(buf, 32, "#%uD(...)", vector_ndims(vect));
- port_write_string(port)(sc, buf, plen, port);
- }
- else port_write_string(port)(sc, "#(...)", 6, port);
- return;
- }
+static s7_pointer newline_p(void) {s7_write_char(cur_sc, '\n', cur_sc->output_port); return(cur_sc->unspecified);}
+static s7_pointer newline_p_p(s7_pointer port) {s7_write_char(cur_sc, '\n', port); return(cur_sc->unspecified);}
- if (len > plen)
- {
- too_long = true;
- len = plen;
- }
- }
- if (use_write == USE_READABLE_WRITE)
+/* -------------------------------- write -------------------------------- */
+void s7_write(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+{
+ if (port != sc->F)
{
- if ((ci) &&
- (peek_shared_ref(ci, vect) != 0))
- {
- port_write_string(port)(sc, "(let (({v} (make-vector ", 24, port);
- if (vector_rank(vect) > 1)
- {
- unsigned int dim;
- port_write_string(port)(sc, "'(", 2, port);
- for (dim = 0; dim < vector_ndims(vect); dim++)
- {
- plen = snprintf(buf, 128, "%lld ", vector_dimension(vect, dim));
- port_write_string(port)(sc, buf, plen, port);
- }
- port_write_string(port)(sc, ")))) ", 5, port);
- }
- else
- {
- plen = snprintf(buf, 128, "%lld))) ", vector_length(vect));
- port_write_string(port)(sc, buf, plen, port);
- }
- if (shared_ref(ci, vect) < 0)
- {
- plen = snprintf(buf, 128, "(set! {%d} {v}) ", -shared_ref(ci, vect));
- port_write_string(port)(sc, buf, plen, port);
- }
-
- if (vector_rank(vect) > 1)
- {
- bool last = false;
- multivector_to_port(sc, vect, port, len, 0, 0, vector_ndims(vect), &last, use_write, ci);
- }
- else
- {
- for (i = 0; i < len; i++)
- {
- port_write_string(port)(sc, "(set! ({v} ", 11, port);
- plen = snprintf(buf, 128, "%lld) ", i);
- port_write_string(port)(sc, buf, plen, port);
- object_to_port_with_circle_check(sc, vector_element(vect, i), port, use_write, ci);
- port_write_string(port)(sc, ") ", 2, port);
- }
- }
- port_write_string(port)(sc, "{v})", 4, port);
- }
- else /* simple readable case */
- {
- if (vector_rank(vect) > 1)
- port_write_string(port)(sc, "(make-shared-vector (vector", 27, port);
- else port_write_string(port)(sc, "(vector", 7, port);
+ if (port_is_closed(port))
+ s7_wrong_type_arg_error(sc, "write", 2, port, "an open output port");
+ object_out(sc, obj, port, USE_WRITE);
+ }
+}
- for (i = 0; i < len; i++)
- {
- port_write_character(port)(sc, ' ', port);
- object_to_port_with_circle_check(sc, vector_element(vect, i), port, use_write, ci);
- }
- port_write_character(port)(sc, ')', port);
- if (vector_rank(vect) > 1)
- {
- unsigned int dim;
- port_write_string(port)(sc, " '(", 3, port);
- for (dim = 0; dim < vector_ndims(vect) - 1; dim++)
- {
- plen = snprintf(buf, 128, "%lld ", vector_dimension(vect, dim));
- port_write_string(port)(sc, buf, plen, port);
- }
- plen = snprintf(buf, 128, "%lld", vector_dimension(vect, dim));
- port_write_string(port)(sc, buf, plen, port);
- port_write_string(port)(sc, "))", 2, port);
- }
- }
- }
- else
- {
- if (vector_rank(vect) > 1)
- {
- bool last = false;
- if (vector_ndims(vect) > 1)
- {
- plen = snprintf(buf, 32, "#%uD", vector_ndims(vect));
- port_write_string(port)(sc, buf, plen, port);
- }
- else port_write_character(port)(sc, '#', port);
- multivector_to_port(sc, vect, port, len, 0, 0, vector_ndims(vect), &last, use_write, ci);
- }
- else
- {
- port_write_string(port)(sc, "#(", 2, port);
- for (i = 0; i < len - 1; i++)
- {
- object_to_port_with_circle_check(sc, vector_element(vect, i), port, DONT_USE_DISPLAY(use_write), ci);
- port_write_character(port)(sc, ' ', port);
- }
- object_to_port_with_circle_check(sc, vector_element(vect, i), port, DONT_USE_DISPLAY(use_write), ci);
+static s7_pointer g_write(s7_scheme *sc, s7_pointer args)
+{
+ #define H_write "(write obj (port (current-output-port))) writes (object->string obj) to the output port"
+ #define Q_write s7_make_signature(sc, 3, sc->T, sc->T, sc->is_output_port_symbol)
+ s7_pointer port;
- if (too_long)
- port_write_string(port)(sc, " ...)", 5, port);
- else port_write_character(port)(sc, ')', port);
- }
+ if (is_pair(cdr(args)))
+ port = cadr(args);
+ else port = sc->output_port;
+ if (!is_output_port(port))
+ {
+ if (port == sc->F) return(car(args));
+ method_or_bust_with_type(sc, port, sc->write_symbol, args, an_output_port_string, 2);
}
+ if (port_is_closed(port))
+ return(s7_wrong_type_arg_error(sc, "write", 2, port, "an open output port"));
+ return(object_out(sc, car(args), port, USE_WRITE));
}
-static bool string_needs_slashification(const char *str, int len)
+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_pp(s7_pointer x, s7_pointer port)
{
- /* we have to go by len (str len) not *s==0 because s7 strings can have embedded nulls */
- unsigned char *p, *pend;
- pend = (unsigned char *)(str + len);
- for (p = (unsigned char *)str; p < pend; p++)
- if (slashify_table[*p])
- return(true);
- return(false);
+ if (port == cur_sc->F)
+ return(x);
+ return(object_out(cur_sc, x, port, USE_WRITE));
}
-#define IN_QUOTES true
-#define NOT_IN_QUOTES false
-static char *slashify_string(s7_scheme *sc, const char *p, int len, bool quoted, int *nlen) /* do not free result */
+/* -------------------------------- display -------------------------------- */
+void s7_display(s7_scheme *sc, s7_pointer obj, s7_pointer port)
{
- int j = 0, cur_size, size;
- char *s;
- unsigned char *pcur, *pend;
+ if (port != sc->F)
+ {
+ if (port_is_closed(port))
+ s7_wrong_type_arg_error(sc, "display", 2, port, "an open output port");
+ object_out(sc, obj, port, USE_DISPLAY);
+ }
+}
- pend = (unsigned char *)(p + len);
- size = len + 256;
- if (size > sc->slash_str_size)
+static s7_pointer g_display(s7_scheme *sc, s7_pointer args)
+{
+ #define H_display "(display obj (port (current-output-port))) prints obj"
+ #define Q_display s7_make_signature(sc, 3, sc->T, sc->T, sc->is_output_port_symbol)
+ s7_pointer port;
+
+ if (is_pair(cdr(args)))
+ port = cadr(args);
+ else port = sc->output_port;
+ if (!is_output_port(port))
{
- if (sc->slash_str) free(sc->slash_str);
- sc->slash_str_size = size;
- sc->slash_str = (char *)malloc(size);
+ if (port == sc->F) return(car(args));
+ method_or_bust_with_type(sc, port, sc->display_symbol, args, an_output_port_string, 2);
}
- else size = sc->slash_str_size;
- cur_size = size - 2;
+ if (port_is_closed(port))
+ return(s7_wrong_type_arg_error(sc, "display", 2, port, "an open output port"));
+ return(object_out(sc, car(args), port, USE_DISPLAY));
+}
- /* memset((void *)sc->slash_str, 0, size); */
- s = sc->slash_str;
+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_pp(s7_pointer x, s7_pointer port)
+{
+ if (port == cur_sc->F)
+ return(x);
+ return(object_out(cur_sc, x, port, USE_DISPLAY));
+}
- if (quoted) s[j++] = '"';
- /* what about the trailing nulls? Guile writes them out (as does s7 currently)
- * but that is not ideal. I'd like to use ~S for error messages, so that
- * strings are clearly identified via the double-quotes, but this way of
- * writing them is ugly:
- *
- * :(let ((str (make-string 8 #\null))) (set! (str 0) #\a) str)
- * "a\x00\x00\x00\x00\x00\x00\x00"
- *
- * but it would be misleading to omit them because:
- *
- * :(let ((str (make-string 8 #\null))) (set! (str 0) #\a) (string-append str "bc"))
- * "a\x00\x00\x00\x00\x00\x00\x00bc"
- */
+/* -------------------------------- call-with-output-string -------------------------------- */
+static s7_pointer g_call_with_output_string(s7_scheme *sc, s7_pointer args)
+{
+ #define H_call_with_output_string "(call-with-output-string proc) opens a string port applies proc to it, then returns the collected output"
+ #define Q_call_with_output_string s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_procedure_symbol)
+ s7_pointer port, proc;
- for (pcur = (unsigned char *)p; pcur < pend; pcur++)
- {
- if (slashify_table[*pcur])
- {
- s[j++] = '\\';
- switch (*pcur)
- {
- case '"':
- s[j++] = '"';
- break;
+ proc = car(args);
+ if (is_let(proc))
+ check_method(sc, proc, sc->call_with_output_string_symbol, args);
+ if (!s7_is_aritable(sc, proc, 1))
+ method_or_bust_with_type(sc, proc, sc->call_with_output_string_symbol, args, make_string_wrapper(sc, "a procedure of one argument (the port)"), 1);
- case '\\':
- s[j++] = '\\';
- break;
+ if ((is_continuation(proc)) || (is_goto(proc)))
+ return(wrong_type_argument_with_type(sc, sc->call_with_output_string_symbol, 1, proc, a_normal_procedure_string));
- default: /* this is the "\x01" stuff */
- {
- unsigned int n;
- static char dignum[] = "0123456789abcdef";
- s[j++] = 'x';
- n = (unsigned int)(*pcur);
- if (n < 16)
- s[j++] = '0';
- else s[j++] = dignum[(n / 16) % 16];
- s[j++] = dignum[n % 16];
- }
- break;
- }
- }
- else s[j++] = *pcur;
- if (j >= cur_size) /* even with 256 extra, we can overflow (for example, inordinately many tabs in ALSA output) */
- {
- /* int k; */
- size *= 2;
- sc->slash_str = (char *)realloc(sc->slash_str, size * sizeof(char));
- sc->slash_str_size = size;
- cur_size = size - 2;
- s = sc->slash_str;
- /* for (k = j; k < size; k++) s[k] = 0; */
- }
- }
- if (quoted) s[j++] = '"';
- s[j] = '\0';
- (*nlen) = j;
- return(s);
+ port = s7_open_output_string(sc);
+ push_stack(sc, OP_GET_OUTPUT_STRING_1, sc->F, port);
+ push_stack(sc, OP_APPLY, list_1(sc, port), proc);
+ return(sc->F);
+}
+
+
+
+/* -------------------------------- call-with-output-file -------------------------------- */
+static s7_pointer g_call_with_output_file(s7_scheme *sc, s7_pointer args)
+{
+ #define H_call_with_output_file "(call-with-output-file filename proc) opens filename and calls proc with the output port as its argument"
+ #define Q_call_with_output_file pl_sf
+ s7_pointer port, file, proc;
+
+ file = car(args);
+ if (!is_string(file))
+ method_or_bust(sc, file, sc->call_with_output_file_symbol, args, T_STRING, 1);
+
+ proc = cadr(args);
+ if (!s7_is_aritable(sc, proc, 1))
+ method_or_bust_with_type(sc, proc, sc->call_with_output_file_symbol, args, make_string_wrapper(sc, "a procedure of one argument (the port)"), 2);
+
+ if ((is_continuation(proc)) || is_goto(proc))
+ return(wrong_type_argument_with_type(sc, sc->call_with_output_file_symbol, 2, proc, a_normal_procedure_string));
+
+ port = s7_open_output_file(sc, string_value(file), "w");
+ push_stack(sc, OP_UNWIND_OUTPUT, sc->F, port);
+ push_stack(sc, OP_APPLY, list_1(sc, port), proc);
+ return(sc->F);
}
-static void output_port_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write)
+
+
+/* -------------------------------- with-output-to-string -------------------------------- */
+static s7_pointer g_with_output_to_string(s7_scheme *sc, s7_pointer args)
{
- if ((obj == sc->standard_output) ||
- (obj == sc->standard_error))
- port_write_string(port)(sc, port_filename(obj), port_filename_length(obj), port);
+ #define H_with_output_to_string "(with-output-to-string thunk) opens a string as a temporary current-output-port, calls thunk, then returns the collected output"
+ #define Q_with_output_to_string s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_procedure_symbol)
+ s7_pointer old_output_port, p;
+
+ p = car(args);
+ if (!is_thunk(sc, p))
+ method_or_bust_with_type(sc, p, sc->with_output_to_string_symbol, args, a_thunk_string, 1);
+
+ 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);
+}
+
+/* (let () (define-macro (mac) (write "123")) (with-output-to-string mac))
+ * (string-ref (with-output-to-string (lambda () (write "1234") (values (get-output-string) 1))))
+ */
+
+
+/* -------------------------------- with-output-to-file -------------------------------- */
+static s7_pointer g_with_output_to_file(s7_scheme *sc, s7_pointer args)
+{
+ #define H_with_output_to_file "(with-output-to-file filename thunk) opens filename as the temporary current-output-port and calls thunk"
+ #define Q_with_output_to_file pl_sf
+ s7_pointer old_output_port, file, proc;
+
+ file = car(args);
+ if (!is_string(file))
+ method_or_bust(sc, file, sc->with_output_to_file_symbol, args, T_STRING, 1);
+
+ proc = cadr(args);
+ if (!is_thunk(sc, proc))
+ method_or_bust_with_type(sc, proc, sc->with_output_to_file_symbol, args, a_thunk_string, 2);
+
+ 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);
+}
+
+
+
+/* -------------------------------- format -------------------------------- */
+
+static s7_pointer format_error_1(s7_scheme *sc, s7_pointer msg, const char *str, s7_pointer args, format_data *fdat)
+{
+ s7_pointer x = NULL, ctrl_str;
+ static s7_pointer format_string_1 = NULL, format_string_2, format_string_3, format_string_4;
+
+ if (!format_string_1)
+ {
+ format_string_1 = s7_make_permanent_string("format: ~S ~{~S~^ ~}: ~A");
+ format_string_2 = s7_make_permanent_string("format: ~S: ~A");
+ format_string_3 = s7_make_permanent_string("format: ~S ~{~S~^ ~}~&~NT^: ~A");
+ format_string_4 = s7_make_permanent_string("format: ~S~&~NT^: ~A");
+ }
+
+ if (fdat->orig_str)
+ ctrl_str = fdat->orig_str;
+ else ctrl_str = make_string_wrapper(sc, str);
+
+ if (fdat->loc == 0)
+ {
+ if (is_pair(args))
+ x = set_elist_4(sc, format_string_1, ctrl_str, args, msg);
+ else x = set_elist_3(sc, format_string_2, ctrl_str, msg);
+ }
else
{
- int nlen;
- if (use_write == USE_READABLE_WRITE)
- {
- if (port_is_closed(obj))
- port_write_string(port)(sc, "(let ((p (open-output-string))) (close-output-port p) p)", 56, port);
- else
- {
- char *str;
- if (is_string_port(obj))
- {
- port_write_string(port)(sc, "(let ((p (open-output-string)))", 31, port);
- if (port_position(obj) > 0)
- {
- port_write_string(port)(sc, " (display ", 10, port);
- str = slashify_string(sc, (const char *)port_data(obj), port_position(obj), IN_QUOTES, &nlen);
- port_write_string(port)(sc, str, nlen, port);
- port_write_string(port)(sc, " p)", 3, port);
- }
- port_write_string(port)(sc, " p)", 3, port);
- }
- else
- {
- str = (char *)malloc(256 * sizeof(char));
- nlen = snprintf(str, 256, "(open-output-file \"%s\" \"a\")", port_filename(obj));
- port_write_string(port)(sc, str, nlen, port);
- free(str);
- }
- }
- }
- else
- {
- if (is_string_port(obj))
- port_write_string(port)(sc, "<output-string-port", 19, port);
- else
- {
- if (is_file_port(obj))
- port_write_string(port)(sc, "<output-file-port", 17, port);
- else port_write_string(port)(sc, "<output-function-port", 21, port);
- }
- if (port_is_closed(obj))
- port_write_string(port)(sc, " (closed)>", 10, port);
- else port_write_character(port)(sc, '>', port);
- }
+ if (is_pair(args))
+ x = set_elist_5(sc, format_string_3, ctrl_str, args, make_integer(sc, fdat->loc + 20), msg);
+ else x = set_elist_4(sc, format_string_4, ctrl_str, make_integer(sc, fdat->loc + 20), msg);
+ }
+ if (fdat->port)
+ {
+ close_format_port(sc, fdat->port);
+ fdat->port = NULL;
}
+ return(s7_error(sc, sc->format_error_symbol, x));
}
-static void input_port_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write)
+#define format_error(Sc, Msg, Str, Args, Fdat) \
+ do {static s7_pointer _Err_ = NULL; if (!_Err_) _Err_ = s7_make_permanent_string(Msg); return(format_error_1(Sc, _Err_, Str, Args, Fdat));} while (0)
+
+#define just_format_error(Sc, Msg, Str, Args, Fdat) \
+ do {static s7_pointer _Err_ = NULL; if (!_Err_) _Err_ = s7_make_permanent_string(Msg); format_error_1(Sc, _Err_, Str, Args, Fdat);} while (0)
+
+static void format_append_char(s7_scheme *sc, format_data *fdat, char c, s7_pointer port)
{
- if (obj == sc->standard_input)
- port_write_string(port)(sc, port_filename(obj), port_filename_length(obj), port);
- else
+ port_write_character(port)(sc, c, port);
+ sc->format_column++;
+
+ /* if c is #\null, is this the right thing to do?
+ * We used to return "1 2 3 4" because ~C was first turned into a string (empty in this case)
+ * (format #f "1 2~C3 4" #\null)
+ * "1 2"
+ * Clisp does this:
+ * (format nil "1 2~C3 4" (int-char 0))
+ * "1 23 4"
+ * whereas sbcl says int-char is undefined, and
+ * Guile returns "1 2\x003 4"
+ */
+}
+
+static void format_append_newline(s7_scheme *sc, format_data *fdat, s7_pointer port)
+{
+ port_write_character(port)(sc, '\n', port);
+ sc->format_column = 0;
+}
+
+
+static void format_append_string(s7_scheme *sc, format_data *fdat, const char *str, int len, s7_pointer port)
+{
+ port_write_string(port)(sc, str, len, port);
+ fdat->loc += len;
+ sc->format_column += len;
+}
+
+static void format_append_chars(s7_scheme *sc, format_data *fdat, char pad, int chars, s7_pointer port)
+{
+ if (chars > 0)
{
- int nlen = 0;
- if (use_write == USE_READABLE_WRITE)
+ if (chars < TMPBUF_SIZE)
{
- if (port_is_closed(obj))
- port_write_string(port)(sc, "(call-with-input-string \"\" (lambda (p) p))", 42, port);
- else
- {
- if (is_function_port(obj))
- port_write_string(port)(sc, "#<function input port>", 22, port);
- else
- {
- char *str;
- if (is_file_port(obj))
- {
- str = (char *)malloc(256 * sizeof(char));
- nlen = snprintf(str, 256, "(open-input-file \"%s\")", port_filename(obj));
- port_write_string(port)(sc, str, nlen, port);
- free(str);
- }
- else
- {
- /* if the string is large, slashify_string is a problem. Usually this is actually
- * a file port where the contents were read in one (up to 5MB) gulp, so the
- * readable version could be: open file, read-char to the current port_position.
- * s7_port_filename(port) has the char* name if any.
- */
- int data_len;
- data_len = port_data_size(obj) - port_position(obj);
- if (data_len > 100)
- {
- const char *filename;
- filename = (const char *)s7_port_filename(obj);
- if (filename)
- {
- #define DO_STR_LEN 1024
- char *do_str;
- int len;
- do_str = (char *)malloc(DO_STR_LEN * sizeof(char));
- if (port_position(obj) > 0)
- {
- len = snprintf(do_str, DO_STR_LEN, "(let ((port (open-input-file \"%s\")))", filename);
- port_write_string(port)(sc, do_str, len, port);
- len = snprintf(do_str, DO_STR_LEN, " (do ((i 0 (+ i 1)) (c (read-char port) (read-char port))) ((= i %u) port)))",
- port_position(obj) - 1);
- }
- else len = snprintf(do_str, DO_STR_LEN, "(open-input-file \"%s\")", filename);
- port_write_string(port)(sc, do_str, len, port);
- free(do_str);
- return;
- }
- }
- port_write_string(port)(sc, "(open-input-string ", 19, port);
- /* not port_write_string here because there might be embedded double-quotes */
- str = slashify_string(sc, (const char *)(port_data(obj) + port_position(obj)), port_data_size(obj) - port_position(obj), IN_QUOTES, &nlen);
- port_write_string(port)(sc, str, nlen, port);
- port_write_character(port)(sc, ')', port);
- }
- }
- }
+ int j;
+ for (j = 0; j < chars; j++)
+ sc->tmpbuf[j] = pad;
+ sc->tmpbuf[chars] = '\0';
+ format_append_string(sc, fdat, sc->tmpbuf, chars, port);
}
else
{
- if (is_string_port(obj))
- port_write_string(port)(sc, "<input-string-port", 18, port);
- else
- {
- if (is_file_port(obj))
- port_write_string(port)(sc, "<input-file-port", 16, port);
- else port_write_string(port)(sc, "<input-function-port", 20, port);
- }
- if (port_is_closed(obj))
- port_write_string(port)(sc, " (closed)>", 10, port);
- else port_write_character(port)(sc, '>', port);
+ int j;
+ for (j = 0; j < chars; j++)
+ format_append_char(sc, fdat, pad, port);
}
}
}
-static bool symbol_needs_slashification(s7_pointer obj)
-{
- unsigned char *p, *pend;
- const char *str;
- int len;
- str = symbol_name(obj);
- if (str[0] == '#')
- return(true);
- len = symbol_name_length(obj);
- pend = (unsigned char *)(str + len);
- for (p = (unsigned char *)str; p < pend; p++)
- if (symbol_slashify_table[*p])
- return(true);
- set_clean_symbol(obj);
- return(false);
-}
-static void symbol_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write)
+static int format_read_integer(s7_scheme *sc, int *cur_i, int str_len, const char *str, s7_pointer args, format_data *fdat)
{
- /* I think this is the only place we print a symbol's name
- * but in the readable case, what about (symbol "1;3")? it actually seems ok!
- */
- if ((!is_clean_symbol(obj)) &&
- (symbol_needs_slashification(obj)))
- {
- int nlen = 0;
- char *str, *symstr;
- str = slashify_string(sc, symbol_name(obj), symbol_name_length(obj), NOT_IN_QUOTES, &nlen);
- nlen += 16;
- tmpbuf_malloc(symstr, nlen);
- nlen = snprintf(symstr, nlen, "(symbol \"%s\")", str);
- port_write_string(port)(sc, symstr, nlen, port);
- tmpbuf_free(symstr, nlen);
- }
- else
+ /* we know that str[*cur_i] is a digit */
+ int i, lval = 0;
+ for (i = *cur_i; i < str_len - 1; i++)
{
- if ((use_write == USE_READABLE_WRITE) &&
- (!is_keyword(obj)))
- port_write_character(port)(sc, '\'', port);
- if (is_string_port(port))
+ int dig;
+ dig = digits[(unsigned char)str[i]];
+ if (dig < 10)
{
- int new_len;
- new_len = port_position(port) + symbol_name_length(obj);
- if (new_len >= (int)port_data_size(port))
- resize_port_data(port, new_len * 2);
- memcpy((void *)(port_data(port) + port_position(port)), (void *)symbol_name(obj), symbol_name_length(obj));
- port_position(port) = new_len;
+#if HAVE_OVERFLOW_CHECKS
+ if ((int_multiply_overflow(lval, 10, &lval)) ||
+ (int_add_overflow(lval, dig, &lval)))
+ break;
+#else
+ lval = dig + (lval * 10);
+#endif
}
- else port_write_string(port)(sc, symbol_name(obj), symbol_name_length(obj), port);
+ else break;
}
+
+ if (i >= str_len)
+ just_format_error(sc, "numeric argument, but no directive!", str, args, fdat);
+ *cur_i = i;
+ return(lval);
}
-static void string_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write)
+
+static void format_number(s7_scheme *sc, format_data *fdat, int radix, int width, int precision, char float_choice, char pad, s7_pointer port)
{
- if (string_length(obj) > 0)
+ char *tmp;
+ int nlen = 0;
+ if (width < 0) width = 0;
+
+ /* precision choice depends on float_choice if it's -1 */
+ if (precision < 0)
{
- /* this used to check for length > 1<<24 -- is that still necessary?
- * since string_length is a scheme length, not C, this write can embed nulls from C's point of view
- */
- if (use_write == USE_DISPLAY)
- port_write_string(port)(sc, string_value(obj), string_length(obj), port);
+ if ((float_choice == 'e') ||
+ (float_choice == 'f') ||
+ (float_choice == 'g'))
+ precision = 6;
else
{
- if (!string_needs_slashification(string_value(obj), string_length(obj)))
- {
- port_write_character(port)(sc, '"', port);
- port_write_string(port)(sc, string_value(obj), string_length(obj), port);
- port_write_character(port)(sc, '"', port);
- }
- else
+ /* in the "int" cases, precision depends on the arg type */
+ switch (type(car(fdat->args)))
{
- char *str;
- int nlen = 0;
- str = slashify_string(sc, string_value(obj), string_length(obj), IN_QUOTES, &nlen);
- port_write_string(port)(sc, str, nlen, port);
+ case T_INTEGER:
+ case T_RATIO:
+ precision = 0;
+ break;
+
+ default:
+ precision = 6;
+ break;
}
}
}
- else
+ /* should (format #f "~F" 1/3) return "1/3"?? in CL it's "0.33333334" */
+
+ tmp = number_to_string_with_radix(sc, car(fdat->args), radix, width, precision, float_choice, &nlen);
+ if (pad != ' ')
{
- if (use_write != USE_DISPLAY)
- port_write_string(port)(sc, "\"\"", 2, port);
+ char *padtmp;
+ padtmp = tmp;
+ while (*padtmp == ' ') (*(padtmp++)) = pad;
}
-}
+ format_append_string(sc, fdat, tmp, nlen, port);
-static void byte_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_write_t use_write)
+ free(tmp);
+ fdat->args = cdr(fdat->args);
+ fdat->ctr++;
+}
+
+
+static int format_nesting(const char *str, char opener, char closer, int start, int end) /* start=i, end=str_len-1 */
{
- s7_int i, len;
- int plen;
- bool too_long = false;
+ int k, nesting = 1;
+ for (k = start + 2; k < end; k++)
+ if (str[k] == '~')
+ {
+ if (str[k + 1] == closer)
+ {
+ nesting--;
+ if (nesting == 0)
+ return(k - start - 1);
+ }
+ else
+ {
+ if (str[k + 1] == opener)
+ nesting++;
+ }
+ }
+ return(-1);
+}
- len = string_length(vect);
- if (use_write == USE_READABLE_WRITE)
- plen = len;
- else plen = sc->print_length;
+static bool format_method(s7_scheme *sc, const char *str, format_data *fdat, s7_pointer port)
+{
+ s7_pointer obj, func;
- if (len == 0)
- port_write_string(port)(sc, "#u8()", 5, port);
- else
+ obj = car(fdat->args);
+ if ((has_methods(obj)) &&
+ ((func = find_method(sc, find_let(sc, obj), sc->format_symbol)) != sc->undefined))
{
- if (plen <= 0)
- port_write_string(port)(sc, "#u8(...)", 8, port);
- else
- {
- unsigned int nlen;
- char *p;
- if (len > plen)
- {
- too_long = true;
- len = plen;
- }
- 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, ' ');
- 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' : ')');
- port_write_string(port)(sc, p, nlen - 1, port);
+ s7_pointer ctrl_str;
+ if (fdat->orig_str)
+ ctrl_str = fdat->orig_str;
+ else ctrl_str = make_string_wrapper(sc, str);
- if (too_long)
- port_write_string(port)(sc, " ...)", 5, port);
+ obj = s7_apply_function(sc, func, cons(sc, ctrl_str, fdat->args));
+ if (is_string(obj))
+ {
+ format_append_string(sc, fdat, string_value(obj), string_length(obj), port);
+ fdat->args = cdr(fdat->args);
+ fdat->ctr++;
+ return(true);
}
}
+ return(false);
}
-static void int_or_float_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_write_t use_write)
+#define MAX_FORMAT_NUMERIC_ARG 10000
+static int format_n_arg(s7_scheme *sc, const char *str, int str_len, format_data *fdat, s7_pointer args)
{
- s7_int i, len;
- int plen;
- bool too_long = false;
+ int n;
- len = vector_length(vect);
- if (use_write == USE_READABLE_WRITE)
- plen = len;
- else plen = sc->print_length;
+ if (is_null(fdat->args)) /* (format #f "~nT") */
+ 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));
- if (len == 0)
- port_write_string(port)(sc, "#()", 3, port);
+ if (n < 0)
+ just_format_error(sc, "~~N value is negative?", str, args, fdat);
else
{
- if (plen <= 0)
- port_write_string(port)(sc, "#(...)", 6, port);
- else
- {
- char buf[128];
- if (len > plen)
- {
- too_long = true;
- len = plen;
- }
- if (is_int_vector(vect))
- {
- if (vector_rank(vect) > 1)
- port_write_string(port)(sc, "(make-shared-vector (int-vector", 31, port);
- else port_write_string(port)(sc, "(int-vector", 11, port);
-
- if (!is_string_port(port))
- {
- for (i = 0; i < len; i++)
- {
- plen = snprintf(buf, 128, " %lld", int_vector_element(vect, i));
- port_write_string(port)(sc, buf, plen, port);
- }
- }
- else
- {
- /* an experiment */
- int new_len, next_len;
- unsigned char *dbuf;
- new_len = port_position(port);
- next_len = port_data_size(port) - 128;
- dbuf = port_data(port);
-
- for (i = 0; i < len; i++)
- {
- if (new_len >= next_len)
- {
- resize_port_data(port, port_data_size(port) * 2);
- next_len = port_data_size(port) - 128;
- dbuf = port_data(port);
- }
- plen = snprintf((char *)(dbuf + new_len), 128, " %lld", int_vector_element(vect, i));
- new_len += plen;
- }
- port_position(port) = new_len;
- }
- }
- else
- {
- if (vector_rank(vect) > 1)
- port_write_string(port)(sc, "(make-shared-vector (float-vector", 33, port);
- else port_write_string(port)(sc, "(float-vector", 13, port);
+ if (n > MAX_FORMAT_NUMERIC_ARG)
+ just_format_error(sc, "~~N value is too big", str, args, fdat);
+ }
- for (i = 0; i < len; i++)
- {
- port_write_character(port)(sc, ' ', port);
- plen = snprintf(buf, 124, float_format_g, float_format_precision, float_vector_element(vect, i)); /* 124 so floatify has room */
- floatify(buf, &plen);
- port_write_string(port)(sc, buf, plen, port);
- }
- }
+ fdat->args = cdr(fdat->args); /* I don't think fdat->ctr should be incremented here -- it's for *vector-print-length* etc */
+ return(n);
+}
- if (too_long)
- port_write_string(port)(sc, " ...)", 5, port);
- else port_write_character(port)(sc, ')', port);
- if (vector_rank(vect) > 1)
- {
- unsigned int dim;
- port_write_string(port)(sc, " '(", 3, port);
- for (dim = 0; dim < vector_ndims(vect) - 1; dim++)
- {
- plen = snprintf(buf, 128, "%lld ", vector_dimension(vect, dim));
- port_write_string(port)(sc, buf, plen, port);
- }
- plen = snprintf(buf, 128, "%lld", vector_dimension(vect, dim));
- port_write_string(port)(sc, buf, plen, port);
- port_write_string(port)(sc, "))", 2, port);
- }
- }
+static int format_numeric_arg(s7_scheme *sc, const char *str, int str_len, format_data *fdat, s7_pointer args, int *i)
+{
+ int width;
+ width = format_read_integer(sc, i, str_len, str, args, fdat);
+ if (width < 0)
+ just_format_error(sc, "width value is negative?", str, fdat->args, fdat);
+ else
+ {
+ if (width > MAX_FORMAT_NUMERIC_ARG)
+ just_format_error(sc, "width value is too big", str, fdat->args, fdat);
}
+ return(width);
}
-static void list_to_port(s7_scheme *sc, s7_pointer lst, s7_pointer port, use_write_t use_write, shared_info *ci)
+#if WITH_GMP
+static bool s7_is_one_or_big_one(s7_pointer p);
+#else
+#define s7_is_one_or_big_one(Num) s7_is_one(Num)
+#endif
+
+static s7_pointer object_to_list(s7_scheme *sc, s7_pointer obj);
+
+static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *str, s7_pointer args,
+ s7_pointer *next_arg, bool with_result, bool columnized, int len, s7_pointer orig_str)
{
- /* we need list_to_starboard... */
- s7_pointer x;
- int i, len, true_len;
+ int i, str_len;
+ format_data *fdat;
+ s7_pointer deferred_port;
- true_len = s7_list_length(sc, lst);
- if (true_len < 0) /* a dotted list -- handle cars, then final cdr */
- len = (-true_len + 1);
- else
+ if ((!with_result) &&
+ (port == sc->F))
+ return(sc->F);
+
+ if (len <= 0)
{
- if (true_len == 0) /* either () or a circular list */
+ str_len = safe_strlen(str);
+ if (str_len == 0)
{
- if (is_not_null(lst))
- len = circular_list_entries(lst);
- else
+ if (is_not_null(args))
{
- port_write_string(port)(sc, "()", 2, port);
- return;
+ static s7_pointer null_err = NULL;
+ if (!null_err)
+ null_err = s7_make_permanent_string("format control string is null, but there are arguments: ~S");
+ return(s7_error(sc, sc->format_error_symbol, set_elist_2(sc, null_err, args)));
}
+ if (with_result)
+ return(make_string_wrapper_with_length(sc, "", 0));
+ return(sc->F);
}
- else len = true_len;
}
+ else str_len = len;
- if (((car(lst) == sc->quote_symbol) ||
- (car(lst) == sc->quote_unchecked_symbol)) && /* this can happen (see lint.scm) */
- (true_len == 2))
+ sc->format_depth++;
+ if (sc->format_depth >= sc->num_fdats)
{
- /* len == 1 is important, otherwise (list 'quote 1 2) -> '1 2 which looks weird
- * or (object->string (apply . `''1)) -> "'quote 1"
- * so (quote x) = 'x but (quote x y z) should be left alone (if evaluated, it's an error)
- */
- port_write_character(port)(sc, '\'', port);
- object_to_port_with_circle_check(sc, cadr(lst), port, USE_WRITE, ci);
- return;
+ int k, new_num_fdats;
+ new_num_fdats = sc->format_depth * 2;
+ sc->fdats = (format_data **)realloc(sc->fdats, sizeof(format_data *) * new_num_fdats);
+ for (k = sc->num_fdats; k < new_num_fdats; k++) sc->fdats[k] = NULL;
+ sc->num_fdats = new_num_fdats;
}
- else port_write_character(port)(sc, '(', port);
-
- if (is_multiple_value(lst))
- port_write_string(port)(sc, "values ", 7, port);
- if (use_write == USE_READABLE_WRITE)
+ fdat = sc->fdats[sc->format_depth];
+ if (!fdat)
{
- if (ci)
- {
- int plen;
- char buf[128];
-
- port_write_string(port)(sc, "let (({lst} (make-list ", 23, port);
- plen = snprintf(buf, 128, "%d))) ", len);
- port_write_string(port)(sc, buf, plen, port);
-
- if ((shared_ref(ci, lst) < 0))
- {
- plen = snprintf(buf, 128, "(set! {%d} {lst}) ", -shared_ref(ci, lst));
- port_write_string(port)(sc, buf, plen, port);
- }
-
- port_write_string(port)(sc, "(let (({x} {lst})) ", 19, port);
- for (i = 0, x = lst; (i < len) && (is_pair(x)); i++, x = cdr(x))
- {
- port_write_string(port)(sc, "(set-car! {x} ", 14, port);
- object_to_port_with_circle_check(sc, car(x), port, use_write, ci);
- port_write_string(port)(sc, ") ", 2, port);
- if (i < len - 1)
- port_write_string(port)(sc, "(set! {x} (cdr {x})) ", 21, port);
- }
- if (!is_null(x))
- {
- port_write_string(port)(sc, "(set-cdr! {x} ", 14, port);
- object_to_port_with_circle_check(sc, x, port, use_write, ci);
- port_write_string(port)(sc, ") ", 2, port);
- }
- port_write_string(port)(sc, ") {lst})", 8, port);
- }
- else
- {
- /* the easier cases: no circles or shared refs to patch up */
- if (true_len > 0)
- {
- port_write_string(port)(sc, "list", 4, port);
- for (x = lst; is_pair(x); x = cdr(x))
- {
- port_write_character(port)(sc, ' ', port);
- object_to_port_with_circle_check(sc, car(x), port, use_write, ci);
- }
- port_write_character(port)(sc, ')', port);
- }
- else
- {
- port_write_string(port)(sc, "cons ", 5, port);
- object_to_port_with_circle_check(sc, car(lst), port, use_write, ci);
- for (x = cdr(lst); is_pair(x); x = cdr(x))
- {
- port_write_character(port)(sc, ' ', port);
- port_write_string(port)(sc, "(cons ", 6, port);
- object_to_port_with_circle_check(sc, car(x), port, use_write, ci);
- }
- port_write_character(port)(sc, ' ', port);
- object_to_port_with_circle_check(sc, x, port, use_write, ci);
- for (i = 1; i < len; i++)
- port_write_character(port)(sc, ')', port);
- }
- }
+ fdat = (format_data *)malloc(sizeof(format_data));
+ sc->fdats[sc->format_depth] = fdat;
+ fdat->curly_len = 0;
+ fdat->curly_str = NULL;
+ fdat->ctr = 0;
}
else
{
- if (ci)
- {
- for (x = lst, i = 0; (is_pair(x)) && (i < len) && ((!ci) || (i == 0) || (peek_shared_ref(ci, x) == 0)); i++, x = cdr(x))
- {
- object_to_port_with_circle_check(sc, car(x), port, DONT_USE_DISPLAY(use_write), ci);
- if (i < (len - 1))
- port_write_character(port)(sc, ' ', port);
- }
- if (is_not_null(x))
- {
- if ((true_len == 0) &&
- (i == len))
- port_write_string(port)(sc, " . ", 3, port);
- else port_write_string(port)(sc, ". ", 2, port);
- object_to_port_with_circle_check(sc, x, port, DONT_USE_DISPLAY(use_write), ci);
- }
- port_write_character(port)(sc, ')', port);
- }
- else
- {
- for (x = lst, i = 0; (is_pair(x)) && (i < len); i++, x = cdr(x))
- {
- object_to_port(sc, car(x), port, DONT_USE_DISPLAY(use_write), ci);
- if (i < (len - 1))
- port_write_character(port)(sc, ' ', port);
- }
- if (is_not_null(x))
- {
- port_write_string(port)(sc, ". ", 2, port);
- object_to_port(sc, x, port, DONT_USE_DISPLAY(use_write), ci);
- }
- port_write_character(port)(sc, ')', port);
- }
+ if (fdat->port)
+ close_format_port(sc, fdat->port);
+ if (fdat->strport)
+ close_format_port(sc, fdat->strport);
}
-}
-
-
-static void hash_table_to_port(s7_scheme *sc, s7_pointer hash, s7_pointer port, use_write_t use_write, shared_info *ci)
-{
- int i, len;
- unsigned int gc_iter;
- bool too_long = false;
- s7_pointer iterator, p;
+ fdat->port = NULL;
+ fdat->strport = NULL;
+ fdat->loc = 0;
+ fdat->args = args;
+ fdat->orig_str = orig_str;
+ fdat->curly_arg = sc->nil;
- /* if hash is a member of ci, just print its number
- * (let ((ht (hash-table '(a . 1)))) (hash-table-set! ht 'b ht))
- *
- * since equal? does not care about the hash-table lengths, we can ignore that complication in the :readable case
+ /* choose whether to write to a temporary string port, or simply use the in-coming port
+ * if with_result, returned string is wanted.
+ * if port is sc->F, no non-string result is wanted.
+ * if port is not boolean, it better be a port.
+ * if we are about to goto START in eval, and main_stack_op(Sc) == OP_BEGIN1, no return string is wanted -- yow, this is not true
*/
- len = hash_table_entries(hash);
- if (len == 0)
+ if (with_result)
{
- port_write_string(port)(sc, "(hash-table)", 12, port);
- return;
+ deferred_port = port;
+ port = open_format_port(sc);
+ fdat->port = port;
}
+ else deferred_port = sc->F;
- if (use_write != USE_READABLE_WRITE)
+ for (i = 0; i < str_len - 1; i++)
{
- s7_int plen;
- plen = sc->print_length;
- if (plen <= 0)
- {
- port_write_string(port)(sc, "(hash-table ...)", 16, port);
- return;
- }
- if (len > plen)
+ if ((unsigned char)(str[i]) == (unsigned char)'~') /* what does MS C want? */
{
- too_long = true;
- len = plen;
- }
- }
+ use_write_t use_write;
+ switch (str[i + 1])
+ {
+ case '%': /* -------- newline -------- */
+ /* sbcl apparently accepts numeric args here (including 0) */
- iterator = s7_make_iterator(sc, hash);
- gc_iter = s7_gc_protect(sc, iterator);
- p = cons(sc, sc->F, sc->F);
- iterator_current(iterator) = p;
- set_mark_seq(iterator);
+ if ((port_data(port)) &&
+ (port_position(port) < port_data_size(port)))
+ {
+ port_data(port)[port_position(port)++] = '\n';
+ /* which is actually a bad idea, but as a desperate stopgap, I simply padded
+ * the string port string with 8 chars that are not in the length.
+ */
+ sc->format_column = 0;
+ }
+ else format_append_newline(sc, fdat, port);
+ i++;
+ break;
- if ((use_write == USE_READABLE_WRITE) &&
- (ci) &&
- (peek_shared_ref(ci, hash) != 0))
- {
- port_write_string(port)(sc, "(let (({ht} (make-hash-table)))", 31, port);
- if (shared_ref(ci, hash) < 0)
- {
- int plen;
- char buf[64];
- plen = snprintf(buf, 64, "(set! {%d} {ht}) ", -shared_ref(ci, hash));
- port_write_string(port)(sc, buf, plen, port);
- }
- for (i = 0; i < len; i++)
- {
- s7_pointer key_val, key, val;
+ case '&': /* -------- conditional newline -------- */
+ /* this only works if all output goes through format -- display/write for example do not update format_column */
+ if (sc->format_column > 0)
+ format_append_newline(sc, fdat, port);
+ i++;
+ break;
- key_val = hash_table_iterate(sc, iterator);
- key = car(key_val);
- val = cdr(key_val);
+ case '~': /* -------- tilde -------- */
+ format_append_char(sc, fdat, '~', port);
+ i++;
+ break;
- port_write_string(port)(sc, " (set! ({ht} ", 13, port);
- if (key == hash)
- port_write_string(port)(sc, "{ht}", 4, port);
- else object_to_port_with_circle_check(sc, key, port, USE_READABLE_WRITE, ci);
- port_write_string(port)(sc, ") ", 2, port);
- if (val == hash)
- port_write_string(port)(sc, "{ht}", 4, port);
- else object_to_port_with_circle_check(sc, val, port, USE_READABLE_WRITE, ci);
- port_write_character(port)(sc, ')', port);
- }
- port_write_string(port)(sc, " {ht})", 6, port);
- }
- else
- {
- port_write_string(port)(sc, "(hash-table", 11, port);
- for (i = 0; i < len; i++)
- {
- s7_pointer key_val;
- if (use_write == USE_READABLE_WRITE)
- port_write_character(port)(sc, ' ', port);
- else port_write_string(port)(sc, " '", 2, port);
- key_val = hash_table_iterate(sc, iterator);
- object_to_port_with_circle_check(sc, key_val, port, DONT_USE_DISPLAY(use_write), ci);
- }
+ case '\n': /* -------- trim white-space -------- */
+ for (i = i + 2; i <str_len - 1; i++)
+ if (!(white_space[(unsigned char)(str[i])]))
+ {
+ i--;
+ break;
+ }
+ break;
- if (too_long)
- port_write_string(port)(sc, " ...)", 5, port);
- else port_write_character(port)(sc, ')', port);
- }
+ case '*': /* -------- ignore arg -------- */
+ i++;
+ if (is_null(fdat->args)) /* (format #f "~*~A") */
+ format_error(sc, "can't skip argument!", str, args, fdat);
+ fdat->args = cdr(fdat->args);
+ break;
- s7_gc_unprotect_at(sc, gc_iter);
-}
+ case '|': /* -------- exit if args nil or ctr > (*s7* 'print-length) -------- */
+ if ((is_pair(fdat->args)) &&
+ (fdat->ctr >= sc->print_length))
+ {
+ format_append_string(sc, fdat, " ...", 4, port);
+ fdat->args = sc->nil;
+ }
+ /* fall through */
+ case '^': /* -------- exit -------- */
+ if (is_null(fdat->args))
+ {
+ i = str_len;
+ goto ALL_DONE;
+ }
+ i++;
+ break;
-static int slot_to_port_1(s7_scheme *sc, s7_pointer x, s7_pointer port, use_write_t use_write, shared_info *ci, int n)
-{
- if (is_slot(x))
- {
- n = slot_to_port_1(sc, next_slot(x), port, use_write, ci, n);
- if (n <= sc->print_length)
- {
- port_write_character(port)(sc, ' ', port);
- object_to_port_with_circle_check(sc, x, port, use_write, ci);
- }
- if (n == (sc->print_length + 1))
- port_write_string(port)(sc, " ...", 4, port);
- }
- return(n + 1);
-}
+ case '@': /* -------- plural, 'y' or 'ies' -------- */
+ i += 2;
+ if ((str[i] != 'P') && (str[i] != 'p'))
+ format_error(sc, "unknown '@' directive", 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);
-static void let_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
-{
- /* if outer env points to (say) method list, the object needs to specialize object->string itself */
- if (has_methods(obj))
- {
- s7_pointer print_func;
- print_func = find_method(sc, obj, sc->object_to_string_symbol);
- if (print_func != sc->undefined)
+ if (!s7_is_one_or_big_one(car(fdat->args)))
+ format_append_string(sc, fdat, "ies", 3, port);
+ else format_append_char(sc, fdat, 'y', port);
+
+ fdat->args = cdr(fdat->args);
+ break;
+
+ case 'P': case 'p': /* -------- plural in 's' -------- */
+ 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)))
+ format_append_char(sc, fdat, 's', port);
+ i++;
+ fdat->args = cdr(fdat->args);
+ break;
+
+ case '{': /* -------- iteration -------- */
+ {
+ int curly_len;
+
+ if (is_null(fdat->args))
+ format_error(sc, "missing argument", str, args, fdat);
+
+ curly_len = format_nesting(str, '{', '}', i, str_len - 1);
+
+ if (curly_len == -1)
+ format_error(sc, "'{' directive, but no matching '}'", str, args, fdat);
+ if (curly_len == 1)
+ format_error(sc, "~{~}' doesn't consume any arguments!", str, args, fdat);
+
+ /* what about cons's here? I can't see any way in CL either to specify the car or cdr of a cons within the format string
+ * (cons 1 2) is applicable: ((cons 1 2) 0) -> 1
+ * also there can be applicable objects that won't work in the map context (arg not integer etc)
+ */
+ if (is_not_null(car(fdat->args))) /* (format #f "~{~A ~}" ()) -> "" */
+ {
+ s7_pointer curly_arg;
+ 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 ~}" #()) -> "" */
+ {
+ char *curly_str = NULL; /* this is the local (nested) format control string */
+ s7_pointer orig_arg;
+
+ if (!is_proper_list(sc, curly_arg))
+ format_error(sc, "'{' directive argument should be a proper list or something we can turn into a list", str, args, fdat);
+
+ fdat->curly_arg = curly_arg;
+ if (curly_arg != car(fdat->args))
+ orig_arg = curly_arg;
+ else orig_arg = sc->nil;
+
+ if (curly_len > fdat->curly_len)
+ {
+ if (fdat->curly_str) free (fdat->curly_str);
+ fdat->curly_len = curly_len;
+ fdat->curly_str = (char *)malloc(curly_len * sizeof(char));
+ }
+ curly_str = fdat->curly_str;
+ memcpy((void *)curly_str, (void *)(str + i + 2), curly_len - 1);
+ curly_str[curly_len - 1] = '\0';
+
+ if ((sc->format_depth < sc->num_fdats - 1) &&
+ (sc->fdats[sc->format_depth + 1]))
+ sc->fdats[sc->format_depth + 1]->ctr = 0;
+
+ /* it's not easy to use an iterator here instead of a list (so object->list isn't needed above),
+ * because the curly brackets may enclose multiple arguments -- we would need to use
+ * iterators throughout this function.
+ */
+ while (is_not_null(curly_arg))
+ {
+ s7_pointer new_arg = sc->nil;
+ format_to_port_1(sc, port, curly_str, curly_arg, &new_arg, false, columnized, curly_len - 1, NULL);
+ if (curly_arg == new_arg)
+ {
+ fdat->curly_arg = sc->nil;
+ format_error(sc, "'{...}' doesn't consume any arguments!", str, args, fdat);
+ }
+ curly_arg = new_arg;
+ }
+ fdat->curly_arg = sc->nil;
+ while (is_pair(orig_arg))
+ {
+ s7_pointer p;
+ p = orig_arg;
+ orig_arg = cdr(orig_arg);
+ free_cell(sc, p); /* if car(fdar->args) is a hash-table, we could also free_cell(car(p)), but not in any other case */
+ }
+ }
+ }
+
+ i += (curly_len + 2); /* jump past the ending '}' too */
+ fdat->args = cdr(fdat->args);
+ fdat->ctr++;
+ }
+ break;
+
+ case '}':
+ format_error(sc, "unmatched '}'", str, args, fdat);
+
+ case 'W': case 'w':
+ use_write = USE_READABLE_WRITE;
+ goto OBJSTR;
+
+ case 'S': case 's':
+ use_write = USE_WRITE;
+ goto OBJSTR;
+
+ case 'A': case 'a':
+ use_write = USE_DISPLAY;
+ OBJSTR:
+ /* object->string */
+ {
+ s7_pointer obj, strport;
+ if (is_null(fdat->args))
+ format_error(sc, "missing argument", str, args, fdat);
+
+ i++;
+ obj = car(fdat->args);
+ /* for the column check, we need to know the length of the object->string output */
+ if (columnized)
+ {
+ strport = open_format_port(sc);
+ fdat->strport = strport;
+ }
+ else strport = port;
+ object_out(sc, obj, strport, use_write);
+ if (columnized)
+ {
+ if (port_position(strport) >= port_data_size(strport))
+ resize_port_data(strport, port_data_size(strport) * 2);
+
+ port_data(strport)[port_position(strport)] = '\0';
+ if (port_position(strport) > 0)
+ format_append_string(sc, fdat, (const char *)port_data(strport), port_position(strport), port);
+ close_format_port(sc, strport);
+ fdat->strport = NULL;
+ }
+
+ fdat->args = cdr(fdat->args);
+ fdat->ctr++;
+ }
+ break;
+
+
+ /* -------- numeric args -------- */
+ case '0': case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9': case ',':
+ case 'N': case 'n':
+
+ case 'B': case 'b':
+ case 'D': case 'd':
+ case 'E': case 'e':
+ case 'F': case 'f':
+ case 'G': case 'g':
+ case 'O': case 'o':
+ case 'X': case 'x':
+
+ case 'T': case 't':
+ case 'C': case 'c':
+ {
+ int width = -1, precision = -1;
+ char pad = ' ';
+ i++; /* str[i] == '~' */
+
+ if (isdigit((int)(str[i])))
+ width = format_numeric_arg(sc, str, str_len, fdat, args, &i);
+ else
+ {
+ if ((str[i] == 'N') || (str[i] == 'n'))
+ {
+ i++;
+ width = format_n_arg(sc, str, str_len, fdat, args);
+ }
+ }
+ if (str[i] == ',')
+ {
+ i++; /* is (format #f "~12,12D" 1) an error? The precision has no use here. */
+ if (isdigit((int)(str[i])))
+ precision = format_numeric_arg(sc, str, str_len, fdat, args, &i);
+ else
+ {
+ if ((str[i] == 'N') || (str[i] == 'n'))
+ {
+ i++;
+ precision = format_n_arg(sc, str, str_len, fdat, args);
+ }
+ else
+ {
+ if (str[i] == '\'') /* (format #f "~12,'xD" 1) -> "xxxxxxxxxxx1" */
+ {
+ pad = str[i + 1];
+ i += 2;
+ if (i >= str_len) /* (format #f "~,'") */
+ format_error(sc, "incomplete numeric argument", str, args, fdat);
+ }
+ /* is (let ((str "~12,'xD")) (set! (str 5) #\null) (format #f str 1)) an error? */
+ }
+ }
+ }
+
+ switch (str[i])
+ {
+ /* -------- pad to column --------
+ * are columns numbered from 1 or 0? there seems to be disagreement about this directive
+ * does "space over to" mean including?
+ */
+
+ case 'T': case 't':
+ if (width == -1) width = 0;
+ if (precision == -1) precision = 0;
+ if ((width > 0) || (precision > 0)) /* (format #f "a~8Tb") */
+ {
+ /* (length (substring (format #f "~%~10T.") 1)) == (length (format #f "~10T."))
+ * (length (substring (format #f "~%-~10T.~%") 1)) == (length (format #f "-~10T.~%"))
+ */
+ if (precision > 0)
+ {
+ int mult;
+ mult = (int)(ceil((s7_double)(sc->format_column + 1 - width) / (s7_double)precision)); /* CLtL2 ("least positive int") */
+ if (mult < 1) mult = 1;
+ width += (precision * mult);
+ }
+ format_append_chars(sc, fdat, pad, width - sc->format_column - 1, port);
+ }
+ break;
+
+ case 'C': case 'c':
+ {
+ s7_pointer obj;
+
+ if (is_null(fdat->args))
+ format_error(sc, "~~C: missing argument", str, args, fdat);
+ /* the "~~" here and below protects against "~C" being treated as a directive */
+ /* i++; */
+ obj = car(fdat->args);
+
+ if (!s7_is_character(obj))
+ {
+ if (!format_method(sc, str, fdat, port))
+ format_error(sc, "'C' directive requires a character argument", str, args, fdat);
+ }
+ else
+ {
+ /* here use_write is false, so we just add the char, not its name */
+ if (width == -1)
+ format_append_char(sc, fdat, character(obj), port);
+ else format_append_chars(sc, fdat, character(obj), width, port);
+ fdat->args = cdr(fdat->args);
+ fdat->ctr++;
+ }
+ }
+ break;
+
+ /* -------- numbers -------- */
+ case 'F': case 'f':
+ if (is_null(fdat->args))
+ format_error(sc, "~~F: missing argument", str, args, fdat);
+ if (!(s7_is_number(car(fdat->args))))
+ {
+ if (!format_method(sc, str, fdat, port))
+ format_error(sc, "~~F: numeric argument required", str, args, fdat);
+ }
+ else format_number(sc, fdat, 10, width, precision, 'f', pad, port);
+ break;
+
+ case 'G': case 'g':
+ if (is_null(fdat->args))
+ format_error(sc, "~~G: missing argument", str, args, fdat);
+ if (!(s7_is_number(car(fdat->args))))
+ {
+ if (!format_method(sc, str, fdat, port))
+ format_error(sc, "~~G: numeric argument required", str, args, fdat);
+ }
+ else format_number(sc, fdat, 10, width, precision, 'g', pad, port);
+ break;
+
+ case 'E': case 'e':
+ if (is_null(fdat->args))
+ format_error(sc, "~~E: missing argument", str, args, fdat);
+ if (!(s7_is_number(car(fdat->args))))
+ {
+ if (!format_method(sc, str, fdat, port))
+ format_error(sc, "~~E: numeric argument required", str, args, fdat);
+ }
+ else format_number(sc, fdat, 10, width, precision, 'e', pad, port);
+ break;
+
+ /* how to handle non-integer arguments in the next 4 cases? clisp just returns
+ * the argument: (format nil "~X" 1.25) -> "1.25" which is perverse (ClTl2 p 581:
+ * "if arg is not an integer, it is printed in ~A format and decimal base")!!
+ * I think I'll use the type of the number to choose the output format.
+ */
+ case 'D': case 'd':
+ if (is_null(fdat->args))
+ format_error(sc, "~~D: missing argument", str, args, fdat);
+ if (!(s7_is_number(car(fdat->args))))
+ {
+ /* (let () (require mockery.scm) (format #f "~D" ((*mock-number* 'mock-number) 123)))
+ * port here is a string-port, str has the width/precision data if the caller wants it,
+ * args is the current arg. But format_number handles fdat->args and so on, so
+ * I think I'll pass the format method the current control string (str), the
+ * current object (car(fdat->args)), and the arglist (args), and assume it will
+ * return a (scheme) string.
+ */
+ if (!format_method(sc, str, fdat, port))
+ format_error(sc, "~~D: numeric argument required", str, args, fdat);
+ }
+ else format_number(sc, fdat, 10, width, precision, 'd', pad, port);
+ break;
+
+ case 'O': case 'o':
+ if (is_null(fdat->args))
+ format_error(sc, "~~O: missing argument", str, args, fdat);
+ if (!(s7_is_number(car(fdat->args))))
+ {
+ if (!format_method(sc, str, fdat, port))
+ format_error(sc, "~~O: numeric argument required", str, args, fdat);
+ }
+ else format_number(sc, fdat, 8, width, precision, 'o', pad, port);
+ break;
+
+ case 'X': case 'x':
+ if (is_null(fdat->args))
+ format_error(sc, "~~X: missing argument", str, args, fdat);
+ if (!(s7_is_number(car(fdat->args))))
+ {
+ if (!format_method(sc, str, fdat, port))
+ format_error(sc, "~~X: numeric argument required", str, args, fdat);
+ }
+ else format_number(sc, fdat, 16, width, precision, 'x', pad, port);
+ break;
+
+ case 'B': case 'b':
+ if (is_null(fdat->args))
+ format_error(sc, "~~B: missing argument", str, args, fdat);
+ if (!(s7_is_number(car(fdat->args))))
+ {
+ if (!format_method(sc, str, fdat, port))
+ format_error(sc, "~~B: numeric argument required", str, args, fdat);
+ }
+ else format_number(sc, fdat, 2, width, precision, 'b', pad, port);
+ break;
+
+ default:
+ if (width > 0)
+ format_error(sc, "unused numeric argument", str, args, fdat);
+ format_error(sc, "unimplemented format directive", str, args, fdat);
+ }
+ }
+ break;
+
+ default:
+ format_error(sc, "unimplemented format directive", str, args, fdat);
+ }
+ }
+ else /* str[i] is not #\~ */
{
- s7_pointer p;
- /* what needs to be protected here? for one, the function might not return a string! */
+ int j, new_len;
+ const char *p;
- clear_has_methods(obj);
- if (use_write == USE_WRITE)
- p = s7_apply_function(sc, print_func, list_1(sc, obj));
- else p = s7_apply_function(sc, print_func, list_2(sc, obj, (use_write == USE_DISPLAY) ? sc->F : sc->key_readable_symbol));
- set_has_methods(obj);
+ p = (char *)strchr((const char *)(str + i + 1), (int)'~');
+ if (!p)
+ j = str_len;
+ else j = (int)(p - str);
+ new_len = j - i;
- if ((is_string(p)) &&
- (string_length(p) > 0))
- port_write_string(port)(sc, string_value(p), string_length(p), port);
- return;
+ if ((port_data(port)) &&
+ ((port_position(port) + new_len) < port_data_size(port)))
+ {
+ memcpy((void *)(port_data(port) + port_position(port)), (void *)(str + i), new_len);
+ port_position(port) += new_len;
+ }
+ else port_write_string(port)(sc, (char *)(str + i), new_len, port);
+ fdat->loc += new_len;
+ sc->format_column += new_len;
+ i = j - 1;
}
}
- if (obj == sc->rootlet)
- port_write_string(port)(sc, "(rootlet)", 9, port);
+
+ ALL_DONE:
+ if (next_arg)
+ (*next_arg) = fdat->args;
else
{
- if (sc->short_print)
- port_write_string(port)(sc, "#<let>", 6, port);
- else
+ if (is_not_null(fdat->args))
+ format_error(sc, "too many arguments", str, args, fdat);
+ }
+ if (i < str_len)
+ {
+ if (str[i] == '~')
+ format_error(sc, "control string ends in tilde", str, args, fdat);
+ format_append_char(sc, fdat, str[i], port);
+ }
+
+ sc->format_depth--;
+
+ if (with_result)
+ {
+ s7_pointer result;
+
+ if ((is_output_port(deferred_port)) &&
+ (port_position(port) > 0))
{
- /* circles can happen here:
- * (let () (let ((b (curlet))) (curlet)))
- * #<let 'b #<let>>
- * or (let ((b #f)) (set! b (curlet)) (curlet))
- * #1=#<let 'b #1#>
- */
- if ((use_write == USE_READABLE_WRITE) &&
- (ci) &&
- (peek_shared_ref(ci, obj) != 0))
- {
- s7_pointer x;
- port_write_string(port)(sc, "(let (({e} (inlet))) ", 21, port);
- if ((ci) &&
- (shared_ref(ci, obj) < 0))
- {
- int plen;
- char buf[64];
- plen = snprintf(buf, 64, "(set! {%d} {e}) ", -shared_ref(ci, obj));
- port_write_string(port)(sc, buf, plen, port);
- }
-
- port_write_string(port)(sc, "(apply varlet {e} (reverse (list ", 33, port);
- for (x = let_slots(obj); is_slot(x); x = next_slot(x))
- {
- port_write_string(port)(sc, "(cons ", 6, port);
- symbol_to_port(sc, slot_symbol(x), port, use_write);
- port_write_character(port)(sc, ' ', port);
- object_to_port_with_circle_check(sc, slot_value(x), port, use_write, ci);
- port_write_character(port)(sc, ')', port);
- }
- port_write_string(port)(sc, "))) {e})", 8, port);
- }
- else
- {
- port_write_string(port)(sc, "(inlet", 6, port);
- slot_to_port_1(sc, let_slots(obj), port, use_write, ci, 0);
- port_write_character(port)(sc, ')', port);
- }
+ port_data(port)[port_position(port)] = '\0';
+ port_write_string(deferred_port)(sc, (const char *)port_data(port), port_position(port), deferred_port);
}
+ result = s7_make_string_with_length(sc, (char *)port_data(port), port_position(port));
+ close_format_port(sc, port);
+ fdat->port = NULL;
+ return(result);
+ }
+ return(sc->F);
+}
+
+
+static bool is_columnizing(const char *str)
+{
+ /* look for ~t ~,<int>T ~<int>,<int>t */
+ char *p;
+
+ for (p = (char *)str; (*p);)
+ if (*p++ == '~') /* this is faster than strchr */
+ {
+ char c;
+ c = *p++;
+ if ((c == 't') || (c == 'T')) return(true);
+ if (!c) return(false);
+ if ((c == ',') || ((c >= '0') && (c <= '9')) || (c == 'n') || (c == 'N'))
+ {
+ while (((c >= '0') && (c <= '9')) || (c == 'n') || (c == 'N')) c = *p++;
+ if ((c == 't') || (c == 'T')) return(true);
+ if (!c) return(false); /* ~,1 for example */
+ if (c == ',')
+ {
+ c = *p++;
+ while (((c >= '0') && (c <= '9')) || (c == 'n') || (c == 'N')) c = *p++;
+ if ((c == 't') || (c == 'T')) return(true);
+ if (!c) return(false);
+ }
+ }
+ }
+ return(false);
+}
+
+
+static s7_pointer format_to_port(s7_scheme *sc, s7_pointer port, const char *str, s7_pointer args, s7_pointer *next_arg, bool with_result, int len)
+{
+ return(format_to_port_1(sc, port, str, args, next_arg, with_result, true /* is_columnizing(str) */, len, NULL));
+ /* is_columnizing on every call is much slower than ignoring the issue */
+}
+
+
+static s7_pointer g_format_1(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer pt, str;
+ sc->format_column = 0;
+ pt = car(args);
+
+ if (is_string(pt))
+ return(format_to_port_1(sc, sc->F, string_value(pt), cdr(args), NULL, true, true, string_length(pt), pt));
+ if (is_null(pt)) pt = sc->output_port; /* () -> (current-output-port) */
+
+ if (!((s7_is_boolean(pt)) || /* #f or #t */
+ ((is_output_port(pt)) && /* (current-output-port) or call-with-open-file arg, etc */
+ (!port_is_closed(pt)))))
+ method_or_bust_with_type(sc, pt, sc->format_symbol, args, an_output_port_string, 1);
+
+ str = cadr(args);
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->format_symbol, args, T_STRING, 2);
+
+ return(format_to_port_1(sc, (pt == sc->T) ? sc->output_port : pt,
+ string_value(str), cddr(args), NULL, !is_output_port(pt), true, string_length(str), str));
+}
+
+
+static s7_pointer g_format(s7_scheme *sc, s7_pointer args)
+{
+ #define H_format "(format out str . args) substitutes args into str sending the result to out. Most of \
+s7's format directives are taken from CL: ~% = newline, ~& = newline if the preceding output character was \
+no a newline, ~~ = ~, ~<newline> trims white space, ~* skips an argument, ~^ exits {} iteration if the arg list is exhausted, \
+~nT spaces over to column n, ~A prints a representation of any object, ~S is the same, but puts strings in double quotes, \
+~C prints a character, numbers are handled by ~F, ~E, ~G, ~B, ~O, ~D, and ~X with preceding numbers giving \
+spacing (and spacing character) and precision. ~{ starts an embedded format directive which is ended by ~}: \n\
+\n\
+ >(format #f \"dashed: ~{~A~^-~}\" '(1 2 3))\n\
+ \"dashed: 1-2-3\"\n\
+\n\
+~P inserts \"s\" if the current it is not 1 or 1.0 (use ~@P for \"ies\" or \"y\").\n\
+~B is number->string in base 2, ~O in base 8, ~D base 10, ~X base 16,\n\
+~E: (format #f \"~E\" 100.1) -> \"1.001000e+02\" (%e in C)\n\
+~F: (format #f \"~F\" 100.1) -> \"100.100000\" (%f in C)\n\
+~G: (format #f \"~G\" 100.1) -> \"100.1\" (%g in C)\n\
+\n\
+If the 'out' it is not an output port, the resultant string is returned. If it \
+is #t, the string is also sent to the current-output-port."
+
+ #define Q_format s7_make_circular_signature(sc, 1, 2, s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_boolean_symbol), sc->T)
+ return(g_format_1(sc, args));
+}
+
+
+const char *s7_format(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer result;
+ result = g_format_1(sc, args);
+ if (is_string(result))
+ return(string_value(result));
+ return(NULL);
+}
+
+
+/* -------------------------------- system extras -------------------------------- */
+
+#if WITH_SYSTEM_EXTRAS
+#include <fcntl.h>
+
+static s7_pointer g_is_directory(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_directory "(directory? str) returns #t if str is the name of a directory"
+ #define Q_is_directory s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_string_symbol)
+ s7_pointer name;
+ name = car(args);
+
+ if (!is_string(name))
+ method_or_bust_one_arg(sc, name, sc->is_directory_symbol, args, T_STRING);
+ return(s7_make_boolean(sc, is_directory(string_value(name))));
+}
+
+static bool is_directory_b(s7_pointer p)
+{
+ if (!is_string(p))
+ simple_wrong_type_argument(cur_sc, cur_sc->is_directory_symbol, p, T_STRING);
+ return(is_directory(string_value(p)));
+}
+
+
+static bool file_probe(const char *arg)
+{
+#if (!MS_WINDOWS)
+ return(access(arg, F_OK) == 0);
+#else
+ int fd;
+ fd = open(arg, O_RDONLY, 0);
+ if (fd == -1) return(false);
+ close(fd);
+ return(true);
+#endif
+}
+
+
+static s7_pointer g_file_exists(s7_scheme *sc, s7_pointer args)
+{
+ #define H_file_exists "(file-exists? filename) returns #t if the file exists"
+ #define Q_file_exists s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_string_symbol)
+
+ s7_pointer name;
+ name = car(args);
+
+ if (!is_string(name))
+ method_or_bust_one_arg(sc, name, sc->file_exists_symbol, args, T_STRING);
+ return(s7_make_boolean(sc, file_probe(string_value(name))));
+}
+
+static bool file_exists_b(s7_pointer p)
+{
+ if (!is_string(p))
+ simple_wrong_type_argument(cur_sc, cur_sc->file_exists_symbol, p, T_STRING);
+ return(file_probe(string_value(p)));
+}
+
+
+static s7_pointer g_delete_file(s7_scheme *sc, s7_pointer args)
+{
+ #define H_delete_file "(delete-file filename) deletes the file filename."
+ #define Q_delete_file s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_string_symbol)
+
+ s7_pointer name;
+ name = car(args);
+
+ if (!is_string(name))
+ method_or_bust_one_arg(sc, name, sc->delete_file_symbol, args, T_STRING);
+ return(make_integer(sc, unlink(string_value(name))));
+}
+
+
+static s7_pointer g_getenv(s7_scheme *sc, s7_pointer args)
+{
+ #define H_getenv "(getenv var) returns the value of an environment variable."
+ #define Q_getenv pcl_s
+
+ s7_pointer name;
+ name = car(args);
+
+ if (!is_string(name))
+ method_or_bust_one_arg(sc, name, sc->getenv_symbol, args, T_STRING);
+ return(s7_make_string(sc, getenv(string_value(name))));
+}
+
+
+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, \
+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)
+
+ s7_pointer name;
+ name = car(args);
+
+ if (!is_string(name))
+ method_or_bust_one_arg(sc, name, sc->system_symbol, args, T_STRING);
+
+ if ((is_pair(cdr(args))) &&
+ (cadr(args) == sc->T))
+ {
+ #define BUF_SIZE 256
+ char buf[BUF_SIZE];
+ char *str = NULL;
+ int cur_len = 0, full_len = 0;
+ FILE *fd;
+ s7_pointer res;
+
+ fd = popen(string_value(name), "r");
+ while (fgets(buf, BUF_SIZE, fd))
+ {
+ int buf_len;
+ buf_len = safe_strlen(buf);
+ if (cur_len + buf_len >= full_len)
+ {
+ full_len += BUF_SIZE * 2;
+ if (str)
+ str = (char *)realloc(str, full_len * sizeof(char));
+ else str = (char *)malloc(full_len * sizeof(char));
+ }
+ memcpy((void *)(str + cur_len), (void *)buf, buf_len);
+ cur_len += buf_len;
+ }
+ pclose(fd);
+
+ res = s7_make_string_with_length(sc, str, cur_len);
+ if (str) free(str);
+ return(res);
+ }
+ return(make_integer(sc, system(string_value(name))));
+}
+
+
+#if (!MS_WINDOWS)
+#include <dirent.h>
+
+static s7_pointer g_directory_to_list(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer name;
+ DIR *dpos;
+ s7_pointer result;
+
+ #define H_directory_to_list "(directory->list directory) returns the contents of the directory as a list of strings (filenames)."
+ #define Q_directory_to_list s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_string_symbol)
+
+ name = car(args);
+ if (!is_string(name))
+ method_or_bust_one_arg(sc, name, sc->directory_to_list_symbol, list_1(sc, name), T_STRING);
+
+ sc->w = sc->nil;
+ if ((dpos = opendir(string_value(name))))
+ {
+ struct dirent *dirp;
+ while ((dirp = readdir(dpos)))
+ sc->w = cons(sc, s7_make_string(sc, dirp->d_name), sc->w);
+ closedir(dpos);
+ }
+
+ result = sc->w;
+ sc->w = sc->nil;
+ return(result);
+}
+
+static s7_pointer g_file_mtime(s7_scheme *sc, s7_pointer args)
+{
+ #define H_file_mtime "(file-mtime file): return the write date of file"
+ #define Q_file_mtime s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_string_symbol)
+
+ struct stat statbuf;
+ int err;
+ s7_pointer name;
+
+ name = car(args);
+ if (!is_string(name))
+ method_or_bust_one_arg(sc, name, sc->file_mtime_symbol, args, T_STRING);
+
+ err = stat(string_value(name), &statbuf);
+ if (err < 0)
+ return(file_error(sc, "file-mtime", strerror(errno), string_value(name)));
+
+ return(s7_make_integer(sc, (s7_int)(statbuf.st_mtime)));
+}
+#endif
+#endif
+
+
+
+/* -------------------------------- lists -------------------------------- */
+
+s7_pointer s7_cons(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+ s7_pointer x;
+ new_cell(sc, x, T_PAIR | T_SAFE_PROCEDURE);
+ set_car(x, a);
+ set_cdr(x, b);
+ return(x);
+}
+
+
+static s7_pointer cons_unchecked(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+ /* apparently slightly faster as a function? */
+ s7_pointer x;
+ new_cell_no_check(sc, x, T_PAIR | T_SAFE_PROCEDURE);
+ set_car(x, a);
+ set_cdr(x, b);
+ return(x);
+}
+
+
+static s7_pointer permanent_cons(s7_pointer a, s7_pointer b, unsigned int type)
+{
+ /* for the symbol table which is never GC'd (and its contents aren't marked) */
+ s7_pointer x;
+ x = alloc_pointer();
+ set_type(x, type);
+ unheap(x);
+ set_car(x, a);
+ set_cdr(x, b);
+ return(x);
+}
+
+static s7_pointer permanent_list(s7_scheme *sc, int len)
+{
+ int j;
+ s7_pointer p;
+ p = sc->nil;
+ for (j = 0; j < len; j++)
+ p = permanent_cons(sc->nil, p, T_PAIR | T_IMMUTABLE);
+ return(p);
+}
+
+
+static void check_sig_entry(s7_scheme *sc, s7_pointer p, s7_pointer res, bool circle)
+{
+ if ((!is_symbol(car(p))) &&
+ (!s7_is_boolean(car(p))) &&
+ (!is_pair(car(p))))
+ {
+ s7_pointer np;
+ int i;
+ for (np = res, i = 0; np != p; np = cdr(np), i++);
+ fprintf(stderr, "s7_make_%ssignature got an invalid entry at position %d: (", (circle) ? "circular_" : "", i);
+ for (np = res; np != p; np = cdr(np))
+ fprintf(stderr, "%s ", DISPLAY(car(np)));
+ fprintf(stderr, "...");
+ set_car(p, sc->nil);
+ }
+}
+
+s7_pointer s7_make_signature(s7_scheme *sc, int len, ...)
+{
+ va_list ap;
+ s7_pointer p, res;
+
+ res = permanent_list(sc, len);
+ va_start(ap, len);
+ for (p = res; is_pair(p); p = cdr(p))
+ {
+ set_car(p, va_arg(ap, s7_pointer));
+ check_sig_entry(sc, p, res, false);
+ }
+ va_end(ap);
+
+ return((s7_pointer)res);
+}
+
+s7_pointer s7_make_circular_signature(s7_scheme *sc, int cycle_point, int len, ...)
+{
+ va_list ap;
+ int i;
+ s7_pointer p, res, back = NULL, end = NULL;
+
+ res = permanent_list(sc, len);
+ va_start(ap, len);
+ for (p = res, i = 0; is_pair(p); p = cdr(p), i++)
+ {
+ set_car(p, va_arg(ap, s7_pointer));
+ check_sig_entry(sc, p, res, true);
+ if (i == cycle_point) back = p;
+ if (i == (len - 1)) end = p;
+ }
+ va_end(ap);
+ if (end) set_cdr(end, back);
+ if (i < len)
+ fprintf(stderr, "s7_make_circular_signature got too few entries: %s\n", DISPLAY(res));
+ return((s7_pointer)res);
+}
+
+
+bool s7_is_pair(s7_pointer p) {return(is_pair(p));}
+static s7_pointer is_pair_p_p(s7_pointer p) {return((is_pair(p)) ? cur_sc->T : cur_sc->F);}
+
+
+s7_pointer s7_car(s7_pointer p) {return(car(p));}
+s7_pointer s7_cdr(s7_pointer p) {return(cdr(p));}
+
+s7_pointer s7_cadr(s7_pointer p) {return(cadr(p));}
+s7_pointer s7_cddr(s7_pointer p) {return(cddr(p));}
+s7_pointer s7_cdar(s7_pointer p) {return(cdar(p));}
+s7_pointer s7_caar(s7_pointer p) {return(caar(p));}
+
+s7_pointer s7_caadr(s7_pointer p) {return(caadr(p));}
+s7_pointer s7_caddr(s7_pointer p) {return(caddr(p));}
+s7_pointer s7_cadar(s7_pointer p) {return(cadar(p));}
+s7_pointer s7_caaar(s7_pointer p) {return(caaar(p));}
+s7_pointer s7_cdadr(s7_pointer p) {return(cdadr(p));}
+s7_pointer s7_cdddr(s7_pointer p) {return(cdddr(p));}
+s7_pointer s7_cddar(s7_pointer p) {return(cddar(p));}
+s7_pointer s7_cdaar(s7_pointer p) {return(cdaar(p));}
+
+s7_pointer s7_caaadr(s7_pointer p) {return(caaadr(p));}
+s7_pointer s7_caaddr(s7_pointer p) {return(caaddr(p));}
+s7_pointer s7_caadar(s7_pointer p) {return(caadar(p));}
+s7_pointer s7_caaaar(s7_pointer p) {return(caaaar(p));}
+s7_pointer s7_cadadr(s7_pointer p) {return(cadadr(p));}
+s7_pointer s7_cadddr(s7_pointer p) {return(cadddr(p));}
+s7_pointer s7_caddar(s7_pointer p) {return(caddar(p));}
+s7_pointer s7_cadaar(s7_pointer p) {return(cadaar(p));}
+
+s7_pointer s7_cdaadr(s7_pointer p) {return(cdaadr(p));}
+s7_pointer s7_cdaddr(s7_pointer p) {return(cdaddr(p));}
+s7_pointer s7_cdadar(s7_pointer p) {return(cdadar(p));}
+s7_pointer s7_cdaaar(s7_pointer p) {return(cdaaar(p));}
+s7_pointer s7_cddadr(s7_pointer p) {return(cddadr(p));}
+s7_pointer s7_cddddr(s7_pointer p) {return(cddddr(p));}
+s7_pointer s7_cdddar(s7_pointer p) {return(cdddar(p));}
+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);
+}
+
+
+s7_pointer s7_set_cdr(s7_pointer p, s7_pointer q)
+{
+ set_cdr(p, q);
+ return(p);
+}
+
+/* -------------------------------------------------------------------------------- */
+
+s7_pointer s7_apply_1(s7_scheme *sc, s7_pointer args, s7_pointer (*f1)(s7_pointer a1))
+{
+ /* not currently used */
+ return(f1(car(args)));
+}
+
+s7_pointer s7_apply_2(s7_scheme *sc, s7_pointer args, s7_pointer (*f2)(s7_pointer a1, s7_pointer a2))
+{
+ return(f2(car(args), cadr(args)));
+}
+
+s7_pointer s7_apply_3(s7_scheme *sc, s7_pointer args, s7_pointer (*f3)(s7_pointer a1, s7_pointer a2, s7_pointer a3))
+{
+ s7_pointer a1;
+ a1 = car(args); args = cdr(args);
+ return(f3(a1, car(args), cadr(args)));
+}
+
+s7_pointer s7_apply_4(s7_scheme *sc, s7_pointer args, s7_pointer (*f4)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4))
+{
+ s7_pointer a1, a2;
+ a1 = car(args); a2 = cadr(args); args = cddr(args);
+ return(f4(a1, a2, car(args), cadr(args)));
+}
+
+s7_pointer s7_apply_5(s7_scheme *sc, s7_pointer args, s7_pointer (*f5)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5))
+{
+ s7_pointer a1, a2, a3, a4;
+ a1 = car(args); a2 = cadr(args); args = cddr(args);
+ a3 = car(args); a4 = cadr(args); args = cddr(args);
+ return(f5(a1, a2, a3, a4, car(args)));
+}
+
+s7_pointer s7_apply_6(s7_scheme *sc, s7_pointer args, s7_pointer (*f6)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5, s7_pointer a6))
+{
+ s7_pointer a1, a2, a3, a4;
+ a1 = car(args); a2 = cadr(args); args = cddr(args);
+ a3 = car(args); a4 = cadr(args); args = cddr(args);
+ return(f6(a1, a2, a3, a4, car(args), cadr(args)));
+}
+
+s7_pointer s7_apply_7(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f7)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5, s7_pointer a6, s7_pointer a7))
+{
+ s7_pointer a1, a2, a3, a4, a5, a6;
+ a1 = car(args); a2 = cadr(args); args = cddr(args);
+ a3 = car(args); a4 = cadr(args); args = cddr(args);
+ a5 = car(args); a6 = cadr(args); args = cddr(args);
+ return(f7(a1, a2, a3, a4, a5, a6, car(args)));
+}
+
+s7_pointer s7_apply_8(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f8)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8))
+{
+ s7_pointer a1, a2, a3, a4, a5, a6;
+ a1 = car(args); a2 = cadr(args); args = cddr(args);
+ a3 = car(args); a4 = cadr(args); args = cddr(args);
+ a5 = car(args); a6 = cadr(args); args = cddr(args);
+ return(f8(a1, a2, a3, a4, a5, a6, car(args), cadr(args)));
+}
+
+s7_pointer s7_apply_9(s7_scheme *sc, s7_pointer args, s7_pointer (*f9)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
+ s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8, s7_pointer a9))
+{
+ s7_pointer a1, a2, a3, a4, a5, a6;
+ a1 = car(args); a2 = cadr(args); args = cddr(args);
+ a3 = car(args); a4 = cadr(args); args = cddr(args);
+ a5 = car(args); a6 = cadr(args); args = cddr(args);
+ return(f9(a1, a2, a3, a4, a5, a6, car(args), cadr(args), caddr(args)));
+}
+
+s7_pointer s7_apply_n_1(s7_scheme *sc, s7_pointer args, s7_pointer (*f1)(s7_pointer a1))
+{
+ if (is_pair(args))
+ return(f1(car(args)));
+ return(f1(sc->undefined));
+}
+
+s7_pointer s7_apply_n_2(s7_scheme *sc, s7_pointer args, s7_pointer (*f2)(s7_pointer a1, s7_pointer a2))
+{
+ if (is_pair(args))
+ {
+ if (is_pair(cdr(args)))
+ return(f2(car(args), cadr(args)));
+ return(f2(car(args), sc->undefined));
+ }
+ return(f2(sc->undefined, sc->undefined));
+}
+
+s7_pointer s7_apply_n_3(s7_scheme *sc, s7_pointer args, s7_pointer (*f3)(s7_pointer a1, s7_pointer a2, s7_pointer a3))
+{
+ if (is_pair(args))
+ {
+ s7_pointer a1;
+ a1 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ s7_pointer a2;
+ a2 = car(args);
+ if (is_pair(cdr(args)))
+ return(f3(a1, a2, cadr(args)));
+ return(f3(a1, a2, sc->undefined));
+ }
+ return(f3(a1, sc->undefined, sc->undefined));
+ }
+ return(f3(sc->undefined, sc->undefined, sc->undefined));
+}
+
+s7_pointer s7_apply_n_4(s7_scheme *sc, s7_pointer args, s7_pointer (*f4)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4))
+{
+ if (is_pair(args))
+ {
+ s7_pointer a1;
+ a1 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ s7_pointer a2;
+ a2 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ s7_pointer a3;
+ a3 = car(args);
+ if (is_pair(cdr(args)))
+ return(f4(a1, a2, a3, cadr(args)));
+ return(f4(a1, a2, a3, sc->undefined));
+ }
+ return(f4(a1, a2, sc->undefined, sc->undefined));
+ }
+ return(f4(a1, sc->undefined, sc->undefined, sc->undefined));
+ }
+ return(f4(sc->undefined, sc->undefined, sc->undefined, sc->undefined));
+}
+
+s7_pointer s7_apply_n_5(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f5)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5))
+{
+ if (is_pair(args))
+ {
+ s7_pointer a1;
+ a1 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ s7_pointer a2;
+ a2 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ s7_pointer a3;
+ a3 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ s7_pointer a4;
+ a4 = car(args);
+ if (is_pair(cdr(args)))
+ return(f5(a1, a2, a3, a4, cadr(args)));
+ return(f5(a1, a2, a3, a4, sc->undefined));
+ }
+ return(f5(a1, a2, a3, sc->undefined, sc->undefined));
+ }
+ return(f5(a1, a2, sc->undefined, sc->undefined, sc->undefined));
+ }
+ return(f5(a1, sc->undefined, sc->undefined, sc->undefined, sc->undefined));
+ }
+ return(f5(sc->undefined, sc->undefined, sc->undefined, sc->undefined, sc->undefined));
+}
+
+s7_pointer s7_apply_n_6(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f6)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5, s7_pointer a6))
+{
+ s7_pointer a1, a2, a3, a4, a5, a6;
+ a1 = sc->undefined; a2 = sc->undefined; a3 = sc->undefined; a4 = sc->undefined; a5 = sc->undefined; a6 = sc->undefined;
+ if (is_pair(args))
+ {
+ a1 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a2 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a3 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a4 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a5 = car(args);
+ if (is_pair(cdr(args))) a6 = cadr(args);
+ }}}}}
+ return(f6(a1, a2, a3, a4, a5, a6));
+}
+
+s7_pointer s7_apply_n_7(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f7)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
+ s7_pointer a5, s7_pointer a6, s7_pointer a7))
+{
+ s7_pointer a1, a2, a3, a4, a5, a6, a7;
+ a1 = sc->undefined; a2 = sc->undefined; a3 = sc->undefined; a4 = sc->undefined; a5 = sc->undefined;
+ a6 = sc->undefined, a7 = sc->undefined;
+ if (is_pair(args))
+ {
+ a1 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a2 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a3 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a4 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a5 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a6 = car(args);
+ if (is_pair(cdr(args))) a7 = cadr(args);
+ }}}}}}
+ return(f7(a1, a2, a3, a4, a5, a6, a7));
+}
+
+s7_pointer s7_apply_n_8(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f8)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
+ s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8))
+{
+ s7_pointer a1, a2, a3, a4, a5, a6, a7, a8;
+ a1 = sc->undefined; a2 = sc->undefined; a3 = sc->undefined; a4 = sc->undefined; a5 = sc->undefined;
+ a6 = sc->undefined, a7 = sc->undefined; a8 = sc->undefined;
+ if (is_pair(args))
+ {
+ a1 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a2 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a3 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a4 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a5 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a6 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a7 = car(args);
+ if (is_pair(cdr(args))) a8 = cadr(args);
+ }}}}}}}
+ return(f8(a1, a2, a3, a4, a5, a6, a7, a8));
+}
+
+s7_pointer s7_apply_n_9(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f9)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
+ s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8,
+ s7_pointer a9))
+{
+ s7_pointer a1, a2, a3, a4, a5, a6, a7, a8, a9;
+ a1 = sc->undefined; a2 = sc->undefined; a3 = sc->undefined; a4 = sc->undefined; a5 = sc->undefined;
+ a6 = sc->undefined, a7 = sc->undefined; a8 = sc->undefined; a9 = sc->undefined;
+ if (is_pair(args))
+ {
+ a1 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a2 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a3 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a4 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a5 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a6 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a7 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a8 = car(args);
+ if (is_pair(cdr(args))) a9 = cadr(args);
+ }}}}}}}}
+ return(f9(a1, a2, a3, a4, a5, a6, a7, a8, a9));
+}
+
+/* -------------------------------------------------------------------------------- */
+
+
+
+s7_pointer s7_list_ref(s7_scheme *sc, s7_pointer lst, int num)
+{
+ int i;
+ s7_pointer x;
+ for (x = lst, i = 0; (i < num) && (is_pair(x)); i++, x = cdr(x)) {}
+ if ((i == num) && (is_pair(x)))
+ return(car(x));
+ return(sc->nil);
+}
+
+
+s7_pointer s7_list_set(s7_scheme *sc, s7_pointer lst, int num, s7_pointer val)
+{
+ int i;
+ s7_pointer x;
+ for (x = lst, i = 0; (i < num) && (is_pair(x)); i++, x = cdr(x)) {}
+ if ((i == num) &&
+ (is_pair(x)))
+ set_car(x, _NFre(val));
+ return(val);
+}
+
+
+s7_pointer s7_member(s7_scheme *sc, s7_pointer sym, s7_pointer lst)
+{
+ s7_pointer x;
+ for (x = lst; is_pair(x); x = cdr(x))
+ if (s7_is_equal(sc, sym, car(x)))
+ return(x);
+ return(sc->F);
+}
+
+
+static bool symbol_is_in_arg_list(s7_pointer sym, s7_pointer lst)
+{
+ s7_pointer x;
+ for (x = lst; is_pair(x); x = cdr(x))
+ if ((sym == car(x)) ||
+ ((is_pair(car(x))) &&
+ (sym == caar(x))))
+ return(true);
+ 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++;
+ return(sum);
+}
+
+static s7_int tree_len(s7_scheme *sc, s7_pointer p)
+{
+ if (is_null(p))
+ return(0);
+ return(tree_len_1(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)
+{
+ return(s7_make_integer(sc, tree_len(sc, car(args))));
+}
+
+
+bool s7_tree_memq(s7_scheme *sc, s7_pointer sym, s7_pointer tree)
+{
+ if (sym == tree) return(true);
+ if (!is_pair(tree)) return(false);
+ if (car(tree) == sc->quote_symbol)
+ {
+ if ((is_symbol(sym)) || (is_pair(sym)))
+ return(false);
+ return(sym == cadr(tree));
+ }
+ do {
+ if ((sym == cdr(tree)) ||
+ (s7_tree_memq(sc, sym, car(tree))))
+ return(true);
+ tree = cdr(tree);
+ } while (is_pair(tree));
+ return((!is_null(tree)) &&
+ (sym == tree));
+}
+
+static s7_pointer g_tree_memq(s7_scheme *sc, s7_pointer args)
+{
+ return(make_boolean(sc, s7_tree_memq(sc, car(args), cadr(args))));
+}
+
+static bool tree_memq_b_pp(s7_pointer sym, s7_pointer tree) {return(s7_tree_memq(cur_sc, sym, tree));}
+
+
+static bool tree_set_memq(s7_scheme *sc, s7_pointer tree)
+{
+ if (is_symbol(tree))
+ return(symbol_is_in_list(sc, tree));
+ if ((!is_pair(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)));
+}
+
+static s7_pointer g_tree_set_memq(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer syms, p, tree;
+ syms = car(args);
+ if (!is_pair(syms)) return(sc->F);
+ tree = cadr(args);
+ clear_symbol_list(sc);
+ for (p = syms; is_pair(p); p = cdr(p))
+ if (is_symbol(car(p)))
+ add_symbol_to_list(sc, car(p));
+ return(make_boolean(sc, tree_set_memq(sc, tree)));
+}
+
+static bool tree_set_memq_b_pp(s7_pointer syms, s7_pointer tree) {return(g_tree_set_memq(cur_sc, set_plist_2(cur_sc, syms, tree)) != cur_sc->F);}
+
+static s7_int tree_count(s7_scheme *sc, s7_pointer x, s7_pointer p, s7_int count)
+{
+ if (p == x)
+ return(count + 1);
+ if ((!is_pair(p)) || (car(p) == sc->quote_symbol))
+ return(count);
+ return(tree_count(sc, x, cdr(p), tree_count(sc, x, car(p), count)));
+}
+
+static s7_int tree_count_at_least(s7_scheme *sc, s7_pointer x, s7_pointer p, s7_int count, s7_int top)
+{
+ if (p == x)
+ return(count + 1);
+ if ((!is_pair(p)) || (car(p) == sc->quote_symbol) || (count >= top))
+ return(count);
+ return(tree_count_at_least(sc, x, cdr(p), tree_count_at_least(sc, x, car(p), count, top), top));
+}
+
+static s7_pointer g_tree_count(s7_scheme *sc, s7_pointer args)
+{
+ if (is_null(cddr(args)))
+ return(s7_make_integer(sc, tree_count(sc, car(args), cadr(args), 0)));
+ return(s7_make_integer(sc, tree_count_at_least(sc, car(args), cadr(args), 0, s7_integer(caddr(args)))));
+}
+
+
+static s7_pointer print_truncate(s7_scheme *sc, s7_pointer code)
+{
+ if (tree_len(sc, code) > sc->print_length)
+ {
+ char *str;
+ str = object_to_truncated_string(sc, code, sc->print_length * 10);
+ return(make_string_uncopied_with_length(sc, str, safe_strlen(str)));
+ }
+ return(code);
+}
+
+
+s7_pointer s7_assoc(s7_scheme *sc, s7_pointer sym, s7_pointer lst)
+{
+ s7_pointer x, y;
+
+ if (!is_pair(lst))
+ return(sc->F);
+
+ x = lst;
+ y = lst;
+ while (true)
+ {
+ if ((is_pair(car(x))) && (s7_is_equal(sc, sym, caar(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if ((is_pair(car(x))) && (s7_is_equal(sc, sym, caar(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F);
+}
+
+
+s7_pointer s7_reverse(s7_scheme *sc, s7_pointer a)
+{
+ /* reverse list -- produce new list (other code assumes this function does not return the original!) */
+ s7_pointer x, p;
+
+ if (is_null(a)) return(a);
+
+ if (!is_pair(cdr(a)))
+ {
+ if (is_not_null(cdr(a)))
+ return(cons(sc, cdr(a), car(a)));
+ return(cons(sc, car(a), sc->nil)); /* don't return 'a' itself */
+ }
+
+ sc->w = list_1(sc, car(a));
+ for (x = cdr(a), p = a; is_pair(x); x = cdr(x), p = cdr(p))
+ {
+ sc->w = cons(sc, car(x), sc->w);
+ if (is_pair(cdr(x)))
+ {
+ x = cdr(x);
+ sc->w = cons(sc, car(x), sc->w);
+ }
+ if (x == p) /* this can take awhile to notice there's a cycle, but what does the caller expect? */
+ break;
+ }
+
+ if (is_not_null(x))
+ p = cons(sc, x, sc->w); /* ?? this means that (reverse '(1 2 . 3)) returns '(3 2 1) -- we used to return () here */
+ else p = sc->w;
+
+ sc->w = sc->nil;
+ return(p);
+}
+
+/* s7_reverse sometimes tacks extra nodes on the end of a reversed circular list (it detects the cycle too late)
+ * (let ((lst (list 0))) (set! (cdr lst) lst) (reverse lst)) -> (#1=(0 . #1#) 0 0 0)
+ */
+
+
+static s7_pointer reverse_in_place(s7_scheme *sc, s7_pointer term, s7_pointer list)
+{
+ s7_pointer p = list, result = term, q;
+
+ while (is_not_null(p))
+ {
+ q = cdr(p);
+ if ((!is_pair(q)) &&
+ (is_not_null(q)))
+ return(sc->nil); /* improper list? */
+ set_cdr(p, result);
+ result = p;
+ p = q;
+ }
+ return(result);
+}
+
+
+static s7_pointer reverse_in_place_unchecked(s7_scheme *sc, s7_pointer term, s7_pointer list)
+{
+ s7_pointer p = list, result = term, q;
+
+ while (is_not_null(p))
+ {
+ q = cdr(p);
+ set_cdr(p, result);
+ result = p;
+ p = q;
+
+ if (is_null(p)) break;
+ q = cdr(p);
+ set_cdr(p, result);
+ result = p;
+ p = q;
+ }
+ return(result);
+}
+
+
+static s7_pointer safe_reverse_in_place(s7_scheme *sc, s7_pointer list) /* "safe" here means we guarantee this list is unproblematic */
+{
+ s7_pointer p = list, result, q;
+ result = sc->nil;
+
+ while (is_not_null(p))
+ {
+ q = cdr(p);
+ /* also if (is_null(list)) || (is_null(cdr(list))) return(list) */
+ set_cdr(p, result);
+ result = p;
+ p = q;
+
+ /* unroll the loop for speed */
+ if (is_null(p)) break;
+ q = cdr(p);
+ set_cdr(p, result);
+ result = p;
+ p = q;
+
+ if (is_null(p)) break;
+ q = cdr(p);
+ set_cdr(p, result);
+ result = p;
+ p = q;
+
+ if (is_null(p)) break;
+ q = cdr(p);
+ set_cdr(p, result);
+ result = p;
+ p = q;
+ }
+ return(result);
+}
+
+
+/* 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;
+ if (is_null(a)) return(b);
+
+ tp = cons(sc, car(a), sc->nil);
+ sc->y = tp;
+ for (p = cdr(a), np = tp; is_pair(p); p = cdr(p), np = cdr(np))
+ set_cdr(np, cons(sc, car(p), sc->nil));
+ set_cdr(np, b);
+ sc->y = sc->nil;
+
+ return(tp);
+}
+
+
+static s7_pointer copy_list(s7_scheme *sc, s7_pointer lst)
+{
+ s7_pointer p, tp, np;
+ if (!is_pair(lst)) return(sc->nil);
+ tp = cons(sc, car(lst), sc->nil);
+ sc->y = tp;
+ for (p = cdr(lst), np = tp; is_pair(p); p = cdr(p), np = cdr(np))
+ set_cdr(np, cons(sc, car(p), sc->nil));
+ sc->y = sc->nil;
+ return(tp);
+}
+
+
+static s7_pointer copy_list_with_arglist_error(s7_scheme *sc, s7_pointer lst)
+{
+ s7_pointer p, tp, np;
+ if (is_null(lst)) return(sc->nil);
+ if (!is_pair(lst))
+ s7_error(sc, sc->syntax_error_symbol, set_elist_2(sc, make_string_wrapper(sc, "stray dot?: ~S"), lst));
+ tp = cons(sc, car(lst), sc->nil);
+ sc->y = tp;
+ for (p = cdr(lst), np = tp; is_pair(p); p = cdr(p), np = cdr(np))
+ set_cdr(np, cons(sc, car(p), sc->nil));
+ sc->y = sc->nil;
+ if (!is_null(p))
+ s7_error(sc, sc->syntax_error_symbol, set_elist_2(sc, make_string_wrapper(sc, "improper list of arguments: ~S"), lst));
+ return(tp);
+}
+
+
+static s7_pointer revappend(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+ /* (map (lambda (x) (if (odd? x) (apply values '(1 2 3)) (values))) (list 1 2 3 4))
+ * is a bad case -- we have to copy the incoming list.
+ */
+ s7_pointer p = b, q;
+
+ if (is_not_null(a))
+ {
+ a = copy_list(sc, a);
+ while (is_not_null(a))
+ {
+ q = cdr(a);
+ set_cdr(a, p);
+ p = a;
+ a = q;
+ }
+ }
+ return(p);
+}
+
+static int safe_list_length(s7_scheme *sc, s7_pointer a)
+{
+ /* assume that "a" is a proper list */
+ int i = 0;
+ s7_pointer b;
+ for (b = a; is_pair(b); i++, b = cdr(b)) {};
+ return(i);
+}
+
+
+int s7_list_length(s7_scheme *sc, s7_pointer a)
+{
+ /* returns -len if list is dotted, 0 if it's (directly) circular */
+ int i;
+ s7_pointer slow, fast;
+
+ slow = fast = a;
+ for (i = 0; ; i += 2)
+ {
+ if (!is_pair(fast))
+ {
+ if (is_null(fast))
+ return(i);
+ return(-i);
+ }
+
+ fast = cdr(fast);
+ if (!is_pair(fast))
+ {
+ if (is_null(fast))
+ return(i + 1);
+ return(-i - 1);
+ }
+ /* if unrolled further, it's a lot slower? */
+
+ fast = cdr(fast);
+ slow = cdr(slow);
+ if (fast == slow)
+ return(0);
+ }
+ return(0);
+}
+
+
+/* -------------------------------- null? pair? -------------------------------- */
+static s7_pointer g_is_null(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_null "(null? obj) returns #t if obj is the empty list"
+ #define Q_is_null pl_bt
+ check_boolean_method(sc, is_null, sc->is_null_symbol, args);
+ /* as a generic this could be: has_structure and length == 0 */
+}
+
+static s7_pointer g_is_pair(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_pair "(pair? obj) returns #t if obj is a pair (a non-empty list)"
+ #define Q_is_pair pl_bt
+ check_boolean_method(sc, is_pair, sc->is_pair_symbol, args);
+}
+
+
+/* -------------------------------- list? proper-list? -------------------------------- */
+bool s7_is_list(s7_scheme *sc, s7_pointer p)
+{
+ return((is_pair(p)) ||
+ (is_null(p)));
+}
+
+static bool is_list_b(s7_pointer p) {return((is_pair(p)) || (type(p) == T_NIL));}
+
+
+static bool is_proper_list(s7_scheme *sc, s7_pointer lst)
+{
+ /* #t if () or undotted/non-circular pair */
+ s7_pointer slow, fast;
+
+ fast = lst;
+ slow = lst;
+ while (true)
+ {
+ if (!is_pair(fast))
+ return(is_null(fast)); /* else it's an improper list */
+
+ fast = cdr(fast);
+ if (!is_pair(fast)) return(is_null(fast));
+
+ fast = cdr(fast);
+ if (!is_pair(fast)) return(is_null(fast));
+
+ fast = cdr(fast);
+ slow = cdr(slow);
+ if (fast == slow) return(false);
+ }
+ return(true);
+}
+
+
+static s7_pointer g_is_list(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_list "(list? obj) returns #t if obj is a pair or null"
+ #define Q_is_list pl_bt
+ #define is_a_list(p) s7_is_list(sc, p)
+ check_boolean_method(sc, is_a_list, sc->is_list_symbol, args);
+}
+
+
+/* -------------------------------- make-list -------------------------------- */
+static s7_pointer make_list(s7_scheme *sc, int len, s7_pointer init)
+{
+ switch (len)
+ {
+ case 0: return(sc->nil);
+ case 1: return(cons(sc, init, sc->nil));
+ case 2: return(cons_unchecked(sc, init, cons(sc, init, sc->nil)));
+ case 3: return(cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->nil))));
+ case 4: return(cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->nil)))));
+ case 5: return(cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init,
+ cons_unchecked(sc, init, cons(sc, init, sc->nil))))));
+ case 6: return(cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init,
+ cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->nil)))))));
+ case 7: return(cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init,
+ cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->nil))))))));
+ default:
+ {
+ s7_pointer result;
+ int i;
+
+ if (len >= (sc->free_heap_top - sc->free_heap))
+ {
+ gc(sc);
+ while (len >= (sc->free_heap_top - sc->free_heap))
+ resize_heap(sc);
+ }
+
+ sc->v = sc->nil;
+ for (i = 0; i < len; i++)
+ sc->v = cons_unchecked(sc, init, sc->v);
+ result = sc->v;
+ sc->v = sc->nil;
+ return(result);
+ }
+ }
+ return(sc->nil); /* never happens, I hope */
+}
+
+
+static s7_pointer g_make_list(s7_scheme *sc, s7_pointer args)
+{
+ #define H_make_list "(make-list length (initial-element #f)) returns a list of 'length' elements whose value is 'initial-element'."
+ #define Q_make_list s7_make_signature(sc, 3, sc->is_proper_list_symbol, sc->is_integer_symbol, sc->T)
+
+ s7_pointer init;
+ s7_int len;
+
+ if (!s7_is_integer(car(args)))
+ method_or_bust(sc, car(args), sc->make_list_symbol, args, T_INTEGER, 1);
+
+ len = s7_integer(car(args)); /* needs to be s7_int here so that (make-list most-negative-fixnum) is handled correctly */
+ if (len < 0)
+ return(out_of_range(sc, sc->make_list_symbol, small_int(1), car(args), its_negative_string));
+ if (len == 0) return(sc->nil); /* what about (make-list 0 123)? */
+ if (len > sc->max_list_length)
+ return(out_of_range(sc, sc->make_list_symbol, small_int(1), car(args), its_too_large_string));
+
+ if (is_pair(cdr(args)))
+ init = cadr(args);
+ else init = sc->F;
+ return(make_list(sc, (int)len, init));
+}
+
+
+/* -------------------------------- list-ref -------------------------------- */
+
+static s7_pointer list_ref_1(s7_scheme *sc, s7_pointer lst, s7_pointer ind)
+{
+ s7_int i, index;
+ s7_pointer p;
+
+ if (!s7_is_integer(ind))
+ {
+ if (!s7_is_integer(p = check_values(sc, ind, cons(sc, ind, sc->nil))))
+ method_or_bust(sc, ind, sc->list_ref_symbol, list_2(sc, lst, ind), T_INTEGER, 2);
+ ind = p;
+ }
+ index = s7_integer(ind);
+ if ((index < 0) || (index > sc->max_list_length))
+ return(out_of_range(sc, sc->list_ref_symbol, small_int(2), ind, (index < 0) ? its_negative_string : its_too_large_string));
+
+ for (i = 0, p = lst; (i < index) && is_pair(p); i++, p = cdr(p)) {}
+
+ if (!is_pair(p))
+ {
+ if (is_null(p))
+ return(out_of_range(sc, sc->list_ref_symbol, small_int(2), ind, its_too_large_string));
+ return(wrong_type_argument_with_type(sc, sc->list_ref_symbol, 1, lst, a_proper_list_string));
+ }
+ return(car(p));
+}
+
+
+static s7_pointer g_list_ref(s7_scheme *sc, s7_pointer args)
+{
+ #define H_list_ref "(list-ref lst i ...) returns the i-th element (0-based) of the list"
+ #define Q_list_ref s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_pair_symbol, sc->is_integer_symbol)
+
+ /* (let ((L '((1 2 3) (4 5 6)))) (list-ref L 1 2))
+
+ (define (lref L . args)
+ (if (null? (cdr args))
+ (list-ref L (car args))
+ (apply lref (list-ref L (car args)) (cdr args))))
+ */
+ s7_pointer lst, inds;
+
+ lst = car(args);
+ if (!is_pair(lst))
+ method_or_bust(sc, lst, sc->list_ref_symbol, args, T_PAIR, 1);
+
+ inds = cdr(args);
+ while (true)
+ {
+ lst = list_ref_1(sc, lst, car(inds));
+ if (is_null(cdr(inds)))
+ return(lst);
+ inds = cdr(inds);
+ if (!is_pair(lst)) /* trying to avoid a cons here at the cost of one extra type check */
+ return(implicit_index(sc, lst, inds));
}
}
-static void write_macro_readably(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+
+/* -------------------------------- list-set! -------------------------------- */
+static s7_pointer g_list_set_1(s7_scheme *sc, s7_pointer lst, s7_pointer args, int arg_num)
{
- s7_pointer arglist, body, expr;
+ #define H_list_set "(list-set! lst i ... val) sets the i-th element (0-based) of the list to val"
+ #define Q_list_set s7_make_circular_signature(sc, 3, 4, sc->T, sc->is_pair_symbol, sc->is_integer_symbol, sc->is_integer_or_any_at_end_symbol)
- body = closure_body(obj);
- arglist = closure_args(obj);
+ int i;
+ s7_int index;
+ s7_pointer p, ind;
- port_write_string(port)(sc, "(define-", 8, port);
- port_write_string(port)(sc, ((is_macro(obj)) || (is_macro_star(obj))) ? "macro" : "bacro", 5, port);
- if ((is_macro_star(obj)) || (is_bacro_star(obj)))
- port_write_character(port)(sc, '*', port);
- port_write_string(port)(sc, " (_m_", 5, port);
- if (is_symbol(arglist))
+ /* (let ((L '((1 2 3) (4 5 6)))) (list-set! L 1 2 32) L) */
+
+ if (!is_pair(lst))
+ method_or_bust(sc, lst, sc->list_set_symbol, cons(sc, lst, args), T_PAIR, 1);
+
+ ind = car(args);
+ if (!s7_is_integer(ind))
{
- port_write_string(port)(sc, " . ", 3, port);
- port_write_string(port)(sc, symbol_name(arglist), symbol_name_length(arglist), port);
+ if (!s7_is_integer(p = check_values(sc, ind, args)))
+ method_or_bust(sc, ind, sc->list_set_symbol, cons(sc, lst, args), T_INTEGER, arg_num);
+ ind = p;
}
- else
+ index = s7_integer(ind);
+ if ((index < 0) || (index > sc->max_list_length))
+ return(out_of_range(sc, sc->list_set_symbol, small_int(arg_num), ind, (index < 0) ? its_negative_string : its_too_large_string));
+
+ for (i = 0, p = _TSet(lst); (i < index) && is_pair(p); i++, p = cdr(p)) {}
+
+ if (!is_pair(p))
{
- if (is_pair(arglist))
- {
- for (expr = arglist; is_pair(expr); expr = cdr(expr))
- {
- port_write_character(port)(sc, ' ', port);
- object_to_port(sc, car(expr), port, USE_WRITE, NULL);
- }
- if (!is_null(expr))
- {
- port_write_string(port)(sc, " . ", 3, port);
- object_to_port(sc, expr, port, USE_WRITE, NULL);
- }
- }
+ if (is_null(p))
+ return(out_of_range(sc, sc->list_set_symbol, small_int(arg_num), ind, its_too_large_string));
+ return(wrong_type_argument_with_type(sc, sc->list_set_symbol, 1, lst, a_proper_list_string));
}
- port_write_string(port)(sc, ") ", 2, port);
- for (expr = body; is_pair(expr); expr = cdr(expr))
- object_to_port(sc, car(expr), port, USE_WRITE, NULL);
- port_write_character(port)(sc, ')', port);
-}
+ if (is_null(cddr(args)))
+ set_car(p, cadr(args));
+ else return(g_list_set_1(sc, car(p), cdr(args), arg_num + 1));
+ return(cadr(args));
+}
-static s7_pointer match_symbol(s7_scheme *sc, s7_pointer symbol, s7_pointer e)
+static s7_pointer g_list_set(s7_scheme *sc, s7_pointer args)
{
- s7_pointer y, le;
- for (le = e; is_let(le) && (le != sc->rootlet); le = outlet(le))
- for (y = let_slots(le); is_slot(y); y = next_slot(y))
- if (slot_symbol(y) == symbol)
- return(y);
- return(NULL);
+ return(g_list_set_1(sc, car(args), cdr(args), 2));
}
-static bool slot_memq(s7_pointer symbol, s7_pointer symbols)
+static s7_pointer list_ref_p_pi_direct(s7_pointer p1, s7_int i1)
{
- s7_pointer x;
- for (x = symbols; is_pair(x); x = cdr(x))
- if (slot_symbol(car(x)) == symbol)
- return(true);
- return(false);
+ s7_pointer p;
+ s7_int i;
+ if ((i1 < 0) || (i1 > cur_sc->max_list_length))
+ out_of_range(cur_sc, cur_sc->list_ref_symbol, small_int(2), make_integer(cur_sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string);
+ for (i = 0, p = p1; ((is_pair(p)) && (i < i1)); i++, p = cdr(p));
+ if (!is_pair(p))
+ {
+ if (type(p) == T_NIL)
+ out_of_range(cur_sc, cur_sc->list_ref_symbol, small_int(2), make_integer(cur_sc, i1), its_too_large_string);
+ else simple_wrong_type_argument_with_type(cur_sc, cur_sc->list_ref_symbol, p1, a_proper_list_string);
+ }
+ return(car(p));
}
-static bool arg_memq(s7_pointer symbol, s7_pointer args)
+static s7_pointer list_ref_p_pi(s7_pointer p1, s7_int i1)
{
- s7_pointer x;
- for (x = args; is_pair(x); x = cdr(x))
- if ((car(x) == symbol) ||
- ((is_pair(car(x))) &&
- (caar(x) == symbol)))
- return(true);
- return(false);
+ if (!is_pair(p1))
+ simple_wrong_type_argument(cur_sc, cur_sc->list_ref_symbol, p1, T_PAIR);
+ return(list_ref_p_pi_direct(p1, i1));
}
-
-static void collect_locals(s7_scheme *sc, s7_pointer body, s7_pointer e, s7_pointer args, unsigned int gc_loc)
+static s7_pointer list_set_p_pip_direct(s7_pointer p1, s7_int i1, s7_pointer p2)
{
- if (is_pair(body))
- {
- collect_locals(sc, car(body), e, args, gc_loc);
- collect_locals(sc, cdr(body), e, args, gc_loc);
- }
- else
+ s7_pointer p;
+ s7_int i;
+ if ((i1 < 0) || (i1 > cur_sc->max_list_length))
+ out_of_range(cur_sc, cur_sc->list_set_symbol, small_int(2), make_integer(cur_sc, i1), (i1 < 0) ? its_negative_string : its_too_large_string);
+ for (i = 0, p = p1; ((is_pair(p)) && (i < i1)); i++, p = cdr(p));
+ if (!is_pair(p))
{
- if ((is_symbol(body)) &&
- (!arg_memq(body, args)) &&
- (!slot_memq(body, gc_protected_at(sc, gc_loc))))
- {
- s7_pointer slot;
- slot = match_symbol(sc, body, e);
- if (slot)
- gc_protected_at(sc, gc_loc) = cons(sc, slot, gc_protected_at(sc, gc_loc));
- }
+ if (type(p) == T_NIL)
+ out_of_range(cur_sc, cur_sc->list_set_symbol, small_int(2), make_integer(cur_sc, i1), its_too_large_string);
+ else simple_wrong_type_argument_with_type(cur_sc, cur_sc->list_set_symbol, p1, a_proper_list_string);
}
+ set_car(p, p2);
+ return(p2);
}
-
-
-static s7_pointer find_closure(s7_scheme *sc, s7_pointer closure, s7_pointer cur_env)
+static s7_pointer list_set_p_pip(s7_pointer p1, s7_int i1, s7_pointer p2)
{
- s7_pointer e, y;
- for (e = cur_env; is_let(e); e = outlet(e))
- {
- if ((is_function_env(e)) &&
- (is_global(funclet_function(e))) && /* (define (f1) (lambda () 1)) shouldn't say the returned closure is named f1 */
- (slot_value(global_slot(funclet_function(e))) == closure))
- return(funclet_function(e));
-
- for (y = let_slots(e); is_slot(y); y = next_slot(y))
- if (slot_value(y) == closure)
- return(slot_symbol(y));
- }
- return(sc->nil);
+ if (!is_pair(p1))
+ simple_wrong_type_argument(cur_sc, cur_sc->list_set_symbol, p1, T_PAIR);
+ return(list_set_p_pip_direct(p1, i1, p2));
}
-static void write_closure_name(s7_scheme *sc, s7_pointer closure, s7_pointer port)
+static s7_pointer list_set_ic;
+static s7_pointer g_list_set_ic(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
- x = find_closure(sc, closure, closure_let(closure));
- /* this can be confusing! In some cases, the function is in its environment, and in other very similar-looking cases it isn't:
- * (let ((a (lambda () 1))) a)
- * #<lambda ()>
- * (letrec ((a (lambda () 1))) a)
- * a
- * (let () (define (a) 1) a)
- * a
- */
- if (is_symbol(x)) /* after find_closure */
+ s7_pointer p, lst, val;
+ s7_int i, index;
+ lst = car(args);
+ if (!is_pair(lst))
+ method_or_bust(sc, lst, sc->list_set_symbol, args, T_PAIR, 1);
+
+ index = s7_integer(cadr(args));
+ if ((index < 0) || (index > sc->max_list_length))
+ return(out_of_range(sc, sc->list_set_symbol, small_int(2), make_integer(sc, index), (index < 0) ? its_negative_string : its_too_large_string));
+
+ for (i = 0, p = lst; (i < index) && is_pair(p); i++, p = cdr(p)) {}
+ if (!is_pair(p))
{
- port_write_string(port)(sc, symbol_name(x), symbol_name_length(x), port);
- return;
+ if (is_null(p))
+ return(out_of_range(sc, sc->list_set_symbol, small_int(2), make_integer(sc, index), its_too_large_string));
+ return(wrong_type_argument_with_type(sc, sc->list_set_symbol, 1, lst, a_proper_list_string));
}
- /* names like #<closure> and #<macro> are useless -- try to be a bit more informative */
- switch (type(closure))
- {
- case T_CLOSURE:
- port_write_string(port)(sc, "#<lambda ", 9, port);
- break;
-
- case T_CLOSURE_STAR:
- port_write_string(port)(sc, "#<lambda* ", 10, port);
- break;
+ val = caddr(args);
+ set_car(p, val);
+ return(val);
+}
+
- case T_MACRO:
- if (is_expansion(closure))
- port_write_string(port)(sc, "#<expansion ", 12, port);
- else port_write_string(port)(sc, "#<macro ", 8, port);
- break;
- case T_MACRO_STAR:
- port_write_string(port)(sc, "#<macro* ", 9, port);
- break;
-
- case T_BACRO:
- port_write_string(port)(sc, "#<bacro ", 8, port);
- break;
+/* -------------------------------- list-tail -------------------------------- */
- case T_BACRO_STAR:
- port_write_string(port)(sc, "#<bacro* ", 9, port);
- break;
- }
+static s7_pointer g_list_tail(s7_scheme *sc, s7_pointer args)
+{
+ #define H_list_tail "(list-tail lst i) returns the list from the i-th element on"
+ #define Q_list_tail s7_make_signature(sc, 3, sc->is_list_symbol, sc->is_pair_symbol, sc->is_integer_symbol)
+ s7_pointer lst, p;
+ s7_int i, index;
- if (is_null(closure_args(closure)))
- port_write_string(port)(sc, "()>", 3, port);
- else
+ lst = car(args);
+ p = cadr(args);
+ if (!s7_is_integer(p))
{
- s7_pointer args;
- args = closure_args(closure);
- if (is_symbol(args))
- {
- port_write_string(port)(sc, symbol_name(args), symbol_name_length(args), port);
- port_write_character(port)(sc, '>', port); /* (lambda a a) -> #<lambda a> */
- }
- else
- {
- port_write_character(port)(sc, '(', port);
- x = car(args);
- if (is_pair(x)) x = car(x);
- port_write_string(port)(sc, symbol_name(x), symbol_name_length(x), port);
- if (!is_null(cdr(args)))
- {
- s7_pointer y;
- port_write_character(port)(sc, ' ', port);
- if (is_pair(cdr(args)))
- {
- y = cadr(args);
- if (is_pair(y))
- y = car(y);
- else
- {
- if (y == sc->key_rest_symbol)
- {
- port_write_string(port)(sc, ":rest ", 6, port);
- args = cdr(args);
- y = cadr(args);
- if (is_pair(y)) y = car(y);
- }
- }
- }
- else
- {
- port_write_string(port)(sc, ". ", 2, port);
- y = cdr(args);
- }
- port_write_string(port)(sc, symbol_name(y), symbol_name_length(y), port);
- if ((is_pair(cdr(args))) &&
- (!is_null(cddr(args))))
- port_write_string(port)(sc, " ...", 4, port);
- }
- port_write_string(port)(sc, ")>", 2, port);
- }
+ s7_pointer p1;
+ if (!s7_is_integer(p1 = check_values(sc, p, cdr(args))))
+ method_or_bust(sc, p, sc->list_tail_symbol, args, T_INTEGER, 2);
+ p = p1;
}
+ index = s7_integer(p);
+
+ if (!s7_is_list(sc, lst))
+ method_or_bust_with_type(sc, lst, sc->list_tail_symbol, list_2(sc, lst, make_integer(sc, index)), a_list_string, 1);
+
+ if ((index < 0) || (index > sc->max_list_length))
+ return(out_of_range(sc, sc->list_tail_symbol, small_int(2), make_integer(sc, index), (index < 0) ? its_negative_string : its_too_large_string));
+
+ for (i = 0, p = lst; (i < index) && (is_pair(p)); i++, p = cdr(p)) {}
+ if (i < index)
+ return(out_of_range(sc, sc->list_tail_symbol, small_int(2), make_integer(sc, index), its_too_large_string));
+ return(p);
}
-static s7_pointer closure_name(s7_scheme *sc, s7_pointer closure)
+
+/* -------------------------------- cons -------------------------------- */
+static s7_pointer g_cons(s7_scheme *sc, s7_pointer args)
{
- /* this is used by the error handlers to get the current function name
- */
- s7_pointer x;
+ /* n-ary cons could be the equivalent of CL's list*? */
+ /* it would be neater to have a single cons cell able to contain (directly) any number of elements */
+ /* (set! (cadr (cons 1 2 3)) 4) -> (1 4 . 3) */
- x = find_closure(sc, closure, sc->envir);
- if (is_symbol(x))
- return(x);
+ #define H_cons "(cons a b) returns a pair containing a and b"
+ #define Q_cons s7_make_signature(sc, 3, sc->is_pair_symbol, sc->T, sc->T)
- if (is_pair(current_code(sc)))
- return(current_code(sc));
+ /* set_cdr(args, cadr(args));
+ * this is not safe -- it changes a variable's value directly:
+ * (let ((lst (list 1 2))) (list (apply cons lst) lst)) -> '((1 . 2) (1 . 2))
+ */
+ s7_pointer x;
+ new_cell(sc, x, T_PAIR | T_SAFE_PROCEDURE);
+ set_car(x, car(args));
+ set_cdr(x, cadr(args));
+ return(x);
+}
- return(closure); /* desperation -- the parameter list (caar here) will cause endless confusion in OP_APPLY errors! */
+static s7_pointer cons_p_pp(s7_pointer p1, s7_pointer p2)
+{
+ s7_pointer x;
+ new_cell(cur_sc, x, T_PAIR | T_SAFE_PROCEDURE);
+ set_car(x, p1);
+ set_cdr(x, p2);
+ return(x);
}
-static void write_closure_readably_1(s7_scheme *sc, s7_pointer obj, s7_pointer arglist, s7_pointer body, s7_pointer port)
+static void init_car_a_list(void)
{
- s7_int old_print_length;
- s7_pointer p;
+ car_a_list_string = s7_make_permanent_string("a list whose car is also a list");
+ cdr_a_list_string = s7_make_permanent_string("a list whose cdr is also a list");
- if (type(obj) == T_CLOSURE_STAR)
- port_write_string(port)(sc, "(lambda* ", 9, port);
- else port_write_string(port)(sc, "(lambda ", 8, port);
+ caar_a_list_string = s7_make_permanent_string("a list whose caar is also a list");
+ cadr_a_list_string = s7_make_permanent_string("a list whose cadr is also a list");
+ cdar_a_list_string = s7_make_permanent_string("a list whose cdar is also a list");
+ cddr_a_list_string = s7_make_permanent_string("a list whose cddr is also a list");
- if ((is_pair(arglist)) &&
- (allows_other_keys(arglist)))
- {
- sc->temp9 = s7_append(sc, arglist, cons(sc, sc->key_allow_other_keys_symbol, sc->nil));
- object_out(sc, sc->temp9, port, USE_WRITE);
- sc->temp9 = sc->nil;
- }
- else object_out(sc, arglist, port, USE_WRITE); /* here we just want the straight output (a b) not (list 'a 'b) */
+ caaar_a_list_string = s7_make_permanent_string("a list whose caaar is also a list");
+ caadr_a_list_string = s7_make_permanent_string("a list whose caadr is also a list");
+ cadar_a_list_string = s7_make_permanent_string("a list whose cadar is also a list");
+ caddr_a_list_string = s7_make_permanent_string("a list whose caddr is also a list");
+ cdaar_a_list_string = s7_make_permanent_string("a list whose cdaar is also a list");
+ cdadr_a_list_string = s7_make_permanent_string("a list whose cdadr is also a list");
+ cddar_a_list_string = s7_make_permanent_string("a list whose cddar is also a list");
+ cdddr_a_list_string = s7_make_permanent_string("a list whose cdddr is also a list");
- old_print_length = sc->print_length;
- sc->print_length = 1048576;
- for (p = body; is_pair(p); p = cdr(p))
- {
- port_write_character(port)(sc, ' ', port);
- object_out(sc, car(p), port, USE_WRITE);
- }
- port_write_character(port)(sc, ')', port);
- sc->print_length = old_print_length;
+ a_list_string = s7_make_permanent_string("a list");
+ an_eq_func_string = s7_make_permanent_string("a procedure that can take 2 arguments");
+ an_association_list_string = s7_make_permanent_string("an association list");
+ a_normal_real_string = s7_make_permanent_string("a normal real");
+ a_rational_string = s7_make_permanent_string("an integer or a ratio");
+ a_number_string = s7_make_permanent_string("a number");
+ a_procedure_string = s7_make_permanent_string("a procedure");
+ a_normal_procedure_string = s7_make_permanent_string("a normal procedure (not a continuation)");
+ a_let_string = s7_make_permanent_string("a let (environment)");
+ a_proper_list_string = s7_make_permanent_string("a proper list");
+ a_boolean_string = s7_make_permanent_string("a boolean");
+ an_input_port_string = s7_make_permanent_string("an input port");
+ an_open_port_string = s7_make_permanent_string("an open port");
+ an_output_port_string = s7_make_permanent_string("an output port");
+ an_input_string_port_string = s7_make_permanent_string("an input string port");
+ an_input_file_port_string = s7_make_permanent_string("an input file port");
+ an_output_string_port_string = s7_make_permanent_string("an output string port");
+ an_output_file_port_string = s7_make_permanent_string("an output file port");
+ a_thunk_string = s7_make_permanent_string("a thunk");
+ a_symbol_string = s7_make_permanent_string("a symbol");
+ a_non_negative_integer_string = s7_make_permanent_string("a non-negative integer");
+ an_unsigned_byte_string = s7_make_permanent_string("an unsigned byte");
+ something_applicable_string = s7_make_permanent_string("a procedure or something applicable");
+ a_random_state_object_string = s7_make_permanent_string("a random-state object");
+ a_format_port_string = s7_make_permanent_string("#f, #t, (), or an open output port");
+ a_non_constant_symbol_string = s7_make_permanent_string("a non-constant symbol");
+ a_sequence_string = s7_make_permanent_string("a sequence");
+ a_valid_radix_string = s7_make_permanent_string("should be between 2 and 16");
+ result_is_too_large_string = s7_make_permanent_string("result is too large");
+ its_too_large_string = s7_make_permanent_string("it is too large");
+ its_too_small_string = s7_make_permanent_string("it is less than the start position");
+ its_negative_string = s7_make_permanent_string("it is negative");
+ its_nan_string = s7_make_permanent_string("NaN usually indicates a numerical error");
+ its_infinite_string = s7_make_permanent_string("it is infinite");
+ too_many_indices_string = s7_make_permanent_string("too many indices");
+ value_is_missing_string = s7_make_permanent_string("~A argument '~A's value is missing");
+#if (!HAVE_COMPLEX_NUMBERS)
+ no_complex_numbers_string = s7_make_permanent_string("this version of s7 does not support complex numbers");
+#endif
}
-static void write_closure_readably(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+
+/* -------- car -------- */
+
+static s7_pointer g_car(s7_scheme *sc, s7_pointer args)
{
- s7_pointer body, arglist, pe, local_slots, setter = NULL;
- unsigned int gc_loc;
-
- body = closure_body(obj);
- arglist = closure_args(obj);
- pe = closure_let(obj); /* perhaps check for documentation? */
+ #define H_car "(car pair) returns the first element of the pair"
+ #define Q_car pl_p
- gc_loc = s7_gc_protect(sc, sc->nil);
- collect_locals(sc, body, pe, arglist, gc_loc); /* collect locals used only here */
- if (s7_is_dilambda(obj))
- {
- setter = closure_setter(obj);
- if ((!(has_closure_let(setter))) ||
- (closure_let(setter) != pe))
- setter = NULL;
- }
- if (setter)
- collect_locals(sc, closure_body(setter), pe, closure_args(setter), gc_loc);
- local_slots = _TLst(gc_protected_at(sc, gc_loc)); /* possibly a list of slots */
+ s7_pointer lst;
+ lst = car(args);
+ if (is_pair(lst))
+ return(car(lst));
+ method_or_bust_one_arg(sc, lst, sc->car_symbol, args, T_PAIR);
+}
- if (!is_null(local_slots))
- {
- s7_pointer x;
- port_write_string(port)(sc, "(let (", 6, port);
- for (x = local_slots; is_pair(x); x = cdr(x))
- {
- s7_pointer slot;
- slot = car(x);
- port_write_character(port)(sc, '(', port);
- port_write_string(port)(sc, symbol_name(slot_symbol(slot)), symbol_name_length(slot_symbol(slot)), port);
- port_write_character(port)(sc, ' ', port);
- object_out(sc, slot_value(slot), port, USE_WRITE);
- if (is_null(cdr(x)))
- port_write_character(port)(sc, ')', port);
- else port_write_string(port)(sc, ") ", 2, port);
- }
- port_write_string(port)(sc, ") ", 2, port);
- }
+static s7_pointer car_p_p(s7_pointer p)
+{
+ if (is_pair(p))
+ return(car(p));
+ return(simple_wrong_type_argument(cur_sc, cur_sc->car_symbol, p, T_PAIR));
+}
- if (setter)
- port_write_string(port)(sc, "(dilambda ", 10, port);
- write_closure_readably_1(sc, obj, arglist, body, port);
+static s7_pointer g_set_car(s7_scheme *sc, s7_pointer args)
+{
+ #define H_set_car "(set-car! pair val) sets the pair's first element to val"
+ #define Q_set_car s7_make_signature(sc, 3, sc->T, sc->is_pair_symbol, sc->T)
+ s7_pointer p;
- if (setter)
+ p = car(args);
+ if (is_pair(p))
{
- port_write_character(port)(sc, ' ', port);
- write_closure_readably_1(sc, setter, closure_args(setter), closure_body(setter), port);
- port_write_character(port)(sc, ')', port);
+ set_car(p, cadr(args));
+ return(car(p));
}
+ method_or_bust(sc, p, sc->set_car_symbol, args, T_PAIR, 1);
+}
- if (!is_null(local_slots))
- port_write_character(port)(sc, ')', port);
- s7_gc_unprotect_at(sc, gc_loc);
+static s7_pointer set_car_p_pp(s7_pointer p1, s7_pointer p2)
+{
+ if (!is_pair(p1))
+ simple_wrong_type_argument(cur_sc, cur_sc->set_car_symbol, p1, T_PAIR);
+ set_car(p1, p2);
+ return(p2);
}
-#if TRAP_SEGFAULT
-#include <signal.h>
-static sigjmp_buf senv; /* global here is not a problem -- it is used only to protect s7_is_valid */
-static volatile sig_atomic_t can_jump = 0;
-static void segv(int ignored) {if (can_jump) siglongjmp(senv, 1);}
-#endif
+/* -------- cdr -------- */
+static s7_pointer g_cdr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cdr "(cdr pair) returns the second element of the pair"
+ #define Q_cdr pl_p
-bool s7_is_valid(s7_scheme *sc, s7_pointer arg)
+ s7_pointer lst;
+ lst = car(args);
+ if (is_pair(lst))
+ return(cdr(lst));
+ method_or_bust_one_arg(sc, lst, sc->cdr_symbol, args, T_PAIR);
+}
+
+static s7_pointer cdr_p_p(s7_pointer p)
{
- bool result = false;
- if (!arg) return(false);
+ if (is_pair(p))
+ return(cdr(p));
+ return(simple_wrong_type_argument(cur_sc, cur_sc->cdr_symbol, p, T_PAIR));
+}
-#if TRAP_SEGFAULT
- if (sigsetjmp(senv, 1) == 0)
- {
- void (*old_segv)(int sig);
- can_jump = 1;
- old_segv = signal(SIGSEGV, segv);
-#endif
- result = ((!is_free(arg)) &&
- (type(arg) < NUM_TYPES) &&
- (arg->hloc >= not_heap) &&
- ((arg->hloc < 0) ||
- ((arg->hloc < (int)sc->heap_size) && (sc->heap[arg->hloc] == arg))));
-#if TRAP_SEGFAULT
- signal(SIGSEGV, old_segv);
- }
- else result = false;
- can_jump = 0;
-#endif
+static s7_pointer g_set_cdr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_set_cdr "(set-cdr! pair val) sets the pair's second element to val"
+ #define Q_set_cdr s7_make_signature(sc, 3, sc->T, sc->is_pair_symbol, sc->T)
+ s7_pointer p;
+
+ p = car(args);
+ if (!is_pair(p))
+ method_or_bust(sc, p, sc->set_cdr_symbol, args, T_PAIR, 1);
+
+ set_cdr(p, cadr(args));
+ return(cdr(p));
+}
- return(result);
+static s7_pointer set_cdr_p_pp(s7_pointer p1, s7_pointer p2)
+{
+ if (!is_pair(p1))
+ simple_wrong_type_argument(cur_sc, cur_sc->set_cdr_symbol, p1, T_PAIR);
+ set_cdr(p1, p2);
+ return(p2);
}
-enum {NO_ARTICLE, INDEFINITE_ARTICLE};
-static char *describe_type_bits(s7_scheme *sc, s7_pointer obj)
+/* -------- caar --------*/
+static s7_pointer g_caar(s7_scheme *sc, s7_pointer args)
{
- unsigned int full_typ;
- unsigned char typ;
- char *buf;
+ #define H_caar "(caar lst) returns (car (car lst)): (caar '((1 2))) -> 1"
+ #define Q_caar pl_p
- buf = (char *)malloc(512 * sizeof(char));
- typ = unchecked_type(obj);
- full_typ = typeflag(obj);
+ s7_pointer lst;
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->caar_symbol, args, T_PAIR);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caar_symbol, lst, car_a_list_string));
+ /* it makes no difference in timing to move lst here or below (i.e. lst=car(lst) then return(car(lst)) and so on) */
+ return(caar(lst));
+}
- /* if debugging all of these bits are being watched, so we need some ugly subterfuges */
- snprintf(buf, 512, "type: %d (%s), flags: #x%x%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,
- ((full_typ & T_PROCEDURE) != 0) ? " procedure" : "",
- ((full_typ & T_GC_MARK) != 0) ? " gc-marked" : "",
- ((full_typ & T_IMMUTABLE) != 0) ? " immutable" : "",
- ((full_typ & T_EXPANSION) != 0) ? " expansion" : "",
- ((full_typ & T_MULTIPLE_VALUE) != 0) ? " values or matched" : "",
- ((full_typ & T_KEYWORD) != 0) ? " keyword" : "",
- ((full_typ & T_DONT_EVAL_ARGS) != 0) ? " dont-eval-args" : "",
- ((full_typ & T_SYNTACTIC) != 0) ? " syntactic" : "",
- ((full_typ & T_OVERLAY) != 0) ? " overlay" : "",
- ((full_typ & T_CHECKED) != 0) ? " checked" : "",
- ((full_typ & T_UNSAFE) != 0) ? ((is_symbol(obj)) ? " clean" : " unsafe") : "",
- ((full_typ & T_OPTIMIZED) != 0) ? " optimized" : "",
- ((full_typ & T_SAFE_CLOSURE) != 0) ? " safe-closure" : "",
- ((full_typ & T_SAFE_PROCEDURE) != 0) ? " safe-procedure" : "",
- ((full_typ & T_SETTER) != 0) ? " setter" : "",
- ((full_typ & T_COPY_ARGS) != 0) ? " copy-args" : "",
- ((full_typ & T_COLLECTED) != 0) ? " collected" : "",
- ((full_typ & T_SHARED) != 0) ? " shared" : "",
- ((full_typ & T_HAS_METHODS) != 0) ? " has-methods" : "",
- ((full_typ & T_GLOBAL) != 0) ? ((is_pair(obj)) ? " unsafe-do" : " global") : "",
- ((full_typ & T_SAFE_STEPPER) != 0) ? ((is_let(obj)) ? " let-set!-fallback" : ((is_slot(obj)) ? " safe-stepper" : " print-name")) : "",
- ((full_typ & T_LINE_NUMBER) != 0) ?
- ((is_pair(obj)) ? " line number" : ((is_input_port(obj)) ? " loader-port" : ((is_let(obj)) ? " with-let" : " has accessor"))) : "",
- ((full_typ & T_MUTABLE) != 0) ?
- ((is_string(obj)) ? " byte-vector" : ((is_let(obj)) ? " let-ref-fallback" :
- ((is_iterator(obj)) ? " mark-seq" : ((is_slot(obj)) ? " stepper" : " mutable")))) : "",
- ((full_typ & T_GENSYM) != 0) ?
- ((is_let(obj)) ? " function-env" : ((is_unspecified(obj)) ? " no-value" : ((is_pair(obj)) ? " list-in-use" :
- ((is_closure_star(obj)) ? " simple-args" : ((is_string(obj)) ? " documented" : " gensym"))))) : "");
- return(buf);
+static s7_pointer caar_p_p(s7_pointer p)
+{
+ if ((is_pair(p)) &&
+ (is_pair(car(p))))
+ return(caar(p));
+ return(simple_wrong_type_argument(cur_sc, cur_sc->caar_symbol, p, T_PAIR));
}
-#if DEBUGGING
-static const char *check_name(int typ)
+
+/* -------- cadr --------*/
+static s7_pointer g_cadr(s7_scheme *sc, s7_pointer args)
{
- if ((typ >= 0) && (typ < NUM_TYPES))
- {
- s7_pointer p;
- p = prepackaged_type_names[typ];
- if (is_string(p)) return(string_value(p));
-
- switch (typ)
- {
- case T_C_OBJECT: return("a c-object");
- case T_INPUT_PORT: return("an input port");
- case T_OUTPUT_PORT: return("an output port");
- }
- }
- return("unknown type!");
+ #define H_cadr "(cadr lst) returns (car (cdr lst)): (cadr '(1 2 3)) -> 2"
+ #define Q_cadr pl_p
+
+ s7_pointer lst;
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cadr_symbol, args, T_PAIR);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadr_symbol, lst, cdr_a_list_string));
+ return(cadr(lst));
}
-static s7_pointer check_seti(s7_scheme *sc, s7_pointer x, const char *func, int line)
+static s7_pointer cadr_p_p(s7_pointer p)
{
- if (is_immutable(x))
- {
- fprintf(stderr, "%s%s[%d]: set! immutable %s: %s%s\n", BOLD_TEXT, func, line, type_name(sc, x, NO_ARTICLE), DISPLAY(x), UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
- return(x);
+ if ((is_pair(p)) &&
+ (is_pair(cdr(p))))
+ return(cadr(p));
+ return(simple_wrong_type_argument(cur_sc, cur_sc->cadr_symbol, p, T_PAIR));
}
-static s7_pointer check_ref(s7_pointer p, int expected_type, const char *func, int line, const char *func1, const char *func2)
+
+/* -------- cdar -------- */
+static s7_pointer g_cdar(s7_scheme *sc, s7_pointer args)
{
- int typ;
- typ = unchecked_type(p);
- if (typ != expected_type)
- {
- if ((!func1) || (typ != T_FREE))
- {
- fprintf(stderr, "%s%s[%d]: not %s, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(expected_type), check_name(typ), typ, UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
- else
- {
- if ((strcmp(func, func1) != 0) &&
- ((!func2) || (strcmp(func, func2) != 0)))
- {
- fprintf(stderr, "%s%s[%d]: free cell, not %s%s\n", BOLD_TEXT, func, line, check_name(expected_type), UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
- }
- }
- return(p);
+ #define H_cdar "(cdar lst) returns (cdr (car lst)): (cdar '((1 2 3))) -> '(2 3)"
+ #define Q_cdar pl_p
+
+ s7_pointer lst;
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cdar_symbol, args, T_PAIR);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdar_symbol, lst, car_a_list_string));
+ return(cdar(lst));
}
-static s7_pointer check_ref2(s7_pointer p, int expected_type, int other_type, const char *func, int line, const char *func1, const char *func2)
+static s7_pointer cdar_p_p(s7_pointer p)
{
- int typ;
- typ = unchecked_type(p);
- if ((typ != expected_type) && (typ != other_type))
- return(check_ref(p, expected_type, func, line, func1, func2));
- return(p);
+ if ((is_pair(p)) &&
+ (is_pair(car(p))))
+ return(cdar(p));
+ return(simple_wrong_type_argument(cur_sc, cur_sc->cdar_symbol, p, T_PAIR));
}
-static s7_pointer check_ref3(s7_pointer p, const char *func, int line)
+
+/* -------- cddr -------- */
+static s7_pointer g_cddr(s7_scheme *sc, s7_pointer args)
{
- int typ;
- typ = unchecked_type(p);
- if ((typ != T_INPUT_PORT) && (typ != T_OUTPUT_PORT) && (typ != T_FREE))
- {
- fprintf(stderr, "%s%s[%d]: not a port, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
- return(p);
+ #define H_cddr "(cddr lst) returns (cdr (cdr lst)): (cddr '(1 2 3 4)) -> '(3 4)"
+ #define Q_cddr pl_p
+
+ s7_pointer lst;
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cddr_symbol, args, T_PAIR);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddr_symbol, lst, cdr_a_list_string));
+ return(cddr(lst));
}
-static s7_pointer check_ref4(s7_pointer p, const char *func, int line)
+static s7_pointer cddr_p_p(s7_pointer p)
{
- int typ;
- typ = unchecked_type(p);
- if ((typ != T_VECTOR) && (typ != T_FLOAT_VECTOR) && (typ != T_INT_VECTOR) && (typ != T_FREE))
- {
- fprintf(stderr, "%s%s[%d]: not a vector, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
- return(p);
+ if ((is_pair(p)) &&
+ (is_pair(cdr(p))))
+ return(cddr(p));
+ return(simple_wrong_type_argument(cur_sc, cur_sc->cddr_symbol, p, T_PAIR));
}
-static s7_pointer check_ref5(s7_pointer p, const char *func, int line)
+
+/* -------- caaar -------- */
+static s7_pointer g_caaar(s7_scheme *sc, s7_pointer args)
{
- int typ;
- typ = unchecked_type(p);
- if (!t_has_closure_let[typ])
- {
- fprintf(stderr, "%s%s[%d]: not a closure, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
- return(p);
+ s7_pointer lst;
+ #define H_caaar "(caaar lst) returns (car (car (car lst))): (caaar '(((1 2)))) -> 1"
+ #define Q_caaar pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->caaar_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaar_symbol, lst, car_a_list_string));
+ if (!is_pair(caar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaar_symbol, lst, caar_a_list_string));
+ return(caaar(lst));
}
-static s7_pointer check_ref6(s7_pointer p, const char *func, int line)
+
+/* -------- caadr -------- */
+static s7_pointer g_caadr(s7_scheme *sc, s7_pointer args)
{
- int typ;
- typ = unchecked_type(p);
- if ((typ < T_C_FUNCTION_STAR) && (typ != T_C_MACRO))
- {
- fprintf(stderr, "%s%s[%d]: not a c function, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
- return(p);
+ s7_pointer lst;
+ #define H_caadr "(caadr lst) returns (car (car (cdr lst))): (caadr '(1 (2 3))) -> 2"
+ #define Q_caadr pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->caadr_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caadr_symbol, lst, cdr_a_list_string));
+ if (!is_pair(cadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caadr_symbol, lst, cadr_a_list_string));
+ return(caadr(lst));
}
-static s7_pointer check_ref7(s7_pointer p, const char *func, int line)
+
+/* -------- cadar -------- */
+static s7_pointer g_cadar(s7_scheme *sc, s7_pointer args)
{
- if ((!func) || (strcmp(func, "decribe_type_bits") != 0))
- {
- int typ;
- typ = unchecked_type(p);
- if ((typ < T_INTEGER) || (typ > T_COMPLEX))
- {
- fprintf(stderr, "%s%s[%d]: not a number, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
- }
- return(p);
+ s7_pointer lst;
+ #define H_cadar "(cadar lst) returns (car (cdr (car lst))): (cadar '((1 2 3))) -> 2"
+ #define Q_cadar pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cadar_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadar_symbol, lst, car_a_list_string));
+ if (!is_pair(cdar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadar_symbol, lst, cdar_a_list_string));
+ return(cadar(lst));
}
-static s7_pointer check_ref8(s7_pointer p, const char *func, int line)
+
+/* -------- cdaar -------- */
+static s7_pointer g_cdaar(s7_scheme *sc, s7_pointer args)
{
- int typ;
- typ = unchecked_type(p);
- if ((!t_sequence_p[typ]) && (!t_structure_p[typ]) && (!is_any_closure(p))) /* closure calling itself an iterator?? */
- {
- fprintf(stderr, "%s%s[%d]: not a sequence or structure, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
- return(p);
+ s7_pointer lst;
+ #define H_cdaar "(cdaar lst) returns (cdr (car (car lst))): (cdaar '(((1 2 3)))) -> '(2 3)"
+ #define Q_cdaar pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cdaar_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaar_symbol, lst, car_a_list_string));
+ if (!is_pair(caar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaar_symbol, lst, caar_a_list_string));
+ return(cdaar(lst));
}
-static s7_pointer check_ref9(s7_pointer p, const char *func, int line)
+
+/* -------- caddr -------- */
+static s7_pointer g_caddr(s7_scheme *sc, s7_pointer args)
{
- int typ;
- typ = unchecked_type(p);
- if ((typ != T_LET) && (typ != T_C_OBJECT) && (!is_any_closure(p)) && (!is_any_macro(p)))
- {
- fprintf(stderr, "%s%s[%d]: not a possible method holder, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
- return(p);
+ s7_pointer lst;
+ #define H_caddr "(caddr lst) returns (car (cdr (cdr lst))): (caddr '(1 2 3 4)) -> 3"
+ #define Q_caddr pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->caddr_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caddr_symbol, lst, cdr_a_list_string));
+ if (!is_pair(cddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caddr_symbol, lst, cddr_a_list_string));
+ return(caddr(lst));
}
-static s7_pointer check_ref10(s7_pointer p, const char *func, int line)
+
+/* -------- cdddr -------- */
+static s7_pointer g_cdddr(s7_scheme *sc, s7_pointer args)
{
- int typ;
- typ = unchecked_type(p);
- if ((typ != T_PAIR) && (typ != T_NIL) && (typ != T_SYMBOL))
- {
- fprintf(stderr, "%s%s[%d]: arglist is %s (%d)%s?\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
- return(p);
+ s7_pointer lst;
+ #define H_cdddr "(cdddr lst) returns (cdr (cdr (cdr lst))): (cdddr '(1 2 3 4)) -> '(4)"
+ #define Q_cdddr pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cdddr_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdddr_symbol, lst, cdr_a_list_string));
+ if (!is_pair(cddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdddr_symbol, lst, cddr_a_list_string));
+ return(cdddr(lst));
}
-static s7_pointer check_ref11(s7_pointer p, const char *func, int line)
+
+/* -------- cdadr -------- */
+static s7_pointer g_cdadr(s7_scheme *sc, s7_pointer args)
{
- int typ;
- typ = unchecked_type(p);
- if ((typ < T_CLOSURE) && (typ != T_BOOLEAN)) /* actually #t is an error here */
- {
- fprintf(stderr, "%s%s[%d]: setter is %s (%d)%s?\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
- return(p);
+ s7_pointer lst;
+ #define H_cdadr "(cdadr lst) returns (cdr (car (cdr lst))): (cdadr '(1 (2 3 4))) -> '(3 4)"
+ #define Q_cdadr pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cdadr_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdadr_symbol, lst, cdr_a_list_string));
+ if (!is_pair(cadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdadr_symbol, lst, cadr_a_list_string));
+ return(cdadr(lst));
}
-static s7_pointer check_nref(s7_pointer p, const char *func, int line)
+
+/* -------- cddar -------- */
+static s7_pointer g_cddar(s7_scheme *sc, s7_pointer args)
{
- int typ;
- typ = unchecked_type(p);
- if (typ == T_FREE)
- {
- fprintf(stderr, "%s%s[%d]: attempt to use cleared type%s\n", BOLD_TEXT, func, line, UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
- if ((typ < 0) || (typ >= NUM_TYPES))
- {
- fprintf(stderr, "%s%s[%d]: attempt to use messed up cell (type: %d)%s\n", BOLD_TEXT, func, line, typ, UNBOLD_TEXT);
- if (stop_at_error) abort();
- }
- return(p);
+ s7_pointer lst;
+ #define H_cddar "(cddar lst) returns (cdr (cdr (car lst))): (cddar '((1 2 3 4))) -> '(3 4)"
+ #define Q_cddar pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cddar_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddar_symbol, lst, car_a_list_string));
+ if (!is_pair(cdar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddar_symbol, lst, cdar_a_list_string));
+ return(cddar(lst));
}
-static void print_gc_info(s7_pointer obj, int line)
+
+/* -------- caaaar -------- */
+static s7_pointer g_caaaar(s7_scheme *sc, s7_pointer args)
{
- fprintf(stderr, "%s%p is free (line %d), current: %s[%d], previous: %s[%d], gc call: %s[%d], clear: %d, alloc: %s[%d]%s\n",
- BOLD_TEXT,
- obj, line,
- obj->current_alloc_func, obj->current_alloc_line,
- obj->previous_alloc_func, obj->previous_alloc_line,
- obj->gc_func, obj->gc_line, obj->clear_line, obj->alloc_func, obj->alloc_line,
- UNBOLD_TEXT);
- abort();
+ s7_pointer lst;
+ #define H_caaaar "(caaaar lst) returns (car (car (car (car lst)))): (caaaar '((((1 2))))) -> 1"
+ #define Q_caaaar pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->caaaar_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaaar_symbol, lst, car_a_list_string));
+ if (!is_pair(caar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaaar_symbol, lst, caar_a_list_string));
+ if (!is_pair(caaar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaaar_symbol, lst, caaar_a_list_string));
+ return(caaaar(lst));
}
-static void show_opt1_bits(s7_scheme *sc, s7_pointer p, const char *func, int line)
+
+/* -------- caaadr -------- */
+static s7_pointer g_caaadr(s7_scheme *sc, s7_pointer args)
{
- fprintf(stderr, "%sopt1 %s[%d]: %p->%p %x%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s\n", BOLD_TEXT, func, line, p, p->object.cons.opt1, p->debugger_bits,
- ((p->debugger_bits & E_SET) != 0) ? " e-set" : "",
- ((p->debugger_bits & E_FAST) != 0) ? " fast" : "",
- ((p->debugger_bits & E_CFUNC) != 0) ? " cfunc" : "",
- ((p->debugger_bits & E_CLAUSE) != 0) ? " clause" : "",
- ((p->debugger_bits & E_BACK) != 0) ? " back" : "",
- ((p->debugger_bits & E_LAMBDA) != 0) ? " lambda" : "",
- ((p->debugger_bits & E_SYM) != 0) ? " sym" : "",
- ((p->debugger_bits & E_PAIR) != 0) ? " pair" : "",
- ((p->debugger_bits & E_CON) != 0) ? " con" : "",
- ((p->debugger_bits & E_GOTO) != 0) ? " goto" : "",
- ((p->debugger_bits & E_VECTOR) != 0) ? " vector" : "",
- ((p->debugger_bits & E_ANY) != 0) ? " any" : "",
- ((p->debugger_bits & E_SLOT) != 0) ? " slot" : "",
- ((p->debugger_bits & S_HASH) != 0) ? " raw-hash" : "",
- UNBOLD_TEXT);
+ s7_pointer lst;
+ #define H_caaadr "(caaadr lst) returns (car (car (car (cdr lst)))): (caaadr '(1 ((2 3)))) -> 2"
+ #define Q_caaadr pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->caaadr_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaadr_symbol, lst, cdr_a_list_string));
+ if (!is_pair(cadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaadr_symbol, lst, cadr_a_list_string));
+ if (!is_pair(caadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaadr_symbol, lst, caadr_a_list_string));
+ return(caaadr(lst));
}
-static s7_pointer opt1_1(s7_scheme *sc, s7_pointer p, unsigned int role, const char *func, int line)
+
+/* -------- caadar -------- */
+static s7_pointer g_caadar(s7_scheme *sc, s7_pointer args)
{
- if ((!opt1_is_set(p)) ||
- ((!opt1_role_matches(p, role)) &&
- (role != E_ANY)))
- {
- show_opt1_bits(sc, p, func, line);
- if (stop_at_error) abort();
- }
- return(p->object.cons.opt1);
+ s7_pointer lst;
+ #define H_caadar "(caadar lst) returns (car (car (cdr (car lst)))): (caadar '((1 (2 3)))) -> 2"
+ #define Q_caadar pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->caadar_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caadar_symbol, lst, car_a_list_string));
+ if (!is_pair(cdar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caadar_symbol, lst, cdar_a_list_string));
+ if (!is_pair(cadar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caadar_symbol, lst, cadar_a_list_string));
+ return(caadar(lst));
}
-static s7_pointer set_opt1_1(s7_scheme *sc, s7_pointer p, s7_pointer x, unsigned int role, const char *func, int line)
+
+/* -------- cadaar -------- */
+static s7_pointer g_cadaar(s7_scheme *sc, s7_pointer args)
{
- p->object.cons.opt1 = x;
- set_opt1_role(p, role);
- set_opt1_is_set(p);
- return(x);
+ s7_pointer lst;
+ #define H_cadaar "(cadaar lst) returns (car (cdr (car (car lst)))): (cadaar '(((1 2 3)))) -> 2"
+ #define Q_cadaar pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cadaar_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadaar_symbol, lst, car_a_list_string));
+ if (!is_pair(caar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadaar_symbol, lst, caar_a_list_string));
+ if (!is_pair(cdaar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadaar_symbol, lst, cdaar_a_list_string));
+ return(cadaar(lst));
}
-static unsigned long long int s_hash_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
+
+/* -------- caaddr -------- */
+static s7_pointer g_caaddr(s7_scheme *sc, s7_pointer args)
{
- if ((!opt1_is_set(p)) ||
- (!opt1_role_matches(p, S_HASH)))
- {
- show_opt1_bits(sc, p, func, line);
- if (stop_at_error) abort();
- }
- return(p->object.sym_cons.hash);
+ s7_pointer lst;
+ #define H_caaddr "(caaddr lst) returns (car (car (cdr (cdr lst)))): (caaddr '(1 2 (3 4))) -> 3"
+ #define Q_caaddr pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->caaddr_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaddr_symbol, lst, cdr_a_list_string));
+ if (!is_pair(cddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaddr_symbol, lst, cddr_a_list_string));
+ if (!is_pair(caddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaddr_symbol, lst, caddr_a_list_string));
+ return(caaddr(lst));
}
-static void set_s_hash_1(s7_scheme *sc, s7_pointer p, unsigned long long int x, const char *func, int line)
+
+/* -------- cadddr -------- */
+static s7_pointer g_cadddr(s7_scheme *sc, s7_pointer args)
{
- p->object.sym_cons.hash = x;
- set_opt1_role(p, S_HASH);
- set_opt1_is_set(p);
+ s7_pointer lst;
+ #define H_cadddr "(cadddr lst) returns (car (cdr (cdr (cdr lst)))): (cadddr '(1 2 3 4 5)) -> 4"
+ #define Q_cadddr pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cadddr_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadddr_symbol, lst, cdr_a_list_string));
+ if (!is_pair(cddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadddr_symbol, lst, cddr_a_list_string));
+ if (!is_pair(cdddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadddr_symbol, lst, cdddr_a_list_string));
+ return(cadddr(lst));
}
-static void show_opt2_bits(s7_scheme *sc, s7_pointer p, const char *func, int line, unsigned int role)
+
+/* -------- cadadr -------- */
+static s7_pointer g_cadadr(s7_scheme *sc, s7_pointer args)
{
- fprintf(stderr, "%s%s[%d]: opt2: %p->%p is %x%s%s%s%s%s%s%s%s%s but expects %x%s%s%s%s%s%s%s%s%s%s\n",
- BOLD_TEXT, func, line, p, p->object.cons.opt2,
-
- p->debugger_bits,
- ((p->debugger_bits & F_SET) != 0) ? " f-set" : "",
- ((p->debugger_bits & F_KEY) != 0) ? " key" : "",
- ((p->debugger_bits & F_SLOW) != 0) ? " slow" : "",
- ((p->debugger_bits & F_SYM) != 0) ? " sym" : "",
- ((p->debugger_bits & F_PAIR) != 0) ? " pair" : "",
- ((p->debugger_bits & F_CON) != 0) ? " con" : "",
- ((p->debugger_bits & F_CALL) != 0) ? " call" : "",
- ((p->debugger_bits & F_LAMBDA) != 0) ? " lambda" : "",
- ((p->debugger_bits & S_NAME) != 0) ? " raw-name" : "",
-
- role,
- ((role & F_SET) != 0) ? " f-set" : "",
- ((role & F_KEY) != 0) ? " key" : "",
- ((role & F_SLOW) != 0) ? " slow" : "",
- ((role & F_SYM) != 0) ? " sym" : "",
- ((role & F_PAIR) != 0) ? " pair" : "",
- ((role & F_CON) != 0) ? " con" : "",
- ((role & F_CALL) != 0) ? " call" : "",
- ((role & F_LAMBDA) != 0) ? " lambda" : "",
- ((role & S_NAME) != 0) ? " raw-name" : "",
+ s7_pointer lst;
+ #define H_cadadr "(cadadr lst) returns (car (cdr (car (cdr lst)))): (cadadr '(1 (2 3 4))) -> 3"
+ #define Q_cadadr pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cadadr_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadadr_symbol, lst, cdr_a_list_string));
+ if (!is_pair(cadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadadr_symbol, lst, cadr_a_list_string));
+ if (!is_pair(cdadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadadr_symbol, lst, cdadr_a_list_string));
+ return(cadadr(lst));
+}
- UNBOLD_TEXT);
+
+/* -------- caddar -------- */
+static s7_pointer g_caddar(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer lst;
+ #define H_caddar "(caddar lst) returns (car (cdr (cdr (car lst)))): (caddar '((1 2 3 4))) -> 3"
+ #define Q_caddar pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->caddar_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caddar_symbol, lst, car_a_list_string));
+ if (!is_pair(cdar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caddar_symbol, lst, cdar_a_list_string));
+ if (!is_pair(cddar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caddar_symbol, lst, cddar_a_list_string));
+ return(caddar(lst));
}
-static s7_pointer opt2_1(s7_scheme *sc, s7_pointer p, unsigned int role, const char *func, int line)
+
+/* -------- cdaaar -------- */
+static s7_pointer g_cdaaar(s7_scheme *sc, s7_pointer args)
{
- if ((!opt2_is_set(p)) ||
- (!opt2_role_matches(p, role)))
- {
- show_opt2_bits(sc, p, func, line, role);
- fprintf(stderr, "p: %s\n", DISPLAY(p));
- if (stop_at_error) abort();
- }
- return(p->object.cons.opt2);
+ s7_pointer lst;
+ #define H_cdaaar "(cdaaar lst) returns (cdr (car (car (car lst)))): (cdaaar '((((1 2 3))))) -> '(2 3)"
+ #define Q_cdaaar pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cdaaar_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaaar_symbol, lst, car_a_list_string));
+ if (!is_pair(caar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaaar_symbol, lst, caar_a_list_string));
+ if (!is_pair(caaar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaaar_symbol, lst, caaar_a_list_string));
+ return(cdaaar(lst));
}
-static void set_opt2_1(s7_scheme *sc, s7_pointer p, s7_pointer x, unsigned int role, const char *func, int line)
+
+/* -------- cdaadr -------- */
+static s7_pointer g_cdaadr(s7_scheme *sc, s7_pointer args)
{
- p->object.cons.opt2 = x;
- set_opt2_role(p, role);
- set_opt2_is_set(p);
+ s7_pointer lst;
+ #define H_cdaadr "(cdaadr lst) returns (cdr (car (car (cdr lst)))): (cdaadr '(1 ((2 3 4)))) -> '(3 4)"
+ #define Q_cdaadr pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cdaadr_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaadr_symbol, lst, cdr_a_list_string));
+ if (!is_pair(cadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaadr_symbol, lst, cadr_a_list_string));
+ if (!is_pair(caadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaadr_symbol, lst, caadr_a_list_string));
+ return(cdaadr(lst));
}
-static const char *s_name_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
+
+/* -------- cdadar -------- */
+static s7_pointer g_cdadar(s7_scheme *sc, s7_pointer args)
{
- if ((!opt2_is_set(p)) ||
- (!opt2_role_matches(p, S_NAME)))
- {
- show_opt2_bits(sc, p, func, line, (unsigned int)S_NAME);
- if (stop_at_error) abort();
- }
- return(p->object.sym_cons.fstr);
+ s7_pointer lst;
+ #define H_cdadar "(cdadar lst) returns (cdr (car (cdr (car lst)))): (cdadar '((1 (2 3 4)))) -> '(3 4)"
+ #define Q_cdadar pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cdadar_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdadar_symbol, lst, car_a_list_string));
+ if (!is_pair(cdar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdadar_symbol, lst, cdar_a_list_string));
+ if (!is_pair(cadar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdadar_symbol, lst, cadar_a_list_string));
+ return(cdadar(lst));
}
-static void set_s_name_1(s7_scheme *sc, s7_pointer p, const char *str, const char *func, int line)
+
+/* -------- cddaar -------- */
+static s7_pointer g_cddaar(s7_scheme *sc, s7_pointer args)
{
- p->object.sym_cons.fstr = str;
- set_opt2_role(p, S_NAME);
- set_opt2_is_set(p);
+ s7_pointer lst;
+ #define H_cddaar "(cddaar lst) returns (cdr (cdr (car (car lst)))): (cddaar '(((1 2 3 4)))) -> '(3 4)"
+ #define Q_cddaar pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cddaar_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddaar_symbol, lst, car_a_list_string));
+ if (!is_pair(caar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddaar_symbol, lst, caar_a_list_string));
+ if (!is_pair(cdaar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddaar_symbol, lst, cdaar_a_list_string));
+ return(cddaar(lst));
}
-static void show_opt3_bits(s7_scheme *sc, s7_pointer p, const char *func, int line)
+
+/* -------- cdaddr -------- */
+static s7_pointer g_cdaddr(s7_scheme *sc, s7_pointer args)
{
- fprintf(stderr, "%s%s[%d]: opt3: %x%s%s%s%s%s%s%s%s%s\n", BOLD_TEXT, func, line,
- p->debugger_bits,
- ((p->debugger_bits & G_SET) != 0) ? " g-set" : "",
- ((p->debugger_bits & G_ARGLEN) != 0) ? " arglen" : "",
- ((p->debugger_bits & G_SYM) != 0) ? " sym" : "",
- ((p->debugger_bits & G_AND) != 0) ? " and" : "",
- ((p->debugger_bits & S_LINE) != 0) ? " line" : "",
- ((p->debugger_bits & S_LEN) != 0) ? " len" : "",
- ((p->debugger_bits & S_OP) != 0) ? " op" : "",
- ((p->debugger_bits & S_SYNOP) != 0) ? " syn-op" : "",
- UNBOLD_TEXT);
+ s7_pointer lst;
+ #define H_cdaddr "(cdaddr lst) returns (cdr (car (cdr (cdr lst)))): (cdaddr '(1 2 (3 4 5))) -> '(4 5)"
+ #define Q_cdaddr pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cdaddr_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaddr_symbol, lst, cdr_a_list_string));
+ if (!is_pair(cddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaddr_symbol, lst, cddr_a_list_string));
+ if (!is_pair(caddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaddr_symbol, lst, caddr_a_list_string));
+ return(cdaddr(lst));
}
-static s7_pointer opt3_1(s7_scheme *sc, s7_pointer p, unsigned int role, const char *func, int line)
+
+/* -------- cddddr -------- */
+static s7_pointer g_cddddr(s7_scheme *sc, s7_pointer args)
{
- if ((!opt3_is_set(p)) ||
- (!opt3_role_matches(p, role)))
- {
- show_opt3_bits(sc, p, func, line);
- if (stop_at_error) abort();
- }
- return(p->object.cons.opt3);
+ s7_pointer lst;
+ #define H_cddddr "(cddddr lst) returns (cdr (cdr (cdr (cdr lst)))): (cddddr '(1 2 3 4 5)) -> '(5)"
+ #define Q_cddddr pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cddddr_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddddr_symbol, lst, cdr_a_list_string));
+ if (!is_pair(cddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddddr_symbol, lst, cddr_a_list_string));
+ if (!is_pair(cdddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddddr_symbol, lst, cdddr_a_list_string));
+ return(cddddr(lst));
}
-static void set_opt3_1(s7_scheme *sc, s7_pointer p, s7_pointer x, unsigned int role, const char *func, int line)
-{
- typeflag(p) &= ~(T_OPTIMIZED | T_LINE_NUMBER);
- p->object.cons.opt3 = x;
- set_opt3_is_set(p);
- set_opt3_role(p, role);
-}
-/* S_LINE */
-static unsigned int s_line_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
+/* -------- cddadr -------- */
+static s7_pointer g_cddadr(s7_scheme *sc, s7_pointer args)
{
- if ((!opt3_is_set(p)) ||
- ((p->debugger_bits & S_LINE) == 0) ||
- (!has_line_number(p)))
- {
- show_opt3_bits(sc, p, func, line);
- if (stop_at_error) abort();
- }
- return(p->object.sym_cons.line);
+ s7_pointer lst;
+ #define H_cddadr "(cddadr lst) returns (cdr (cdr (car (cdr lst)))): (cddadr '(1 (2 3 4 5))) -> '(4 5)"
+ #define Q_cddadr pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cddadr_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddadr_symbol, lst, cdr_a_list_string));
+ if (!is_pair(cadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddadr_symbol, lst, cadr_a_list_string));
+ if (!is_pair(cdadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddadr_symbol, lst, cdadr_a_list_string));
+ return(cddadr(lst));
}
-static void set_s_line_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line)
+
+/* -------- cdddar -------- */
+static s7_pointer g_cdddar(s7_scheme *sc, s7_pointer args)
{
- p->object.sym_cons.line = x;
- (p)->debugger_bits = (S_LINE | (p->debugger_bits & ~S_LEN)); /* turn on line, cancel len */
- set_opt3_is_set(p);
+ s7_pointer lst;
+ #define H_cdddar "(cdddar lst) returns (cdr (cdr (cdr (car lst)))): (cdddar '((1 2 3 4 5))) -> '(4 5)"
+ #define Q_cdddar pl_p
+
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust_one_arg(sc, lst, sc->cdddar_symbol, set_plist_1(sc, lst), T_PAIR);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdddar_symbol, lst, car_a_list_string));
+ if (!is_pair(cdar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdddar_symbol, lst, cdar_a_list_string));
+ if (!is_pair(cddar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdddar_symbol, lst, cddar_a_list_string));
+ return(cdddar(lst));
}
-/* S_LEN (collides with S_LINE) */
-static unsigned int s_len_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
+
+s7_pointer s7_assq(s7_scheme *sc, s7_pointer obj, s7_pointer x)
{
- if ((!opt3_is_set(p)) ||
- ((p->debugger_bits & S_LEN) == 0) ||
- (has_line_number(p)))
+ s7_pointer y;
+ y = x;
+ while (true)
{
- show_opt3_bits(sc, p, func, line);
- if (stop_at_error) abort();
+ /* we can blithely take the car of anything, since we're not treating it as an object,
+ * then if we get a bogus match, the following check that caar made sense ought to catch it.
+ *
+ * if car(#<unspecified>) = #<unspecified> (initialization time), then cdr(nil)->unspec
+ * and subsequent caar(unspc)->unspec so we could forgo half the is_pair checks below.
+ * This breaks if "x" is a dotted list -- the last cdr is not nil, so we lose.
+ */
+ if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
}
- return(p->object.sym_cons.line);
+ return(sc->F); /* not reached */
}
-static void set_s_len_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line)
+
+static s7_pointer g_assq(s7_scheme *sc, s7_pointer args)
{
- typeflag(p) &= ~(T_LINE_NUMBER);
- p->object.sym_cons.line = x;
- (p)->debugger_bits = (S_LEN | (p->debugger_bits & ~(S_LINE)));
- set_opt3_is_set(p);
+ s7_pointer x, y;
+ #define H_assq "(assq obj alist) returns the key-value pair associated (via eq?) with the key obj in the association list alist"
+ #define Q_assq s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_boolean_symbol), sc->T, sc->is_list_symbol)
+
+ x = car(args);
+ y = cadr(args);
+ if (is_pair(y))
+ return(s7_assq(sc, x, y));
+ if (is_null(y))
+ return(sc->F);
+ method_or_bust_with_type(sc, y, sc->assq_symbol, list_2(sc, x, y), an_association_list_string, 2);
+ /* we don't check for (pair? (car x)) here (or in assv) so we get some inconsistency with assoc:
+ * (assq #f '(#f 2 . 3)) -> #f
+ * (assoc #f '(#f 2 . 3)) -> 'error
+ */
}
-/* S_OP */
-static unsigned int s_op_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
-{
- if ((!opt3_is_set(p)) ||
- ((p->debugger_bits & S_OP) == 0))
+
+static s7_pointer g_assv(s7_scheme *sc, s7_pointer args) /* g_assv is called by g_assoc below */
+{
+ s7_pointer x, y, z;
+ #define H_assv "(assv obj alist) returns the key-value pair associated (via eqv?) with the key obj in the association list alist"
+ #define Q_assv Q_assq
+
+ x = car(args);
+ y = cadr(args);
+ if (!is_pair(y))
{
- show_opt3_bits(sc, p, func, line);
- if (stop_at_error) abort();
+ if (is_null(y)) return(sc->F);
+ method_or_bust_with_type(sc, y, sc->assv_symbol, list_2(sc, x, y), an_association_list_string, 2);
}
- return(p->object.sym_cons.op);
-}
-static void set_s_op_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line)
-{
- p->object.sym_cons.op = x;
- (p)->debugger_bits = (S_OP | (p->debugger_bits & ~(S_SYNOP)));
- set_opt3_is_set(p);
-}
+ if (is_simple(x))
+ return(s7_assq(sc, x, y));
-/* S_SYNOP (collides with S_OP) */
-static unsigned int s_syn_op_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
-{
- if ((!opt3_is_set(p)) ||
- ((p->debugger_bits & S_SYNOP) == 0))
+ z = y;
+ while (true)
{
- show_opt3_bits(sc, p, func, line);
- if (stop_at_error) abort();
+ /* here we can't play the assq == game because s7_is_eqv thinks it's getting a legit s7 object */
+ if ((is_pair(car(y))) && (s7_is_eqv(x, caar(y)))) return(car(y));
+ y = cdr(y);
+ if (!is_pair(y)) return(sc->F);
+
+ if ((is_pair(car(y))) && (s7_is_eqv(x, caar(y)))) return(car(y));
+ y = cdr(y);
+ if (!is_pair(y)) return(sc->F);
+
+ z = cdr(z);
+ if (z == y) return(sc->F);
}
- return(p->object.sym_cons.op);
+ return(sc->F); /* not reached */
}
-static void set_s_syn_op_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line)
-{
- p->object.sym_cons.op = x;
- (p)->debugger_bits = (S_SYNOP | (p->debugger_bits & ~(S_OP)));
- set_opt3_is_set(p);
-}
-static void print_debugging_state(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+static s7_pointer all_x_c_ss(s7_scheme *sc, s7_pointer arg);
+static s7_pointer all_x_c_c(s7_scheme *sc, s7_pointer arg);
+static s7_pointer g_is_eq(s7_scheme *sc, s7_pointer args);
+static s7_pointer g_is_eqv(s7_scheme *sc, s7_pointer args);
+static s7_function s7_bool_optimize(s7_scheme *sc, s7_pointer expr);
+static s7_pointer opt_bool_any(s7_scheme *sc, s7_pointer expr);
+
+static s7_pointer g_assoc(s7_scheme *sc, s7_pointer args)
{
- /* show current state, current allocated state, and previous allocated state.
- */
- char *current_bits, *allocated_bits, *previous_bits, *str;
- int save_typeflag, len, nlen;
- const char *excl_name;
+ #define H_assoc "(assoc obj alist (func #f)) returns the key-value pair associated (via equal?) with the key obj in the association list alist.\
+If 'func' is a function of 2 arguments, it is used for the comparison instead of 'equal?"
+ #define Q_assoc s7_make_signature(sc, 4, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_boolean_symbol), sc->T, sc->is_list_symbol, sc->is_procedure_symbol)
- if (is_free(obj))
- excl_name = "free cell!";
- else excl_name = "unknown object!";
+ s7_pointer x, y, obj, eq_func = NULL;
- current_bits = describe_type_bits(sc, obj);
- save_typeflag = typeflag(obj);
- typeflag(obj) = obj->current_alloc_type;
- allocated_bits = describe_type_bits(sc, obj);
- typeflag(obj) = obj->previous_alloc_type;
- previous_bits = describe_type_bits(sc, obj);
- typeflag(obj) = save_typeflag;
+ x = cadr(args);
+ if (!is_null(x))
+ {
+ if (!is_pair(x))
+ method_or_bust_with_type(sc, x, sc->assoc_symbol, args, an_association_list_string, 2);
- len = safe_strlen(excl_name) +
- safe_strlen(current_bits) + safe_strlen(allocated_bits) + safe_strlen(previous_bits) +
- safe_strlen(obj->previous_alloc_func) + safe_strlen(obj->current_alloc_func) + 512;
- tmpbuf_malloc(str, len);
+ if ((is_pair(x)) && (!is_pair(car(x))))
+ return(wrong_type_argument_with_type(sc, sc->assoc_symbol, 2, x, an_association_list_string)); /* we're assuming caar below so it better exist */
+ }
- nlen = snprintf(str, len,
- "\n<%s %s,\n current: %s[%d] %s,\n previous: %s[%d] %s\n hloc: %d (%d uses), free: %s[%d], clear: %d, alloc: %s[%d]>",
- excl_name, current_bits,
- obj->current_alloc_func, obj->current_alloc_line, allocated_bits,
- obj->previous_alloc_func, obj->previous_alloc_line, previous_bits,
- heap_location(obj), obj->uses,
- obj->gc_func, obj->gc_line, obj->clear_line, obj->alloc_func, obj->alloc_line);
+ if (is_not_null(cddr(args)))
+ {
+ /* check third arg before second (trailing arg error check) */
+ eq_func = caddr(args);
- free(current_bits);
- free(allocated_bits);
- free(previous_bits);
- if (is_null(port))
- fprintf(stderr, "%p: %s\n", obj, str);
- else port_write_string(port)(sc, str, nlen, port);
- tmpbuf_free(str, len);
-}
+ if (type(eq_func) < T_GOTO)
+ method_or_bust_with_type_one_arg(sc, eq_func, sc->assoc_symbol, args, a_procedure_string);
-static s7_pointer check_null_sym(s7_scheme *sc, s7_pointer p, s7_pointer sym, int line, const char *func)
-{
- if (!p)
- {
- fprintf(stderr, "%s%s[%d]: %s unbound%s\n", BOLD_TEXT, func, line, symbol_name(sym), UNBOLD_TEXT);
- if (stop_at_error) abort();
+ if (!s7_is_aritable(sc, eq_func, 2))
+ return(wrong_type_argument_with_type(sc, sc->assoc_symbol, 3, eq_func, an_eq_func_string));
}
- return(p);
-}
-#endif
+ if (is_null(x)) return(sc->F);
-static void iterator_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
-{
- if (use_write == USE_READABLE_WRITE)
+ if (eq_func)
{
- if (iterator_is_at_end(obj))
- port_write_string(port)(sc, "(make-iterator #())", 19, port);
- else
+ /* now maybe there's a simple case */
+ if (s7_list_length(sc, x) > 0)
{
- s7_pointer seq;
- seq = iterator_sequence(obj);
- if ((is_string(seq)) && (!is_byte_vector(seq)))
+ if ((is_safe_procedure(eq_func)) &&
+ (is_c_function(eq_func)))
{
- port_write_string(port)(sc, "(make-iterator \"", 16, port);
- port_write_string(port)(sc, (char *)(string_value(seq) + iterator_position(obj)), string_length(seq) - iterator_position(obj), port);
- port_write_string(port)(sc, "\")", 2, port);
+ s7_function func;
+
+ func = c_function_call(eq_func);
+ if (func == g_is_eq) return(s7_assq(sc, car(args), x));
+ if (func == g_is_eqv) return(g_assv(sc, args));
+ set_car(sc->t2_1, car(args));
+
+ for (; is_pair(x); x = cdr(x))
+ {
+ if (is_pair(car(x)))
+ {
+ set_car(sc->t2_2, caar(x));
+ if (is_true(sc, func(sc, sc->t2_1)))
+ return(car(x));
+ /* I wonder if the assoc equality function should get the cons, not just caar?
+ */
+ }
+ else return(wrong_type_argument_with_type(sc, sc->assoc_symbol, 2, cadr(args), an_association_list_string));
+ }
+ return(sc->F);
}
- else
+
+ if ((is_closure(eq_func)) &&
+ (is_pair(closure_args(eq_func))) &&
+ (is_pair(cdr(closure_args(eq_func))))) /* not dotted arg list */
{
- if (iterator_position(obj) > 0)
- port_write_string(port)(sc, "(let ((iter (make-iterator ", 27, port);
- else port_write_string(port)(sc, "(make-iterator ", 15, port);
- object_to_port_with_circle_check(sc, iterator_sequence(obj), port, use_write, ci);
- if (iterator_position(obj) > 0)
+ s7_pointer body;
+ body = closure_body(eq_func);
+ if (is_null(cdr(body)))
{
- int nlen;
- char *str;
- str = (char *)malloc(128 * sizeof(char));
- nlen = snprintf(str, 128, "))) (do ((i 0 (+ i 1))) ((= i %lld) iter) (iterate iter)))", iterator_position(obj));
- port_write_string(port)(sc, str, nlen, port);
- free(str);
+ s7_function func;
+
+ new_frame_with_two_slots(sc, sc->envir, sc->envir, car(closure_args(eq_func)), car(args), cadr(closure_args(eq_func)), sc->F);
+ func = s7_bool_optimize(sc, body);
+ if (func)
+ {
+ s7_pointer b;
+ b = next_slot(let_slots(sc->envir));
+
+ if (func == opt_bool_any)
+ {
+ opt_info *o;
+ o = sc->opts[0];
+ for (; is_pair(x); x = cdr(x))
+ {
+ slot_set_value(b, caar(x));
+ sc->pc = 0;
+ if (o->v7.fb(o))
+ return(car(x));
+ }
+ }
+ else
+ {
+ for (; is_pair(x); x = cdr(x))
+ {
+ slot_set_value(b, caar(x));
+ if (is_true(sc, func(sc, car(body))))
+ return(car(x));
+ }
+ }
+ return(sc->F);
+ }
}
- else port_write_character(port)(sc, ')', port);
}
}
+
+ /* sc->value = sc->F; */
+ y = cons(sc, args, sc->nil);
+ set_opt_fast(y, x);
+ set_opt_slow(y, x);
+ push_stack(sc, OP_ASSOC_IF, y, eq_func);
+ push_stack(sc, OP_APPLY, list_2(sc, car(args), caar(x)), eq_func);
+ return(sc->unspecified);
}
- else
+
+ x = cadr(args);
+ obj = car(args);
+ if (is_simple(obj))
+ return(s7_assq(sc, obj, x));
+
+ y = x;
+ if (is_string(obj))
{
- const char *str;
- str = type_name(sc, iterator_sequence(obj), NO_ARTICLE);
- port_write_string(port)(sc, "#<iterator: ", 12, port);
- port_write_string(port)(sc, str, safe_strlen(str), port);
- port_write_character(port)(sc, '>', port);
+ s7_pointer val;
+ while (true)
+ {
+ if (is_pair(car(x)))
+ {
+ val = caar(x);
+ if ((val == obj) ||
+ ((is_string(val)) &&
+ (scheme_strings_are_equal(obj, val))))
+ return(car(x));
+ }
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if (is_pair(car(x)))
+ {
+ val = caar(x);
+ if ((val == obj) ||
+ ((is_string(val)) &&
+ (scheme_strings_are_equal(obj, val))))
+ return(car(x));
+ }
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F);
+ }
+
+ while (true)
+ {
+ if ((is_pair(car(x))) && (s7_is_equal(sc, obj, caar(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if ((is_pair(car(x))) && (s7_is_equal(sc, obj, caar(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
}
+ return(sc->F); /* not reached */
}
-static void baffle_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+static s7_pointer assoc_p_pp(s7_pointer p1, s7_pointer p2) {return(g_assoc(cur_sc, set_plist_2(cur_sc, p1, p2)));}
+
+
+
+/* ---------------- member, memv, memq ---------------- */
+
+s7_pointer s7_memq(s7_scheme *sc, s7_pointer obj, s7_pointer x)
{
- int nlen;
- char buf[64];
- nlen = snprintf(buf, 64, "#<baffle: %d>", baffle_key(obj));
- port_write_string(port)(sc, buf, nlen, port);
+ s7_pointer y;
+ y = x;
+ while (true)
+ {
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F);
}
-static void c_pointer_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write)
+static s7_pointer g_memq(s7_scheme *sc, s7_pointer args)
{
- int nlen;
- char buf[64];
+ s7_pointer x, y;
+ #define H_memq "(memq obj list) looks for obj in list and returns the list from that point if it is found, otherwise #f. memq uses eq?"
+ #define Q_memq pl_tl
- if (use_write == USE_READABLE_WRITE)
- nlen = snprintf(buf, 64, "(c-pointer " INT_FORMAT ")", (ptr_int)raw_pointer(obj));
- else nlen = snprintf(buf, 64, "#<c_pointer %p>", raw_pointer(obj));
- port_write_string(port)(sc, buf, nlen, port);
+ x = car(args);
+ y = cadr(args);
+ if (is_pair(y))
+ return(s7_memq(sc, x, y));
+ if (is_null(y))
+ return(sc->F);
+ method_or_bust_with_type(sc, y, sc->memq_symbol, list_2(sc, x, y), a_list_string, 2);
}
-static void rng_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write)
+/* I think (memq 'c '(a b . c)) should return #f because otherwise
+ * (memq () ...) would return the () at the end.
+ */
+
+/* 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 g_memq_3(s7_scheme *sc, s7_pointer args)
{
- int nlen;
- char buf[128];
-#if WITH_GMP
- if (use_write == USE_READABLE_WRITE)
- nlen = snprintf(buf, 128, "#<unprint-readable object>");
- else nlen = snprintf(buf, 128, "#<rng %p>", obj);
-#else
- if (use_write == USE_READABLE_WRITE)
- nlen = snprintf(buf, 128, "(random-state %llu %llu)", random_seed(obj), random_carry(obj));
- else nlen = snprintf(buf, 128, "#<rng %llu %llu>", random_seed(obj), random_carry(obj));
-#endif
- port_write_string(port)(sc, buf, nlen, port);
+ s7_pointer x, obj;
+ x = cadr(args);
+ obj = car(args);
+ while (true)
+ {
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+ }
+ return(sc->F);
}
-static void object_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+static s7_pointer g_memq_4(s7_scheme *sc, s7_pointer args)
{
- int nlen;
- char *str;
- switch (type(obj))
+ s7_pointer x, obj;
+ x = cadr(args);
+ obj = car(args);
+ while (true)
{
- case T_FLOAT_VECTOR:
- case T_INT_VECTOR:
- int_or_float_vector_to_port(sc, obj, port, use_write);
- break;
-
- case T_VECTOR:
- vector_to_port(sc, obj, port, use_write, ci);
- break;
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+ }
+ return(sc->F);
+}
- case T_PAIR:
- list_to_port(sc, obj, port, use_write, ci);
- break;
+static s7_pointer g_memq_any(s7_scheme *sc, s7_pointer args)
+{
+ /* no circular list check needed in this case */
+ s7_pointer x, obj;
+ x = cadr(args);
+ obj = car(args);
+ while (true)
+ {
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F); /* every other pair check could be omitted */
- case T_HASH_TABLE:
- hash_table_to_port(sc, obj, port, use_write, ci);
- break;
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
- case T_ITERATOR:
- iterator_to_port(sc, obj, port, use_write, ci);
- break;
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
- case T_LET:
- let_to_port(sc, obj, port, use_write, ci);
- break;
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+ }
+ return(sc->F);
+}
- case T_UNIQUE:
- /* if file has #<eof> it causes read to return #<eof> -> end of read! what is readable version? '#<eof> or (begin #<eof>) as below
- * but this is silly -- to fool read, the #<eof> has to be all by itself at the top-level!
- * and the read of #<eof> does not affect the port, so if you know it's there, just ignore #<eof> and continue reading.
- */
- if ((use_write == USE_READABLE_WRITE) &&
- (obj == sc->eof_object))
- port_write_string(port)(sc, "(begin #<eof>)", 14, port);
- else port_write_string(port)(sc, unique_name(obj), unique_name_length(obj), port);
- break;
- case T_BOOLEAN:
- case T_NIL:
- case T_UNSPECIFIED:
- port_write_string(port)(sc, unique_name(obj), unique_name_length(obj), port);
- break;
+static s7_pointer memq_car;
+static s7_pointer g_memq_car(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x, obj;
- case T_INPUT_PORT:
- input_port_to_port(sc, obj, port, use_write);
- break;
+ 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);
- case T_OUTPUT_PORT:
- output_port_to_port(sc, obj, port, use_write);
- break;
+ while (true)
+ {
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
- case T_COUNTER:
- port_write_string(port)(sc, "#<counter>", 10, port);
- break;
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+ }
+ return(sc->F);
+}
- case T_BAFFLE:
- baffle_to_port(sc, obj, port);
- break;
+static s7_pointer memq_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
+{
+ if ((is_proper_quote(sc, caddr(expr))) &&
+ (is_pair(cadr(caddr(expr)))))
+ {
+ int len;
- case T_INTEGER:
- if (has_print_name(obj))
- port_write_string(port)(sc, print_name(obj), print_name_length(obj), port);
- else
+ if ((ops) && (is_h_safe_c_s(cadr(expr))) &&
+ (c_callee(cadr(expr)) == g_car))
{
- nlen = 0;
- str = integer_to_string_base_10_no_width(obj, &nlen);
- if (nlen > 0)
- {
- set_print_name(obj, str, nlen);
- port_write_string(port)(sc, str, nlen, port);
- }
- else port_display(port)(sc, str, port);
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(memq_car);
}
- break;
- case T_REAL:
- case T_RATIO:
- case T_COMPLEX:
- if (has_print_name(obj))
- port_write_string(port)(sc, print_name(obj), print_name_length(obj), port);
- else
+ len = s7_list_length(sc, cadr(caddr(expr)));
+ if (len > 0)
{
- nlen = 0;
- str = number_to_string_base_10(obj, 0, float_format_precision, 'g', &nlen, use_write); /* was 14 */
- set_print_name(obj, str, nlen);
- port_write_string(port)(sc, str, nlen, port);
+ if ((len % 4) == 0)
+ return(memq_4);
+ if ((len % 3) == 0)
+ return(memq_3);
+ return(memq_any);
}
- break;
+ }
+ return(f);
+}
-#if WITH_GMP
- case T_BIG_INTEGER:
- case T_BIG_RATIO:
- case T_BIG_REAL:
- case T_BIG_COMPLEX:
- nlen = 0;
- str = big_number_to_string_with_radix(obj, BASE_10, 0, &nlen, use_write);
- port_write_string(port)(sc, str, nlen, port);
- free(str);
- break;
-#endif
- case T_SYMBOL:
- symbol_to_port(sc, obj, port, use_write);
- break;
+static s7_pointer memv_number(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+{
+ s7_pointer y;
+ y = x;
+ while (true)
+ {
+ if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+ if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+ if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+ if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F);
+}
- case T_SYNTAX:
- port_display(port)(sc, symbol_name(syntax_symbol(obj)), port);
- break;
- case T_STRING:
- if (is_byte_vector(obj))
- byte_vector_to_port(sc, obj, port, use_write);
- else string_to_port(sc, obj, port, use_write);
- break;
+static s7_pointer g_memv(s7_scheme *sc, s7_pointer args)
+{
+ #define H_memv "(memv obj list) looks for obj in list and returns the list from that point if it is found, otherwise #f. memv uses eqv?"
+ #define Q_memv pl_tl
+ s7_pointer x, y, z;
- case T_CHARACTER:
- if (use_write == USE_DISPLAY)
- port_write_character(port)(sc, character(obj), port);
- else port_write_string(port)(sc, character_name(obj), character_name_length(obj), port);
- break;
+ x = car(args);
+ y = cadr(args);
+ if (!is_pair(y))
+ {
+ if (is_null(y)) return(sc->F);
+ method_or_bust_with_type(sc, y, sc->memv_symbol, list_2(sc, x, y), a_list_string, 2);
+ }
- case T_CLOSURE:
- case T_CLOSURE_STAR:
- if (has_methods(obj))
- {
- /* look for object->string method else fallback on ordinary case.
- * can't use recursion on closure_let here because then the fallback name is #<let>.
- */
- s7_pointer print_func;
- print_func = find_method(sc, closure_let(obj), sc->object_to_string_symbol);
- if (print_func != sc->undefined)
- {
- s7_pointer p;
- p = s7_apply_function(sc, print_func, list_1(sc, obj));
- if (string_length(p) > 0)
- port_write_string(port)(sc, string_value(p), string_length(p), port);
- break;
- }
- }
- if (use_write == USE_READABLE_WRITE)
- write_closure_readably(sc, obj, port);
- else write_closure_name(sc, obj, port);
- break;
+ if (is_simple(x)) return(s7_memq(sc, x, y));
+ if (s7_is_number(x)) return(memv_number(sc, x, y));
- case T_MACRO:
- case T_MACRO_STAR:
- case T_BACRO:
- case T_BACRO_STAR:
- if (use_write == USE_READABLE_WRITE)
- write_macro_readably(sc, obj, port);
- else write_closure_name(sc, obj, port);
- break;
+ z = y;
+ while (true)
+ {
+ if (s7_is_eqv(x, car(y))) return(y);
+ y = cdr(y);
+ if (!is_pair(y)) return(sc->F);
- case T_C_OPT_ARGS_FUNCTION:
- case T_C_RST_ARGS_FUNCTION:
- case T_C_ANY_ARGS_FUNCTION:
- case T_C_FUNCTION:
- case T_C_FUNCTION_STAR:
- port_write_string(port)(sc, c_function_name(obj), c_function_name_length(obj), port);
- break;
+ if (s7_is_eqv(x, car(y))) return(y);
+ y = cdr(y);
+ if (!is_pair(y)) return(sc->F);
- case T_C_MACRO:
- port_write_string(port)(sc, c_macro_name(obj), c_macro_name_length(obj), port);
- break;
+ z = cdr(z);
+ if (z == y) return(sc->F);
+ }
+ return(sc->F); /* not reached */
+}
- case T_C_POINTER:
- c_pointer_to_port(sc, obj, port, use_write);
- break;
- case T_RANDOM_STATE:
- rng_to_port(sc, obj, port, use_write);
- break;
+static s7_pointer member(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+{
+ s7_pointer y;
- case T_CONTINUATION:
- if (use_write == USE_READABLE_WRITE)
- port_write_string(port)(sc, "continuation", 12, port);
- else port_write_string(port)(sc, "#<continuation>", 15, port);
- break;
+ y = x;
+ if (is_string(obj))
+ {
+ while (true)
+ {
+ if ((obj == car(x)) ||
+ ((is_string(car(x))) &&
+ (scheme_strings_are_equal(obj, car(x)))))
+ return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
- case T_GOTO:
- if (use_write == USE_READABLE_WRITE)
- port_write_string(port)(sc, "goto", 4, port);
- else port_write_string(port)(sc, "#<goto>", 7, port);
- break;
+ if ((obj == car(x)) ||
+ ((is_string(car(x))) &&
+ (scheme_strings_are_equal(obj, car(x)))))
+ return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
- case T_CATCH:
- port_write_string(port)(sc, "#<catch>", 8, port);
- break;
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F);
+ }
- case T_DYNAMIC_WIND:
- /* this can happen because (*s7* 'stack) can involve dynamic-wind markers */
- port_write_string(port)(sc, "#<dynamic-wind>", 15, port);
- break;
+ while (true)
+ {
+ if (s7_is_equal(sc, obj, car(x))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
- case T_C_OBJECT:
- 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)));
- port_display(port)(sc, str, port);
- free(str);
- break;
+ if (s7_is_equal(sc, obj, car(x))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
- case T_SLOT:
- if (use_write != USE_READABLE_WRITE)
- port_write_character(port)(sc, '\'', port);
- symbol_to_port(sc, slot_symbol(obj), port, use_write);
- port_write_character(port)(sc, ' ', port);
- object_to_port_with_circle_check(sc, slot_value(obj), port, use_write, ci);
- break;
+ if (s7_is_equal(sc, obj, car(x))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
- default:
-#if DEBUGGING
- print_debugging_state(sc, obj, port);
-#else
- {
- char *str, *tmp;
- int len;
- tmp = describe_type_bits(sc, obj);
- len = 32 + safe_strlen(tmp);
- tmpbuf_malloc(str, len);
- if (is_free(obj))
- nlen = snprintf(str, len, "<free cell! %s>", tmp);
- else nlen = snprintf(str, len, "<unknown object! %s>", tmp);
- free(tmp);
- port_write_string(port)(sc, str, nlen, port);
- tmpbuf_free(str, len);
- }
-#endif
- break;
+ if (s7_is_equal(sc, obj, car(x))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
}
+ return(sc->F); /* not reached */
}
-static void object_to_port_with_circle_check(s7_scheme *sc, s7_pointer vr, s7_pointer port, use_write_t use_write, shared_info *ci)
+static s7_pointer g_member(s7_scheme *sc, s7_pointer args)
{
- if ((ci) &&
- (has_structure(vr)))
- {
- int ref;
- ref = shared_ref(ci, vr);
- if (ref != 0)
- {
- char buf[32];
- int nlen;
- char *p;
- unsigned int len;
- if (ref > 0)
- {
- if (use_write == USE_READABLE_WRITE)
- {
- nlen = snprintf(buf, 32, "(set! {%d} ", ref);
- port_write_string(port)(sc, buf, nlen, port);
- object_to_port(sc, vr, port, USE_READABLE_WRITE, ci);
- port_write_character(port)(sc, ')', port);
- }
- else
- {
- p = pos_int_to_str((s7_int)ref, &len, '=');
- *--p = '#';
- port_write_string(port)(sc, p, len, port);
- object_to_port(sc, vr, port, DONT_USE_DISPLAY(use_write), ci);
- }
- }
- else
- {
- if (use_write == USE_READABLE_WRITE)
- {
- nlen = snprintf(buf, 32, "{%d}", -ref);
- port_write_string(port)(sc, buf, nlen, port);
- }
- else
- {
- p = pos_int_to_str((s7_int)(-ref), &len, '#');
- *--p = '#';
- port_write_string(port)(sc, p, len, port);
- }
- }
- return;
- }
- }
- object_to_port(sc, vr, port, use_write, ci);
-}
+ #define H_member "(member obj list (func #f)) looks for obj in list and returns the list from that point if it is found, otherwise #f. \
+member uses equal? If 'func' is a function of 2 arguments, it is used for the comparison instead of 'equal?"
+ #define Q_member s7_make_signature(sc, 4, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_boolean_symbol), sc->T, sc->is_list_symbol, sc->is_procedure_symbol)
+
+ /* this could be extended to accept sequences:
+ * (member #\a "123123abnfc" char=?) -> "abnfc"
+ * (member "abc" "123abc321" string=?) -> "abc321" but there's the string length complication
+ * (member 1 #(0 1 2) =) -> #(1 2) etc but what would it do for a hash-table?
+ * the third arg can be weird: (member #f (list #t) cons) -> (#t) -- cons returns '(#f . #t) which is true, so we get '(#t)
+ * should this be an error: (member '(1 2 3) () '(1 . 2)) -- the third arg is bogus, but the second is nil
+ *
+ * here as in assoc, sort, and make-hash-table we accept macros, but I can't think of a good reason to do so.
+ */
+ s7_pointer x, y, obj, eq_func = NULL;
+ x = cadr(args);
-static void setup_shared_reads(s7_scheme *sc, s7_pointer port, shared_info *ci)
-{
- int i;
- char buf[64];
+ if ((!is_pair(x)) && (!is_null(x)))
+ method_or_bust_with_type(sc, x, sc->member_symbol, args, a_list_string, 2);
- port_write_string(port)(sc, "(let (", 6, port);
- for (i = 1; i <= ci->top; i++)
+ if (is_not_null(cddr(args)))
{
- int len;
- len = snprintf(buf, 64, "({%d} #f)", i);
- port_write_string(port)(sc, buf, len, port);
- }
- port_write_string(port)(sc, ") ", 2, port);
-}
+ /* check third arg before second (trailing arg error check) */
+ eq_func = caddr(args);
-static void finish_shared_reads(s7_scheme *sc, s7_pointer port, shared_info *ci)
-{
- port_write_character(port)(sc, ')', port);
-}
+ if (type(eq_func) < T_GOTO)
+ method_or_bust_with_type(sc, eq_func, sc->member_symbol, args, a_procedure_string, 3);
-static s7_pointer object_out(s7_scheme *sc, s7_pointer obj, s7_pointer strport, use_write_t choice)
-{
- if ((has_structure(obj)) &&
- (obj != sc->rootlet))
+ if (!s7_is_aritable(sc, eq_func, 2))
+ return(wrong_type_argument_with_type(sc, sc->member_symbol, 3, eq_func, an_eq_func_string));
+ }
+
+ if (is_null(x)) return(sc->F);
+ if (eq_func)
{
- shared_info *ci;
- ci = make_shared_info(sc, obj, choice != USE_READABLE_WRITE);
- if (ci)
+ s7_pointer slow;
+
+ /* now maybe there's a simple case */
+ if ((is_safe_procedure(eq_func)) &&
+ (is_c_function(eq_func)))
{
- if (choice == USE_READABLE_WRITE)
+ s7_function func;
+ func = c_function_call(eq_func);
+ if (func == g_is_eq) return(s7_memq(sc, car(args), x));
+ if (func == g_is_eqv) return(g_memv(sc, args));
+#if (!WITH_GMP)
+ if (func == g_less) func = g_less_2;
+ if (func == g_greater) func = g_greater_2;
+#endif
+ set_car(sc->t2_1, car(args));
+
+ for (slow = x; is_pair(x); x = cdr(x), slow = cdr(slow))
{
- setup_shared_reads(sc, strport, ci);
- object_to_port_with_circle_check(sc, obj, strport, choice, ci);
- finish_shared_reads(sc, strport, ci);
+ set_car(sc->t2_2, car(x));
+ if (is_true(sc, func(sc, sc->t2_1)))
+ return(x);
+
+ if (!is_pair(cdr(x)))
+ return(sc->F);
+ x = cdr(x);
+ if (x == slow)
+ return(sc->F);
+
+ set_car(sc->t2_2, car(x));
+ if (is_true(sc, func(sc, sc->t2_1)))
+ return(x);
}
- else object_to_port_with_circle_check(sc, obj, strport, choice, ci);
- return(obj);
+ return(sc->F);
}
- }
- object_to_port(sc, obj, strport, choice, NULL);
- return(obj);
-}
-
-static s7_pointer format_ports = NULL;
+ if ((is_closure(eq_func)) &&
+ (is_pair(closure_args(eq_func))) &&
+ (is_pair(cdr(closure_args(eq_func))))) /* not dotted arg list */
+ {
+ s7_pointer body;
+ body = closure_body(eq_func);
+ if (is_null(cdr(body)))
+ {
+ s7_function func;
+
+ new_frame_with_two_slots(sc, sc->envir, sc->envir, car(closure_args(eq_func)), car(args), cadr(closure_args(eq_func)), sc->F);
+ func = s7_bool_optimize(sc, body);
-static s7_pointer open_format_port(s7_scheme *sc)
-{
- s7_pointer x;
- int len;
+ if (func)
+ {
+ s7_pointer b;
+ b = next_slot(let_slots(sc->envir));
+
+ if (func == opt_bool_any)
+ {
+ opt_info *o;
+ o = sc->opts[0];
+ for (slow = x; is_pair(x); x = cdr(x), slow = cdr(slow))
+ {
+ slot_set_value(b, car(x));
+ sc->pc = 0;
+ if (o->v7.fb(o)) return(x);
- if (format_ports)
- {
- x = format_ports;
- format_ports = (s7_pointer)(port_port(x)->next);
- port_position(x) = 0;
- port_data(x)[0] = '\0';
- return(x);
+ if (!is_pair(cdr(x))) return(sc->F);
+ x = cdr(x);
+ if (x == slow) return(sc->F);
+
+ slot_set_value(b, car(x));
+ sc->pc = 0;
+ if (o->v7.fb(o)) return(x);
+ }
+ }
+ else
+ {
+ for (slow = x; is_pair(x); x = cdr(x), slow = cdr(slow))
+ {
+ slot_set_value(b, car(x));
+ if (is_true(sc, func(sc, car(body)))) return(x);
+
+ if (!is_pair(cdr(x))) return(sc->F);
+ x = cdr(x);
+ if (x == slow) return(sc->F);
+
+ slot_set_value(b, car(x));
+ if (is_true(sc, func(sc, sc->t2_1))) return(x);
+ }
+ }
+ return(sc->F);
+ }
+ }
+ }
+
+ y = cons(sc, args, sc->nil); /* this could probably be handled with a counter cell (cdr here is unused) */
+ set_opt_fast(y, x);
+ set_opt_slow(y, x);
+ push_stack(sc, OP_MEMBER_IF, y, eq_func);
+ if (needs_copied_args(eq_func))
+ push_stack(sc, OP_APPLY, list_2(sc, car(args), car(x)), eq_func);
+ else
+ {
+ set_car(sc->t2_1, car(args));
+ set_car(sc->t2_2, car(x));
+ push_stack(sc, OP_APPLY, sc->t2_1, eq_func);
+ }
+ return(sc->unspecified);
}
- len = FORMAT_PORT_LENGTH;
- x = alloc_pointer();
- set_type(x, T_OUTPUT_PORT);
- port_port(x) = (port_t *)calloc(1, sizeof(port_t));
- port_type(x) = STRING_PORT;
- port_is_closed(x) = false;
- port_data_size(x) = len;
- port_data(x) = (unsigned char *)malloc(len * sizeof(unsigned char)); /* was +8 */
- port_data(x)[0] = '\0';
- port_position(x) = 0;
- port_needs_free(x) = false;
- port_read_character(x) = output_read_char;
- port_read_line(x) = output_read_line;
- port_display(x) = string_display;
- port_write_character(x) = string_write_char;
- port_write_string(x) = string_write_string;
- return(x);
-}
+ obj = car(args);
+ if (is_simple(obj))
+ return(s7_memq(sc, obj, x));
-static void close_format_port(s7_scheme *sc, s7_pointer port)
-{
- port_port(port)->next = (void *)format_ports;
- format_ports = port;
-}
+ /* the only things that aren't simply == here are c_object, string, number, vector, hash-table, pair, and c_pointer
+ * but all the other cases are unlikely.
+ */
+ if (s7_is_number(obj))
+ return(memv_number(sc, obj, x));
+ return(member(sc, obj, x));
+}
-static char *s7_object_to_c_string_1(s7_scheme *sc, s7_pointer obj, use_write_t use_write, int *nlen)
+static s7_pointer member_sq;
+static s7_pointer g_member_sq(s7_scheme *sc, s7_pointer args)
{
- char *str;
- s7_pointer strport;
+ s7_pointer obj, lst;
+ lst = cadadr(args);
+ obj = find_symbol_unchecked(sc, car(args));
- strport = open_format_port(sc);
- object_out(sc, obj, strport, use_write);
- if (nlen) (*nlen) = port_position(strport);
+ if (is_simple(obj))
+ return(s7_memq(sc, obj, lst));
- str = (char *)malloc((port_position(strport) + 1) * sizeof(char));
- memcpy((void *)str, (void *)port_data(strport), port_position(strport));
- str[port_position(strport)] = '\0';
- close_format_port(sc, strport);
+ if (s7_is_number(obj))
+ return(memv_number(sc, obj, lst));
- return(str);
+ return(member(sc, obj, lst));
}
-
-char *s7_object_to_c_string(s7_scheme *sc, s7_pointer obj)
+static s7_pointer member_ss;
+static s7_pointer g_member_ss(s7_scheme *sc, s7_pointer args)
{
- return(s7_object_to_c_string_1(sc, obj, USE_WRITE, NULL));
-}
-
+ s7_pointer obj, x;
-s7_pointer s7_object_to_string(s7_scheme *sc, s7_pointer obj, bool use_write) /* unavoidable backwards compatibility rigidity here */
-{
- char *str;
- int len = 0;
+ obj = find_symbol_unchecked(sc, car(args));
+ x = find_symbol_unchecked(sc, cadr(args));
+ if (!is_pair(x))
+ {
+ if (is_null(x)) return(sc->F);
+ method_or_bust_with_type(sc, x, sc->member_symbol, list_2(sc, obj, x), a_list_string, 2);
+ }
- str = s7_object_to_c_string_1(sc, obj, (use_write) ? USE_WRITE : USE_DISPLAY, &len);
- if (str)
- return(make_string_uncopied_with_length(sc, str, len));
- return(s7_make_string_with_length(sc, "", 0));
-}
+ if (is_simple(obj))
+ return(s7_memq(sc, obj, x));
+ if (s7_is_number(obj))
+ return(memv_number(sc, obj, x));
-/* -------------------------------- newline -------------------------------- */
-void s7_newline(s7_scheme *sc, s7_pointer port)
-{
- s7_write_char(sc, '\n', port);
+ return(member(sc, obj, x));
}
-static s7_pointer g_newline(s7_scheme *sc, s7_pointer args)
-{
- #define H_newline "(newline (port (current-output-port))) writes a carriage return to the port"
- #define Q_newline s7_make_signature(sc, 2, sc->is_unspecified_symbol, sc->is_output_port_symbol)
- s7_pointer port;
+static s7_pointer member_p_pp(s7_pointer p1, s7_pointer p2) {return(g_member(cur_sc, set_plist_2(cur_sc, p1, p2)));}
- if (is_not_null(args))
- port = car(args);
- else port = sc->output_port;
- if (!is_output_port(port))
+static s7_pointer member_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
+{
+ if (!ops) return(f);
+ if (args == 2)
{
- if (port == sc->F) return(sc->unspecified);
- method_or_bust_with_type(sc, port, sc->newline_symbol, args, an_output_port_string, 0);
- }
- s7_newline(sc, port);
- return(sc->unspecified);
-}
+ if (is_symbol(caddr(expr)))
+ {
+ if ((optimize_op(expr) == HOP_SAFE_C_SS) ||
+ ((is_h_safe_c_c(expr)) &&
+ (is_symbol(cadr(expr)))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(member_ss); /* (member obj lst) */
+ }
+ }
+ else
+ {
+ if ((optimize_op(expr) == HOP_SAFE_C_SQ) ||
+ ((is_h_safe_c_c(expr)) &&
+ (is_symbol(cadr(expr))) &&
+ (is_proper_quote(sc, caddr(expr))) &&
+ (is_pair(cadr(caddr(expr))))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(member_sq); /* (member q '(quote lambda case)) */
+ }
+ }
+ }
-static s7_pointer c_newline(s7_scheme *sc) {s7_newline(sc, sc->output_port); return(sc->unspecified);}
-PF_0(newline, c_newline)
+ if ((args == 3) &&
+ (is_symbol(cadddr(expr))) &&
+ (cadddr(expr) == sc->is_eq_symbol))
+ return(memq_chooser(sc, f, 2, expr, ops));
+ return(f);
+}
-/* -------------------------------- write -------------------------------- */
-void s7_write(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+
+static bool is_memq(s7_pointer sym, s7_pointer lst)
{
- if (port != sc->F)
- {
- if (port_is_closed(port))
- s7_wrong_type_arg_error(sc, "write", 2, port, "an open output port");
- object_out(sc, obj, port, USE_WRITE);
- }
+ s7_pointer x;
+ for (x = lst; is_pair(x); x = cdr(x))
+ if (sym == car(x))
+ return(true);
+ return(false);
}
-static s7_pointer g_write(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_is_provided(s7_scheme *sc, s7_pointer args)
{
- #define H_write "(write obj (port (current-output-port))) writes (object->string obj) to the output port"
- #define Q_write s7_make_signature(sc, 3, sc->T, sc->T, sc->is_output_port_symbol)
- s7_pointer port;
+ #define H_is_provided "(provided? symbol) returns #t if symbol is a member of the *features* list"
+ #define Q_is_provided s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_symbol_symbol)
+ s7_pointer sym, topf, x;
- if (is_pair(cdr(args)))
- port = cadr(args);
- else port = sc->output_port;
- if (!is_output_port(port))
+ sym = car(args);
+ if (!is_symbol(sym))
+ method_or_bust_one_arg(sc, sym, sc->is_provided_symbol, list_1(sc, sym), T_SYMBOL);
+
+ /* here the *features* list is spread out (or can be anyway) along the curlet chain,
+ * so we need to travel back all the way to the top level checking each *features* list in turn.
+ * Since *features* grows via cons (newest first), we can stop the scan if we hit the shared
+ * top-level at least.
+ */
+ topf = slot_value(global_slot(sc->features_symbol));
+ if (is_memq(sym, topf))
+ return(sc->T);
+
+ if (is_global(sc->features_symbol))
+ return(sc->F);
+ for (x = sc->envir; symbol_id(sc->features_symbol) < let_id(x); x = outlet(x));
+ for (; is_let(x); x = outlet(x))
{
- if (port == sc->F) return(car(args));
- method_or_bust_with_type(sc, port, sc->write_symbol, args, an_output_port_string, 2);
+ s7_pointer y;
+ for (y = let_slots(x); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == sc->features_symbol)
+ {
+ if ((slot_value(y) != topf) &&
+ (is_memq(sym, slot_value(y))))
+ return(sc->T);
+ }
}
- if (port_is_closed(port))
- return(s7_wrong_type_arg_error(sc, "write", 2, port, "an open output port"));
- return(object_out(sc, car(args), port, USE_WRITE));
+ return(sc->F);
}
-static s7_pointer c_write_i(s7_scheme *sc, s7_int x) {return(g_write(sc, set_plist_1(sc, make_integer(sc, x))));}
-static s7_pointer c_write_r(s7_scheme *sc, s7_double x) {return(g_write(sc, set_plist_1(sc, make_real(sc, x))));}
-static s7_pointer c_write_p(s7_scheme *sc, s7_pointer x) {return(g_write(sc, set_plist_1(sc, x)));}
-XF_TO_PF(write, c_write_i, c_write_r, c_write_p)
+bool s7_is_provided(s7_scheme *sc, const char *feature)
+{
+ return(is_memq(s7_make_symbol(sc, feature), s7_symbol_value(sc, sc->features_symbol))); /* this goes from local outward */
+}
-/* -------------------------------- display -------------------------------- */
-void s7_display(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+bool is_provided_b(s7_pointer sym)
{
- if (port != sc->F)
- {
- if (port_is_closed(port))
- s7_wrong_type_arg_error(sc, "display", 2, port, "an open output port");
- object_out(sc, obj, port, USE_DISPLAY);
- }
+ if (!is_symbol(sym))
+ simple_wrong_type_argument(cur_sc, cur_sc->is_provided_symbol, sym, T_SYMBOL);
+ return(is_memq(sym, s7_symbol_value(cur_sc, cur_sc->features_symbol)));
}
-static s7_pointer g_display(s7_scheme *sc, s7_pointer args)
+static s7_pointer c_provide(s7_scheme *sc, s7_pointer sym)
{
- #define H_display "(display obj (port (current-output-port))) prints obj"
- #define Q_display s7_make_signature(sc, 3, sc->T, sc->T, sc->is_output_port_symbol)
- s7_pointer port;
+ /* this has to be relative to the curlet: (load file env)
+ * the things loaded are only present in env, and go away with it, so should not be in the global *features* list
+ */
+ s7_pointer p, lst;
+ if (!is_symbol(sym))
+ method_or_bust_one_arg(sc, sym, sc->provide_symbol, list_1(sc, sym), T_SYMBOL);
- if (is_pair(cdr(args)))
- port = cadr(args);
- else port = sc->output_port;
- if (!is_output_port(port))
+ p = find_local_symbol(sc, sc->features_symbol, sc->envir); /* if sc->envir is nil, this returns the global slot, else local slot */
+ lst = slot_value(find_symbol(sc, sc->features_symbol)); /* in either case, we want the current *features* list */
+
+ if (p == sc->undefined)
+ make_slot_1(sc, sc->envir, sc->features_symbol, cons(sc, sym, lst));
+ else
{
- if (port == sc->F) return(car(args));
- method_or_bust_with_type(sc, port, sc->display_symbol, args, an_output_port_string, 2);
+ if (!is_memq(sym, lst))
+ slot_set_value(p, cons(sc, sym, lst));
}
- if (port_is_closed(port))
- return(s7_wrong_type_arg_error(sc, "display", 2, port, "an open output port"));
- return(object_out(sc, car(args), port, USE_DISPLAY));
-}
-
-static s7_pointer c_display(s7_scheme *sc, s7_pointer x) {return(g_display(sc, set_plist_1(sc, x)));}
-PF_TO_PF(display, c_display)
+ if (!is_slot(find_symbol(sc, sym))) /* *features* name might be the same as an existing function */
+ s7_define(sc, sc->envir, sym, sym);
+ return(sym);
+}
-/* -------------------------------- call-with-output-string -------------------------------- */
-static s7_pointer g_call_with_output_string(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_provide(s7_scheme *sc, s7_pointer args)
{
- #define H_call_with_output_string "(call-with-output-string proc) opens a string port applies proc to it, then returns the collected output"
- #define Q_call_with_output_string s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_procedure_symbol)
- s7_pointer port, proc;
+ #define H_provide "(provide symbol) adds symbol to the *features* list"
+ #define Q_provide s7_make_signature(sc, 2, sc->is_symbol_symbol, sc->is_symbol_symbol)
+ return(c_provide(sc, car(args)));
+}
- proc = car(args);
- if (is_let(proc))
- check_method(sc, proc, sc->call_with_output_string_symbol, args);
- if (!s7_is_aritable(sc, proc, 1))
- method_or_bust_with_type(sc, proc, sc->call_with_output_string_symbol, args, make_string_wrapper(sc, "a procedure of one argument (the port)"), 1);
+void s7_provide(s7_scheme *sc, const char *feature) {c_provide(sc, s7_make_symbol(sc, feature));}
- if ((is_continuation(proc)) || (is_goto(proc)))
- 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_APPLY, list_1(sc, port), proc);
- return(sc->F);
+static s7_pointer g_features_set(s7_scheme *sc, s7_pointer args)
+{
+ /* symbol_access for set/let of *features* which can only be changed via provide */
+ if (s7_is_list(sc, cadr(args)))
+ return(cadr(args));
+ return(sc->error_symbol);
}
-static s7_pointer c_call_with_output_string(s7_scheme *sc, s7_pointer x) {return(g_call_with_output_string(sc, set_plist_1(sc, x)));}
-PF_TO_PF(call_with_output_string, c_call_with_output_string)
+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));
+}
-/* -------------------------------- call-with-output-file -------------------------------- */
-static s7_pointer g_call_with_output_file(s7_scheme *sc, s7_pointer args)
+static void check_list_validity(s7_scheme *sc, const char *caller, s7_pointer lst)
{
- #define H_call_with_output_file "(call-with-output-file filename proc) opens filename and calls proc with the output port as its argument"
- #define Q_call_with_output_file pl_sf
- s7_pointer port, file, proc;
+ s7_pointer p;
+ int i;
+ for (i = 1, p = lst; is_pair(p); p = cdr(p), i++)
+ if (!s7_is_valid(sc, car(p)))
+ fprintf(stderr, "bad arg (#%d) to %s: %p\n", i, caller, car(p));
+}
- file = car(args);
- if (!is_string(file))
- method_or_bust(sc, file, sc->call_with_output_file_symbol, args, T_STRING, 1);
+s7_pointer s7_list(s7_scheme *sc, int num_values, ...)
+{
+ int i;
+ va_list ap;
+ s7_pointer p;
- proc = cadr(args);
- if (!s7_is_aritable(sc, proc, 1))
- method_or_bust_with_type(sc, proc, sc->call_with_output_file_symbol, args, make_string_wrapper(sc, "a procedure of one argument (the port)"), 2);
+ if (num_values == 0)
+ return(sc->nil);
- if ((is_continuation(proc)) || is_goto(proc))
- return(wrong_type_argument_with_type(sc, sc->call_with_output_file_symbol, 2, proc, a_normal_procedure_string));
+ sc->w = sc->nil;
+ va_start(ap, num_values);
+ for (i = 0; i < num_values; i++)
+ sc->w = cons(sc, va_arg(ap, s7_pointer), sc->w);
+ va_end(ap);
- port = s7_open_output_file(sc, string_value(file), "w");
- push_stack(sc, OP_UNWIND_OUTPUT, sc->F, port);
- push_stack(sc, OP_APPLY, list_1(sc, port), proc);
- return(sc->F);
-}
+ if (sc->safety > NO_SAFETY)
+ check_list_validity(sc, "s7_list", sc->w);
-static s7_pointer c_call_with_output_file(s7_scheme *sc, s7_pointer x) {return(g_call_with_output_file(sc, set_plist_1(sc, x)));}
-PF_TO_PF(call_with_output_file, c_call_with_output_file)
+ p = sc->w;
+ sc->w = sc->nil;
+ return(safe_reverse_in_place(sc, p));
+}
+static s7_int sequence_length(s7_scheme *sc, s7_pointer lst);
-/* -------------------------------- with-output-to-string -------------------------------- */
-static s7_pointer g_with_output_to_string(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_list_append(s7_scheme *sc, s7_pointer args)
{
- #define H_with_output_to_string "(with-output-to-string thunk) opens a string as a temporary current-output-port, calls thunk, then returns the collected output"
- #define Q_with_output_to_string s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_procedure_symbol)
- s7_pointer old_output_port, p;
+ s7_pointer y, tp, np = NULL, pp;
+ bool args_are_lists = true;
- p = car(args);
- if (!is_thunk(sc, p))
- method_or_bust_with_type(sc, p, sc->with_output_to_string_symbol, args, a_thunk_string, 1);
+ /* we know here that args is a pair and cdr(args) is a pair */
+ tp = sc->nil;
+ for (y = args; is_pair(y); y = cdr(y)) /* arglist so not dotted */
+ {
+ s7_pointer p;
+ p = car(y);
- 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);
+ check_method(sc, p, sc->append_symbol, (is_null(tp)) ? args : cons(sc, tp, y));
- push_stack(sc, OP_APPLY, sc->nil, p);
- return(sc->F);
-}
+ if (is_null(cdr(y)))
+ {
+ if (is_null(tp))
+ return(p);
+ /* (append (list 1) "hi") should return '(1 . "hi") not '(1 #\h #\i)
+ * but this is inconsistent with (append (list 1) "hi" "hi") -> '(1 #\h #\i . "hi") ?
+ * Perhaps if all args but last are lists, returned dotted list?
+ */
+#if DEBUGGING
+ if (!np) fprintf(stderr, "%s[%d]: np is null\n", __func__, __LINE__);
+#endif
+ if (args_are_lists || (is_null(p)))
+ set_cdr(np, p);
+ else
+ {
+ s7_int len;
+ len = sequence_length(sc, p);
+ if (len > 0)
+ set_cdr(np, s7_copy(sc, set_plist_2(sc, p, make_list(sc, len, sc->F))));
+ else
+ {
+ if (len < 0)
+ set_cdr(np, p);
+ }
+ }
+ sc->y = sc->nil;
+ return(tp);
+ }
-static s7_pointer c_with_output_to_string(s7_scheme *sc, s7_pointer x) {return(g_with_output_to_string(sc, set_plist_1(sc, x)));}
-PF_TO_PF(with_output_to_string, c_with_output_to_string)
+ if (!is_sequence(p))
+ return(wrong_type_argument_with_type(sc, sc->append_symbol, position_of(y, args), p, a_sequence_string));
-/* (let () (define-macro (mac) (write "123")) (with-output-to-string mac))
- * (string-ref (with-output-to-string (lambda () (write "1234") (values (get-output-string) 1))))
- */
+ if (!is_null(p))
+ {
+ if (is_pair(p))
+ {
+ if (!is_proper_list(sc, p))
+ {
+ sc->y = sc->nil;
+ return(wrong_type_argument_with_type(sc, sc->append_symbol, position_of(y, args), p, a_proper_list_string));
+ }
+ /* is this error correct?
+ * (append '(3) '(1 . 2)) -> '(3 1 . 2) ; (old) guile also returns this
+ * but (append '(1 . 2) '(3)) -> this error
+ */
+
+ if (is_null(tp))
+ {
+ tp = cons(sc, car(p), sc->nil);
+ np = tp;
+ sc->y = tp; /* GC protect? */
+ pp = cdr(p);
+ }
+ else pp = p;
+ for (; is_pair(pp); pp = cdr(pp), np = cdr(np))
+ set_cdr(np, cons(sc, car(pp), sc->nil));
+ }
+ else
+ {
+ s7_int len;
+ args_are_lists = false;
+ len = sequence_length(sc, p);
+ if (len > 0)
+ {
+ if (is_null(tp))
+ {
+ tp = s7_copy(sc, set_plist_2(sc, p, make_list(sc, len, sc->F)));
+ np = tp;
+ sc->y = tp;
+ }
+ else set_cdr(np, s7_copy(sc, set_plist_2(sc, p, make_list(sc, len, sc->F))));
+ for (; is_pair(cdr(np)); np = cdr(np));
+ }
+ else
+ {
+ if (len < 0)
+ return(wrong_type_argument_with_type(sc, sc->append_symbol, position_of(y, args), p, a_sequence_string));
+ }
+ }
+ }
+ }
+ return(tp);
+}
-/* -------------------------------- with-output-to-file -------------------------------- */
-static s7_pointer g_with_output_to_file(s7_scheme *sc, s7_pointer args)
+static s7_pointer append_in_place(s7_scheme *sc, s7_pointer a, s7_pointer b)
{
- #define H_with_output_to_file "(with-output-to-file filename thunk) opens filename as the temporary current-output-port and calls thunk"
- #define Q_with_output_to_file pl_sf
- s7_pointer old_output_port, file, proc;
-
- file = car(args);
- if (!is_string(file))
- method_or_bust(sc, file, sc->with_output_to_file_symbol, args, T_STRING, 1);
+ /* tack b onto the end of a without copying either -- 'a' is changed! */
+ s7_pointer p;
+ if (is_null(a))
+ return(b);
+ p = a;
+ while (is_not_null(cdr(p))) p = cdr(p);
+ set_cdr(p, b);
+ return(a);
+}
- proc = cadr(args);
- if (!is_thunk(sc, proc))
- method_or_bust_with_type(sc, proc, sc->with_output_to_file_symbol, args, a_thunk_string, 2);
- 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);
+/* -------------------------------- vectors -------------------------------- */
- push_stack(sc, OP_APPLY, sc->nil, proc);
- return(sc->F);
+bool s7_is_vector(s7_pointer p)
+{
+ return(t_vector_p[type(p)]);
}
-static s7_pointer c_with_output_to_file(s7_scheme *sc, s7_pointer x) {return(g_with_output_to_file(sc, set_plist_1(sc, x)));}
-PF_TO_PF(with_output_to_file, c_with_output_to_file)
-
-
-/* -------------------------------- format -------------------------------- */
-static s7_pointer format_error_1(s7_scheme *sc, s7_pointer msg, const char *str, s7_pointer args, format_data *fdat)
+bool s7_is_float_vector(s7_pointer p)
{
- s7_pointer x = NULL, ctrl_str;
- static s7_pointer format_string_1 = NULL, format_string_2, format_string_3, format_string_4;
-
- if (!format_string_1)
- {
- format_string_1 = s7_make_permanent_string("format: ~S ~{~S~^ ~}: ~A");
- format_string_2 = s7_make_permanent_string("format: ~S: ~A");
- format_string_3 = s7_make_permanent_string("format: ~S ~{~S~^ ~}~&~NT^: ~A");
- format_string_4 = s7_make_permanent_string("format: ~S~&~NT^: ~A");
- }
+ return(type(p) == T_FLOAT_VECTOR);
+}
- if (fdat->orig_str)
- ctrl_str = fdat->orig_str;
- else ctrl_str = make_string_wrapper(sc, str);
- if (fdat->loc == 0)
- {
- if (is_pair(args))
- x = set_elist_4(sc, format_string_1, ctrl_str, args, msg);
- else x = set_elist_3(sc, format_string_2, ctrl_str, msg);
- }
- else
- {
- if (is_pair(args))
- x = set_elist_5(sc, format_string_3, ctrl_str, args, make_integer(sc, fdat->loc + 20), msg);
- else x = set_elist_4(sc, format_string_4, ctrl_str, make_integer(sc, fdat->loc + 20), msg);
- }
- if (fdat->port)
- {
- close_format_port(sc, fdat->port);
- fdat->port = NULL;
- }
- return(s7_error(sc, sc->format_error_symbol, x));
+bool s7_is_int_vector(s7_pointer p)
+{
+ return(type(p) == T_INT_VECTOR);
}
-#define format_error(Sc, Msg, Str, Args, Fdat) \
- do {static s7_pointer _Err_ = NULL; if (!_Err_) _Err_ = s7_make_permanent_string(Msg); return(format_error_1(Sc, _Err_, Str, Args, Fdat));} while (0)
-
-#define just_format_error(Sc, Msg, Str, Args, Fdat) \
- do {static s7_pointer _Err_ = NULL; if (!_Err_) _Err_ = s7_make_permanent_string(Msg); format_error_1(Sc, _Err_, Str, Args, Fdat);} while (0)
-static void format_append_char(s7_scheme *sc, format_data *fdat, char c, s7_pointer port)
+static s7_pointer default_vector_setter(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val)
{
- port_write_character(port)(sc, c, port);
- sc->format_column++;
-
- /* if c is #\null, is this the right thing to do?
- * We used to return "1 2 3 4" because ~C was first turned into a string (empty in this case)
- * (format #f "1 2~C3 4" #\null)
- * "1 2"
- * Clisp does this:
- * (format nil "1 2~C3 4" (int-char 0))
- * "1 23 4"
- * whereas sbcl says int-char is undefined, and
- * Guile returns "1 2\x003 4"
- */
+ vector_element(vec, loc) = val;
+ return(val);
}
-static void format_append_newline(s7_scheme *sc, format_data *fdat, s7_pointer port)
+static s7_pointer default_vector_getter(s7_scheme *sc, s7_pointer vec, s7_int loc)
{
- port_write_character(port)(sc, '\n', port);
- sc->format_column = 0;
+ return(vector_element(vec, loc));
}
-
-static void format_append_string(s7_scheme *sc, format_data *fdat, const char *str, int len, s7_pointer port)
+static s7_pointer int_vector_setter(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val)
{
- port_write_string(port)(sc, str, len, port);
- fdat->loc += len;
- sc->format_column += len;
+ if (!s7_is_integer(val))
+ s7_wrong_type_arg_error(sc, "int_vector_set!", 3, val, "an integer");
+ int_vector_element(vec, loc) = s7_integer(val);
+ return(val);
}
-static void format_append_chars(s7_scheme *sc, format_data *fdat, char pad, int chars, s7_pointer port)
+static s7_pointer int_vector_getter(s7_scheme *sc, s7_pointer vec, s7_int loc)
{
- if (chars > 0)
- {
- if (chars < TMPBUF_SIZE)
- {
- int j;
- for (j = 0; j < chars; j++)
- sc->tmpbuf[j] = pad;
- sc->tmpbuf[chars] = '\0';
- format_append_string(sc, fdat, sc->tmpbuf, chars, port);
- }
- else
- {
- int j;
- for (j = 0; j < chars; j++)
- format_append_char(sc, fdat, pad, port);
- }
- }
+ return(make_integer(sc, int_vector_element(vec, loc)));
}
-
-static int format_read_integer(s7_scheme *sc, int *cur_i, int str_len, const char *str, s7_pointer args, format_data *fdat)
+static s7_pointer float_vector_setter(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val)
{
- /* we know that str[*cur_i] is a digit */
- int i, lval = 0;
- for (i = *cur_i; i < str_len - 1; i++)
- {
- int dig;
- dig = digits[(unsigned char)str[i]];
- if (dig < 10)
- {
-#if HAVE_OVERFLOW_CHECKS
- if ((int_multiply_overflow(lval, 10, &lval)) ||
- (int_add_overflow(lval, dig, &lval)))
- break;
-#else
- lval = dig + (lval * 10);
-#endif
- }
- else break;
- }
+ float_vector_element(vec, loc) = real_to_double(sc, val, "float-vector-set!");
+ return(val);
+}
- if (i >= str_len)
- just_format_error(sc, "numeric argument, but no directive!", str, args, fdat);
- *cur_i = i;
- return(lval);
+static s7_pointer float_vector_getter(s7_scheme *sc, s7_pointer vec, s7_int loc)
+{
+ return(make_real(sc, float_vector_element(vec, loc)));
}
-static void format_number(s7_scheme *sc, format_data *fdat, int radix, int width, int precision, char float_choice, char pad, s7_pointer port)
+static s7_pointer make_vector_1(s7_scheme *sc, s7_int len, bool filled, unsigned int typ)
{
- char *tmp;
- int nlen = 0;
- if (width < 0) width = 0;
+ s7_pointer x;
+ if (len < 0)
+ return(wrong_type_argument_with_type(sc, sc->make_vector_symbol, 1, make_integer(sc, len), a_non_negative_integer_string));
+ if (len > sc->max_vector_length)
+ return(out_of_range(sc, sc->make_vector_symbol, small_int(1), make_integer(sc, len), its_too_large_string));
- /* precision choice depends on float_choice if it's -1 */
- if (precision < 0)
+ /* this has to follow the error checks! (else garbage in free_heap temps portion confuses GC when "vector" is finalized) */
+ new_cell(sc, x, typ | T_SAFE_PROCEDURE); /* (v 0) as vector-ref is safe */
+ vector_length(x) = 0;
+ vector_elements(x) = NULL;
+ vector_dimension_info(x) = NULL;
+
+ if (len > 0)
{
- if ((float_choice == 'e') ||
- (float_choice == 'f') ||
- (float_choice == 'g'))
- precision = 6;
+ vector_length(x) = len;
+ if (typ == T_VECTOR)
+ {
+ vector_elements(x) = (s7_pointer *)malloc(len * sizeof(s7_pointer));
+ if (!vector_elements(x))
+ return(s7_error(sc, make_symbol(sc, "out-of-memory"), set_elist_1(sc, make_string_wrapper(sc, "make-vector allocation failed!"))));
+ vector_getter(x) = default_vector_getter;
+ vector_setter(x) = default_vector_setter;
+ if (filled) s7_vector_fill(sc, x, sc->nil); /* make_hash_table assumes nil as the default value */
+ }
else
{
- /* in the "int" cases, precision depends on the arg type */
- switch (type(car(fdat->args)))
+ if (typ == T_FLOAT_VECTOR)
{
- case T_INTEGER:
- case T_RATIO:
- precision = 0;
- break;
-
- default:
- precision = 6;
- break;
+ if (filled)
+ float_vector_elements(x) = (s7_double *)calloc(len, sizeof(s7_double));
+ else float_vector_elements(x) = (s7_double *)malloc(len * sizeof(s7_double));
+ if (!float_vector_elements(x))
+ return(s7_error(sc, make_symbol(sc, "out-of-memory"), set_elist_1(sc, make_string_wrapper(sc, "make-float-vector allocation failed!"))));
+ vector_getter(x) = float_vector_getter;
+ vector_setter(x) = float_vector_setter;
}
- }
- }
- /* should (format #f "~F" 1/3) return "1/3"?? in CL it's "0.33333334" */
-
- tmp = number_to_string_with_radix(sc, car(fdat->args), radix, width, precision, float_choice, &nlen);
- if (pad != ' ')
- {
- char *padtmp;
- padtmp = tmp;
- while (*padtmp == ' ') (*(padtmp++)) = pad;
+ else
+ {
+ if (filled)
+ int_vector_elements(x) = (s7_int *)calloc(len, sizeof(s7_int));
+ else int_vector_elements(x) = (s7_int *)malloc(len * sizeof(s7_int));
+ if (!int_vector_elements(x))
+ return(s7_error(sc, make_symbol(sc, "out-of-memory"), set_elist_1(sc, make_string_wrapper(sc, "make-int-vector allocation failed!"))));
+ vector_getter(x) = int_vector_getter;
+ vector_setter(x) = int_vector_setter;
+ }
+ }
}
- format_append_string(sc, fdat, tmp, nlen, port);
- free(tmp);
- fdat->args = cdr(fdat->args);
- fdat->ctr++;
+ Add_Vector(x);
+ return(x);
}
-static int format_nesting(const char *str, char opener, char closer, int start, int end) /* start=i, end=str_len-1 */
+s7_pointer s7_make_vector(s7_scheme *sc, s7_int len)
{
- int k, nesting = 1;
- for (k = start + 2; k < end; k++)
- if (str[k] == '~')
- {
- if (str[k + 1] == closer)
- {
- nesting--;
- if (nesting == 0)
- return(k - start - 1);
- }
- else
- {
- if (str[k + 1] == opener)
- nesting++;
- }
- }
- return(-1);
+ return(make_vector_1(sc, len, FILLED, T_VECTOR));
}
-static bool format_method(s7_scheme *sc, const char *str, format_data *fdat, s7_pointer port)
+static vdims_t *make_wrap_only(s7_scheme *sc)
{
- s7_pointer obj, func;
-
- obj = car(fdat->args);
- if ((has_methods(obj)) &&
- ((func = find_method(sc, find_let(sc, obj), sc->format_symbol)) != sc->undefined))
- {
- s7_pointer ctrl_str;
- if (fdat->orig_str)
- ctrl_str = fdat->orig_str;
- else ctrl_str = make_string_wrapper(sc, str);
-
- obj = s7_apply_function(sc, func, cons(sc, ctrl_str, fdat->args));
- if (is_string(obj))
- {
- format_append_string(sc, fdat, string_value(obj), string_length(obj), port);
- fdat->args = cdr(fdat->args);
- fdat->ctr++;
- return(true);
- }
- }
- return(false);
+ vdims_t *v;
+ v = (vdims_t *)malloc(sizeof(vdims_t));
+ v->original = sc->F;
+ v->elements_allocated = false;
+ v->ndims = 1;
+ v->dimensions_allocated = false;
+ v->dims = NULL;
+ v->offsets = NULL;
+ return(v);
}
+#define make_vdims(Sc, Alloc, Dims, Info) ((((Dims) == 1) && (!(Alloc))) ? sc->wrap_only : make_vdims_1(Sc, Alloc, Dims, Info))
-#define MAX_FORMAT_NUMERIC_ARG 10000
-static int format_n_arg(s7_scheme *sc, const char *str, int str_len, format_data *fdat, s7_pointer args)
+static vdims_t *make_vdims_1(s7_scheme *sc, bool elements_allocated, int dims, s7_int *dim_info)
{
- int n;
+ vdims_t *v;
- if (is_null(fdat->args)) /* (format #f "~nT") */
- 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));
+ v = (vdims_t *)malloc(sizeof(vdims_t));
+ v->original = sc->F;
+ v->elements_allocated = elements_allocated;
+ v->ndims = dims;
+ if (dims > 1)
+ {
+ int i;
+ s7_int offset = 1;
+ v->dimensions_allocated = true;
+ v->dims = (s7_int *)malloc(v->ndims * sizeof(s7_int));
+ v->offsets = (s7_int *)malloc(v->ndims * sizeof(s7_int));
- if (n < 0)
- just_format_error(sc, "~~N value is negative?", str, args, fdat);
+ for (i = 0; i < dims; i++)
+ v->dims[i] = dim_info[i];
+ for (i = v->ndims - 1; i >= 0; i--)
+ {
+ v->offsets[i] = offset;
+ offset *= v->dims[i];
+ }
+ }
else
{
- if (n > MAX_FORMAT_NUMERIC_ARG)
- just_format_error(sc, "~~N value is too big", str, args, fdat);
+ v->dimensions_allocated = false;
+ v->dims = NULL;
+ v->offsets = NULL;
}
-
- fdat->args = cdr(fdat->args); /* I don't think fdat->ctr should be incremented here -- it's for *vector-print-length* etc */
- return(n);
+ return(v);
}
-static int format_numeric_arg(s7_scheme *sc, const char *str, int str_len, format_data *fdat, s7_pointer args, int *i)
+s7_pointer s7_make_int_vector(s7_scheme *sc, s7_int len, int dims, s7_int *dim_info)
{
- int width;
- width = format_read_integer(sc, i, str_len, str, args, fdat);
- if (width < 0)
- just_format_error(sc, "width value is negative?", str, fdat->args, fdat);
- else
- {
- if (width > MAX_FORMAT_NUMERIC_ARG)
- just_format_error(sc, "width value is too big", str, fdat->args, fdat);
- }
- return(width);
+ s7_pointer p;
+ p = make_vector_1(sc, len, FILLED, T_INT_VECTOR);
+ if (dim_info)
+ vector_dimension_info(p) = make_vdims(sc, true, dims, dim_info);
+ return(p);
}
-#if WITH_GMP
-static bool s7_is_one_or_big_one(s7_pointer p);
-#else
-#define s7_is_one_or_big_one(Num) s7_is_one(Num)
-#endif
+s7_pointer s7_make_float_vector(s7_scheme *sc, s7_int len, int dims, s7_int *dim_info)
+{
+ s7_pointer p;
+ p = make_vector_1(sc, len, FILLED, T_FLOAT_VECTOR);
+ if (dim_info)
+ vector_dimension_info(p) = make_vdims(sc, true, dims, dim_info);
+ return(p);
+}
-static s7_pointer object_to_list(s7_scheme *sc, s7_pointer obj);
-static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *str, s7_pointer args,
- s7_pointer *next_arg, bool with_result, bool columnized, int len, s7_pointer orig_str)
+s7_pointer s7_make_float_vector_wrapper(s7_scheme *sc, s7_int len, s7_double *data, int dims, s7_int *dim_info, bool free_data)
{
- int i, str_len;
- format_data *fdat;
- s7_pointer deferred_port;
-
- if ((!with_result) &&
- (port == sc->F))
- return(sc->F);
+ /* this wraps up a C-allocated/freed double array as an s7 vector.
+ */
+ s7_pointer x;
- if (len <= 0)
+ new_cell(sc, x, T_FLOAT_VECTOR | T_SAFE_PROCEDURE);
+ float_vector_elements(x) = data;
+ vector_getter(x) = float_vector_getter;
+ vector_setter(x) = float_vector_setter;
+ vector_length(x) = len;
+ if (!dim_info)
{
- str_len = safe_strlen(str);
- if (str_len == 0)
+ if (!free_data) /* here we need the dim info to tell the GC to leave the data alone */
{
- if (is_not_null(args))
- {
- static s7_pointer null_err = NULL;
- if (!null_err)
- null_err = s7_make_permanent_string("format control string is null, but there are arguments: ~S");
- return(s7_error(sc, sc->format_error_symbol, set_elist_2(sc, null_err, args)));
- }
- if (with_result)
- return(make_string_wrapper_with_length(sc, "", 0));
- return(sc->F);
+ s7_int di[1];
+ di[0] = len;
+ vector_dimension_info(x) = make_vdims(sc, free_data, 1, di);
}
+ else vector_dimension_info(x) = NULL;
}
- else str_len = len;
+ else vector_dimension_info(x) = make_vdims(sc, free_data, dims, dim_info);
+ Add_Vector(x);
+ return(x);
+}
- sc->format_depth++;
- if (sc->format_depth >= sc->num_fdats)
- {
- int k, new_num_fdats;
- new_num_fdats = sc->format_depth * 2;
- sc->fdats = (format_data **)realloc(sc->fdats, sizeof(format_data *) * new_num_fdats);
- for (k = sc->num_fdats; k < new_num_fdats; k++) sc->fdats[k] = NULL;
- sc->num_fdats = new_num_fdats;
- }
- fdat = sc->fdats[sc->format_depth];
- if (!fdat)
- {
- fdat = (format_data *)malloc(sizeof(format_data));
- sc->fdats[sc->format_depth] = fdat;
- fdat->curly_len = 0;
- fdat->curly_str = NULL;
- fdat->ctr = 0;
- }
- else
- {
- if (fdat->port)
- close_format_port(sc, fdat->port);
- if (fdat->strport)
- close_format_port(sc, fdat->strport);
- }
- fdat->port = NULL;
- fdat->strport = NULL;
- fdat->loc = 0;
- fdat->args = args;
- fdat->orig_str = orig_str;
- fdat->curly_arg = sc->nil;
+s7_int s7_print_length(s7_scheme *sc) {return(sc->print_length);}
+s7_int s7_set_print_length(s7_scheme *sc, s7_int new_len)
+{
+ s7_int old_len;
+ old_len = sc->print_length;
+ sc->print_length = new_len;
+ return(old_len);
+}
- /* choose whether to write to a temporary string port, or simply use the in-coming port
- * if with_result, returned string is wanted.
- * if port is sc->F, no non-string result is wanted.
- * if port is not boolean, it better be a port.
- * if we are about to goto START in eval, and main_stack_op(Sc) == OP_BEGIN1, no return string is wanted -- yow, this is not true
- */
- if (with_result)
- {
- deferred_port = port;
- port = open_format_port(sc);
- fdat->port = port;
- }
- else deferred_port = sc->F;
+#if (!WITH_GMP)
+void s7_vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj)
+#else
+static void vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj)
+#endif
+{
+ s7_int len, i, left;
- for (i = 0; i < str_len - 1; i++)
+ len = vector_length(vec);
+ if (len == 0) return;
+ left = len - 8;
+ i = 0;
+
+ switch (type(vec))
{
- if ((unsigned char)(str[i]) == (unsigned char)'~') /* what does MS C want? */
+ case T_FLOAT_VECTOR:
+ if (!s7_is_real(obj))
+ s7_wrong_type_arg_error(sc, "(float) vector-fill!", 2, obj, "a real");
+ else
{
- use_write_t use_write;
- switch (str[i + 1])
+ s7_double x;
+ x = real_to_double(sc, obj, "vector-fill!");
+ if (x == 0.0)
+ memclr((void *)float_vector_elements(vec), len * sizeof(s7_double));
+ else
{
- case '%': /* -------- newline -------- */
- /* sbcl apparently accepts numeric args here (including 0) */
-
- if ((port_data(port)) &&
- (port_position(port) < port_data_size(port)))
- {
- port_data(port)[port_position(port)++] = '\n';
- /* which is actually a bad idea, but as a desperate stopgap, I simply padded
- * the string port string with 8 chars that are not in the length.
- */
- sc->format_column = 0;
- }
- else format_append_newline(sc, fdat, port);
- i++;
- break;
-
- case '&': /* -------- conditional newline -------- */
- /* this only works if all output goes through format -- display/write for example do not update format_column */
- if (sc->format_column > 0)
- format_append_newline(sc, fdat, port);
- i++;
- break;
-
- case '~': /* -------- tilde -------- */
- format_append_char(sc, fdat, '~', port);
- i++;
- break;
-
- case '\n': /* -------- trim white-space -------- */
- for (i = i + 2; i <str_len - 1; i++)
- if (!(white_space[(unsigned char)(str[i])]))
- {
- i--;
- break;
- }
- break;
-
- case '*': /* -------- ignore arg -------- */
- i++;
- if (is_null(fdat->args)) /* (format #f "~*~A") */
- format_error(sc, "can't skip argument!", str, args, fdat);
- fdat->args = cdr(fdat->args);
- break;
-
- case '|': /* -------- exit if args nil or ctr > (*s7* 'print-length) -------- */
- if ((is_pair(fdat->args)) &&
- (fdat->ctr >= sc->print_length))
+ s7_double *orig;
+ orig = float_vector_elements(vec);
+ while (i <= left)
{
- format_append_string(sc, fdat, " ...", 4, port);
- fdat->args = sc->nil;
+ orig[i++] = x;
+ orig[i++] = x;
+ orig[i++] = x;
+ orig[i++] = x;
+ orig[i++] = x;
+ orig[i++] = x;
+ orig[i++] = x;
+ orig[i++] = x;
}
- /* fall through */
+ for (; i < len; i++)
+ orig[i] = x;
+ }
+ }
+ break;
- case '^': /* -------- exit -------- */
- if (is_null(fdat->args))
+ 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");
+ else
+ {
+ s7_int k;
+ k = s7_integer(obj);
+ if (k == 0)
+ memclr((void *)int_vector_elements(vec), len * sizeof(s7_int));
+ else
+ {
+ s7_int* orig;
+ orig = int_vector_elements(vec);
+ while (i <= left)
{
- i = str_len;
- goto ALL_DONE;
+ orig[i++] = k;
+ orig[i++] = k;
+ orig[i++] = k;
+ orig[i++] = k;
+ orig[i++] = k;
+ orig[i++] = k;
+ orig[i++] = k;
+ orig[i++] = k;
}
- i++;
- break;
-
- case '@': /* -------- plural, 'y' or 'ies' -------- */
- i += 2;
- if ((str[i] != 'P') && (str[i] != 'p'))
- format_error(sc, "unknown '@' directive", 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);
-
- if (!s7_is_one_or_big_one(car(fdat->args)))
- format_append_string(sc, fdat, "ies", 3, port);
- else format_append_char(sc, fdat, 'y', port);
-
- fdat->args = cdr(fdat->args);
- break;
-
- case 'P': case 'p': /* -------- plural in 's' -------- */
- 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)))
- format_append_char(sc, fdat, 's', port);
- i++;
- fdat->args = cdr(fdat->args);
- break;
-
- case '{': /* -------- iteration -------- */
- {
- int curly_len;
-
- if (is_null(fdat->args))
- format_error(sc, "missing argument", str, args, fdat);
+ for (; i < len; i++)
+ orig[i] = k;
+ }
+ }
+ break;
- curly_len = format_nesting(str, '{', '}', i, str_len - 1);
+ default:
+ {
+ s7_pointer *orig;
+ orig = vector_elements(vec);
+ while (i <= left)
+ {
+ orig[i++] = obj;
+ orig[i++] = obj;
+ orig[i++] = obj;
+ orig[i++] = obj;
+ orig[i++] = obj;
+ orig[i++] = obj;
+ orig[i++] = obj;
+ orig[i++] = obj;
+ }
+ for (; i < len; i++)
+ orig[i] = obj;
+ }
+ }
+}
- if (curly_len == -1)
- format_error(sc, "'{' directive, but no matching '}'", str, args, fdat);
- if (curly_len == 1)
- format_error(sc, "~{~}' doesn't consume any arguments!", str, args, fdat);
- /* what about cons's here? I can't see any way in CL either to specify the car or cdr of a cons within the format string
- * (cons 1 2) is applicable: ((cons 1 2) 0) -> 1
- * also there can be applicable objects that won't work in the map context (arg not integer etc)
- */
- if (is_not_null(car(fdat->args))) /* (format #f "~{~A ~}" ()) -> "" */
- {
- s7_pointer curly_arg;
- 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 ~}" #()) -> "" */
- {
- char *curly_str = NULL; /* this is the local (nested) format control string */
- s7_pointer orig_arg;
+static s7_pointer g_vector_fill(s7_scheme *sc, s7_pointer args)
+{
+ #define H_vector_fill "(vector-fill! v val start end) sets all elements of the vector v between start and end to val"
+ #define Q_vector_fill s7_make_circular_signature(sc, 3, 4, sc->T, sc->is_vector_symbol, sc->T, sc->is_integer_symbol)
- if (!is_proper_list(sc, curly_arg))
- format_error(sc, "'{' directive argument should be a proper list or something we can turn into a list", str, args, fdat);
-
- fdat->curly_arg = curly_arg;
- if (curly_arg != car(fdat->args))
- orig_arg = curly_arg;
- else orig_arg = sc->nil;
+ s7_pointer x, fill;
+ s7_int start = 0, end;
- if (curly_len > fdat->curly_len)
- {
- if (fdat->curly_str) free (fdat->curly_str);
- fdat->curly_len = curly_len;
- fdat->curly_str = (char *)malloc(curly_len * sizeof(char));
- }
- curly_str = fdat->curly_str;
- memcpy((void *)curly_str, (void *)(str + i + 2), curly_len - 1);
- curly_str[curly_len - 1] = '\0';
+ x = car(args);
+ if (!s7_is_vector(x))
+ {
+ check_method(sc, x, sc->vector_fill_symbol, args);
+ /* not two_methods (and fill!) here else we get stuff like:
+ * (let ((e (openlet (inlet 'fill! (lambda (obj val) (string-fill! (obj 'value) val)) 'value "01234")))) (vector-fill! e #\a) (e 'value)) -> "aaaaa"
+ */
+ return(wrong_type_argument(sc, sc->vector_fill_symbol, 1, x, T_VECTOR));
+ }
- if ((sc->format_depth < sc->num_fdats - 1) &&
- (sc->fdats[sc->format_depth + 1]))
- sc->fdats[sc->format_depth + 1]->ctr = 0;
-
- /* it's not easy to use an iterator here instead of a list (so object->list isn't needed above),
- * because the curly brackets may enclose multiple arguments -- we would need to use
- * iterators throughout this function.
- */
- while (is_not_null(curly_arg))
- {
- s7_pointer new_arg = sc->nil;
- format_to_port_1(sc, port, curly_str, curly_arg, &new_arg, false, columnized, curly_len - 1, NULL);
- if (curly_arg == new_arg)
- {
- fdat->curly_arg = sc->nil;
- format_error(sc, "'{...}' doesn't consume any arguments!", str, args, fdat);
- }
- curly_arg = new_arg;
- }
- fdat->curly_arg = sc->nil;
- while (is_pair(orig_arg))
- {
- s7_pointer p;
- p = orig_arg;
- orig_arg = cdr(orig_arg);
- free_cell(sc, p); /* if car(fdar->args) is a hash-table, we could also free_cell(car(p)), but not in any other case */
- }
- }
- }
+ if ((sc->safety > NO_SAFETY) &&
+ (is_immutable_vector(x)))
+ return(s7_error(sc, sc->error_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't fill! ~S (it is immutable)"), x)));
- i += (curly_len + 2); /* jump past the ending '}' too */
- fdat->args = cdr(fdat->args);
- fdat->ctr++;
- }
- break;
+ fill = cadr(args);
+ if (is_float_vector(x))
+ {
+ if (!s7_is_real(fill)) /* possibly a bignum */
+ {
+ check_two_methods(sc, fill, sc->vector_fill_symbol, sc->fill_symbol, args);
+ s7_wrong_type_arg_error(sc, "(float) vector-fill!", 2, fill, "a real");
+ }
+ }
+ else
+ {
+ if (is_int_vector(x))
+ {
+ 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");
+ }
+ }
+ }
- case '}':
- format_error(sc, "unmatched '}'", str, args, fdat);
+ end = vector_length(x);
+ if (!is_null(cddr(args)))
+ {
+ s7_pointer p;
+ p = start_and_end(sc, sc->vector_fill_symbol, sc->fill_symbol, cddr(args), args, 3, &start, &end);
+ if (p != sc->gc_nil) return(p);
+ if (start == end) return(fill);
+ }
+ if (end == 0) return(fill);
- case 'W': case 'w':
- use_write = USE_READABLE_WRITE;
- goto OBJSTR;
+ if ((start == 0) && (end == vector_length(x)))
+ s7_vector_fill(sc, x, fill);
+ else
+ {
+ s7_int i;
+ if (is_normal_vector(x))
+ {
+ for (i = start; i < end; i++)
+ vector_element(x, i) = fill;
+ }
+ else
+ {
+ if (is_int_vector(x))
+ {
+ s7_int k;
+ k = s7_integer(fill);
+ if (k == 0)
+ memclr((void *)(int_vector_elements(x) + start), (end - start) * sizeof(s7_int));
+ else
+ {
+ for (i = start; i < end; i++)
+ int_vector_element(x, i) = k;
+ }
+ }
+ else
+ {
+ if (is_float_vector(x))
+ {
+ s7_double y;
+ y = real_to_double(sc, fill, "vector-fill!");
+ if (y == 0.0)
+ memclr((void *)(float_vector_elements(x) + start), (end - start) * sizeof(s7_double));
+ else
+ {
+ s7_double *orig;
+ s7_int left;
+ orig = float_vector_elements(x);
+ left = end - 8;
+ i = start;
+ while (i <= left)
+ {
+ orig[i++] = y;
+ orig[i++] = y;
+ orig[i++] = y;
+ orig[i++] = y;
+ orig[i++] = y;
+ orig[i++] = y;
+ orig[i++] = y;
+ orig[i++] = y;
+ }
+ for (; i < end; i++)
+ orig[i] = y;
+ }
+ }
+ }
+ }
+ }
+ return(fill);
+}
- case 'S': case 's':
- use_write = USE_WRITE;
- goto OBJSTR;
- case 'A': case 'a':
- use_write = USE_DISPLAY;
- OBJSTR:
- /* object->string */
- {
- s7_pointer obj, strport;
- if (is_null(fdat->args))
- format_error(sc, "missing argument", str, args, fdat);
+s7_pointer s7_vector_ref(s7_scheme *sc, s7_pointer vec, s7_int index)
+{
+ if (index >= vector_length(vec))
+ return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), make_integer(sc, index), its_too_large_string));
- i++;
- obj = car(fdat->args);
- /* for the column check, we need to know the length of the object->string output */
- if (columnized)
- {
- strport = open_format_port(sc);
- fdat->strport = strport;
- }
- else strport = port;
- object_out(sc, obj, strport, use_write);
- if (columnized)
- {
- if (port_position(strport) >= port_data_size(strport))
- resize_port_data(strport, port_data_size(strport) * 2);
-
- port_data(strport)[port_position(strport)] = '\0';
- if (port_position(strport) > 0)
- format_append_string(sc, fdat, (const char *)port_data(strport), port_position(strport), port);
- close_format_port(sc, strport);
- fdat->strport = NULL;
- }
+ return(vector_getter(vec)(sc, vec, index));
+}
- fdat->args = cdr(fdat->args);
- fdat->ctr++;
- }
- break;
+s7_pointer s7_vector_set(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer a)
+{
+ if (index >= vector_length(vec))
+ return(out_of_range(sc, sc->vector_set_symbol, small_int(2), make_integer(sc, index), its_too_large_string));
- /* -------- numeric args -------- */
- case '0': case '1': case '2': case '3': case '4': case '5':
- case '6': case '7': case '8': case '9': case ',':
- case 'N': case 'n':
+ vector_setter(vec)(sc, vec, index, _NFre(a));
+ return(a);
+}
- case 'B': case 'b':
- case 'D': case 'd':
- case 'E': case 'e':
- case 'F': case 'f':
- case 'G': case 'g':
- case 'O': case 'o':
- case 'X': case 'x':
- case 'T': case 't':
- case 'C': case 'c':
- {
- int width = -1, precision = -1;
- char pad = ' ';
- i++; /* str[i] == '~' */
+s7_pointer *s7_vector_elements(s7_pointer vec) {return(vector_elements(vec));}
+s7_int *s7_int_vector_elements(s7_pointer vec) {return(int_vector_elements(vec));}
+s7_double *s7_float_vector_elements(s7_pointer vec) {return(float_vector_elements(vec));}
- if (isdigit((int)(str[i])))
- width = format_numeric_arg(sc, str, str_len, fdat, args, &i);
- else
- {
- if ((str[i] == 'N') || (str[i] == 'n'))
- {
- i++;
- width = format_n_arg(sc, str, str_len, fdat, args);
- }
- }
- if (str[i] == ',')
- {
- i++; /* is (format #f "~12,12D" 1) an error? The precision has no use here. */
- if (isdigit((int)(str[i])))
- precision = format_numeric_arg(sc, str, str_len, fdat, args, &i);
- else
- {
- if ((str[i] == 'N') || (str[i] == 'n'))
- {
- i++;
- precision = format_n_arg(sc, str, str_len, fdat, args);
- }
- else
- {
- if (str[i] == '\'') /* (format #f "~12,'xD" 1) -> "xxxxxxxxxxx1" */
- {
- pad = str[i + 1];
- i += 2;
- if (i >= str_len) /* (format #f "~,'") */
- format_error(sc, "incomplete numeric argument", str, args, fdat);
- }
- /* is (let ((str "~12,'xD")) (set! (str 5) #\null) (format #f str 1)) an error? */
- }
- }
- }
- switch (str[i])
- {
- /* -------- pad to column --------
- * are columns numbered from 1 or 0? there seems to be disagreement about this directive
- * does "space over to" mean including?
- */
+s7_int *s7_vector_dimensions(s7_pointer vec)
+{
+ static s7_int *dims = NULL;
+ if (vector_dimension_info(vec))
+ return(vector_dimensions(vec));
+ if (!dims) dims = (s7_int *)malloc(sizeof(s7_int));
+ dims[0] = vector_length(vec);
+ return(dims);
+}
- case 'T': case 't':
- if (width == -1) width = 0;
- if (precision == -1) precision = 0;
- if ((width > 0) || (precision > 0)) /* (format #f "a~8Tb") */
- {
- /* (length (substring (format #f "~%~10T.") 1)) == (length (format #f "~10T."))
- * (length (substring (format #f "~%-~10T.~%") 1)) == (length (format #f "-~10T.~%"))
- */
- if (precision > 0)
- {
- int mult;
- mult = (int)(ceil((s7_double)(sc->format_column + 1 - width) / (s7_double)precision)); /* CLtL2 ("least positive int") */
- if (mult < 1) mult = 1;
- width += (precision * mult);
- }
- format_append_chars(sc, fdat, pad, width - sc->format_column - 1, port);
- }
- break;
- case 'C': case 'c':
- {
- s7_pointer obj;
+s7_int *s7_vector_offsets(s7_pointer vec)
+{
+ static s7_int *offs = NULL;
+ if (vector_dimension_info(vec))
+ return(vector_offsets(vec));
+ if (!offs) offs = (s7_int *)malloc(sizeof(s7_int));
+ offs[0] = 1;
+ return(offs);
+}
- if (is_null(fdat->args))
- format_error(sc, "~~C: missing argument", str, args, fdat);
- /* the "~~" here and below protects against "~C" being treated as a directive */
- /* i++; */
- obj = car(fdat->args);
- if (!s7_is_character(obj))
- {
- if (!format_method(sc, str, fdat, port))
- format_error(sc, "'C' directive requires a character argument", str, args, fdat);
- }
- else
- {
- /* here use_write is false, so we just add the char, not its name */
- if (width == -1)
- format_append_char(sc, fdat, character(obj), port);
- else format_append_chars(sc, fdat, character(obj), width, port);
- fdat->args = cdr(fdat->args);
- fdat->ctr++;
- }
- }
- break;
+#if (!WITH_PURE_S7)
+static s7_pointer vector_append(s7_scheme *sc, s7_pointer args, int typ);
- /* -------- numbers -------- */
- case 'F': case 'f':
- if (is_null(fdat->args))
- format_error(sc, "~~F: missing argument", str, args, fdat);
- if (!(s7_is_number(car(fdat->args))))
- {
- if (!format_method(sc, str, fdat, port))
- format_error(sc, "~~F: numeric argument required", str, args, fdat);
- }
- else format_number(sc, fdat, 10, width, precision, 'f', pad, port);
- break;
+static s7_pointer g_vector_append(s7_scheme *sc, s7_pointer args)
+{
+ /* returns a one-dimensional vector. To handle multidimensional vectors, we'd need to
+ * ensure all the dimensional data matches (rank, size of each dimension except the last etc),
+ * which is too much trouble.
+ */
+ #define H_vector_append "(vector-append . vectors) returns a new (1-dimensional) vector containing the elements of its vector arguments."
+ #define Q_vector_append pcl_v
- case 'G': case 'g':
- if (is_null(fdat->args))
- format_error(sc, "~~G: missing argument", str, args, fdat);
- if (!(s7_is_number(car(fdat->args))))
- {
- if (!format_method(sc, str, fdat, port))
- format_error(sc, "~~G: numeric argument required", str, args, fdat);
- }
- else format_number(sc, fdat, 10, width, precision, 'g', pad, port);
- break;
+ s7_pointer p;
+ int i;
- case 'E': case 'e':
- if (is_null(fdat->args))
- format_error(sc, "~~E: missing argument", str, args, fdat);
- if (!(s7_is_number(car(fdat->args))))
- {
- if (!format_method(sc, str, fdat, port))
- format_error(sc, "~~E: numeric argument required", str, args, fdat);
- }
- else format_number(sc, fdat, 10, width, precision, 'e', pad, port);
- break;
+ if (is_null(args))
+ return(make_vector_1(sc, 0, NOT_FILLED, T_VECTOR));
- /* how to handle non-integer arguments in the next 4 cases? clisp just returns
- * the argument: (format nil "~X" 1.25) -> "1.25" which is perverse (ClTl2 p 581:
- * "if arg is not an integer, it is printed in ~A format and decimal base")!!
- * I think I'll use the type of the number to choose the output format.
- */
- case 'D': case 'd':
- if (is_null(fdat->args))
- format_error(sc, "~~D: missing argument", str, args, fdat);
- if (!(s7_is_number(car(fdat->args))))
- {
- /* (let () (require mockery.scm) (format #f "~D" ((*mock-number* 'mock-number) 123)))
- * port here is a string-port, str has the width/precision data if the caller wants it,
- * args is the current arg. But format_number handles fdat->args and so on, so
- * I think I'll pass the format method the current control string (str), the
- * current object (car(fdat->args)), and the arglist (args), and assume it will
- * return a (scheme) string.
- */
- if (!format_method(sc, str, fdat, port))
- format_error(sc, "~~D: numeric argument required", str, args, fdat);
- }
- else format_number(sc, fdat, 10, width, precision, 'd', pad, port);
- break;
+ for (i = 0, p = args; is_pair(p); p = cdr(p), i++)
+ {
+ s7_pointer x;
+ x = car(p);
+ if (!s7_is_vector(x))
+ {
+ if (is_byte_vector(x))
+ return(wrong_type_argument_with_type(sc, sc->vector_append_symbol, i + 1, x,
+ make_string_wrapper(sc, "a byte-vector is actually a string: use append or string-append")));
+ if (has_methods(x))
+ {
+ s7_pointer func;
+ func = find_method(sc, find_let(sc, x), sc->vector_append_symbol);
+ if (func != sc->undefined)
+ {
+ int k;
+ s7_pointer v, y;
+ if (i == 0)
+ return(s7_apply_function(sc, func, args));
+ /* we have to copy the arglist here */
+ sc->temp9 = make_list(sc, i, sc->F);
+ for (k = 0, y = args, v = sc->temp9; k < i; k++, y = cdr(y), v = cdr(v))
+ set_car(v, car(y));
+ v = g_vector_append(sc, sc->temp9);
+ y = s7_apply_function(sc, func, cons(sc, v, p));
+ sc->temp9 = sc->nil;
+ return(y);
+ }
+ }
+ return(wrong_type_argument(sc, sc->vector_append_symbol, i + 1, x, T_VECTOR));
+ }
+ }
+ return(vector_append(sc, args, type(car(args))));
+}
- case 'O': case 'o':
- if (is_null(fdat->args))
- format_error(sc, "~~O: missing argument", str, args, fdat);
- if (!(s7_is_number(car(fdat->args))))
- {
- if (!format_method(sc, str, fdat, port))
- format_error(sc, "~~O: numeric argument required", str, args, fdat);
- }
- else format_number(sc, fdat, 8, width, precision, 'o', pad, port);
- break;
+static s7_pointer vector_append_p_pp(s7_pointer p1, s7_pointer p2)
+{
+ s7_pointer val;
+ cur_sc->temp7 = list_2(cur_sc, p1, p2);
+ val = g_vector_append(cur_sc, cur_sc->temp7);
+ cur_sc->temp7 = cur_sc->nil;
+ return(val);
+}
- case 'X': case 'x':
- if (is_null(fdat->args))
- format_error(sc, "~~X: missing argument", str, args, fdat);
- if (!(s7_is_number(car(fdat->args))))
- {
- if (!format_method(sc, str, fdat, port))
- format_error(sc, "~~X: numeric argument required", str, args, fdat);
- }
- else format_number(sc, fdat, 16, width, precision, 'x', pad, port);
- break;
+static s7_pointer vector_append_p_ppp(s7_pointer p1, s7_pointer p2, s7_pointer p3)
+{
+ s7_pointer val;
+ cur_sc->temp7 = list_3(cur_sc, p1, p2, p3);
+ val = g_vector_append(cur_sc, cur_sc->temp7);
+ cur_sc->temp7 = cur_sc->nil;
+ return(val);
+}
+#endif
- case 'B': case 'b':
- if (is_null(fdat->args))
- format_error(sc, "~~B: missing argument", str, args, fdat);
- if (!(s7_is_number(car(fdat->args))))
- {
- if (!format_method(sc, str, fdat, port))
- format_error(sc, "~~B: numeric argument required", str, args, fdat);
- }
- else format_number(sc, fdat, 2, width, precision, 'b', pad, port);
- break;
+s7_pointer s7_vector_ref_n(s7_scheme *sc, s7_pointer vector, int indices, ...)
+{
+ /* from s7.html */
+ int ndims;
- default:
- if (width > 0)
- format_error(sc, "unused numeric argument", str, args, fdat);
- format_error(sc, "unimplemented format directive", str, args, fdat);
- }
- }
- break;
+ ndims = s7_vector_rank(vector);
+ if (ndims == indices)
+ {
+ va_list ap;
+ s7_int index = 0;
+ va_start(ap, indices);
- default:
- format_error(sc, "unimplemented format directive", str, args, fdat);
- }
+ if (ndims == 1)
+ {
+ index = va_arg(ap, s7_int);
+ va_end(ap);
+ return(s7_vector_ref(sc, vector, index));
}
- else /* str[i] is not #\~ */
+ else
{
- int j, new_len;
- const char *p;
+ int i;
+ s7_int *offsets, *dimensions;
- p = (char *)strchr((const char *)(str + i + 1), (int)'~');
- if (!p)
- j = str_len;
- else j = (int)(p - str);
- new_len = j - i;
+ dimensions = s7_vector_dimensions(vector);
+ offsets = s7_vector_offsets(vector);
- if ((port_data(port)) &&
- ((port_position(port) + new_len) < port_data_size(port)))
+ for (i = 0; i < indices; i++)
{
- memcpy((void *)(port_data(port) + port_position(port)), (void *)(str + i), new_len);
- port_position(port) += new_len;
+ int ind;
+ ind = va_arg(ap, int);
+ if ((ind < 0) ||
+ (ind >= dimensions[i]))
+ {
+ va_end(ap);
+ return(out_of_range(sc, sc->vector_ref_symbol, small_int(i), make_integer(sc, ind), (ind < 0) ? its_negative_string : its_too_large_string));
+ }
+ index += (ind * offsets[i]);
}
- else port_write_string(port)(sc, (char *)(str + i), new_len, port);
- fdat->loc += new_len;
- sc->format_column += new_len;
- i = j - 1;
+ va_end(ap);
+ return(vector_getter(vector)(sc, vector, index));
}
}
+ return(s7_wrong_number_of_args_error(sc, "s7_vector_ref_n: wrong number of indices: ~A", s7_make_integer(sc, indices)));
+}
- ALL_DONE:
- if (next_arg)
- (*next_arg) = fdat->args;
- else
- {
- if (is_not_null(fdat->args))
- format_error(sc, "too many arguments", str, args, fdat);
- }
- if (i < str_len)
- {
- if (str[i] == '~')
- format_error(sc, "control string ends in tilde", str, args, fdat);
- format_append_char(sc, fdat, str[i], port);
- }
- sc->format_depth--;
+s7_pointer s7_vector_set_n(s7_scheme *sc, s7_pointer vector, s7_pointer value, int indices, ...)
+{
+ int ndims;
- if (with_result)
+ ndims = s7_vector_rank(vector);
+ if (ndims == indices)
{
- s7_pointer result;
+ va_list ap;
+ s7_int index = 0;
+ va_start(ap, indices);
- if ((is_output_port(deferred_port)) &&
- (port_position(port) > 0))
+ if (ndims == 1)
{
- port_data(port)[port_position(port)] = '\0';
- port_write_string(deferred_port)(sc, (const char *)port_data(port), port_position(port), deferred_port);
+ index = va_arg(ap, s7_int);
+ va_end(ap);
+ s7_vector_set(sc, vector, index, value);
+ return(value);
}
- result = s7_make_string_with_length(sc, (char *)port_data(port), port_position(port));
- close_format_port(sc, port);
- fdat->port = NULL;
- return(result);
- }
- return(sc->F);
-}
-
+ else
+ {
+ int i;
+ s7_int *offsets, *dimensions;
-static bool is_columnizing(const char *str)
-{
- /* look for ~t ~,<int>T ~<int>,<int>t */
- char *p;
+ dimensions = s7_vector_dimensions(vector);
+ offsets = s7_vector_offsets(vector);
- for (p = (char *)str; (*p);)
- if (*p++ == '~') /* this is faster than strchr */
- {
- char c;
- c = *p++;
- if ((c == 't') || (c == 'T')) return(true);
- if (!c) return(false);
- if ((c == ',') || ((c >= '0') && (c <= '9')) || (c == 'n') || (c == 'N'))
- {
- while (((c >= '0') && (c <= '9')) || (c == 'n') || (c == 'N')) c = *p++;
- if ((c == 't') || (c == 'T')) return(true);
- if (!c) return(false); /* ~,1 for example */
- if (c == ',')
- {
- c = *p++;
- while (((c >= '0') && (c <= '9')) || (c == 'n') || (c == 'N')) c = *p++;
- if ((c == 't') || (c == 'T')) return(true);
- if (!c) return(false);
- }
- }
- }
- return(false);
+ for (i = 0; i < indices; i++)
+ {
+ int ind;
+ ind = va_arg(ap, int);
+ if ((ind < 0) ||
+ (ind >= dimensions[i]))
+ {
+ va_end(ap);
+ return(s7_out_of_range_error(sc, "s7_vector_set_n", i, s7_make_integer(sc, ind), "should be a valid index"));
+ }
+ index += (ind * offsets[i]);
+ }
+ va_end(ap);
+ vector_setter(vector)(sc, vector, index, value);
+ return(value);
+ }
+ }
+ return(s7_wrong_number_of_args_error(sc, "s7_vector_set_n: wrong number of indices: ~A", s7_make_integer(sc, indices)));
}
-static s7_pointer format_to_port(s7_scheme *sc, s7_pointer port, const char *str, s7_pointer args, s7_pointer *next_arg, bool with_result, int len)
+s7_pointer s7_vector_to_list(s7_scheme *sc, s7_pointer vect)
{
- return(format_to_port_1(sc, port, str, args, next_arg, with_result, true /* is_columnizing(str) */, len, NULL));
- /* is_columnizing on every call is much slower than ignoring the issue */
-}
+ s7_int i, len;
+ s7_pointer result;
+ len = vector_length(vect);
+ if (len == 0)
+ return(sc->nil);
+ if (len >= (sc->free_heap_top - sc->free_heap))
+ {
+ gc(sc);
+ while (len >= (sc->free_heap_top - sc->free_heap))
+ resize_heap(sc);
+ }
-static s7_pointer g_format_1(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer pt, str;
- sc->format_column = 0;
- pt = car(args);
+ sc->v = sc->nil;
+ for (i = len - 1; i >= 0; i--)
+ sc->v = cons_unchecked(sc, vector_getter(vect)(sc, vect, i), sc->v);
+ result = sc->v;
+ sc->v = sc->nil;
+ return(result);
+}
- if (is_string(pt))
- return(format_to_port_1(sc, sc->F, string_value(pt), cdr(args), NULL, true, true, string_length(pt), pt));
- if (is_null(pt)) pt = sc->output_port; /* () -> (current-output-port) */
+#if (!WITH_PURE_S7)
+static s7_pointer g_vector_to_list(s7_scheme *sc, s7_pointer args)
+{
+ s7_int i, start = 0, end;
+ s7_pointer p, vec;
+ #define H_vector_to_list "(vector->list v start end) returns the elements of the vector v as a list; (map values v)"
+ #define Q_vector_to_list s7_make_circular_signature(sc, 2, 3, sc->is_proper_list_symbol, sc->is_vector_symbol, sc->is_integer_symbol)
- if (!((s7_is_boolean(pt)) || /* #f or #t */
- ((is_output_port(pt)) && /* (current-output-port) or call-with-open-file arg, etc */
- (!port_is_closed(pt)))))
- method_or_bust_with_type(sc, pt, sc->format_symbol, args, an_output_port_string, 1);
+ vec = car(args);
+ if (!s7_is_vector(vec))
+ method_or_bust_one_arg(sc, vec, sc->vector_to_list_symbol, args, T_VECTOR);
- str = cadr(args);
- if (!is_string(str))
- method_or_bust(sc, str, sc->format_symbol, args, T_STRING, 2);
+ end = vector_length(vec);
+ if (!is_null(cdr(args)))
+ {
+ p = start_and_end(sc, sc->vector_to_list_symbol, NULL, cdr(args), args, 2, &start, &end);
+ if (p != sc->gc_nil) return(p);
+ if (start == end) return(sc->nil);
+ }
+ if ((start == 0) && (end == vector_length(vec)))
+ return(s7_vector_to_list(sc, vec));
- return(format_to_port_1(sc, (pt == sc->T) ? sc->output_port : pt,
- string_value(str), cddr(args), NULL, !is_output_port(pt), true, string_length(str), str));
+ sc->w = sc->nil;
+ for (i = end - 1; i >= start; i--)
+ sc->w = cons(sc, vector_getter(vec)(sc, vec, i), sc->w);
+ p = sc->w;
+ sc->w = sc->nil;
+ return(p);
}
-
-static s7_pointer g_format(s7_scheme *sc, s7_pointer args)
+static s7_pointer vector_to_list_p_p(s7_pointer p)
{
- #define H_format "(format out str . args) substitutes args into str sending the result to out. Most of \
-s7's format directives are taken from CL: ~% = newline, ~& = newline if the preceding output character was \
-no a newline, ~~ = ~, ~<newline> trims white space, ~* skips an argument, ~^ exits {} iteration if the arg list is exhausted, \
-~nT spaces over to column n, ~A prints a representation of any object, ~S is the same, but puts strings in double quotes, \
-~C prints a character, numbers are handled by ~F, ~E, ~G, ~B, ~O, ~D, and ~X with preceding numbers giving \
-spacing (and spacing character) and precision. ~{ starts an embedded format directive which is ended by ~}: \n\
-\n\
- >(format #f \"dashed: ~{~A~^-~}\" '(1 2 3))\n\
- \"dashed: 1-2-3\"\n\
-\n\
-~P inserts \"s\" if the current it is not 1 or 1.0 (use ~@P for \"ies\" or \"y\").\n\
-~B is number->string in base 2, ~O in base 8, ~D base 10, ~X base 16,\n\
-~E: (format #f \"~E\" 100.1) -> \"1.001000e+02\" (%e in C)\n\
-~F: (format #f \"~F\" 100.1) -> \"100.100000\" (%f in C)\n\
-~G: (format #f \"~G\" 100.1) -> \"100.1\" (%g in C)\n\
-\n\
-If the 'out' it is not an output port, the resultant string is returned. If it \
-is #t, the string is also sent to the current-output-port."
-
- #define Q_format s7_make_circular_signature(sc, 1, 2, s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_boolean_symbol), sc->T)
- return(g_format_1(sc, args));
+ s7_pointer val;
+ cur_sc->temp7 = list_1(cur_sc, p);
+ val = g_vector_to_list(cur_sc, cur_sc->temp7);
+ cur_sc->temp7 = cur_sc->nil;
+ return(val);
}
+#endif
-const char *s7_format(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_make_and_fill_vector(s7_scheme *sc, s7_int len, s7_pointer fill)
{
- s7_pointer result;
- result = g_format_1(sc, args);
- if (is_string(result))
- return(string_value(result));
- return(NULL);
+ s7_pointer vect;
+ vect = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
+ s7_vector_fill(sc, vect, fill);
+ return(vect);
}
-
-/* -------------------------------- system extras -------------------------------- */
-
-#if WITH_SYSTEM_EXTRAS
-#include <fcntl.h>
-
-static s7_pointer g_is_directory(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_vector(s7_scheme *sc, s7_pointer args)
{
- #define H_is_directory "(directory? str) returns #t if str is the name of a directory"
- #define Q_is_directory s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_string_symbol)
- s7_pointer name;
- name = car(args);
+ #define H_vector "(vector ...) returns a vector whose elements are the arguments"
+ #define Q_vector s7_make_circular_signature(sc, 1, 2, sc->is_vector_symbol, sc->T)
- if (!is_string(name))
- method_or_bust(sc, name, sc->is_directory_symbol, args, T_STRING, 0);
- return(s7_make_boolean(sc, is_directory(string_value(name))));
-}
+ s7_int len;
+ s7_pointer vec;
+ len = safe_list_length(sc, args); /* was s7_list_length but don't we ensure that arglists are proper? */
+ vec = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
+ if (len > 0)
+ {
+ s7_int i;
+ s7_pointer x;
+ for (x = args, i = 0; is_pair(x); x = cdr(x), i++)
+ vector_element(vec, i) = car(x);
+ }
+ return(vec);
+}
-static bool file_probe(const char *arg)
+static s7_pointer g_is_float_vector(s7_scheme *sc, s7_pointer args)
{
-#if (!MS_WINDOWS)
- return(access(arg, F_OK) == 0);
-#else
- int fd;
- fd = open(arg, O_RDONLY, 0);
- if (fd == -1) return(false);
- close(fd);
- return(true);
-#endif
+ #define H_is_float_vector "(float-vector? obj) returns #t if obj is an homogeneous float vector"
+ #define Q_is_float_vector pl_bt
+ check_boolean_method(sc, s7_is_float_vector, sc->is_float_vector_symbol, args);
}
-
-static s7_pointer g_file_exists(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_float_vector(s7_scheme *sc, s7_pointer args)
{
- #define H_file_exists "(file-exists? filename) returns #t if the file exists"
- #define Q_file_exists s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_string_symbol)
+ #define H_float_vector "(float-vector ...) returns an homogeneous float vector whose elements are the arguments"
+ #define Q_float_vector s7_make_circular_signature(sc, 1, 2, sc->is_float_vector_symbol, sc->is_real_symbol)
- s7_pointer name;
- name = car(args);
+ s7_int len;
+ s7_pointer vec;
- if (!is_string(name))
- method_or_bust(sc, name, sc->file_exists_symbol, args, T_STRING, 0);
- return(s7_make_boolean(sc, file_probe(string_value(name))));
+ len = safe_list_length(sc, args);
+ vec = make_vector_1(sc, len, NOT_FILLED, T_FLOAT_VECTOR);
+ sc->w = vec;
+ if (len > 0)
+ {
+ s7_int i;
+ s7_pointer x;
+ for (x = args, i = 0; is_pair(x); x = cdr(x), i++)
+ {
+ if (s7_is_real(car(x))) /* bignum is ok here */
+ float_vector_element(vec, i) = real_to_double(sc, car(x), "float-vector");
+ else return(simple_wrong_type_argument(sc, sc->float_vector_symbol, car(x), T_REAL));
+ }
+ }
+ sc->w = sc->nil;
+ return(vec);
}
+static s7_pointer g_is_int_vector(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_int_vector "(int-vector? obj) returns #t if obj is an homogeneous int vector"
+ #define Q_is_int_vector pl_bt
+ check_boolean_method(sc, is_int_vector, sc->is_int_vector_symbol, args);
+}
-static s7_pointer g_delete_file(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_int_vector(s7_scheme *sc, s7_pointer args)
{
- #define H_delete_file "(delete-file filename) deletes the file filename."
- #define Q_delete_file s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_string_symbol)
+ #define H_int_vector "(int-vector ...) returns an homogeneous int vector whose elements are the arguments"
+ #define Q_int_vector s7_make_circular_signature(sc, 1, 2, sc->is_int_vector_symbol, sc->is_integer_symbol)
- s7_pointer name;
- name = car(args);
+ s7_int len;
+ s7_pointer vec;
- if (!is_string(name))
- method_or_bust(sc, name, sc->delete_file_symbol, args, T_STRING, 0);
- return(make_integer(sc, unlink(string_value(name))));
+ len = safe_list_length(sc, args);
+ vec = make_vector_1(sc, len, NOT_FILLED, T_INT_VECTOR);
+ if (len > 0)
+ {
+ s7_int i;
+ s7_pointer x;
+ for (x = args, i = 0; is_pair(x); x = cdr(x), i++)
+ int_vector_element(vec, i) = s7_number_to_integer_with_caller(sc, car(x), "int-vector");
+ }
+ return(vec);
}
+s7_int s7_vector_length(s7_pointer vec)
+{
+ return(vector_length(vec));
+}
-static s7_pointer g_getenv(s7_scheme *sc, s7_pointer args)
+#if (!WITH_PURE_S7)
+static s7_pointer g_list_to_vector(s7_scheme *sc, s7_pointer args)
{
- #define H_getenv "(getenv var) returns the value of an environment variable."
- #define Q_getenv pcl_s
+ s7_pointer p;
+ #define H_list_to_vector "(list->vector lst) returns a vector containing the elements of lst; (apply vector lst)"
+ #define Q_list_to_vector s7_make_signature(sc, 2, sc->is_vector_symbol, sc->is_proper_list_symbol)
- s7_pointer name;
- name = car(args);
+ p = car(args);
+ sc->temp3 = p;
+ if (is_null(p))
+ return(s7_make_vector(sc, 0));
- if (!is_string(name))
- method_or_bust(sc, name, sc->getenv_symbol, args, T_STRING, 0);
- return(s7_make_string(sc, getenv(string_value(name))));
-}
+ if (!is_proper_list(sc, p))
+ method_or_bust_with_type_one_arg(sc, p, sc->list_to_vector_symbol, list_1(sc, p), a_proper_list_string);
+ return(g_vector(sc, p));
+}
-static s7_pointer g_system(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_vector_length(s7_scheme *sc, s7_pointer args)
{
- #define H_system "(system command) executes the command. If the optional second it 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)
+ s7_pointer vec;
+ #define H_vector_length "(vector-length v) returns the length of vector v"
+ #define Q_vector_length s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_vector_symbol)
- s7_pointer name;
- name = car(args);
+ vec = car(args);
+ if (!s7_is_vector(vec))
+ method_or_bust_one_arg(sc, vec, sc->vector_length_symbol, args, T_VECTOR);
- if (!is_string(name))
- method_or_bust(sc, name, sc->system_symbol, args, T_STRING, 0);
+ return(make_integer(sc, vector_length(vec)));
+}
- if ((is_pair(cdr(args))) &&
- (cadr(args) == sc->T))
- {
- #define BUF_SIZE 256
- char buf[BUF_SIZE];
- char *str = NULL;
- int cur_len = 0, full_len = 0;
- FILE *fd;
- s7_pointer res;
+static s7_int vector_length_i(s7_pointer p)
+{
+ if (!s7_is_vector(p))
+ simple_wrong_type_argument(cur_sc, cur_sc->vector_length_symbol, p, T_VECTOR);
+ return(vector_length(p));
+}
+#endif
- fd = popen(string_value(name), "r");
- while (fgets(buf, BUF_SIZE, fd))
- {
- int buf_len;
- buf_len = safe_strlen(buf);
- if (cur_len + buf_len >= full_len)
- {
- full_len += BUF_SIZE * 2;
- if (str)
- str = (char *)realloc(str, full_len * sizeof(char));
- else str = (char *)malloc(full_len * sizeof(char));
- }
- memcpy((void *)(str + cur_len), (void *)buf, buf_len);
- cur_len += buf_len;
- }
- pclose(fd);
- res = s7_make_string_with_length(sc, str, cur_len);
- if (str) free(str);
- return(res);
- }
- return(make_integer(sc, system(string_value(name))));
-}
+static s7_pointer make_shared_vector(s7_scheme *sc, s7_pointer vect, int skip_dims, s7_int index)
+{
+ s7_pointer x;
+ vdims_t *v;
+ /* (let ((v #2d((1 2) (3 4)))) (v 1))
+ * (let ((v (make-vector '(2 3 4) 0))) (v 1 2))
+ * (let ((v #3d(((0 1 2 3) (4 5 6 7) (8 9 10 11)) ((12 13 14 15) (16 17 18 19) (20 21 22 23))))) (v 0 1))
+ */
-#ifndef _MSC_VER
-#include <dirent.h>
+ new_cell(sc, x, typeflag(vect) | T_SAFE_PROCEDURE);
+ vector_length(x) = 0;
+ vector_elements(x) = NULL;
+ vector_getter(x) = vector_getter(vect);
+ vector_setter(x) = vector_setter(vect);
-static s7_pointer c_directory_to_list(s7_scheme *sc, s7_pointer name)
-{
- DIR *dpos;
- s7_pointer result;
+ v = (vdims_t *)malloc(sizeof(vdims_t));
+ v->ndims = vector_ndims(vect) - skip_dims;
+ v->dims = (s7_int *)(vector_dimensions(vect) + skip_dims);
+ v->offsets = (s7_int *)(vector_offsets(vect) + skip_dims);
+ v->original = vect; /* shared_vector */
+ if (is_normal_vector(vect))
+ mark_function[T_VECTOR] = mark_vector_possibly_shared;
+ else mark_function[type(vect)] = mark_int_or_float_vector_possibly_shared;
+ v->elements_allocated = false;
+ v->dimensions_allocated = false;
+ vector_dimension_info(x) = v;
- if (!is_string(name))
- method_or_bust(sc, name, sc->directory_to_list_symbol, list_1(sc, name), T_STRING, 0);
+ if (skip_dims > 0)
+ vector_length(x) = vector_offset(vect, skip_dims - 1);
+ else vector_length(x) = vector_length(vect);
- sc->w = sc->nil;
- if ((dpos = opendir(string_value(name))))
+ if (is_int_vector(vect))
+ int_vector_elements(x) = (s7_int *)(int_vector_elements(vect) + index);
+ else
{
- struct dirent *dirp;
- while ((dirp = readdir(dpos)))
- sc->w = cons(sc, s7_make_string(sc, dirp->d_name), sc->w);
- closedir(dpos);
+ if (is_float_vector(vect))
+ float_vector_elements(x) = (s7_double *)(float_vector_elements(vect) + index);
+ else vector_elements(x) = (s7_pointer *)(vector_elements(vect) + index);
}
-
- result = sc->w;
- sc->w = sc->nil;
- return(result);
+ add_vector(sc, x);
+ return(x);
}
-static s7_pointer g_directory_to_list(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer g_make_shared_vector(s7_scheme *sc, s7_pointer args)
{
- #define H_directory_to_list "(directory->list directory) returns the contents of the directory as a list of strings (filenames)."
- #define Q_directory_to_list s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_string_symbol)
- return(c_directory_to_list(sc, car(args)));
-}
+ #define H_make_shared_vector "(make-shared-vector original-vector new-dimensions (offset 0)) returns \
+a vector that points to the same elements as the original-vector but with different dimensional info."
+ #define Q_make_shared_vector s7_make_signature(sc, 4, sc->is_vector_symbol, sc->is_vector_symbol, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_integer_symbol), sc->is_integer_symbol)
-PF_TO_PF(directory_to_list, c_directory_to_list)
+ /* (let ((v1 #2d((1 2 3) (4 5 6)))) (let ((v2 (make-shared-vector v1 '(6)))) v2)) -> #(1 2 3 4 5 6)
+ * (let ((v1 #(1 2 3 4 5 6))) (let ((v2 (make-shared-vector v1 '(3 2)))) v2)) -> #2D((1 2) (3 4) (5 6))
+ * this is most useful in generic functions -- they can still use (v n) as the accessor.
+ */
+ s7_pointer orig, dims, y, x;
+ vdims_t *v;
+ int i;
+ s7_int new_len = 1, orig_len, offset = 0;
+ orig = car(args);
+ if (!s7_is_vector(orig))
+ method_or_bust(sc, orig, sc->make_shared_vector_symbol, args, T_VECTOR, 1);
-static s7_pointer g_file_mtime(s7_scheme *sc, s7_pointer args)
-{
- #define H_file_mtime "(file-mtime file): return the write date of file"
- #define Q_file_mtime s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_string_symbol)
+ orig_len = vector_length(orig);
- struct stat statbuf;
- int err;
- s7_pointer name;
+ if (!is_null(cddr(args)))
+ {
+ s7_pointer off;
+ off = caddr(args);
+ if (s7_is_integer(off))
+ {
+ offset = s7_integer(off);
+ if ((offset < 0) ||
+ (offset >= orig_len)) /* we need this if, for example, offset == 9223372036854775807 */
+ return(out_of_range(sc, sc->make_shared_vector_symbol, small_int(3), off, (offset < 0) ? its_negative_string : its_too_large_string));
+ }
+ else method_or_bust(sc, off, sc->make_shared_vector_symbol, args, T_INTEGER, 3);
+ }
- name = car(args);
- if (!is_string(name))
- method_or_bust(sc, name, sc->file_mtime_symbol, args, T_STRING, 0);
+ dims = cadr(args);
+ if (is_integer(dims))
+ {
+ if ((s7_integer(dims) < 0) ||
+ (s7_integer(dims) >= orig_len))
+ return(out_of_range(sc, sc->make_shared_vector_symbol, small_int(2), dims, (s7_integer(dims) < 0) ? its_negative_string : its_too_large_string));
+ dims = list_1(sc, dims);
+ }
+ else
+ {
+ if ((is_null(dims)) ||
+ (!is_proper_list(sc, dims)))
+ method_or_bust(sc, dims, sc->make_shared_vector_symbol, args, T_PAIR, 2);
- err = stat(string_value(name), &statbuf);
- if (err < 0)
- return(file_error(sc, "file-mtime", strerror(errno), string_value(name)));
+ for (y = dims; is_pair(y); y = cdr(y))
+ if ((!s7_is_integer(car(y))) || /* (make-shared-vector v '((1 2) (3 4))) */
+ (s7_integer(car(y)) > orig_len) ||
+ (s7_integer(car(y)) < 0))
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_1(sc, make_string_wrapper(sc, "a list of integers that fits the original vector"))));
+ }
- return(s7_make_integer(sc, (s7_int)(statbuf.st_mtime)));
-}
-#endif
-#endif
+ v = (vdims_t *)malloc(sizeof(vdims_t));
+ v->ndims = safe_list_length(sc, dims);
+ v->dims = (s7_int *)malloc(v->ndims * sizeof(s7_int));
+ v->offsets = (s7_int *)malloc(v->ndims * sizeof(s7_int));
+ v->dimensions_allocated = true;
+ v->elements_allocated = false;
+ v->original = orig; /* shared_vector */
+ if (is_normal_vector(orig))
+ mark_function[T_VECTOR] = mark_vector_possibly_shared;
+ else mark_function[type(orig)] = mark_int_or_float_vector_possibly_shared;
+ for (i = 0, y = dims; is_pair(y); i++, y = cdr(y))
+ v->dims[i] = s7_integer(car(y));
+ for (i = v->ndims - 1; i >= 0; i--)
+ {
+ v->offsets[i] = new_len;
+ new_len *= v->dims[i];
+ }
-/* -------------------------------- lists -------------------------------- */
+ if ((new_len < 0) || ((new_len + offset) > vector_length(orig)))
+ {
+ free(v->dims);
+ free(v->offsets);
+ free(v);
+ return(out_of_range(sc, sc->make_shared_vector_symbol, small_int(2), dims, make_string_wrapper(sc, "a shared vector has to fit in the original vector")));
+ }
-s7_pointer s7_cons(s7_scheme *sc, s7_pointer a, s7_pointer b)
-{
- s7_pointer x;
- new_cell(sc, x, T_PAIR | T_SAFE_PROCEDURE);
- set_car(x, a);
- set_cdr(x, b);
+ new_cell(sc, x, typeflag(orig) | T_SAFE_PROCEDURE);
+ vector_dimension_info(x) = v;
+ vector_length(x) = new_len; /* might be less than original length */
+ vector_getter(x) = vector_getter(orig);
+ vector_setter(x) = vector_setter(orig);
+
+ if (is_int_vector(orig))
+ int_vector_elements(x) = (s7_int *)(int_vector_elements(orig) + offset);
+ else
+ {
+ if (is_float_vector(orig))
+ float_vector_elements(x) = (s7_double *)(float_vector_elements(orig) + offset);
+ else vector_elements(x) = (s7_pointer *)(vector_elements(orig) + offset);
+ }
+
+ add_vector(sc, x);
return(x);
}
-static s7_pointer cons_unchecked(s7_scheme *sc, s7_pointer a, s7_pointer b)
+static s7_pointer make_vector_wrapper(s7_scheme *sc, s7_int size, s7_pointer *elements)
{
- /* apparently slightly faster as a function? */
s7_pointer x;
- new_cell_no_check(sc, x, T_PAIR | T_SAFE_PROCEDURE);
- set_car(x, a);
- set_cdr(x, b);
+ new_cell(sc, x, T_VECTOR | T_SAFE_PROCEDURE);
+ vector_length(x) = size;
+ vector_elements(x) = elements;
+ vector_getter(x) = default_vector_getter;
+ vector_setter(x) = default_vector_setter;
+ vector_dimension_info(x) = NULL;
+ /* don't add_vector -- no need for sweep to see this */
return(x);
}
-
-static s7_pointer permanent_cons(s7_pointer a, s7_pointer b, unsigned int type)
+static s7_pointer make_subvector(s7_scheme *sc, s7_pointer v)
{
- /* for the symbol table which is never GC'd (and its contents aren't marked) */
s7_pointer x;
- x = alloc_pointer();
- set_type(x, type);
- unheap(x);
- set_car(x, a);
- set_cdr(x, b);
+ new_cell(sc, x, type(v));
+ vector_length(x) = vector_length(v);
+ if (is_normal_vector(v))
+ vector_elements(x) = vector_elements(v);
+ else
+ {
+ if (is_float_vector(v))
+ float_vector_elements(x) = float_vector_elements(v);
+ else int_vector_elements(x) = int_vector_elements(v);
+ }
+ vector_getter(x) = vector_getter(v);
+ vector_setter(x) = vector_setter(v);
+ vector_dimension_info(x) = NULL;
return(x);
}
-static s7_pointer permanent_list(s7_scheme *sc, int len)
+
+static s7_pointer vector_ref_1(s7_scheme *sc, s7_pointer vect, s7_pointer indices)
{
- int j;
- s7_pointer p;
- p = sc->nil;
- for (j = 0; j < len; j++)
- p = permanent_cons(sc->nil, p, T_PAIR | T_IMMUTABLE);
- return(p);
-}
+ s7_int index = 0;
+ if (vector_length(vect) == 0)
+ return(out_of_range(sc, sc->vector_ref_symbol, small_int(1), vect, its_too_large_string));
-#if DEBUGGING
-static int sigs = 0, sig_pairs = 0;
-#endif
+ if (vector_rank(vect) > 1)
+ {
+ unsigned int i;
+ s7_pointer x;
+ for (x = indices, i = 0; (is_not_null(x)) && (i < vector_ndims(vect)); x = cdr(x), i++)
+ {
+ s7_int n;
+ s7_pointer p, p1;
+ p = car(x);
+ if (!s7_is_integer(p))
+ {
+ if (!s7_is_integer(p1 = check_values(sc, p, x)))
+ method_or_bust(sc, p, sc->vector_ref_symbol, cons(sc, vect, indices), T_INTEGER, i + 2);
+ p = p1;
+ }
+ n = s7_integer(p);
+ if ((n < 0) ||
+ (n >= vector_dimension(vect, i)))
+ return(out_of_range(sc, sc->vector_ref_symbol, make_integer(sc, i + 2), p, (n < 0) ? its_negative_string : its_too_large_string));
-static void check_sig_entry(s7_scheme *sc, s7_pointer p, s7_pointer res, bool circle)
-{
- if ((!is_symbol(car(p))) &&
- (!s7_is_boolean(car(p))) &&
- (!is_pair(car(p))))
+ index += n * vector_offset(vect, i);
+ }
+ if (is_not_null(x))
+ {
+ if (!is_normal_vector(vect))
+ return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), indices, too_many_indices_string));
+ return(implicit_index(sc, vector_element(vect, index), x));
+ }
+
+ /* if not enough indices, return a shared vector covering whatever is left */
+ if (i < vector_ndims(vect))
+ return(make_shared_vector(sc, vect, i, index));
+ }
+ else
{
- s7_pointer np;
- int i;
- for (np = res, i = 0; np != p; np = cdr(np), i++);
- fprintf(stderr, "s7_make_%ssignature got an invalid entry at position %d: (", (circle) ? "circular_" : "", i);
- for (np = res; np != p; np = cdr(np))
- fprintf(stderr, "%s ", DISPLAY(car(np)));
- fprintf(stderr, "...");
- set_car(p, sc->nil);
+ s7_pointer p, p1;
+ /* (let ((hi (make-vector 3 0.0)) (sum 0.0)) (do ((i 0 (+ i 1))) ((= i 3)) (set! sum (+ sum (hi i)))) sum) */
+ p = car(indices);
+
+ if (!s7_is_integer(p))
+ {
+ if (!s7_is_integer(p1 = check_values(sc, p, indices)))
+ method_or_bust(sc, p, sc->vector_ref_symbol, cons(sc, vect, indices), T_INTEGER, 2);
+ p = p1;
+ }
+ index = s7_integer(p);
+ if ((index < 0) ||
+ (index >= vector_length(vect)))
+ return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), p, (index < 0) ? its_negative_string : its_too_large_string));
+
+ if (is_not_null(cdr(indices))) /* (let ((L #(#(1 2 3) #(4 5 6)))) (vector-ref L 1 2)) */
+ {
+ if (!is_normal_vector(vect))
+ return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), indices, too_many_indices_string));
+ return(implicit_index(sc, vector_element(vect, index), cdr(indices)));
+ }
}
+ return((vector_getter(vect))(sc, vect, index));
}
-s7_pointer s7_make_signature(s7_scheme *sc, int len, ...)
+
+static s7_pointer g_vector_ref(s7_scheme *sc, s7_pointer args)
{
- va_list ap;
- s7_pointer p, res;
-#if DEBUGGING
- sigs++;
- sig_pairs += len;
-#endif
+ #define H_vector_ref "(vector-ref v ... i) returns the i-th element of vector v."
+ #define Q_vector_ref s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_vector_symbol, sc->is_integer_symbol)
- res = permanent_list(sc, len);
- va_start(ap, len);
- for (p = res; is_pair(p); p = cdr(p))
- {
- set_car(p, va_arg(ap, s7_pointer));
- check_sig_entry(sc, p, res, false);
- }
- va_end(ap);
+ s7_pointer vec;
- return((s7_pointer)res);
+ vec = car(args);
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->vector_ref_symbol, args, T_VECTOR, 1);
+ return(vector_ref_1(sc, vec, cdr(args)));
}
-s7_pointer s7_make_circular_signature(s7_scheme *sc, int cycle_point, int len, ...)
+static s7_pointer g_vector_ref_ic_n(s7_scheme *sc, s7_pointer args, s7_int index)
{
- va_list ap;
- int i;
- s7_pointer p, res, back = NULL, end = NULL;
-#if DEBUGGING
- sigs++;
- sig_pairs += len;
-#endif
+ s7_pointer vec;
+ vec = find_symbol_unchecked(sc, car(args));
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->vector_ref_symbol, list_2(sc, vec, cadr(args)), T_VECTOR, 1);
- res = permanent_list(sc, len);
- va_start(ap, len);
- for (p = res, i = 0; is_pair(p); p = cdr(p), i++)
+ if (index >= vector_length(vec))
+ return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), cadr(args), its_too_large_string));
+ if (vector_rank(vec) > 1)
{
- set_car(p, va_arg(ap, s7_pointer));
- check_sig_entry(sc, p, res, true);
- if (i == cycle_point) back = p;
- if (i == (len - 1)) end = p;
+ 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)));
}
- va_end(ap);
- if (end) set_cdr(end, back);
- if (i < len)
- fprintf(stderr, "s7_make_circular_signature got too few entries: %s\n", DISPLAY(res));
- return((s7_pointer)res);
+ return(vector_getter(vec)(sc, vec, index));
}
+static s7_pointer vector_ref_p_pi(s7_pointer v, s7_int i)
+{
+ if ((!s7_is_vector(v)) ||
+ (vector_rank(v) > 1) ||
+ (i < 0) ||
+ (i >= vector_length(v)))
+ return(g_vector_ref(cur_sc, set_plist_2(cur_sc, v, make_integer(cur_sc, i))));
+ return(vector_getter(v)(cur_sc, v, i));
+}
-bool s7_is_pair(s7_pointer p)
+static s7_pointer vector_ref_p_pi_direct(s7_pointer v, s7_int i)
{
- return(is_pair(p));
+ if ((i < 0) || (i >= vector_length(v)))
+ out_of_range(cur_sc, cur_sc->vector_ref_symbol, small_int(2), make_integer(cur_sc, i), (i < 0) ? its_negative_string : its_too_large_string);
+ return(vector_getter(v)(cur_sc, v, i));
}
+static s7_pointer vector_ref_unchecked(s7_pointer v, s7_int i) {return(vector_getter(v)(cur_sc, v, i));}
-s7_pointer s7_car(s7_pointer p) {return(car(p));}
-s7_pointer s7_cdr(s7_pointer p) {return(cdr(p));}
+static s7_pointer vector_ref_ic;
+static s7_pointer g_vector_ref_ic(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, s7_integer(cadr(args))));}
+static s7_pointer vector_ref_ic_0;
+static s7_pointer g_vector_ref_ic_0(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, 0));}
+static s7_pointer vector_ref_ic_1;
+static s7_pointer g_vector_ref_ic_1(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, 1));}
+static s7_pointer vector_ref_ic_2;
+static s7_pointer g_vector_ref_ic_2(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, 2));}
+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));}
-s7_pointer s7_cadr(s7_pointer p) {return(cadr(p));}
-s7_pointer s7_cddr(s7_pointer p) {return(cddr(p));}
-s7_pointer s7_cdar(s7_pointer p) {return(cdar(p));}
-s7_pointer s7_caar(s7_pointer p) {return(caar(p));}
+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;
-s7_pointer s7_caadr(s7_pointer p) {return(caadr(p));}
-s7_pointer s7_caddr(s7_pointer p) {return(caddr(p));}
-s7_pointer s7_cadar(s7_pointer p) {return(cadar(p));}
-s7_pointer s7_caaar(s7_pointer p) {return(caaar(p));}
-s7_pointer s7_cdadr(s7_pointer p) {return(cdadr(p));}
-s7_pointer s7_cdddr(s7_pointer p) {return(cdddr(p));}
-s7_pointer s7_cddar(s7_pointer p) {return(cddar(p));}
-s7_pointer s7_cdaar(s7_pointer p) {return(cdaar(p));}
+ vec = find_symbol_unchecked(sc, car(args));
+ x = find_symbol_unchecked(sc, cadadr(args));
-s7_pointer s7_caaadr(s7_pointer p) {return(caaadr(p));}
-s7_pointer s7_caaddr(s7_pointer p) {return(caaddr(p));}
-s7_pointer s7_caadar(s7_pointer p) {return(caadar(p));}
-s7_pointer s7_caaaar(s7_pointer p) {return(caaaar(p));}
-s7_pointer s7_cadadr(s7_pointer p) {return(cadadr(p));}
-s7_pointer s7_cadddr(s7_pointer p) {return(cadddr(p));}
-s7_pointer s7_caddar(s7_pointer p) {return(caddar(p));}
-s7_pointer s7_cadaar(s7_pointer p) {return(cadaar(p));}
+ 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;
-s7_pointer s7_cdaadr(s7_pointer p) {return(cdaadr(p));}
-s7_pointer s7_cdaddr(s7_pointer p) {return(cdaddr(p));}
-s7_pointer s7_cdadar(s7_pointer p) {return(cdadar(p));}
-s7_pointer s7_cdaaar(s7_pointer p) {return(cdaaar(p));}
-s7_pointer s7_cddadr(s7_pointer p) {return(cddadr(p));}
-s7_pointer s7_cddddr(s7_pointer p) {return(cddddr(p));}
-s7_pointer s7_cdddar(s7_pointer p) {return(cdddar(p));}
-s7_pointer s7_cddaar(s7_pointer p) {return(cddaar(p));}
+ 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));
-s7_pointer s7_set_car(s7_pointer p, s7_pointer q)
-{
- set_car(p, q);
- return(p);
+ 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));
}
-s7_pointer s7_set_cdr(s7_pointer p, s7_pointer q)
+static s7_pointer vector_ref_2;
+static s7_pointer g_vector_ref_2(s7_scheme *sc, s7_pointer args)
{
- set_cdr(p, q);
- return(p);
-}
+ s7_pointer vec, ind;
+ s7_int index;
-/* -------------------------------------------------------------------------------- */
+ vec = car(args);
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->vector_ref_symbol, args, T_VECTOR, 1); /* should be ok because we go to g_vector_ref below */
-s7_pointer s7_apply_1(s7_scheme *sc, s7_pointer args, s7_pointer (*f1)(s7_pointer a1))
-{
- /* not currently used */
- return(f1(car(args)));
-}
+ if (vector_rank(vec) > 1)
+ return(g_vector_ref(sc, args));
-s7_pointer s7_apply_2(s7_scheme *sc, s7_pointer args, s7_pointer (*f2)(s7_pointer a1, s7_pointer a2))
-{
- return(f2(car(args), cadr(args)));
-}
+ ind = cadr(args);
+ if (!s7_is_integer(ind))
+ method_or_bust(sc, ind, sc->vector_ref_symbol, args, T_INTEGER, 2);
-s7_pointer s7_apply_3(s7_scheme *sc, s7_pointer args, s7_pointer (*f3)(s7_pointer a1, s7_pointer a2, s7_pointer a3))
-{
- s7_pointer a1;
- a1 = car(args); args = cdr(args);
- return(f3(a1, car(args), cadr(args)));
-}
+ index = s7_integer(ind);
+ if ((index < 0) || (index >= vector_length(vec)))
+ return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), ind, (index < 0) ? its_negative_string : its_too_large_string));
-s7_pointer s7_apply_4(s7_scheme *sc, s7_pointer args, s7_pointer (*f4)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4))
-{
- s7_pointer a1, a2;
- a1 = car(args); a2 = cadr(args); args = cddr(args);
- return(f4(a1, a2, car(args), cadr(args)));
+ return(vector_getter(vec)(sc, vec, index));
}
-s7_pointer s7_apply_5(s7_scheme *sc, s7_pointer args, s7_pointer (*f5)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5))
+static s7_pointer vector_ref_2_direct;
+static s7_pointer g_vector_ref_2_direct(s7_scheme *sc, s7_pointer args)
{
- s7_pointer a1, a2, a3, a4;
- a1 = car(args); a2 = cadr(args); args = cddr(args);
- a3 = car(args); a4 = cadr(args); args = cddr(args);
- return(f5(a1, a2, a3, a4, car(args)));
+ s7_pointer vec, ind;
+ s7_int index;
+ vec = car(args);
+ ind = cadr(args);
+ if (!s7_is_integer(ind))
+ method_or_bust(sc, ind, sc->vector_ref_symbol, args, T_INTEGER, 2);
+ index = s7_integer(ind);
+ if ((index < 0) || (index >= vector_length(vec)))
+ return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), ind, (index < 0) ? its_negative_string : its_too_large_string));
+ return(vector_element(vec, index));
}
-s7_pointer s7_apply_6(s7_scheme *sc, s7_pointer args, s7_pointer (*f6)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5, s7_pointer a6))
-{
- s7_pointer a1, a2, a3, a4;
- a1 = car(args); a2 = cadr(args); args = cddr(args);
- a3 = car(args); a4 = cadr(args); args = cddr(args);
- return(f6(a1, a2, a3, a4, car(args), cadr(args)));
-}
-s7_pointer s7_apply_7(s7_scheme *sc, s7_pointer args,
- s7_pointer (*f7)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5, s7_pointer a6, s7_pointer a7))
-{
- s7_pointer a1, a2, a3, a4, a5, a6;
- a1 = car(args); a2 = cadr(args); args = cddr(args);
- a3 = car(args); a4 = cadr(args); args = cddr(args);
- a5 = car(args); a6 = cadr(args); args = cddr(args);
- return(f7(a1, a2, a3, a4, a5, a6, car(args)));
-}
-s7_pointer s7_apply_8(s7_scheme *sc, s7_pointer args,
- s7_pointer (*f8)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8))
+static s7_pointer g_vector_set(s7_scheme *sc, s7_pointer args)
{
- s7_pointer a1, a2, a3, a4, a5, a6;
- a1 = car(args); a2 = cadr(args); args = cddr(args);
- a3 = car(args); a4 = cadr(args); args = cddr(args);
- a5 = car(args); a6 = cadr(args); args = cddr(args);
- return(f8(a1, a2, a3, a4, a5, a6, car(args), cadr(args)));
-}
+ #define H_vector_set "(vector-set! v i ... value) sets the i-th element of vector v to value."
+ #define Q_vector_set s7_make_circular_signature(sc, 3, 4, sc->T, sc->is_vector_symbol, sc->is_integer_symbol, sc->is_integer_or_any_at_end_symbol)
-s7_pointer s7_apply_9(s7_scheme *sc, s7_pointer args, s7_pointer (*f9)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
- s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8, s7_pointer a9))
-{
- s7_pointer a1, a2, a3, a4, a5, a6;
- a1 = car(args); a2 = cadr(args); args = cddr(args);
- a3 = car(args); a4 = cadr(args); args = cddr(args);
- a5 = car(args); a6 = cadr(args); args = cddr(args);
- return(f9(a1, a2, a3, a4, a5, a6, car(args), cadr(args), caddr(args)));
-}
+ s7_pointer vec, val;
+ s7_int index;
-s7_pointer s7_apply_n_1(s7_scheme *sc, s7_pointer args, s7_pointer (*f1)(s7_pointer a1))
-{
- if (is_pair(args))
- return(f1(car(args)));
- return(f1(sc->undefined));
-}
+ vec = car(args);
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->vector_set_symbol, args, T_VECTOR, 1);
-s7_pointer s7_apply_n_2(s7_scheme *sc, s7_pointer args, s7_pointer (*f2)(s7_pointer a1, s7_pointer a2))
-{
- if (is_pair(args))
- {
- if (is_pair(cdr(args)))
- return(f2(car(args), cadr(args)));
- return(f2(car(args), sc->undefined));
- }
- return(f2(sc->undefined, sc->undefined));
-}
+ if (vector_length(_TSet(vec)) == 0)
+ return(out_of_range(sc, sc->vector_set_symbol, small_int(1), vec, its_too_large_string));
-s7_pointer s7_apply_n_3(s7_scheme *sc, s7_pointer args, s7_pointer (*f3)(s7_pointer a1, s7_pointer a2, s7_pointer a3))
-{
- if (is_pair(args))
+ if (vector_rank(vec) > 1)
{
- s7_pointer a1;
- a1 = car(args); args = cdr(args);
- if (is_pair(args))
+ unsigned int i;
+ s7_pointer x;
+ index = 0;
+ for (x = cdr(args), i = 0; (is_not_null(cdr(x))) && (i < vector_ndims(vec)); x = cdr(x), i++)
{
- s7_pointer a2;
- a2 = car(args);
- if (is_pair(cdr(args)))
- return(f3(a1, a2, cadr(args)));
- return(f3(a1, a2, sc->undefined));
+ s7_int n;
+ s7_pointer p, p1;
+ p = car(x);
+ if (!s7_is_integer(p))
+ {
+ if (!s7_is_integer(p1 = check_values(sc, p, x)))
+ method_or_bust(sc, p, sc->vector_set_symbol, args, T_INTEGER, i + 2);
+ p = p1;
+ }
+ n = s7_integer(p);
+ if ((n < 0) ||
+ (n >= vector_dimension(vec, i)))
+ return(out_of_range(sc, sc->vector_set_symbol, make_integer(sc, i + 2), p, (n < 0) ? its_negative_string : its_too_large_string));
+
+ index += n * vector_offset(vec, i);
}
- return(f3(a1, sc->undefined, sc->undefined));
- }
- return(f3(sc->undefined, sc->undefined, sc->undefined));
-}
-s7_pointer s7_apply_n_4(s7_scheme *sc, s7_pointer args, s7_pointer (*f4)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4))
-{
- if (is_pair(args))
+ if (is_not_null(cdr(x)))
+ return(s7_wrong_number_of_args_error(sc, "too many args for vector-set!: ~S", args));
+ if (i != vector_ndims(vec))
+ return(s7_wrong_number_of_args_error(sc, "not enough args for vector-set!: ~S", args));
+
+ val = car(x);
+ }
+ else
{
- s7_pointer a1;
- a1 = car(args); args = cdr(args);
- if (is_pair(args))
+ s7_pointer p, p1;
+ p = cadr(args);
+ if (!s7_is_integer(p))
{
- s7_pointer a2;
- a2 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- s7_pointer a3;
- a3 = car(args);
- if (is_pair(cdr(args)))
- return(f4(a1, a2, a3, cadr(args)));
- return(f4(a1, a2, a3, sc->undefined));
- }
- return(f4(a1, a2, sc->undefined, sc->undefined));
+ if (!s7_is_integer(p1 = check_values(sc, p, cdr(args))))
+ method_or_bust(sc, p, sc->vector_set_symbol, args, T_INTEGER, 2);
+ p = p1;
}
- return(f4(a1, sc->undefined, sc->undefined, sc->undefined));
- }
- return(f4(sc->undefined, sc->undefined, sc->undefined, sc->undefined));
-}
+ index = s7_integer(p);
+ if ((index < 0) ||
+ (index >= vector_length(vec)))
+ return(out_of_range(sc, sc->vector_set_symbol, small_int(2), p, (index < 0) ? its_negative_string : its_too_large_string));
-s7_pointer s7_apply_n_5(s7_scheme *sc, s7_pointer args,
- s7_pointer (*f5)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5))
-{
- if (is_pair(args))
- {
- s7_pointer a1;
- a1 = car(args); args = cdr(args);
- if (is_pair(args))
+ if (is_not_null(cdddr(args)))
{
- s7_pointer a2;
- a2 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- s7_pointer a3;
- a3 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- s7_pointer a4;
- a4 = car(args);
- if (is_pair(cdr(args)))
- return(f5(a1, a2, a3, a4, cadr(args)));
- return(f5(a1, a2, a3, a4, sc->undefined));
- }
- return(f5(a1, a2, a3, sc->undefined, sc->undefined));
- }
- return(f5(a1, a2, sc->undefined, sc->undefined, sc->undefined));
+ set_car(sc->temp_cell_2, vector_getter(vec)(sc, vec, index));
+ set_cdr(sc->temp_cell_2, cddr(args));
+ return(g_vector_set(sc, sc->temp_cell_2));
}
- return(f5(a1, sc->undefined, sc->undefined, sc->undefined, sc->undefined));
+ val = caddr(args);
}
- return(f5(sc->undefined, sc->undefined, sc->undefined, sc->undefined, sc->undefined));
-}
-s7_pointer s7_apply_n_6(s7_scheme *sc, s7_pointer args,
- s7_pointer (*f6)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5, s7_pointer a6))
-{
- s7_pointer a1, a2, a3, a4, a5, a6;
- a1 = sc->undefined; a2 = sc->undefined; a3 = sc->undefined; a4 = sc->undefined; a5 = sc->undefined; a6 = sc->undefined;
- if (is_pair(args))
- {
- a1 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a2 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a3 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a4 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a5 = car(args);
- if (is_pair(cdr(args))) a6 = cadr(args);
- }}}}}
- return(f6(a1, a2, a3, a4, a5, a6));
+ vector_setter(vec)(sc, vec, index, val);
+ return(val);
}
-s7_pointer s7_apply_n_7(s7_scheme *sc, s7_pointer args,
- s7_pointer (*f7)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
- s7_pointer a5, s7_pointer a6, s7_pointer a7))
+static s7_pointer vector_set_p_pip(s7_pointer v, s7_int i, s7_pointer p)
{
- s7_pointer a1, a2, a3, a4, a5, a6, a7;
- a1 = sc->undefined; a2 = sc->undefined; a3 = sc->undefined; a4 = sc->undefined; a5 = sc->undefined;
- a6 = sc->undefined, a7 = sc->undefined;
- if (is_pair(args))
- {
- a1 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a2 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a3 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a4 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a5 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a6 = car(args);
- if (is_pair(cdr(args))) a7 = cadr(args);
- }}}}}}
- return(f7(a1, a2, a3, a4, a5, a6, a7));
+ if ((!s7_is_vector(v)) ||
+ (vector_rank(v) > 1) ||
+ (i < 0) ||
+ (i >= vector_length(v)))
+ return(g_vector_set(cur_sc, set_plist_3(cur_sc, v, make_integer(cur_sc, i), p)));
+ vector_setter(v)(cur_sc, v, i, p);
+ return(p);
}
-s7_pointer s7_apply_n_8(s7_scheme *sc, s7_pointer args,
- s7_pointer (*f8)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
- s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8))
+static s7_pointer vector_set_p_pip_direct(s7_pointer v, s7_int i, s7_pointer p)
{
- s7_pointer a1, a2, a3, a4, a5, a6, a7, a8;
- a1 = sc->undefined; a2 = sc->undefined; a3 = sc->undefined; a4 = sc->undefined; a5 = sc->undefined;
- a6 = sc->undefined, a7 = sc->undefined; a8 = sc->undefined;
- if (is_pair(args))
- {
- a1 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a2 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a3 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a4 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a5 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a6 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a7 = car(args);
- if (is_pair(cdr(args))) a8 = cadr(args);
- }}}}}}}
- return(f8(a1, a2, a3, a4, a5, a6, a7, a8));
+#if DEBUGGING
+ if (!is_normal_vector(v)) abort();
+#endif
+ if ((i < 0) || (i >= vector_length(v)))
+ out_of_range(cur_sc, cur_sc->vector_set_symbol, small_int(2), make_integer(cur_sc, i), (i < 0) ? its_negative_string : its_too_large_string);
+ vector_element(v, i) = p;
+ return(p);
}
-s7_pointer s7_apply_n_9(s7_scheme *sc, s7_pointer args,
- s7_pointer (*f9)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
- s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8,
- s7_pointer a9))
-{
- s7_pointer a1, a2, a3, a4, a5, a6, a7, a8, a9;
- a1 = sc->undefined; a2 = sc->undefined; a3 = sc->undefined; a4 = sc->undefined; a5 = sc->undefined;
- a6 = sc->undefined, a7 = sc->undefined; a8 = sc->undefined; a9 = sc->undefined;
- if (is_pair(args))
- {
- a1 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a2 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a3 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a4 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a5 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a6 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a7 = car(args); args = cdr(args);
- if (is_pair(args))
- {
- a8 = car(args);
- if (is_pair(cdr(args))) a9 = cadr(args);
- }}}}}}}}
- return(f9(a1, a2, a3, a4, a5, a6, a7, a8, a9));
+static s7_pointer vector_set_unchecked(s7_pointer v, s7_int i, s7_pointer p)
+{
+#if DEBUGGING
+ if (!is_normal_vector(v)) abort();
+#endif
+ vector_element(v, i) = p;
+ return(p);
}
-/* -------------------------------------------------------------------------------- */
-
+static s7_pointer vector_set_ic;
+static s7_pointer g_vector_set_ic(s7_scheme *sc, s7_pointer args)
+{
+ /* (vector-set! vec 0 x) */
+ s7_pointer vec, val;
+ s7_int index;
+ vec = find_symbol_unchecked(sc, car(args));
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->vector_set_symbol, list_3(sc, vec, cadr(args), find_symbol_unchecked(sc, caddr(args))), T_VECTOR, 1);
+ /* the list_3 happens only if we find the method */
-s7_pointer s7_list_ref(s7_scheme *sc, s7_pointer lst, int num)
-{
- int i;
- s7_pointer x;
- for (x = lst, i = 0; (i < num) && (is_pair(x)); i++, x = cdr(x)) {}
- if ((i == num) && (is_pair(x)))
- return(car(x));
- return(sc->nil);
-}
+ if (vector_rank(vec) > 1)
+ return(g_vector_set(sc, set_plist_3(sc, vec, cadr(args), find_symbol_unchecked(sc, caddr(args)))));
+ index = s7_integer(cadr(args));
+ if (index >= vector_length(vec))
+ return(out_of_range(sc, sc->vector_set_symbol, small_int(2), cadr(args), its_too_large_string));
-s7_pointer s7_list_set(s7_scheme *sc, s7_pointer lst, int num, s7_pointer val)
-{
- int i;
- s7_pointer x;
- for (x = lst, i = 0; (i < num) && (is_pair(x)); i++, x = cdr(x)) {}
- if ((i == num) &&
- (is_pair(x)))
- set_car(x, _NFre(val));
+ val = find_symbol_unchecked(sc, caddr(args));
+ vector_setter(vec)(sc, vec, index, val);
return(val);
}
-s7_pointer s7_member(s7_scheme *sc, s7_pointer sym, s7_pointer lst)
+static s7_pointer c_vector_set_3(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer val)
{
- s7_pointer x;
- for (x = lst; is_pair(x); x = cdr(x))
- if (s7_is_equal(sc, sym, car(x)))
- return(x);
- return(sc->F);
-}
+ /* (vector-set! vec ind val) where are all predigested */
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->vector_set_symbol, list_3(sc, vec, make_integer(sc, index), val), T_VECTOR, 1);
-static bool symbol_is_in_arg_list(s7_pointer sym, s7_pointer lst)
-{
- s7_pointer x;
- for (x = lst; is_pair(x); x = cdr(x))
- if ((sym == car(x)) ||
- ((is_pair(car(x))) &&
- (sym == caar(x))))
- return(true);
- return(sym == x);
-}
+ if (vector_rank(vec) > 1)
+ return(g_vector_set(sc, set_plist_3(sc, vec, make_integer(sc, index), val)));
+ if ((index < 0) ||
+ (index >= vector_length(vec)))
+ return(out_of_range(sc, sc->vector_set_symbol, small_int(2), make_integer(sc, index), (index < 0) ? its_negative_string : its_too_large_string));
-static s7_int tree_len(s7_scheme *sc, s7_pointer p, s7_int i)
-{
- if (is_null(p))
- return(i);
- if ((!is_pair(p)) ||
- (car(p) == sc->quote_symbol))
- return(i + 1);
- return(tree_len(sc, car(p), tree_len(sc, cdr(p), i)));
+ vector_setter(vec)(sc, vec, index, val);
+ return(val);
}
-static s7_pointer g_tree_leaves(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer vector_set_3;
+static s7_pointer g_vector_set_3(s7_scheme *sc, s7_pointer args)
{
- return(s7_make_integer(sc, tree_len(sc, car(args), 0)));
+ s7_pointer ind;
+ ind = cadr(args);
+ if (!s7_is_integer(ind))
+ {
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, ind, cdr(args))))
+ return(wrong_type_argument(sc, sc->vector_set_symbol, 2, ind, T_INTEGER));
+ else ind = p;
+ }
+ return(c_vector_set_3(sc, car(args), s7_integer(ind), caddr(args)));
}
-static s7_pointer print_truncate(s7_scheme *sc, s7_pointer code)
+static s7_pointer g_make_vector_1(s7_scheme *sc, s7_pointer args, s7_pointer err_sym)
{
- if (tree_len(sc, code, 0) > sc->print_length)
+ s7_int len;
+ s7_pointer x, fill, vec;
+ int result_type = T_VECTOR;
+
+ fill = sc->unspecified;
+ x = car(args);
+ if (s7_is_integer(x))
{
- char *str;
- str = object_to_truncated_string(sc, code, sc->print_length * 10);
- return(make_string_uncopied_with_length(sc, str, safe_strlen(str)));
+ len = s7_integer(x);
+ if (len < 0)
+ return(wrong_type_argument_with_type(sc, err_sym, 1, x, a_non_negative_integer_string));
}
- return(code);
-}
+ else
+ {
+ if (!(is_pair(x)))
+ method_or_bust_with_type(sc, x, err_sym, args, make_string_wrapper(sc, "an integer or a list of integers"), 1);
+ if (!s7_is_integer(car(x)))
+ return(wrong_type_argument_with_type(sc, err_sym, 1, car(x),
+ make_string_wrapper(sc, "each dimension should be an integer")));
+ if (is_null(cdr(x)))
+ len = s7_integer(car(x));
+ else
+ {
+ int dims;
+ s7_pointer y;
-static bool tree_memq(s7_scheme *sc, s7_pointer sym, s7_pointer tree)
-{
- if (sym == tree) return(true);
- return((is_pair(tree)) &&
- (car(tree) != sc->quote_symbol) &&
- ((tree_memq(sc, sym, car(tree))) || (tree_memq(sc, sym, cdr(tree)))));
-}
+ dims = s7_list_length(sc, x);
+ if (dims <= 0) /* 0 if circular, negative if dotted */
+ return(wrong_type_argument_with_type(sc, err_sym, 1, x, a_proper_list_string));
+ if (dims > sc->max_vector_dimensions)
+ return(out_of_range(sc, err_sym, small_int(1), x, its_too_large_string));
-static s7_pointer g_tree_memq(s7_scheme *sc, s7_pointer args)
-{
- return(make_boolean(sc, tree_memq(sc, car(args), cadr(args))));
-}
-
+ for (len = 1, y = x; is_not_null(y); y = cdr(y))
+ {
+ if (!s7_is_integer(car(y)))
+ return(wrong_type_argument(sc, err_sym, position_of(y, x), car(y), T_INTEGER));
+ len *= s7_integer(car(y));
+ if (len < 0)
+ return(wrong_type_argument_with_type(sc, err_sym, position_of(y, x), car(y), a_non_negative_integer_string));
+ }
+ }
+ }
-s7_pointer s7_assoc(s7_scheme *sc, s7_pointer sym, s7_pointer lst)
-{
- s7_pointer x, y;
+ if (is_not_null(cdr(args)))
+ {
+ fill = cadr(args);
+ if (is_not_null(cddr(args)))
+ {
+ if (caddr(args) == sc->T)
+ {
+ /* here bignums can cause confusion, so use is_integer not s7_is_integer etc */
+ if (is_integer(fill))
+ result_type = T_INT_VECTOR;
+ else
+ {
+ if (s7_is_real(fill)) /* might be gmp with big_real by accident (? see above) */
+ result_type = T_FLOAT_VECTOR;
+ else method_or_bust_with_type(sc, fill, err_sym, args, make_string_wrapper(sc, "an integer or a real since 'homogeneous' is #t"), 2);
+ }
+ }
+ else
+ {
+ if (caddr(args) != sc->F)
+ method_or_bust_with_type(sc, caddr(args), err_sym, args, a_boolean_string, 3);
+ }
+ }
+ }
- if (!is_pair(lst))
- return(sc->F);
+ vec = make_vector_1(sc, len, NOT_FILLED, result_type);
+ if (len > 0) s7_vector_fill(sc, vec, fill);
- x = lst;
- y = lst;
- while (true)
+ if ((is_pair(x)) &&
+ (is_pair(cdr(x))))
{
- if ((is_pair(car(x))) && (s7_is_equal(sc, sym, caar(x)))) return(car(x));
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ int i;
+ s7_int offset = 1;
+ s7_pointer y;
+ vdims_t *v;
- if ((is_pair(car(x))) && (s7_is_equal(sc, sym, caar(x)))) return(car(x));
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ v = (vdims_t *)malloc(sizeof(vdims_t));
+ v->ndims = safe_list_length(sc, x);
+ v->dims = (s7_int *)malloc(v->ndims * sizeof(s7_int));
+ v->offsets = (s7_int *)malloc(v->ndims * sizeof(s7_int));
+ v->original = sc->F;
+ v->dimensions_allocated = true;
+ v->elements_allocated = (len > 0);
- y = cdr(y);
- if (x == y) return(sc->F);
+ for (i = 0, y = x; is_not_null(y); i++, y = cdr(y))
+ v->dims[i] = s7_integer(car(y));
+
+ for (i = v->ndims - 1; i >= 0; i--)
+ {
+ v->offsets[i] = offset;
+ offset *= v->dims[i];
+ }
+ vector_dimension_info(vec) = v;
}
- return(sc->F);
+ return(vec);
}
+static s7_pointer g_make_vector(s7_scheme *sc, s7_pointer args)
+{
+ #define H_make_vector "(make-vector len (value #<unspecified>)) returns a vector of len elements initialized to value. \
+To create a multidimensional vector, put the dimension bounds in a list (this is to avoid ambiguities such as \
+(make-vector 1 2) where it's not clear whether the '2' is an initial value or a dimension size). (make-vector '(2 3) 1.0) \
+returns a 2 dimensional vector of 6 total elements, all initialized to 1.0."
+ #define Q_make_vector s7_make_signature(sc, 3, sc->is_vector_symbol, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_pair_symbol), sc->T)
+ return(g_make_vector_1(sc, args, sc->make_vector_symbol));
+}
-s7_pointer s7_reverse(s7_scheme *sc, s7_pointer a)
+static s7_pointer g_make_float_vector(s7_scheme *sc, s7_pointer args)
{
- /* reverse list -- produce new list (other code assumes this function does not return the original!) */
+ #define H_make_float_vector "(make-float-vector len (init 0.0)) returns a float-vector."
+ #define Q_make_float_vector s7_make_signature(sc, 3, sc->is_float_vector_symbol, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_pair_symbol), sc->is_real_symbol)
+ s7_int len;
s7_pointer x, p;
+ s7_double *arr;
- if (is_null(a)) return(a);
-
- if (!is_pair(cdr(a)))
+ p = car(args);
+ if ((is_pair(cdr(args))) ||
+ (!is_integer(p)))
{
- if (is_not_null(cdr(a)))
- return(cons(sc, cdr(a), car(a)));
- return(cons(sc, car(a), sc->nil)); /* don't return 'a' itself */
+ s7_pointer init;
+ if (is_pair(cdr(args)))
+ {
+ init = cadr(args);
+ if (!s7_is_real(init))
+ method_or_bust(sc, init, sc->make_float_vector_symbol, args, T_REAL, 2);
+#if WITH_GMP
+ if (s7_is_bignum(init))
+ return(g_make_vector_1(sc, set_plist_3(sc, p, make_real(sc, real_to_double(sc, init, "make-float-vector")), sc->T), sc->make_float_vector_symbol));
+#endif
+ if (is_rational(init))
+ return(g_make_vector_1(sc, set_plist_3(sc, p, make_real(sc, rational_to_double(sc, init)), sc->T), sc->make_float_vector_symbol));
+ }
+ else init = real_zero;
+ return(g_make_vector_1(sc, set_plist_3(sc, p, init, sc->T), sc->make_float_vector_symbol));
}
- sc->w = list_1(sc, car(a));
- for (x = cdr(a), p = a; is_pair(x); x = cdr(x), p = cdr(p))
+ len = s7_integer(p);
+ if (len < 0)
+ return(wrong_type_argument_with_type(sc, sc->make_float_vector_symbol, 1, p, a_non_negative_integer_string));
+ if (len > sc->max_vector_length)
+ return(out_of_range(sc, sc->make_float_vector_symbol, small_int(1), p, its_too_large_string));
+
+ if (len > 0)
+ arr = (s7_double *)calloc(len, sizeof(s7_double));
+ else arr = NULL;
+
+ new_cell(sc, x, T_FLOAT_VECTOR | T_SAFE_PROCEDURE);
+ vector_length(x) = len;
+ float_vector_elements(x) = arr;
+ vector_dimension_info(x) = NULL;
+ vector_getter(x) = float_vector_getter;
+ vector_setter(x) = float_vector_setter;
+
+ add_vector(sc, x);
+ return(x);
+}
+
+
+static s7_pointer g_make_int_vector(s7_scheme *sc, s7_pointer args)
+{
+ #define H_make_int_vector "(make-int-vector len (init 0)) returns an int-vector."
+ #define Q_make_int_vector s7_make_signature(sc, 3, sc->is_int_vector_symbol, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_pair_symbol), sc->is_integer_symbol)
+
+ s7_int len;
+ s7_pointer x, p;
+ s7_int *arr;
+
+ p = car(args);
+ if ((is_pair(cdr(args))) ||
+ (!is_integer(p)))
{
- sc->w = cons(sc, car(x), sc->w);
- if (is_pair(cdr(x)))
+ s7_pointer init;
+ if (is_pair(cdr(args)))
{
- x = cdr(x);
- sc->w = cons(sc, car(x), sc->w);
+ init = cadr(args);
+ if (!is_integer(init))
+ method_or_bust(sc, init, sc->make_int_vector_symbol, args, T_INTEGER, 2);
}
- if (x == p) /* this can take awhile to notice there's a cycle, but what does the caller expect? */
- break;
+ else init = small_int(0);
+ return(g_make_vector_1(sc, set_plist_3(sc, p, init, sc->T), sc->make_int_vector_symbol));
}
- if (is_not_null(x))
- p = cons(sc, x, sc->w); /* ?? this means that (reverse '(1 2 . 3)) returns '(3 2 1) -- we used to return () here */
- else p = sc->w;
+ len = s7_integer(p);
+ if (len < 0)
+ return(wrong_type_argument_with_type(sc, sc->make_int_vector_symbol, 1, p, a_non_negative_integer_string));
+ if (len > sc->max_vector_length)
+ return(out_of_range(sc, sc->make_int_vector_symbol, small_int(1), p, its_too_large_string));
- sc->w = sc->nil;
- return(p);
+ if (len > 0)
+ arr = (s7_int *)calloc(len, sizeof(s7_int));
+ else arr = NULL;
+
+ new_cell(sc, x, T_INT_VECTOR | T_SAFE_PROCEDURE);
+ vector_length(x) = len;
+ int_vector_elements(x) = arr;
+ vector_dimension_info(x) = NULL;
+ vector_getter(x) = int_vector_getter;
+ vector_setter(x) = int_vector_setter;
+
+ add_vector(sc, x);
+ return(x);
}
-/* s7_reverse sometimes tacks extra nodes on the end of a reversed circular list (it detects the cycle too late)
- * (let ((lst (list 0))) (set! (cdr lst) lst) (reverse lst)) -> (#1=(0 . #1#) 0 0 0)
- */
+static s7_pointer g_is_vector(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_vector "(vector? obj) returns #t if obj is a vector"
+ #define Q_is_vector pl_bt
+ check_boolean_method(sc, s7_is_vector, sc->is_vector_symbol, args);
+}
-static s7_pointer reverse_in_place(s7_scheme *sc, s7_pointer term, s7_pointer list)
+int s7_vector_rank(s7_pointer vect)
{
- s7_pointer p = list, result = term, q;
+ return(vector_rank(vect));
+}
- while (is_not_null(p))
+
+static s7_pointer g_vector_dimensions(s7_scheme *sc, s7_pointer args)
+{
+ #define H_vector_dimensions "(vector-dimensions vect) returns a list of vect's dimensions. In srfi-63 terms:\n\
+ (define array-dimensions vector-dimensions)\n\
+ (define (array-rank v) (length (vector-dimensions v)))"
+ #define Q_vector_dimensions s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_vector_symbol)
+
+ s7_pointer x;
+ x = car(args);
+ if (!s7_is_vector(x))
+ method_or_bust_one_arg(sc, x, sc->vector_dimensions_symbol, args, T_VECTOR);
+
+ if (vector_rank(x) > 1)
{
- q = cdr(p);
- if ((!is_pair(q)) &&
- (is_not_null(q)))
- return(sc->nil); /* improper list? */
- set_cdr(p, result);
- result = p;
- p = q;
+ int i;
+ sc->w = sc->nil;
+ for (i = vector_ndims(x) - 1; i >= 0; i--)
+ sc->w = cons(sc, make_integer(sc, vector_dimension(x, i)), sc->w);
+ x = sc->w;
+ sc->w = sc->nil;
+ return(x);
}
- return(result);
+ return(list_1(sc, make_integer(sc, vector_length(x))));
}
-static s7_pointer reverse_in_place_unchecked(s7_scheme *sc, s7_pointer term, s7_pointer list)
+#define MULTIVECTOR_TOO_MANY_ELEMENTS -1
+#define MULTIVECTOR_NOT_ENOUGH_ELEMENTS -2
+
+static int traverse_vector_data(s7_scheme *sc, s7_pointer vec, int flat_ref, int dimension, int dimensions, int *sizes, s7_pointer lst)
{
- s7_pointer p = list, result = term, q;
+ /* we're filling vec, we're currently looking for element (flat-wise) flat_ref,
+ * we're at ref in dimension of dimensions, where sizes gives the bounds, and lst is our data
+ * #3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12)))
+ */
+ int i;
+ s7_pointer x;
- while (is_not_null(p))
+ for (i = 0, x = lst; i < sizes[dimension]; i++, x = cdr(x))
{
- q = cdr(p);
- set_cdr(p, result);
- result = p;
- p = q;
+ if (!is_pair(x))
+ return(MULTIVECTOR_NOT_ENOUGH_ELEMENTS);
- if (is_null(p)) break;
- q = cdr(p);
- set_cdr(p, result);
- result = p;
- p = q;
+ if (dimension == (dimensions - 1))
+ vector_setter(vec)(sc, vec, flat_ref++, car(x));
+ else
+ {
+ flat_ref = traverse_vector_data(sc, vec, flat_ref, dimension + 1, dimensions, sizes, car(x));
+ if (flat_ref < 0) return(flat_ref);
+ }
}
- return(result);
+ if (is_not_null(x))
+ return(MULTIVECTOR_TOO_MANY_ELEMENTS);
+ return(flat_ref);
}
-static s7_pointer safe_reverse_in_place(s7_scheme *sc, s7_pointer list) /* "safe" here means we guarantee this list is unproblematic */
+static s7_pointer s7_multivector_error(s7_scheme *sc, const char *message, s7_pointer data)
{
- s7_pointer p = list, result, q;
- result = sc->nil;
-
- while (is_not_null(p))
- {
- q = cdr(p);
- /* also if (is_null(list)) || (is_null(cdr(list))) return(list) */
- set_cdr(p, result);
- result = p;
- p = q;
+ return(s7_error(sc, sc->read_error_symbol,
+ set_elist_3(sc, make_string_wrapper(sc, "reading constant vector, ~A: ~A"), make_string_wrapper(sc, message), data)));
+}
- /* unroll the loop for speed */
- if (is_null(p)) break;
- q = cdr(p);
- set_cdr(p, result);
- result = p;
- p = q;
- if (is_null(p)) break;
- q = cdr(p);
- set_cdr(p, result);
- result = p;
- p = q;
+static s7_pointer g_multivector(s7_scheme *sc, s7_int dims, s7_pointer data)
+{
+ /* get the dimension bounds from data, make the new vector, fill it from data
+ *
+ * dims needs to be s7_int so we can at least give correct error messages.
+ * also should we let an empty vector have any number of dimensions? currently ndims is an int.
+ */
+ s7_pointer vec, x;
+ int i, err;
+ unsigned int vec_loc;
+ int *sizes;
- if (is_null(p)) break;
- q = cdr(p);
- set_cdr(p, result);
- result = p;
- p = q;
- }
- return(result);
-}
+ /* (#2d((1 2 3) (4 5 6)) 0 0) -> 1
+ * (#2d((1 2 3) (4 5 6)) 0 1) -> 2
+ * (#2d((1 2 3) (4 5 6)) 1 1) -> 5
+ * (#3D(((1 2) (3 4)) ((5 6) (7 8))) 0 0 0) -> 1
+ * (#3D(((1 2) (3 4)) ((5 6) (7 8))) 1 1 0) -> 7
+ * #3D(((1 2) (3 4)) ((5 6) (7))) -> error, #3D(((1 2) (3 4)) ((5 6) (7 8 9))), #3D(((1 2) (3 4)) (5 (7 8 9))) etc
+ *
+ * but a special case: #nD() is an n-dimensional empty vector
+ */
+ if (dims <= 0) /* #0d(...) #2147483649D() [if dims is int this is negative] */
+ return(s7_out_of_range_error(sc, "#nD(...) dimensions", 1, make_integer(sc, dims), "must be 1 or more"));
+ if (dims > sc->max_vector_dimensions)
+ return(s7_out_of_range_error(sc, "#nD(...) dimensions", 1, make_integer(sc, dims), "must be < 512")); /* sc->max_vector_dimensions=512 currently */
-/* is this correct? (let ((x (list 1 2))) (eq? x (append () x))) -> #t
- */
+ sc->w = sc->nil;
+ 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)))));
-s7_pointer s7_append(s7_scheme *sc, s7_pointer a, s7_pointer b)
-{
- s7_pointer p, tp, np;
- if (is_null(a)) return(b);
+ sizes = (int *)calloc(dims, sizeof(int));
+ for (x = data, i = 0; i < dims; i++)
+ {
+ sizes[i] = safe_list_length(sc, x);
+ sc->w = cons(sc, make_integer(sc, sizes[i]), sc->w);
+ x = car(x);
+ if ((i < (dims - 1)) &&
+ (!is_pair(x)))
+ {
+ free(sizes);
+ return(s7_multivector_error(sc, "we need a list that fully specifies the vector's elements", data));
+ }
+ }
- tp = cons(sc, car(a), sc->nil);
- sc->y = tp;
- for (p = cdr(a), np = tp; is_pair(p); p = cdr(p), np = cdr(np))
- set_cdr(np, cons(sc, car(p), sc->nil));
- set_cdr(np, b);
- sc->y = sc->nil;
+ vec = g_make_vector(sc, set_plist_1(sc, sc->w = safe_reverse_in_place(sc, sc->w)));
+ vec_loc = s7_gc_protect(sc, vec);
+ sc->w = sc->nil;
- return(tp);
-}
+ /* now fill the vector checking that all the lists match */
+ err = traverse_vector_data(sc, vec, 0, 0, dims, sizes, data);
+ free(sizes);
+ s7_gc_unprotect_at(sc, vec_loc);
+ if (err < 0)
+ return(s7_multivector_error(sc, (err == MULTIVECTOR_TOO_MANY_ELEMENTS) ? "found too many elements" : "not enough elements found", data));
-static s7_pointer copy_list(s7_scheme *sc, s7_pointer lst)
-{
- s7_pointer p, tp, np;
- if (!is_pair(lst)) return(sc->nil);
- tp = cons(sc, car(lst), sc->nil);
- sc->y = tp;
- for (p = cdr(lst), np = tp; is_pair(p); p = cdr(p), np = cdr(np))
- set_cdr(np, cons(sc, car(p), sc->nil));
- sc->y = sc->nil;
- return(tp);
+ return(vec);
}
-
-static s7_pointer copy_list_with_arglist_error(s7_scheme *sc, s7_pointer lst)
+static s7_pointer g_int_multivector(s7_scheme *sc, s7_int dims, s7_pointer data)
{
- s7_pointer p, tp, np;
- if (is_null(lst)) return(sc->nil);
- if (!is_pair(lst))
- s7_error(sc, sc->syntax_error_symbol, set_elist_2(sc, make_string_wrapper(sc, "stray dot?: ~S"), lst));
- tp = cons(sc, car(lst), sc->nil);
- sc->y = tp;
- for (p = cdr(lst), np = tp; is_pair(p); p = cdr(p), np = cdr(np))
- set_cdr(np, cons(sc, car(p), sc->nil));
- sc->y = sc->nil;
- if (!is_null(p))
- s7_error(sc, sc->syntax_error_symbol, set_elist_2(sc, make_string_wrapper(sc, "improper list of arguments: ~S"), lst));
- return(tp);
+ /* dims > 1, sc->value is a pair (not null) */
+ s7_pointer *src;
+ s7_int i, len;
+ sc->value = g_multivector(sc, dims, sc->value);
+ src = (s7_pointer *)vector_elements(sc->value);
+ len = vector_length(sc->value);
+ for (i = 0; i < len; i++)
+ if (!is_t_integer(src[i]))
+ return(s7_wrong_type_arg_error(sc, "#i(...)", i + 1, src[i], "an integer"));
+ sc->args = g_make_vector_1(sc, set_plist_3(sc, g_vector_dimensions(sc, set_plist_1(sc, sc->value)), small_int(0), sc->T), sc->make_int_vector_symbol);
+ return(s7_copy(sc, set_plist_2(sc, sc->value, sc->args)));
+}
+
+static s7_pointer g_float_multivector(s7_scheme *sc, s7_int dims, s7_pointer data)
+{
+ /* dims > 1, sc->value is a pair (not null) */
+ s7_pointer *src;
+ s7_int i, len;
+ sc->value = g_multivector(sc, dims, sc->value);
+ src = (s7_pointer *)vector_elements(sc->value);
+ len = vector_length(sc->value);
+ for (i = 0; i < len; i++)
+ if (!s7_is_real(src[i]))
+ return(s7_wrong_type_arg_error(sc, "#r(...)", i + 1, src[i], "a real"));
+ sc->args = g_make_vector_1(sc, set_plist_3(sc, g_vector_dimensions(sc, set_plist_1(sc, sc->value)), real_zero, sc->T), sc->make_float_vector_symbol);
+ return(s7_copy(sc, set_plist_2(sc, sc->value, sc->args)));
}
-static s7_pointer revappend(s7_scheme *sc, s7_pointer a, s7_pointer b)
+s7_pointer s7_vector_copy(s7_scheme *sc, s7_pointer old_vect)
{
- /* (map (lambda (x) (if (odd? x) (apply values '(1 2 3)) (values))) (list 1 2 3 4))
- * is a bad case -- we have to copy the incoming list.
- */
- s7_pointer p = b, q;
+ s7_int i, len;
+ s7_pointer new_vect;
- if (is_not_null(a))
+ len = vector_length(old_vect);
+ if (is_float_vector(old_vect))
{
- a = copy_list(sc, a);
- while (is_not_null(a))
+ s7_double *src, *dst;
+ if (vector_rank(old_vect) > 1)
+ new_vect = g_make_vector_1(sc, set_plist_3(sc, g_vector_dimensions(sc, set_plist_1(sc, old_vect)), real_zero, sc->T), sc->make_float_vector_symbol);
+ else new_vect = make_vector_1(sc, len, NOT_FILLED, T_FLOAT_VECTOR);
+ /* if (len > 0) memcpy((void *)(float_vector_elements(new_vect)), (void *)(float_vector_elements(old_vect)), len * sizeof(s7_double)); */
+ src = (s7_double *)float_vector_elements(old_vect);
+ dst = (s7_double *)float_vector_elements(new_vect);
+ for (i = len; i > 0; i--) *dst++ = *src++;
+ }
+ else
+ {
+ if (is_int_vector(old_vect))
{
- q = cdr(a);
- set_cdr(a, p);
- p = a;
- a = q;
+ s7_int *src, *dst;
+ if (vector_rank(old_vect) > 1)
+ new_vect = g_make_vector_1(sc, set_plist_3(sc, g_vector_dimensions(sc, set_plist_1(sc, old_vect)), small_int(0), sc->T), sc->make_int_vector_symbol);
+ else new_vect = make_vector_1(sc, len, NOT_FILLED, T_INT_VECTOR);
+ /* if (len > 0) memcpy((void *)(int_vector_elements(new_vect)), (void *)(int_vector_elements(old_vect)), len * sizeof(s7_int)); */
+ src = (s7_int *)int_vector_elements(old_vect);
+ dst = (s7_int *)int_vector_elements(new_vect);
+ for (i = len; i > 0; i--) *dst++ = *src++;
}
- }
- return(p);
-}
+ else
+ {
+ s7_pointer *src, *dst;
+ if (vector_rank(old_vect) > 1)
+ new_vect = g_make_vector(sc, set_plist_1(sc, g_vector_dimensions(sc, list_1(sc, old_vect))));
+ else new_vect = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
-static int safe_list_length(s7_scheme *sc, s7_pointer a)
-{
- /* assume that "a" is a proper list */
- int i = 0;
- s7_pointer b;
- for (b = a; is_pair(b); i++, b = cdr(b)) {};
- return(i);
+ /* here and in vector-fill! we have a problem with bignums -- should new bignums be allocated? (copy_list also) */
+ /* if (len > 0) memcpy((void *)(vector_elements(new_vect)), (void *)(vector_elements(old_vect)), len * sizeof(s7_pointer)); */
+ src = (s7_pointer *)vector_elements(old_vect);
+ dst = (s7_pointer *)vector_elements(new_vect);
+ for (i = len; i > 0; i--) *dst++ = *src++;
+ }
+ }
+ return(new_vect);
}
-int s7_list_length(s7_scheme *sc, s7_pointer a)
+static s7_pointer univect_ref(s7_scheme *sc, s7_pointer args, bool flt)
{
- /* returns -len if list is dotted, 0 if it's (directly) circular */
- int i;
- s7_pointer slow, fast;
+ s7_pointer v, caller;
+ s7_int ind;
+ int typ;
- slow = fast = a;
- for (i = 0; ; i += 2)
+ caller = (flt) ? sc->float_vector_ref_symbol : sc->int_vector_ref_symbol;
+ typ = (flt) ? T_FLOAT_VECTOR : T_INT_VECTOR;
+
+ v = car(args);
+ if (type(v) != typ)
+ method_or_bust(sc, v, caller, args, typ, 1);
+
+ if (vector_rank(v) == 1)
{
- if (!is_pair(fast))
+ s7_pointer index;
+ index = cadr(args);
+ if (!s7_is_integer(index))
{
- if (is_null(fast))
- return(i);
- return(-i);
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, index, cdr(args))))
+ return(wrong_type_argument(sc, caller, 2, index, T_INTEGER));
+ else index = p;
}
-
- fast = cdr(fast);
- if (!is_pair(fast))
+ ind = s7_integer(index);
+ if ((ind < 0) || (ind >= vector_length(v)))
+ return(simple_out_of_range(sc, caller, index, (ind < 0) ? its_negative_string : its_too_large_string));
+ if (!is_null(cddr(args)))
+ return(out_of_range(sc, caller, small_int(2), cdr(args), too_many_indices_string));
+ }
+ else
+ {
+ unsigned int i;
+ s7_pointer x;
+ ind = 0;
+ for (x = cdr(args), i = 0; (is_not_null(x)) && (i < vector_ndims(v)); x = cdr(x), i++)
{
- if (is_null(fast))
- return(i + 1);
- return(-i - 1);
+ s7_int n;
+ if (!s7_is_integer(car(x)))
+ {
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, car(x), x)))
+ return(wrong_type_argument(sc, caller, i + 2, car(x), T_INTEGER));
+ n = s7_integer(p);
+ }
+ else n = s7_integer(car(x));
+ if ((n < 0) ||
+ (n >= vector_dimension(v, i)))
+ return(out_of_range(sc, caller, make_integer(sc, i + 2), car(x), (n < 0) ? its_negative_string : its_too_large_string));
+
+ ind += n * vector_offset(v, i);
}
- /* if unrolled further, it's a lot slower? */
+ if (is_not_null(x))
+ return(out_of_range(sc, caller, small_int(2), cdr(args), too_many_indices_string));
- fast = cdr(fast);
- slow = cdr(slow);
- if (fast == slow)
- return(0);
+ /* if not enough indices, return a shared vector covering whatever is left */
+ if (i < vector_ndims(v))
+ return(make_shared_vector(sc, v, i, ind));
}
- return(0);
+ if (flt)
+ return(make_real(sc, float_vector_element(v, ind)));
+ return(make_integer(sc, int_vector_element(v, ind)));
}
-/* -------------------------------- null? pair? -------------------------------- */
-static s7_pointer g_is_null(s7_scheme *sc, s7_pointer args)
+static s7_pointer univect_set(s7_scheme *sc, s7_pointer args, bool flt)
{
- #define H_is_null "(null? obj) returns #t if obj is the empty list"
- #define Q_is_null pl_bt
- check_boolean_method(sc, is_null, sc->is_null_symbol, args);
- /* as a generic this could be: has_structure and length == 0 */
-}
-
+ s7_pointer vec, val, caller;
+ s7_int index;
+ int typ;
-static s7_pointer g_is_pair(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_pair "(pair? obj) returns #t if obj is a pair (a non-empty list)"
- #define Q_is_pair pl_bt
- check_boolean_method(sc, is_pair, sc->is_pair_symbol, args);
-}
+ caller = (flt) ? sc->float_vector_set_symbol : sc->int_vector_set_symbol;
+ typ = (flt) ? T_FLOAT_VECTOR : T_INT_VECTOR;
+ vec = car(args);
+ if (type(vec) != typ)
+ method_or_bust(sc, vec, caller, args, typ, 1);
-/* -------------------------------- list? proper-list? -------------------------------- */
-bool s7_is_list(s7_scheme *sc, s7_pointer p)
-{
- return((is_pair(p)) ||
- (is_null(p)));
-}
+ if (vector_rank(vec) > 1)
+ {
+ unsigned int i;
+ s7_pointer x;
+ index = 0;
+ for (x = cdr(args), i = 0; (is_not_null(cdr(x))) && (i < vector_ndims(vec)); x = cdr(x), i++)
+ {
+ s7_int n;
+ if (!s7_is_integer(car(x)))
+ {
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, car(x), x)))
+ method_or_bust(sc, car(x), caller, args, T_INTEGER, i + 2);
+ n = s7_integer(p);
+ }
+ else n = s7_integer(car(x));
+ if ((n < 0) ||
+ (n >= vector_dimension(vec, i)))
+ return(out_of_range(sc, caller, make_integer(sc, i + 2), car(x), (n < 0) ? its_negative_string : its_too_large_string));
+ index += n * vector_offset(vec, i);
+ }
-static bool is_proper_list(s7_scheme *sc, s7_pointer lst)
-{
- /* #t if () or undotted/non-circular pair */
- s7_pointer slow, fast;
+ if (is_not_null(cdr(x)))
+ return(s7_wrong_number_of_args_error(sc, "too many args: ~S", args));
+ if (i != vector_ndims(vec))
+ return(s7_wrong_number_of_args_error(sc, "not enough args: ~S", args));
- fast = lst;
- slow = lst;
- while (true)
+ val = car(x);
+ }
+ else
{
- if (!is_pair(fast))
- return(is_null(fast)); /* else it's an improper list */
-
- fast = cdr(fast);
- if (!is_pair(fast)) return(is_null(fast));
+ if (!s7_is_integer(cadr(args)))
+ {
+ 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);
+ }
+ else index = s7_integer(cadr(args));
+ 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));
- fast = cdr(fast);
- if (!is_pair(fast)) return(is_null(fast));
+ if (is_not_null(cdddr(args)))
+ return(s7_wrong_number_of_args_error(sc, "too many args: ~S", args));
+ val = caddr(args);
+ }
- fast = cdr(fast);
- slow = cdr(slow);
- if (fast == slow) return(false);
+ if (flt)
+ {
+ if (!s7_is_real(val))
+ method_or_bust(sc, val, caller, args, T_REAL, 3);
+ float_vector_element(vec, index) = real_to_double(sc, val, "float-vector-set!");
}
- return(true);
+ else
+ {
+ if (!s7_is_integer(val))
+ method_or_bust(sc, val, caller, args, T_INTEGER, 3);
+ int_vector_element(vec, index) = s7_integer(val);
+ }
+ return(val);
}
-static s7_pointer g_is_list(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_float_vector_ref(s7_scheme *sc, s7_pointer args)
{
- #define H_is_list "(list? obj) returns #t if obj is a pair or null"
- #define Q_is_list pl_bt
- #define is_a_list(p) s7_is_list(sc, p)
- check_boolean_method(sc, is_a_list, sc->is_list_symbol, args);
+ #define H_float_vector_ref "(float-vector-ref v ...) returns an element of the float-vector v."
+ #define Q_float_vector_ref s7_make_circular_signature(sc, 2, 3, s7_make_signature(sc, 2, sc->is_float_symbol, sc->is_float_vector_symbol), sc->is_float_vector_symbol, sc->is_integer_symbol)
+ /* fprintf(stderr, "%s\n", DISPLAY_80(current_code(sc))); */
+ /* (lambda (y) (> (magnitude (- y (* 0.5 (float-vector-ref vals (floor (-..
+ (do ((sum 0.0) (len (min (length v1) (length v2))) (mx (float-vector-peak...
+ (* (env e1) (oscil osc (float-vector-ref x 0)))
+ (= (float-vector-ref (cadr qr) 0) 0.0)
+ (let ((wkm-k (float-vector-ref wkm k)) (old-wk1 (copy wk1))) (do ((j 0 (+ j
+ (set! unclipped-max (max unclipped-max (float-vector-ref data i)))
+ (set! tj (if (zero? (float-vector-ref radii j)) 1e-10 (* (float-vector-ref...
+ */
+ /* we need opt_let */
+ return(univect_ref(sc, args, true));
}
-
-/* -------------------------------- make-list -------------------------------- */
-static s7_pointer make_list(s7_scheme *sc, int len, s7_pointer init)
+static s7_double float_vector_ref_unchecked(s7_pointer v, s7_int i) {return(float_vector_element(v, i));}
+static s7_int ref_check_index(s7_pointer v, s7_int i)
{
- switch (len)
- {
- case 0: return(sc->nil);
- case 1: return(cons(sc, init, sc->nil));
- case 2: return(cons_unchecked(sc, init, cons(sc, init, sc->nil)));
- case 3: return(cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->nil))));
- case 4: return(cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->nil)))));
- case 5: return(cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init,
- cons_unchecked(sc, init, cons(sc, init, sc->nil))))));
- case 6: return(cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init,
- cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->nil)))))));
- case 7: return(cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init,
- cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->nil))))))));
- default:
- {
- s7_pointer result;
- int i;
-
- if (len >= (sc->free_heap_top - sc->free_heap))
- {
- gc(sc);
- while (len >= (sc->free_heap_top - sc->free_heap))
- resize_heap(sc);
- }
-
- sc->v = sc->nil;
- for (i = 0; i < len; i++)
- sc->v = cons_unchecked(sc, init, sc->v);
- result = sc->v;
- sc->v = sc->nil;
- return(result);
- }
- }
- return(sc->nil); /* never happens, I hope */
+ /* according to valgrind, it is faster to split out the bounds check */
+ if ((i < 0) || (i >= vector_length(v)))
+ out_of_range(cur_sc, cur_sc->float_vector_ref_symbol, small_int(2), make_integer(cur_sc, i), (i < 0) ? its_negative_string : its_too_large_string);
+ return(i);
}
+static s7_double float_vector_ref_d(s7_pointer v, s7_int i) {return(float_vector_element(v, ref_check_index(v, i)));}
+static s7_pointer float_vector_ref_unchecked_p(s7_pointer v, s7_int i) {return(float_vector_getter(cur_sc, v, i));}
-static s7_pointer g_make_list(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_float_vector_set(s7_scheme *sc, s7_pointer args)
{
- #define H_make_list "(make-list length (initial-element #f)) returns a list of 'length' elements whose value is 'initial-element'."
- #define Q_make_list s7_make_signature(sc, 3, sc->is_proper_list_symbol, sc->is_integer_symbol, sc->T)
-
- s7_pointer init;
- s7_int len;
-
- if (!s7_is_integer(car(args)))
- method_or_bust(sc, car(args), sc->make_list_symbol, args, T_INTEGER, 1);
-
- len = s7_integer(car(args)); /* needs to be s7_int here so that (make-list most-negative-fixnum) is handled correctly */
- if (len < 0)
- return(out_of_range(sc, sc->make_list_symbol, small_int(1), car(args), its_negative_string));
- if (len == 0) return(sc->nil); /* what about (make-list 0 123)? */
- if (len > sc->max_list_length)
- return(out_of_range(sc, sc->make_list_symbol, small_int(1), car(args), its_too_large_string));
-
- if (is_pair(cdr(args)))
- init = cadr(args);
- else init = sc->F;
- return(make_list(sc, (int)len, init));
+ #define H_float_vector_set "(float-vector-set! v i ... value) sets the i-th element of the float-vector v to value."
+ #define Q_float_vector_set s7_make_circular_signature(sc, 3, 4, sc->is_real_symbol, sc->is_float_vector_symbol, sc->is_integer_symbol, sc->is_integer_or_real_at_end_symbol)
+ return(univect_set(sc, args, true));
}
-static s7_pointer c_make_list(s7_scheme *sc, s7_int len) {return(make_list(sc, (int)len, sc->F));}
-IF_TO_PF(make_list, c_make_list)
-
-/* -------------------------------- list-ref -------------------------------- */
-static s7_pointer list_ref_ic;
-static s7_pointer g_list_ref_ic(s7_scheme *sc, s7_pointer args)
+static s7_double float_vector_set_unchecked(s7_pointer v, s7_int i, s7_double x) {float_vector_element(v, i) = x; return(x);}
+static s7_int set_check_index(s7_pointer v, s7_int i)
{
- s7_int i, index;
- s7_pointer lst, p;
-
- lst = car(args);
- if (!is_pair(lst))
- method_or_bust(sc, lst, sc->list_ref_symbol, args, T_PAIR, 1);
-
- index = s7_integer(cadr(args));
-
- for (i = 0, p = lst; (i < index) && is_pair(p); i++, p = cdr(p)) {}
-
- if (!is_pair(p))
- {
- if (is_null(p))
- return(out_of_range(sc, sc->list_ref_symbol, small_int(2), cadr(args), its_too_large_string));
- return(wrong_type_argument_with_type(sc, sc->list_ref_symbol, 1, lst, a_proper_list_string));
- }
- return(car(p));
+ if ((i < 0) || (i >= vector_length(v)))
+ out_of_range(cur_sc, cur_sc->float_vector_set_symbol, small_int(2), make_integer(cur_sc, i), (i < 0) ? its_negative_string : its_too_large_string);
+ return(i);
}
+static s7_double float_vector_set_d(s7_pointer v, s7_int i, s7_double x) {float_vector_element(v, (set_check_index(v, i))) = x; return(x);}
+static s7_pointer float_vector_set_unchecked_p(s7_pointer v, s7_int i, s7_pointer p) {return(float_vector_setter(cur_sc, v, i, p));}
-static s7_pointer list_ref_1(s7_scheme *sc, s7_pointer lst, s7_pointer ind)
+static s7_pointer g_int_vector_ref(s7_scheme *sc, s7_pointer args)
{
- s7_int i, index;
- s7_pointer p;
+ #define H_int_vector_ref "(int-vector-ref v ...) returns an element of the int-vector v."
+ #define Q_int_vector_ref s7_make_circular_signature(sc, 2, 3, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_int_vector_symbol), sc->is_int_vector_symbol, sc->is_integer_symbol)
+ /* actually here and in float-vector-ref, we could return a vector, not an integer: (int-vector-ref #i2d((1 2) (3 4)) 0) -> #i(1 2) */
+ return(univect_ref(sc, args, false));
+}
- if (!s7_is_integer(ind))
- {
- if (!s7_is_integer(p = check_values(sc, ind, cons(sc, ind, sc->nil))))
- method_or_bust(sc, ind, sc->list_ref_symbol, list_2(sc, lst, ind), T_INTEGER, 2);
- ind = p;
- }
- index = s7_integer(ind);
- if ((index < 0) || (index > sc->max_list_length))
- return(out_of_range(sc, sc->list_ref_symbol, small_int(2), ind, (index < 0) ? its_negative_string : its_too_large_string));
+static s7_int int_vector_ref_unchecked(s7_pointer v, s7_int i) {return(int_vector_element(v, i));}
+static s7_int int_vector_ref_i(s7_pointer v, s7_int i)
+{
+ if ((i < 0) || (i >= vector_length(v)))
+ out_of_range(cur_sc, cur_sc->int_vector_ref_symbol, small_int(2), make_integer(cur_sc, i), (i < 0) ? its_negative_string : its_too_large_string);
+ return(int_vector_element(v, i));
+}
+static s7_pointer int_vector_ref_unchecked_p(s7_pointer v, s7_int i) {return(int_vector_getter(cur_sc, v, i));}
- for (i = 0, p = lst; (i < index) && is_pair(p); i++, p = cdr(p)) {}
- if (!is_pair(p))
- {
- if (is_null(p))
- return(out_of_range(sc, sc->list_ref_symbol, small_int(2), ind, its_too_large_string));
- return(wrong_type_argument_with_type(sc, sc->list_ref_symbol, 1, lst, a_proper_list_string));
- }
- return(car(p));
+static s7_pointer g_int_vector_set(s7_scheme *sc, s7_pointer args)
+{
+ #define H_int_vector_set "(int-vector-set! v i ... value) sets the i-th element of the int-vector v to value."
+ #define Q_int_vector_set s7_make_circular_signature(sc, 2, 3, sc->is_integer_symbol, sc->is_int_vector_symbol, sc->is_integer_symbol)
+ return(univect_set(sc, args, false));
}
-
-static s7_pointer g_list_ref(s7_scheme *sc, s7_pointer args)
+static s7_int int_vector_set_unchecked(s7_pointer v, s7_int i, s7_int x) {int_vector_element(v, i) = x; return(x);}
+static s7_int int_vector_set_i(s7_pointer v, s7_int i, s7_int x)
{
- #define H_list_ref "(list-ref lst i ...) returns the i-th element (0-based) of the list"
- #define Q_list_ref s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_pair_symbol, sc->is_integer_symbol)
+ if ((i < 0) || (i >= vector_length(v)))
+ out_of_range(cur_sc, cur_sc->int_vector_set_symbol, small_int(2), make_integer(cur_sc, i), (i < 0) ? its_negative_string : its_too_large_string);
+ int_vector_element(v, i) = x;
+ return(x);
+}
+static s7_pointer int_vector_set_unchecked_p(s7_pointer v, s7_int i, s7_pointer p) {return(int_vector_setter(cur_sc, v, i, p));}
- /* (let ((L '((1 2 3) (4 5 6)))) (list-ref L 1 2))
- (define (lref L . args)
- (if (null? (cdr args))
- (list-ref L (car args))
- (apply lref (list-ref L (car args)) (cdr args))))
- */
- s7_pointer lst, inds;
+/* -------------------------------------------------------------------------------- */
- lst = car(args);
- if (!is_pair(lst))
- method_or_bust(sc, lst, sc->list_ref_symbol, args, T_PAIR, 1);
+static bool c_function_is_ok(s7_scheme *sc, s7_pointer x)
+{
+ /* macro version of this (below) is much slower! Since this is almost never false,
+ * I tried __builtin_expect throughout eval below. The result was not faster.
+ */
+ s7_pointer p;
- inds = cdr(args);
- while (true)
- {
- lst = list_ref_1(sc, lst, car(inds));
- if (is_null(cdr(inds)))
- return(lst);
- inds = cdr(inds);
- if (!is_pair(lst)) /* trying to avoid a cons here at the cost of one extra type check */
- return(implicit_index(sc, lst, inds));
- }
+ p = car(x); /* function name (symbol) */
+ if (is_global(p))
+ p = slot_value(global_slot(p));
+ else p = find_symbol_unchecked(sc, p);
+
+ /* this is nearly always global and p == opt_cfunc(x)
+ * p can be null if we evaluate some code, optimizing it, then eval it again in a context
+ * where the incoming p was undefined(!) -- explicit use of eval and so on.
+ * I guess ideally eval would ignore optimization info -- copy :readable or something.
+ */
+ return((p == opt_any1(x)) ||
+ ((is_any_c_function(p)) &&
+ (c_function_class(p) == c_function_class(opt_cfunc(x)))));
}
-static s7_pointer c_list_ref(s7_scheme *sc, s7_pointer x, s7_int index)
+static bool arglist_has_rest(s7_scheme *sc, s7_pointer args)
{
- int i;
s7_pointer p;
- if (!s7_is_pair(x))
- method_or_bust(sc, x, sc->list_ref_symbol, list_2(sc, x, make_integer(sc, index)), T_PAIR, 1);
- if (index < 0)
- return(out_of_range(sc, sc->list_ref_symbol, small_int(2), make_integer(sc, index), its_negative_string));
- for (i = 0, p = x; (i < index) && is_pair(p); i++, p = cdr(p)) {}
- if (!is_pair(p))
- {
- if (is_null(p))
- return(out_of_range(sc, sc->list_ref_symbol, small_int(2), make_integer(sc, index), its_too_large_string));
- return(wrong_type_argument_with_type(sc, sc->list_ref_symbol, 1, x, a_proper_list_string));
- }
- return(car(p));
+ for (p = args; is_pair(p); p = cdr(p))
+ if (car(p) == sc->key_rest_symbol)
+ return(true);
+ return(!is_null(p));
}
-PIF_TO_PF(list_ref, c_list_ref)
+/* -------- sort! -------- */
-/* -------------------------------- list-set! -------------------------------- */
-static s7_pointer g_list_set_1(s7_scheme *sc, s7_pointer lst, s7_pointer args, int arg_num)
+#if (!WITH_GMP)
+static int dbl_less(const void *f1, const void *f2)
{
- #define H_list_set "(list-set! lst i ... val) sets the i-th element (0-based) of the list to val"
- #define Q_list_set s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_pair_symbol, sc->T)
-
- int i;
- s7_int index;
- s7_pointer p, ind;
-
- /* (let ((L '((1 2 3) (4 5 6)))) (list-set! L 1 2 32) L) */
-
- if (!is_pair(lst))
- method_or_bust(sc, lst, sc->list_set_symbol, cons(sc, lst, args), T_PAIR, 1);
-
- ind = car(args);
- if (!s7_is_integer(ind))
- {
- if (!s7_is_integer(p = check_values(sc, ind, args)))
- method_or_bust(sc, ind, sc->list_set_symbol, cons(sc, lst, args), T_INTEGER, arg_num);
- ind = p;
- }
- index = s7_integer(ind);
- if ((index < 0) || (index > sc->max_list_length))
- return(out_of_range(sc, sc->list_set_symbol, small_int(arg_num), ind, (index < 0) ? its_negative_string : its_too_large_string));
+ if ((*((s7_double *)f1)) < (*((s7_double *)f2))) return(-1);
+ if ((*((s7_double *)f1)) > (*((s7_double *)f2))) return(1);
+ return(0);
+}
- for (i = 0, p = _TSet(lst); (i < index) && is_pair(p); i++, p = cdr(p)) {}
+static int int_less(const void *f1, const void *f2)
+{
+ if ((*((s7_int *)f1)) < (*((s7_int *)f2))) return(-1);
+ if ((*((s7_int *)f1)) > (*((s7_int *)f2))) return(1);
+ return(0);
+}
- if (!is_pair(p))
- {
- if (is_null(p))
- return(out_of_range(sc, sc->list_set_symbol, small_int(arg_num), ind, its_too_large_string));
- return(wrong_type_argument_with_type(sc, sc->list_set_symbol, 1, lst, a_proper_list_string));
- }
- if (is_null(cddr(args)))
- set_car(p, cadr(args));
- else return(g_list_set_1(sc, car(p), cdr(args), arg_num + 1));
+static int dbl_greater(const void *f1, const void *f2) {return(-dbl_less(f1, f2));}
+static int int_greater(const void *f1, const void *f2) {return(-int_less(f1, f2));}
- return(cadr(args));
+static int byte_less(const void *f1, const void *f2)
+{
+ if ((*((unsigned char *)f1)) < (*((unsigned char *)f2))) return(-1);
+ if ((*((unsigned char *)f1)) > (*((unsigned char *)f2))) return(1);
+ return(0);
}
+static int byte_greater(const void *f1, const void *f2) {return(-byte_less(f1, f2));}
-static s7_pointer g_list_set(s7_scheme *sc, s7_pointer args)
+static int dbl_less_2(const void *f1, const void *f2)
{
- return(g_list_set_1(sc, car(args), cdr(args), 2));
+ s7_pointer p1, p2;
+ p1 = (*((s7_pointer *)f1));
+ p2 = (*((s7_pointer *)f2));
+ if (real(p1) < real(p2)) return(-1);
+ if (real(p1) > real(p2)) return(1);
+ return(0);
}
-static int c_list_tester(s7_scheme *sc, s7_pointer expr)
+static int int_less_2(const void *f1, const void *f2)
{
- s7_pointer a1;
- a1 = cadr(expr);
- if (is_symbol(a1))
- {
- s7_pointer table;
- table = s7_slot(sc, a1);
- if ((is_slot(table)) &&
- ((is_immutable_symbol(a1)) || (!is_stepper(table))) &&
- (is_pair(slot_value(table))))
- {
- s7_xf_store(sc, slot_value(table));
- a1 = caddr(expr);
- if (is_symbol(a1))
- {
- s7_pointer slot;
- slot = s7_slot(sc, a1);
- if ((is_slot(slot)) &&
- (is_integer(slot_value(slot))))
- {
- s7_xf_store(sc, slot);
- return(TEST_SS);
- }
- }
- else
- {
- if (s7_arg_to_if(sc, a1))
- return(TEST_SI);
- }
- return(TEST_SQ);
- }
- }
- return(TEST_NO_S);
+ s7_pointer p1, p2;
+ p1 = (*((s7_pointer *)f1));
+ p2 = (*((s7_pointer *)f2));
+ if (integer(p1) < integer(p2)) return(-1);
+ if (integer(p1) > integer(p2)) return(1);
+ return(0);
}
-static s7_pointer c_list_set_s(s7_scheme *sc, s7_pointer lst, s7_int index, s7_pointer val)
+static int dbl_greater_2(const void *f1, const void *f2) {return(-dbl_less_2(f1, f2));}
+static int int_greater_2(const void *f1, const void *f2) {return(-int_less_2(f1, f2));}
+
+static int str_less_2(const void *f1, const void *f2)
{
- s7_int i;
- s7_pointer p;
+ s7_pointer p1, p2;
+ p1 = (*((s7_pointer *)f1));
+ p2 = (*((s7_pointer *)f2));
+ return(scheme_strcmp(p1, p2));
+}
- if ((index < 0) || (index > sc->max_list_length))
- return(out_of_range(sc, sc->list_set_symbol, small_int(2), make_integer(sc, index), (index < 0) ? its_negative_string : its_too_large_string));
+static int str_greater_2(const void *f1, const void *f2) {return(-str_less_2(f1, f2));}
- for (i = 0, p = lst; (i < index) && is_pair(p); i++, p = cdr(p)) {}
- if (!is_pair(p))
- {
- if (is_null(p))
- return(out_of_range(sc, sc->list_set_symbol, small_int(2), make_integer(sc, index), its_too_large_string));
- return(wrong_type_argument_with_type(sc, sc->list_set_symbol, 1, lst, a_proper_list_string));
- }
- set_car(p, val);
- return(val);
+static int chr_less_2(const void *f1, const void *f2)
+{
+ s7_pointer p1, p2;
+ p1 = (*((s7_pointer *)f1));
+ p2 = (*((s7_pointer *)f2));
+ if (character(p1) < character(p2)) return(-1);
+ if (character(p1) > character(p2)) return(1);
+ return(0);
}
-static s7_pointer c_list_set(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer val)
+static int chr_greater_2(const void *f1, const void *f2) {return(-chr_less_2(f1, f2));}
+#endif
+
+static s7_scheme *compare_sc;
+static s7_function compare_func;
+static s7_pointer compare_args, compare_begin, compare_v1, compare_v2;
+static opcode_t compare_op;
+static int compare_body_len = 0;
+static bool p_to_b(void *p);
+static int vector_compare(const void *v1, const void *v2)
{
- if (!s7_is_pair(vec))
- method_or_bust(sc, vec, sc->list_set_symbol, set_plist_3(sc, vec, make_integer(sc, index), val), T_PAIR, 1);
- return(c_list_set_s(sc, vec, index, val));
+ set_car(compare_args, (*(s7_pointer *)v1));
+ set_cadr(compare_args, (*(s7_pointer *)v2));
+ return(((*(compare_func))(compare_sc, compare_args) != compare_sc->F) ? -1 : 1);
}
-PIPF_TO_PF(list_set, c_list_set_s, c_list_set, c_list_tester)
-
-static s7_pointer list_set_ic;
-static s7_pointer g_list_set_ic(s7_scheme *sc, s7_pointer args)
+static int vector_car_compare(const void *v1, const void *v2)
{
- s7_pointer lst;
- lst = car(args);
- if (!is_pair(lst))
- method_or_bust(sc, lst, sc->list_set_symbol, args, T_PAIR, 1);
- return(c_list_set_s(sc, lst, s7_integer(cadr(args)), caddr(args)));
+ s7_pointer a, b;
+ a = (*(s7_pointer *)v1);
+ b = (*(s7_pointer *)v2);
+ set_car(compare_args, (is_pair(a)) ? car(a) : g_car(compare_sc, set_plist_1(compare_sc, a)));
+ set_cadr(compare_args, (is_pair(b)) ? car(b) : g_car(compare_sc, set_plist_1(compare_sc, b)));
+ return(((*(compare_func))(compare_sc, compare_args) != compare_sc->F) ? -1 : 1);
}
-
-/* -------------------------------- list-tail -------------------------------- */
-static s7_pointer c_list_tail(s7_scheme *sc, s7_pointer lst, s7_int index)
+static int vector_cdr_compare(const void *v1, const void *v2)
{
- s7_int i;
- s7_pointer p;
-
- if (!s7_is_list(sc, lst))
- method_or_bust_with_type(sc, lst, sc->list_tail_symbol, list_2(sc, lst, make_integer(sc, index)), a_list_string, 1);
+ s7_pointer a, b;
+ a = (*(s7_pointer *)v1);
+ b = (*(s7_pointer *)v2);
+ set_car(compare_args, (is_pair(a)) ? cdr(a) : g_cdr(compare_sc, set_plist_1(compare_sc, a)));
+ set_cadr(compare_args, (is_pair(b)) ? cdr(b) : g_cdr(compare_sc, set_plist_1(compare_sc, b)));
+ return(((*(compare_func))(compare_sc, compare_args) != compare_sc->F) ? -1 : 1);
+}
- if ((index < 0) || (index > sc->max_list_length))
- return(out_of_range(sc, sc->list_tail_symbol, small_int(2), make_integer(sc, index), (index < 0) ? its_negative_string : its_too_large_string));
+static int all_x_compare(const void *v1, const void *v2)
+{
+ slot_set_value(compare_v1, (*(s7_pointer *)v1));
+ slot_set_value(compare_v2, (*(s7_pointer *)v2));
+ return((compare_func(compare_sc, compare_args) != compare_sc->F) ? -1 : 1);
+}
- for (i = 0, p = lst; (i < index) && (is_pair(p)); i++, p = cdr(p)) {}
- if (i < index)
- return(out_of_range(sc, sc->list_tail_symbol, small_int(2), make_integer(sc, index), its_too_large_string));
- return(p);
+static int opt_bool_compare(const void *v1, const void *v2)
+{
+ slot_set_value(compare_v1, (*(s7_pointer *)v1));
+ slot_set_value(compare_v2, (*(s7_pointer *)v2));
+ compare_sc->pc = 0; /* always opt_bool_call here, so insert it */
+ return((compare_sc->opts[0]->v7.fb(compare_sc->opts[0])) ? -1 : 1);
}
-static s7_pointer g_list_tail(s7_scheme *sc, s7_pointer args)
+static int opt_bool_compare_p(const void *v1, const void *v2)
{
- #define H_list_tail "(list-tail lst i) returns the list from the i-th element on"
- #define Q_list_tail s7_make_signature(sc, 3, sc->is_list_symbol, sc->is_pair_symbol, sc->is_integer_symbol)
- s7_pointer p;
+ slot_set_value(compare_v1, (*(s7_pointer *)v1));
+ slot_set_value(compare_v2, (*(s7_pointer *)v2));
+ compare_sc->pc = 0;
+ return((compare_sc->opts[0]->v8.fp(compare_sc->opts[0]) == compare_sc->F) ? 1 : -1);
+}
- p = cadr(args);
- if (!s7_is_integer(p))
+static int opt_begin_bool_compare_b(const void *v1, const void *v2)
+{
+ int i;
+ opt_info *o;
+ slot_set_value(compare_v1, (*(s7_pointer *)v1));
+ slot_set_value(compare_v2, (*(s7_pointer *)v2));
+ compare_sc->pc = -1;
+ for (i = 0; i < compare_body_len - 1; i++)
{
- s7_pointer p1;
- if (!s7_is_integer(p1 = check_values(sc, p, cdr(args))))
- method_or_bust(sc, p, sc->list_tail_symbol, args, T_INTEGER, 2);
- p = p1;
+ o = compare_sc->opts[++compare_sc->pc];
+ o->v7.fp(o);
}
- return(c_list_tail(sc, car(args), s7_integer(p)));
+ o = compare_sc->opts[++compare_sc->pc];
+ return((o->v7.fb(o)) ? -1 : 1);
}
-PIF_TO_PF(list_tail, c_list_tail)
-
-
-/* -------------------------------- cons -------------------------------- */
-static s7_pointer g_cons(s7_scheme *sc, s7_pointer args)
+static int opt_begin_bool_compare_p(const void *v1, const void *v2)
{
- /* n-ary cons could be the equivalent of CL's list*? */
- /* it would be neater to have a single cons cell able to contain (directly) any number of elements */
- /* (set! (cadr (cons 1 2 3)) 4) -> (1 4 . 3) */
-
- #define H_cons "(cons a b) returns a pair containing a and b"
- #define Q_cons s7_make_signature(sc, 3, sc->is_pair_symbol, sc->T, sc->T)
-
- /* set_cdr(args, cadr(args));
- * this is not safe -- it changes a variable's value directly:
- * (let ((lst (list 1 2))) (list (apply cons lst) lst)) -> '((1 . 2) (1 . 2))
- */
- s7_pointer x;
+ int i;
+ opt_info *o;
+ s7_pointer val;
+ slot_set_value(compare_v1, (*(s7_pointer *)v1));
+ slot_set_value(compare_v2, (*(s7_pointer *)v2));
+ compare_sc->pc = -1;
+ for (i = 0; i < compare_body_len - 1; i++)
+ {
+ o = compare_sc->opts[++compare_sc->pc];
+ o->v7.fp(o);
+ }
+ o = compare_sc->opts[++compare_sc->pc];
+ val = o->v7.fp(o);
+ return((val != compare_sc->F) ? -1 : 1);
+}
- new_cell(sc, x, T_PAIR | T_SAFE_PROCEDURE);
- set_car(x, car(args));
- set_cdr(x, cadr(args));
- return(x);
+static int closure_compare(const void *v1, const void *v2)
+{
+ slot_set_value(compare_v1, (*(s7_pointer *)v1));
+ slot_set_value(compare_v2, (*(s7_pointer *)v2));
+ push_stack(compare_sc, OP_EVAL_DONE, compare_sc->args, compare_sc->code);
+ compare_sc->code = compare_args; /* this should be ok because we checked in advance that it is a safe closure (no sort! for example) */
+ eval(compare_sc, compare_op);
+ return((compare_sc->value != compare_sc->F) ? -1 : 1);
}
-PF2_TO_PF(cons, s7_cons)
+static int closure_compare_begin(const void *v1, const void *v2)
+{
+ slot_set_value(compare_v1, (*(s7_pointer *)v1));
+ slot_set_value(compare_v2, (*(s7_pointer *)v2));
+ push_stack(compare_sc, OP_EVAL_DONE, compare_sc->args, compare_sc->code);
+ push_stack_no_args(compare_sc, OP_BEGIN1, compare_begin);
+ compare_sc->code = compare_args;
+ eval(compare_sc, compare_op);
+ return((compare_sc->value != compare_sc->F) ? -1 : 1);
+}
-static void init_car_a_list(void)
+static s7_pointer g_sort(s7_scheme *sc, s7_pointer args)
{
- car_a_list_string = s7_make_permanent_string("a list whose car is also a list");
- cdr_a_list_string = s7_make_permanent_string("a list whose cdr is also a list");
+ #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)
- caar_a_list_string = s7_make_permanent_string("a list whose caar is also a list");
- cadr_a_list_string = s7_make_permanent_string("a list whose cadr is also a list");
- cdar_a_list_string = s7_make_permanent_string("a list whose cdar is also a list");
- cddr_a_list_string = s7_make_permanent_string("a list whose cddr is also a list");
+ s7_pointer data, lessp, lx;
+ s7_int len = 0, n, k;
+ int (*sort_func)(const void *v1, const void *v2);
+ s7_pointer *elements;
+ unsigned int gc_loc = 0;
- caaar_a_list_string = s7_make_permanent_string("a list whose caaar is also a list");
- caadr_a_list_string = s7_make_permanent_string("a list whose caadr is also a list");
- cadar_a_list_string = s7_make_permanent_string("a list whose cadar is also a list");
- caddr_a_list_string = s7_make_permanent_string("a list whose caddr is also a list");
- cdaar_a_list_string = s7_make_permanent_string("a list whose cdaar is also a list");
- cdadr_a_list_string = s7_make_permanent_string("a list whose cdadr is also a list");
- cddar_a_list_string = s7_make_permanent_string("a list whose cddar is also a list");
- cdddr_a_list_string = s7_make_permanent_string("a list whose cdddr is also a list");
+ /* both the intermediate vector (if any) and the current args pointer need GC protection,
+ * but it is a real bother to unprotect args at every return statement, so I'll use temp3
+ */
+ sc->temp3 = args; /* this is needed! */
+ data = car(args);
+ if (is_null(data))
+ {
+ /* (apply sort! () #f) should be an error I think */
+ lessp = cadr(args);
+ if (type(lessp) < T_GOTO)
+ method_or_bust_with_type(sc, lessp, sc->sort_symbol, args, a_procedure_string, 2);
+ if (!s7_is_aritable(sc, lessp, 2))
+ return(wrong_type_argument_with_type(sc, sc->sort_symbol, 2, lessp, an_eq_func_string));
+ return(sc->nil);
+ }
- a_list_string = s7_make_permanent_string("a list");
- an_eq_func_string = s7_make_permanent_string("a procedure that can take 2 arguments");
- an_association_list_string = s7_make_permanent_string("an association list");
- a_normal_real_string = s7_make_permanent_string("a normal real");
- a_rational_string = s7_make_permanent_string("an integer or a ratio");
- a_number_string = s7_make_permanent_string("a number");
- a_procedure_string = s7_make_permanent_string("a procedure");
- a_normal_procedure_string = s7_make_permanent_string("a normal procedure (not a continuation)");
- a_let_string = s7_make_permanent_string("a let (environment)");
- a_proper_list_string = s7_make_permanent_string("a proper list");
- a_boolean_string = s7_make_permanent_string("a boolean");
- an_input_port_string = s7_make_permanent_string("an input port");
- an_open_port_string = s7_make_permanent_string("an open port");
- an_output_port_string = s7_make_permanent_string("an output port");
- an_input_string_port_string = s7_make_permanent_string("an input string port");
- an_input_file_port_string = s7_make_permanent_string("an input file port");
- an_output_string_port_string = s7_make_permanent_string("an output string port");
- an_output_file_port_string = s7_make_permanent_string("an output file port");
- a_thunk_string = s7_make_permanent_string("a thunk");
- a_symbol_string = s7_make_permanent_string("a symbol");
- a_non_negative_integer_string = s7_make_permanent_string("a non-negative integer");
- an_unsigned_byte_string = s7_make_permanent_string("an unsigned byte");
- something_applicable_string = s7_make_permanent_string("a procedure or something applicable");
- a_random_state_object_string = s7_make_permanent_string("a random-state object");
- a_format_port_string = s7_make_permanent_string("#f, #t, or an open output port");
- a_binding_string = s7_make_permanent_string("a pair whose car is a symbol: '(symbol . value)");
- a_non_constant_symbol_string = s7_make_permanent_string("a non-constant symbol");
- a_sequence_string = s7_make_permanent_string("a sequence");
- a_valid_radix_string = s7_make_permanent_string("should be between 2 and 16");
- result_is_too_large_string = s7_make_permanent_string("result is too large");
- its_too_large_string = s7_make_permanent_string("it is too large");
- its_too_small_string = s7_make_permanent_string("it is less than the start position");
- its_negative_string = s7_make_permanent_string("it is negative");
- its_nan_string = s7_make_permanent_string("NaN usually indicates a numerical error");
- its_infinite_string = s7_make_permanent_string("it is infinite");
- too_many_indices_string = s7_make_permanent_string("too many indices");
-#if (!HAVE_COMPLEX_NUMBERS)
- no_complex_numbers_string = s7_make_permanent_string("this version of s7 does not support complex numbers");
-#endif
-}
+ if ((sc->safety > NO_SAFETY) &&
+ (is_immutable(data)))
+ return(s7_error(sc, sc->error_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't sort! ~S (it is immutable)"), data)));
+ lessp = cadr(args);
+ if (type(lessp) < T_GOTO)
+ method_or_bust_with_type(sc, lessp, sc->sort_symbol, args, a_procedure_string, 2);
+ if (!s7_is_aritable(sc, lessp, 2))
+ return(wrong_type_argument_with_type(sc, sc->sort_symbol, 2, lessp, an_eq_func_string));
-/* -------- car -------- */
-static s7_pointer g_car_1(s7_scheme *sc, s7_pointer lst)
-{
- if (!is_pair(lst))
- method_or_bust(sc, lst, sc->car_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- return(car(lst));
-}
+ if ((is_continuation(lessp)) || is_goto(lessp))
+ return(wrong_type_argument_with_type(sc, sc->sort_symbol, 2, lessp, a_normal_procedure_string));
-static s7_pointer g_car(s7_scheme *sc, s7_pointer args)
-{
- #define H_car "(car pair) returns the first element of the pair"
- #define Q_car pl_p
+ sort_func = vector_compare;
+ compare_func = NULL;
+ compare_args = sc->t2_1;
+ compare_sc = sc;
- s7_pointer lst;
- lst = car(args);
- if (!is_pair(lst))
- method_or_bust(sc, lst, sc->car_symbol, args, T_PAIR, 0);
- return(car(lst));
-}
+ if ((is_safe_procedure(lessp)) && /* (sort! a <) */
+ (is_c_function(lessp)))
+ {
+ s7_pointer sig;
+ sig = c_function_signature(lessp);
+ if ((sig) &&
+ (is_pair(sig)) &&
+ (car(sig) != sc->is_boolean_symbol))
+ return(wrong_type_argument_with_type(sc, sc->sort_symbol, 2, lessp, make_string_wrapper(sc, "sort! function should return a boolean")));
+ compare_func = c_function_call(lessp);
+ }
+ else
+ {
+ if (is_closure(lessp))
+ {
+ s7_pointer expr, largs;
+ expr = car(closure_body(lessp));
+ largs = closure_args(lessp);
+
+ if ((is_pair(largs)) && /* closure args not a symbol, etc */
+ (!arglist_has_rest(sc, largs)))
+ {
+ if (is_null(cdr(closure_body(lessp))))
+ {
+ if ((is_optimized(expr)) &&
+ /* since (sort seq (lambda (a b) ...)) can't return a "safe closure" (the hop bit is off in
+ * optimize in this case, for some arcane reason), the optimized expression won't be hop_safe,
+ * 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))))
+ {
+ int 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) &&
+ (car(largs) == cadr(expr)) &&
+ (cadr(largs) == caddr(expr)))
+ {
+ lessp = find_symbol_unchecked(sc, car(expr));
+ compare_func = c_function_call(lessp);
+ }
+ else
+ {
+ if ((optimize_op(expr) == HOP_SAFE_C_opSq_opSq) &&
+ ((caadr(expr) == sc->car_symbol) || (caadr(expr) == sc->cdr_symbol)) &&
+ (caadr(expr) == caaddr(expr)) &&
+ (car(largs) == cadadr(expr)) &&
+ (cadr(largs) == cadr(caddr(expr))))
+ {
+ lessp = find_symbol_unchecked(sc, car(expr));
+ compare_func = c_function_call(lessp);
+ sort_func = ((caadr(expr) == sc->car_symbol) ? vector_car_compare : vector_cdr_compare);
+ }
+ }
+ set_optimize_op(expr, orig_data);
+ }
+ }
+
+ if (!compare_func)
+ {
+ s7_pointer init_val, old_e;
+ if (is_float_vector(data))
+ init_val = real_zero;
+ else
+ {
+ if (is_int_vector(data))
+ init_val = small_int(0);
+ else init_val = sc->F;
+ }
+ old_e = sc->envir;
+ new_frame_with_two_slots(sc, closure_let(lessp), sc->envir, car(largs), init_val, cadr(largs), init_val);
+ compare_args = expr;
+ compare_v1 = let_slots(sc->envir);
+ compare_v2 = next_slot(let_slots(sc->envir));
+ if (is_null(cdr(closure_body(lessp))))
+ {
+ compare_func = s7_bool_optimize(sc, closure_body(lessp));
+ if (compare_func)
+ {
+ if (compare_func == opt_bool_any)
+ {
+ if (sc->opts[0]->v7.fb == p_to_b)
+ sort_func = opt_bool_compare_p;
+ else sort_func = opt_bool_compare;
+ }
+ else sort_func = all_x_compare;
+ }
+ }
+ else
+ {
+ if (setjmp(sc->opt_exit) == 0)
+ {
+ s7_pointer p;
+ compare_body_len = s7_list_length(sc, closure_body(lessp));
+ sc->pc = 0;
+ for (p = closure_body(lessp); is_pair(cdr(p)); p = cdr(p))
+ if (!cell_optimize(sc, p))
+ break;
+ if (is_null(cdr(p)))
+ {
+ int start;
+ start = sc->pc;
+ if (bool_optimize_nw(sc, p))
+ {
+ compare_func = opt_bool_any;
+ sort_func = opt_begin_bool_compare_b;
+ }
+ else
+ {
+ pc_fallback(sc, start);
+ if (cell_optimize(sc, p))
+ {
+ compare_func = opt_bool_any;
+ sort_func = opt_begin_bool_compare_p;
+ }
+ }
+ }
+ }
+ }
+ if (!compare_func)
+ sc->envir = old_e;
+ }
+
+ if ((!compare_func) &&
+ (is_safe_closure(lessp))) /* no embedded sort! or call/cc, etc */
+ {
+ new_frame_with_two_slots(sc, closure_let(lessp), sc->envir, car(largs), sc->F, cadr(largs), sc->F);
+ compare_func = (s7_function)lessp; /* not used -- just a flag */
+ compare_args = car(closure_body(lessp));
+ compare_begin = cdr(closure_body(lessp));
+ if (is_null(compare_begin))
+ sort_func = closure_compare;
+ else sort_func = closure_compare_begin;
+ if (typesflag(compare_args) == SYNTACTIC_PAIR)
+ {
+ compare_op = (opcode_t)pair_syntax_op(compare_args);
+ compare_args = cdr(compare_args);
+ }
+ else compare_op = OP_EVAL;
+ compare_v1 = let_slots(sc->envir);
+ compare_v2 = next_slot(let_slots(sc->envir));
+ }
+ }
+ }
+ }
-PF_TO_PF(car, g_car_1)
+ if (compare_func == g_strings_are_less)
+ compare_func = g_string_less_2;
+ else
+ {
+ if (compare_func == g_strings_are_greater)
+ compare_func = g_string_greater_2;
+ else
+ {
+ if (compare_func == g_chars_are_less)
+ compare_func = g_char_less_2;
+ else
+ {
+ if (compare_func == g_chars_are_greater)
+ compare_func = g_char_greater_2;
+ }
+ }
+ }
+#if (!WITH_GMP)
+ if (compare_func == g_less)
+ compare_func = g_less_2;
+ else
+ {
+ if (compare_func == g_greater)
+ compare_func = g_greater_2;
+ }
+#endif
+ switch (type(data))
+ {
+ case T_PAIR:
+ len = s7_list_length(sc, data); /* 0 here == infinite */
+ if (len <= 0)
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "sort! argument 1 should be a proper list: ~S"), data)));
+ if (len < 2)
+ return(data);
+ if (compare_func)
+ {
+ s7_int i;
+ s7_pointer vec, p;
-static s7_pointer g_set_car(s7_scheme *sc, s7_pointer args)
-{
- #define H_set_car "(set-car! pair val) sets the pair's first element to val"
- #define Q_set_car s7_make_signature(sc, 3, sc->T, sc->is_pair_symbol, sc->T)
- s7_pointer p;
+ vec = g_vector(sc, data);
+ gc_loc = s7_gc_protect(sc, vec);
+ elements = s7_vector_elements(vec);
- p = car(args);
- if (!is_pair(p))
- method_or_bust(sc, p, sc->set_car_symbol, args, T_PAIR, 1);
+ sc->v = vec;
+ qsort((void *)elements, len, sizeof(s7_pointer), sort_func);
+ for (p = data, i = 0; i < len; i++, p = cdr(p))
+ set_car(p, elements[i]);
- set_car(p, cadr(args));
- return(car(p));
-}
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(data);
+ }
-static s7_pointer c_set_car(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- if (!is_pair(x))
- method_or_bust(sc, x, sc->set_car_symbol, set_plist_2(sc, x, y), T_PAIR, 1);
- set_car(x, y);
- return(y);
-}
+ push_stack(sc, OP_SORT_PAIR_END, cons(sc, data, lessp), sc->code); /* save and gc protect the original list and func */
+ set_car(args, g_vector(sc, data));
+ break;
-PF2_TO_PF(set_car, c_set_car)
+ case T_STRING:
+ {
+ /* byte-vectors here also, so this isn't completely silly */
+ s7_int i;
+ s7_pointer vec;
+ unsigned char *chrs;
+ len = string_length(data);
+ if (len < 2)
+ return(data);
-/* -------- cdr -------- */
-static s7_pointer g_cdr_1(s7_scheme *sc, s7_pointer lst)
-{
- if (!is_pair(lst))
- method_or_bust(sc, lst, sc->cdr_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- return(cdr(lst));
-}
+#if (!WITH_GMP)
+ if (is_c_function(lessp))
+ {
+ if (((!is_byte_vector(data)) && (compare_func == g_char_less_2)) ||
+ ((is_byte_vector(data)) && (compare_func == g_less_2)))
+ {
+ qsort((void *)vector_elements(data), len, sizeof(unsigned char), byte_less);
+ return(data);
+ }
+ if (((!is_byte_vector(data)) && (compare_func == g_char_greater_2)) ||
+ ((is_byte_vector(data)) && (compare_func == g_greater_2)))
+ {
+ qsort((void *)vector_elements(data), len, sizeof(unsigned char), byte_greater);
+ return(data);
+ }
+ }
+#endif
-static s7_pointer g_cdr(s7_scheme *sc, s7_pointer args)
-{
- #define H_cdr "(cdr pair) returns the second element of the pair"
- #define Q_cdr pl_p
+ vec = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
+ gc_loc = s7_gc_protect(sc, vec);
+ elements = s7_vector_elements(vec);
+ chrs = (unsigned char *)string_value(data);
- s7_pointer lst;
- lst = car(args);
- if (!is_pair(lst))
- method_or_bust(sc, lst, sc->cdr_symbol, args, T_PAIR, 0);
- return(cdr(lst));
-}
+ if (is_byte_vector(data))
+ {
+ for (i = 0; i < len; i++)
+ elements[i] = small_int(chrs[i]);
+ }
+ else
+ {
+ for (i = 0; i < len; i++)
+ elements[i] = chars[chrs[i]];
+ }
-PF_TO_PF(cdr, g_cdr_1)
+ if (compare_func)
+ {
+ sc->v = vec;
+ qsort((void *)elements, len, sizeof(s7_pointer), sort_func);
+ if (is_byte_vector(data))
+ {
+ for (i = 0; i < len; i++)
+ chrs[i] = (char)integer(elements[i]);
+ }
+ else
+ {
+ for (i = 0; i < len; i++)
+ chrs[i] = character(elements[i]);
+ }
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(data);
+ }
-static s7_pointer g_set_cdr(s7_scheme *sc, s7_pointer args)
-{
- #define H_set_cdr "(set-cdr! pair val) sets the pair's second element to val"
- #define Q_set_cdr s7_make_signature(sc, 3, sc->T, sc->is_pair_symbol, sc->T)
- s7_pointer p;
+ push_stack(sc, OP_SORT_STRING_END, cons(sc, data, lessp), sc->code);
+ set_car(args, vec);
+ s7_gc_unprotect_at(sc, gc_loc);
+ }
+ break;
- p = car(args);
- if (!is_pair(p))
- method_or_bust(sc, p, sc->set_cdr_symbol, args, T_PAIR, 1);
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ {
+ s7_int i;
+ s7_pointer vec;
- set_cdr(p, cadr(args));
- return(cdr(p));
-}
+ len = vector_length(data);
+ if (len < 2)
+ return(data);
+#if (!WITH_GMP)
+ if (is_c_function(lessp))
+ {
+ if (compare_func == g_less_2)
+ {
+ if (is_float_vector(data))
+ qsort((void *)vector_elements(data), len, sizeof(s7_double), dbl_less);
+ else qsort((void *)vector_elements(data), len, sizeof(s7_int), int_less);
+ return(data);
+ }
+ if (compare_func == g_greater_2)
+ {
+ if (is_float_vector(data))
+ qsort((void *)vector_elements(data), len, sizeof(s7_double), dbl_greater);
+ else qsort((void *)vector_elements(data), len, sizeof(s7_int), int_greater);
+ return(data);
+ }
+ }
+#endif
-static s7_pointer c_set_cdr(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- if (!is_pair(x))
- method_or_bust(sc, x, sc->set_cdr_symbol, set_plist_2(sc, x, y), T_PAIR, 1);
- set_cdr(x, y);
- return(y);
-}
+ /* currently we have to make the ordinary vector here even if not compare_func
+ * because the sorter uses vector_element to access sort args (see SORT_DATA in eval).
+ * This is probably better than passing down getter/setter (fewer allocations).
+ * get/set macro in eval is SORT_DATA(k) then s7_vector_to_list if pair at start (sort_*_end)
+ */
+ vec = make_vector_1(sc, len, FILLED, T_VECTOR);
+ /* we need this vector prefilled because vector_getter below makes reals/int, causing possible GC
+ * at any time during that loop, and the GC mark process expects the vector to have an s7_pointer
+ * at every element.
+ */
+ gc_loc = s7_gc_protect(sc, vec);
+ elements = s7_vector_elements(vec);
-PF2_TO_PF(set_cdr, c_set_cdr)
+ for (i = 0; i < len; i++)
+ elements[i] = vector_getter(data)(sc, data, i);
+ if (compare_func)
+ {
+ sc->v = vec;
+ qsort((void *)elements, len, sizeof(s7_pointer), sort_func);
+ for (i = 0; i < len; i++)
+ vector_setter(data)(sc, data, i, elements[i]);
-/* -------- caar --------*/
-static s7_pointer g_caar_1(s7_scheme *sc, s7_pointer lst)
-{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->caar_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caar_symbol, lst, car_a_list_string));
- /* it makes no difference in timing to move lst here or below (i.e. lst=car(lst) then return(car(lst)) and so on) */
- return(caar(lst));
-}
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(data);
+ }
-static s7_pointer g_caar(s7_scheme *sc, s7_pointer args)
-{
- #define H_caar "(caar lst) returns (car (car lst)): (caar '((1 2))) -> 1"
- #define Q_caar pl_p
+ push_stack(sc, OP_SORT_VECTOR_END, cons(sc, data, lessp), sc->code); /* save and gc protect the original homogeneous vector and func */
+ set_car(args, vec);
+ s7_gc_unprotect_at(sc, gc_loc);
+ }
+ break;
- s7_pointer lst;
- lst = car(args);
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->caar_symbol, args, T_PAIR, 0);
- if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caar_symbol, lst, car_a_list_string));
- /* it makes no difference in timing to move lst here or below (i.e. lst=car(lst) then return(car(lst)) and so on) */
- return(caar(lst));
-}
+ case T_VECTOR:
+ len = vector_length(data);
+ if (len < 2)
+ return(data);
+ if (compare_func)
+ {
+ /* here if, for example, compare_func == string<?, we could precheck for strings,
+ * then qsort without the type checks. Also common is (lambda (a b) (f (car a) (car b))).
+ */
+#if (!WITH_GMP)
+ if ((compare_func == g_less_2) || (compare_func == g_greater_2) ||
+ (compare_func == g_string_less_2) || (compare_func == g_string_greater_2) ||
+ (compare_func == g_char_less_2) || (compare_func == g_char_greater_2))
+ {
+ int typ;
+ s7_pointer *els;
+ els = s7_vector_elements(data);
+ typ = type(els[0]);
+ if ((typ == T_INTEGER) || (typ == T_REAL) || (typ == T_STRING) || (typ == T_CHARACTER))
+ {
+ s7_int i;
+ for (i = 1; i < len; i++)
+ if (type(els[i]) != typ)
+ {
+ typ = T_FREE;
+ break;
+ }
+ }
+ if ((compare_func == g_less_2) || (compare_func == g_greater_2))
+ {
+ if (typ == T_INTEGER)
+ {
+ qsort((void *)els, len, sizeof(s7_pointer), ((compare_func == g_less_2) ? int_less_2 : int_greater_2));
+ return(data);
+ }
+ if (typ == T_REAL)
+ {
+ qsort((void *)els, len, sizeof(s7_pointer), ((compare_func == g_less_2) ? dbl_less_2 : dbl_greater_2));
+ return(data);
+ }
+ }
+ if ((typ == T_STRING) &&
+ ((compare_func == g_string_less_2) || (compare_func == g_string_greater_2)))
+ {
+ qsort((void *)els, len, sizeof(s7_pointer), ((compare_func == g_string_less_2) ? str_less_2 : str_greater_2));
+ return(data);
+ }
+ if ((typ == T_CHARACTER) &&
+ ((compare_func == g_char_less_2) || (compare_func == g_char_greater_2)))
+ {
+ qsort((void *)els, len, sizeof(s7_pointer), ((compare_func == g_char_less_2) ? chr_less_2 : chr_greater_2));
+ return(data);
+ }
+ }
+#endif
+ qsort((void *)s7_vector_elements(data), len, sizeof(s7_pointer), sort_func);
+ return(data);
+ }
+ break;
-PF_TO_PF(caar, g_caar_1)
+ default:
+ method_or_bust_with_type(sc, data, sc->sort_symbol, args, a_sequence_string, 1);
+ }
+ n = len - 1;
+ k = ((int)(n / 2)) + 1;
-/* -------- cadr --------*/
-static s7_pointer g_cadr_1(s7_scheme *sc, s7_pointer lst)
-{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cadr_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadr_symbol, lst, cdr_a_list_string));
- return(cadr(lst));
-}
+ lx = s7_make_vector(sc, (sc->safety == NO_SAFETY) ? 4 : 6);
+ gc_loc = s7_gc_protect(sc, lx);
+ sc->v = lx;
-static s7_pointer g_cadr(s7_scheme *sc, s7_pointer args)
-{
- #define H_cadr "(cadr lst) returns (car (cdr lst)): (cadr '(1 2 3)) -> 2"
- #define Q_cadr pl_p
+ vector_element(lx, 0) = make_mutable_integer(sc, n);
+ vector_element(lx, 1) = make_mutable_integer(sc, k);
+ vector_element(lx, 2) = make_mutable_integer(sc, 0);
+ vector_element(lx, 3) = make_mutable_integer(sc, 0);
+ if (sc->safety > NO_SAFETY)
+ {
+ vector_element(lx, 4) = make_mutable_integer(sc, 0);
+ vector_element(lx, 5) = make_integer(sc, n * n);
+ }
+ push_stack(sc, OP_SORT, args, lx);
+ s7_gc_unprotect_at(sc, gc_loc);
- s7_pointer lst;
- lst = car(args);
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cadr_symbol, args, T_PAIR, 0);
- if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadr_symbol, lst, cdr_a_list_string));
- return(cadr(lst));
+ return(sc->F);
+ /* if the comparison function waffles, sort! can hang: (sort! '(1 2 3) (lambda (a b) (= a b)))
+ * set 'safety to 1 to add a check for this loop, but the "safe" procedures are direct, so unchecked.
+ */
}
-PF_TO_PF(cadr, g_cadr_1)
-
-
-/* -------- cdar -------- */
-static s7_pointer g_cdar_1(s7_scheme *sc, s7_pointer lst)
-{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cdar_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdar_symbol, lst, car_a_list_string));
- return(cdar(lst));
-}
-static s7_pointer g_cdar(s7_scheme *sc, s7_pointer args)
+/* these are for the eval sort -- sort a vector, then if necessary put that data into the original sequence */
+static s7_pointer vector_into_list(s7_pointer vect, s7_pointer lst)
{
- #define H_cdar "(cdar lst) returns (cdr (car lst)): (cdar '((1 2 3))) -> '(2 3)"
- #define Q_cdar pl_p
-
- s7_pointer lst;
- lst = car(args);
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cdar_symbol, args, T_PAIR, 0);
- if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdar_symbol, lst, car_a_list_string));
- return(cdar(lst));
-}
-
-PF_TO_PF(cdar, g_cdar_1)
-
+ s7_pointer p;
+ s7_pointer *elements;
+ int i, len;
-/* -------- cddr -------- */
-static s7_pointer g_cddr_1(s7_scheme *sc, s7_pointer lst)
-{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cddr_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddr_symbol, lst, cdr_a_list_string));
- return(cddr(lst));
+ elements = s7_vector_elements(vect);
+ len = vector_length(vect);
+ for (i = 0, p = lst; i < len; i++, p = cdr(p))
+ set_car(p, elements[i]);
+ return(lst);
}
-static s7_pointer g_cddr(s7_scheme *sc, s7_pointer args)
+static s7_pointer vector_into_fi_vector(s7_pointer source, s7_pointer dest)
{
- #define H_cddr "(cddr lst) returns (cdr (cdr lst)): (cddr '(1 2 3 4)) -> '(3 4)"
- #define Q_cddr pl_p
+ s7_pointer *elements;
+ int i, len;
- s7_pointer lst;
- lst = car(args);
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cddr_symbol, args, T_PAIR, 0);
- if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddr_symbol, lst, cdr_a_list_string));
- return(cddr(lst));
+ elements = s7_vector_elements(source);
+ len = vector_length(source);
+
+ if (is_float_vector(dest))
+ {
+ s7_double *flts;
+ flts = float_vector_elements(dest);
+ for (i = 0; i < len; i++)
+ flts[i] = real(elements[i]);
+ }
+ else
+ {
+ s7_int *ints;
+ ints = int_vector_elements(dest);
+ for (i = 0; i < len; i++)
+ ints[i] = integer(elements[i]);
+ }
+ return(dest);
}
-PF_TO_PF(cddr, g_cddr_1)
-
-
-/* -------- caaar -------- */
-static s7_pointer g_caaar_1(s7_scheme *sc, s7_pointer lst)
+static s7_pointer vector_into_string(s7_pointer vect, s7_pointer dest)
{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->caaar_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaar_symbol, lst, car_a_list_string));
- if (!is_pair(car(car(lst)))) return(simple_wrong_type_argument_with_type(sc, sc->caaar_symbol, lst, caar_a_list_string));
- return(caaar(lst));
+ s7_pointer *elements;
+ int i, len;
+ unsigned char *str;
+
+ elements = s7_vector_elements(vect);
+ len = vector_length(vect);
+ str = (unsigned char *)string_value(dest);
+
+ if (is_byte_vector(dest))
+ {
+ for (i = 0; i < len; i++)
+ str[i] = (unsigned char)integer(elements[i]);
+ }
+ else
+ {
+ for (i = 0; i < len; i++)
+ str[i] = character(elements[i]);
+ }
+ return(dest);
}
-static s7_pointer g_caaar(s7_scheme *sc, s7_pointer args)
-{
- #define H_caaar "(caaar lst) returns (car (car (car lst))): (caaar '(((1 2)))) -> 1"
- #define Q_caaar pl_p
- return(g_caaar_1(sc, car(args)));
-}
-PF_TO_PF(caaar, g_caaar_1)
+/* -------- hash tables -------- */
+static hash_entry_t *hash_free_list = NULL;
-/* -------- caadr -------- */
-static s7_pointer g_caadr_1(s7_scheme *sc, s7_pointer lst)
+static void free_hash_table(s7_pointer table)
{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->caadr_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caadr_symbol, lst, cdr_a_list_string));
- if (!is_pair(car(cdr(lst)))) return(simple_wrong_type_argument_with_type(sc, sc->caadr_symbol, lst, cadr_a_list_string));
- return(caadr(lst));
+ hash_entry_t **entries;
+ entries = hash_table_elements(table);
+
+ if (hash_table_entries(table) > 0)
+ {
+ unsigned int i, len;
+ len = hash_table_mask(table) + 1;
+ for (i = 0; i < len; i++)
+ {
+ hash_entry_t *p, *n;
+ for (p = entries[i++]; p; p = n)
+ {
+ n = p->next;
+ p->next = hash_free_list;
+ hash_free_list = p;
+ }
+ for (p = entries[i]; p; p = n)
+ {
+ n = p->next;
+ p->next = hash_free_list;
+ hash_free_list = p;
+ }
+ }
+ }
+ free(entries);
}
-static s7_pointer g_caadr(s7_scheme *sc, s7_pointer args)
+static hash_entry_t *make_hash_entry(s7_pointer key, s7_pointer value, unsigned int raw_hash)
{
- #define H_caadr "(caadr lst) returns (car (car (cdr lst))): (caadr '(1 (2 3))) -> 2"
- #define Q_caadr pl_p
-
- return(g_caadr_1(sc, car(args)));
+ hash_entry_t *p;
+ if (hash_free_list)
+ {
+ p = hash_free_list;
+ hash_free_list = p->next;
+ }
+ else p = (hash_entry_t *)malloc(sizeof(hash_entry_t));
+ p->key = key;
+ p->value = value;
+ p->raw_hash = raw_hash;
+ return(p);
}
-PF_TO_PF(caadr, g_caadr_1)
-
-/* -------- cadar -------- */
-static s7_pointer g_cadar_1(s7_scheme *sc, s7_pointer lst)
+/* -------------------------------- hash-table? -------------------------------- */
+bool s7_is_hash_table(s7_pointer p)
{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cadar_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadar_symbol, lst, car_a_list_string));
- if (!is_pair(cdr(car(lst)))) return(simple_wrong_type_argument_with_type(sc, sc->cadar_symbol, lst, cdar_a_list_string));
- return(cadar(lst));
+ return(is_hash_table(p));
}
-static s7_pointer g_cadar(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_is_hash_table(s7_scheme *sc, s7_pointer args)
{
- #define H_cadar "(cadar lst) returns (car (cdr (car lst))): (cadar '((1 2 3))) -> 2"
- #define Q_cadar pl_p
-
- return(g_cadar_1(sc, car(args)));
+ #define H_is_hash_table "(hash-table? obj) returns #t if obj is a hash-table"
+ #define Q_is_hash_table pl_bt
+ check_boolean_method(sc, is_hash_table, sc->is_hash_table_symbol, args);
}
-PF_TO_PF(cadar, g_cadar_1)
-
-
-/* -------- cdaar -------- */
-static s7_pointer g_cdaar_1(s7_scheme *sc, s7_pointer lst)
-{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cdaar_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaar_symbol, lst, car_a_list_string));
- if (!is_pair(car(car(lst)))) return(simple_wrong_type_argument_with_type(sc, sc->cdaar_symbol, lst, caar_a_list_string));
- return(cdaar(lst));
-}
-static s7_pointer g_cdaar(s7_scheme *sc, s7_pointer args)
+/* -------------------------------- hash-table-entries -------------------------------- */
+static s7_pointer g_hash_table_entries(s7_scheme *sc, s7_pointer args)
{
- #define H_cdaar "(cdaar lst) returns (cdr (car (car lst))): (cdaar '(((1 2 3)))) -> '(2 3)"
- #define Q_cdaar pl_p
+ #define H_hash_table_entries "(hash-table-entries obj) returns the number of entries in the hash-table obj"
+ #define Q_hash_table_entries s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_hash_table_symbol)
- return(g_cdaar_1(sc, car(args)));
+ if (!is_hash_table(car(args)))
+ method_or_bust_one_arg(sc, car(args), sc->hash_table_entries_symbol, args, T_HASH_TABLE);
+ return(make_integer(sc, hash_table_entries(car(args))));
}
-PF_TO_PF(cdaar, g_cdaar_1)
-
-
-/* -------- caddr -------- */
-static s7_pointer g_caddr_1(s7_scheme *sc, s7_pointer lst)
+static s7_int hash_table_entries_i(s7_pointer p)
{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->caddr_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caddr_symbol, lst, cdr_a_list_string));
- if (!is_pair(cdr(cdr(lst)))) return(simple_wrong_type_argument_with_type(sc, sc->caddr_symbol, lst, cddr_a_list_string));
- return(caddr(lst));
+ if (!is_hash_table(p))
+ simple_wrong_type_argument(cur_sc, cur_sc->hash_table_entries_symbol, p, T_HASH_TABLE);
+ return(hash_table_entries(p));
}
-static s7_pointer g_caddr(s7_scheme *sc, s7_pointer args)
+
+/* ---------------- mappers ---------------- */
+static unsigned int hash_float_location(s7_double x)
{
- #define H_caddr "(caddr lst) returns (car (cdr (cdr lst))): (caddr '(1 2 3 4)) -> 3"
- #define Q_caddr pl_p
+ int loc;
+#if defined(__clang__)
+ if ((is_inf(x)) || (is_NaN(x))) return(0);
+#endif
+ x = fabs(x);
+ if (x < 100.0)
+ loc = 1000.0 * x; /* this means hash_table_float_epsilon only works if it is less than about .001 */
+ else loc = x;
- return(g_caddr_1(sc, car(args)));
+ if (loc < 0)
+ return(0);
+ return(loc);
}
-PF_TO_PF(caddr, g_caddr_1)
+/* built in hash loc tables for eq? eqv? equal? morally-equal? = string=? string-ci=? char=? char-ci=? (default=equal?) */
+#define hash_loc(Sc, Table, Key) (*(hash_table_mapper(Table)[type(Key)]))(Sc, Table, Key)
-/* -------- cdddr -------- */
-static s7_pointer g_cdddr_1(s7_scheme *sc, s7_pointer lst)
-{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cdddr_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdddr_symbol, lst, cdr_a_list_string));
- if (!is_pair(cdr(cdr(lst)))) return(simple_wrong_type_argument_with_type(sc, sc->cdddr_symbol, lst, cddr_a_list_string));
- return(cdddr(lst));
-}
+static hash_map_t *eq_hash_map, *eqv_hash_map, *string_eq_hash_map, *number_eq_hash_map, *char_eq_hash_map, *closure_hash_map;
+static hash_map_t *morally_equal_hash_map, *c_function_hash_map;
+#if (!WITH_PURE_S7)
+static hash_map_t *string_ci_eq_hash_map, *char_ci_eq_hash_map;
+#endif
-static s7_pointer g_cdddr(s7_scheme *sc, s7_pointer args)
-{
- #define H_cdddr "(cdddr lst) returns (cdr (cdr (cdr lst))): (cdddr '(1 2 3 4)) -> '(4)"
- #define Q_cdddr pl_p
+static unsigned int hash_map_nil(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(type(key));}
+static unsigned int hash_map_int(s7_scheme *sc, s7_pointer table, s7_pointer key) {return((unsigned int)(s7_int_abs(integer(key))));}
+static unsigned int hash_map_char(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(character(key));}
+static unsigned int hash_map_ratio(s7_scheme *sc, s7_pointer table, s7_pointer key) {return((unsigned int)denominator(key));} /* overflow possible as elsewhere */
+static unsigned int hash_map_complex(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(hash_float_location(real_part(key)));}
+static unsigned int hash_map_symbol(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(symbol_hmap(key));}
+static unsigned int hash_map_syntax(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(symbol_hmap(syntax_symbol(key)));}
- return(g_cdddr_1(sc, car(args)));
+#if WITH_GMP
+static unsigned int hash_map_big_int(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ return((unsigned int)(big_integer_to_s7_int(big_integer(key))));
}
-PF_TO_PF(cdddr, g_cdddr_1)
-
-
-/* -------- cdadr -------- */
-static s7_pointer g_cdadr_1(s7_scheme *sc, s7_pointer lst)
+static unsigned int hash_map_big_ratio(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cdadr_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdadr_symbol, lst, cdr_a_list_string));
- if (!is_pair(car(cdr(lst)))) return(simple_wrong_type_argument_with_type(sc, sc->cdadr_symbol, lst, cadr_a_list_string));
- return(cdadr(lst));
+ return((unsigned int)(big_integer_to_s7_int(mpq_denref(big_ratio(key)))));
}
-static s7_pointer g_cdadr(s7_scheme *sc, s7_pointer args)
+static unsigned int hash_map_big_real(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- #define H_cdadr "(cdadr lst) returns (cdr (car (cdr lst))): (cdadr '(1 (2 3 4))) -> '(3 4)"
- #define Q_cdadr pl_p
-
- return(g_cdadr_1(sc, car(args)));
+ return((unsigned int)mpfr_get_d(big_real(key), GMP_RNDN));
}
-PF_TO_PF(cdadr, g_cdadr_1)
-
-
-/* -------- cddar -------- */
-static s7_pointer g_cddar_1(s7_scheme *sc, s7_pointer lst)
+static unsigned int hash_map_big_complex(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cddar_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddar_symbol, lst, car_a_list_string));
- if (!is_pair(cdr(car(lst)))) return(simple_wrong_type_argument_with_type(sc, sc->cddar_symbol, lst, cdar_a_list_string));
- return(cddar(lst));
+ return((unsigned int)mpfr_get_d(mpc_realref(big_complex(key)), GMP_RNDN));
}
+#endif
-static s7_pointer g_cddar(s7_scheme *sc, s7_pointer args)
+static unsigned int hash_map_string(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- #define H_cddar "(cddar lst) returns (cdr (cdr (car lst))): (cddar '((1 2 3 4))) -> '(3 4)"
- #define Q_cddar pl_p
-
- return(g_cddar_1(sc, car(args)));
+ if (string_hash(key) == 0)
+ string_hash(key) = raw_string_hash((const unsigned char *)string_value(key), string_length(key));
+ return(string_hash(key));
}
-PF_TO_PF(cddar, g_cddar_1)
-
+#if (!WITH_PURE_S7)
+static unsigned int hash_map_ci_char(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(upper_character(key));}
-/* -------- caaaar -------- */
-static s7_pointer g_caaaar_1(s7_scheme *sc, s7_pointer lst)
+static unsigned int hash_map_ci_string(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->caaaar_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaaar_symbol, lst, car_a_list_string));
- if (!is_pair(caar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaaar_symbol, lst, caar_a_list_string));
- if (!is_pair(caaar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaaar_symbol, lst, caaar_a_list_string));
- return(caaaar(lst));
+ int len;
+ len = string_length(key);
+ if (len == 0) return(0);
+ return(len + (uppers[(int)(string_value(key)[0])] << 4));
}
+#endif
-static s7_pointer g_caaaar(s7_scheme *sc, s7_pointer args)
+static unsigned int hash_map_real(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- #define H_caaaar "(caaaar lst) returns (car (car (car (car lst)))): (caaaar '((((1 2))))) -> 1"
- #define Q_caaaar pl_p
-
- return(g_caaaar_1(sc, car(args)));
+ return(hash_float_location(real(key)));
+ /* currently 1e300 goes to most-negative-fixnum! -> 0 after logand size, I hope
+ *
+ * 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
+ */
}
-PF_TO_PF(caaaar, g_caaaar_1)
-
-
-/* -------- caaadr -------- */
-static s7_pointer g_caaadr_1(s7_scheme *sc, s7_pointer lst)
+static unsigned int hash_map_real_eq(s7_scheme *sc, s7_pointer table, s7_pointer x)
{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->caaadr_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaadr_symbol, lst, cdr_a_list_string));
- if (!is_pair(cadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaadr_symbol, lst, cadr_a_list_string));
- if (!is_pair(caadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaadr_symbol, lst, caadr_a_list_string));
- return(caaadr(lst));
+ if (real(x) < 0.0)
+ return((unsigned int)(s7_round(-real(x))));
+ return((unsigned int)s7_round(real(x)));
}
-static s7_pointer g_caaadr(s7_scheme *sc, s7_pointer args)
+static unsigned int hash_map_ratio_eq(s7_scheme *sc, s7_pointer table, s7_pointer y)
{
- #define H_caaadr "(caaadr lst) returns (car (car (car (cdr lst)))): (caaadr '(1 ((2 3)))) -> 2"
- #define Q_caaadr pl_p
-
- return(g_caaadr_1(sc, car(args)));
+ s7_double x;
+ x = fraction(y);
+ if (x < 0.0)
+ return((unsigned int)s7_round(-x));
+ return((unsigned int)s7_round(x));
}
-PF_TO_PF(caaadr, g_caaadr_1)
-
-
-/* -------- caadar -------- */
-static s7_pointer g_caadar_1(s7_scheme *sc, s7_pointer lst)
+static unsigned int hash_map_hash_table(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->caadar_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caadar_symbol, lst, car_a_list_string));
- if (!is_pair(cdar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caadar_symbol, lst, cdar_a_list_string));
- if (!is_pair(cadar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caadar_symbol, lst, cadar_a_list_string));
- return(caadar(lst));
+ /* hash-tables are equal if key/values match independent of table size and entry order.
+ * if not using morally-equal?, hash_table_checker|mapper must also be the same.
+ * Keys are supposed to be constant while keys, so a hash-table shouldn't be a key of itself.
+ */
+ return(hash_table_entries(key));
}
-static s7_pointer g_caadar(s7_scheme *sc, s7_pointer args)
+static unsigned int hash_map_int_vector(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- #define H_caadar "(caadar lst) returns (car (car (cdr (car lst)))): (caadar '((1 (2 3)))) -> 2"
- #define Q_caadar pl_p
-
- return(g_caadar_1(sc, car(args)));
+ if (vector_length(key) == 0)
+ return(0);
+ if (vector_length(key) == 1)
+ return((unsigned int)(s7_int_abs(int_vector_element(key, 0))));
+ return((unsigned int)(vector_length(key) + s7_int_abs(int_vector_element(key, 0)) + s7_int_abs(int_vector_element(key, 1))));
}
-PF_TO_PF(caadar, g_caadar_1)
-
-
-/* -------- cadaar -------- */
-static s7_pointer g_cadaar_1(s7_scheme *sc, s7_pointer lst)
+static unsigned int hash_map_float_vector(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cadaar_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadaar_symbol, lst, car_a_list_string));
- if (!is_pair(caar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadaar_symbol, lst, caar_a_list_string));
- if (!is_pair(cdaar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadaar_symbol, lst, cdaar_a_list_string));
- return(cadaar(lst));
+ if (vector_length(key) == 0)
+ return(0);
+ if (vector_length(key) == 1)
+ return(hash_float_location(float_vector_element(key, 0)));
+ return((unsigned int)(vector_length(key) + hash_float_location(float_vector_element(key, 0)) + hash_float_location(float_vector_element(key, 1))));
}
-static s7_pointer g_cadaar(s7_scheme *sc, s7_pointer args)
+static unsigned int hash_map_vector(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- #define H_cadaar "(cadaar lst) returns (car (cdr (car (car lst)))): (cadaar '(((1 2 3)))) -> 2"
- #define Q_cadaar pl_p
-
- return(g_cadaar_1(sc, car(args)));
+ if ((vector_length(key) == 0) ||
+ (is_sequence(vector_element(key, 0))))
+ return(vector_length(key));
+ if ((vector_length(key) == 1) ||
+ (is_sequence(vector_element(key, 1))))
+ return(hash_loc(sc, table, vector_element(key, 0)));
+ return(vector_length(key) + hash_loc(sc, table, vector_element(key, 0)) + hash_loc(sc, table, vector_element(key, 1)));
}
-PF_TO_PF(cadaar, g_cadaar_1)
-
-
-/* -------- caaddr -------- */
-static s7_pointer g_caaddr_1(s7_scheme *sc, s7_pointer lst)
+static unsigned int hash_map_eq(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->caaddr_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaddr_symbol, lst, cdr_a_list_string));
- if (!is_pair(cddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaddr_symbol, lst, cddr_a_list_string));
- if (!is_pair(caddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caaddr_symbol, lst, caddr_a_list_string));
- return(caaddr(lst));
+ int x;
+ x = heap_location(key);
+ if (x < 0) return(-x);
+ return(x);
}
-static s7_pointer g_caaddr(s7_scheme *sc, s7_pointer args)
+static unsigned int hash_map_closure(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- #define H_caaddr "(caaddr lst) returns (car (car (cdr (cdr lst)))): (caaddr '(1 2 (3 4))) -> 3"
- #define Q_caaddr pl_p
+ s7_pointer f, old_e, args, body;
- return(g_caaddr_1(sc, car(args)));
+ f = hash_table_procedures_mapper(table);
+ old_e = sc->envir;
+ args = closure_args(f);
+ body = closure_body(f);
+ new_frame_with_slot(sc, closure_let(f), sc->envir, (is_symbol(car(args))) ? car(args) : caar(args), key);
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ if (is_pair(cdr(body)))
+ push_stack_no_args(sc, OP_BEGIN1, cdr(body));
+ sc->code = car(body);
+ eval(sc, OP_EVAL);
+ sc->envir = old_e;
+ return(integer(sc->value));
}
-PF_TO_PF(caaddr, g_caaddr_1)
-
-
-/* -------- cadddr -------- */
-static s7_pointer g_cadddr_1(s7_scheme *sc, s7_pointer lst)
+static unsigned int hash_map_c_function(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cadddr_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadddr_symbol, lst, cdr_a_list_string));
- if (!is_pair(cddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadddr_symbol, lst, cddr_a_list_string));
- if (!is_pair(cdddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadddr_symbol, lst, cdddr_a_list_string));
- return(cadddr(lst));
+ s7_function f;
+ f = c_function_call(hash_table_procedures_mapper(table));
+ set_car(sc->t1_1, key);
+ return(integer(f(sc, sc->t1_1)));
}
-static s7_pointer g_cadddr(s7_scheme *sc, s7_pointer args)
+static unsigned int hash_map_let(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- #define H_cadddr "(cadddr lst) returns (car (cdr (cdr (cdr lst)))): (cadddr '(1 2 3 4 5)) -> 4"
- #define Q_cadddr pl_p
-
- return(g_cadddr_1(sc, car(args)));
-}
-
-PF_TO_PF(cadddr, g_cadddr_1)
+ /* lets are equal if same symbol/value pairs, independent of order, taking into account shadowing
+ * (length (inlet 'a 1 'a 2)) = 2
+ * but this counts as just one entry from equal?'s point of view, so if more than one entry, we have a problem.
+ * (equal? (inlet 'a 1) (inlet 'a 3 'a 2 'a 1)) = #t
+ * also currently equal? follows outlet, but that is ridiculous here, so in this case hash equal?
+ * is not the same as equal? Surely anyone using lets as keys wants eq?
+ */
+ s7_pointer slot;
+ int slots;
+ if ((key == sc->rootlet) ||
+ (!is_slot(let_slots(key))))
+ return(0);
+ slot = let_slots(key);
+ if (!is_slot(next_slot(slot)))
+ {
+ if (is_sequence(slot_value(slot))) /* avoid loop if cycles */
+ return(symbol_hmap(slot_symbol(slot)));
+ return(symbol_hmap(slot_symbol(slot)) + hash_loc(sc, table, slot_value(slot)));
+ }
+ slots = 0;
+ for (; is_slot(slot); slot = next_slot(slot))
+ if (!is_matched_symbol(slot_symbol(slot)))
+ {
+ set_match_symbol(slot_symbol(slot));
+ slots++;
+ }
+ for (slot = let_slots(key); is_slot(slot); slot = next_slot(slot))
+ clear_match_symbol(slot_symbol(slot));
-/* -------- cadadr -------- */
-static s7_pointer g_cadadr_1(s7_scheme *sc, s7_pointer lst)
-{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cadadr_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadadr_symbol, lst, cdr_a_list_string));
- if (!is_pair(cadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadadr_symbol, lst, cadr_a_list_string));
- if (!is_pair(cdadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cadadr_symbol, lst, cdadr_a_list_string));
- return(cadadr(lst));
+ if (slots == 1)
+ {
+ slot = let_slots(key);
+ if (is_sequence(slot_value(slot))) /* avoid loop if cycles */
+ return(symbol_hmap(slot_symbol(slot)));
+ return(symbol_hmap(slot_symbol(slot)) + hash_loc(sc, table, slot_value(slot)));
+ }
+
+ return(slots);
}
-static s7_pointer g_cadadr(s7_scheme *sc, s7_pointer args)
+static unsigned int hash_map_pair(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- #define H_cadadr "(cadadr lst) returns (car (cdr (car (cdr lst)))): (cadadr '(1 (2 3 4))) -> 3"
- #define Q_cadadr pl_p
-
- return(g_cadadr_1(sc, car(args)));
-}
-
-PF_TO_PF(cadadr, g_cadadr_1)
-
+ /* 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
+ * with stats like symbols/pairs/constants at top level, then use those to spread it out over all the locs.
+ */
+ s7_pointer p1;
+ unsigned int loc = 0;
-/* -------- caddar -------- */
-static s7_pointer g_caddar_1(s7_scheme *sc, s7_pointer lst)
-{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->caddar_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caddar_symbol, lst, car_a_list_string));
- if (!is_pair(cdar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caddar_symbol, lst, cdar_a_list_string));
- if (!is_pair(cddar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->caddar_symbol, lst, cddar_a_list_string));
- return(caddar(lst));
+ if (!is_sequence(car(key)))
+ loc = hash_loc(sc, table, car(key)) + 1;
+ else
+ {
+ if ((is_pair(car(key))) &&
+ (!is_sequence(caar(key))))
+ loc = hash_loc(sc, table, caar(key)) + 1;
+ }
+ p1 = cdr(key);
+ if (is_pair(p1))
+ {
+ if (!is_sequence(car(p1)))
+ loc += hash_loc(sc, table, car(p1)) + 1;
+ else
+ {
+ if ((is_pair(car(p1))) &&
+ (!is_sequence(caar(p1))))
+ loc += hash_loc(sc, table, caar(p1)) + 1;
+ }
+ }
+ return(loc);
}
-static s7_pointer g_caddar(s7_scheme *sc, s7_pointer args)
-{
- #define H_caddar "(caddar lst) returns (car (cdr (cdr (car lst)))): (caddar '((1 2 3 4))) -> 3"
- #define Q_caddar pl_p
- return(g_caddar_1(sc, car(args)));
+/* ---------------- checkers ---------------- */
+static hash_entry_t *hash_empty(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ return(NULL);
}
-PF_TO_PF(caddar, g_caddar_1)
-
-/* -------- cdaaar -------- */
-static s7_pointer g_cdaaar_1(s7_scheme *sc, s7_pointer lst)
+static hash_entry_t *hash_int(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cdaaar_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaaar_symbol, lst, car_a_list_string));
- if (!is_pair(caar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaaar_symbol, lst, caar_a_list_string));
- if (!is_pair(caaar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaaar_symbol, lst, caaar_a_list_string));
- return(cdaaar(lst));
-}
+ if (is_integer(key))
+ {
+ s7_int keyval;
+ hash_entry_t *x;
+ unsigned int loc, hash_len;
-static s7_pointer g_cdaaar(s7_scheme *sc, s7_pointer args)
-{
- #define H_cdaaar "(cdaaar lst) returns (cdr (car (car (car lst)))): (cdaaar '((((1 2 3))))) -> '(2 3)"
- #define Q_cdaaar pl_p
+ hash_len = hash_table_mask(table);
+ keyval = integer(key);
+ if (keyval < 0)
+ loc = (unsigned int)((-keyval) & hash_len);
+ else loc = (unsigned int)(keyval & hash_len);
+ /* I think this assumes hash_map_int is using s7_int_abs (and high order bits are ignored) */
- return(g_cdaaar_1(sc, car(args)));
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (integer(x->key) == keyval)
+ return(x);
+ }
+ return(NULL);
}
-PF_TO_PF(cdaaar, g_cdaaar_1)
-
-
-/* -------- cdaadr -------- */
-static s7_pointer g_cdaadr_1(s7_scheme *sc, s7_pointer lst)
-{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cdaadr_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaadr_symbol, lst, cdr_a_list_string));
- if (!is_pair(cadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaadr_symbol, lst, cadr_a_list_string));
- if (!is_pair(caadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaadr_symbol, lst, caadr_a_list_string));
- return(cdaadr(lst));
-}
-static s7_pointer g_cdaadr(s7_scheme *sc, s7_pointer args)
+static hash_entry_t *hash_string(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- #define H_cdaadr "(cdaadr lst) returns (cdr (car (car (cdr lst)))): (cdaadr '(1 ((2 3 4)))) -> '(3 4)"
- #define Q_cdaadr pl_p
-
- return(g_cdaadr_1(sc, car(args)));
-}
+ if (is_string(key))
+ {
+ hash_entry_t *x;
+ unsigned int hash_len, key_len;
+ unsigned long long int hash;
+ const char *key_str;
-PF_TO_PF(cdaadr, g_cdaadr_1)
+ key_len = string_length(key);
+ key_str = string_value(key);
+ hash_len = hash_table_mask(table);
+ if (string_hash(key) == 0)
+ string_hash(key) = raw_string_hash((const unsigned char *)string_value(key), string_length(key));
+ hash = string_hash(key);
-/* -------- cdadar -------- */
-static s7_pointer g_cdadar_1(s7_scheme *sc, s7_pointer lst)
-{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cdadar_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdadar_symbol, lst, car_a_list_string));
- if (!is_pair(cdar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdadar_symbol, lst, cdar_a_list_string));
- if (!is_pair(cadar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdadar_symbol, lst, cadar_a_list_string));
- return(cdadar(lst));
+ if (key_len <= 8)
+ {
+ for (x = hash_table_element(table, hash & hash_len); x; x = x->next)
+ if ((hash == string_hash(x->key)) &&
+ (key_len == string_length(x->key)))
+ return(x);
+ }
+ else
+ {
+ for (x = hash_table_element(table, hash & hash_len); x; x = x->next)
+ if ((hash == string_hash(x->key)) &&
+ (key_len == string_length(x->key)) && /* these are scheme strings, so we can't assume 0=end of string */
+ (strings_are_equal_with_length(key_str, string_value(x->key), key_len)))
+ return(x);
+ }
+ }
+ return(NULL);
}
-static s7_pointer g_cdadar(s7_scheme *sc, s7_pointer args)
+#if (!WITH_PURE_S7)
+static hash_entry_t *hash_ci_string(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- #define H_cdadar "(cdadar lst) returns (cdr (car (cdr (car lst)))): (cdadar '((1 (2 3 4)))) -> '(3 4)"
- #define Q_cdadar pl_p
-
- return(g_cdadar_1(sc, car(args)));
-}
-
-PF_TO_PF(cdadar, g_cdadar_1)
+ if (is_string(key))
+ {
+ hash_entry_t *x;
+ unsigned int hash, hash_len;
+ hash_len = hash_table_mask(table);
+ hash = hash_map_ci_string(sc, table, key);
-/* -------- cddaar -------- */
-static s7_pointer g_cddaar_1(s7_scheme *sc, s7_pointer lst)
-{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cddaar_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddaar_symbol, lst, car_a_list_string));
- if (!is_pair(caar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddaar_symbol, lst, caar_a_list_string));
- if (!is_pair(cdaar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddaar_symbol, lst, cdaar_a_list_string));
- return(cddaar(lst));
+ for (x = hash_table_element(table, hash & hash_len); x; x = x->next)
+ if (scheme_strequal_ci(key, x->key))
+ return(x);
+ }
+ return(NULL);
}
-static s7_pointer g_cddaar(s7_scheme *sc, s7_pointer args)
+static hash_entry_t *hash_ci_char(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- #define H_cddaar "(cddaar lst) returns (cdr (cdr (car (car lst)))): (cddaar '(((1 2 3 4)))) -> '(3 4)"
- #define Q_cddaar pl_p
-
- return(g_cddaar_1(sc, car(args)));
-}
-
-PF_TO_PF(cddaar, g_cddaar_1)
+ if (s7_is_character(key))
+ {
+ hash_entry_t *x;
+ unsigned int hash_len, loc;
+ hash_len = hash_table_mask(table);
+ loc = hash_loc(sc, table, key) & hash_len;
-/* -------- cdaddr -------- */
-static s7_pointer g_cdaddr_1(s7_scheme *sc, s7_pointer lst)
-{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cdaddr_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaddr_symbol, lst, cdr_a_list_string));
- if (!is_pair(cddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaddr_symbol, lst, cddr_a_list_string));
- if (!is_pair(caddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdaddr_symbol, lst, caddr_a_list_string));
- return(cdaddr(lst));
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (upper_character(key) == upper_character(x->key))
+ return(x);
+ }
+ return(NULL);
}
+#endif
-static s7_pointer g_cdaddr(s7_scheme *sc, s7_pointer args)
+static hash_entry_t *hash_float_1(s7_scheme *sc, s7_pointer table, unsigned int loc, s7_double keyval)
{
- #define H_cdaddr "(cdaddr lst) returns (cdr (car (cdr (cdr lst)))): (cdaddr '(1 2 (3 4 5))) -> '(4 5)"
- #define Q_cdaddr pl_p
+ hash_entry_t *x;
+ bool look_for_nan;
+ look_for_nan = is_NaN(keyval);
- return(g_cdaddr_1(sc, car(args)));
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ {
+ if (is_t_real(x->key)) /* we're possibly called from hash_equal, so keys might not be T_REAL */
+ {
+ s7_double val;
+ val = real(x->key);
+ if (look_for_nan)
+ {
+ if (is_NaN(val))
+ return(x);
+ }
+ else
+ {
+ if ((val == keyval) || /* inf case */
+ (fabs(val - keyval) < sc->hash_table_float_epsilon))
+ return(x);
+ }
+ }
+ }
+ return(NULL);
}
-PF_TO_PF(cdaddr, g_cdaddr_1)
-
-/* -------- cddddr -------- */
-static s7_pointer g_cddddr_1(s7_scheme *sc, s7_pointer lst)
+static hash_entry_t *hash_float(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cddddr_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddddr_symbol, lst, cdr_a_list_string));
- if (!is_pair(cddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddddr_symbol, lst, cddr_a_list_string));
- if (!is_pair(cdddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddddr_symbol, lst, cdddr_a_list_string));
- return(cddddr(lst));
+ /* give the equality check some room. also inf == inf and nan == nan
+ */
+ if (type(key) == T_REAL)
+ {
+ s7_double keyval;
+ unsigned int hash_len, loc;
+
+ hash_len = hash_table_mask(table);
+ keyval = real(key);
+ loc = hash_float_location(keyval) & hash_len;
+
+ return(hash_float_1(sc, table, loc, keyval));
+ }
+ return(NULL);
}
-static s7_pointer g_cddddr(s7_scheme *sc, s7_pointer args)
+
+static hash_entry_t *hash_complex_1(s7_scheme *sc, s7_pointer table, unsigned int loc, s7_pointer key)
{
- #define H_cddddr "(cddddr lst) returns (cdr (cdr (cdr (cdr lst)))): (cddddr '(1 2 3 4 5)) -> '(5)"
- #define Q_cddddr pl_p
- return(g_cddddr_1(sc, car(args)));
+ hash_entry_t *x;
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if ((is_t_complex(x->key)) &&
+ (s7_is_morally_equal(sc, x->key, key)))
+ return(x);
+ return(NULL);
}
-PF_TO_PF(cddddr, g_cddddr_1)
-
-/* -------- cddadr -------- */
-static s7_pointer g_cddadr_1(s7_scheme *sc, s7_pointer lst)
+static hash_entry_t *hash_equal_real(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cddadr_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddadr_symbol, lst, cdr_a_list_string));
- if (!is_pair(cadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddadr_symbol, lst, cadr_a_list_string));
- if (!is_pair(cdadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cddadr_symbol, lst, cdadr_a_list_string));
- return(cddadr(lst));
+ return(hash_float_1(sc, table, hash_loc(sc, table, key) & hash_table_mask(table), real(key)));
}
-static s7_pointer g_cddadr(s7_scheme *sc, s7_pointer args)
+
+static hash_entry_t *hash_equal_complex(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- #define H_cddadr "(cddadr lst) returns (cdr (cdr (car (cdr lst)))): (cddadr '(1 (2 3 4 5))) -> '(4 5)"
- #define Q_cddadr pl_p
- return(g_cddadr_1(sc, car(args)));
+ return(hash_complex_1(sc, table, hash_loc(sc, table, key) & hash_table_mask(table), key));
}
-PF_TO_PF(cddadr, g_cddadr_1)
-
-/* -------- cdddar -------- */
-static s7_pointer g_cdddar_1(s7_scheme *sc, s7_pointer lst)
+static hash_entry_t *hash_equal_syntax(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- if (!is_pair(lst)) method_or_bust(sc, lst, sc->cdddar_symbol, set_plist_1(sc, lst), T_PAIR, 0);
- if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdddar_symbol, lst, car_a_list_string));
- if (!is_pair(cdar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdddar_symbol, lst, cdar_a_list_string));
- if (!is_pair(cddar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->cdddar_symbol, lst, cddar_a_list_string));
- return(cdddar(lst));
+ hash_entry_t *x;
+ unsigned int loc;
+ loc = hash_loc(sc, table, key) & hash_table_mask(table);
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if ((is_syntax(x->key)) &&
+ (syntax_symbol(x->key) == syntax_symbol(key))) /* the opcodes might differ, but the symbols should not */
+ return(x);
+ return(NULL);
}
-static s7_pointer g_cdddar(s7_scheme *sc, s7_pointer args)
-{
- #define H_cdddar "(cdddar lst) returns (cdr (cdr (cdr (car lst)))): (cdddar '((1 2 3 4 5))) -> '(4 5)"
- #define Q_cdddar pl_p
- return(g_cdddar_1(sc, car(args)));
+static hash_entry_t *hash_equal_eq(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ hash_entry_t *x;
+ unsigned int loc;
+ loc = hash_loc(sc, table, key) & hash_table_mask(table);
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (x->key == key)
+ return(x);
+ return(NULL);
}
-PF_TO_PF(cdddar, g_cdddar_1)
-
-
-s7_pointer s7_assq(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+static hash_entry_t *hash_equal_any(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- s7_pointer y;
- y = x;
- while (true)
- {
- /* we can blithely take the car of anything, since we're not treating it as an object,
- * then if we get a bogus match, the following check that caar made sense ought to catch it.
- *
- * if car(#<unspecified>) = #<unspecified> (initialization time), then cdr(nil)->unspec
- * and subsequent caar(unspc)->unspec so we could forgo half the is_pair checks below.
- * This breaks if "x" is a dotted list -- the last cdr is not nil, so we lose.
- */
- if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
-
- if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ hash_entry_t *x;
+ unsigned int loc;
+ loc = hash_loc(sc, table, key) & hash_table_mask(table);
- if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ /* 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 ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (x->key == key)
+ return(x);
- if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (s7_is_equal(sc, x->key, key))
+ return(x);
+ return(NULL);
+}
- if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
- y = cdr(y);
- if (x == y) return(sc->F);
- }
- return(sc->F); /* not reached */
-}
+static hash_entry_t *(*default_hash_checks[NUM_TYPES])(s7_scheme *sc, s7_pointer table, s7_pointer key);
+static hash_entry_t *(*equal_hash_checks[NUM_TYPES])(s7_scheme *sc, s7_pointer table, s7_pointer key);
+static hash_entry_t *(*morally_equal_hash_checks[NUM_TYPES])(s7_scheme *sc, s7_pointer table, s7_pointer key);
-static s7_pointer c_assq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static hash_entry_t *hash_equal(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- if (!is_pair(y))
- {
- if (is_null(y)) return(sc->F);
- method_or_bust_with_type(sc, y, sc->assq_symbol, list_2(sc, x, y), an_association_list_string, 2);
- }
- /* we don't check for (pair? (car x)) here (or in assv) so we get some inconsistency with assoc:
- * (assq #f '(#f 2 . 3)) -> #f
- * (assoc #f '(#f 2 . 3)) -> 'error
- */
- return(s7_assq(sc, x, y));
+ return((*(equal_hash_checks[type(key)]))(sc, table, key));
}
-static s7_pointer g_assq(s7_scheme *sc, s7_pointer args)
+static hash_entry_t *hash_morally_equal(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- #define H_assq "(assq obj alist) returns the key-value pair associated (via eq?) with the key obj in the association list alist"
- #define Q_assq s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_boolean_symbol), sc->T, sc->is_list_symbol)
- return(c_assq(sc, car(args), cadr(args)));
-}
+ hash_entry_t *x;
+ unsigned int loc;
+ loc = hash_loc(sc, table, key) & hash_table_mask(table);
-PF2_TO_PF(assq, c_assq)
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (x->key == key)
+ return(x);
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (s7_is_morally_equal(sc, x->key, key))
+ return(x);
+ return(NULL);
+}
-static s7_pointer c_assv(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static hash_entry_t *hash_c_function(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- s7_pointer z;
- if (!is_pair(y))
- {
- if (is_null(y)) return(sc->F);
- method_or_bust_with_type(sc, y, sc->assv_symbol, list_2(sc, x, y), an_association_list_string, 2);
- }
-
- if (is_simple(x))
- return(s7_assq(sc, x, y));
+ hash_entry_t *x;
+ unsigned int hash_len, loc;
+ s7_function f;
- z = y;
- while (true)
+ f = c_function_call(hash_table_procedures_checker(table));
+ hash_len = hash_table_mask(table);
+ loc = hash_loc(sc, table, key) & hash_len;
+
+ set_car(sc->t2_1, key);
+ for (x = hash_table_element(table, loc); x; x = x->next)
{
- /* here we can't play the assq == game because s7_is_eqv thinks it's getting a legit s7 object */
- if ((is_pair(car(y))) && (s7_is_eqv(x, caar(y)))) return(car(y));
- y = cdr(y);
- if (!is_pair(y)) return(sc->F);
-
- if ((is_pair(car(y))) && (s7_is_eqv(x, caar(y)))) return(car(y));
- y = cdr(y);
- if (!is_pair(y)) return(sc->F);
-
- z = cdr(z);
- if (z == y) return(sc->F);
+ set_car(sc->t2_2, x->key);
+ if (is_true(sc, f(sc, sc->t2_1)))
+ return(x);
}
- return(sc->F); /* not reached */
-}
-
-static s7_pointer g_assv(s7_scheme *sc, s7_pointer args) /* g_assv is called by g_assoc below */
-{
- #define H_assv "(assv obj alist) returns the key-value pair associated (via eqv?) with the key obj in the association list alist"
- #define Q_assv Q_assq
- return(c_assv(sc, car(args), cadr(args)));
+ return(NULL);
}
-PF2_TO_PF(assv, c_assv)
-
-static s7_pointer all_x_c_ss(s7_scheme *sc, s7_pointer arg);
-static s7_pointer all_x_c_uu(s7_scheme *sc, s7_pointer arg);
-static s7_pointer g_is_eq(s7_scheme *sc, s7_pointer args);
-static s7_pointer g_is_eqv(s7_scheme *sc, s7_pointer args);
-static s7_pointer g_assoc(s7_scheme *sc, s7_pointer args)
+static hash_entry_t *hash_eq(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- #define H_assoc "(assoc obj alist (func #f)) returns the key-value pair associated (via equal?) with the key obj in the association list alist.\
-If 'func' is a function of 2 arguments, it is used for the comparison instead of 'equal?"
- #define Q_assoc s7_make_signature(sc, 4, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_boolean_symbol), sc->T, sc->is_list_symbol, sc->is_procedure_symbol)
-
- s7_pointer x, y, obj, eq_func = NULL;
-
- x = cadr(args);
- if (!is_null(x))
- {
- if (!is_pair(x))
- method_or_bust_with_type(sc, x, sc->assoc_symbol, args, an_association_list_string, 2);
-
- if ((is_pair(x)) && (!is_pair(car(x))))
- return(wrong_type_argument_with_type(sc, sc->assoc_symbol, 2, x, an_association_list_string)); /* we're assuming caar below so it better exist */
- }
-
- if (is_not_null(cddr(args)))
- {
- /* check third arg before second (trailing arg error check) */
- eq_func = caddr(args);
-
- if (type(eq_func) < T_GOTO)
- method_or_bust_with_type(sc, eq_func, sc->assoc_symbol, args, a_procedure_string, 0);
-
- if (!s7_is_aritable(sc, eq_func, 2))
- return(wrong_type_argument_with_type(sc, sc->assoc_symbol, 3, eq_func, an_eq_func_string));
- }
- if (is_null(x)) return(sc->F);
-
- if (eq_func)
- {
- /* now maybe there's a simple case */
- if (s7_list_length(sc, x) > 0)
- {
- if ((is_safe_procedure(eq_func)) &&
- (is_c_function(eq_func)))
- {
- s7_function func;
-
- func = c_function_call(eq_func);
- if (func == g_is_eq) return(s7_assq(sc, car(args), x));
- if (func == g_is_eqv) return(g_assv(sc, args));
- set_car(sc->t2_1, car(args));
-
- for (; is_pair(x); x = cdr(x))
- {
- if (is_pair(car(x)))
- {
- set_car(sc->t2_2, caar(x));
- if (is_true(sc, func(sc, sc->t2_1)))
- return(car(x));
- /* I wonder if the assoc equality function should get the cons, not just caar?
- */
- }
- else return(wrong_type_argument_with_type(sc, sc->assoc_symbol, 2, cadr(args), an_association_list_string));
- }
- return(sc->F);
- }
-
- /* lg auto? */
- if ((is_closure(eq_func)) &&
- (is_pair(closure_args(eq_func))) &&
- (is_pair(cdr(closure_args(eq_func))))) /* not dotted arg list */
- {
- s7_pointer body;
- body = closure_body(eq_func);
- if ((is_optimized(car(body))) &&
- (is_null(cdr(body))) &&
- (is_all_x_safe(sc, car(body))))
- {
- s7_function func;
- s7_pointer b;
-
- new_frame_with_two_slots(sc, sc->envir, sc->envir, car(closure_args(eq_func)), car(args), cadr(closure_args(eq_func)), sc->F);
- func = all_x_eval(sc, car(body), sc->envir, let_symbol_is_safe); /* safe since local */
- b = next_slot(let_slots(sc->envir));
-
- for (; is_pair(x); x = cdr(x))
- {
- slot_set_value(b, caar(x));
- if (is_true(sc, func(sc, car(body))))
- return(car(x));
- }
- return(sc->F);
- }
- }
- }
-
- /* sc->value = sc->F; */
- y = cons(sc, args, sc->nil);
- set_opt_fast(y, x);
- set_opt_slow(y, x);
- push_stack(sc, OP_ASSOC_IF, y, eq_func);
- push_stack(sc, OP_APPLY, list_2(sc, car(args), caar(x)), eq_func);
- return(sc->unspecified);
- }
-
- x = cadr(args);
- obj = car(args);
- if (is_simple(obj))
- return(s7_assq(sc, obj, x));
-
- y = x;
- if (is_string(obj))
- {
- s7_pointer val;
- while (true)
- {
- if (is_pair(car(x)))
- {
- val = caar(x);
- if ((val == obj) ||
- ((is_string(val)) &&
- (scheme_strings_are_equal(obj, val))))
- return(car(x));
- }
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
-
- if (is_pair(car(x)))
- {
- val = caar(x);
- if ((val == obj) ||
- ((is_string(val)) &&
- (scheme_strings_are_equal(obj, val))))
- return(car(x));
- }
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
-
- y = cdr(y);
- if (x == y) return(sc->F);
- }
- return(sc->F);
- }
+ /* explicit eq? as hash equality func or (for example) symbols as keys */
+ hash_entry_t *x;
+ unsigned int hash_len, loc;
- while (true)
- {
- if ((is_pair(car(x))) && (s7_is_equal(sc, obj, caar(x)))) return(car(x));
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ hash_len = hash_table_mask(table);
+ loc = hash_loc(sc, table, key) & hash_len;
- if ((is_pair(car(x))) && (s7_is_equal(sc, obj, caar(x)))) return(car(x));
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (key == x->key)
+ return(x);
- y = cdr(y);
- if (x == y) return(sc->F);
- }
- return(sc->F); /* not reached */
+ return(NULL);
}
-static s7_pointer c_assoc(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_assoc(sc, set_plist_2(sc, x, y)));}
-PF2_TO_PF(assoc, c_assoc)
+static hash_entry_t *hash_eqv(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ hash_entry_t *x;
+ unsigned int hash_len, loc;
+ hash_len = hash_table_mask(table);
+ loc = hash_loc(sc, table, key) & hash_len;
-/* ---------------- member, memv, memq ---------------- */
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (s7_is_eqv(key, x->key))
+ return(x);
-s7_pointer s7_memq(s7_scheme *sc, s7_pointer obj, s7_pointer x)
-{
- s7_pointer y;
- y = x;
- while (true)
- {
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ return(NULL);
+}
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+static hash_entry_t *hash_number(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ if (is_number(key))
+ {
+ hash_entry_t *x;
+ unsigned int hash_len, loc;
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ hash_len = hash_table_mask(table);
+ loc = hash_loc(sc, table, key) & hash_len;
- y = cdr(y);
- if (x == y) return(sc->F);
+#if (!WITH_GMP)
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if ((is_number(x->key)) &&
+ (is_true(sc, c_equal_2(sc, key, x->key))))
+ return(x);
+#else
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if ((is_number(x->key)) &&
+ (is_true(sc, big_equal(sc, set_plist_2(sc, key, x->key)))))
+ return(x);
+#endif
}
- return(sc->F);
+ return(NULL);
}
-
-static s7_pointer c_memq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static hash_entry_t *hash_symbol(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- if (!is_pair(y))
+ if (is_symbol(key))
{
- if (is_null(y)) return(sc->F);
- method_or_bust_with_type(sc, y, sc->memq_symbol, list_2(sc, x, y), a_list_string, 2);
+ hash_entry_t *x;
+ for (x = hash_table_element(table, symbol_hmap(key) & hash_table_mask(table)); x; x = x->next)
+ if (key == x->key)
+ return(x);
}
- return(s7_memq(sc, x, y));
+ return(NULL);
}
-static s7_pointer g_memq(s7_scheme *sc, s7_pointer args)
+
+static hash_entry_t *hash_char(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- #define H_memq "(memq obj list) looks for obj in list and returns the list from that point if it is found, otherwise #f. memq uses eq?"
- #define Q_memq pl_tl
- return(c_memq(sc, car(args), cadr(args)));
+ if (s7_is_character(key))
+ return(hash_eq(sc, table, key));
+ return(NULL);
}
-PF2_TO_PF(memq, c_memq)
-
-/* I think (memq 'c '(a b . c)) should return #f because otherwise
- * (memq () ...) would return the () at the end.
- */
+static hash_entry_t *hash_closure(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ hash_entry_t *x;
+ unsigned int hash_len, loc;
+ s7_pointer f, args, body, old_e;
+ f = hash_table_procedures_checker(table);
+ hash_len = hash_table_mask(table);
+ loc = hash_loc(sc, table, key) & hash_len;
-/* 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;
+ old_e = sc->envir;
+ args = closure_args(f); /* in lambda* case, car/cadr(args) can be lists */
+ body = closure_body(f);
+ new_frame_with_two_slots(sc, closure_let(f), sc->envir,
+ (is_symbol(car(args))) ? car(args) : caar(args), key,
+ (is_symbol(cadr(args))) ? cadr(args) : caadr(args), sc->F);
-static s7_pointer g_memq_3(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer x, obj;
- x = cadr(args);
- obj = car(args);
- while (true)
+ for (x = hash_table_element(table, loc); x; x = x->next)
{
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ slot_set_value(next_slot(let_slots(sc->envir)), x->key);
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ if (is_pair(cdr(body)))
+ push_stack_no_args(sc, OP_BEGIN1, cdr(body));
+ sc->code = car(body);
+ eval(sc, OP_EVAL);
+ if (is_true(sc, sc->value))
+ {
+ sc->envir = old_e;
+ return(x);
+ }
}
- return(sc->F);
+ sc->envir = old_e;
+ return(NULL);
}
-static s7_pointer g_memq_4(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer x, obj;
- x = cadr(args);
- obj = car(args);
- while (true)
- {
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
- }
- return(sc->F);
-}
-static s7_pointer g_memq_any(s7_scheme *sc, s7_pointer args)
+static s7_pointer remove_from_hash_table(s7_scheme *sc, s7_pointer table, s7_pointer key, hash_entry_t *p)
{
- /* no circular list check needed in this case */
- s7_pointer x, obj;
- x = cadr(args);
- obj = car(args);
- while (true)
- {
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F); /* every other pair check could be omitted */
+ hash_entry_t *x;
+ unsigned int hash_len, loc;
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ hash_len = hash_table_mask(table);
+#if DEBUGGING
+ if (p->raw_hash != hash_loc(sc, table, key))
+ fprintf(stderr, "%s[%d]: %s raw: %u, loc: %u\n", __func__, __LINE__, DISPLAY(key), p->raw_hash, hash_loc(sc, table, key));
+#endif
+ loc = p->raw_hash & hash_len;
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ x = hash_table_element(table, loc);
+ if (x == p)
+ hash_table_element(table, loc) = x->next;
+ else
+ {
+ hash_entry_t *y;
+ for (y = x, x = x->next; x; y = x, x = x->next)
+ if (x == p)
+ {
+ y->next = x->next;
+ break;
+ }
}
+ hash_table_entries(table)--;
+ if ((hash_table_entries(table) == 0) &&
+ (!hash_table_checker_locked(table)))
+ hash_table_checker(table) = hash_empty;
+ x->next = hash_free_list;
+ hash_free_list = x;
return(sc->F);
}
+/* -------------------------------- make-hash-table -------------------------------- */
-static s7_pointer memq_car;
-static s7_pointer g_memq_car(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_make_hash_table(s7_scheme *sc, s7_int size)
{
- s7_pointer x, obj;
+ s7_pointer table;
+ hash_entry_t **els;
+ /* size is rounded up to the next power of 2 */
- obj = find_symbol_checked(sc, cadar(args));
- if (!is_pair(obj))
+ if (size < 2)
+ size = 2;
+ else
{
- 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));
+ if ((size & (size - 1)) != 0) /* already 2^n ? */
+ {
+ if ((size & (size + 1)) != 0) /* already 2^n - 1 ? */
+ {
+ size--;
+ size |= (size >> 1);
+ size |= (size >> 2);
+ size |= (size >> 4);
+ size |= (size >> 8);
+ size |= (size >> 16);
+ if (s7_int_bits > 31) /* this is either 31 or 63 */
+ size |= (size >> 32);
+ }
+ size++;
+ }
}
- obj = car(obj);
- x = cadr(cadr(args));
- while (true)
- {
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ els = (hash_entry_t **)calloc(size, sizeof(hash_entry_t *));
+ if (!els) return(s7_error(sc, make_symbol(sc, "out-of-memory"), set_elist_1(sc, make_string_wrapper(sc, "make-hash-table allocation failed!"))));
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
- }
- return(sc->F);
+ new_cell(sc, table, T_HASH_TABLE | T_SAFE_PROCEDURE);
+ hash_table_mask(table) = size - 1;
+ hash_table_elements(table) = els;
+ hash_table_checker(table) = hash_empty;
+ hash_table_mapper(table) = default_hash_map;
+ hash_table_entries(table) = 0;
+ hash_table_set_procedures(table, sc->nil);
+ add_hash_table(sc, table);
+
+ return(table);
}
-static s7_pointer memq_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer g_is_equal(s7_scheme *sc, s7_pointer args);
+static s7_pointer g_is_morally_equal(s7_scheme *sc, s7_pointer args);
+
+static s7_pointer g_make_hash_table(s7_scheme *sc, s7_pointer args)
{
- if ((is_pair(caddr(expr))) &&
- (car(caddr(expr)) == sc->quote_symbol) &&
- (is_pair(cadr(caddr(expr)))))
- {
- int len;
+ #define H_make_hash_table "(make-hash-table (size 8) eq-func) returns a new hash table"
+ #define Q_make_hash_table s7_make_signature(sc, 3, sc->is_hash_table_symbol, sc->is_integer_symbol, s7_make_signature(sc, 2, sc->is_procedure_symbol, sc->is_pair_symbol))
- if ((is_h_safe_c_s(cadr(expr))) &&
- (c_callee(cadr(expr)) == g_car))
+ s7_int size;
+ size = sc->default_hash_table_length;
+
+ if (is_not_null(args))
+ {
+ s7_pointer p;
+ p = car(args);
+ if (!s7_is_integer(p))
{
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(memq_car);
+ s7_pointer p1;
+ if (!s7_is_integer(p1 = check_values(sc, p, args)))
+ method_or_bust(sc, p, sc->make_hash_table_symbol, args, T_INTEGER, 1);
+ p = p1;
}
+ size = s7_integer(p);
+ if (size <= 0) /* we need s7_int here to catch (make-hash-table most-negative-fixnum) etc */
+ return(simple_out_of_range(sc, sc->make_hash_table_symbol, p, make_string_wrapper(sc, "should be a positive integer")));
+ if (size > sc->max_vector_length)
+ return(simple_out_of_range(sc, sc->make_hash_table_symbol, p, its_too_large_string));
- len = s7_list_length(sc, cadr(caddr(expr)));
- if (len > 0)
+ if (is_not_null(cdr(args)))
{
- if ((len % 4) == 0)
- return(memq_4);
- if ((len % 3) == 0)
- return(memq_3);
- return(memq_any);
- }
- }
- return(f);
-}
+ s7_pointer ht, proc;
+ proc = cadr(args);
+ if (is_c_function(proc))
+ {
+ if (!s7_is_aritable(sc, proc, 2))
+ return(wrong_type_argument_with_type(sc, sc->make_hash_table_symbol, 3, proc, an_eq_func_string));
-static s7_pointer memv_number(s7_scheme *sc, s7_pointer obj, s7_pointer x)
-{
- s7_pointer y;
- y = x;
- while (true)
- {
- if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
- if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
- if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
- if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
- y = cdr(y);
- if (x == y) return(sc->F);
+ ht = s7_make_hash_table(sc, size);
+ if (c_function_call(proc) == g_is_equal)
+ return(ht);
+ if (c_function_call(proc) == g_is_eq)
+ {
+ hash_table_checker(ht) = hash_eq;
+ hash_table_mapper(ht) = eq_hash_map;
+ return(ht);
+ }
+ if (c_function_call(proc) == g_strings_are_equal)
+ {
+ hash_table_checker(ht) = hash_string;
+ hash_table_mapper(ht) = string_eq_hash_map;
+ return(ht);
+ }
+#if (!WITH_PURE_S7)
+ if (c_function_call(proc) == g_strings_are_ci_equal)
+ {
+ hash_table_checker(ht) = hash_ci_string;
+ hash_table_mapper(ht) = string_ci_eq_hash_map;
+ return(ht);
+ }
+ if (c_function_call(proc) == g_chars_are_ci_equal)
+ {
+ hash_table_checker(ht) = hash_ci_char;
+ hash_table_mapper(ht) = char_ci_eq_hash_map;
+ return(ht);
+ }
+#endif
+ if (c_function_call(proc) == g_chars_are_equal)
+ {
+ hash_table_checker(ht) = hash_char;
+ hash_table_mapper(ht) = char_eq_hash_map;
+ return(ht);
+ }
+#if (!WITH_GMP)
+ if (c_function_call(proc) == g_equal)
+#else
+ if ((c_function_call(proc) == g_equal) ||
+ (c_function_call(proc) == big_equal))
+#endif
+ {
+ hash_table_checker(ht) = hash_number;
+ hash_table_mapper(ht) = number_eq_hash_map;
+ return(ht);
+ }
+ if (c_function_call(proc) == g_is_eqv)
+ {
+ hash_table_checker(ht) = hash_eqv;
+ 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, make_string_wrapper(sc, "a hash function")));
+ }
+ /* proc not c_function */
+ else
+ {
+ if (is_pair(proc))
+ {
+ s7_pointer checker, mapper;
+ checker = car(proc);
+ mapper = cdr(proc);
+
+ if (((is_any_c_function(checker)) || (is_any_closure(checker))) &&
+ ((is_any_c_function(mapper)) || (is_any_closure(mapper))) &&
+ (s7_is_aritable(sc, checker, 2)) &&
+ (s7_is_aritable(sc, mapper, 1)))
+ {
+ s7_pointer sig;
+ ht = s7_make_hash_table(sc, size);
+ if (is_any_c_function(checker))
+ {
+ sig = c_function_signature(checker);
+ if ((sig) &&
+ (is_pair(sig)) &&
+ (car(sig) != sc->is_boolean_symbol))
+ return(wrong_type_argument_with_type(sc, sc->make_hash_table_symbol, 3, proc,
+ make_string_wrapper(sc, "equality function should return a boolean")));
+ hash_table_checker(ht) = hash_c_function;
+ }
+ else hash_table_checker(ht) = hash_closure;
+ if (is_any_c_function(mapper))
+ {
+ sig = c_function_signature(mapper);
+ if ((sig) &&
+ (is_pair(sig)) &&
+ (car(sig) != sc->is_integer_symbol))
+ return(wrong_type_argument_with_type(sc, sc->make_hash_table_symbol, 3, proc,
+ make_string_wrapper(sc, "mapping function should return an integer")));
+ hash_table_mapper(ht) = c_function_hash_map;
+ }
+ else hash_table_mapper(ht) = closure_hash_map;
+ hash_table_set_procedures(ht, proc);
+ return(ht);
+ }
+ }
+ return(wrong_type_argument_with_type(sc, sc->make_hash_table_symbol, 3, proc,
+ make_string_wrapper(sc, "a cons of two functions")));
+ }
+ }
}
- return(sc->F);
+ return(s7_make_hash_table(sc, size));
}
-static s7_pointer c_memv(s7_scheme *sc, s7_pointer x, s7_pointer y)
+void init_hash_maps(void)
{
- s7_pointer z;
+ int i;
+
+ default_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+ eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+ eqv_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+ string_eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+ number_eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+ char_eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+#if (!WITH_PURE_S7)
+ string_ci_eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+ char_ci_eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+#endif
+ closure_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+ c_function_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+ morally_equal_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
- if (!is_pair(y))
+ for (i = 0; i < NUM_TYPES; i++)
{
- if (is_null(y)) return(sc->F);
- method_or_bust_with_type(sc, y, sc->memv_symbol, list_2(sc, x, y), a_list_string, 2);
+ default_hash_map[i] = hash_map_nil;
+ string_eq_hash_map[i] = hash_map_nil;
+ char_eq_hash_map[i] = hash_map_nil;
+#if (!WITH_PURE_S7)
+ string_ci_eq_hash_map[i] = hash_map_nil;
+ char_ci_eq_hash_map[i] = hash_map_nil;
+#endif
+ number_eq_hash_map[i] = hash_map_nil;
+ closure_hash_map[i] = hash_map_closure;
+ c_function_hash_map[i] = hash_map_c_function;
+ eq_hash_map[i] = hash_map_eq;
+ eqv_hash_map[i] = hash_map_eq;
+
+ equal_hash_checks[i] = hash_equal_any;
+ morally_equal_hash_checks[i] = hash_equal_any;
+ default_hash_checks[i] = hash_equal;
}
+ default_hash_map[T_INTEGER] = hash_map_int;
+ default_hash_map[T_RATIO] = hash_map_ratio;
+ default_hash_map[T_REAL] = hash_map_real;
+ default_hash_map[T_COMPLEX] = hash_map_complex;
+ default_hash_map[T_CHARACTER] = hash_map_char;
+ default_hash_map[T_SYMBOL] = hash_map_symbol;
+ default_hash_map[T_SYNTAX] = hash_map_syntax;
+ default_hash_map[T_STRING] = hash_map_string;
+ default_hash_map[T_HASH_TABLE] = hash_map_hash_table;
+ default_hash_map[T_VECTOR] = hash_map_vector;
+ default_hash_map[T_INT_VECTOR] = hash_map_int_vector;
+ default_hash_map[T_FLOAT_VECTOR] = hash_map_float_vector;
+ default_hash_map[T_LET] = hash_map_let;
+ default_hash_map[T_PAIR] = hash_map_pair;
+#if WITH_GMP
+ default_hash_map[T_BIG_INTEGER] = hash_map_big_int;
+ default_hash_map[T_BIG_RATIO] = hash_map_big_ratio;
+ default_hash_map[T_BIG_REAL] = hash_map_big_real;
+ default_hash_map[T_BIG_COMPLEX] = hash_map_big_complex;
+#endif
+
+ for (i = 0; i < NUM_TYPES; i++) morally_equal_hash_map[i] = default_hash_map[i];
- if (is_simple(x)) return(s7_memq(sc, x, y));
- if (s7_is_number(x)) return(memv_number(sc, x, y));
+ string_eq_hash_map[T_STRING] = hash_map_string;
+ char_eq_hash_map[T_CHARACTER] = hash_map_char;
+#if (!WITH_PURE_S7)
+ string_ci_eq_hash_map[T_STRING] = hash_map_ci_string;
+ char_ci_eq_hash_map[T_CHARACTER] = hash_map_ci_char;
+#endif
- z = y;
- while (true)
- {
- if (s7_is_eqv(x, car(y))) return(y);
- y = cdr(y);
- if (!is_pair(y)) return(sc->F);
+ number_eq_hash_map[T_INTEGER] = hash_map_int;
+ number_eq_hash_map[T_RATIO] = hash_map_ratio_eq;
+ number_eq_hash_map[T_REAL] = hash_map_real_eq;
+ number_eq_hash_map[T_COMPLEX] = hash_map_complex;
+#if (WITH_GMP)
+ number_eq_hash_map[T_BIG_INTEGER] = hash_map_big_int;
+ number_eq_hash_map[T_BIG_RATIO] = hash_map_big_ratio;
+ number_eq_hash_map[T_BIG_REAL] = hash_map_big_real;
+ number_eq_hash_map[T_BIG_COMPLEX] = hash_map_big_complex;
+#endif
- if (s7_is_eqv(x, car(y))) return(y);
- y = cdr(y);
- if (!is_pair(y)) return(sc->F);
+ eqv_hash_map[T_INTEGER] = hash_map_int;
+ eqv_hash_map[T_RATIO] = hash_map_ratio_eq;
+ eqv_hash_map[T_REAL] = hash_map_real_eq;
+ eqv_hash_map[T_COMPLEX] = hash_map_complex;
- z = cdr(z);
- if (z == y) return(sc->F);
- }
- return(sc->F); /* not reached */
-}
+ morally_equal_hash_map[T_INTEGER] = hash_map_int;
+ morally_equal_hash_map[T_RATIO] = hash_map_ratio_eq;
+ morally_equal_hash_map[T_REAL] = hash_map_real_eq;
+ morally_equal_hash_map[T_COMPLEX] = hash_map_complex;
-static s7_pointer g_memv(s7_scheme *sc, s7_pointer args)
-{
- #define H_memv "(memv obj list) looks for obj in list and returns the list from that point if it is found, otherwise #f. memv uses eqv?"
- #define Q_memv pl_tl
+ equal_hash_checks[T_REAL] = hash_equal_real;
+ equal_hash_checks[T_COMPLEX] = hash_equal_complex;
+ equal_hash_checks[T_SYNTAX] = hash_equal_syntax;
+ equal_hash_checks[T_SYMBOL] = hash_equal_eq;
+ equal_hash_checks[T_CHARACTER] = hash_equal_eq;
- return(c_memv(sc, car(args), cadr(args)));
+ default_hash_checks[T_STRING] = hash_string;
+ default_hash_checks[T_INTEGER] = hash_int;
+ default_hash_checks[T_REAL] = hash_float;
+ default_hash_checks[T_SYMBOL] = hash_symbol;
+ default_hash_checks[T_CHARACTER] = hash_char;
}
-PF2_TO_PF(memv, c_memv)
-
-static s7_pointer member(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+static unsigned int resize_hash_table(s7_scheme *sc, s7_pointer table)
{
- s7_pointer y;
-
- y = x;
- if (is_string(obj))
+ /* resize the table */
+ unsigned int hash_len, loc;
+ int i, old_size, new_size;
+ hash_entry_t **new_els, **old_els;
+
+ old_size = hash_table_mask(table) + 1;
+ new_size = old_size * 4;
+ hash_len = new_size - 1;
+ new_els = (hash_entry_t **)calloc(new_size, sizeof(hash_entry_t *));
+ old_els = hash_table_elements(table);
+
+ for (i = 0; i < old_size; i++)
{
- while (true)
+ hash_entry_t *x, *n;
+ for (x = old_els[i]; x; x = n)
{
- if ((obj == car(x)) ||
- ((is_string(car(x))) &&
- (scheme_strings_are_equal(obj, car(x)))))
- return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
-
- if ((obj == car(x)) ||
- ((is_string(car(x))) &&
- (scheme_strings_are_equal(obj, car(x)))))
- return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
-
- y = cdr(y);
- if (x == y) return(sc->F);
+ n = x->next;
+ loc = x->raw_hash & hash_len;
+ x->next = new_els[loc];
+ new_els[loc] = x;
}
- return(sc->F);
- }
-
- while (true)
- {
- if (s7_is_equal(sc, obj, car(x))) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
-
- if (s7_is_equal(sc, obj, car(x))) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
-
- if (s7_is_equal(sc, obj, car(x))) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
-
- if (s7_is_equal(sc, obj, car(x))) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
-
- y = cdr(y);
- if (x == y) return(sc->F);
}
- return(sc->F); /* not reached */
+ hash_table_elements(table) = new_els;
+ free(old_els);
+ hash_table_mask(table) = new_size - 1;
+ return(hash_len);
}
-static s7_pointer g_member(s7_scheme *sc, s7_pointer args)
-{
- #define H_member "(member obj list (func #f)) looks for obj in list and returns the list from that point if it is found, otherwise #f. \
-member uses equal? If 'func' is a function of 2 arguments, it is used for the comparison instead of 'equal?"
- #define Q_member s7_make_signature(sc, 4, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_boolean_symbol), sc->T, sc->is_list_symbol, sc->is_procedure_symbol)
-
- /* this could be extended to accept sequences:
- * (member #\a "123123abnfc" char=?) -> "abnfc"
- * (member "abc" "123abc321" string=?) -> "abc321" but there's the string length complication
- * (member 1 #(0 1 2) =) -> #(1 2) etc but what would it do for a hash-table?
- * the third arg can be weird: (member #f (list #t) cons) -> (#t) -- cons returns '(#f . #t) which is true, so we get '(#t)
- * should this be an error: (member '(1 2 3) () '(1 . 2)) -- the third arg is bogus, but the second is nil
- *
- * here as in assoc, sort, and make-hash-table we accept macros, but I can't think of a good reason to do so.
- */
- s7_pointer x, y, obj, eq_func = NULL;
- x = cadr(args);
+/* -------------------------------- hash-table-ref -------------------------------- */
- if ((!is_pair(x)) && (!is_null(x)))
- method_or_bust_with_type(sc, x, sc->member_symbol, args, a_list_string, 2);
+s7_pointer s7_hash_table_ref(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ hash_entry_t *x;
+ x = (*hash_table_checker(table))(sc, table, key);
+ if (x) return(x->value);
+ return(sc->F);
+}
- if (is_not_null(cddr(args)))
- {
- /* check third arg before second (trailing arg error check) */
- eq_func = caddr(args);
- if (type(eq_func) < T_GOTO)
- method_or_bust_with_type(sc, eq_func, sc->member_symbol, args, a_procedure_string, 3);
+static s7_pointer g_hash_table_ref(s7_scheme *sc, s7_pointer args)
+{
+ #define H_hash_table_ref "(hash-table-ref table key) returns the value associated with key in the hash table"
+ #define Q_hash_table_ref s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_hash_table_symbol, sc->T)
- if (!s7_is_aritable(sc, eq_func, 2))
- return(wrong_type_argument_with_type(sc, sc->member_symbol, 3, eq_func, an_eq_func_string));
- }
+ s7_pointer table;
+ table = car(args);
+ if (!is_hash_table(table))
+ method_or_bust(sc, table, sc->hash_table_ref_symbol, args, T_HASH_TABLE, 1);
+ /*
+ (define (href H . args)
+ (if (null? (cdr args))
+ (hash-table-ref H (car args))
+ (apply href (hash-table-ref H (car args)) (cdr args))))
+ */
+ if (is_null(cddr(args)))
+ return(s7_hash_table_ref(sc, table, cadr(args)));
+ return(implicit_index(sc, s7_hash_table_ref(sc, table, cadr(args)), cddr(args)));
+}
- if (is_null(x)) return(sc->F);
- if (eq_func)
- {
- /* now maybe there's a simple case */
- if (s7_list_length(sc, x) > 0)
- {
- if ((is_safe_procedure(eq_func)) &&
- (is_c_function(eq_func)))
- {
- s7_function func;
- func = c_function_call(eq_func);
- if (func == g_is_eq) return(s7_memq(sc, car(args), x));
- if (func == g_is_eqv) return(g_memv(sc, args));
- set_car(sc->t2_1, car(args));
+static s7_pointer hash_table_ref_2;
+static s7_pointer g_hash_table_ref_2(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer table;
+ hash_entry_t *x;
- for (; is_pair(x); x = cdr(x))
- {
- set_car(sc->t2_2, car(x));
- if (is_true(sc, func(sc, sc->t2_1)))
- return(x);
- }
- return(sc->F);
- }
+ table = car(args);
+ if (!is_hash_table(table))
+ method_or_bust(sc, table, sc->hash_table_ref_symbol, args, T_HASH_TABLE, 1);
- if ((is_closure(eq_func)) &&
- (is_pair(closure_args(eq_func))) &&
- (is_pair(cdr(closure_args(eq_func))))) /* not dotted arg list */
- {
- s7_pointer body;
- body = closure_body(eq_func);
- if ((is_optimized(car(body))) &&
- (is_null(cdr(body))) &&
- (is_all_x_safe(sc, car(body))))
- {
- s7_function func;
- func = all_x_eval(sc, car(body), closure_args(eq_func), pair_symbol_is_safe);
+ x = (*hash_table_checker(table))(sc, table, cadr(args));
+ if (x) return(x->value);
+ return(sc->F);
+}
- /* tmap, lg falls through*/
- if (((func == all_x_c_ss) || (func == all_x_c_uu)) &&
- (cadar(body) == car(closure_args(eq_func))) &&
- (caddar(body) == cadr(closure_args(eq_func))))
- {
- set_car(sc->t2_1, car(args));
- func = c_callee(car(body));
- for (; is_pair(x); x = cdr(x))
- {
- set_car(sc->t2_2, car(x));
- if (is_true(sc, func(sc, sc->t2_1)))
- return(x);
- }
- }
- else
- {
- s7_pointer b;
- new_frame_with_two_slots(sc, sc->envir, sc->envir, car(closure_args(eq_func)), car(args), cadr(closure_args(eq_func)), sc->F);
- b = next_slot(let_slots(sc->envir));
+static s7_pointer hash_table_ref_ss;
+static s7_pointer g_hash_table_ref_ss(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer table, key;
+ hash_entry_t *x;
- for (; is_pair(x); x = cdr(x))
- {
- slot_set_value(b, car(x));
- if (is_true(sc, func(sc, car(body))))
- return(x);
- }
- }
- return(sc->F);
- }
- }
- }
+ table = find_symbol_unchecked(sc, car(args));
+ key = find_symbol_unchecked(sc, cadr(args));
+ if (!is_hash_table(table))
+ method_or_bust(sc, table, sc->hash_table_ref_symbol, list_2(sc, table, key), T_HASH_TABLE, 1);
+
+ x = (*hash_table_checker(table))(sc, table, key);
+ if (x) return(x->value);
+ return(sc->F);
+}
- y = cons(sc, args, sc->nil); /* this could probably be handled with a counter cell (cdr here is unused) */
- set_opt_fast(y, x);
- set_opt_slow(y, x);
- push_stack(sc, OP_MEMBER_IF, y, eq_func);
- set_car(sc->t2_1, car(args));
- set_car(sc->t2_2, car(x));
- push_stack(sc, OP_APPLY, sc->t2_1, eq_func);
- return(sc->unspecified);
- }
+static s7_pointer hash_table_ref_car;
+static s7_pointer g_hash_table_ref_car(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer y, table;
+ hash_entry_t *x;
- obj = car(args);
- if (is_simple(obj))
- return(s7_memq(sc, obj, x));
+ table = find_symbol_unchecked(sc, car(args));
+ y = find_symbol_unchecked(sc, cadadr(args));
+ if (!is_pair(y))
+ return(simple_wrong_type_argument(sc, sc->car_symbol, y, T_PAIR));
- /* the only things that aren't simply == here are c_object, string, number, vector, hash-table, pair, and c_pointer
- * but all the other cases are unlikely.
- */
- if (s7_is_number(obj))
- return(memv_number(sc, obj, x));
+ if (!is_hash_table(table))
+ method_or_bust(sc, table, sc->hash_table_ref_symbol, list_2(sc, table, car(y)), T_HASH_TABLE, 1);
- return(member(sc, obj, x));
+ x = (*hash_table_checker(table))(sc, table, car(y));
+ if (x) return(x->value);
+ return(sc->F);
}
-static s7_pointer c_member(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_member(sc, set_plist_2(sc, x, y)));}
-PF2_TO_PF(member, c_member)
-
-static s7_pointer member_sq;
-static s7_pointer g_member_sq(s7_scheme *sc, s7_pointer args)
+static s7_pointer hash_table_ref_p_pp(s7_pointer p1, s7_pointer p2)
{
- s7_pointer obj, lst;
- lst = cadr(cadr(args));
- obj = find_symbol_checked(sc, car(args));
+ if (!is_hash_table(p1))
+ simple_wrong_type_argument(cur_sc, cur_sc->hash_table_ref_symbol, p1, T_HASH_TABLE);
+ return(s7_hash_table_ref(cur_sc, p1, p2));
+}
- if (is_simple(obj))
- return(s7_memq(sc, obj, lst));
+static s7_pointer hash_table_ref_p_pp_direct(s7_pointer p1, s7_pointer p2)
+{
+ return(s7_hash_table_ref(cur_sc, p1, p2));
+}
- if (s7_is_number(obj))
- return(memv_number(sc, obj, lst));
- return(member(sc, obj, lst));
-}
+/* -------------------------------- hash-table-set! -------------------------------- */
-static s7_pointer member_num_s;
-static s7_pointer g_member_num_s(s7_scheme *sc, s7_pointer args)
+static void hash_table_set_function(s7_pointer table, int typ)
{
- s7_pointer lst;
-
- lst = find_symbol_checked(sc, cadr(args));
- if (!is_pair(lst))
+ if ((hash_table_checker(table) != hash_equal) &&
+ (hash_table_checker(table) != default_hash_checks[typ]))
{
- if (is_null(lst)) return(sc->F);
- method_or_bust_with_type(sc, lst, sc->member_symbol, list_2(sc, car(args), lst), a_list_string, 2);
+ if (hash_table_checker(table) == hash_empty)
+ hash_table_checker(table) = default_hash_checks[typ];
+ else hash_table_checker(table) = hash_equal;
}
- return(memv_number(sc, car(args), lst));
}
-static s7_pointer member_ss;
-static s7_pointer g_member_ss(s7_scheme *sc, s7_pointer args)
+
+s7_pointer s7_hash_table_set(s7_scheme *sc, s7_pointer table, s7_pointer key, s7_pointer value)
{
- s7_pointer obj, x;
+ hash_entry_t *x;
+ x = (*hash_table_checker(table))(sc, table, key);
- obj = find_symbol_checked(sc, car(args));
- x = find_symbol_checked(sc, cadr(args));
- if (!is_pair(x))
+ if (x)
{
- if (is_null(x)) return(sc->F);
- method_or_bust_with_type(sc, x, sc->member_symbol, list_2(sc, obj, x), a_list_string, 2);
+ if (value == sc->F)
+ return(remove_from_hash_table(sc, table, key, x));
+ x->value = _NFre(value);
}
+ else
+ {
+ unsigned int hash_len, raw_hash, loc;
+ 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 (is_simple(obj))
- return(s7_memq(sc, obj, x));
+ hash_len = hash_table_mask(table);
+ if (hash_table_entries(table) > hash_len)
+ hash_len = resize_hash_table(sc, table);
+ raw_hash = hash_loc(sc, table, key);
- if (s7_is_number(obj))
- return(memv_number(sc, obj, x));
+ if (!hash_free_list)
+ {
+ int i;
+ hash_free_list = (hash_entry_t *)malloc(16 * sizeof(hash_entry_t));
+ for (p = hash_free_list, i = 0; i < 15; i++) {p->next = p + 1; p++;}
+ p->next = NULL;
+ }
- return(member(sc, obj, x));
+ p = hash_free_list;
+ hash_free_list = p->next;
+ p->key = key;
+ p->value = _NFre(value);
+ p->raw_hash = raw_hash;
+
+ loc = raw_hash & hash_len;
+ p->next = hash_table_element(table, loc);
+ hash_table_element(table, loc) = p;
+ hash_table_entries(table)++;
+ }
+ return(value);
}
-static s7_pointer member_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+
+static s7_pointer g_hash_table_set(s7_scheme *sc, s7_pointer args)
{
- if (args == 2)
- {
- if (is_symbol(caddr(expr)))
- {
- if (s7_is_number(cadr(expr)))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(member_num_s); /* (member 4 lst) */
- }
+ #define H_hash_table_set "(hash-table-set! table key value) sets the value associated with key in the hash table to value"
+ #define Q_hash_table_set s7_make_signature(sc, 4, sc->T, sc->is_hash_table_symbol, sc->T, sc->T)
- if (is_symbol(cadr(expr)))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(member_ss); /* (member obj lst) */
- }
- }
- else
- {
- if ((is_symbol(cadr(expr))) &&
- (is_pair(caddr(expr))) &&
- (car(caddr(expr)) == sc->quote_symbol) &&
- (is_pair(cadr(caddr(expr)))))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(member_sq); /* (member q '(quote lambda case)) */
- }
- }
- }
+ s7_pointer table;
+ table = car(args);
+ if (!is_hash_table(table))
+ method_or_bust(sc, table, sc->hash_table_set_symbol, args, T_HASH_TABLE, 1);
+ return(s7_hash_table_set(sc, table, cadr(args), caddr(args)));
+}
- if ((args == 3) &&
- (is_symbol(cadddr(expr))) &&
- (cadddr(expr) == sc->is_eq_symbol))
- return(memq_chooser(sc, f, 2, expr));
+static s7_pointer hash_table_set_p_ppp(s7_pointer p1, s7_pointer p2, s7_pointer p3)
+{
+ if (!is_hash_table(p1))
+ simple_wrong_type_argument(cur_sc, cur_sc->hash_table_set_symbol, p1, T_HASH_TABLE);
+ return(s7_hash_table_set(cur_sc, p1, p2, p3));
+}
- return(f);
+static s7_pointer hash_table_set_p_ppp_direct(s7_pointer p1, s7_pointer p2, s7_pointer p3)
+{
+ return(s7_hash_table_set(cur_sc, p1, p2, p3));
}
-static bool is_memq(s7_pointer sym, s7_pointer lst)
+/* -------------------------------- hash-table -------------------------------- */
+static s7_pointer g_hash_table(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
- for (x = lst; is_pair(x); x = cdr(x))
- if (sym == car(x))
- return(true);
- return(false);
+ #define H_hash_table "(hash-table ...) returns a hash-table containing the cons's passed as its arguments. \
+That is, (hash-table '(\"hi\" . 3) (\"ho\" . 32)) returns a new hash-table with the two key/value pairs preinstalled."
+ #define Q_hash_table s7_make_circular_signature(sc, 1, 2, sc->is_hash_table_symbol, sc->is_list_symbol)
+
+ int len;
+ s7_pointer x, ht;
+
+ /* this accepts repeated keys: (hash-table '(a . 1) '(a . 1)) */
+ for (len = 0, x = args; is_pair(x); x = cdr(x), len++)
+ if ((!is_pair(car(x))) &&
+ (!is_null(car(x))))
+ return(wrong_type_argument(sc, sc->hash_table_symbol, position_of(x, args), car(x), T_PAIR));
+
+ ht = s7_make_hash_table(sc, (len > sc->default_hash_table_length) ? len : sc->default_hash_table_length);
+ if (len > 0)
+ {
+ unsigned int ht_loc;
+ ht_loc = s7_gc_protect(sc, ht); /* hash_table_set can cons, so we need to protect this */
+ for (x = args; is_pair(x); x = cdr(x))
+ if (is_pair(car(x)))
+ s7_hash_table_set(sc, ht, caar(x), cdar(x));
+ s7_gc_unprotect_at(sc, ht_loc);
+ }
+ return(ht);
}
-static s7_pointer c_is_provided(s7_scheme *sc, s7_pointer sym)
+/* -------------------------------- hash-table* -------------------------------- */
+static s7_pointer g_hash_table_star(s7_scheme *sc, s7_pointer args)
{
- s7_pointer topf, x;
+ #define H_hash_table_star "(hash-table* ...) returns a hash-table containing the symbol/value pairs passed as its arguments. \
+That is, (hash-table* 'a 1 'b 2) returns a new hash-table with the two key/value pairs preinstalled."
+ #define Q_hash_table_star s7_make_circular_signature(sc, 1, 2, sc->is_hash_table_symbol, sc->T)
- if (!is_symbol(sym))
- method_or_bust(sc, sym, sc->is_provided_symbol, list_1(sc, sym), T_SYMBOL, 0);
+ int len;
+ s7_pointer ht;
- /* here the *features* list is spread out (or can be anyway) along the curlet chain,
- * so we need to travel back all the way to the top level checking each *features* list in turn.
- * Since *features* grows via cons (newest first), we can stop the scan if we hit the shared
- * top-level at least.
- */
- topf = slot_value(global_slot(sc->features_symbol));
- if (is_memq(sym, topf))
- return(sc->T);
+ len = safe_list_length(sc, args);
+ if (len & 1)
+ return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_2(sc, make_string_wrapper(sc, "hash-table* got an odd number of arguments: ~S"), args)));
+ len /= 2;
- if (is_global(sc->features_symbol))
- return(sc->F);
- for (x = sc->envir; symbol_id(sc->features_symbol) < let_id(x); x = outlet(x));
- for (; is_let(x); x = outlet(x))
+ ht = s7_make_hash_table(sc, (len > sc->default_hash_table_length) ? len : sc->default_hash_table_length);
+ if (len > 0)
{
- s7_pointer y;
- for (y = let_slots(x); is_slot(y); y = next_slot(y))
- if (slot_symbol(y) == sc->features_symbol)
- {
- if ((slot_value(y) != topf) &&
- (is_memq(sym, slot_value(y))))
- return(sc->T);
- }
+ unsigned int ht_loc;
+ 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))
+ s7_hash_table_set(sc, ht, car(x), car(y));
+
+ s7_gc_unprotect_at(sc, ht_loc);
}
- return(sc->F);
+ return(ht);
}
-static s7_pointer g_is_provided(s7_scheme *sc, s7_pointer args)
+static s7_pointer hash_table_copy(s7_scheme *sc, s7_pointer old_hash, s7_pointer new_hash, unsigned int start, unsigned int end)
{
- #define H_is_provided "(provided? symbol) returns #t if symbol is a member of the *features* list"
- #define Q_is_provided s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_symbol_symbol)
+ unsigned int i, old_len, new_len, count = 0;
+ hash_entry_t **old_lists, **new_lists;
+ hash_entry_t *x, *p;
- return(c_is_provided(sc, car(args)));
+ old_len = hash_table_mask(old_hash) + 1;
+ new_len = hash_table_mask(new_hash);
+ old_lists = hash_table_elements(old_hash);
+ new_lists = hash_table_elements(new_hash);
+
+ if (hash_table_entries(new_hash) == 0)
+ {
+ hash_table_checker(new_hash) = hash_table_checker(old_hash);
+ if ((start == 0) &&
+ (end >= hash_table_entries(old_hash)))
+ {
+ for (i = 0; i < old_len; i++)
+ for (x = old_lists[i]; x; x = x->next)
+ {
+ unsigned int loc;
+ loc = x->raw_hash & new_len;
+ p = make_hash_entry(x->key, x->value, x->raw_hash);
+ p->next = new_lists[loc];
+ new_lists[loc] = p;
+ }
+ hash_table_entries(new_hash) = hash_table_entries(old_hash);
+ return(new_hash);
+ }
+ for (i = 0; i < old_len; i++)
+ for (x = old_lists[i]; x; x = x->next)
+ {
+ if (count >= end)
+ {
+ hash_table_entries(new_hash) = end - start;
+ return(new_hash);
+ }
+ if (count >= start)
+ {
+ unsigned int loc;
+ loc = x->raw_hash & new_len;
+ p = make_hash_entry(x->key, x->value, x->raw_hash);
+ p->next = new_lists[loc];
+ new_lists[loc] = p;
+ }
+ count++;
+ }
+ hash_table_entries(new_hash) = count - start;
+ return(new_hash);
+ }
+
+ /* this can't be optimized much because we have to look for key matches (we're copying old_hash into the exisiting, non-empty new_hash) */
+ for (i = 0; i < old_len; i++)
+ for (x = old_lists[i]; x; x = x->next)
+ {
+ if (count >= end)
+ return(new_hash);
+ if (count >= start)
+ {
+ hash_entry_t *y;
+ y = (*hash_table_checker(new_hash))(sc, new_hash, x->key);
+ if (y)
+ y->value = x->value;
+ else
+ {
+ unsigned int loc;
+ loc = x->raw_hash & new_len;
+ p = make_hash_entry(x->key, x->value, x->raw_hash);
+ 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));
+ }
+ }
+ count++;
+ }
+ return(new_hash);
}
-bool s7_is_provided(s7_scheme *sc, const char *feature)
+static s7_pointer hash_table_fill(s7_scheme *sc, s7_pointer args)
{
- return(is_memq(s7_make_symbol(sc, feature), s7_symbol_value(sc, sc->features_symbol))); /* this goes from local outward */
+ s7_pointer val, table;
+ table = car(args);
+ val = cadr(args);
+ if (hash_table_entries(table) > 0)
+ {
+ int len;
+ hash_entry_t **entries;
+ entries = hash_table_elements(table);
+ len = hash_table_mask(table) + 1;
+ /* hash-table-ref returns #f if it can't find a key, so val == #f here means empty the table */
+ if (val == sc->F)
+ {
+ hash_entry_t **hp;
+ hash_entry_t *p;
+ hp = entries;
+ if (len == 1)
+ {
+ if (*hp)
+ {
+ p = *hp;
+ while (p->next) p = p->next;
+ p->next = hash_free_list;
+ hash_free_list = *hp;
+ }
+ }
+ else
+ {
+ hash_entry_t **hn;
+ /* here we assume we can go by 2's */
+ hn = (hash_entry_t **)(hp + len);
+ for (; hp < hn; hp++)
+ {
+ if (*hp)
+ {
+ p = *hp;
+ while (p->next) p = p->next;
+ p->next = hash_free_list;
+ hash_free_list = *hp;
+ }
+ hp++;
+ if (*hp)
+ {
+ p = *hp;
+ while (p->next) p = p->next;
+ p->next = hash_free_list;
+ hash_free_list = *hp;
+ }
+ }
+ }
+ memset(entries, 0, len * sizeof(hash_entry_t *));
+ if (!hash_table_checker_locked(table))
+ hash_table_checker(table) = hash_empty;
+ hash_table_entries(table) = 0;
+ }
+ else
+ {
+ int i;
+ hash_entry_t *x;
+ for (i = 0; i < len; i++)
+ for (x = entries[i]; x; x = x->next)
+ x->value = val;
+ /* keys haven't changed, so no need to mess with hash_table_checker */
+ }
+ }
+ return(val);
}
-PF_TO_PF(is_provided, c_is_provided)
-
-static s7_pointer c_provide(s7_scheme *sc, s7_pointer sym)
+static s7_pointer hash_table_reverse(s7_scheme *sc, s7_pointer old_hash)
{
- /* this has to be relative to the curlet: (load file env)
- * the things loaded are only present in env, and go away with it, so should not be in the global *features* list
- */
- s7_pointer p, lst;
- if (!is_symbol(sym))
- method_or_bust(sc, sym, sc->provide_symbol, list_1(sc, sym), T_SYMBOL, 0);
+ int i, len;
+ s7_pointer new_hash;
+ hash_entry_t **old_lists;
+ unsigned int gc_loc;
- p = find_local_symbol(sc, sc->features_symbol, sc->envir); /* if sc->envir is nil, this returns the global slot, else local slot */
- lst = slot_value(find_symbol(sc, sc->features_symbol)); /* in either case, we want the current *features* list */
+ len = hash_table_mask(old_hash) + 1;
+ new_hash = s7_make_hash_table(sc, len);
+ gc_loc = s7_gc_protect(sc, new_hash);
- if (p == sc->undefined)
- make_slot_1(sc, sc->envir, sc->features_symbol, cons(sc, sym, lst));
- else
+ /* I don't think the original hash functions can make any sense in general, so ignore them */
+ old_lists = hash_table_elements(old_hash);
+ for (i = 0; i < len; i++)
{
- if (!is_memq(sym, lst))
- slot_set_value(p, cons(sc, sym, lst));
+ hash_entry_t *x;
+ for (x = old_lists[i]; x; x = x->next)
+ s7_hash_table_set(sc, new_hash, x->value, x->key);
}
-
- if (!is_slot(find_symbol(sc, sym))) /* *features* name might be the same as an existing function */
- s7_define(sc, sc->envir, sym, sym);
- return(sym);
-}
-
-static s7_pointer g_provide(s7_scheme *sc, s7_pointer args)
-{
- #define H_provide "(provide symbol) adds symbol to the *features* list"
- #define Q_provide s7_make_signature(sc, 2, sc->is_symbol_symbol, sc->is_symbol_symbol)
- return(c_provide(sc, car(args)));
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(new_hash);
}
-void s7_provide(s7_scheme *sc, const char *feature)
-{
- c_provide(sc, s7_make_symbol(sc, feature));
-}
-PF_TO_PF(provide, c_provide)
+/* -------------------------------- functions -------------------------------- */
-static s7_pointer g_features_set(s7_scheme *sc, s7_pointer args)
+bool s7_is_function(s7_pointer p)
{
- /* symbol_access for set/let of *features* which can only be changed via provide */
- if (s7_is_list(sc, cadr(args)))
- return(cadr(args));
- return(sc->error_symbol);
+ return(is_c_function(p));
}
-static s7_pointer g_list(s7_scheme *sc, s7_pointer args)
+static s7_pointer fallback_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
- #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));
+ return(f);
}
-static s7_pointer c_list_1(s7_scheme *sc, s7_pointer x) {return(cons(sc, x, sc->nil));}
-PF_TO_PF(list, c_list_1)
-
-static s7_pointer list_0, list_1, list_2;
-static s7_pointer g_list_0(s7_scheme *sc, s7_pointer args)
+static void s7_function_set_class(s7_pointer f, s7_pointer base_f)
{
- return(sc->nil);
+ c_function_class(f) = c_function_class(base_f);
+ c_function_set_base(f, base_f);
}
-static s7_pointer g_list_1(s7_scheme *sc, s7_pointer args)
-{
- return(cons(sc, car(args), sc->nil));
-}
+static int c_functions = 0;
-static s7_pointer g_list_2(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_make_function(s7_scheme *sc, const char *name, s7_function f, int required_args, int optional_args, bool rest_arg, const char *doc)
{
- return(cons_unchecked(sc, car(args), cons(sc, cadr(args), sc->nil)));
-}
+ c_proc_t *ptr;
+ unsigned int ftype = T_C_FUNCTION;
+ s7_pointer x;
-static s7_pointer list_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
-{
- switch (args)
+ x = alloc_pointer();
+ unheap(x);
+
+ ptr = (c_proc_t *)malloc(sizeof(c_proc_t));
+ c_functions++;
+ if (required_args == 0)
{
- case 0: return(list_0);
- case 1: return(list_1);
- case 2: return(list_2);
+ if (rest_arg)
+ ftype = T_C_ANY_ARGS_FUNCTION;
+ else
+ {
+ if (optional_args != 0)
+ ftype = T_C_OPT_ARGS_FUNCTION;
+ /* a thunk needs to check for no args passed */
+ }
+ }
+ else
+ {
+ if (rest_arg)
+ ftype = T_C_RST_ARGS_FUNCTION;
}
- return(f);
-}
+ set_type(x, ftype);
-s7_pointer s7_list(s7_scheme *sc, int num_values, ...)
-{
- int i;
- va_list ap;
- s7_pointer p;
+ c_function_data(x) = ptr;
+ c_function_call(x) = f;
+ /* f is _TApp but needs cast */
+ c_function_set_base(x, x);
+ c_function_set_setter(x, sc->F);
+ c_function_name(x) = name; /* (procedure-name proc) => (format #f "~A" proc) */
+ c_function_name_length(x) = safe_strlen(name);
+ if (doc)
+ c_function_documentation(x) = make_permanent_c_string(doc);
+ else c_function_documentation(x) = NULL;
+ c_function_signature(x) = sc->F;
- if (num_values == 0)
- return(sc->nil);
+ c_function_required_args(x) = required_args;
+ c_function_optional_args(x) = optional_args;
+ c_function_has_rest_arg(x) = rest_arg;
+ if (rest_arg)
+ c_function_all_args(x) = MAX_ARITY;
+ else c_function_all_args(x) = required_args + optional_args;
- sc->w = sc->nil;
- va_start(ap, num_values);
- for (i = 0; i < num_values; i++)
- sc->w = cons(sc, va_arg(ap, s7_pointer), sc->w);
- va_end(ap);
+ c_function_class(x) = ++sc->f_class;
+ c_function_chooser(x) = fallback_chooser;
+ c_function_opt_data(x) = NULL;
- p = sc->w;
- sc->w = sc->nil;
- return(safe_reverse_in_place(sc, p));
+ return(x);
}
-static s7_int sequence_length(s7_scheme *sc, s7_pointer lst);
-
-static s7_pointer g_list_append(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_make_safe_function(s7_scheme *sc, const char *name, s7_function f,
+ int required_args, int optional_args, bool rest_arg, const char *doc)
{
- s7_pointer y, tp, np = NULL, pp;
- bool args_are_lists = true;
-
- /* we know here that args is a pair and cdr(args) is a pair */
- tp = sc->nil;
- for (y = args; is_pair(y); y = cdr(y)) /* arglist so not dotted */
- {
- s7_pointer p;
- p = car(y);
-
- check_method(sc, p, sc->append_symbol, (is_null(tp)) ? args : cons(sc, tp, y));
-
- if (is_null(cdr(y)))
- {
- if (is_null(tp))
- return(p);
- /* (append (list 1) "hi") should return '(1 . "hi") not '(1 #\h #\i)
- * but this is inconsistent with (append (list 1) "hi" "hi") -> '(1 #\h #\i . "hi") ?
- * Perhaps if all args but last are lists, returned dotted list?
- */
- if (args_are_lists || (is_null(p)))
- set_cdr(np, p);
- else
- {
- s7_int len;
- len = sequence_length(sc, p);
- if (len > 0)
- set_cdr(np, s7_copy(sc, set_plist_2(sc, p, make_list(sc, len, sc->F))));
- else
- {
- if (len < 0)
- set_cdr(np, p);
- }
- }
- sc->y = sc->nil;
- return(tp);
- }
-
- if (!is_sequence(p))
- return(wrong_type_argument_with_type(sc, sc->append_symbol, position_of(y, args), p, a_sequence_string));
-
- if (!is_null(p))
- {
- if (is_pair(p))
- {
- if (!is_proper_list(sc, p))
- {
- sc->y = sc->nil;
- return(wrong_type_argument_with_type(sc, sc->append_symbol, position_of(y, args), p, a_proper_list_string));
- }
- /* is this error correct?
- * (append '(3) '(1 . 2)) -> '(3 1 . 2) ; (old) guile also returns this
- * but (append '(1 . 2) '(3)) -> this error
- */
-
- if (is_null(tp))
- {
- tp = cons(sc, car(p), sc->nil);
- np = tp;
- sc->y = tp; /* GC protect? */
- pp = cdr(p);
- }
- else pp = p;
- for (; is_pair(pp); pp = cdr(pp), np = cdr(np))
- set_cdr(np, cons(sc, car(pp), sc->nil));
- }
- else
- {
- s7_int len;
- args_are_lists = false;
- len = sequence_length(sc, p);
- if (len > 0)
- {
- if (is_null(tp))
- {
- tp = s7_copy(sc, set_plist_2(sc, p, make_list(sc, len, sc->F)));
- np = tp;
- sc->y = tp;
- }
- else set_cdr(np, s7_copy(sc, set_plist_2(sc, p, make_list(sc, len, sc->F))));
- for (; is_pair(cdr(np)); np = cdr(np));
- }
- else
- {
- if (len < 0)
- return(wrong_type_argument_with_type(sc, sc->append_symbol, position_of(y, args), p, a_sequence_string));
- }
- }
- }
- }
- return(tp);
+ s7_pointer p;
+ p = s7_make_function(sc, name, f, required_args, optional_args, rest_arg, doc);
+ typeflag(p) |= T_SAFE_PROCEDURE;
+ return(p);
}
-static s7_pointer append_in_place(s7_scheme *sc, s7_pointer a, s7_pointer b)
+s7_pointer s7_make_typed_function(s7_scheme *sc, const char *name, s7_function f,
+ int required_args, int optional_args, bool rest_arg, const char *doc, s7_pointer signature)
{
- /* tack b onto the end of a without copying either -- 'a' is changed! */
- s7_pointer p;
- if (is_null(a))
- return(b);
- p = a;
- while (is_not_null(cdr(p))) p = cdr(p);
- set_cdr(p, b);
- return(a);
+ s7_pointer func;
+ func = s7_make_function(sc, name, f, required_args, optional_args, rest_arg, doc);
+ typeflag(func) |= T_SAFE_PROCEDURE;
+ if (signature) c_function_signature(func) = signature;
+ return(func);
}
-/* -------------------------------- vectors -------------------------------- */
-
-bool s7_is_vector(s7_pointer p)
+bool s7_is_procedure(s7_pointer x)
{
- return(t_vector_p[type(p)]);
+ return(is_procedure(x));
}
-bool s7_is_float_vector(s7_pointer p)
+static s7_pointer g_is_procedure(s7_scheme *sc, s7_pointer args)
{
- return(type(p) == T_FLOAT_VECTOR);
+ #define H_is_procedure "(procedure? obj) returns #t if obj is a procedure"
+ #define Q_is_procedure pl_bt
+
+ return(make_boolean(sc, is_procedure(car(args))));
}
-bool s7_is_int_vector(s7_pointer p)
+static void s7_function_set_setter(s7_scheme *sc, const char *getter, const char *setter)
{
- return(type(p) == T_INT_VECTOR);
+ /* this is internal, used only with c_function setters, so we don't need to worry about the GC mark choice
+ */
+ c_function_set_setter(s7_name_to_value(sc, getter), s7_name_to_value(sc, setter));
}
-static s7_pointer default_vector_setter(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val)
+s7_pointer s7_closure_body(s7_scheme *sc, s7_pointer p)
{
- vector_element(vec, loc) = val;
- return(val);
+ if (has_closure_let(p))
+ return(closure_body(p));
+ return(sc->nil);
}
-static s7_pointer default_vector_getter(s7_scheme *sc, s7_pointer vec, s7_int loc)
-{
- return(vector_element(vec, loc));
-}
-static s7_pointer int_vector_setter(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val)
+s7_pointer s7_closure_let(s7_scheme *sc, s7_pointer p)
{
- if (!s7_is_integer(val))
- s7_wrong_type_arg_error(sc, "int_vector_set!", 3, val, "an integer");
- int_vector_element(vec, loc) = s7_integer(val);
- return(val);
+ if (has_closure_let(p))
+ return(closure_let(p));
+ return(sc->nil);
}
-static s7_pointer int_vector_getter(s7_scheme *sc, s7_pointer vec, s7_int loc)
+
+s7_pointer s7_closure_args(s7_scheme *sc, s7_pointer p)
{
- return(make_integer(sc, int_vector_element(vec, loc)));
+ if (has_closure_let(p))
+ return(closure_args(p));
+ return(sc->nil);
}
-static s7_pointer float_vector_setter(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val)
+static s7_pointer g_procedure_source(s7_scheme *sc, s7_pointer args)
{
- float_vector_element(vec, loc) = real_to_double(sc, val, "float-vector-set!");
- return(val);
+ /* make it look like a scheme-level lambda */
+ s7_pointer p;
+ #define H_procedure_source "(procedure-source func) tries to return the definition of func"
+ #define Q_procedure_source s7_make_signature(sc, 2, sc->is_list_symbol, sc->is_procedure_symbol)
+
+ p = car(args);
+ if (is_symbol(p))
+ {
+ p = s7_symbol_value(sc, p);
+ if (p == sc->undefined)
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "procedure-source arg, '~S, is unbound"), p)));
+ }
+
+ if ((is_c_function(p)) || (is_c_macro(p)))
+ return(sc->nil);
+
+ check_method(sc, p, sc->procedure_source_symbol, list_1(sc, p));
+ if (has_closure_let(p))
+ {
+ s7_pointer body;
+ body = closure_body(p);
+ if (is_safe_closure(body))
+ clear_safe_closure(body);
+ return(append_in_place(sc, list_2(sc, ((is_closure_star(p)) ||
+ (is_macro_star(p)) ||
+ (is_bacro_star(p))) ? sc->lambda_star_symbol : sc->lambda_symbol,
+ closure_args(p)), body));
+ }
+
+ if (!is_procedure(p))
+ return(simple_wrong_type_argument_with_type(sc, sc->procedure_source_symbol, p, make_string_wrapper(sc, "a procedure or a macro")));
+ return(sc->nil);
}
-static s7_pointer float_vector_getter(s7_scheme *sc, s7_pointer vec, s7_int loc)
+s7_pointer s7_funclet(s7_scheme *sc, s7_pointer p)
{
- return(make_real(sc, float_vector_element(vec, loc)));
+ if (has_closure_let(p))
+ return(closure_let(p));
+ return(sc->rootlet);
}
-static s7_pointer make_vector_1(s7_scheme *sc, s7_int len, bool filled, unsigned int typ)
+static s7_pointer g_funclet(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
- if (len < 0)
- return(wrong_type_argument_with_type(sc, sc->make_vector_symbol, 1, make_integer(sc, len), a_non_negative_integer_string));
- if (len > sc->max_vector_length)
- return(out_of_range(sc, sc->make_vector_symbol, small_int(1), make_integer(sc, len), its_too_large_string));
+ s7_pointer p, e;
+ #define H_funclet "(funclet func) tries to return an object's environment"
+ #define Q_funclet s7_make_signature(sc, 2, sc->is_let_symbol, sc->is_procedure_symbol)
- /* this has to follow the error checks! (else garbage in free_heap temps portion confuses GC when "vector" is finalized) */
- new_cell(sc, x, typ | T_SAFE_PROCEDURE); /* (v 0) as vector-ref is safe */
- vector_length(x) = 0;
- vector_elements(x) = NULL;
- vector_dimension_info(x) = NULL;
+ /* this procedure gives direct access to a function's closure -- see s7test.scm
+ * for some wild examples. At least it provides a not-too-kludgey way for several functions
+ * to share a closure.
+ */
- if (len > 0)
+ p = car(args);
+ if (is_symbol(p))
{
- vector_length(x) = len;
- if (typ == T_VECTOR)
- {
- vector_elements(x) = (s7_pointer *)malloc(len * sizeof(s7_pointer));
- if (!vector_elements(x))
- return(s7_error(sc, make_symbol(sc, "out-of-memory"), set_elist_1(sc, make_string_wrapper(sc, "make-vector allocation failed!"))));
- vector_getter(x) = default_vector_getter;
- vector_setter(x) = default_vector_setter;
- if (filled) s7_vector_fill(sc, x, sc->nil); /* make_hash_table assumes nil as the default value */
- }
- else
- {
- if (typ == T_FLOAT_VECTOR)
- {
- if (filled)
- float_vector_elements(x) = (s7_double *)calloc(len, sizeof(s7_double));
- else float_vector_elements(x) = (s7_double *)malloc(len * sizeof(s7_double));
- if (!float_vector_elements(x))
- return(s7_error(sc, make_symbol(sc, "out-of-memory"), set_elist_1(sc, make_string_wrapper(sc, "make-float-vector allocation failed!"))));
- vector_getter(x) = float_vector_getter;
- vector_setter(x) = float_vector_setter;
- }
- else
- {
- if (filled)
- int_vector_elements(x) = (s7_int *)calloc(len, sizeof(s7_int));
- else int_vector_elements(x) = (s7_int *)malloc(len * sizeof(s7_int));
- if (!int_vector_elements(x))
- return(s7_error(sc, make_symbol(sc, "out-of-memory"), set_elist_1(sc, make_string_wrapper(sc, "make-int-vector allocation failed!"))));
- vector_getter(x) = int_vector_getter;
- vector_setter(x) = int_vector_setter;
- }
- }
+ p = s7_symbol_value(sc, p);
+ if (p == sc->undefined)
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "funclet arg, '~S, is unbound"), car(args)))); /* not p here */
}
+ check_method(sc, p, sc->funclet_symbol, args);
- Add_Vector(x);
- return(x);
+ if (!((is_procedure_or_macro(p)) || (is_c_object(p))))
+ return(simple_wrong_type_argument_with_type(sc, sc->funclet_symbol, p, make_string_wrapper(sc, "a procedure or a macro")));
+
+ e = find_let(sc, p);
+ if ((is_null(e)) &&
+ (!is_c_object(p)))
+ return(sc->rootlet);
+
+ return(e);
}
-s7_pointer s7_make_vector(s7_scheme *sc, s7_int len)
+s7_pointer s7_define_function(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg, const char *doc)
{
- return(make_vector_1(sc, len, FILLED, T_VECTOR));
+ s7_pointer func, sym;
+ func = s7_make_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
+ sym = make_symbol(sc, name);
+ s7_define(sc, sc->nil, sym, func);
+ return(sym);
}
-static vdims_t *make_wrap_only(s7_scheme *sc)
+
+s7_pointer s7_define_safe_function(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg, const char *doc)
{
- vdims_t *v;
- v = (vdims_t *)malloc(sizeof(vdims_t));
- v->original = sc->F;
- v->elements_allocated = false;
- v->ndims = 1;
- v->dimensions_allocated = false;
- v->dims = NULL;
- v->offsets = NULL;
- return(v);
+ /* returns (string->symbol name), not the c_proc_t func */
+ s7_pointer func, sym;
+ func = s7_make_safe_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
+ sym = make_symbol(sc, name);
+ s7_define(sc, sc->nil, sym, func);
+ return(sym);
}
-#define make_vdims(Sc, Alloc, Dims, Info) ((((Dims) == 1) && (!(Alloc))) ? sc->wrap_only : make_vdims_1(Sc, Alloc, Dims, Info))
-static vdims_t *make_vdims_1(s7_scheme *sc, bool elements_allocated, int dims, s7_int *dim_info)
+s7_pointer s7_define_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg,
+ const char *doc, s7_pointer signature)
{
- vdims_t *v;
+ /* returns (string->symbol name), not the c_proc_t func */
+ s7_pointer func, sym;
+ func = s7_make_typed_function(sc, name, fnc, required_args, optional_args, rest_arg, doc, signature);
+ sym = make_symbol(sc, name);
+ s7_define(sc, sc->nil, sym, func);
+ return(sym);
+}
- v = (vdims_t *)malloc(sizeof(vdims_t));
- v->original = sc->F;
- v->elements_allocated = elements_allocated;
- v->ndims = dims;
- if (dims > 1)
- {
- int i;
- s7_int offset = 1;
- v->dimensions_allocated = true;
- v->dims = (s7_int *)malloc(v->ndims * sizeof(s7_int));
- v->offsets = (s7_int *)malloc(v->ndims * sizeof(s7_int));
- for (i = 0; i < dims; i++)
- v->dims[i] = dim_info[i];
- for (i = v->ndims - 1; i >= 0; i--)
- {
- v->offsets[i] = offset;
- offset *= v->dims[i];
- }
- }
- else
- {
- v->dimensions_allocated = false;
- v->dims = NULL;
- v->offsets = NULL;
- }
- return(v);
+s7_pointer s7_define_unsafe_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg,
+ const char *doc, s7_pointer signature)
+{
+ /* returns (string->symbol name), not the c_proc_t func */
+ s7_pointer func, sym;
+ func = s7_make_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
+ if (signature) c_function_signature(func) = signature;
+ sym = make_symbol(sc, name);
+ s7_define(sc, sc->nil, sym, func);
+ return(sym);
}
-s7_pointer s7_make_int_vector(s7_scheme *sc, s7_int len, int dims, s7_int *dim_info)
+s7_pointer s7_define_macro(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg, const char *doc)
{
- s7_pointer p;
- p = make_vector_1(sc, len, FILLED, T_INT_VECTOR);
- if (dim_info)
- vector_dimension_info(p) = make_vdims(sc, true, dims, dim_info);
- return(p);
+ s7_pointer func, sym;
+ func = s7_make_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
+ set_type(func, T_C_MACRO | T_DONT_EVAL_ARGS);
+ sym = make_symbol(sc, name);
+ s7_define(sc, sc->nil, sym, func);
+ return(sym);
}
-s7_pointer s7_make_float_vector(s7_scheme *sc, s7_int len, int dims, s7_int *dim_info)
+bool s7_is_macro(s7_scheme *sc, s7_pointer x)
{
- s7_pointer p;
- p = make_vector_1(sc, len, FILLED, T_FLOAT_VECTOR);
- if (dim_info)
- vector_dimension_info(p) = make_vdims(sc, true, dims, dim_info);
- return(p);
+ return(is_any_macro(x));
}
+static bool is_macro_b(s7_pointer x) {return(is_any_macro(x));}
-s7_pointer s7_make_float_vector_wrapper(s7_scheme *sc, s7_int len, s7_double *data, int dims, s7_int *dim_info, bool free_data)
-{
- /* this wraps up a C-allocated/freed double array as an s7 vector.
- */
- s7_pointer x;
- new_cell(sc, x, T_FLOAT_VECTOR | T_SAFE_PROCEDURE);
- float_vector_elements(x) = data;
- vector_getter(x) = float_vector_getter;
- vector_setter(x) = float_vector_setter;
- vector_length(x) = len;
- if (!dim_info)
- {
- if (!free_data) /* here we need the dim info to tell the GC to leave the data alone */
- {
- s7_int di[1];
- di[0] = len;
- vector_dimension_info(x) = make_vdims(sc, free_data, 1, di);
- }
- else vector_dimension_info(x) = NULL;
- }
- else vector_dimension_info(x) = make_vdims(sc, free_data, dims, dim_info);
- Add_Vector(x);
- return(x);
+static s7_pointer g_is_macro(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_macro "(macro? arg) returns #t if 'arg' is a macro or a bacro"
+ #define Q_is_macro pl_bt
+ check_boolean_method(sc, is_any_macro, sc->is_macro_symbol, args);
}
-s7_int s7_vector_length(s7_pointer vec)
+static s7_pointer s7_macroexpand(s7_scheme *sc, s7_pointer mac, s7_pointer args)
{
- return(vector_length(vec));
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->code = mac;
+ 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);
}
-s7_int s7_print_length(s7_scheme *sc) {return(sc->print_length);}
-s7_int s7_set_print_length(s7_scheme *sc, s7_int new_len)
+static void define_function_star_1(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc, bool safe)
{
- s7_int old_len;
- old_len = sc->print_length;
- sc->print_length = new_len;
- return(old_len);
-}
+ s7_pointer func, sym, local_args, p;
+ char *internal_arglist;
+ int i, len, n_args;
+ unsigned int gc_loc;
+ s7_pointer *names, *defaults;
+
+ len = safe_strlen(arglist) + 8;
+ tmpbuf_malloc(internal_arglist, len);
+ snprintf(internal_arglist, len, "'(%s)", arglist);
+ local_args = s7_eval_c_string(sc, internal_arglist);
+ gc_loc = s7_gc_protect(sc, local_args);
+ tmpbuf_free(internal_arglist, len);
+ n_args = safe_list_length(sc, local_args); /* currently rest arg not supported, and we don't notice :allow-other-keys etc */
+
+ func = s7_make_function(sc, name, fnc, 0, n_args, false, doc);
+ if (safe)
+ set_type(func, T_C_FUNCTION_STAR | T_SAFE_PROCEDURE);
+ else set_type(func, T_C_FUNCTION_STAR);
+ c_function_call_args(func) = make_list(sc, n_args, sc->F);
+ s7_remove_from_heap(sc, c_function_call_args(func));
-#if (!WITH_GMP)
-void s7_vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj)
-#else
-static void vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj)
-#endif
-{
- s7_int len, i, left;
+ sym = make_symbol(sc, name);
+ s7_define(sc, sc->nil, sym, func);
- len = vector_length(vec);
- if (len == 0) return;
- left = len - 8;
- i = 0;
+ names = (s7_pointer *)malloc(n_args * sizeof(s7_pointer));
+ c_function_arg_names(func) = names;
+ defaults = (s7_pointer *)malloc(n_args * sizeof(s7_pointer));
+ c_function_arg_defaults(func) = defaults;
+ set_simple_defaults(func);
- switch (type(vec))
+ for (p = local_args, i = 0; i < n_args; p = cdr(p), i++)
{
- case T_FLOAT_VECTOR:
- if (!s7_is_real(obj))
- s7_wrong_type_arg_error(sc, "(float) vector-fill!", 2, obj, "a real");
- else
+ s7_pointer arg;
+ arg = car(p);
+ if (is_pair(arg))
{
- s7_double x;
- x = real_to_double(sc, obj, "vector-fill!");
- if (x == 0.0)
- memclr((void *)float_vector_elements(vec), len * sizeof(s7_double));
- else
+ names[i] = s7_make_keyword(sc, symbol_name(car(arg)));
+ defaults[i] = cadr(arg);
+ s7_remove_from_heap(sc, cadr(arg));
+ if ((is_symbol(defaults[i])) ||
+ (is_pair(defaults[i])))
{
- s7_double *orig;
- orig = float_vector_elements(vec);
- while (i <= left)
- {
- orig[i++] = x;
- orig[i++] = x;
- orig[i++] = x;
- orig[i++] = x;
- orig[i++] = x;
- orig[i++] = x;
- orig[i++] = x;
- orig[i++] = x;
- }
- for (; i < len; i++)
- orig[i] = x;
+ clear_simple_defaults(func);
+ mark_function[T_C_FUNCTION_STAR] = mark_c_proc_star;
}
}
- break;
-
- 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");
else
{
- s7_int k;
- k = s7_integer(obj);
- if (k == 0)
- memclr((void *)int_vector_elements(vec), len * sizeof(s7_int));
- else
- {
- s7_int* orig;
- orig = int_vector_elements(vec);
- while (i <= left)
- {
- orig[i++] = k;
- orig[i++] = k;
- orig[i++] = k;
- orig[i++] = k;
- orig[i++] = k;
- orig[i++] = k;
- orig[i++] = k;
- orig[i++] = k;
- }
- for (; i < len; i++)
- orig[i] = k;
- }
+ names[i] = s7_make_keyword(sc, symbol_name(arg));
+ defaults[i] = sc->F;
}
- break;
-
- default:
- {
- s7_pointer *orig;
- orig = vector_elements(vec);
- while (i <= left)
- {
- orig[i++] = obj;
- orig[i++] = obj;
- orig[i++] = obj;
- orig[i++] = obj;
- orig[i++] = obj;
- orig[i++] = obj;
- orig[i++] = obj;
- orig[i++] = obj;
- }
- for (; i < len; i++)
- orig[i] = obj;
- }
}
+ s7_gc_unprotect_at(sc, gc_loc);
}
+void s7_define_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc)
+{
+ define_function_star_1(sc, name, fnc, arglist, doc, false);
+}
-static s7_pointer g_vector_fill(s7_scheme *sc, s7_pointer args)
+void s7_define_safe_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc)
{
- #define H_vector_fill "(vector-fill! v val start end) sets all elements of the vector v between start and end to val"
- #define Q_vector_fill s7_make_circular_signature(sc, 3, 4, sc->T, sc->is_vector_symbol, sc->T, sc->is_integer_symbol)
+ define_function_star_1(sc, name, fnc, arglist, doc, true);
+}
- s7_pointer x, fill;
- s7_int start = 0, end;
- x = car(args);
- if (!s7_is_vector(x))
+static s7_pointer set_c_function_call_args(s7_scheme *sc)
+{
+ int i, j, n_args;
+ s7_pointer arg, par, call_args, func;
+ s7_pointer *df;
+
+ func = sc->code;
+ n_args = c_function_all_args(func);
+ call_args = c_function_call_args(func);
+
+ df = c_function_arg_defaults(func);
+ for (i = 0, par = call_args; is_pair(par); i++, par = cdr(par))
{
- check_method(sc, x, sc->vector_fill_symbol, args);
- /* not two_methods (and fill!) here else we get stuff like:
- * (let ((e (openlet (inlet 'fill! (lambda (obj val) (string-fill! (obj 'value) val)) 'value "01234")))) (vector-fill! e #\a) (e 'value)) -> "aaaaa"
- */
- return(wrong_type_argument(sc, sc->vector_fill_symbol, 1, x, T_VECTOR));
+ clear_checked(par);
+ set_car(par, df[i]);
}
- fill = cadr(args);
- if (is_float_vector(x))
+ df = c_function_arg_names(func);
+ for (i = 0, arg = sc->args, par = call_args; (i < n_args) && (is_pair(arg)); i++, arg = cdr(arg), par = cdr(par))
{
- if (!s7_is_real(fill)) /* possibly a bignum */
+ if (!is_keyword(car(arg)))
{
- check_two_methods(sc, fill, sc->vector_fill_symbol, sc->fill_symbol, args);
- s7_wrong_type_arg_error(sc, "(float) vector-fill!", 2, fill, "a real");
+ if (is_checked(par))
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, make_string_wrapper(sc, "parameter set twice, ~S in ~S"), car(par), sc->args)));
+ set_checked(par);
+ set_car(par, car(arg));
}
- }
- else
- {
- if (is_int_vector(x))
+ else
{
- 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_pointer p;
+ for (j = 0, p = call_args; j < n_args; j++, p = cdr(p))
+ if (df[j] == car(arg))
+ break;
+ if (j == n_args)
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "~A: not a parameter name?"), car(arg))));
+ if (is_checked(p))
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, make_string_wrapper(sc, "parameter set twice, ~S in ~S"), car(p), sc->args)));
+ set_checked(p);
+ arg = cdr(arg);
+ set_car(p, car(arg));
}
}
- end = vector_length(x);
- if (!is_null(cddr(args)))
- {
- s7_pointer p;
- p = start_and_end(sc, sc->vector_fill_symbol, sc->fill_symbol, cddr(args), args, 3, &start, &end);
- if (p != sc->gc_nil) return(p);
- if (start == end) return(fill);
- }
- if (end == 0) return(fill);
+ if (!is_null(arg))
+ return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, func, sc->args)));
- if ((start == 0) && (end == vector_length(x)))
- s7_vector_fill(sc, x, fill);
- else
- {
- s7_int i;
- if (is_normal_vector(x))
- {
- for (i = start; i < end; i++)
- vector_element(x, i) = fill;
- }
- else
+ if (!has_simple_defaults(func))
+ for (i = 0, par = call_args; i < n_args; i++, par = cdr(par))
+ if (!is_checked(par))
{
- if (is_int_vector(x))
- {
- s7_int k;
- k = s7_integer(fill);
- if (k == 0)
- memclr((void *)(int_vector_elements(x) + start), (end - start) * sizeof(s7_int));
- else
- {
- for (i = start; i < end; i++)
- int_vector_element(x, i) = k;
- }
- }
+ if (is_symbol(car(par)))
+ set_car(par, find_symbol_checked(sc, car(par)));
else
{
- if (is_float_vector(x))
- {
- s7_double y;
- y = real_to_double(sc, fill, "vector-fill!");
- if (y == 0.0)
- memclr((void *)(float_vector_elements(x) + start), (end - start) * sizeof(s7_double));
- else
- {
- s7_double *orig;
- s7_int left;
- orig = float_vector_elements(x);
- left = end - 8;
- i = start;
- while (i <= left)
- {
- orig[i++] = y;
- orig[i++] = y;
- orig[i++] = y;
- orig[i++] = y;
- orig[i++] = y;
- orig[i++] = y;
- orig[i++] = y;
- orig[i++] = y;
- }
- for (; i < end; i++)
- orig[i] = y;
- }
- }
+ if (is_pair(car(par)))
+ set_car(par, s7_eval(sc, car(par), sc->nil));
}
}
- }
- return(fill);
+ return(call_args);
}
-#if (!WITH_PURE_S7)
-static s7_pointer c_vector_fill(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_vector_fill(sc, set_plist_2(sc, x, y)));}
-PF2_TO_PF(vector_fill, c_vector_fill)
-#endif
-s7_pointer s7_vector_ref(s7_scheme *sc, s7_pointer vec, s7_int index)
+/* -------------------------------- procedure-documentation -------------------------------- */
+static s7_pointer get_doc(s7_scheme *sc, s7_pointer x)
{
- if (index >= vector_length(vec))
- return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), make_integer(sc, index), its_too_large_string));
-
- return(vector_getter(vec)(sc, vec, index));
+ check_closure_for(sc, x, sc->documentation_symbol);
+ return(NULL);
}
-
-s7_pointer s7_vector_set(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer a)
+const char *s7_procedure_documentation(s7_scheme *sc, s7_pointer x)
{
- if (index >= vector_length(vec))
- return(out_of_range(sc, sc->vector_set_symbol, small_int(2), make_integer(sc, index), its_too_large_string));
+ s7_pointer val;
+ if (is_symbol(x))
+ {
+ if ((symbol_has_help(x)) &&
+ (is_global(x)))
+ return(symbol_help(x));
+ x = s7_symbol_value(sc, x); /* this is needed by Snd */
+ }
- vector_setter(vec)(sc, vec, index, _NFre(a));
- return(a);
-}
+ if ((is_any_c_function(x)) ||
+ (is_c_macro(x)))
+ return((char *)c_function_documentation(x));
+
+ val = get_doc(sc, x);
+ if ((val) && (is_string(val)))
+ return(string_value(val));
+ return(NULL);
+}
-s7_pointer *s7_vector_elements(s7_pointer vec)
+static s7_pointer g_procedure_documentation(s7_scheme *sc, s7_pointer args)
{
- return(vector_elements(vec));
+ s7_pointer p;
+ #define H_procedure_documentation "(procedure-documentation func) returns func's documentation string"
+ #define Q_procedure_documentation s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_procedure_symbol)
+
+ p = car(args);
+ if (is_symbol(p))
+ {
+ if ((symbol_has_help(p)) &&
+ (is_global(p)))
+ return(s7_make_string(sc, symbol_help(p)));
+ p = s7_symbol_value(sc, p);
+ }
+
+ check_method(sc, p, sc->procedure_documentation_symbol, list_1(sc, p));
+ if ((!is_procedure(p)) &&
+ (!s7_is_macro(sc, 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)));
}
-s7_int *s7_int_vector_elements(s7_pointer vec)
+/* -------------------------------- help -------------------------------- */
+const char *s7_help(s7_scheme *sc, s7_pointer obj)
{
- return(int_vector_elements(vec));
+ if (is_syntax(obj))
+ return(string_value(syntax_documentation(obj)));
+
+ if (is_symbol(obj))
+ {
+ /* here look for name */
+ if (s7_symbol_documentation(sc, obj))
+ return(s7_symbol_documentation(sc, obj));
+ obj = s7_symbol_value(sc, obj);
+ }
+
+ if (is_procedure_or_macro(obj))
+ return(s7_procedure_documentation(sc, obj));
+
+ /* if is string, apropos? (can scan symbol table) */
+ return(NULL);
}
-s7_double *s7_float_vector_elements(s7_pointer vec)
+static s7_pointer g_help(s7_scheme *sc, s7_pointer args)
{
- return(float_vector_elements(vec));
+ #define H_help "(help obj) returns obj's documentation"
+ #define Q_help s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_boolean_symbol), sc->T)
+ const char *doc;
+
+ check_method(sc, car(args), sc->help_symbol, args);
+ doc = s7_help(sc, car(args));
+ if (!doc)
+ return(sc->F);
+ return(s7_make_string(sc, doc));
}
-s7_int *s7_vector_dimensions(s7_pointer vec)
+/* -------------------------------- procedure-signature -------------------------------- */
+static s7_pointer get_signature(s7_scheme *sc, s7_pointer x)
{
- s7_int *dims;
- if (vector_dimension_info(vec))
- return(vector_dimensions(vec));
- dims = (s7_int *)malloc(sizeof(s7_int));
- dims[0] = vector_length(vec);
- return(dims);
+ check_closure_for(sc, x, sc->signature_symbol);
+ return(sc->F);
}
+s7_pointer s7_procedure_signature(s7_scheme *sc, s7_pointer func)
+{
+ if ((is_any_c_function(func)) ||
+ (is_c_macro(func)))
+ return((s7_pointer)c_function_signature(func));
+ return(get_signature(sc, func));
+}
-s7_int *s7_vector_offsets(s7_pointer vec)
+static s7_pointer g_procedure_signature(s7_scheme *sc, s7_pointer args)
{
- s7_int *offs;
- if (vector_dimension_info(vec))
- return(vector_offsets(vec));
- offs = (s7_int *)malloc(sizeof(s7_int));
- offs[0] = 1;
- return(offs);
+ 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)
+
+ p = car(args);
+ if (is_symbol(p))
+ {
+ p = s7_symbol_value(sc, p);
+ if (p == sc->undefined)
+ return(sc->F);
+ }
+ 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));
}
+/* -------------------------------- new types (c_objects) -------------------------------- */
-#if (!WITH_PURE_S7)
-static s7_pointer vector_append(s7_scheme *sc, s7_pointer args, int typ);
+static void fallback_free(void *value) {}
+static void fallback_mark(void *value) {}
-static s7_pointer g_vector_append(s7_scheme *sc, s7_pointer args)
+static char *fallback_print(s7_scheme *sc, void *val)
{
- /* returns a one-dimensional vector. To handle multidimensional vectors, we'd need to
- * ensure all the dimensional data matches (rank, size of each dimension except the last etc),
- * which is too much trouble.
- */
- #define H_vector_append "(vector-append . vectors) returns a new (1-dimensional) vector containing the elements of its vector arguments."
- #define Q_vector_append pcl_v
+ return(copy_string("#<unprintable object>"));
+}
- s7_pointer p;
- int i;
+static char *fallback_print_readably(s7_scheme *sc, void *val)
+{
+ return(copy_string("#<unprint-readable object>"));
+}
- if (is_null(args))
- return(make_vector_1(sc, 0, NOT_FILLED, T_VECTOR));
+static bool fallback_equal(void *val1, void *val2)
+{
+ return(val1 == val2);
+}
- for (i = 0, p = args; is_pair(p); p = cdr(p), i++)
- {
- s7_pointer x;
- x = car(p);
- if (!s7_is_vector(x))
- {
- if (has_methods(x))
- {
- s7_pointer func;
- func = find_method(sc, find_let(sc, x), sc->vector_append_symbol);
- if (func != sc->undefined)
- {
- int k;
- s7_pointer v, y;
- if (i == 0)
- return(s7_apply_function(sc, func, args));
- /* we have to copy the arglist here */
- sc->temp9 = make_list(sc, i, sc->F);
- for (k = 0, y = args, v = sc->temp9; k < i; k++, y = cdr(y), v = cdr(v))
- set_car(v, car(y));
- v = g_vector_append(sc, sc->temp9);
- y = s7_apply_function(sc, func, cons(sc, v, p));
- sc->temp9 = sc->nil;
- return(y);
- }
- }
- return(wrong_type_argument(sc, sc->vector_append_symbol, i, x, T_VECTOR));
- }
- }
- return(vector_append(sc, args, type(car(args))));
+static s7_pointer fallback_ref(s7_scheme *sc, s7_pointer obj, s7_pointer args)
+{
+ return(apply_error(sc, obj, args));
}
-#endif
-s7_pointer s7_vector_ref_n(s7_scheme *sc, s7_pointer vector, int indices, ...)
+static s7_pointer fallback_set(s7_scheme *sc, s7_pointer obj, s7_pointer args)
{
- /* from s7.html */
- int ndims;
+ eval_error(sc, "attempt to set ~S?", obj);
+}
- ndims = s7_vector_rank(vector);
- if (ndims == indices)
- {
- va_list ap;
- s7_int index = 0;
- va_start(ap, indices);
+static s7_pointer fallback_length(s7_scheme *sc, s7_pointer obj)
+{
+ return(sc->F);
+}
- if (ndims == 1)
- {
- index = va_arg(ap, s7_int);
- va_end(ap);
- return(s7_vector_ref(sc, vector, index));
- }
- else
- {
- int i;
- s7_int *offsets, *dimensions;
- dimensions = s7_vector_dimensions(vector);
- offsets = s7_vector_offsets(vector);
+bool s7_is_object(s7_pointer p)
+{
+ return(is_c_object(p));
+}
- for (i = 0; i < indices; i++)
- {
- int ind;
- ind = va_arg(ap, int);
- if ((ind < 0) ||
- (ind >= dimensions[i]))
- {
- va_end(ap);
- return(out_of_range(sc, sc->vector_ref_symbol, small_int(i), make_integer(sc, ind), (ind < 0) ? its_negative_string : its_too_large_string));
- }
- index += (ind * offsets[i]);
- }
- va_end(ap);
- return(vector_getter(vector)(sc, vector, index));
- }
- }
- return(s7_wrong_number_of_args_error(sc, "s7_vector_ref_n: wrong number of indices: ~A", s7_make_integer(sc, indices)));
+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 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 */
+ check_method(sc, p, sc->is_c_object_symbol, args);
+ return(sc->F);
}
-s7_pointer s7_vector_set_n(s7_scheme *sc, s7_pointer vector, s7_pointer value, int indices, ...)
+static s7_pointer g_internal_object_set(s7_scheme *sc, s7_pointer args)
{
- int ndims;
+ return((*(c_object_set(car(args))))(sc, car(args), cdr(args)));
+}
- ndims = s7_vector_rank(vector);
- if (ndims == indices)
- {
- va_list ap;
- s7_int index = 0;
- va_start(ap, indices);
- if (ndims == 1)
+int s7_new_type(const char *name,
+ char *(*print)(s7_scheme *sc, void *value),
+ void (*gc_free)(void *value),
+ bool (*equal)(void *val1, void *val2),
+ void (*gc_mark)(void *val),
+ s7_pointer (*ref)(s7_scheme *sc, s7_pointer obj, s7_pointer args),
+ s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args))
+{
+ int tag;
+ tag = num_object_types++;
+ if (tag >= object_types_size)
+ {
+ if (object_types_size == 0)
{
- index = va_arg(ap, s7_int);
- va_end(ap);
- s7_vector_set(sc, vector, index, value);
- return(value);
+ object_types_size = 8;
+ object_types = (c_object_t **)calloc(object_types_size, sizeof(c_object_t *));
}
else
{
- int i;
- s7_int *offsets, *dimensions;
-
- dimensions = s7_vector_dimensions(vector);
- offsets = s7_vector_offsets(vector);
-
- for (i = 0; i < indices; i++)
- {
- int ind;
- ind = va_arg(ap, int);
- if ((ind < 0) ||
- (ind >= dimensions[i]))
- {
- va_end(ap);
- return(s7_out_of_range_error(sc, "s7_vector_set_n", i, s7_make_integer(sc, ind), "should be a valid index"));
- }
- index += (ind * offsets[i]);
- }
- va_end(ap);
- vector_setter(vector)(sc, vector, index, value);
- return(value);
+ object_types_size = tag + 8;
+ object_types = (c_object_t **)realloc((void *)object_types, object_types_size * sizeof(c_object_t *));
}
}
- return(s7_wrong_number_of_args_error(sc, "s7_vector_set_n: wrong number of indices: ~A", s7_make_integer(sc, indices)));
-}
+ 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);
+ 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;
-s7_pointer s7_vector_to_list(s7_scheme *sc, s7_pointer vect)
-{
- s7_int i, len;
- s7_pointer result;
+ 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;
- len = vector_length(vect);
- if (len == 0)
- return(sc->nil);
- if (len >= (sc->free_heap_top - sc->free_heap))
- {
- gc(sc);
- while (len >= (sc->free_heap_top - sc->free_heap))
- resize_heap(sc);
- }
+ 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;
- sc->v = sc->nil;
- for (i = len - 1; i >= 0; i--)
- sc->v = cons_unchecked(sc, vector_getter(vect)(sc, vect, i), sc->v);
- result = sc->v;
- sc->v = sc->nil;
- return(result);
+ return(tag);
}
-#if (!WITH_PURE_S7)
-static s7_pointer c_vector_to_list(s7_scheme *sc, s7_pointer vec)
+
+int s7_new_type_x(s7_scheme *sc,
+ const char *name,
+ char *(*print)(s7_scheme *sc, void *value),
+ void (*free)(void *value),
+ bool (*equal)(void *val1, void *val2),
+ void (*gc_mark)(void *val),
+ s7_pointer (*apply)(s7_scheme *sc, s7_pointer obj, s7_pointer args),
+ s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args),
+ s7_pointer (*length)(s7_scheme *sc, s7_pointer obj),
+ s7_pointer (*copy)(s7_scheme *sc, s7_pointer args),
+ s7_pointer (*reverse)(s7_scheme *sc, s7_pointer args),
+ s7_pointer (*fill)(s7_scheme *sc, s7_pointer args))
{
- sc->temp3 = vec;
- if (!s7_is_vector(vec))
- method_or_bust(sc, vec, sc->vector_to_list_symbol, list_1(sc, vec), T_VECTOR, 0);
- return(s7_vector_to_list(sc, vec));
+ int 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;
+ return(tag);
}
-static s7_pointer g_vector_to_list(s7_scheme *sc, s7_pointer args)
-{
- s7_int i, start = 0, end;
- s7_pointer p, vec;
- #define H_vector_to_list "(vector->list v start end) returns the elements of the vector v as a list; (map values v)"
- #define Q_vector_to_list s7_make_circular_signature(sc, 2, 3, sc->is_proper_list_symbol, sc->is_vector_symbol, sc->is_integer_symbol)
- vec = car(args);
- if (!s7_is_vector(vec))
- method_or_bust(sc, vec, sc->vector_to_list_symbol, args, T_VECTOR, 0);
+static void free_object(s7_pointer a)
+{
+ (*(c_object_free(a)))(c_object_value(a));
+}
- end = vector_length(vec);
- if (!is_null(cdr(args)))
- {
- p = start_and_end(sc, sc->vector_to_list_symbol, NULL, cdr(args), args, 2, &start, &end);
- if (p != sc->gc_nil) return(p);
- if (start == end) return(sc->nil);
- }
- if ((start == 0) && (end == vector_length(vec)))
- return(s7_vector_to_list(sc, vec));
- sc->w = sc->nil;
- for (i = end - 1; i >= start; i--)
- sc->w = cons(sc, vector_getter(vec)(sc, vec, i), sc->w);
- p = sc->w;
- sc->w = sc->nil;
- return(p);
+static bool 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))));
}
-PF_TO_PF(vector_to_list, c_vector_to_list)
-#endif
-s7_pointer s7_make_and_fill_vector(s7_scheme *sc, s7_int len, s7_pointer fill)
+void *s7_object_value(s7_pointer obj)
{
- s7_pointer vect;
- vect = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
- s7_vector_fill(sc, vect, fill);
- return(vect);
+ return(c_object_value(obj));
}
-static s7_pointer g_vector(s7_scheme *sc, s7_pointer args)
+void *s7_object_value_checked(s7_pointer obj, int type)
{
- #define H_vector "(vector ...) returns a vector whose elements are the arguments"
- #define Q_vector s7_make_circular_signature(sc, 1, 2, sc->is_vector_symbol, sc->T)
+ if ((is_c_object(obj)) &&
+ (c_object_type(obj) == type))
+ return(c_object_value(obj));
+ return(NULL);
+}
- s7_int len;
- s7_pointer vec;
- len = s7_list_length(sc, args);
- vec = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
- if (len > 0)
- {
- s7_int i;
- s7_pointer x;
- for (x = args, i = 0; is_pair(x); x = cdr(x), i++)
- vector_element(vec, i) = car(x);
- }
- return(vec);
+void s7_set_object_print_readably(int type, char *(*printer)(s7_scheme *sc, void *val))
+{
+ object_types[type]->print_readably = printer;
}
-static s7_pointer c_vector_1(s7_scheme *sc, s7_pointer x) {return(g_vector(sc, set_plist_1(sc, x)));}
-PF_TO_PF(vector, c_vector_1)
-
-static s7_pointer g_is_float_vector(s7_scheme *sc, s7_pointer args)
+int s7_object_type(s7_pointer obj)
{
- #define H_is_float_vector "(float-vector? obj) returns #t if obj is an homogeneous float vector"
- #define Q_is_float_vector pl_bt
- check_boolean_method(sc, s7_is_float_vector, sc->is_float_vector_symbol, args);
+ if (is_c_object(obj))
+ return(c_object_type(obj));
+ return(-1);
}
-static s7_pointer g_float_vector(s7_scheme *sc, s7_pointer args)
-{
- #define H_float_vector "(float-vector ...) returns an homogeneous float vector whose elements are the arguments"
- #define Q_float_vector s7_make_circular_signature(sc, 1, 2, sc->is_float_vector_symbol, sc->is_real_symbol)
- s7_int len;
- s7_pointer vec;
+s7_pointer s7_make_object(s7_scheme *sc, int type, void *value)
+{
+ s7_pointer x;
+ new_cell(sc, x, object_types[type]->outer_type);
- len = s7_list_length(sc, args);
- vec = make_vector_1(sc, len, NOT_FILLED, T_FLOAT_VECTOR); /* dangerous: assumes real_to_double won't trigger GC even if bignums */
- if (len > 0)
- {
- s7_int i;
- s7_pointer x;
- for (x = args, i = 0; is_pair(x); x = cdr(x), i++)
- {
- if (s7_is_real(car(x))) /* bignum is ok here */
- float_vector_element(vec, i) = real_to_double(sc, car(x), "float-vector");
- else return(simple_wrong_type_argument(sc, sc->float_vector_symbol, car(x), T_REAL));
- }
- }
- return(vec);
+ /* 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
+ * 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, sc->nil);
+ add_c_object(sc, x);
+ return(x);
}
-static s7_pointer c_float_vector_1(s7_scheme *sc, s7_pointer x) {return(g_float_vector(sc, set_plist_1(sc, x)));}
-PF_TO_PF(float_vector, c_float_vector_1)
-
-static s7_pointer g_is_int_vector(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_object_let(s7_pointer obj)
{
- #define H_is_int_vector "(int-vector? obj) returns #t if obj is an homogeneous int vector"
- #define Q_is_int_vector pl_bt
- check_boolean_method(sc, is_int_vector, sc->is_int_vector_symbol, args);
+ return(c_object_let(obj));
}
-static s7_pointer g_int_vector(s7_scheme *sc, s7_pointer args)
+
+s7_pointer s7_object_set_let(s7_pointer obj, s7_pointer e)
{
- #define H_int_vector "(int-vector ...) returns an homogeneous int vector whose elements are the arguments"
- #define Q_int_vector s7_make_circular_signature(sc, 1, 2, sc->is_int_vector_symbol, sc->is_integer_symbol)
+ c_object_set_let(obj, e);
+ return(e);
+}
- s7_int len;
- s7_pointer vec;
- len = s7_list_length(sc, args);
- vec = make_vector_1(sc, len, NOT_FILLED, T_INT_VECTOR);
- if (len > 0)
- {
- s7_int i;
- s7_pointer x;
- for (x = args, i = 0; is_pair(x); x = cdr(x), i++)
- {
- if (is_integer(car(x)))
- int_vector_element(vec, i) = integer(car(x));
- else return(simple_wrong_type_argument(sc, sc->int_vector_symbol, car(x), T_INTEGER));
- }
- }
- return(vec);
+void s7_object_type_set_direct(int 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_int_vector_1(s7_scheme *sc, s7_pointer x) {return(g_int_vector(sc, set_plist_1(sc, x)));}
-PF_TO_PF(int_vector, c_int_vector_1)
+static s7_pointer c_object_pi_direct(s7_pointer obj, s7_int i) {return((c_object_direct_ref(obj))(cur_sc, obj, i));}
-
-#if (!WITH_PURE_S7)
-static s7_pointer c_list_to_vector(s7_scheme *sc, s7_pointer p)
+static s7_pointer object_length(s7_scheme *sc, s7_pointer obj)
{
- sc->temp3 = p;
- if (is_null(p))
- return(s7_make_vector(sc, 0));
+ if (c_object_length(obj))
+ return((*(c_object_length(obj)))(sc, obj));
+ eval_error(sc, "attempt to get length of ~S?", obj);
+}
- if (!is_proper_list(sc, p))
- method_or_bust_with_type(sc, p, sc->list_to_vector_symbol, list_1(sc, p), a_proper_list_string, 0);
- return(g_vector(sc, p));
+static s7_int object_length_to_int(s7_scheme *sc, s7_pointer obj)
+{
+ if (c_object_length(obj))
+ {
+ s7_pointer res;
+ res = (*(c_object_length(obj)))(sc, obj);
+ if (s7_is_integer(res))
+ return(s7_integer(res));
+ }
+ return(-1);
}
-static s7_pointer g_list_to_vector(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer object_copy(s7_scheme *sc, s7_pointer args)
{
- #define H_list_to_vector "(list->vector lst) returns a vector containing the elements of lst; (apply vector lst)"
- #define Q_list_to_vector s7_make_signature(sc, 2, sc->is_vector_symbol, sc->is_proper_list_symbol)
- return(c_list_to_vector(sc, car(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));
+ eval_error(sc, "attempt to copy ~S?", obj);
}
-PF_TO_PF(list_to_vector, c_list_to_vector)
-static s7_pointer g_vector_length(s7_scheme *sc, s7_pointer args)
+
+/* -------- dilambda -------- */
+
+s7_pointer s7_dilambda(s7_scheme *sc,
+ const char *name,
+ s7_pointer (*getter)(s7_scheme *sc, s7_pointer args),
+ int get_req_args, int get_opt_args,
+ s7_pointer (*setter)(s7_scheme *sc, s7_pointer args),
+ int set_req_args, int set_opt_args,
+ const char *documentation)
{
- s7_pointer vec;
- #define H_vector_length "(vector-length v) returns the length of vector v"
- #define Q_vector_length s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_vector_symbol)
+ s7_pointer get_func, set_func;
+ char *internal_set_name;
+ int len;
- vec = car(args);
- if (!s7_is_vector(vec))
- method_or_bust(sc, vec, sc->vector_length_symbol, args, T_VECTOR, 0);
+ len = 16 + safe_strlen(name);
+ internal_set_name = (char *)malloc(len * sizeof(char));
+ snprintf(internal_set_name, len, "[set-%s]", name);
- return(make_integer(sc, vector_length(vec)));
+ get_func = s7_make_safe_function(sc, name, getter, get_req_args, get_opt_args, false, documentation);
+ s7_define(sc, sc->nil, make_symbol(sc, name), get_func);
+ set_func = s7_make_function(sc, internal_set_name, setter, set_req_args, set_opt_args, false, documentation);
+ c_function_set_setter(get_func, set_func);
+
+ return(get_func);
}
-static s7_int c_vector_length(s7_scheme *sc, s7_pointer vec)
+s7_pointer s7_typed_dilambda(s7_scheme *sc,
+ const char *name,
+ s7_pointer (*getter)(s7_scheme *sc, s7_pointer args),
+ int get_req_args, int get_opt_args,
+ s7_pointer (*setter)(s7_scheme *sc, s7_pointer args),
+ int set_req_args, int set_opt_args,
+ const char *documentation,
+ s7_pointer get_sig, s7_pointer set_sig)
{
- if (!s7_is_vector(vec))
- int_method_or_bust(sc, vec, sc->vector_length_symbol, set_plist_1(sc, vec), T_VECTOR, 0);
- return(vector_length(vec));
+ s7_pointer get_func, set_func;
+ get_func = s7_dilambda(sc, name, getter, get_req_args, get_opt_args, setter, set_req_args, set_opt_args, documentation);
+ set_func = c_function_setter(get_func);
+ if (get_sig) c_function_signature(get_func) = get_sig;
+ if (set_sig) c_function_signature(set_func) = set_sig;
+ return(get_func);
}
-PF_TO_IF(vector_length, c_vector_length)
-#endif
-static s7_pointer make_shared_vector(s7_scheme *sc, s7_pointer vect, int skip_dims, s7_int index)
+bool s7_is_dilambda(s7_pointer obj)
{
- s7_pointer x;
- vdims_t *v;
+ return(((is_c_function(obj)) &&
+ (is_c_function(c_function_setter(obj)))) ||
+ ((is_any_closure(obj)) &&
+ (is_procedure(closure_setter(obj)))));
+}
- /* (let ((v #2d((1 2) (3 4)))) (v 1))
- * (let ((v (make-vector '(2 3 4) 0))) (v 1 2))
- * (let ((v #3d(((0 1 2 3) (4 5 6 7) (8 9 10 11)) ((12 13 14 15) (16 17 18 19) (20 21 22 23))))) (v 0 1))
- */
+static s7_pointer g_is_dilambda(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_dilambda "(dilambda? obj) returns #t if obj is a procedure with setter."
+ #define Q_is_dilambda pl_bt
+ check_boolean_method(sc, s7_is_dilambda, sc->is_dilambda_symbol, args);
+}
- new_cell(sc, x, typeflag(vect) | T_SAFE_PROCEDURE);
- vector_length(x) = 0;
- vector_elements(x) = NULL;
- vector_getter(x) = vector_getter(vect);
- vector_setter(x) = vector_setter(vect);
+static s7_pointer c_set_setter(s7_scheme *sc, s7_pointer p, s7_pointer setter)
+{
+ switch (type(p))
+ {
+ case T_MACRO: case T_MACRO_STAR:
+ case T_BACRO: case T_BACRO_STAR:
+ case T_CLOSURE: case T_CLOSURE_STAR:
+ closure_set_setter(p, setter);
+ break;
- v = (vdims_t *)malloc(sizeof(vdims_t));
- v->ndims = vector_ndims(vect) - skip_dims;
- v->dims = (s7_int *)(vector_dimensions(vect) + skip_dims);
- v->offsets = (s7_int *)(vector_offsets(vect) + skip_dims);
- v->original = vect; /* shared_vector */
- if (type(vect) == T_VECTOR)
- mark_function[T_VECTOR] = mark_vector_possibly_shared;
- else mark_function[type(vect)] = mark_int_or_float_vector_possibly_shared;
- v->elements_allocated = false;
- v->dimensions_allocated = false;
- vector_dimension_info(x) = v;
+ case T_C_FUNCTION:
+ case T_C_ANY_ARGS_FUNCTION:
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ c_function_set_setter(p, setter);
+ if ((is_any_closure(setter)) ||
+ (is_any_macro(setter)))
+ add_setter(sc, p, setter);
+ break;
- if (skip_dims > 0)
- vector_length(x) = vector_offset(vect, skip_dims - 1);
- else vector_length(x) = vector_length(vect);
+ case T_C_FUNCTION_STAR:
+ c_function_set_setter(p, setter);
+ if ((is_any_closure(setter)) ||
+ (is_any_macro(setter)))
+ add_setter(sc, p, setter);
+ break;
- if (is_int_vector(vect))
- int_vector_elements(x) = (s7_int *)(int_vector_elements(vect) + index);
- else
- {
- if (is_float_vector(vect))
- float_vector_elements(x) = (s7_double *)(float_vector_elements(vect) + index);
- else vector_elements(x) = (s7_pointer *)(vector_elements(vect) + index);
+ case T_C_MACRO:
+ if ((is_any_closure(setter)) ||
+ (is_any_macro(setter)))
+ add_setter(sc, p, setter);
+ c_macro_set_setter(p, setter);
+ break;
}
- add_vector(sc, x);
- return(x);
+ return(setter);
}
-
-static s7_pointer g_make_shared_vector(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_dilambda(s7_scheme *sc, s7_pointer args)
{
- #define H_make_shared_vector "(make-shared-vector original-vector new-dimensions (offset 0)) returns \
-a vector that points to the same elements as the original-vector but with different dimensional info."
- #define Q_make_shared_vector s7_make_signature(sc, 4, sc->is_vector_symbol, sc->is_vector_symbol, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_integer_symbol), sc->is_integer_symbol)
-
- /* (let ((v1 #2d((1 2 3) (4 5 6)))) (let ((v2 (make-shared-vector v1 '(6)))) v2)) -> #(1 2 3 4 5 6)
- * (let ((v1 #(1 2 3 4 5 6))) (let ((v2 (make-shared-vector v1 '(3 2)))) v2)) -> #2D((1 2) (3 4) (5 6))
- * this is most useful in generic functions -- they can still use (v n) as the accessor.
- */
- s7_pointer orig, dims, y, x;
- vdims_t *v;
- int i;
- s7_int new_len = 1, orig_len, offset = 0;
-
- orig = car(args);
- if (!s7_is_vector(orig))
- method_or_bust(sc, orig, sc->make_shared_vector_symbol, args, T_VECTOR, 1);
+ #define H_dilambda "(dilambda getter setter) sets getter's procedure-setter to be setter."
+ #define Q_dilambda s7_make_signature(sc, 3, sc->is_procedure_symbol, sc->is_procedure_symbol, sc->is_procedure_symbol)
+ s7_pointer getter, setter;
- orig_len = vector_length(orig);
+ getter = car(args);
+ if (!is_any_procedure(getter))
+ return(wrong_type_argument_with_type(sc, sc->dilambda_symbol, 1, getter, make_string_wrapper(sc, "a procedure or macro")));
- if (!is_null(cddr(args)))
- {
- s7_pointer off;
- off = caddr(args);
- if (s7_is_integer(off))
- {
- offset = s7_integer(off);
- if ((offset < 0) ||
- (offset >= orig_len)) /* we need this if, for example, offset == 9223372036854775807 */
- return(out_of_range(sc, sc->make_shared_vector_symbol, small_int(3), off, (offset < 0) ? its_negative_string : its_too_large_string));
- }
- else method_or_bust(sc, off, sc->make_shared_vector_symbol, args, T_INTEGER, 3);
- }
+ setter = cadr(args);
+ if (!is_any_procedure(setter))
+ return(wrong_type_argument_with_type(sc, sc->dilambda_symbol, 2, setter, make_string_wrapper(sc, "a procedure or macro")));
+
+ c_set_setter(sc, getter, setter);
+ return(getter);
+}
- dims = cadr(args);
- if (is_integer(dims))
- {
- if ((s7_integer(dims) < 0) ||
- (s7_integer(dims) >= orig_len))
- return(out_of_range(sc, sc->make_shared_vector_symbol, small_int(2), dims, (s7_integer(dims) < 0) ? its_negative_string : its_too_large_string));
- dims = list_1(sc, dims);
- }
- else
- {
- if ((is_null(dims)) ||
- (!is_proper_list(sc, dims)))
- method_or_bust(sc, dims, sc->make_shared_vector_symbol, args, T_PAIR, 2);
- for (y = dims; is_pair(y); y = cdr(y))
- if ((!s7_is_integer(car(y))) || /* (make-shared-vector v '((1 2) (3 4))) */
- (s7_integer(car(y)) > orig_len) ||
- (s7_integer(car(y)) < 0))
- return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_1(sc, make_string_wrapper(sc, "a list of integers that fits the original vector"))));
- }
+s7_pointer s7_procedure_setter(s7_scheme *sc, s7_pointer obj)
+{
+ if (is_c_function(obj))
+ return(c_function_setter(obj));
- v = (vdims_t *)malloc(sizeof(vdims_t));
- v->ndims = safe_list_length(sc, dims);
- v->dims = (s7_int *)malloc(v->ndims * sizeof(s7_int));
- v->offsets = (s7_int *)malloc(v->ndims * sizeof(s7_int));
- v->dimensions_allocated = true;
- v->elements_allocated = false;
- v->original = orig; /* shared_vector */
- if (type(orig) == T_VECTOR)
- mark_function[T_VECTOR] = mark_vector_possibly_shared;
- else mark_function[type(orig)] = mark_int_or_float_vector_possibly_shared;
+ return(closure_setter(obj));
+}
- for (i = 0, y = dims; is_pair(y); i++, y = cdr(y))
- v->dims[i] = s7_integer(car(y));
+static s7_pointer g_procedure_setter(s7_scheme *sc, s7_pointer args)
+{
+ #define H_procedure_setter "(procedure-setter obj) returns the setter associated with obj, or #f"
+ #define Q_procedure_setter s7_make_signature(sc, 2, sc->T, sc->is_procedure_symbol)
+ s7_pointer p;
- for (i = v->ndims - 1; i >= 0; i--)
+ p = car(args);
+ switch (type(p))
{
- v->offsets[i] = new_len;
- new_len *= v->dims[i];
- }
+ case T_MACRO: case T_MACRO_STAR:
+ case T_BACRO: case T_BACRO_STAR:
+ case T_CLOSURE: case T_CLOSURE_STAR:
+ return(closure_setter(p));
- if ((new_len < 0) || ((new_len + offset) > vector_length(orig)))
- {
- free(v->dims);
- free(v->offsets);
- free(v);
- return(out_of_range(sc, sc->make_shared_vector_symbol, small_int(2), dims, make_string_wrapper(sc, "a shared vector has to fit in the original vector")));
- }
+ case T_C_FUNCTION:
+ case T_C_FUNCTION_STAR:
+ case T_C_ANY_ARGS_FUNCTION:
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ return(c_function_setter(p));
- new_cell(sc, x, typeflag(orig) | T_SAFE_PROCEDURE);
- vector_dimension_info(x) = v;
- vector_length(x) = new_len; /* might be less than original length */
- vector_getter(x) = vector_getter(orig);
- vector_setter(x) = vector_setter(orig);
+ case T_C_MACRO:
+ return(c_macro_setter(p));
- if (is_int_vector(orig))
- int_vector_elements(x) = (s7_int *)(int_vector_elements(orig) + offset);
- else
- {
- if (is_float_vector(orig))
- float_vector_elements(x) = (s7_double *)(float_vector_elements(orig) + offset);
- else vector_elements(x) = (s7_pointer *)(vector_elements(orig) + offset);
- }
+ case T_GOTO:
+ case T_CONTINUATION:
+ return(sc->F);
- add_vector(sc, x);
- return(x);
+ case T_LET:
+ case T_C_OBJECT:
+ check_method(sc, p, s7_make_symbol(sc, "procedure-setter"), args);
+ break;
+
+ case T_ITERATOR:
+ if (is_any_closure(iterator_sequence(p)))
+ return(closure_setter(iterator_sequence(p)));
+ return(sc->F);
+ }
+ return(s7_wrong_type_arg_error(sc, "procedure-setter", 0, p, "a procedure or a reasonable facsimile thereof"));
}
-static s7_pointer c_make_shared_vector_ppi(s7_scheme *sc, s7_pointer x, s7_pointer y, s7_int z)
+static s7_pointer g_procedure_set_setter(s7_scheme *sc, s7_pointer args)
{
- return(g_make_shared_vector(sc, set_plist_3(sc, x, y, make_integer(sc, z))));
+ s7_pointer p, setter;
+
+ p = car(args);
+ if (!is_any_procedure(p))
+ return(s7_wrong_type_arg_error(sc, "set! procedure-setter procedure", 1, p, "a procedure"));
+
+ setter = cadr(args);
+ if ((setter != sc->F) &&
+ (!is_any_procedure(setter)))
+ return(s7_wrong_type_arg_error(sc, "set! procedure-setter setter", 2, setter, "a procedure or #f"));
+
+ /* should we check that p != setter?
+ * :(set! (procedure-setter <) <)
+ * <
+ * :(set! (< 3 2) 3)
+ * #f
+ * :(set! (< 1) 2)
+ * #t
+ * can this make sense?
+ */
+ return(c_set_setter(sc, p, setter));
}
-static s7_pointer c_make_shared_vector_pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+
+void s7_define_function_with_setter(s7_scheme *sc, const char *name, s7_function get_fnc, s7_function set_fnc, int req_args, int opt_args, const char *doc)
{
- return(g_make_shared_vector(sc, set_plist_2(sc, x, y)));
+ s7_dilambda(sc, name, get_fnc, req_args, opt_args, set_fnc, req_args + 1, opt_args, doc);
}
-PPIF_TO_PF(make_shared_vector, c_make_shared_vector_pp, c_make_shared_vector_ppi)
+/* -------------------------------- arity -------------------------------- */
-static s7_pointer make_vector_wrapper(s7_scheme *sc, s7_int size, s7_pointer *elements)
+static s7_pointer closure_arity_to_cons(s7_scheme *sc, s7_pointer x, s7_pointer x_args)
{
- s7_pointer x;
- new_cell(sc, x, T_VECTOR | T_SAFE_PROCEDURE);
- vector_length(x) = size;
- vector_elements(x) = elements;
- vector_getter(x) = default_vector_getter;
- vector_setter(x) = default_vector_setter;
- vector_dimension_info(x) = NULL;
- /* don't add_vector -- no need for sweep to see this */
- return(x);
-}
+ /* x_args is unprocessed -- it is exactly the list as used in the closure[*] definition
+ */
+ int len;
-static s7_pointer make_subvector(s7_scheme *sc, s7_pointer v)
-{
- s7_pointer x;
- new_cell(sc, x, type(v));
- vector_length(x) = vector_length(v);
- if (is_normal_vector(v))
- vector_elements(x) = vector_elements(v);
- else
- {
- if (is_float_vector(v))
- float_vector_elements(x) = float_vector_elements(v);
- else int_vector_elements(x) = int_vector_elements(v);
- }
- vector_getter(x) = vector_getter(v);
- vector_setter(x) = vector_setter(v);
- vector_dimension_info(x) = NULL;
- return(x);
-}
+ if (is_symbol(x_args)) /* any number of args is ok */
+ return(s7_cons(sc, small_int(0), max_arity));
+ if (closure_arity_unknown(x))
+ closure_arity(x) = s7_list_length(sc, x_args);
+ len = closure_arity(x);
+ if (len < 0) /* dotted list => rest arg, (length '(a b . c)) is -2 */
+ return(s7_cons(sc, s7_make_integer(sc, -len), max_arity));
+ return(s7_cons(sc, s7_make_integer(sc, len), s7_make_integer(sc, len)));
+}
-static s7_pointer vector_ref_1(s7_scheme *sc, s7_pointer vect, s7_pointer indices)
+static void closure_star_arity_1(s7_scheme *sc, s7_pointer x, s7_pointer args)
{
- s7_int index = 0;
- if (vector_length(vect) == 0)
- return(out_of_range(sc, sc->vector_ref_symbol, small_int(1), vect, its_too_large_string));
-
- if (vector_rank(vect) > 1)
+ if (closure_arity_unknown(x))
{
- unsigned int i;
- s7_pointer x;
- for (x = indices, i = 0; (is_not_null(x)) && (i < vector_ndims(vect)); x = cdr(x), i++)
+ if (is_null(args))
+ closure_arity(x) = 0;
+ else
{
- s7_int n;
- s7_pointer p, p1;
- p = car(x);
- if (!s7_is_integer(p))
+ if (allows_other_keys(args))
+ closure_arity(x) = -1;
+ else
{
- if (!s7_is_integer(p1 = check_values(sc, p, x)))
- method_or_bust(sc, p, sc->vector_ref_symbol, cons(sc, vect, indices), T_INTEGER, i + 2);
- p = p1;
+ s7_pointer p;
+ int i;
+ for (i = 0, p = args; is_pair(p); p = cdr(p))
+ {
+ s7_pointer arg;
+ arg = car(p);
+ if (arg == sc->key_rest_symbol)
+ break;
+ i++;
+ }
+ if (is_null(p))
+ closure_arity(x) = i;
+ else closure_arity(x) = -1; /* see below */
}
- n = s7_integer(p);
- if ((n < 0) ||
- (n >= vector_dimension(vect, i)))
- return(out_of_range(sc, sc->vector_ref_symbol, make_integer(sc, i + 2), p, (n < 0) ? its_negative_string : its_too_large_string));
-
- index += n * vector_offset(vect, i);
- }
- if (is_not_null(x))
- {
- if (type(vect) != T_VECTOR)
- return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), indices, too_many_indices_string));
- return(implicit_index(sc, vector_element(vect, index), x));
}
-
- /* if not enough indices, return a shared vector covering whatever is left */
- if (i < vector_ndims(vect))
- return(make_shared_vector(sc, vect, i, index));
}
- else
- {
- s7_pointer p, p1;
- /* (let ((hi (make-vector 3 0.0)) (sum 0.0)) (do ((i 0 (+ i 1))) ((= i 3)) (set! sum (+ sum (hi i)))) sum) */
- p = car(indices);
+}
- if (!s7_is_integer(p))
- {
- if (!s7_is_integer(p1 = check_values(sc, p, indices)))
- method_or_bust(sc, p, sc->vector_ref_symbol, cons(sc, vect, indices), T_INTEGER, 2);
- p = p1;
- }
- index = s7_integer(p);
- if ((index < 0) ||
- (index >= vector_length(vect)))
- return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), p, (index < 0) ? its_negative_string : its_too_large_string));
+static s7_pointer closure_star_arity_to_cons(s7_scheme *sc, s7_pointer x, s7_pointer x_args)
+{
+ if (is_symbol(x_args))
+ return(s7_cons(sc, small_int(0), max_arity));
- if (is_not_null(cdr(indices))) /* (let ((L #(#(1 2 3) #(4 5 6)))) (vector-ref L 1 2)) */
+ closure_star_arity_1(sc, x, x_args);
+
+ if (closure_arity(x) == -1)
+ return(s7_cons(sc, small_int(0), max_arity));
+ return(s7_cons(sc, small_int(0), s7_make_integer(sc, closure_arity(x))));
+}
+
+
+static int closure_arity_to_int(s7_scheme *sc, s7_pointer x)
+{
+ /* not lambda* here */
+ if (closure_arity_unknown(x))
+ {
+ int i;
+ s7_pointer b;
+ for (i = 0, b = closure_args(x); is_pair(b); i++, b = cdr(b)) {};
+ if (is_null(b))
+ closure_arity(x) = i;
+ else
{
- if (type(vect) != T_VECTOR)
- return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), indices, too_many_indices_string));
- return(implicit_index(sc, vector_element(vect, index), cdr(indices)));
+ if (i == 0)
+ return(-1);
+ closure_arity(x) = -i;
}
}
- return((vector_getter(vect))(sc, vect, index));
+ return(closure_arity(x));
}
-static s7_pointer g_vector_ref(s7_scheme *sc, s7_pointer args)
+static int closure_star_arity_to_int(s7_scheme *sc, s7_pointer x)
{
- #define H_vector_ref "(vector-ref v ... i) returns the i-th element of vector v."
- #define Q_vector_ref s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_vector_symbol, sc->is_integer_symbol)
-
- s7_pointer vec;
-
- vec = car(args);
- if (!s7_is_vector(vec))
- method_or_bust(sc, vec, sc->vector_ref_symbol, args, T_VECTOR, 1);
- return(vector_ref_1(sc, vec, cdr(args)));
+ /* not lambda here */
+ closure_star_arity_1(sc, x, closure_args(x));
+ return(closure_arity(x));
}
-static s7_pointer g_vector_ref_ic_n(s7_scheme *sc, s7_pointer args, s7_int index)
-{
- s7_pointer vec;
- vec = find_symbol_checked(sc, car(args));
- if (!s7_is_vector(vec))
- method_or_bust(sc, vec, sc->vector_ref_symbol, list_2(sc, vec, cadr(args)), T_VECTOR, 1);
- if (index >= vector_length(vec))
- return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), cadr(args), its_too_large_string));
- if (vector_rank(vec) > 1)
+s7_pointer s7_arity(s7_scheme *sc, s7_pointer x)
+{
+ switch (type(x))
{
- 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)));
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ case T_C_FUNCTION:
+ return(s7_cons(sc, s7_make_integer(sc, c_function_required_args(x)), s7_make_integer(sc, c_function_all_args(x))));
+
+ case T_C_ANY_ARGS_FUNCTION:
+ case T_C_FUNCTION_STAR:
+ return(s7_cons(sc, small_int(0), s7_make_integer(sc, c_function_all_args(x)))); /* should this be *2? */
+
+ case T_MACRO:
+ case T_BACRO:
+ case T_CLOSURE:
+ return(closure_arity_to_cons(sc, x, closure_args(x)));
+
+ case T_MACRO_STAR:
+ case T_BACRO_STAR:
+ case T_CLOSURE_STAR:
+ return(closure_star_arity_to_cons(sc, x, closure_args(x)));
+
+ case T_C_MACRO:
+ return(s7_cons(sc, s7_make_integer(sc, c_macro_required_args(x)), s7_make_integer(sc, c_macro_all_args(x))));
+
+ case T_GOTO:
+ case T_CONTINUATION:
+ return(s7_cons(sc, small_int(0), max_arity));
+
+ case T_STRING:
+ if (string_length(x) == 0)
+ return(sc->F);
+
+ case T_LET:
+ /* check_method(sc, x, sc->arity_symbol, args); */
+ return(s7_cons(sc, small_int(1), small_int(1)));
+
+ case T_C_OBJECT:
+ /* check_method(sc, x, sc->arity_symbol, args); */
+ if (is_procedure(x))
+ return(s7_cons(sc, small_int(0), max_arity));
+ return(sc->F);
+
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ if (vector_length(x) == 0)
+ return(sc->F);
+
+ case T_PAIR:
+ case T_HASH_TABLE:
+ return(s7_cons(sc, small_int(1), max_arity));
+
+ case T_ITERATOR:
+ return(s7_cons(sc, small_int(0), small_int(0)));
+
+ case T_SYNTAX:
+ return(s7_cons(sc, small_int(syntax_min_args(x)), (syntax_max_args(x) == -1) ? max_arity : small_int(syntax_max_args(x))));
}
- return(vector_getter(vec)(sc,vec, index));
+ return(sc->F);
}
-/* (vector-ref fv i) -> allocates real, so it's not a pf case */
-static s7_pointer vector_ref_pf_slot(s7_scheme *sc, s7_pointer **p)
+
+static s7_pointer g_arity(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x, y;
- x = (**p); (*p)++;
- y = slot_value(**p); (*p)++;
- return(vector_elements(x)[s7_integer(y)]);
+ #define H_arity "(arity obj) the min and max acceptable args for obj if it is applicable, otherwise #f."
+ #define Q_arity s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_boolean_symbol), sc->T)
+ /* check_method(sc, p, sc->arity_symbol, args); */
+ return(s7_arity(sc, car(args)));
}
-static s7_pointer vector_ref_pf_s(s7_scheme *sc, s7_pointer **p)
+
+static bool closure_is_aritable(s7_scheme *sc, s7_pointer x, s7_pointer x_args, int args)
{
- s7_if_t xf;
- s7_pointer x;
- s7_int y;
- x = (**p); (*p)++;
- xf = (s7_if_t)(**p); (*p)++;
- y = xf(sc, p);
- return(vector_elements(x)[y]);
+ /* x_args is unprocessed -- it is exactly the list as used in the closure definition
+ */
+ int len;
+
+ if (args == 0)
+ return(!is_pair(x_args));
+
+ if (is_symbol(x_args)) /* any number of args is ok */
+ return(true);
+
+ len = closure_arity(x);
+ if (len == CLOSURE_ARITY_NOT_SET)
+ {
+ len = s7_list_length(sc, x_args);
+ closure_arity(x) = len;
+ }
+ if (len < 0) /* dotted list => rest arg, (length '(a b . c)) is -2 */
+ return((-len) <= args); /* so we have enough to take care of the required args */
+ return(args == len); /* in a normal lambda list, there are no other possibilities */
}
-static s7_pointer vector_ref_pf_i(s7_scheme *sc, s7_pointer **p)
+
+static bool closure_star_is_aritable(s7_scheme *sc, s7_pointer x, s7_pointer x_args, int args)
{
- s7_if_t xf;
- s7_pointer x;
- s7_int y;
- x = slot_value(**p); (*p)++;
- xf = (s7_if_t)(**p); (*p)++;
- y = xf(sc, p);
- return(vector_elements(x)[y]);
+ if (is_symbol(x_args))
+ return(true);
+
+ closure_star_arity_1(sc, x, x_args);
+ return((closure_arity(x) == -1) ||
+ (args <= closure_arity(x)));
}
-static int c_vector_tester(s7_scheme *sc, s7_pointer expr)
+
+bool s7_is_aritable(s7_scheme *sc, s7_pointer x, int args)
{
- s7_pointer a1;
- a1 = cadr(expr);
- if (is_symbol(a1))
+ switch (type(x))
{
- s7_pointer table;
- table = s7_slot(sc, a1);
- if ((is_slot(table)) && ((is_immutable_symbol(a1)) || (!is_stepper(table))))
- {
- table = slot_value(table);
- if ((type(table) == T_VECTOR) && (vector_rank(table) == 1))
- {
- s7_pointer a2;
- s7_xf_store(sc, table);
- a2 = caddr(expr);
- if (is_symbol(a2))
- {
- s7_pointer slot;
- slot = s7_slot(sc, a2);
- if ((is_slot(slot)) &&
- (is_integer(slot_value(slot))))
- {
- s7_xf_store(sc, slot);
- return(TEST_SS);
- }
- }
- else
- {
- if (s7_arg_to_if(sc, a2))
- return(TEST_SI);
- }
- return(TEST_SQ);
- }
- }
- }
- return(TEST_NO_S);
-}
+ 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));
-static s7_pf_t vector_ref_pf(s7_scheme *sc, s7_pointer expr)
-{
- if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))))
- {
- int choice;
- choice = (c_vector_tester(sc, expr));
- if (choice == TEST_SS)
- return(vector_ref_pf_slot);
- if (choice == TEST_SI)
- return(vector_ref_pf_s);
+ 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);
+
+ case T_MACRO:
+ case T_BACRO:
+ case T_CLOSURE:
+ return(closure_is_aritable(sc, x, closure_args(x), args));
+
+ case T_MACRO_STAR:
+ case T_BACRO_STAR:
+ case T_CLOSURE_STAR:
+ 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));
+
+ case T_GOTO:
+ case T_CONTINUATION:
+ return(true);
+
+ case T_STRING:
+ return((args == 1) &&
+ (string_length(x) > 0)); /* ("" 0) -> error */
+
+ case T_C_OBJECT:
+ /* check_method(sc, x, sc->is_aritable_symbol, list_2(sc, x, s7_make_integer(sc, args))); -- see below */
+ return(is_procedure(x)); /* i.e. is_applicable */
+
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ return((args > 0) &&
+ (vector_length(x) > 0) && /* (#() 0) -> error */
+ ((unsigned int)args <= vector_rank(x)));
+
+ case T_LET:
+ /* check_method(sc, x, sc->is_aritable_symbol, list_2(sc, x, s7_make_integer(sc, args))); */
+ /* this slows us down a lot */
+ case T_HASH_TABLE:
+ case T_PAIR:
+ return(args == 1);
+
+ case T_ITERATOR:
+ return(args == 0);
+
+ case T_SYNTAX:
+ return((args >= syntax_min_args(x)) && ((args <= syntax_max_args(x)) || (syntax_max_args(x) == -1)));
}
- return(NULL);
+ return(false);
}
-static s7_pointer vector_ref_ic;
-static s7_pointer g_vector_ref_ic(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, s7_integer(cadr(args))));}
-static s7_pointer vector_ref_ic_0;
-static s7_pointer g_vector_ref_ic_0(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, 0));}
-static s7_pointer vector_ref_ic_1;
-static s7_pointer g_vector_ref_ic_1(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, 1));}
-static s7_pointer vector_ref_ic_2;
-static s7_pointer g_vector_ref_ic_2(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, 2));}
-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_gs;
-static s7_pointer g_vector_ref_gs(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_is_aritable(s7_scheme *sc, s7_pointer args)
{
- /* global vector ref: (vector-ref global_vector i) */
- s7_pointer x, vec;
- s7_int index;
+ #define H_is_aritable "(aritable? obj num-args) returns #t if 'obj can be applied to 'num-args arguments."
+ #define Q_is_aritable s7_make_signature(sc, 3, sc->is_boolean_symbol, sc->T, sc->is_integer_symbol)
- vec = find_global_symbol_checked(sc, car(args));
- x = find_symbol_checked(sc, cadr(args));
+ s7_pointer n;
+ s7_int num;
- if (!s7_is_vector(vec))
- method_or_bust(sc, vec, sc->vector_ref_symbol, list_2(sc, vec, x), T_VECTOR, 1);
- if (!s7_is_integer(x))
- method_or_bust(sc, x, sc->vector_ref_symbol, list_2(sc, vec, x), T_INTEGER, 2);
+ n = cadr(args);
+ if (!s7_is_integer(n)) /* remember gmp case! */
+ method_or_bust(sc, n, sc->is_aritable_symbol, args, T_INTEGER, 2);
- index = s7_integer(x);
- 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));
+ num = s7_integer(n);
+ if (num < 0)
+ return(out_of_range(sc, sc->is_aritable_symbol, small_int(2), n, its_negative_string));
+ if (num > MAX_ARITY) num = MAX_ARITY;
- 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));
+ return(make_boolean(sc, s7_is_aritable(sc, car(args), (int)num)));
}
-static s7_pointer vector_ref_add1;
-static s7_pointer g_vector_ref_add1(s7_scheme *sc, s7_pointer args)
+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);}
+
+
+/* -------- sequence? -------- */
+static s7_pointer g_is_sequence(s7_scheme *sc, s7_pointer args)
{
- /* (vector-ref v (+ s 1)) I think */
- s7_pointer vec, x;
- s7_int index;
+ #define H_is_sequence "(sequence? obj) returns #t if obj is a sequence (vector, string, pair, etc)"
+ #define Q_is_sequence pl_bt
+ check_boolean_method(sc, is_simple_sequence, sc->is_sequence_symbol, args);
+}
- vec = find_symbol_checked(sc, car(args));
- x = find_symbol_checked(sc, cadr(cadr(args)));
+static bool is_sequence_b(s7_pointer p) {return(is_simple_sequence(p));}
- 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));
+/* -------------------------------- symbol-access ------------------------------------------------ */
- if (vector_rank(vec) > 1)
+static unsigned int protect_accessor(s7_scheme *sc, s7_pointer acc)
+{
+ unsigned int loc;
+ if (sc->protected_accessors_size == sc->protected_accessors_loc)
{
- 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)));
+ int i, new_size, size;
+ size = sc->protected_accessors_size;
+ new_size = 2 * size;
+ vector_elements(sc->protected_accessors) = (s7_pointer *)realloc(vector_elements(sc->protected_accessors), new_size * sizeof(s7_pointer));
+ vector_length(sc->protected_accessors) = new_size;
+ for (i = size; i < new_size; i++)
+ vector_element(sc->protected_accessors, i) = sc->gc_nil;
+ sc->protected_accessors_size = new_size;
}
- return(vector_getter(vec)(sc, vec, index));
+ loc = sc->protected_accessors_loc++;
+ vector_element(sc->protected_accessors, loc) = acc;
+ return(loc);
}
+s7_pointer s7_symbol_access(s7_scheme *sc, s7_pointer sym)
+{
+ /* these refer to the rootlet */
+ if ((is_slot(global_slot(sym))) &&
+ (slot_has_accessor(global_slot(sym))))
+ return(slot_accessor(global_slot(sym)));
+ return(sc->F);
+}
-static s7_pointer vector_ref_2, constant_vector_ref_gs;
-static s7_pointer g_constant_vector_ref_gs(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_symbol_set_access(s7_scheme *sc, s7_pointer symbol, s7_pointer func)
{
- s7_pointer x, vec;
- s7_int index;
- vec = opt_vector(args);
- x = find_symbol_checked(sc, cadr(args));
- if (!s7_is_integer(x))
- return(g_vector_ref_gs(sc, args));
- index = s7_integer(x);
- 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));
- return(vector_element(vec, index));
+ if (slot_has_accessor(global_slot(symbol)))
+ {
+ unsigned int index;
+ index = symbol_global_accessor_index(symbol);
+ if (index < sc->protected_accessors_size)
+ {
+ if (is_immutable(vector_element(sc->protected_accessors, index))) /* a function */
+ return(func);
+ vector_element(sc->protected_accessors, index) = func;
+ slot_set_accessor(global_slot(symbol), func);
+ return(func);
+ }
+ }
+ if (func != sc->F)
+ {
+ slot_set_has_accessor(global_slot(symbol));
+ symbol_set_has_accessor(symbol);
+ symbol_global_accessor_index(symbol) = protect_accessor(sc, func);
+ }
+ slot_set_accessor(global_slot(symbol), func);
+ return(func);
}
-static s7_pointer g_vector_ref_2(s7_scheme *sc, s7_pointer args)
+/* (let () (define xxx 23) (define (hix) (set! xxx 24)) (hix) (set! (symbol-access 'xxx) (lambda (sym val) (format *stderr* "val: ~A~%" val) val)) (hix))
+ * so set symbol-access before use!
+ */
+
+static s7_pointer g_symbol_access(s7_scheme *sc, s7_pointer args)
{
- s7_pointer vec, ind;
- s7_int index;
+ #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)
+ s7_pointer sym, p;
- vec = car(args);
- if (!s7_is_vector(vec))
- method_or_bust(sc, vec, sc->vector_ref_symbol, args, T_VECTOR, 1); /* should be ok because we go to g_vector_ref below */
+ sym = car(args);
+ if (!is_symbol(sym))
+ method_or_bust_one_arg(sc, sym, sc->symbol_access_symbol, args, T_SYMBOL);
+ if (is_keyword(sym))
+ return(sc->F);
- if (vector_rank(vec) > 1)
- return(g_vector_ref(sc, args));
+ if (is_pair(cdr(args)))
+ {
+ s7_pointer e, old_e;
+ e = cadr(args);
+ if ((e == sc->rootlet) || (e == sc->nil))
+ p = global_slot(sym);
+ else
+ {
+ if (!is_let(e))
+ return(wrong_type_argument(sc, sc->symbol_access_symbol, 2, e, T_LET));
+ old_e = sc->envir;
+ sc->envir = e;
+ p = find_symbol(sc, sym);
+ sc->envir = old_e;
+ }
+ }
+ else p = find_symbol(sc, sym);
- ind = cadr(args);
- if (!s7_is_integer(ind))
- method_or_bust(sc, ind, sc->vector_ref_symbol, args, T_INTEGER, 2);
+ if (!is_slot(p))
+ return(sc->F);
- index = s7_integer(ind);
- if ((index < 0) || (index >= vector_length(vec)))
- return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), ind, (index < 0) ? its_negative_string : its_too_large_string));
+ if (slot_has_accessor(p))
+ return(slot_accessor(p));
- return(vector_getter(vec)(sc, vec, index));
+ return(sc->F);
}
-
-static s7_pointer g_vector_set(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_symbol_set_access(s7_scheme *sc, s7_pointer args)
{
- #define H_vector_set "(vector-set! v i ... value) sets the i-th element of vector v to value."
- #define Q_vector_set s7_make_circular_signature(sc, 3, 4, sc->T, sc->is_vector_symbol, sc->is_integer_symbol, sc->is_integer_or_any_at_end_symbol)
-
- s7_pointer vec, val;
- s7_int index;
-
- vec = car(args);
- if (!s7_is_vector(vec))
- method_or_bust(sc, vec, sc->vector_set_symbol, args, T_VECTOR, 1);
+ s7_pointer sym, func, p;
- if (vector_length(_TSet(vec)) == 0)
- return(out_of_range(sc, sc->vector_set_symbol, small_int(1), vec, its_too_large_string));
+ sym = car(args);
+ if (!is_symbol(sym)) /* no check method because no method name? */
+ return(s7_wrong_type_arg_error(sc, "set! symbol-access", 1, sym, "a symbol"));
+ if (is_keyword(sym))
+ return(s7_wrong_type_arg_error(sc, "set! symbol-access", 1, sym, "a normal symbol (a keyword can't be set)"));
- if (vector_rank(vec) > 1)
+ /* (set! (symbol-access sym) f) or (set! (symbol-access sym env) f) */
+ if (is_pair(cddr(args)))
{
- unsigned int i;
- s7_pointer x;
- index = 0;
- for (x = cdr(args), i = 0; (is_not_null(cdr(x))) && (i < vector_ndims(vec)); x = cdr(x), i++)
+ s7_pointer e, old_e;
+ e = cadr(args);
+ func = caddr(args);
+ if ((e == sc->rootlet) || (e == sc->nil))
+ p = global_slot(sym);
+ else
{
- s7_int n;
- s7_pointer p, p1;
- p = car(x);
- if (!s7_is_integer(p))
- {
- if (!s7_is_integer(p1 = check_values(sc, p, x)))
- method_or_bust(sc, p, sc->vector_set_symbol, args, T_INTEGER, i + 2);
- p = p1;
- }
- n = s7_integer(p);
- if ((n < 0) ||
- (n >= vector_dimension(vec, i)))
- return(out_of_range(sc, sc->vector_set_symbol, make_integer(sc, i + 2), p, (n < 0) ? its_negative_string : its_too_large_string));
-
- index += n * vector_offset(vec, i);
+ if (!is_let(e))
+ return(s7_wrong_type_arg_error(sc, "set! symbol-access", 2, e, "a let"));
+ old_e = sc->envir;
+ sc->envir = e;
+ p = find_symbol(sc, sym);
+ sc->envir = old_e;
}
-
- if (is_not_null(cdr(x)))
- return(s7_wrong_number_of_args_error(sc, "too many args for vector-set!: ~S", args));
- if (i != vector_ndims(vec))
- return(s7_wrong_number_of_args_error(sc, "not enough args for vector-set!: ~S", args));
-
- val = car(x);
}
else
{
- s7_pointer p, p1;
- p = cadr(args);
- if (!s7_is_integer(p))
- {
- if (!s7_is_integer(p1 = check_values(sc, p, cdr(args))))
- method_or_bust(sc, p, sc->vector_set_symbol, args, T_INTEGER, 2);
- p = p1;
- }
- index = s7_integer(p);
- if ((index < 0) ||
- (index >= vector_length(vec)))
- return(out_of_range(sc, sc->vector_set_symbol, small_int(2), p, (index < 0) ? its_negative_string : its_too_large_string));
-
- if (is_not_null(cdddr(args)))
- {
- set_car(sc->temp_cell_2, vector_getter(vec)(sc, vec, index));
- set_cdr(sc->temp_cell_2, cddr(args));
- return(g_vector_set(sc, sc->temp_cell_2));
- }
- val = caddr(args);
+ p = find_symbol(sc, sym);
+ func = cadr(args);
}
- vector_setter(vec)(sc, vec, index, val);
- return(val);
-}
-
-
-static s7_pointer vector_set_ic;
-static s7_pointer g_vector_set_ic(s7_scheme *sc, s7_pointer args)
-{
- /* (vector-set! vec 0 x) */
- s7_pointer vec, val;
- s7_int index;
-
- vec = find_symbol_checked(sc, car(args));
- if (!s7_is_vector(vec))
- method_or_bust(sc, vec, sc->vector_set_symbol, list_3(sc, vec, cadr(args), find_symbol_checked(sc, caddr(args))), T_VECTOR, 1);
- /* the list_3 happens only if we find the method */
+ if ((!is_procedure_or_macro(func)) &&
+ (func != sc->F))
+ return(s7_wrong_type_arg_error(sc, "set! symbol-access", 3, func, "a function or #f"));
- if (vector_rank(vec) > 1)
- return(g_vector_set(sc, set_plist_3(sc, vec, cadr(args), find_symbol_checked(sc, caddr(args)))));
+ if (!is_slot(p))
+ return(sc->F);
- index = s7_integer(cadr(args));
- if (index >= vector_length(vec))
- return(out_of_range(sc, sc->vector_set_symbol, small_int(2), cadr(args), its_too_large_string));
+ if (p == global_slot(sym))
+ {
+ s7_symbol_set_access(sc, sym, func); /* special GC protection for global vars */
+ return(func);
+ }
- val = find_symbol_checked(sc, caddr(args));
- vector_setter(vec)(sc, vec, index, val);
- return(val);
+ slot_set_accessor(p, func);
+ if (func != sc->F)
+ {
+ slot_set_has_accessor(p);
+ symbol_set_has_accessor(sym);
+ }
+ return(func);
}
-static s7_pointer vector_set_vref;
-static s7_pointer g_vector_set_vref(s7_scheme *sc, s7_pointer args)
+static s7_pointer bind_accessed_symbol(s7_scheme *sc, opcode_t op, s7_pointer symbol, s7_pointer new_value)
{
- /* (vector-set! vec i (vector-ref vec j)) -- checked that the vector is the same */
- s7_pointer vec, val1, val2;
- s7_int index1, index2;
+ /* this refers to (define (sym ...)) and friends -- define cases
+ * see call_accessor for the set! cases
+ */
+ s7_pointer func;
- vec = find_symbol_checked(sc, car(args));
- val1 = find_symbol_checked(sc, cadr(args));
- val2 = find_symbol_checked(sc, caddr(caddr(args)));
+ func = g_symbol_access(sc, set_plist_2(sc, symbol, sc->envir));
+ if (is_procedure_or_macro(func))
+ {
+ if (is_c_function(func))
+ {
+ s7_pointer old_value;
+ old_value = new_value;
+ set_car(sc->t2_1, symbol);
+ set_car(sc->t2_2, new_value);
+ new_value = c_function_call(func)(sc, sc->t2_1);
+ if (new_value == sc->error_symbol)
+ return(s7_error(sc, sc->error_symbol, set_elist_3(sc, make_string_wrapper(sc, "can't bind ~S to ~S"), symbol, old_value)));
+ }
+ else
+ {
+ sc->args = list_2(sc, symbol, new_value);
+ push_stack(sc, op, sc->args, sc->code);
+ sc->code = func;
+ return(sc->no_value); /* this means the accessor in set! needs to goto APPLY to get the new value */
+ }
+ }
+ return(new_value);
+}
- if ((!s7_is_vector(vec)) ||
- (vector_rank(vec) > 1) ||
- (!s7_is_integer(val1)) ||
- (!s7_is_integer(val2)))
- return(g_vector_set(sc, set_plist_3(sc, vec, val1, g_vector_ref(sc, set_plist_2(sc, vec, val2)))));
- index1 = s7_integer(val1);
- if (index1 >= vector_length(vec))
- return(out_of_range(sc, sc->vector_set_symbol, small_int(2), val1, its_too_large_string));
- index2 = s7_integer(val2);
- if (index2 >= vector_length(vec))
- return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), val2, its_too_large_string));
+/* -------------------------------- hooks -------------------------------- */
- vector_setter(vec)(sc, vec, index1, val1 = vector_getter(vec)(sc, vec, index2));
- return(val1);
+s7_pointer s7_hook_functions(s7_scheme *sc, s7_pointer hook)
+{
+ return(s7_symbol_local_value(sc, sc->body_symbol, closure_let(hook)));
}
-static s7_pointer vector_set_vector_ref;
-static s7_pointer g_vector_set_vector_ref(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_hook_set_functions(s7_scheme *sc, s7_pointer hook, s7_pointer functions)
{
- /* (vector-set! data i|j (+|- (vector-ref data i) tc)) */
- s7_pointer vec, val, val2, tc, arg3;
- s7_int index1, index2;
+ if (s7_is_list(sc, functions))
+ s7_let_set(sc, closure_let(hook), sc->body_symbol, functions);
+ return(functions);
+}
- vec = find_symbol_checked(sc, car(args));
- val = find_symbol_checked(sc, cadr(args));
- arg3 = caddr(args);
- tc = find_symbol_checked(sc, caddr(arg3));
- val2 = caddr(cadr(arg3));
- if ((!s7_is_vector(vec)) ||
- (vector_rank(vec) > 1) ||
- (!s7_is_integer(val)))
- return(g_vector_set(sc, set_plist_3(sc, vec, val, c_call(arg3)(sc, list_2(sc, g_vector_ref(sc, set_plist_2(sc, vec, find_symbol_checked(sc, val2))), tc)))));
+/* -------------------------------- eq etc -------------------------------- */
- index1 = s7_integer(val);
- if (index1 >= vector_length(vec))
- return(out_of_range(sc, sc->vector_set_symbol, small_int(2), val, its_too_large_string));
+bool s7_is_eq(s7_pointer obj1, s7_pointer obj2)
+{
+ return(obj1 == obj2); /* so floats and NaNs might be eq? but not eqv? */
+}
- if (val2 != cadr(args))
- {
- val2 = find_symbol_checked(sc, val2);
- if (!s7_is_integer(val2))
- {
- s7_pointer p;
- if (!s7_is_integer(p = check_values(sc, val2, list_1(sc, val2))))
- return(wrong_type_argument(sc, sc->vector_ref_symbol, 2, val2, T_INTEGER));
- else val2 = p;
- }
- index2 = s7_integer(val2);
- if (index2 >= vector_length(vec))
- return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), val, its_too_large_string));
- }
- else index2 = index1;
- set_car(sc->z2_1, vector_getter(vec)(sc, vec, index2));
- set_car(sc->z2_2, tc);
- vector_setter(vec)(sc, vec, index1, tc = c_call(arg3)(sc, sc->z2_1));
- return(tc);
+static s7_pointer g_is_eq(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_eq "(eq? obj1 obj2) returns #t if obj1 is eq to (the same object as) obj2"
+ #define Q_is_eq pcl_bt
+ return(make_boolean(sc, ((car(args) == cadr(args)) ||
+ ((is_unspecified(car(args))) && (is_unspecified(cadr(args)))))));
+ /* (eq? (apply apply apply values '(())) #<unspecified>) should return #t
+ */
}
-static s7_pointer c_vector_set_3(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer val)
+
+bool s7_is_eqv(s7_pointer a, s7_pointer b)
{
- /* (vector-set! vec ind val) where are all predigested */
+#if WITH_GMP
+ if ((is_big_number(a)) || (is_big_number(b)))
+ return(big_numbers_are_eqv(a, b));
+#endif
- if (!s7_is_vector(vec))
- method_or_bust(sc, vec, sc->vector_set_symbol, list_3(sc, vec, make_integer(sc, index), val), T_VECTOR, 1);
+ if (type(a) != type(b))
+ return(false);
- if (vector_rank(vec) > 1)
- return(g_vector_set(sc, list_3(sc, vec, make_integer(sc, index), val)));
+ if ((a == b) && (!is_number(a)))
+ return(true);
- if ((index < 0) ||
- (index >= vector_length(vec)))
- return(out_of_range(sc, sc->vector_set_symbol, small_int(2), make_integer(sc, index), (index < 0) ? its_negative_string : its_too_large_string));
+ if (is_string(a))
+ return(string_value(a) == string_value(b));
- vector_setter(vec)(sc, vec, index, val);
- return(val);
-}
+ if (s7_is_number(a))
+ return(numbers_are_eqv(a, b));
-static s7_pointer c_vector_set_s(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer val)
-{
- /* (vector-set! vec ind val) where are all predigested, vector is prechecked */
- if ((index < 0) ||
- (index >= vector_length(vec)))
- return(out_of_range(sc, sc->vector_set_symbol, small_int(2), make_integer(sc, index), (index < 0) ? its_negative_string : its_too_large_string));
+ if (is_unspecified(a)) /* types are the same so we know b is also unspecified */
+ return(true);
- vector_elements(vec)[index] = val;
- return(val);
+ return(false);
}
-static s7_pointer vector_set_3;
-static s7_pointer g_vector_set_3(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer g_is_eqv(s7_scheme *sc, s7_pointer args)
{
- s7_pointer ind;
- ind = cadr(args);
- if (!s7_is_integer(ind))
- {
- s7_pointer p;
- if (!s7_is_integer(p = check_values(sc, ind, cdr(args))))
- return(wrong_type_argument(sc, sc->vector_set_symbol, 2, ind, T_INTEGER));
- else ind = p;
- }
- return(c_vector_set_3(sc, car(args), s7_integer(ind), caddr(args)));
+ #define H_is_eqv "(eqv? obj1 obj2) returns #t if obj1 is equivalent to obj2"
+ #define Q_is_eqv pcl_bt
+ return(make_boolean(sc, s7_is_eqv(car(args), cadr(args))));
}
-PIPF_TO_PF(vector_set, c_vector_set_s, c_vector_set_3, c_vector_tester)
-static s7_pointer g_make_vector_1(s7_scheme *sc, s7_pointer args, s7_pointer err_sym)
+static bool floats_are_morally_equal(s7_scheme *sc, s7_double x, s7_double y)
{
- s7_int len;
- s7_pointer x, fill, vec;
- int result_type = T_VECTOR;
-
- fill = sc->unspecified;
- x = car(args);
- if (s7_is_integer(x))
- {
- len = s7_integer(x);
- if (len < 0)
- return(wrong_type_argument_with_type(sc, err_sym, 1, x, a_non_negative_integer_string));
- }
- else
- {
- if (!(is_pair(x)))
- method_or_bust_with_type(sc, x, err_sym, args, make_string_wrapper(sc, "an integer or a list of integers"), 1);
+ if (x == y) return(true);
- if (!s7_is_integer(car(x)))
- return(wrong_type_argument_with_type(sc, err_sym, 1, car(x),
- make_string_wrapper(sc, "each dimension should be an integer")));
- if (is_null(cdr(x)))
- len = s7_integer(car(x));
- else
- {
- int dims;
- s7_pointer y;
+ if ((is_NaN(x)) || (is_NaN(y)))
+ return((is_NaN(x)) && (is_NaN(y)));
- dims = s7_list_length(sc, x);
- if (dims <= 0) /* 0 if circular, negative if dotted */
- return(wrong_type_argument_with_type(sc, err_sym, 1, x, a_proper_list_string));
- if (dims > sc->max_vector_dimensions)
- return(out_of_range(sc, err_sym, small_int(1), x, its_too_large_string));
+ return(fabs(x - y) <= sc->morally_equal_float_epsilon);
+}
- for (len = 1, y = x; is_not_null(y); y = cdr(y))
- {
- if (!s7_is_integer(car(y)))
- return(wrong_type_argument(sc, err_sym, position_of(y, x), car(y), T_INTEGER));
- len *= s7_integer(car(y));
- if (len < 0)
- return(wrong_type_argument_with_type(sc, err_sym, position_of(y, x), car(y), a_non_negative_integer_string));
- }
- }
- }
+static bool eq_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ return(x == y);
+}
- if (is_not_null(cdr(args)))
- {
- fill = cadr(args);
- if (is_not_null(cddr(args)))
- {
- if (caddr(args) == sc->T)
- {
- /* here bignums can cause confusion, so use is_integer not s7_is_integer etc */
- if (is_integer(fill))
- result_type = T_INT_VECTOR;
- else
- {
- if (s7_is_real(fill)) /* might be gmp with big_real by accident (? see above) */
- result_type = T_FLOAT_VECTOR;
- else method_or_bust_with_type(sc, fill, err_sym, args, make_string_wrapper(sc, "an integer or a real since 'homogeneous' is #t"), 2);
- }
- }
- else
- {
- if (caddr(args) != sc->F)
- method_or_bust_with_type(sc, caddr(args), err_sym, args, a_boolean_string, 3);
- }
- }
- }
+static bool symbol_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ 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))) &&
+ (is_syntax(slot_value(global_slot(y)))) &&
+ (syntax_symbol(slot_value(global_slot(x))) == syntax_symbol(slot_value(global_slot(y)))));
+}
- vec = make_vector_1(sc, len, NOT_FILLED, result_type);
- if (len > 0) s7_vector_fill(sc, vec, fill);
+static bool unspecified_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ return(is_unspecified(y));
+}
- if ((is_pair(x)) &&
- (is_pair(cdr(x))))
- {
- int i;
- s7_int offset = 1;
- s7_pointer y;
- vdims_t *v;
+static bool c_pointer_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ return((s7_is_c_pointer(y)) && (raw_pointer(x) == raw_pointer(y)));
+}
- v = (vdims_t *)malloc(sizeof(vdims_t));
- v->ndims = safe_list_length(sc, x);
- v->dims = (s7_int *)malloc(v->ndims * sizeof(s7_int));
- v->offsets = (s7_int *)malloc(v->ndims * sizeof(s7_int));
- v->original = sc->F;
- v->dimensions_allocated = true;
- v->elements_allocated = (len > 0);
+static bool string_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ return((is_string(y)) && (scheme_strings_are_equal(x, y)));
+}
- for (i = 0, y = x; is_not_null(y); i++, y = cdr(y))
- v->dims[i] = s7_integer(car(y));
+static bool syntax_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ return((is_syntax(y)) && (syntax_symbol(x) == syntax_symbol(y)));
+}
- for (i = v->ndims - 1; i >= 0; i--)
- {
- v->offsets[i] = offset;
- offset *= v->dims[i];
- }
- vector_dimension_info(vec) = v;
- }
- return(vec);
+static bool c_object_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ return((is_c_object(y)) && (objects_are_equal(sc, x, y)));
}
-static s7_pointer g_make_vector(s7_scheme *sc, s7_pointer args)
+static bool port_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
{
- #define H_make_vector "(make-vector len (value #<unspecified>)) returns a vector of len elements initialized to value. \
-To create a multidimensional vector, put the dimension bounds in a list (this is to avoid ambiguities such as \
-(make-vector 1 2) where it's not clear whether the '2' is an initial value or a dimension size). (make-vector '(2 3) 1.0) \
-returns a 2 dimensional vector of 6 total elements, all initialized to 1.0."
- #define Q_make_vector s7_make_signature(sc, 3, sc->is_vector_symbol, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_pair_symbol), sc->T)
- return(g_make_vector_1(sc, args, sc->make_vector_symbol));
+ if (x == y) return(true);
+ if ((!morally) || (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)) &&
+ (port_data_size(x) == port_data_size(y)) &&
+ (local_strncmp((const char *)port_data(x), (const char *)port_data(y), (is_input_port(x)) ? port_data_size(x) : port_position(x))));
}
+#define equal_ref(Sc, X, Y, Ci) \
+ do { \
+ /* here we know x and y are pointers to the same type of structure */ \
+ int ref_x, ref_y; \
+ ref_x = (is_collected(X)) ? peek_shared_ref(Ci, X) : 0; \
+ 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); \
+ else \
+ { \
+ if (ref_y != 0) \
+ add_shared_ref(Ci, X, ref_y); \
+ else \
+ { \
+ /* 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); \
+ set_collected(X); \
+ set_collected(Y); \
+ Ci->objs[Ci->top] = X; \
+ Ci->ref++; \
+ Ci->refs[Ci->top++] = Ci->ref; \
+ Ci->objs[Ci->top] = Y; \
+ Ci->refs[Ci->top++] = Ci->ref; \
+ } \
+ } \
+ } while (0)
-IF_TO_PF(make_vector, s7_make_vector)
+static bool s7_is_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally);
-static s7_pointer g_make_float_vector(s7_scheme *sc, s7_pointer args)
+static bool hash_table_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
{
- #define H_make_float_vector "(make-float-vector len (init 0.0)) returns a float-vector."
- #define Q_make_float_vector s7_make_signature(sc, 3, sc->is_float_vector_symbol, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_pair_symbol), sc->is_real_symbol)
- s7_int len;
- s7_pointer x, p;
- s7_double *arr;
+ hash_entry_t **lists;
+ int i, len;
+ shared_info *nci = ci;
- p = car(args);
- if ((is_pair(cdr(args))) ||
- (!is_integer(p)))
+ if (x == y)
+ return(true);
+ if (!is_hash_table(y))
{
- s7_pointer init;
- if (is_pair(cdr(args)))
+ if ((morally) && (has_methods(y)))
{
- init = cadr(args);
- if (!s7_is_real(init))
- method_or_bust(sc, init, sc->make_float_vector_symbol, args, T_REAL, 2);
-#if WITH_GMP
- if (s7_is_bignum(init))
- return(g_make_vector_1(sc, set_plist_3(sc, p, make_real(sc, real_to_double(sc, init, "make-float-vector")), sc->T), sc->make_float_vector_symbol));
-#endif
- if (is_rational(init))
- return(g_make_vector_1(sc, set_plist_3(sc, p, make_real(sc, rational_to_double(sc, init)), sc->T), sc->make_float_vector_symbol));
+ s7_pointer equal_func;
+ 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))));
}
- else init = real_zero;
- return(g_make_vector_1(sc, set_plist_3(sc, p, init, sc->T), sc->make_float_vector_symbol));
+ return(false);
}
+ if (ci)
+ equal_ref(sc, x, y, ci);
- len = s7_integer(p);
- if (len < 0)
- return(wrong_type_argument_with_type(sc, sc->make_float_vector_symbol, 1, p, a_non_negative_integer_string));
- if (len > sc->max_vector_length)
- return(out_of_range(sc, sc->make_float_vector_symbol, small_int(1), p, its_too_large_string));
-
- if (len > 0)
- arr = (s7_double *)calloc(len, sizeof(s7_double));
- else arr = NULL;
-
- new_cell(sc, x, T_FLOAT_VECTOR | T_SAFE_PROCEDURE);
- vector_length(x) = len;
- float_vector_elements(x) = arr;
- vector_dimension_info(x) = NULL;
- vector_getter(x) = float_vector_getter;
- vector_setter(x) = float_vector_setter;
-
- add_vector(sc, x);
- return(x);
-}
-
-static s7_pointer c_make_float_vector(s7_scheme *sc, s7_int len) {return(s7_make_float_vector(sc, len, 1, NULL));}
-IF_TO_PF(make_float_vector, c_make_float_vector)
-
-
-static s7_pointer g_make_int_vector(s7_scheme *sc, s7_pointer args)
-{
- #define H_make_int_vector "(make-int-vector len (init 0.0)) returns an int-vector."
- #define Q_make_int_vector s7_make_signature(sc, 3, sc->is_int_vector_symbol, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_pair_symbol), sc->is_integer_symbol)
-
- s7_int len;
- s7_pointer x, p;
- s7_int *arr;
-
- p = car(args);
- if ((is_pair(cdr(args))) ||
- (!is_integer(p)))
+ if (hash_table_entries(x) != hash_table_entries(y))
+ return(false);
+ if (hash_table_entries(x) == 0)
+ return(true);
+ if ((!morally) &&
+ ((hash_table_checker_locked(x)) || (hash_table_checker_locked(y))))
{
- s7_pointer init;
- if (is_pair(cdr(args)))
- {
- init = cadr(args);
- if (!is_integer(init))
- method_or_bust(sc, init, sc->make_int_vector_symbol, args, T_INTEGER, 2);
- }
- else init = small_int(0);
- return(g_make_vector_1(sc, set_plist_3(sc, p, init, sc->T), sc->make_int_vector_symbol));
+ if (hash_table_checker(x) != hash_table_checker(y))
+ return(false);
+ if (hash_table_mapper(x) != hash_table_mapper(y))
+ return(false);
}
- len = s7_integer(p);
- if (len < 0)
- return(wrong_type_argument_with_type(sc, sc->make_int_vector_symbol, 1, p, a_non_negative_integer_string));
- if (len > sc->max_vector_length)
- return(out_of_range(sc, sc->make_int_vector_symbol, small_int(1), p, its_too_large_string));
-
- if (len > 0)
- arr = (s7_int *)calloc(len, sizeof(s7_int));
- else arr = NULL;
-
- new_cell(sc, x, T_INT_VECTOR | T_SAFE_PROCEDURE);
- vector_length(x) = len;
- int_vector_elements(x) = arr;
- vector_dimension_info(x) = NULL;
- vector_getter(x) = int_vector_getter;
- vector_setter(x) = int_vector_setter;
-
- add_vector(sc, x);
- return(x);
-}
-
-static s7_pointer c_make_int_vector(s7_scheme *sc, s7_int len) {return(s7_make_int_vector(sc, len, 1, NULL));}
-IF_TO_PF(make_int_vector, c_make_int_vector)
+ 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);
-static s7_pointer g_is_vector(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_vector "(vector? obj) returns #t if obj is a vector"
- #define Q_is_vector pl_bt
- check_boolean_method(sc, s7_is_vector, sc->is_vector_symbol, args);
+ if ((!y_val) ||
+ (!s7_is_equal_1(sc, p->value, y_val->value, nci, morally)))
+ return(false);
+ }
+ }
+ /* if we get here, every key/value in x has a corresponding key/value in y, and the number of entries match,
+ * so surely the tables are equal??
+ */
+ return(true);
}
-int s7_vector_rank(s7_pointer vect)
+static bool slots_match(s7_scheme *sc, s7_pointer px, s7_pointer y, bool morally, shared_info *nci)
{
- return(vector_rank(vect));
+ 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(false);
}
-
-static s7_pointer g_vector_dimensions(s7_scheme *sc, s7_pointer args)
+static bool let_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
{
- #define H_vector_dimensions "(vector-dimensions vect) returns a list of vect's dimensions. In srfi-63 terms:\n\
- (define array-dimensions vector-dimensions)\n\
- (define (array-rank v) (length (vector-dimensions v)))"
- #define Q_vector_dimensions s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_vector_symbol)
+ /* 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 x;
- x = car(args);
- if (!s7_is_vector(x))
- method_or_bust(sc, x, sc->vector_dimensions_symbol, args, T_VECTOR, 0);
+ s7_pointer ex, ey, px, py;
+ shared_info *nci = ci;
+ int x_len, y_len;
- if (vector_rank(x) > 1)
+ if (x == y)
+ return(true);
+
+ if (morally)
{
- int i;
- sc->w = sc->nil;
- for (i = vector_ndims(x) - 1; i >= 0; i--)
- sc->w = cons(sc, make_integer(sc, vector_dimension(x, i)), sc->w);
- x = sc->w;
- sc->w = sc->nil;
- return(x);
+ 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))));
+ }
}
- return(list_1(sc, make_integer(sc, vector_length(x))));
-}
+ if (!is_let(y))
+ return(false);
+ if ((x == sc->rootlet) || (y == sc->rootlet))
+ return(false);
-static s7_pointer c_vector_dimensions(s7_scheme *sc, s7_pointer x) {return(g_vector_dimensions(sc, set_plist_1(sc, x)));}
-PF_TO_PF(vector_dimensions, c_vector_dimensions)
+ if (ci)
+ equal_ref(sc, x, y, ci);
+ clear_symbol_list(sc);
+ for (x_len = 0, ex = x; (is_let(ex)) && (ex != sc->rootlet); ex = outlet(ex))
+ for (px = let_slots(ex); is_slot(px); px = next_slot(px))
+ if (!symbol_is_in_list(sc, slot_symbol(px)))
+ {
+ add_symbol_to_list(sc, slot_symbol(px));
+ x_len++;
+ }
-#define MULTIVECTOR_TOO_MANY_ELEMENTS -1
-#define MULTIVECTOR_NOT_ENOUGH_ELEMENTS -2
+ 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 (!symbol_is_in_list(sc, slot_symbol(py))) /* symbol in y, not in x */
+ return(false);
-static int traverse_vector_data(s7_scheme *sc, s7_pointer vec, int flat_ref, int dimension, int dimensions, int *sizes, s7_pointer lst)
-{
- /* we're filling vec, we're currently looking for element (flat-wise) flat_ref,
- * we're at ref in dimension of dimensions, where sizes gives the bounds, and lst is our data
- * #3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12)))
- */
- int i;
- s7_pointer x;
+ for (y_len = 0, ey = y; (is_let(ey)) && (ey != sc->rootlet); ey = outlet(ey))
+ for (py = let_slots(ey); is_slot(py); py = next_slot(py))
+ if (symbol_tag(slot_symbol(py)) != 0)
+ {
+ y_len ++;
+ symbol_set_tag(slot_symbol(py), 0);
+ }
+
+ if (x_len != y_len) /* symbol in x, not in y */
+ return(false);
- for (i = 0, x = lst; i < sizes[dimension]; i++, x = cdr(x))
- {
- if (!is_pair(x))
- return(MULTIVECTOR_NOT_ENOUGH_ELEMENTS);
+ if (!nci) nci = new_shared_info(sc);
- if (dimension == (dimensions - 1))
- vector_setter(vec)(sc, vec, flat_ref++, car(x));
- else
+ for (ex = x; (is_let(ex)) && (ex != sc->rootlet); ex = outlet(ex))
+ for (px = let_slots(ex); is_slot(px); px = next_slot(px))
+ if (symbol_tag(slot_symbol(px)) == 0) /* unshadowed */
{
- flat_ref = traverse_vector_data(sc, vec, flat_ref, dimension + 1, dimensions, sizes, car(x));
- if (flat_ref < 0) return(flat_ref);
+ symbol_set_tag(slot_symbol(px), sc->syms_tag); /* values don't match */
+ if (!slots_match(sc, px, y, morally, nci))
+ return(false);
}
- }
- if (is_not_null(x))
- return(MULTIVECTOR_TOO_MANY_ELEMENTS);
- return(flat_ref);
+ return(true);
}
-
-static s7_pointer s7_multivector_error(s7_scheme *sc, const char *message, s7_pointer data)
+static bool closure_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
{
- return(s7_error(sc, sc->read_error_symbol,
- set_elist_3(sc, make_string_wrapper(sc, "reading constant vector, ~A: ~A"), make_string_wrapper(sc, message), data)));
+ 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), (morally) ? sc->is_morally_equal_symbol : sc->is_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)));
}
-
-static s7_pointer g_multivector(s7_scheme *sc, s7_int dims, s7_pointer data)
+static bool pair_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
{
- /* get the dimension bounds from data, make the new vector, fill it from data
- *
- * dims needs to be s7_int so we can at least give correct error messages.
- * also should we let an empty vector have any number of dimensions? currently ndims is an int.
- */
- s7_pointer vec, x;
- int i, err;
- unsigned int vec_loc;
- int *sizes;
-
- /* (#2d((1 2 3) (4 5 6)) 0 0) -> 1
- * (#2d((1 2 3) (4 5 6)) 0 1) -> 2
- * (#2d((1 2 3) (4 5 6)) 1 1) -> 5
- * (#3D(((1 2) (3 4)) ((5 6) (7 8))) 0 0 0) -> 1
- * (#3D(((1 2) (3 4)) ((5 6) (7 8))) 1 1 0) -> 7
- * #3D(((1 2) (3 4)) ((5 6) (7))) -> error, #3D(((1 2) (3 4)) ((5 6) (7 8 9))), #3D(((1 2) (3 4)) (5 (7 8 9))) etc
- *
- * but a special case: #nD() is an n-dimensional empty vector
- */
-
- if (dims <= 0) /* #0d(...) #2147483649D() [if dims is int this is negative] */
- return(s7_out_of_range_error(sc, "#nD(...) dimensions", 1, make_integer(sc, dims), "must be 1 or more"));
- if (dims > sc->max_vector_dimensions)
- return(s7_out_of_range_error(sc, "#nD(...) dimensions", 1, make_integer(sc, dims), "must be < 512")); /* sc->max_vector_dimensions=512 currently */
-
- sc->w = sc->nil;
- 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)))));
+ s7_pointer px, py;
+ shared_info *nci = ci;
- sizes = (int *)calloc(dims, sizeof(int));
- for (x = data, i = 0; i < dims; i++)
+ if (x == y)
+ return(true);
+ if (!is_pair(y))
{
- sizes[i] = safe_list_length(sc, x);
- sc->w = cons(sc, make_integer(sc, sizes[i]), sc->w);
- x = car(x);
- if ((i < (dims - 1)) &&
- (!is_pair(x)))
+ if ((morally) && (has_methods(y)))
{
- free(sizes);
- return(s7_multivector_error(sc, "we need a list that fully specifies the vector's elements", data));
+ s7_pointer equal_func;
+ 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(false);
}
+ if (ci)
+ equal_ref(sc, x, y, ci);
+ else nci = new_shared_info(sc);
- vec = g_make_vector(sc, set_plist_1(sc, sc->w = safe_reverse_in_place(sc, sc->w)));
- vec_loc = s7_gc_protect(sc, vec);
- sc->w = sc->nil;
+ if (!s7_is_equal_1(sc, car(x), car(y), nci, morally)) 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);
+ equal_ref(sc, px, py, nci);
+ }
+ return(s7_is_equal_1(sc, px, py, nci, morally));
+}
- /* now fill the vector checking that all the lists match */
- err = traverse_vector_data(sc, vec, 0, 0, dims, sizes, data);
+static bool vector_rank_match(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ int x_dims, y_dims;
- free(sizes);
- s7_gc_unprotect_at(sc, vec_loc);
- if (err < 0)
- return(s7_multivector_error(sc, (err == MULTIVECTOR_TOO_MANY_ELEMENTS) ? "found too many elements" : "not enough elements found", data));
+ if (vector_has_dimensional_info(x))
+ x_dims = vector_ndims(x);
+ else x_dims = 1;
+ if (vector_has_dimensional_info(y))
+ y_dims = vector_ndims(y);
+ else y_dims = 1;
- return(vec);
+ if (x_dims != y_dims)
+ return(false);
+
+ if (x_dims > 1)
+ {
+ int j;
+ for (j = 0; j < x_dims; j++)
+ if (vector_dimension(x, j) != vector_dimension(y, j))
+ return(false);
+ }
+ return(true);
}
-s7_pointer s7_vector_copy(s7_scheme *sc, s7_pointer old_vect)
+static bool vector_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
{
- s7_int len;
- s7_pointer new_vect;
+ s7_int i, len;
+ shared_info *nci = ci;
- len = vector_length(old_vect);
- if (is_float_vector(old_vect))
+ if (x == y)
+ return(true);
+ if (!s7_is_vector(y))
{
- if (vector_rank(old_vect) > 1)
- new_vect = g_make_vector_1(sc, set_plist_3(sc, g_vector_dimensions(sc, set_plist_1(sc, old_vect)), real_zero, sc->T), sc->make_float_vector_symbol);
- else new_vect = make_vector_1(sc, len, NOT_FILLED, T_FLOAT_VECTOR);
- if (len > 0)
- memcpy((void *)(float_vector_elements(new_vect)), (void *)(float_vector_elements(old_vect)), len * sizeof(s7_double));
+ if ((morally) && (has_methods(y)))
+ {
+ s7_pointer equal_func;
+ 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(false);
}
- else
+ len = vector_length(x);
+ if (len != vector_length(y)) return(false);
+ if (len == 0)
{
- if (is_int_vector(old_vect))
+ if (morally) return(true);
+ if (!vector_rank_match(sc, x, y))
+ return(false);
+ 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 */
+ return(false);
+ return(true);
+ }
+
+ if (is_float_vector(x))
+ {
+ if (!morally)
{
- if (vector_rank(old_vect) > 1)
- new_vect = g_make_vector_1(sc, set_plist_3(sc, g_vector_dimensions(sc, set_plist_1(sc, old_vect)), small_int(0), sc->T), sc->make_int_vector_symbol);
- else new_vect = make_vector_1(sc, len, NOT_FILLED, T_INT_VECTOR);
- if (len > 0)
- memcpy((void *)(int_vector_elements(new_vect)), (void *)(int_vector_elements(old_vect)), len * sizeof(s7_int));
+ 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);
}
else
{
- if (vector_rank(old_vect) > 1)
- new_vect = g_make_vector(sc, set_plist_1(sc, g_vector_dimensions(sc, list_1(sc, old_vect))));
- else new_vect = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
-
- /* here and in vector-fill! we have a problem with bignums -- should new bignums be allocated? (copy_list also) */
- if (len > 0)
- memcpy((void *)(vector_elements(new_vect)), (void *)(vector_elements(old_vect)), len * sizeof(s7_pointer));
+ 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++)
+ {
+ 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(new_vect);
-}
+ 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);
+ }
-static s7_pointer univect_ref(s7_scheme *sc, s7_pointer args, bool flt)
-{
- s7_pointer v, caller;
- s7_int ind;
- int typ;
+ if (ci)
+ equal_ref(sc, x, y, ci);
+ else nci = new_shared_info(sc);
- caller = (flt) ? sc->float_vector_ref_symbol : sc->int_vector_ref_symbol;
- typ = (flt) ? T_FLOAT_VECTOR : T_INT_VECTOR;
+ for (i = 0; i < len; i++)
+ if (!(s7_is_equal_1(sc, vector_element(x, i), vector_element(y, i), nci, morally)))
+ return(false);
+ return(true);
+}
- v = car(args);
- if (type(v) != typ)
- method_or_bust(sc, v, caller, args, typ, 1);
+static bool iterator_equal(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);
- if (vector_rank(v) == 1)
+ switch (type(iterator_sequence(x)))
{
- s7_pointer index;
- index = cadr(args);
- if (!s7_is_integer(index))
- {
- s7_pointer p;
- if (!s7_is_integer(p = check_values(sc, index, cdr(args))))
- return(wrong_type_argument(sc, caller, 2, index, T_INTEGER));
- else index = p;
- }
- ind = s7_integer(index);
- if ((ind < 0) || (ind >= vector_length(v)))
- return(simple_out_of_range(sc, caller, index, (ind < 0) ? its_negative_string : its_too_large_string));
- if (!is_null(cddr(args)))
- return(out_of_range(sc, caller, small_int(2), cdr(args), too_many_indices_string));
+ 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)));
+
+ 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)));
+
+ case T_PAIR:
+ return((iterator_sequence(x) == iterator_sequence(y)) &&
+ (iterator_next(x) == iterator_next(y)) && /* even if seqs are equal, one might be at end */
+ (iterator_current(x) == iterator_current(y))); /* current pointer into the sequence */
+
+ case T_HASH_TABLE:
+ return((iterator_sequence(x) == iterator_sequence(y)) &&
+ (iterator_next(x) == iterator_next(y)) &&
+ (iterator_current(x) == iterator_current(y)) &&
+ (iterator_hash_current(x) == iterator_hash_current(y)) &&
+ (iterator_position(x) == iterator_position(y)));
+
+ default:
+ break;
}
- else
- {
- unsigned int i;
- s7_pointer x;
- ind = 0;
- for (x = cdr(args), i = 0; (is_not_null(x)) && (i < vector_ndims(v)); x = cdr(x), i++)
- {
- s7_int n;
- if (!s7_is_integer(car(x)))
- {
- s7_pointer p;
- if (!s7_is_integer(p = check_values(sc, car(x), x)))
- return(wrong_type_argument(sc, caller, i + 2, car(x), T_INTEGER));
- n = s7_integer(p);
- }
- else n = s7_integer(car(x));
- if ((n < 0) ||
- (n >= vector_dimension(v, i)))
- return(out_of_range(sc, caller, make_integer(sc, i + 2), car(x), (n < 0) ? its_negative_string : its_too_large_string));
+ return(false);
+}
- ind += n * vector_offset(v, i);
- }
- if (is_not_null(x))
- return(out_of_range(sc, caller, small_int(2), cdr(args), too_many_indices_string));
+static bool bignum_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ 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
+}
- /* if not enough indices, return a shared vector covering whatever is left */
- if (i < vector_ndims(v))
- return(make_shared_vector(sc, v, i, ind));
+static bool integer_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+#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);
}
- if (flt)
- return(make_real(sc, float_vector_element(v, ind)));
- return(make_integer(sc, int_vector_element(v, ind)));
+#endif
+ if (is_integer(y))
+ return(integer(x) == integer(y));
+ if ((!morally) || (!is_number(y)))
+ return(false);
+
+ if (is_t_real(y))
+ return((!is_NaN(real(y))) &&
+ (fabs(integer(x) - real(y)) <= sc->morally_equal_float_epsilon));
+
+ if (is_t_ratio(y))
+ return(s7_fabsl(integer(x) - fraction(y)) <= sc->morally_equal_float_epsilon);
+
+ return((!is_NaN(real_part(y))) &&
+ (!is_NaN(imag_part(y))) &&
+ (fabs(integer(x) - real_part(y)) <= sc->morally_equal_float_epsilon) &&
+ (fabs(imag_part(y)) <= sc->morally_equal_float_epsilon));
}
+/* 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)
+{
+#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);
+ }
+#endif
+ if (!morally)
+ return((s7_is_ratio(y)) &&
+ (numerator(x) == numerator(y)) &&
+ (denominator(x) == denominator(y)));
+
+ if (is_t_ratio(y))
+ return(s7_fabsl(fraction(x) - fraction(y)) <= sc->morally_equal_float_epsilon);
-static s7_pointer univect_set(s7_scheme *sc, s7_pointer args, bool flt)
+ if (is_t_real(y))
+ return(floats_are_morally_equal(sc, fraction(x), real(y)));
+
+ if (is_integer(y))
+ return(s7_fabsl(fraction(x) - integer(y)) <= sc->morally_equal_float_epsilon);
+
+ if (is_t_complex(y))
+ return((!is_NaN(real_part(y))) &&
+ (!is_NaN(imag_part(y))) &&
+ (s7_fabsl(fraction(x) - real_part(y)) <= sc->morally_equal_float_epsilon) &&
+ (fabs(imag_part(y)) <= sc->morally_equal_float_epsilon));
+ return(false);
+}
+
+static bool real_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
{
- s7_pointer vec, val, caller;
- s7_int index;
- int typ;
+#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);
+ }
+#endif
+ if (!morally)
+ return((is_t_real(y)) &&
+ (real(x) == real(y)));
+ if (!is_number(y)) return(false);
- caller = (flt) ? sc->float_vector_set_symbol : sc->int_vector_set_symbol;
- typ = (flt) ? T_FLOAT_VECTOR : T_INT_VECTOR;
+ if (is_t_real(y))
+ return(floats_are_morally_equal(sc, real(x), real(y)));
- vec = car(args);
- if (type(vec) != typ)
- method_or_bust(sc, vec, caller, args, typ, 1);
+ if (is_integer(y))
+ return((!is_NaN(real(x))) &&
+ (fabs(real(x) - integer(y)) <= sc->morally_equal_float_epsilon));
- if (vector_rank(vec) > 1)
- {
- unsigned int i;
- s7_pointer x;
- index = 0;
- for (x = cdr(args), i = 0; (is_not_null(cdr(x))) && (i < vector_ndims(vec)); x = cdr(x), i++)
- {
- s7_int n;
- if (!s7_is_integer(car(x)))
- {
- s7_pointer p;
- if (!s7_is_integer(p = check_values(sc, car(x), x)))
- method_or_bust(sc, car(x), caller, args, T_INTEGER, i + 2);
- n = s7_integer(p);
- }
- else n = s7_integer(car(x));
- if ((n < 0) ||
- (n >= vector_dimension(vec, i)))
- return(out_of_range(sc, caller, make_integer(sc, i + 2), car(x), (n < 0) ? its_negative_string : its_too_large_string));
+ if (is_t_ratio(y))
+ return(floats_are_morally_equal(sc, real(x), fraction(y)));
- index += n * vector_offset(vec, i);
- }
+ if (is_NaN(real(x)))
+ return((is_NaN(real_part(y))) &&
+ (fabs(imag_part(y)) <= sc->morally_equal_float_epsilon));
- if (is_not_null(cdr(x)))
- return(s7_wrong_number_of_args_error(sc, "too many args: ~S", args));
- if (i != vector_ndims(vec))
- return(s7_wrong_number_of_args_error(sc, "not enough args: ~S", args));
+ return((!is_NaN(real(x))) &&
+ (!is_NaN(real_part(y))) &&
+ (!is_NaN(imag_part(y))) &&
+ ((real(x) == real_part(y)) ||
+ (fabs(real(x) - real_part(y)) <= sc->morally_equal_float_epsilon)) &&
+ (fabs(imag_part(y)) <= sc->morally_equal_float_epsilon));
+}
- val = car(x);
- }
- else
+static bool complex_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+#if WITH_GMP
+ if (is_big_number(y))
{
- if (!s7_is_integer(cadr(args)))
- {
- 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);
- }
- else index = s7_integer(cadr(args));
- 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));
-
- if (is_not_null(cdddr(args)))
- return(s7_wrong_number_of_args_error(sc, "too many args: ~S", args));
- val = caddr(args);
+ if (!morally)
+ return(big_numbers_are_eqv(x, 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 (flt)
- {
- if (!s7_is_real(val))
- method_or_bust(sc, val, caller, args, T_REAL, 3);
- float_vector_element(vec, index) = real_to_double(sc, val, "float-vector-set!");
- /* currently this accepts a complex value and assigns real_part(val) to the float-vector -- maybe an error instead? */
- }
- else
+ if (is_integer(y))
+ return((!is_NaN(real_part(x))) &&
+ (!is_NaN(imag_part(x))) &&
+ (fabs(real_part(x) - integer(y)) <= sc->morally_equal_float_epsilon) &&
+ (fabs(imag_part(x)) <= sc->morally_equal_float_epsilon));
+
+ if (s7_is_ratio(y))
+ return((!is_NaN(real_part(x))) &&
+ (!is_NaN(imag_part(x))) &&
+ (s7_fabsl(real_part(x) - fraction(y)) <= sc->morally_equal_float_epsilon) &&
+ (fabs(imag_part(x)) <= sc->morally_equal_float_epsilon));
+
+ if (is_real(y))
{
- if (!s7_is_integer(val))
- method_or_bust(sc, val, caller, args, T_INTEGER, 3);
- int_vector_element(vec, index) = s7_integer(val);
+ if (is_NaN(imag_part(x)))
+ return(false);
+ if (is_NaN(real(y)))
+ return((is_NaN(real_part(x))) &&
+ (fabs(imag_part(x)) <= sc->morally_equal_float_epsilon));
+ return(((real_part(x) == real(y)) ||
+ (fabs(real_part(x) - real(y)) <= sc->morally_equal_float_epsilon)) &&
+ (fabs(imag_part(x)) <= sc->morally_equal_float_epsilon));
}
- return(val);
-}
+ /* should (morally-equal? nan.0 (complex nan.0 nan.0)) be #t (it's #f above)? */
+ if (is_NaN(real_part(x)))
+ return((is_NaN(real_part(y))) &&
+ (((is_NaN(imag_part(x))) && (is_NaN(imag_part(y)))) ||
+ (imag_part(x) == imag_part(y)) ||
+ (fabs(imag_part(x) - imag_part(y)) <= sc->morally_equal_float_epsilon)));
-static s7_pointer g_float_vector_ref(s7_scheme *sc, s7_pointer args)
-{
- #define H_float_vector_ref "(float-vector-ref v ...) returns an element of the float-vector v."
- #define Q_float_vector_ref s7_make_circular_signature(sc, 2, 3, sc->is_float_symbol, sc->is_float_vector_symbol, sc->is_integer_symbol)
- return(univect_ref(sc, args, true));
-}
+ if (is_NaN(imag_part(x)))
+ return((is_NaN(imag_part(y))) &&
+ ((real_part(x) == real_part(y)) ||
+ (fabs(real_part(x) - real_part(y)) <= sc->morally_equal_float_epsilon)));
+ if ((is_NaN(real_part(y))) ||
+ (is_NaN(imag_part(y))))
+ return(false);
-static s7_pointer g_float_vector_set(s7_scheme *sc, s7_pointer args)
-{
- #define H_float_vector_set "(float-vector-set! v i ... value) sets the i-th element of the float-vector v to value."
- #define Q_float_vector_set s7_make_circular_signature(sc, 3, 4, sc->is_real_symbol, sc->is_float_vector_symbol, sc->is_integer_symbol, sc->is_integer_or_real_at_end_symbol)
- return(univect_set(sc, args, true));
+ return(((real_part(x) == real_part(y)) ||
+ (fabs(real_part(x) - real_part(y)) <= sc->morally_equal_float_epsilon)) &&
+ ((imag_part(x) == imag_part(y)) ||
+ (fabs(imag_part(x) - imag_part(y)) <= sc->morally_equal_float_epsilon)));
}
-static s7_pointer g_int_vector_ref(s7_scheme *sc, s7_pointer args)
+static bool rng_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
{
- #define H_int_vector_ref "(int-vector-ref v ...) returns an element of the int-vector v."
- #define Q_int_vector_ref s7_make_circular_signature(sc, 2, 3, sc->is_integer_symbol, sc->is_int_vector_symbol, sc->is_integer_symbol)
- return(univect_ref(sc, args, false));
+#if WITH_GMP
+ return(x == y);
+#else
+ return((x == y) ||
+ ((is_random_state(y)) &&
+ (random_seed(x) == random_seed(y)) &&
+ (random_carry(x) == random_carry(y))));
+#endif
}
-static s7_pointer g_int_vector_set(s7_scheme *sc, s7_pointer args)
-{
- #define H_int_vector_set "(int-vector-set! v i ... value) sets the i-th element of the int-vector v to value."
- #define Q_int_vector_set s7_make_circular_signature(sc, 2, 3, sc->is_integer_symbol, sc->is_int_vector_symbol, sc->is_integer_symbol)
- return(univect_set(sc, args, false));
-}
-/* int-vector-ref|set optimizers */
+static bool (*equals[NUM_TYPES])(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally);
-static s7_int int_vector_ref_if_a(s7_scheme *sc, s7_pointer **p)
+static void init_equals(void)
{
- s7_if_t xf;
- s7_pointer x;
- s7_int y;
- x = (**p); (*p)++;
- if (!is_int_vector(x))
- wrong_type_argument(sc, sc->int_vector_ref_symbol, 1, x, T_INT_VECTOR);
- xf = (s7_if_t)(**p); (*p)++;
- y = xf(sc, p);
- if ((y < 0) || (y >= vector_length(x)))
- out_of_range(sc, sc->int_vector_ref_symbol, small_int(2), make_integer(sc, y), (y < 0) ? its_negative_string : its_too_large_string);
- return(int_vector_elements(x)[y]);
+ int i;
+ for (i = 0; i < NUM_TYPES; i++) equals[i] = eq_equal;
+ equals[T_SYMBOL] = symbol_equal;
+ equals[T_C_POINTER] = c_pointer_equal;
+ equals[T_UNSPECIFIED] = unspecified_equal;
+ equals[T_STRING] = string_equal;
+ equals[T_SYNTAX] = syntax_equal;
+ equals[T_C_OBJECT] = c_object_equal;
+ equals[T_RANDOM_STATE] = rng_equal;
+ equals[T_ITERATOR] = iterator_equal;
+ equals[T_INPUT_PORT] = port_equal;
+ equals[T_OUTPUT_PORT] = port_equal;
+ equals[T_MACRO] = closure_equal;
+ equals[T_MACRO_STAR] = closure_equal;
+ equals[T_BACRO] = closure_equal;
+ equals[T_BACRO_STAR] = closure_equal;
+ equals[T_CLOSURE] = closure_equal;
+ equals[T_CLOSURE_STAR] = closure_equal;
+ equals[T_HASH_TABLE] = hash_table_equal;
+ equals[T_LET] = let_equal;
+ equals[T_PAIR] = pair_equal;
+ equals[T_VECTOR] = vector_equal;
+ equals[T_INT_VECTOR] = vector_equal;
+ equals[T_FLOAT_VECTOR] = vector_equal;
+ equals[T_INTEGER] = integer_equal;
+ equals[T_RATIO] = fraction_equal;
+ equals[T_REAL] = real_equal;
+ equals[T_COMPLEX] = complex_equal;
+ equals[T_BIG_INTEGER] = bignum_equal;
+ equals[T_BIG_RATIO] = bignum_equal;
+ equals[T_BIG_REAL] = bignum_equal;
+ equals[T_BIG_COMPLEX] = bignum_equal;
}
-static s7_if_t int_vector_ref_if_expanded(s7_scheme *sc, s7_pointer iv, s7_pointer ind_expr)
+static bool s7_is_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
{
- s7_xf_store(sc, iv);
- if (s7_arg_to_if(sc, ind_expr))
- return(int_vector_ref_if_a);
- return(NULL);
+ return((*(equals[type(x)]))(sc, x, y, ci, morally));
}
-static s7_if_t int_vector_ref_if(s7_scheme *sc, s7_pointer expr)
+bool s7_is_equal(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))))
- {
- s7_pointer iv;
- iv = cadr(expr);
- if (!is_symbol(iv)) return(NULL);
- iv = s7_slot(sc, iv);
- if (!is_slot(iv)) return(NULL);
- if (!is_int_vector(slot_value(iv))) return(NULL);
- return(int_vector_ref_if_expanded(sc, slot_value(iv), caddr(expr)));
- }
- return(NULL);
+ return(s7_is_equal_1(sc, x, y, NULL, false));
}
-static s7_if_t implicit_int_vector_ref(s7_scheme *sc, s7_pointer expr)
+bool s7_is_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- if ((is_null(cdr(expr))) || (!is_null(cddr(expr)))) return(NULL);
- return(int_vector_ref_if_expanded(sc, s7_symbol_value(sc, car(expr)), cadr(expr)));
+ return(s7_is_equal_1(sc, x, y, NULL, true));
}
-static s7_int int_vector_set_if_a(s7_scheme *sc, s7_pointer **p)
+static s7_pointer g_is_equal(s7_scheme *sc, s7_pointer args)
{
- s7_if_t xf;
- s7_pointer x;
- s7_int y, z;
- x = (**p); (*p)++;
- if (!is_int_vector(x))
- wrong_type_argument(sc, sc->int_vector_set_symbol, 1, x, T_INT_VECTOR);
- xf = (s7_if_t)(**p); (*p)++;
- y = xf(sc, p);
- if ((y < 0) || (y >= vector_length(x)))
- out_of_range(sc, sc->int_vector_set_symbol, small_int(2), make_integer(sc, y), (y < 0) ? its_negative_string : its_too_large_string);
- xf = (s7_if_t)(**p); (*p)++;
- z = xf(sc, p);
- int_vector_elements(x)[y] = z;
- return(z);
+ #define H_is_equal "(equal? obj1 obj2) returns #t if obj1 is equal to obj2"
+ #define Q_is_equal pcl_bt
+ return(make_boolean(sc, s7_is_equal(sc, car(args), cadr(args))));
}
-static s7_if_t int_vector_set_if_expanded(s7_scheme *sc, s7_pointer iv, s7_pointer ind_sym, s7_pointer val_expr)
+static s7_pointer g_is_morally_equal(s7_scheme *sc, s7_pointer args)
{
- s7_xf_store(sc, iv);
- if ((s7_arg_to_if(sc, ind_sym)) &&
- (s7_arg_to_if(sc, val_expr)))
- return(int_vector_set_if_a);
- return(NULL);
+ #define H_is_morally_equal "(morally-equal? obj1 obj2) returns #t if obj1 is close enough to obj2."
+ #define Q_is_morally_equal pcl_bt
+ return(make_boolean(sc, s7_is_morally_equal(sc, car(args), cadr(args))));
}
-static s7_if_t int_vector_set_if(s7_scheme *sc, s7_pointer expr)
+static bool is_equal_b_pp(s7_pointer a, s7_pointer b) {return(s7_is_equal(cur_sc, a, b));}
+static bool is_morally_equal_b_pp(s7_pointer a, s7_pointer b) {return(s7_is_morally_equal(cur_sc, a, b));}
+
+
+static s7_pointer is_equal_p_pp(s7_pointer a, s7_pointer b) {return((s7_is_equal(cur_sc, a, b)) ? cur_sc->T : cur_sc->F);}
+static s7_pointer is_morally_equal_p_pp(s7_pointer a, s7_pointer b) {return((s7_is_morally_equal(cur_sc, a, b)) ? cur_sc->T : cur_sc->F);}
+
+
+/* ---------------------------------------- length, copy, fill ---------------------------------------- */
+
+static s7_pointer s7_length(s7_scheme *sc, s7_pointer lst)
{
- if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_pair(cdddr(expr))) && (is_null(cddddr(expr))))
+ switch (type(lst))
{
- s7_pointer iv;
- iv = cadr(expr);
- if (!is_symbol(iv)) return(NULL);
- iv = s7_slot(sc, iv);
- if (!is_slot(iv)) return(NULL);
- if (!is_int_vector(slot_value(iv))) return(NULL);
- return(int_vector_set_if_expanded(sc, slot_value(iv), caddr(expr), cadddr(expr)));
- }
- return(NULL);
-}
+ case T_PAIR:
+ {
+ int 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)));
-/* float-vector-ref|set optimizers */
-static s7_double fv_set_rf_checked(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer fv, ind;
- s7_double val;
- s7_int index;
- s7_rf_t rf;
- fv = **p; (*p)++;
- ind = slot_value(**p); (*p)++;
- if (!is_integer(ind))
- wrong_type_argument(sc, sc->float_vector_set_symbol, 2, ind, T_INTEGER);
- index = integer(ind);
- if ((index < 0) || (index >= vector_length(fv)))
- out_of_range(sc, sc->float_vector_set_symbol, small_int(2), ind, (index < 0) ? its_negative_string : its_too_large_string);
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- float_vector_element(fv, index) = val;
- return(val);
-}
+ case T_STRING:
+ return(make_integer(sc, string_length(lst)));
-static s7_double fv_set_rf_r(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer fv, ind, x;
- s7_double val;
- s7_int index;
- fv = **p; (*p)++;
- ind = slot_value(**p); (*p)++;
- if (!is_integer(ind))
- wrong_type_argument(sc, sc->float_vector_set_symbol, 2, ind, T_INTEGER);
- index = integer(ind);
- if ((index < 0) || (index >= vector_length(fv)))
- out_of_range(sc, sc->float_vector_set_symbol, small_int(2), ind, (index < 0) ? its_negative_string : its_too_large_string);
- x = **p; (*p)++;
- val = real_to_double(sc, x, "float-vector-set!");
- float_vector_element(fv, index) = val;
- return(val);
-}
+ case T_ITERATOR:
+ return(make_integer(sc, iterator_length(lst))); /* in several cases, this is incorrect */
-static s7_double fv_set_rf_s(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer fv, ind, x;
- s7_double val;
- s7_int index;
- fv = **p; (*p)++;
- ind = slot_value(**p); (*p)++;
- if (!is_integer(ind))
- wrong_type_argument(sc, sc->float_vector_set_symbol, 2, ind, T_INTEGER);
- index = integer(ind);
- if ((index < 0) || (index >= vector_length(fv)))
- out_of_range(sc, sc->float_vector_set_symbol, small_int(2), ind, (index < 0) ? its_negative_string : its_too_large_string);
- x = slot_value(**p); (*p)++;
- val = real_to_double(sc, x, "float-vector-set!");
- float_vector_element(fv, index) = val;
- return(val);
-}
+ case T_HASH_TABLE:
+ return(make_integer(sc, hash_table_mask(lst) + 1));
+ case T_C_OBJECT:
+ check_method(sc, lst, sc->length_symbol, list_1(sc, lst));
+ return(object_length(sc, lst));
-static s7_double fv_set_rf_six(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer fv, ind;
- s7_double val;
- s7_int index;
- s7_rf_t rf;
- fv = **p; (*p)++;
- ind = **p; (*p)++;
- index = integer(ind);
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- float_vector_element(fv, index) = val;
- return(val);
-}
+ case T_LET:
+ check_method(sc, lst, sc->length_symbol, list_1(sc, lst));
+ return(make_integer(sc, let_length(sc, lst)));
-static s7_double fv_set_rf_if(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer fv;
- s7_double val;
- s7_int index;
- s7_rf_t rf;
- s7_if_t xf;
- fv = **p; (*p)++;
- xf = (s7_if_t)(**p); (*p)++;
- index = xf(sc, p);
- if ((index < 0) || (index >= vector_length(fv)))
- out_of_range(sc, sc->float_vector_set_symbol, small_int(2), make_integer(sc, index), (index < 0) ? its_negative_string : its_too_large_string);
- rf = (s7_rf_t)(**p); (*p)++;
- val = rf(sc, p);
- float_vector_element(fv, index) = val;
- return(val);
-}
+ case T_CLOSURE:
+ case T_CLOSURE_STAR:
+ if (has_methods(lst))
+ return(make_integer(sc, closure_length(sc, lst)));
+ return(sc->F);
-static s7_rf_t float_vector_set_rf_expanded(s7_scheme *sc, s7_pointer fv, s7_pointer ind_sym, s7_pointer val_expr)
-{
- xf_t *rc;
- xf_init(3);
- xf_store(fv);
- if (is_symbol(ind_sym))
- {
- s7_pointer ind, ind_slot;
+ case T_INPUT_PORT:
+ if (is_string_port(lst))
+ return(make_integer(sc, port_data_size(lst)));
+ return(sc->F);
- ind_slot = s7_slot(sc, ind_sym);
- if (!is_slot(ind_slot)) return(NULL);
- ind = slot_value(ind_slot);
- if (!is_integer(ind)) return(NULL);
- if (numerator(ind) < 0) return(NULL);
- xf_store(ind_slot);
- if (is_real(val_expr))
- {
- xf_store(val_expr);
- return(fv_set_rf_r);
- }
- if (is_symbol(val_expr))
- {
- s7_pointer slot, val;
- slot = s7_slot(sc, val_expr);
- if (!is_slot(slot)) return(NULL);
- val = slot_value(slot);
- if (!is_real(val)) return(NULL);
- xf_store(slot);
- return(fv_set_rf_s);
- }
- if (!is_pair(val_expr)) return(NULL);
- return(pair_to_rf(sc, val_expr, fv_set_rf_checked));
- }
- if (is_pair(ind_sym))
- {
- s7_ip_t ip;
- s7_if_t xf;
- s7_int loc;
- if (!is_pair(val_expr)) return(NULL);
- xf_save_loc(loc);
- ip = pair_to_ip(sc, ind_sym);
- if (!ip) return(NULL);
- xf = ip(sc, ind_sym);
- if (!xf) return(NULL);
- xf_store_at(loc, (s7_pointer)xf);
- return(pair_to_rf(sc, val_expr, fv_set_rf_if));
- }
- if ((is_integer(ind_sym)) &&
- (is_pair(val_expr)))
- {
- s7_int index;
- index = integer(ind_sym);
- if ((index < 0) || (index >= vector_length(fv))) return(NULL);
- xf_store(ind_sym);
- return(pair_to_rf(sc, val_expr, fv_set_rf_six));
+ default:
+ return(sc->F);
}
- return(NULL);
+ return(sc->F);
}
-static s7_rf_t float_vector_set_rf(s7_scheme *sc, s7_pointer expr)
+static s7_pointer g_length(s7_scheme *sc, s7_pointer args)
{
- s7_pointer fv;
- fv = cadr(expr);
- if (!is_symbol(fv)) return(NULL);
- fv = s7_slot(sc, fv);
- if (!is_slot(fv)) return(NULL);
- if (!is_float_vector(slot_value(fv))) return(NULL);
- return(float_vector_set_rf_expanded(sc, slot_value(fv), caddr(expr), cadddr(expr)));
+ #define H_length "(length obj) returns the length of obj, which can be a list, vector, string, or hash-table. \
+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)));
}
+/* what about (length file)? input port, read_file gets the file length, so perhaps save it
+ * but we're actually looking at the port, so its length is what remains to be read? (if input port)
+ */
-static s7_double fv_ref_rf_ss(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1, s2;
- s7_int ind;
- s1 = slot_value(**p); (*p)++;
- s2 = slot_value(**p); (*p)++;
- ind = s7_integer(s2);
- if ((ind < 0) || (ind >= vector_length(s1)))
- out_of_range(sc, sc->float_vector_ref_symbol, small_int(2), s2, (ind < 0) ? its_negative_string : its_too_large_string);
- return(float_vector_elements(s1)[ind]);
-}
-static s7_double fv_ref_rf_si(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer s1, s2;
- s7_int ind;
- s1 = slot_value(**p); (*p)++;
- s2 = (**p); (*p)++;
- ind = s7_integer(s2);
- if ((ind < 0) || (ind >= vector_length(s1)))
- out_of_range(sc, sc->float_vector_ref_symbol, small_int(2), s2, (ind < 0) ? its_negative_string : its_too_large_string);
- return(float_vector_elements(s1)[ind]);
-}
+/* -------------------------------- copy -------------------------------- */
+
+static s7_pointer copy_to_string_error = NULL, copy_to_byte_vector_error = NULL;
-static s7_double fv_ref_rf_sx(s7_scheme *sc, s7_pointer **p)
+static void set_string_error_source(s7_scheme *sc, s7_pointer source)
{
- s7_pointer s1;
- s7_if_t i1;
- s7_int ind;
- s1 = slot_value(**p); (*p)++;
- i1 = (s7_if_t)(**p); (*p)++;
- ind = i1(sc, p);
- if ((ind < 0) || (ind >= vector_length(s1)))
- out_of_range(sc, sc->float_vector_ref_symbol, small_int(2), make_integer(sc, ind), (ind < 0) ? its_negative_string : its_too_large_string);
- return(float_vector_elements(s1)[ind]);
+ if (!copy_to_string_error)
+ copy_to_string_error = s7_make_permanent_string("copy ~A to string, ~S is not a character");
+ if (!copy_to_byte_vector_error)
+ copy_to_byte_vector_error = s7_make_permanent_string("copy ~A to byte-vector, ~S is not a byte");
+ set_cadr(sc->elist_3, prepackaged_type_name(sc, source));
}
-static s7_double fv_ref_rf_pf(s7_scheme *sc, s7_pointer **p)
+static s7_pointer string_setter(s7_scheme *sc, s7_pointer str, s7_int loc, s7_pointer val)
{
- s7_pointer s1;
- s7_pf_t fv;
- s7_if_t i1;
- s7_int ind;
- fv = (s7_pf_t)(**p); (*p)++;
- s1 = fv(sc, p);
- if (!is_float_vector(s1))
- wrong_type_argument(sc, sc->float_vector_ref_symbol, 1, s1, T_FLOAT_VECTOR);
- i1 = (s7_if_t)(**p); (*p)++;
- ind = i1(sc, p);
- if ((ind < 0) || (ind >= vector_length(s1)))
- out_of_range(sc, sc->float_vector_ref_symbol, small_int(2), make_integer(sc, ind), (ind < 0) ? its_negative_string : its_too_large_string);
- return(float_vector_elements(s1)[ind]);
+ if (s7_is_character(val))
+ {
+ string_value(str)[loc] = s7_character(val);
+ return(val);
+ }
+ /* (copy #(3) "123"): wrong type arg because not a char, but it's very confusing to report
+ * error: copy argument 3, 3, is an integer but should be a character
+ * perhaps better, copy #(3) to string, 3 is not a character
+ */
+
+ if (!copy_to_string_error)
+ copy_to_string_error = s7_make_permanent_string("copy ~A to string, ~S is not a character");
+
+ set_car(sc->elist_3, copy_to_string_error);
+ set_caddr(sc->elist_3, val);
+ return(s7_error(sc, sc->wrong_type_arg_symbol, sc->elist_3));
}
-static s7_rf_t float_vector_ref_rf_expanded(s7_scheme *sc, s7_pointer a1, s7_pointer a2)
+static s7_pointer byte_vector_setter(s7_scheme *sc, s7_pointer str, s7_int loc, s7_pointer val)
{
- if ((is_symbol(a1)) &&
- (is_float_vector(s7_symbol_value(sc, a1))))
+ if (s7_is_integer(val))
{
- xf_t *rc;
- xf_init(2);
- xf_store(s7_slot(sc, a1));
- if (is_integer(a2))
- {
- xf_store(a2);
- return(fv_ref_rf_si);
- }
- if (is_symbol(a2))
- {
- a2 = s7_slot(sc, a2);
- if ((!is_slot(a2)) || (is_t_complex(slot_value(a2)))) return(NULL);
- xf_store(a2);
- return(fv_ref_rf_ss);
- }
- if (is_pair(a2))
- return(pair_to_rf_via_if(sc, a2, fv_ref_rf_sx));
+ s7_int byte;
+ byte = s7_integer(val);
+ if ((byte >= 0) && (byte < 256))
+ string_value(str)[loc] = (unsigned char)byte;
+ else return(simple_wrong_type_argument_with_type(sc, sc->copy_symbol, val, an_unsigned_byte_string));
+ return(val);
}
- if ((is_pair(a1)) &&
- (s7_arg_to_pf(sc, a1)) &&
- (s7_arg_to_if(sc, a2)))
- return(fv_ref_rf_pf);
- return(NULL);
+
+ if (!copy_to_byte_vector_error)
+ copy_to_byte_vector_error = s7_make_permanent_string("copy ~A to byte-vector, ~S is not a byte");
+
+ set_car(sc->elist_3, copy_to_byte_vector_error);
+ set_caddr(sc->elist_3, val);
+ return(s7_error(sc, sc->wrong_type_arg_symbol, sc->elist_3));
}
-static s7_rf_t float_vector_ref_rf(s7_scheme *sc, s7_pointer expr)
+static s7_pointer string_getter(s7_scheme *sc, s7_pointer str, s7_int loc)
{
- if ((is_null(cdr(expr))) || (is_null(cddr(expr))) || (!is_null(cdddr(expr)))) return(NULL);
- return(float_vector_ref_rf_expanded(sc, cadr(expr), caddr(expr)));
+ return(s7_make_character(sc, (unsigned char)(string_value(str)[loc]))); /* cast needed else (copy (string (integer->char 255))...) is trouble */
}
-static s7_rf_t implicit_float_vector_ref(s7_scheme *sc, s7_pointer expr)
+static s7_pointer byte_vector_getter(s7_scheme *sc, s7_pointer str, s7_int loc)
{
- if ((is_null(cdr(expr))) || (!is_null(cddr(expr)))) return(NULL);
- return(float_vector_ref_rf_expanded(sc, car(expr), cadr(expr)));
+ return(make_integer(sc, (unsigned char)(string_value(str)[loc])));
}
-
-static s7_pointer hash_table_ref_pf_i(s7_scheme *sc, s7_pointer **p);
-static s7_pointer hash_table_set_pf_sxx(s7_scheme *sc, s7_pointer **p);
-
-static s7_pf_t implicit_pf_sequence_ref(s7_scheme *sc, s7_pointer expr)
+static s7_pointer c_object_setter(s7_scheme *sc, s7_pointer obj, s7_int loc, s7_pointer val)
{
- s7_pointer seq, ind;
- if ((is_null(cdr(expr))) || (!is_null(cddr(expr)))) return(NULL);
- seq = car(expr);
- ind = cadr(expr);
- if (!is_symbol(seq)) return(NULL);
- seq = s7_slot(sc, seq);
- if (!is_slot(seq)) return(NULL);
- s7_xf_store(sc, seq);
- switch (type(slot_value(seq)))
- {
- case T_STRING:
- if (s7_arg_to_if(sc, ind))
- return(string_ref_pf_si);
- break;
-
- case T_PAIR:
- if (s7_arg_to_if(sc, ind))
- return(list_ref_pf_si);
- break;
-
- case T_VECTOR:
- if (s7_arg_to_if(sc, ind))
- return(vector_ref_pf_i); /* TODO: these vref funcs don't check bounds */
- break;
-
- case T_HASH_TABLE:
- if (s7_arg_to_pf(sc, ind))
- return(hash_table_ref_pf_i);
- break;
-
- case T_LET:
- if (s7_arg_to_pf(sc, ind))
- return(let_ref_pf_p2_sp);
- break;
- }
- return(NULL);
+ 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));
}
-static s7_pf_t implicit_gf_sequence_ref(s7_scheme *sc, s7_pointer expr)
+static s7_pointer c_object_getter(s7_scheme *sc, s7_pointer obj, s7_int loc)
{
- /* only difference from pf case: int|float-vectors return s7_pointer values */
- return(implicit_pf_sequence_ref(sc, expr));
+ set_car(sc->t1_1, make_integer(sc, loc));
+ return((*(c_object_ref(obj)))(sc, obj, sc->t1_1));
}
-#if WITH_OPTIMIZATION
-static s7_pf_t implicit_pf_sequence_set(s7_scheme *sc, s7_pointer seq, s7_pointer ind, s7_pointer val)
+static s7_pointer let_setter(s7_scheme *sc, s7_pointer e, s7_int loc, s7_pointer val)
{
- /* seq is the slot */
- s7_xf_store(sc, seq);
- switch (type(slot_value(seq)))
+ /* loc is irrelevant here
+ * val has to be of the form (cons symbol value)
+ * if symbol is already in e, its value is changed, otherwise a new slot is added to e
+ */
+ static s7_pointer ls_err = NULL;
+ s7_pointer sym;
+ if (!is_pair(val))
{
- case T_STRING:
- if ((s7_arg_to_if(sc, ind)) &&
- (s7_arg_to_pf(sc, val)))
- return(string_set_pf_seq);
- break;
-
- case T_PAIR:
- if ((s7_arg_to_if(sc, ind)) &&
- (s7_arg_to_pf(sc, val)))
- return(list_set_pf_seq);
- break;
-
- case T_VECTOR:
- if ((s7_arg_to_if(sc, ind)) &&
- (s7_arg_to_pf(sc, val)))
- return(vector_set_pf_seq);
- break;
-
- case T_HASH_TABLE:
- if ((s7_arg_to_pf(sc, ind)) &&
- (s7_arg_to_pf(sc, val)))
- return(hash_table_set_pf_sxx);
- break;
-
- case T_LET:
- if ((s7_arg_to_pf(sc, ind)) &&
- (s7_arg_to_pf(sc, val)))
- return(let_set_pf_p3_s);
- break;
+ if (!ls_err) ls_err = s7_make_permanent_string("(cons symbol value)");
+ return(wrong_type_argument_with_type(sc, sc->copy_symbol, 3, e, ls_err));
}
- return(NULL);
+ sym = car(val);
+ if (!is_symbol(sym))
+ {
+ if (!ls_err) ls_err = s7_make_permanent_string("(cons symbol value)");
+ return(wrong_type_argument_with_type(sc, sc->copy_symbol, 3, e, ls_err));
+ }
+ if ((symbol_id(sym) < let_id(e)) ||
+ (s7_let_set(sc, e, sym, cdr(val)) != cdr(val)))
+ make_slot_1(sc, e, sym, cdr(val));
+ return(val);
}
-static s7_pf_t implicit_gf_sequence_set(s7_scheme *sc, s7_pointer v, s7_pointer ind, s7_pointer val)
+static s7_pointer hash_table_setter(s7_scheme *sc, s7_pointer e, s7_int loc, s7_pointer val)
{
- return(implicit_pf_sequence_set(sc, v, ind, val));
+ /* loc is irrelevant here
+ * val has to be of the form (cons key value)
+ * if key is already in e, its value is changed, otherwise a new slot is added to e
+ */
+ if (!is_pair(val))
+ return(wrong_type_argument_with_type(sc, sc->copy_symbol, 1, e, a_list_string));
+ return(s7_hash_table_set(sc, e, car(val), cdr(val)));
}
-#endif
-
-/* -------------------------------------------------------------------------------- */
-
-static bool c_function_is_ok(s7_scheme *sc, s7_pointer x)
+s7_pointer s7_copy(s7_scheme *sc, s7_pointer args)
{
- /* macro version of this (below) is much slower! Since this is almost never false,
- * I tried __builtin_expect throughout eval below. The result was not faster.
+ #define H_copy "(copy obj) returns a copy of obj, (copy src dest) copies src into dest, (copy src dest start end) copies src from start to end."
+ /* #define Q_copy s7_make_circular_signature(sc, 3, 4, sc->T, sc->is_sequence_symbol, sc->is_sequence_symbol, sc->is_integer_symbol) */
+ /* this is not right when c-object types are handled in lint -- a generator or Snd object need not consider itself a sequence,
+ * but it can provide a copy method. So, I think I'll just use #t
*/
- s7_pointer p;
+ #define Q_copy s7_make_circular_signature(sc, 3, 4, sc->T, sc->T, sc->T, sc->is_integer_symbol)
- p = car(x);
- if (is_global(p)) p = slot_value(global_slot(p)); else p = find_symbol_unchecked(sc, p);
- /* this is nearly always global and p == opt_cfunc(x)
- * p can be null if we evaluate some code, optimizing it, then eval it again in a context
- * where the incoming p was undefined(!) -- explicit use of eval and so on.
- * I guess ideally eval would ignore optimization info -- copy :readable or something.
- */
- return((p == opt_any1(x)) ||
- ((is_any_c_function(p)) && /* (opt_cfunc(x)) && */
- (c_function_class(p) == c_function_class(opt_cfunc(x)))));
-}
+ s7_pointer source, dest;
+ s7_int i, j, dest_len, start, end, source_len;
+ s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_int loc, s7_pointer val) = NULL;
+ s7_pointer (*get)(s7_scheme *sc, s7_pointer obj, s7_int loc) = NULL;
+ bool have_indices;
+
+ source = car(args);
+ if (is_null(cdr(args))) /* (copy obj) */
+ {
+ switch (type(source))
+ {
+ case T_STRING:
+ {
+ s7_pointer ns;
+ ns = s7_make_string_with_length(sc, string_value(source), string_length(source));
+ if (is_byte_vector(source))
+ set_byte_vector(ns);
+ return(ns);
+ }
+
+ case T_C_OBJECT:
+ return(object_copy(sc, args));
+
+ case T_RANDOM_STATE:
+ return(rng_copy(sc, args));
+
+ case T_HASH_TABLE: /* this has to copy nearly everything */
+ {
+ unsigned int gc_loc;
+ s7_pointer new_hash;
+ 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);
+ 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));
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(new_hash);
+ }
+
+ case T_ITERATOR:
+ return(iterator_copy(sc, source));
+
+ case T_LET:
+ check_method(sc, source, sc->copy_symbol, args);
+ return(let_copy(sc, source)); /* this copies only the local env and points to outer envs */
+
+ case T_CLOSURE: case T_CLOSURE_STAR:
+ case T_MACRO: case T_MACRO_STAR:
+ case T_BACRO: case T_BACRO_STAR:
+ check_method(sc, source, sc->copy_symbol, args);
+ return(copy_closure(sc, source));
+
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ return(s7_vector_copy(sc, source)); /* "shallow" copy */
+
+ case T_PAIR: /* top level only, as in the other cases, last arg checks for circles */
+ return(protected_list_copy(sc, source));
+
+ case T_INTEGER:
+ new_cell(sc, dest, T_INTEGER);
+ integer(dest) = integer(source);
+ return(dest);
-static bool arglist_has_rest(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer p;
- for (p = args; is_pair(p); p = cdr(p))
- if (car(p) == sc->key_rest_symbol)
- return(true);
- return(false);
-}
+ case T_RATIO:
+ new_cell(sc, dest, T_RATIO);
+ numerator(dest) = numerator(source);
+ denominator(dest) = denominator(source);
+ return(dest);
+ case T_REAL:
+ new_cell(sc, dest, T_REAL);
+ set_real(dest, real(source));
+ return(dest);
-static bool arglist_has_keyword(s7_pointer args)
-{
- s7_pointer p;
- for (p = args; is_pair(p); p = cdr(p))
- if (is_keyword(car(p)))
- return(true);
- return(false);
-}
+ case T_COMPLEX:
+ new_cell(sc, dest, T_COMPLEX);
+ set_real_part(dest, real_part(source));
+ set_imag_part(dest, imag_part(source));
+ return(dest);
+#if WITH_GMP
+ case T_BIG_INTEGER: return(mpz_to_big_integer(sc, big_integer(source)));
+ case T_BIG_RATIO: return(mpq_to_big_ratio(sc, big_ratio(source)));
+ case T_BIG_REAL: return(mpfr_to_big_real(sc, big_real(source)));
+ case T_BIG_COMPLEX: return(mpc_to_big_complex(sc, big_complex(source)));
+#endif
+
+ case T_C_POINTER:
+ return(s7_make_c_pointer(sc, s7_c_pointer(source)));
+ }
+ return(source);
+ }
-/* -------- sort! -------- */
+ have_indices = (is_pair(cddr(args)));
+ dest = cadr(args);
+ if ((source == dest) && (!have_indices))
+ return(dest);
+
+ switch (type(source))
+ {
+ case T_PAIR:
+ if (dest == sc->key_readable_symbol) /* a kludge, but I can't think of anything less stupid */
+ return(copy_body(sc, source));
-#if (!WITH_GMP)
-static int dbl_less(const void *f1, const void *f2)
-{
- if ((*((s7_double *)f1)) < (*((s7_double *)f2))) return(-1);
- if ((*((s7_double *)f1)) > (*((s7_double *)f2))) return(1);
- return(0);
-}
+ end = s7_list_length(sc, source);
+ if (end == 0)
+ end = circular_list_entries(source);
+ else
+ {
+ if (end < 0) end = -end;
+ }
+ break;
-static int int_less(const void *f1, const void *f2)
-{
- if ((*((s7_int *)f1)) < (*((s7_int *)f2))) return(-1);
- if ((*((s7_int *)f1)) > (*((s7_int *)f2))) return(1);
- return(0);
-}
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ get = vector_getter(source);
+ end = vector_length(source);
+ break;
-static int dbl_greater(const void *f1, const void *f2) {return(-dbl_less(f1, f2));}
-static int int_greater(const void *f1, const void *f2) {return(-int_less(f1, f2));}
+ case T_STRING:
+ if (is_byte_vector(source))
+ get = byte_vector_getter;
+ else get = string_getter;
+ end = string_length(source);
+ break;
-static int byte_less(const void *f1, const void *f2)
-{
- if ((*((unsigned char *)f1)) < (*((unsigned char *)f2))) return(-1);
- if ((*((unsigned char *)f1)) > (*((unsigned char *)f2))) return(1);
- return(0);
-}
+ case T_HASH_TABLE:
+ end = hash_table_entries(source);
+ break;
-static int byte_greater(const void *f1, const void *f2) {return(-byte_less(f1, f2));}
+ case T_C_OBJECT:
+ check_method(sc, source, sc->copy_symbol, args);
+ {
+ s7_pointer x;
+ x = object_copy(sc, args);
+ if (x == dest)
+ 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);
+ if (!get) get = c_object_getter;
+ end = object_length_to_int(sc, source);
+ break;
-static int dbl_less_2(const void *f1, const void *f2)
-{
- s7_pointer p1, p2;
- p1 = (*((s7_pointer *)f1));
- p2 = (*((s7_pointer *)f2));
- if (real(p1) < real(p2)) return(-1);
- if (real(p1) > real(p2)) return(1);
- return(0);
-}
+ case T_LET:
+ check_method(sc, source, sc->copy_symbol, args);
+ if (source == sc->rootlet)
+ return(wrong_type_argument_with_type(sc, sc->copy_symbol, 1, source, make_string_wrapper(sc, "a sequence other than the rootlet")));
+ end = let_length(sc, source);
+ break;
-static int int_less_2(const void *f1, const void *f2)
-{
- s7_pointer p1, p2;
- p1 = (*((s7_pointer *)f1));
- p2 = (*((s7_pointer *)f2));
- if (integer(p1) < integer(p2)) return(-1);
- if (integer(p1) > integer(p2)) return(1);
- return(0);
-}
+ case T_NIL:
+ end = 0;
+ if (is_sequence(dest))
+ break;
-static int dbl_greater_2(const void *f1, const void *f2) {return(-dbl_less_2(f1, f2));}
-static int int_greater_2(const void *f1, const void *f2) {return(-int_less_2(f1, f2));}
-#endif
+ default:
+ return(wrong_type_argument_with_type(sc, sc->copy_symbol, 1, source, a_sequence_string));
+ /* copy doesn't have to duplicate fill!, so (copy 1 #(...)) need not be supported */
+ }
-static s7_scheme *compare_sc;
-static s7_function compare_func;
-static s7_pointer compare_args, compare_begin, compare_v1, compare_v2;
-static opcode_t compare_op;
-static s7_pf_t compare_pf;
+ start = 0;
+ if (have_indices)
+ {
+ s7_pointer p;
+ p = start_and_end(sc, sc->copy_symbol, NULL, cddr(args), args, 3, &start, &end);
+ if (p != sc->gc_nil) return(p);
+ }
+ if ((start == 0) && (source == dest))
+ return(dest);
+ source_len = end - start;
+ if (source_len == 0)
+ {
+ if (!is_sequence(dest))
+ return(wrong_type_argument_with_type(sc, sc->copy_symbol, 2, dest, a_sequence_string));
+ return(dest);
+ }
-static int vector_compare(const void *v1, const void *v2)
-{
- set_car(compare_args, (*(s7_pointer *)v1));
- set_cadr(compare_args, (*(s7_pointer *)v2));
- return(((*(compare_func))(compare_sc, compare_args) != compare_sc->F) ? -1 : 1);
-}
+ switch (type(dest))
+ {
+ case T_PAIR:
+ dest_len = source_len;
+ break;
-static int pf_compare(const void *v1, const void *v2)
-{
- s7_pointer *top;
- s7_pointer **rp;
- slot_set_value(compare_v1, (*(s7_pointer *)v1));
- slot_set_value(compare_v2, (*(s7_pointer *)v2));
- top = compare_sc->cur_rf->data;
- rp = ⊤ (*rp)++;
- if (is_true(compare_sc, compare_pf(compare_sc, rp)))
- return(-1);
- return(1);
-}
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ set = vector_setter(dest);
+ dest_len = vector_length(dest);
+ break;
-static int closure_compare(const void *v1, const void *v2)
-{
- slot_set_value(compare_v1, (*(s7_pointer *)v1));
- slot_set_value(compare_v2, (*(s7_pointer *)v2));
- push_stack(compare_sc, OP_EVAL_DONE, compare_sc->args, compare_sc->code);
- compare_sc->code = compare_args; /* this should be ok because we checked in advance that it is a safe closure (no sort! for example) */
- eval(compare_sc, compare_op);
- return((compare_sc->value != compare_sc->F) ? -1 : 1);
-}
+ case T_STRING:
+ if (is_byte_vector(dest))
+ set = byte_vector_setter;
+ else set = string_setter;
+ dest_len = string_length(dest);
+ break;
-static int closure_compare_begin(const void *v1, const void *v2)
-{
- slot_set_value(compare_v1, (*(s7_pointer *)v1));
- slot_set_value(compare_v2, (*(s7_pointer *)v2));
- push_stack(compare_sc, OP_EVAL_DONE, compare_sc->args, compare_sc->code);
- push_stack_no_args(compare_sc, OP_BEGIN1, compare_begin);
- compare_sc->code = compare_args;
- eval(compare_sc, compare_op);
- return((compare_sc->value != compare_sc->F) ? -1 : 1);
-}
+ case T_HASH_TABLE:
+ set = hash_table_setter;
+ dest_len = source_len;
+ break;
-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)
+ case T_C_OBJECT:
+ set = c_object_direct_set(dest);
+ if (!set) set = c_object_setter;
+ dest_len = object_length_to_int(sc, dest);
+ break;
- s7_pointer data, lessp, lx;
- s7_int len = 0, n, k;
- int (*sort_func)(const void *v1, const void *v2);
- s7_pointer *elements;
- unsigned int gc_loc = 0;
+ case T_LET:
+ if (dest == sc->rootlet)
+ return(wrong_type_argument_with_type(sc, sc->copy_symbol, 2, dest, make_string_wrapper(sc, "a sequence other than the rootlet")));
+ set = let_setter;
+ dest_len = source_len; /* grows via set, so dest_len isn't relevant */
+ break;
- /* both the intermediate vector (if any) and the current args pointer need GC protection,
- * but it is a real bother to unprotect args at every return statement, so I'll use temp3
- */
- sc->temp3 = args; /* this is needed! */
- data = car(args);
- if (is_null(data))
- {
- /* (apply sort! () #f) should be an error I think */
- lessp = cadr(args);
- if (type(lessp) < T_GOTO)
- method_or_bust_with_type(sc, lessp, sc->sort_symbol, args, a_procedure_string, 2);
- if (!s7_is_aritable(sc, lessp, 2))
- return(wrong_type_argument_with_type(sc, sc->sort_symbol, 2, lessp, an_eq_func_string));
+ case T_NIL:
return(sc->nil);
- }
-
- lessp = cadr(args);
- if (type(lessp) < T_GOTO)
- method_or_bust_with_type(sc, lessp, sc->sort_symbol, args, a_procedure_string, 2);
- if (!s7_is_aritable(sc, lessp, 2))
- return(wrong_type_argument_with_type(sc, sc->sort_symbol, 2, lessp, an_eq_func_string));
- if ((is_continuation(lessp)) || is_goto(lessp))
- return(wrong_type_argument_with_type(sc, sc->sort_symbol, 2, lessp, a_normal_procedure_string));
-
- sort_func = vector_compare;
- compare_func = NULL;
- compare_args = sc->t2_1;
- compare_sc = sc;
-
- if ((is_safe_procedure(lessp)) && /* (sort! a <) */
- (is_c_function(lessp)))
- {
- s7_pointer sig;
- sig = c_function_signature(lessp);
- if ((sig) &&
- (is_pair(sig)) &&
- (car(sig) != sc->is_boolean_symbol))
- return(wrong_type_argument_with_type(sc, sc->sort_symbol, 2, lessp, make_string_wrapper(sc, "sort! function should return a boolean")));
- compare_func = c_function_call(lessp);
+ default:
+ return(wrong_type_argument_with_type(sc, sc->copy_symbol, 2, dest, a_sequence_string));
}
- else
- {
- if (is_closure(lessp))
- {
- s7_pointer expr, largs;
- expr = car(closure_body(lessp));
- largs = closure_args(lessp);
-
- if ((is_null(cdr(closure_body(lessp)))) &&
- (is_optimized(expr)))
- {
- /* since (sort seq (lambda (a b) ...)) can't return a "safe closure" (the hop bit is off in
- * optimize in this case, for some arcane reason), the optimized expression won't be hop_safe,
- * but that is irrelevant at this point -- if c_function_is_ok, we're good to go.
- */
- if ((is_pair(largs)) &&
- (!arglist_has_rest(sc, largs)) &&
- (((optimize_op(expr) & 1) != 0) ||
- (c_function_is_ok(sc, expr))))
- {
- int orig_data;
- orig_data = optimize_op(expr);
- set_optimize_op(expr, optimize_op(expr) | 1);
- if ((optimize_op(expr) == HOP_SAFE_C_SS) &&
- (car(largs) == cadr(expr)) &&
- (cadr(largs) == caddr(expr)))
- {
- lessp = find_symbol_unchecked(sc, car(expr));
- compare_func = c_function_call(lessp);
- }
- else
- {
- if (!is_unsafe_sort(expr))
- {
- new_frame_with_two_slots(sc, closure_let(lessp), sc->envir, car(largs), sc->F, cadr(largs), sc->F);
- set_stepper(let_slots(sc->envir));
- set_stepper(next_slot(let_slots(sc->envir)));
- s7_xf_new(sc, sc->envir);
- compare_pf = xf_opt(sc, expr);
- if (compare_pf)
- {
- sort_func = pf_compare;
- compare_func = g_sort; /* whatever...(just a flag) */
- compare_v1 = let_slots(sc->envir);
- compare_v2 = next_slot(let_slots(sc->envir));
- }
- else
- {
- set_unsafe_sort(expr);
- s7_xf_free(sc);
- }
- }
- }
- set_optimize_op(expr, orig_data);
- }
- }
- if ((!compare_func) &&
- (is_pair(largs)) && /* closure args not a symbol, etc */
- (is_safe_closure(lessp))) /* no embedded sort! or call/cc, etc */
- {
- new_frame_with_two_slots(sc, closure_let(lessp), sc->envir, car(largs), sc->F, cadr(largs), sc->F);
- compare_func = (s7_function)lessp; /* not used -- just a flag */
- compare_args = car(closure_body(lessp));
- compare_begin = cdr(closure_body(lessp));
- if (is_null(compare_begin))
- sort_func = closure_compare;
- else sort_func = closure_compare_begin;
- if (typesflag(compare_args) == SYNTACTIC_PAIR)
- {
- compare_op = (opcode_t)pair_syntax_op(compare_args);
- compare_args = cdr(compare_args);
- }
- else compare_op = OP_EVAL;
- compare_v1 = let_slots(sc->envir);
- compare_v2 = next_slot(let_slots(sc->envir));
- }
- }
- }
+ if (dest_len == 0)
+ return(dest);
-#if (!WITH_GMP)
- if (compare_func == g_less)
- compare_func = g_less_2;
- else
+ /* end is source_len if not set explicitly */
+ if (dest_len < source_len)
{
- if (compare_func == g_greater)
- compare_func = g_greater_2;
+ end = dest_len + start;
+ source_len = dest_len;
}
-#endif
- switch (type(data))
+ if ((source != dest) &&
+ (type(source) == type(dest)))
{
- case T_PAIR:
- len = s7_list_length(sc, data); /* 0 here == infinite */
- if (len <= 0)
- {
- if (sort_func == pf_compare) s7_xf_free(sc);
- return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "sort! argument 1 should be a proper list: ~S"), data)));
- }
- if (len < 2)
- {
- if (sort_func == pf_compare) s7_xf_free(sc);
- return(data);
- }
- if (compare_func)
+ switch (type(source))
{
- s7_int i;
- s7_pointer vec, p;
+ case T_PAIR:
+ {
+ s7_pointer ps, pd;
- vec = g_vector(sc, data);
- gc_loc = s7_gc_protect(sc, vec);
- elements = s7_vector_elements(vec);
+ ps = source;
+ for (i = 0; i < start; i++)
+ ps = cdr(ps);
+ for (pd = dest; (i < end) && is_pair(ps) && is_pair(pd); i++, ps = cdr(ps), pd = cdr(pd))
+ set_car(pd, car(ps));
+ return(dest);
+ }
- sc->v = vec;
- qsort((void *)elements, len, sizeof(s7_pointer), sort_func);
- for (p = data, i = 0; i < len; i++, p = cdr(p))
- set_car(p, elements[i]);
+ case T_VECTOR:
+ memcpy((void *)(vector_elements(dest)), (void *)((vector_elements(source)) + start), source_len * sizeof(s7_pointer));
+ return(dest);
- s7_gc_unprotect_at(sc, gc_loc);
- if (sort_func == pf_compare) s7_xf_free(sc);
- return(data);
- }
+ case T_INT_VECTOR:
+ memcpy((void *)(int_vector_elements(dest)), (void *)((int_vector_elements(source)) + start), source_len * sizeof(s7_int));
+ return(dest);
- push_stack(sc, OP_SORT_PAIR_END, cons(sc, data, lessp), sc->code); /* save and gc protect the original list and func */
- set_car(args, g_vector(sc, data));
- break;
+ case T_FLOAT_VECTOR:
+ memcpy((void *)(float_vector_elements(dest)), (void *)((float_vector_elements(source)) + start), source_len * sizeof(s7_double));
+ return(dest);
- case T_STRING:
- {
- /* byte-vectors here also, so this isn't completely silly */
- s7_int i;
- s7_pointer vec;
- unsigned char *chrs;
+ case T_STRING: /* this is 4 cases (string/byte-vector) */
+ memcpy((void *)string_value(dest), (void *)((string_value(source)) + start), source_len * sizeof(char));
+ return(dest);
- len = string_length(data);
- if (len < 2)
+ case T_C_OBJECT:
{
- if (sort_func == pf_compare) s7_xf_free(sc);
- return(data);
- }
+ s7_pointer mi, mj;
+ unsigned int gc_loc1, gc_loc2;
+ s7_pointer (*ref)(s7_scheme *sc, s7_pointer obj, s7_pointer args);
+ s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args);
-#if (!WITH_GMP)
- if (is_c_function(lessp))
- {
- if (((!is_byte_vector(data)) && (compare_func == g_chars_are_less)) ||
- ((is_byte_vector(data)) && (compare_func == g_less_2)))
- {
- qsort((void *)vector_elements(data), len, sizeof(unsigned char), byte_less);
- return(data);
- }
- if (((!is_byte_vector(data)) && (compare_func == g_chars_are_greater)) ||
- ((is_byte_vector(data)) && (compare_func == g_greater_2)))
+ mi = make_mutable_integer(sc, start);
+ 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);
+
+ for (i = start, j = 0; i < end; i++, j++)
{
- qsort((void *)vector_elements(data), len, sizeof(unsigned char), byte_greater);
- return(data);
+ integer(mi) = i;
+ integer(mj) = j;
+ set_car(sc->t1_1, mi);
+ set_car(sc->t2_2, ref(sc, source, sc->t1_1));
+ set_car(sc->t2_1, mj);
+ set(sc, dest, sc->t2_1);
}
+ s7_gc_unprotect_at(sc, gc_loc1);
+ s7_gc_unprotect_at(sc, gc_loc2);
+ free_cell(sc, mi);
+ free_cell(sc, mj);
+ return(dest);
}
-#endif
-
- vec = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
- gc_loc = s7_gc_protect(sc, vec);
- elements = s7_vector_elements(vec);
- chrs = (unsigned char *)string_value(data);
- if (is_byte_vector(data))
- {
- for (i = 0; i < len; i++)
- elements[i] = small_int(chrs[i]);
- }
- else
- {
- for (i = 0; i < len; i++)
- elements[i] = chars[chrs[i]];
- }
+ case T_LET:
+ break;
- if (compare_func)
+ case T_HASH_TABLE:
{
- sc->v = vec;
- qsort((void *)elements, len, sizeof(s7_pointer), sort_func);
-
- if (is_byte_vector(data))
- {
- for (i = 0; i < len; i++)
- chrs[i] = (char)integer(elements[i]);
- }
- else
+ s7_pointer p;
+ p = hash_table_copy(sc, source, dest, start, end);
+ if ((hash_table_checker(source) != hash_table_checker(dest)) &&
+ (!hash_table_checker_locked(dest)))
{
- for (i = 0; i < len; i++)
- chrs[i] = character(elements[i]);
+ if (hash_table_checker(dest) == hash_empty)
+ hash_table_checker(dest) = hash_table_checker(source);
+ else hash_table_checker(dest) = hash_equal;
}
- s7_gc_unprotect_at(sc, gc_loc);
- if (sort_func == pf_compare) s7_xf_free(sc);
- return(data);
+ return(p);
}
+ break;
- push_stack(sc, OP_SORT_STRING_END, cons(sc, data, lessp), sc->code);
- set_car(args, vec);
- s7_gc_unprotect_at(sc, gc_loc);
- }
- break;
+ default:
+ return(dest);
+ }
+ }
- case T_INT_VECTOR:
- case T_FLOAT_VECTOR:
+ switch (type(source))
+ {
+ case T_PAIR:
{
- s7_int i;
- s7_pointer vec;
+ s7_pointer p;
+ p = source;
+ if (start > 0)
+ for (i = 0; i < start; i++)
+ p = cdr(p);
+ /* dest won't be a pair here -- the pair->pair case was caught above */
+ if (is_string(dest)) set_string_error_source(sc, source);
+ for (i = start, j = 0; i < end; i++, j++, p = cdr(p))
+ set(sc, dest, j, car(p));
+ return(dest);
+ }
- len = vector_length(data);
- if (len < 2)
+ case T_LET:
+ /* implicit index can give n-way reality check (ht growth by new entries)
+ * if shadowed entries are they unshadowed by reversal?
+ */
+ {
+ /* source and dest can't be rootlet (checked above) */
+ s7_pointer slot;
+ slot = let_slots(source);
+ for (i = 0; i < start; i++) slot = next_slot(slot);
+ if (is_pair(dest))
{
- if (sort_func == pf_compare) s7_xf_free(sc);
- return(data);
+ s7_pointer p;
+ for (i = start, p = dest; (i < end) && (is_pair(p)); i++, p = cdr(p), slot = next_slot(slot))
+ set_car(p, cons(sc, slot_symbol(slot), slot_value(slot)));
}
-#if (!WITH_GMP)
- if (is_c_function(lessp))
+ else
{
- if (compare_func == g_less_2)
+ if (is_let(dest))
{
- if (type(data) == T_FLOAT_VECTOR)
- qsort((void *)vector_elements(data), len, sizeof(s7_double), dbl_less);
- else qsort((void *)vector_elements(data), len, sizeof(s7_int), int_less);
- return(data);
+ for (i = start; i < end; i++, slot = next_slot(slot))
+ make_slot_1(sc, dest, slot_symbol(slot), slot_value(slot));
}
- if (compare_func == g_greater_2)
+ else
{
- if (type(data) == T_FLOAT_VECTOR)
- qsort((void *)vector_elements(data), len, sizeof(s7_double), dbl_greater);
- else qsort((void *)vector_elements(data), len, sizeof(s7_int), int_greater);
- return(data);
+ if (is_hash_table(dest))
+ {
+ for (i = start; i < end; i++, slot = next_slot(slot))
+ s7_hash_table_set(sc, dest, slot_symbol(slot), slot_value(slot));
+ }
+ else
+ {
+ for (i = start, j = 0; i < end; i++, j++, slot = next_slot(slot))
+ set(sc, dest, j, cons(sc, slot_symbol(slot), slot_value(slot)));
+ }
}
}
-#endif
-
- /* currently we have to make the ordinary vector here even if not compare_func
- * because the sorter uses vector_element to access sort args (see SORT_DATA in eval).
- * This is probably better than passing down getter/setter (fewer allocations).
- * get/set macro in eval is SORT_DATA(k) then s7_vector_to_list if pair at start (sort_*_end)
- */
- vec = make_vector_1(sc, len, FILLED, T_VECTOR);
- /* we need this vector prefilled because vector_getter below makes reals/int, causing possible GC
- * at any time during that loop, and the GC mark process expects the vector to have an s7_pointer
- * at every element.
- */
- gc_loc = s7_gc_protect(sc, vec);
- elements = s7_vector_elements(vec);
+ return(dest);
+ }
- for (i = 0; i < len; i++)
- elements[i] = vector_getter(data)(sc, data, i);
+ case T_HASH_TABLE:
+ {
+ int loc, skip;
+ hash_entry_t **elements;
+ hash_entry_t *x = NULL;
+ elements = hash_table_elements(source);
+ loc = -1;
- if (compare_func)
+ skip = start;
+ while (skip > 0)
{
- sc->v = vec;
- qsort((void *)elements, len, sizeof(s7_pointer), sort_func);
-
- for (i = 0; i < len; i++)
- vector_setter(data)(sc, data, i, elements[i]);
-
- s7_gc_unprotect_at(sc, gc_loc);
- if (sort_func == pf_compare) s7_xf_free(sc);
- return(data);
+ while (!x) x = elements[++loc];
+ skip--;
+ x = x->next;
}
- push_stack(sc, OP_SORT_VECTOR_END, cons(sc, data, lessp), sc->code); /* save and gc protect the original homogeneous vector and func */
- set_car(args, vec);
- s7_gc_unprotect_at(sc, gc_loc);
- }
- break;
-
- case T_VECTOR:
- len = vector_length(data);
- if (len < 2)
+ if (is_pair(dest))
{
- if (sort_func == pf_compare) s7_xf_free(sc);
- return(data);
+ s7_pointer p;
+ for (i = start, p = dest; (i < end) && (is_pair(p)); i++, p = cdr(p))
+ {
+ while (!x) x = elements[++loc];
+ set_car(p, cons(sc, x->key, x->value));
+ x = x->next;
+ }
}
- if (compare_func)
+ else
{
- /* here if, for example, compare_func == string<?, we could precheck for strings,
- * then qsort without the type checks. Also common is (lambda (a b) (f (car a) (car b))).
- */
-#if (!WITH_GMP)
- if ((compare_func == g_less_2) || (compare_func == g_greater_2))
+ if (is_let(dest))
{
- int typ;
- s7_pointer *els;
- els = s7_vector_elements(data);
- typ = type(els[0]);
- if ((typ == T_INTEGER) || (typ == T_REAL))
- {
- s7_int i;
- for (i = 1; i < len; i++)
- if (type(els[i]) != typ)
- {
- typ = T_FREE;
- break;
- }
- }
- if (typ == T_INTEGER)
+ for (i = start; i < end; i++)
{
- qsort((void *)els, len, sizeof(s7_pointer), ((compare_func == g_less_2) ? int_less_2 : int_greater_2));
- return(data);
+ while (!x) x = elements[++loc];
+ if (!is_symbol(x->key))
+ return(simple_wrong_type_argument(sc, sc->copy_symbol, x->key, T_SYMBOL));
+ make_slot_1(sc, dest, x->key, x->value);
+ x = x->next;
}
- if (typ == T_REAL)
+ }
+ else
+ {
+ for (i = start, j = 0; i < end; i++, j++)
{
- qsort((void *)els, len, sizeof(s7_pointer), ((compare_func == g_less_2) ? dbl_less_2 : dbl_greater_2));
- return(data);
+ while (!x) x = elements[++loc];
+ set(sc, dest, j, cons(sc, x->key, x->value));
+ x = x->next;
}
}
-#endif
- qsort((void *)s7_vector_elements(data), len, sizeof(s7_pointer), sort_func);
- if (sort_func == pf_compare) s7_xf_free(sc);
- return(data);
+ }
+ return(dest);
+ }
+
+ case T_VECTOR:
+ if (is_float_vector(dest))
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ float_vector_element(dest, j) = real_to_double(sc, vector_element(source, i), "copy");
+ return(dest);
+ }
+ if (is_int_vector(dest))
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ {
+ s7_pointer val;
+ val = vector_element(source, i);
+ if (!s7_is_integer(val))
+ s7_wrong_type_arg_error(sc, "copy", 3, val, "an integer");
+ int_vector_element(dest, j) = s7_integer(val);
+ }
+ return(dest);
}
break;
- default:
- method_or_bust_with_type(sc, data, sc->sort_symbol, args, a_sequence_string, 1);
- }
- if (sort_func == pf_compare) s7_xf_free(sc);
+ case T_FLOAT_VECTOR:
+ if (is_int_vector(dest))
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ int_vector_element(dest, j) = (s7_int)(float_vector_element(source, i));
+ return(dest);
+ }
+ if (is_normal_vector(dest))
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ vector_element(dest, j) = make_real(sc, float_vector_element(source, i));
+ return(dest);
+ }
+ break;
- n = len - 1;
- k = ((int)(n / 2)) + 1;
+ case T_INT_VECTOR:
+ if (is_float_vector(dest))
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ float_vector_element(dest, j) = (s7_double)(int_vector_element(source, i));
+ return(dest);
+ }
+ if (is_string(dest)) /* includes byte-vector, as below */
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ string_value(dest)[j] = (unsigned char)int_vector_element(source, i);
+ return(dest);
+ }
+ if (is_normal_vector(dest))
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ vector_element(dest, j) = s7_make_integer(sc, int_vector_element(source, i));
+ return(dest);
+ }
+ break;
- lx = s7_make_vector(sc, (sc->safety == 0) ? 4 : 6);
- gc_loc = s7_gc_protect(sc, lx);
- sc->v = lx;
+ case T_STRING:
+ if (is_normal_vector(dest))
+ {
+ if (is_byte_vector(source))
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ vector_element(dest, j) = make_integer(sc, (s7_int)((unsigned char)string_value(source)[i]));
+ }
+ else
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ vector_element(dest, j) = s7_make_character(sc, (unsigned char)string_value(source)[i]);
+ }
+ return(dest);
+ }
+ if (is_int_vector(dest))
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ int_vector_element(dest, j) = (s7_int)((unsigned char)(string_value(source)[i]));
+ return(dest);
+ }
+ if (is_float_vector(dest))
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ float_vector_element(dest, j) = (s7_double)((unsigned char)(string_value(source)[i]));
+ return(dest);
+ }
+ }
- vector_element(lx, 0) = make_mutable_integer(sc, n);
- vector_element(lx, 1) = make_mutable_integer(sc, k);
- vector_element(lx, 2) = make_mutable_integer(sc, 0);
- vector_element(lx, 3) = make_mutable_integer(sc, 0);
- if (sc->safety != 0)
+ if (is_pair(dest))
{
- vector_element(lx, 4) = make_mutable_integer(sc, 0);
- vector_element(lx, 5) = make_integer(sc, n * n);
+ s7_pointer p;
+ for (i = start, p = dest; (i < end) && (is_pair(p)); i++, p = cdr(p))
+ set_car(p, get(sc, source, i));
}
- push_stack(sc, OP_SORT, args, lx);
- s7_gc_unprotect_at(sc, gc_loc);
-
- return(sc->F);
- /* if the comparison function waffles, sort! can hang: (sort! '(1 2 3) (lambda (a b) (= a b)))
- * set 'safety to 1 to add a check for this loop, but the "safe" procedures are direct, so unchecked.
+ else
+ {
+ /* if source == dest here, we're moving data backwards, so this is safe in either case */
+ if (is_string(dest)) set_string_error_source(sc, source);
+ for (i = start, j = 0; i < end; i++, j++)
+ set(sc, dest, j, get(sc, source, i));
+ }
+ /* some choices probably should raise an error, but don't:
+ * (copy (make-hash-table) "1") ; nothing to copy (empty hash table), so no error
*/
+ return(dest);
}
-static s7_pointer c_sort_p(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_sort(sc, set_plist_2(sc, x, y)));}
-PF2_TO_PF(sort, c_sort_p)
+#define g_copy s7_copy
-/* these are for the eval sort -- sort a vector, then if necessary put that data into the original sequence */
-static s7_pointer vector_into_list(s7_pointer vect, s7_pointer lst)
+/* -------------------------------- reverse -------------------------------- */
+
+static s7_pointer g_reverse(s7_scheme *sc, s7_pointer args)
{
- s7_pointer p;
- s7_pointer *elements;
- int i, len;
+ #define H_reverse "(reverse lst) returns a list with the elements of lst in reverse order. reverse \
+also accepts a string or vector argument."
+ #define Q_reverse s7_make_signature(sc, 2, sc->is_sequence_symbol, sc->is_sequence_symbol)
- elements = s7_vector_elements(vect);
- len = vector_length(vect);
- for (i = 0, p = lst; i < len; i++, p = cdr(p))
- set_car(p, elements[i]);
- return(lst);
-}
+ s7_pointer p, np;
-static s7_pointer vector_into_fi_vector(s7_pointer source, s7_pointer dest)
-{
- s7_pointer *elements;
- int i, len;
+ p = car(args);
+ sc->temp3 = p;
+ np = sc->nil;
- elements = s7_vector_elements(source);
- len = vector_length(source);
-
- if (is_float_vector(dest))
- {
- s7_double *flts;
- flts = float_vector_elements(dest);
- for (i = 0; i < len; i++)
- flts[i] = real(elements[i]);
- }
- else
+ switch (type(p))
{
- s7_int *ints;
- ints = int_vector_elements(dest);
- for (i = 0; i < len; i++)
- ints[i] = integer(elements[i]);
+ case T_NIL:
+ return(sc->nil);
+
+ case T_PAIR:
+ return(s7_reverse(sc, p));
+
+ case T_STRING:
+ {
+ char *source, *dest, *end;
+ int len;
+ len = string_length(p);
+ source = string_value(p);
+ end = (char *)(source + len);
+ dest = (char *)malloc((len + 1) * sizeof(char));
+ dest[len] = 0;
+ np = make_string_uncopied_with_length(sc, dest, len);
+ dest += len;
+ while (source < end) *(--dest) = *source++;
+ if (is_byte_vector(p))
+ set_byte_vector(np);
+ }
+ break;
+
+ case T_INT_VECTOR:
+ {
+ s7_int *source, *dest, *end;
+ s7_int len;
+ len = vector_length(p);
+ if (vector_rank(p) > 1)
+ np = g_make_vector_1(sc, set_plist_3(sc, g_vector_dimensions(sc, set_plist_1(sc, p)), small_int(0), sc->T), sc->make_int_vector_symbol);
+ else np = make_vector_1(sc, len, NOT_FILLED, T_INT_VECTOR);
+ source = int_vector_elements(p);
+ end = (s7_int *)(source + len);
+ dest = (s7_int *)(int_vector_elements(np) + len);
+ while (source < end) *(--dest) = *source++;
+ }
+ break;
+
+ case T_FLOAT_VECTOR:
+ {
+ s7_double *source, *dest, *end;
+ s7_int len;
+ len = vector_length(p);
+ if (vector_rank(p) > 1)
+ np = g_make_vector_1(sc, set_plist_3(sc, g_vector_dimensions(sc, set_plist_1(sc, p)), real_zero, sc->T), sc->make_float_vector_symbol);
+ else np = make_vector_1(sc, len, NOT_FILLED, T_FLOAT_VECTOR);
+ source = float_vector_elements(p);
+ end = (s7_double *)(source + len);
+ dest = (s7_double *)(float_vector_elements(np) + len);
+ while (source < end) *(--dest) = *source++;
+ }
+ break;
+
+ case T_VECTOR:
+ {
+ s7_pointer *source, *dest, *end;
+ s7_int len;
+ len = vector_length(p);
+ if (vector_rank(p) > 1)
+ np = g_make_vector(sc, set_plist_1(sc, g_vector_dimensions(sc, set_plist_1(sc, p))));
+ else np = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
+ source = vector_elements(p);
+ end = (s7_pointer *)(source + len);
+ dest = (s7_pointer *)(vector_elements(np) + len);
+ while (source < end) *(--dest) = *source++;
+ }
+ break;
+
+ case T_HASH_TABLE:
+ return(hash_table_reverse(sc, p));
+
+ case T_C_OBJECT:
+ check_method(sc, p, sc->reverse_symbol, args);
+ if (c_object_reverse(p))
+ return((*(c_object_reverse(p)))(sc, args));
+ eval_error(sc, "attempt to reverse ~S?", p);
+
+ default:
+ method_or_bust_with_type_one_arg(sc, p, sc->reverse_symbol, args, a_sequence_string);
}
- return(dest);
+ return(np);
}
-static s7_pointer vector_into_string(s7_pointer vect, s7_pointer dest)
+static s7_pointer g_reverse_in_place(s7_scheme *sc, s7_pointer args)
{
- s7_pointer *elements;
- int i, len;
- unsigned char *str;
+ s7_pointer p;
+ #define H_reverse_in_place "(reverse! lst) reverses lst in place"
+ #define Q_reverse_in_place s7_make_signature(sc, 2, sc->is_sequence_symbol, sc->is_sequence_symbol)
- elements = s7_vector_elements(vect);
- len = vector_length(vect);
- str = (unsigned char *)string_value(dest);
-
- if (is_byte_vector(dest))
- {
- for (i = 0; i < len; i++)
- str[i] = (unsigned char)integer(elements[i]);
- }
- else
+ p = car(args);
+
+ if ((sc->safety > NO_SAFETY) &&
+ (is_immutable(p)))
+ return(s7_error(sc, sc->error_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't reverse! ~S (it is immutable)"), p)));
+
+ switch (type(p))
{
- for (i = 0; i < len; i++)
- str[i] = character(elements[i]);
- }
- return(dest);
-}
+ case T_NIL:
+ return(sc->nil);
+
+ case T_PAIR:
+ {
+ s7_pointer np;
+ np = reverse_in_place(sc, sc->nil, p);
+ if (is_null(np))
+ return(simple_wrong_type_argument_with_type(sc, sc->reverseb_symbol, p, a_proper_list_string));
+ return(np);
+ }
+ break;
+ /* (reverse! p) is supposed to change p directly and lisp programmers expect reverse! to be fast
+ * so in a sense this is different from the other cases: it assumes (set! p (reverse! p))
+ * To make (reverse! p) direct:
+ * for (l = p, r = cdr(p); is_pair(r); l = r, r = cdr(r)) opt1(r) = l;
+ * if (!is_null(r)) return(simple_wrong_type_argument_with_type(sc, sc->reverseb_symbol, p, a_proper_list_string));
+ * for (r = l, l = p; l != r; l = cdr(l)) {t = car(l); set_car(l, car(r)); set_car(r, t); if (cdr(l) != r) r = opt1(r);}
+ */
+ case T_STRING:
+ {
+ int len;
+ char *s1, *s2;
+ len = string_length(p);
+ if (len < 2) return(p);
+ s1 = string_value(p);
+ s2 = (char *)(s1 + len - 1);
+ while (s1 < s2) {char c; c = *s1; *s1++ = *s2; *s2-- = c;}
+ }
+ break;
+ case T_INT_VECTOR:
+ {
+ s7_int len;
+ s7_int *s1, *s2;
+ len = vector_length(p);
+ if (len < 2) return(p);
+ s1 = int_vector_elements(p);
+ s2 = (s7_int *)(s1 + len - 1);
+ while (s1 < s2) {s7_int c; c = *s1; *s1++ = *s2; *s2-- = c;}
+ }
+ break;
-/* -------- hash tables -------- */
+ case T_FLOAT_VECTOR:
+ {
+ s7_int len;
+ s7_double *s1, *s2;
+ len = vector_length(p);
+ if (len < 2) return(p);
+ s1 = float_vector_elements(p);
+ s2 = (s7_double *)(s1 + len - 1);
+ while (s1 < s2) {s7_double c; c = *s1; *s1++ = *s2; *s2-- = c;}
+ }
+ break;
-static hash_entry_t *hash_free_list = NULL;
+ case T_VECTOR:
+ {
+ s7_int len;
+ s7_pointer *s1, *s2;
+ len = vector_length(p);
+ if (len < 2) return(p);
+ s1 = vector_elements(p);
+ s2 = (s7_pointer *)(s1 + len - 1);
+ while (s1 < s2) {s7_pointer c; c = *s1; *s1++ = *s2; *s2-- = c;}
+ }
+ break;
-static void free_hash_table(s7_pointer table)
+ default:
+ if ((is_simple_sequence(p)) &&
+ (!has_methods(p)))
+ return(simple_wrong_type_argument_with_type(sc, sc->reverseb_symbol, p, make_string_wrapper(sc, "a vector, string, or list")));
+ method_or_bust_with_type_one_arg(sc, p, sc->reverseb_symbol, list_1(sc, p), a_sequence_string);
+ }
+ return(p);
+}
+
+
+/* -------------------------------- fill! -------------------------------- */
+
+static s7_pointer pair_fill(s7_scheme *sc, s7_pointer args)
{
- hash_entry_t **entries;
- entries = hash_table_elements(table);
+ /* ambiguous ("tree-fill"?) but if it's like vector-fill, we just stomp on the top level */
+ s7_pointer x, y, obj, val, p;
+ s7_int i, start = 0, end, len;
- if (hash_table_entries(table) > 0)
+ obj = car(args);
+ if ((sc->safety > NO_SAFETY) &&
+ (is_immutable_pair(obj)))
+ return(s7_error(sc, sc->error_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't fill! ~S (it is immutable)"), obj)));
+
+ val = cadr(args);
+ len = s7_list_length(sc, obj);
+ end = len;
+ if (end < 0) end = -end; else {if (end == 0) end = 123123123;}
+ if (!is_null(cddr(args)))
{
- unsigned int i, len;
- len = hash_table_mask(table) + 1;
- for (i = 0; i < len; i++)
- {
- hash_entry_t *p, *n;
- for (p = entries[i++]; p; p = n)
- {
- n = p->next;
- p->next = hash_free_list;
- hash_free_list = p;
- }
- for (p = entries[i]; p; p = n)
- {
- n = p->next;
- p->next = hash_free_list;
- hash_free_list = p;
- }
- }
+ p = start_and_end(sc, sc->fill_symbol, sc->fill_symbol, cddr(args), args, 3, &start, &end);
+ if (p != sc->gc_nil) return(p);
+ if (start == end) return(val);
+ }
+ if (len > 0)
+ {
+ s7_int i;
+ if (end < len) len = end;
+ for (i = 0, p = obj; i < start; p = cdr(p), i++);
+ for (; i < len; p = cdr(p), i++) set_car(p, val);
+ return(val);
}
- free(entries);
-}
-static hash_entry_t *make_hash_entry(s7_pointer key, s7_pointer value, unsigned int raw_hash)
-{
- hash_entry_t *p;
- if (hash_free_list)
+ for (x = obj, y = obj, i = 0; ;i++)
{
- p = hash_free_list;
- hash_free_list = p->next;
+ if ((end > 0) && (i >= end))
+ return(val);
+ if (i >= start) set_car(x, val);
+ if (!is_pair(cdr(x)))
+ {
+ if (!is_null(cdr(x)))
+ set_cdr(x, val);
+ return(val);
+ }
+ x = cdr(x);
+ if ((i & 1) != 0) y = cdr(y);
+ if (x == y)
+ return(val);
}
- else p = (hash_entry_t *)malloc(sizeof(hash_entry_t));
- p->key = key;
- p->value = value;
- p->raw_hash = raw_hash;
- return(p);
+ return(val);
}
-/* -------------------------------- hash-table? -------------------------------- */
-bool s7_is_hash_table(s7_pointer p)
-{
- return(is_hash_table(p));
-}
-
-static s7_pointer g_is_hash_table(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_fill(s7_scheme *sc, s7_pointer args)
{
- #define H_is_hash_table "(hash-table? obj) returns #t if obj is a hash-table"
- #define Q_is_hash_table pl_bt
- check_boolean_method(sc, is_hash_table, sc->is_hash_table_symbol, args);
-}
+ #define H_fill "(fill! obj val (start 0) end) fills obj with val"
+ #define Q_fill s7_make_circular_signature(sc, 3, 4, sc->T, sc->is_sequence_symbol, sc->T, sc->is_integer_symbol)
+ s7_pointer p;
+ p = car(args);
+ switch (type(p))
+ {
+ case T_STRING:
+ return(g_string_fill(sc, args)); /* redundant type check here and below */
-/* -------------------------------- hash-table-entries -------------------------------- */
-static s7_pointer g_hash_table_entries(s7_scheme *sc, s7_pointer args)
-{
- #define H_hash_table_entries "(hash-table-entries obj) returns the number of entries in the hash-table obj"
- #define Q_hash_table_entries s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_hash_table_symbol)
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ return(g_vector_fill(sc, args));
- if (!is_hash_table(car(args)))
- method_or_bust(sc, car(args), sc->hash_table_entries_symbol, args, T_HASH_TABLE, 0);
- return(make_integer(sc, hash_table_entries(car(args))));
-}
+ case T_PAIR:
+ return(pair_fill(sc, args));
-static s7_int c_hash_table_entries(s7_scheme *sc, s7_pointer p)
-{
- if (!is_hash_table(p))
- int_method_or_bust(sc, p, sc->hash_table_entries_symbol, set_plist_1(sc, p), T_HASH_TABLE, 0);
- return(hash_table_entries(p));
-}
+ case T_NIL:
+ return(cadr(args)); /* this parallels the empty vector case */
-PF_TO_IF(hash_table_entries, c_hash_table_entries)
+ case T_HASH_TABLE:
+ return(hash_table_fill(sc, args));
+ case T_LET:
+ check_method(sc, p, sc->fill_symbol, args);
+ return(let_fill(sc, args));
-/* ---------------- mappers ---------------- */
-static unsigned int hash_float_location(s7_double x)
-{
- int loc;
-#if defined(__clang__)
- if ((is_inf(x)) || (is_NaN(x))) return(0);
-#endif
- x = fabs(x);
- if (x < 100.0)
- loc = 1000.0 * x; /* this means hash_table_float_epsilon only works if it is less than about .001 */
- else loc = x;
+ case T_C_OBJECT:
+ check_method(sc, p, sc->fill_symbol, args);
+ if (c_object_fill(p))
+ return((*(c_object_fill(p)))(sc, args));
+ eval_error(sc, "attempt to fill ~S?", p);
- if (loc < 0)
- return(0);
- return(loc);
+ default:
+ check_method(sc, p, sc->fill_symbol, args);
+ }
+ return(wrong_type_argument_with_type(sc, sc->fill_symbol, 1, p, a_sequence_string)); /* (fill! 1 0) */
}
-/* built in hash loc tables for eq? eqv? equal? morally-equal? = string=? string-ci=? char=? char-ci=? (default=equal?) */
-
-#define hash_loc(Sc, Table, Key) (*(hash_table_mapper(Table)[type(Key)]))(Sc, Table, Key)
+#define g_fill s7_fill
+/* perhaps (fill iterator obj) could fill the underlying sequence (if any) -- not let/closure
+ * similarly for length, reverse etc
+ */
-static hash_map_t *eq_hash_map, *eqv_hash_map, *string_eq_hash_map, *number_eq_hash_map, *char_eq_hash_map, *closure_hash_map;
-static hash_map_t *morally_equal_hash_map, *c_function_hash_map;
-#if (!WITH_PURE_S7)
-static hash_map_t *string_ci_eq_hash_map, *char_ci_eq_hash_map;
-#endif
-static unsigned int hash_map_nil(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(type(key));}
-static unsigned int hash_map_int(s7_scheme *sc, s7_pointer table, s7_pointer key) {return((unsigned int)(s7_int_abs(integer(key))));}
-static unsigned int hash_map_char(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(character(key));}
-static unsigned int hash_map_ratio(s7_scheme *sc, s7_pointer table, s7_pointer key) {return((unsigned int)denominator(key));} /* overflow possible as elsewhere */
-static unsigned int hash_map_complex(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(hash_float_location(real_part(key)));}
-static unsigned int hash_map_symbol(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(symbol_hmap(key));}
-static unsigned int hash_map_syntax(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(symbol_hmap(syntax_symbol(key)));}
+/* -------------------------------- append -------------------------------- */
-#if WITH_GMP
-static unsigned int hash_map_big_int(s7_scheme *sc, s7_pointer table, s7_pointer key)
+static s7_int sequence_length(s7_scheme *sc, s7_pointer lst)
{
- return((unsigned int)(big_integer_to_s7_int(big_integer(key))));
+ switch (type(lst))
+ {
+ case T_PAIR:
+ {
+ int len;
+ len = s7_list_length(sc, lst);
+ if (len == 0) return(-1);
+ return(len);
+ }
+ case T_NIL: return(0);
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR: return(vector_length(lst));
+ case T_STRING: return(string_length(lst));
+ case T_HASH_TABLE: return(hash_table_entries(lst));
+ case T_LET: return(let_length(sc, lst));
+ case T_C_OBJECT:
+ {
+ s7_pointer x;
+ x = object_length(sc, lst);
+ if (s7_is_integer(x))
+ return(s7_integer(x));
+ }
+ }
+ return(-1);
}
-static unsigned int hash_map_big_ratio(s7_scheme *sc, s7_pointer table, s7_pointer key)
+static s7_int total_sequence_length(s7_scheme *sc, s7_pointer args, s7_pointer caller, int typ)
{
- return((unsigned int)(big_integer_to_s7_int(mpq_denref(big_ratio(key)))));
-}
+ s7_pointer p;
+ int i;
+ s7_int len = 0;
-static unsigned int hash_map_big_real(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- return((unsigned int)mpfr_get_d(big_real(key), GMP_RNDN));
+ for (i = 1, p = args; is_pair(p); p = cdr(p), i++)
+ {
+ s7_pointer seq;
+ s7_int n;
+ seq = car(p);
+ n = sequence_length(sc, seq);
+ if ((n > 0) &&
+ (typ != T_FREE) &&
+ ((type(seq) == T_HASH_TABLE) || /* can't append hash-tables (no obvious meaning to the operation) */
+ ((type(seq) == T_LET) && /* similarly for lets, unless this is a mock-string or something similar */
+ ((!has_methods(seq)) || (find_method(sc, seq, caller) == sc->undefined)))))
+ {
+ wrong_type_argument(sc, caller, i, seq, typ);
+ return(0);
+ }
+ if (n < 0)
+ {
+ wrong_type_argument_with_type(sc, caller, i, seq, (is_pair(seq)) ? a_proper_list_string : a_sequence_string);
+ return(0);
+ }
+ len += n;
+ }
+ return(len);
}
-static unsigned int hash_map_big_complex(s7_scheme *sc, s7_pointer table, s7_pointer key)
+static s7_pointer vector_append(s7_scheme *sc, s7_pointer args, int typ)
{
- return((unsigned int)mpfr_get_d(mpc_realref(big_complex(key)), GMP_RNDN));
-}
-#endif
+ s7_pointer new_vec;
+ s7_int len;
-static unsigned int hash_map_string(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- if (string_hash(key) == 0)
- string_hash(key) = raw_string_hash((const unsigned char *)string_value(key), string_length(key));
- return(string_hash(key));
-}
+ len = total_sequence_length(sc, args, sc->vector_append_symbol, (typ == T_VECTOR) ? T_FREE : ((typ == T_FLOAT_VECTOR) ? T_REAL : T_INTEGER));
+ new_vec = make_vector_1(sc, len, (typ == T_VECTOR) ? FILLED : NOT_FILLED, typ); /* might hit GC in loop below so we can't use NOT_FILLED here */
-#if (!WITH_PURE_S7)
-static unsigned int hash_map_ci_char(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(upper_character(key));}
+ if (len > 0)
+ {
+ s7_pointer p, sv;
+ int i;
-static unsigned int hash_map_ci_string(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- int len;
- len = string_length(key);
- if (len == 0) return(0);
- return(len + (uppers[(int)(string_value(key)[0])] << 4));
-}
-#endif
+ sc->temp9 = new_vec; /* s7_copy below can call s7_error so s7_gc_protect here is tricky -- use a preset position perhaps? */
+ sv = make_subvector(sc, new_vec);
+ sc->temp10 = sv;
-static unsigned int hash_map_real(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- return(hash_float_location(real(key)));
- /* currently 1e300 goes to most-negative-fixnum! -> 0 after logand size, I hope
- *
- * 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
- */
+ for (i = 0, p = args; is_pair(p); p = cdr(p))
+ {
+ s7_int n;
+ s7_pointer x;
+ x = car(p);
+ n = sequence_length(sc, x);
+ if (n > 0)
+ {
+ vector_length(sv) = n;
+ s7_copy(sc, set_plist_2(sc, x, sv));
+ vector_length(sv) = 0; /* so GC doesn't march off the end */
+ i += n;
+ if (typ == T_VECTOR)
+ vector_elements(sv) = (s7_pointer *)(vector_elements(new_vec) + i);
+ else
+ {
+ if (typ == T_FLOAT_VECTOR)
+ float_vector_elements(sv) = (s7_double *)(float_vector_elements(new_vec) + i);
+ else int_vector_elements(sv) = (s7_int *)(int_vector_elements(new_vec) + i);
+ }
+ }
+ }
+ set_plist_2(sc, sc->nil, sc->nil);
+ sc->temp9 = sc->nil;
+ sc->temp10 = sc->nil;
+ vector_length(sv) = 0;
+ }
+ return(new_vec);
}
-static unsigned int hash_map_real_eq(s7_scheme *sc, s7_pointer table, s7_pointer x)
+static s7_pointer string_append(s7_scheme *sc, s7_pointer args)
{
- if (real(x) < 0.0)
- return((unsigned int)(s7_round(-real(x))));
- return((unsigned int)s7_round(real(x)));
-}
+ s7_pointer new_str;
+ s7_int len;
-static unsigned int hash_map_ratio_eq(s7_scheme *sc, s7_pointer table, s7_pointer y)
-{
- s7_double x;
- x = fraction(y);
- if (x < 0.0)
- return((unsigned int)s7_round(-x));
- return((unsigned int)s7_round(x));
-}
+ len = total_sequence_length(sc, args, sc->string_append_symbol, (is_byte_vector(car(args))) ? T_INTEGER : T_CHARACTER);
+ new_str = make_empty_string(sc, len, 0);
+ if (is_byte_vector(car(args)))
+ set_byte_vector(new_str);
-static unsigned int hash_map_hash_table(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- /* hash-tables are equal if key/values match independent of table size and entry order.
- * if not using morally-equal?, hash_table_checker|mapper must also be the same.
- * Keys are supposed to be constant while keys, so a hash-table shouldn't be a key of itself.
- */
- return(hash_table_entries(key));
-}
+ if (len > 0)
+ {
+ s7_pointer p, sv;
+ int i;
-static unsigned int hash_map_int_vector(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- if (vector_length(key) == 0)
- return(0);
- if (vector_length(key) == 1)
- return((unsigned int)(s7_int_abs(int_vector_element(key, 0))));
- return((unsigned int)(vector_length(key) + s7_int_abs(int_vector_element(key, 0)) + s7_int_abs(int_vector_element(key, 1))));
-}
+ sc->temp9 = new_str;
+ sv = make_string_wrapper_with_length(sc, (const char *)string_value(new_str), len);
+ if (is_byte_vector(new_str))
+ set_byte_vector(sv);
+ sc->temp10 = sv;
-static unsigned int hash_map_float_vector(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- if (vector_length(key) == 0)
- return(0);
- if (vector_length(key) == 1)
- return(hash_float_location(float_vector_element(key, 0)));
- return((unsigned int)(vector_length(key) + hash_float_location(float_vector_element(key, 0)) + hash_float_location(float_vector_element(key, 1))));
-}
+ for (i = 0, p = args; is_pair(p); p = cdr(p))
+ {
+ s7_pointer x;
+ s7_int n;
+ x = car(p);
+ n = sequence_length(sc, x);
+ if (n > 0)
+ {
+ string_length(sv) = n;
+ s7_copy(sc, set_plist_2(sc, x, sv));
+ i += n;
+ string_value(sv) = (char *)(string_value(new_str) + i);
+ }
+ }
+ set_plist_2(sc, sc->nil, sc->nil);
+ sc->temp9 = sc->nil;
+ sc->temp10 = sc->nil;
+ string_length(sv) = 0;
+ }
-static unsigned int hash_map_vector(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- if ((vector_length(key) == 0) ||
- (is_sequence(vector_element(key, 0))))
- return(vector_length(key));
- if ((vector_length(key) == 1) ||
- (is_sequence(vector_element(key, 1))))
- return(hash_loc(sc, table, vector_element(key, 0)));
- return(vector_length(key) + hash_loc(sc, table, vector_element(key, 0)) + hash_loc(sc, table, vector_element(key, 1)));
+ return(new_str);
}
-static unsigned int hash_map_eq(s7_scheme *sc, s7_pointer table, s7_pointer key)
+static s7_pointer hash_table_append(s7_scheme *sc, s7_pointer args)
{
- int x;
- x = heap_location(key);
- if (x < 0) return(-x);
- return(x);
+ s7_pointer new_hash, p;
+ unsigned int gc_loc;
+ new_hash = s7_make_hash_table(sc, sc->default_hash_table_length);
+ gc_loc = s7_gc_protect(sc, new_hash);
+ for (p = args; is_pair(p); p = cdr(p))
+ s7_copy(sc, set_plist_2(sc, car(p), new_hash));
+ set_plist_2(sc, sc->nil, sc->nil);
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(new_hash);
}
-static unsigned int hash_map_closure(s7_scheme *sc, s7_pointer table, s7_pointer key)
+static s7_pointer let_append(s7_scheme *sc, s7_pointer args)
{
- s7_pointer f, old_e, args, body;
-
- f = hash_table_procedures_mapper(table);
- old_e = sc->envir;
- args = closure_args(f);
- body = closure_body(f);
- new_frame_with_slot(sc, closure_let(f), sc->envir, (is_symbol(car(args))) ? car(args) : caar(args), key);
- push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
- if (is_pair(cdr(body)))
- push_stack_no_args(sc, OP_BEGIN1, cdr(body));
- sc->code = car(body);
- eval(sc, OP_EVAL);
- sc->envir = old_e;
- return(integer(sc->value));
+ s7_pointer new_let, p, e;
+
+ e = car(args);
+ check_method(sc, e, sc->append_symbol, args);
+ new_let = new_frame_in_env(sc, sc->nil);
+ for (p = args; is_pair(p); p = cdr(p))
+ s7_copy(sc, set_plist_2(sc, car(p), new_let));
+ set_plist_2(sc, sc->nil, sc->nil);
+ return(new_let);
}
-static unsigned int hash_map_c_function(s7_scheme *sc, s7_pointer table, s7_pointer key)
+static s7_pointer g_append(s7_scheme *sc, s7_pointer args)
{
- s7_function f;
- f = c_function_call(hash_table_procedures_mapper(table));
- set_car(sc->t1_1, key);
- return(integer(f(sc, sc->t1_1)));
-}
+ #define H_append "(append ...) returns its argument sequences appended into one sequence"
+ #define Q_append s7_make_circular_signature(sc, 0, 1, sc->T)
+ s7_pointer a1;
-static unsigned int hash_map_let(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- /* lets are equal if same symbol/value pairs, independent of order, taking into account shadowing
- * (length (inlet 'a 1 'a 2)) = 2
- * but this counts as just one entry from equal?'s point of view, so if more than one entry, we have a problem.
- * (equal? (inlet 'a 1) (inlet 'a 3 'a 2 'a 1)) = #t
- * also currently equal? follows outlet, but that is ridiculous here, so in this case hash equal?
- * is not the same as equal? Surely anyone using lets as keys wants eq?
- */
- s7_pointer slot;
- int slots;
+ if (is_null(args)) return(sc->nil); /* (append) -> () */
+ a1 = car(args); /* first arg determines result type unless all args but last are empty (sigh) */
+ if (is_null(cdr(args))) return(a1); /* (append <anything>) -> <anything> */
- if ((key == sc->rootlet) ||
- (!is_slot(let_slots(key))))
- return(0);
- slot = let_slots(key);
- if (!is_slot(next_slot(slot)))
+ switch (type(a1))
{
- if (is_sequence(slot_value(slot))) /* avoid loop if cycles */
- return(symbol_hmap(slot_symbol(slot)));
- return(symbol_hmap(slot_symbol(slot)) + hash_loc(sc, table, slot_value(slot)));
- }
- slots = 0;
- for (; is_slot(slot); slot = next_slot(slot))
- if (!is_matched_symbol(slot_symbol(slot)))
- {
- set_match_symbol(slot_symbol(slot));
- slots++;
- }
- for (slot = let_slots(key); is_slot(slot); slot = next_slot(slot))
- clear_match_symbol(slot_symbol(slot));
+ case T_NIL:
+ case T_PAIR:
+ return(g_list_append(sc, args)); /* only list case accepts any trailing arg because dotted lists are special */
- if (slots == 1)
- {
- slot = let_slots(key);
- if (is_sequence(slot_value(slot))) /* avoid loop if cycles */
- return(symbol_hmap(slot_symbol(slot)));
- return(symbol_hmap(slot_symbol(slot)) + hash_loc(sc, table, slot_value(slot)));
+ case T_VECTOR:
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ return(vector_append(sc, args, type(a1)));
+
+ case T_STRING:
+ return(string_append(sc, args));
+
+ case T_HASH_TABLE:
+ return(hash_table_append(sc, args));
+
+ case T_LET:
+ return(let_append(sc, args));
+
+ default:
+ check_method(sc, a1, sc->append_symbol, args);
}
-
- return(slots);
+ return(wrong_type_argument_with_type(sc, sc->append_symbol, 1, a1, a_sequence_string)); /* (append 1 0) */
}
-static unsigned int hash_map_pair(s7_scheme *sc, s7_pointer table, s7_pointer key)
+static s7_pointer append_p_pp(s7_pointer p1, s7_pointer p2)
{
- /* 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
- * with stats like symbols/pairs/constants at top level, then use those to spread it out over all the locs.
- */
- s7_pointer p1;
- unsigned int loc = 0;
+ /* plist in use above */
+ s7_pointer val;
+ cur_sc->temp7 = list_2(cur_sc, p1, p2);
+ val = g_append(cur_sc, cur_sc->temp7);
+ cur_sc->temp7 = cur_sc->nil;
+ return(val);
+}
- if (!is_sequence(car(key)))
- loc = hash_loc(sc, table, car(key)) + 1;
- else
- {
- if ((is_pair(car(key))) &&
- (!is_sequence(caar(key))))
- loc = hash_loc(sc, table, caar(key)) + 1;
- }
- p1 = cdr(key);
- if (is_pair(p1))
+static s7_pointer append_p_ppp(s7_pointer p1, s7_pointer p2, s7_pointer p3)
+{
+ s7_pointer val;
+ cur_sc->temp7 = list_3(cur_sc, p1, p2, p3);
+ val = g_append(cur_sc, cur_sc->temp7);
+ cur_sc->temp7 = cur_sc->nil;
+ return(val);
+}
+
+static s7_pointer object_to_list(s7_scheme *sc, s7_pointer obj)
+{
+ /* used only in format_to_port_1 and (map values ...) */
+ switch (type(obj))
{
- if (!is_sequence(car(p1)))
- loc += hash_loc(sc, table, car(p1)) + 1;
- else
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ return(s7_vector_to_list(sc, obj));
+
+ case T_STRING:
+ if (is_byte_vector(obj))
+ return(byte_vector_to_list(sc, string_value(obj), string_length(obj)));
+ return(s7_string_to_list(sc, string_value(obj), string_length(obj)));
+
+ case T_HASH_TABLE:
+ if (hash_table_entries(obj) > 0)
{
- if ((is_pair(car(p1))) &&
- (!is_sequence(caar(p1))))
- loc += hash_loc(sc, table, caar(p1)) + 1;
+ s7_pointer x, iterator;
+ iterator = s7_make_iterator(sc, obj);
+ sc->temp8 = iterator;
+ sc->w = sc->nil;
+ while (true)
+ {
+ x = s7_iterate(sc, iterator);
+ if (iterator_is_at_end(iterator)) break;
+ sc->w = cons(sc, x, sc->w);
+ }
+ x = sc->w;
+ sc->w = sc->nil;
+ sc->temp8 = sc->nil;
+ return(x);
}
- }
- return(loc);
-}
+ return(sc->nil);
+
+ case T_LET:
+#if (!WITH_PURE_S7)
+ check_method(sc, obj, sc->let_to_list_symbol, list_1(sc, obj));
+#endif
+ return(s7_let_to_list(sc, obj));
+ case T_ITERATOR:
+ {
+ s7_pointer result, p = NULL;
+ int results = 0;
+ result = sc->nil;
+ while (true)
+ {
+ s7_pointer val;
+ val = s7_iterate(sc, obj);
+ if ((val == sc->ITERATOR_END) &&
+ (iterator_is_at_end(obj)))
+ {
+ sc->temp8 = sc->nil;
+ return(result);
+ }
+ if (sc->safety > NO_SAFETY)
+ {
+ results++;
+ if (results > 10000)
+ {
+ fprintf(stderr, "iterator in object->list is creating a very long list!\n");
+ results = S7_LONG_MIN;
+ }
+ }
+ if (val != sc->no_value)
+ {
+ if (is_null(result))
+ {
+ if (is_multiple_value(val))
+ {
+ result = multiple_value(val);
+ clear_multiple_value(val);
+ for (p = result; is_pair(cdr(p)); p = cdr(p));
+ }
+ else
+ {
+ result = cons(sc, val, sc->nil);
+ p = result;
+ }
+ sc->temp8 = result;
+ }
+ else
+ {
+ if (is_multiple_value(val))
+ {
+ set_cdr(p, multiple_value(val));
+ clear_multiple_value(val);
+ for (; is_pair(cdr(p)); p = cdr(p));
+ }
+ else
+ {
+ set_cdr(p, cons(sc, val, sc->nil));
+ p = cdr(p);
+ }
+ }
+ }
+ }
+ }
-/* ---------------- checkers ---------------- */
-static hash_entry_t *hash_empty(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- return(NULL);
-}
+ case T_C_OBJECT:
+ {
+ long int i, len; /* the "long" matters on 64-bit machines */
+ s7_pointer x, z, result;
+ unsigned int gc_z;
+ x = object_length(sc, obj);
+ if (s7_is_integer(x))
+ len = s7_integer(x);
+ else return(sc->F);
-static hash_entry_t *hash_int(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- if (is_integer(key))
- {
- s7_int keyval;
- hash_entry_t *x;
- unsigned int loc, hash_len;
+ if (len < 0)
+ return(sc->F);
+ if (len == 0)
+ return(sc->nil);
- hash_len = hash_table_mask(table);
- keyval = integer(key);
- if (keyval < 0)
- loc = (unsigned int)((-keyval) & hash_len);
- else loc = (unsigned int)(keyval & hash_len);
- /* I think this assumes hash_map_int is using s7_int_abs (and high order bits are ignored) */
+ result = make_list(sc, len, sc->nil);
+ sc->temp8 = result;
+ z = list_1(sc, sc->F);
+ gc_z = s7_gc_protect(sc, z);
- for (x = hash_table_element(table, loc); x; x = x->next)
- if (integer(x->key) == keyval)
- return(x);
+ set_car(sc->z2_1, sc->x);
+ set_car(sc->z2_2, sc->z);
+ 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));
+ }
+ sc->x = car(sc->z2_1);
+ sc->z = car(sc->z2_2);
+ s7_gc_unprotect_at(sc, gc_z);
+ sc->temp8 = sc->nil;
+ return(result);
+ }
}
- return(NULL);
+ return(obj);
}
-static hash_entry_t *hash_string(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- if (is_string(key))
- {
- hash_entry_t *x;
- unsigned int hash_len, key_len;
- unsigned long long int hash;
- const char *key_str;
-
- key_len = string_length(key);
- key_str = string_value(key);
- hash_len = hash_table_mask(table);
- if (string_hash(key) == 0)
- string_hash(key) = raw_string_hash((const unsigned char *)string_value(key), string_length(key));
- hash = string_hash(key);
+/* -------------------------------- object->let -------------------------------- */
- if (key_len <= 8)
- {
- for (x = hash_table_element(table, hash & hash_len); x; x = x->next)
- if ((hash == string_hash(x->key)) &&
- (key_len == string_length(x->key)))
- return(x);
- }
- else
- {
- for (x = hash_table_element(table, hash & hash_len); x; x = x->next)
- if ((hash == string_hash(x->key)) &&
- (key_len == string_length(x->key)) && /* these are scheme strings, so we can't assume 0=end of string */
- (strings_are_equal_with_length(key_str, string_value(x->key), key_len)))
- return(x);
- }
- }
- return(NULL);
-}
+static bool is_decodable(s7_scheme *sc, s7_pointer p);
+static s7_pointer stack_entries(s7_scheme *sc, s7_pointer stack, int top);
-#if (!WITH_PURE_S7)
-static hash_entry_t *hash_ci_string(s7_scheme *sc, s7_pointer table, s7_pointer key)
+static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args)
{
- if (is_string(key))
- {
- hash_entry_t *x;
- unsigned int hash, hash_len;
-
- hash_len = hash_table_mask(table);
- hash = hash_map_ci_string(sc, table, key);
+ #define H_object_to_let "(object->let obj) returns a let (namespace) describing obj."
+ #define Q_object_to_let s7_make_signature(sc, 2, sc->is_let_symbol, sc->T)
- for (x = hash_table_element(table, hash & hash_len); x; x = x->next)
- if (scheme_strequal_ci(key, x->key))
- return(x);
- }
- return(NULL);
-}
+ s7_pointer obj;
+ obj = car(args);
-static hash_entry_t *hash_ci_char(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- if (s7_is_character(key))
+ switch (type(obj))
{
- hash_entry_t *x;
- unsigned int hash_len, loc;
-
- hash_len = hash_table_mask(table);
- loc = hash_loc(sc, table, key) & hash_len;
+ case T_NIL:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_null_symbol)));
- for (x = hash_table_element(table, loc); x; x = x->next)
- if (upper_character(key) == upper_character(x->key))
- return(x);
- }
- return(NULL);
-}
-#endif
+ case T_UNSPECIFIED:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_unspecified_symbol)));
-static hash_entry_t *hash_float_1(s7_scheme *sc, s7_pointer table, unsigned int loc, s7_double keyval)
-{
- hash_entry_t *x;
- bool look_for_nan;
- look_for_nan = is_NaN(keyval);
+ case T_UNDEFINED:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, obj)));
- for (x = hash_table_element(table, loc); x; x = x->next)
- {
- if (is_t_real(x->key)) /* we're possibly called from hash_equal, so keys might not be T_REAL */
- {
- s7_double val;
- val = real(x->key);
- if (look_for_nan)
- {
- if (is_NaN(val))
- return(x);
- }
- else
- {
- if ((val == keyval) || /* inf case */
- (fabs(val - keyval) < sc->hash_table_float_epsilon))
- return(x);
- }
- }
- }
- return(NULL);
-}
+ case T_SYNTAX:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_syntax_symbol)));
+ case T_EOF_OBJECT:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_eof_object_symbol)));
-static hash_entry_t *hash_float(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- /* give the equality check some room. also inf == inf and nan == nan
- */
- if (type(key) == T_REAL)
- {
- s7_double keyval;
- unsigned int hash_len, loc;
+ case T_BOOLEAN:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_boolean_symbol)));
- hash_len = hash_table_mask(table);
- keyval = real(key);
- loc = hash_float_location(keyval) & hash_len;
+ case T_SYMBOL:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, (is_keyword(obj)) ? sc->is_keyword_symbol : sc->is_symbol_symbol)));
- return(hash_float_1(sc, table, loc, keyval));
- }
- return(NULL);
-}
-
-
-static hash_entry_t *hash_complex_1(s7_scheme *sc, s7_pointer table, unsigned int loc, s7_pointer key)
-{
- hash_entry_t *x;
- for (x = hash_table_element(table, loc); x; x = x->next)
- if ((is_t_complex(x->key)) &&
- (s7_is_morally_equal(sc, x->key, key)))
- return(x);
- return(NULL);
-}
-
+ case T_CHARACTER:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_char_symbol)));
+
+ case T_INTEGER:
+ case T_BIG_INTEGER:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_integer_symbol)));
+
+ case T_RATIO:
+ case T_BIG_RATIO:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_rational_symbol)));
+
+ case T_REAL:
+ case T_BIG_REAL:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_real_symbol)));
+
+ case T_COMPLEX:
+ case T_BIG_COMPLEX:
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_complex_symbol)));
-static hash_entry_t *hash_equal_real(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- return(hash_float_1(sc, table, hash_loc(sc, table, key) & hash_table_mask(table), real(key)));
-}
+ case T_STRING:
+ return(s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
+ sc->type_symbol, (is_byte_vector(obj)) ? sc->is_byte_vector_symbol : sc->is_string_symbol,
+ sc->length_symbol, s7_length(sc, obj))));
+ case T_PAIR:
+ return(s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
+ sc->type_symbol, sc->is_pair_symbol,
+ sc->length_symbol, s7_length(sc, obj))));
-static hash_entry_t *hash_equal_complex(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- return(hash_complex_1(sc, table, hash_loc(sc, table, key) & hash_table_mask(table), key));
-}
+ case T_RANDOM_STATE:
+#if WITH_GMP
+ return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_random_state_symbol)));
+#else
+ return(s7_inlet(sc, s7_list(sc, 8, sc->value_symbol, obj,
+ sc->type_symbol, sc->is_random_state_symbol,
+ s7_make_symbol(sc, "seed"), s7_make_integer(sc, random_seed(obj)),
+ s7_make_symbol(sc, "carry"), s7_make_integer(sc, random_carry(obj)))));
+#endif
+ case T_GOTO:
+ return(s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
+ sc->type_symbol, s7_make_symbol(sc, "goto?"),
+ s7_make_symbol(sc, "active"), s7_make_boolean(sc, call_exit_active(obj)))));
-static hash_entry_t *hash_equal_syntax(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- hash_entry_t *x;
- unsigned int loc;
- loc = hash_loc(sc, table, key) & hash_table_mask(table);
- for (x = hash_table_element(table, loc); x; x = x->next)
- if ((is_syntax(x->key)) &&
- (syntax_symbol(x->key) == syntax_symbol(key))) /* the opcodes might differ, but the symbols should not */
- return(x);
- return(NULL);
-}
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ return(s7_inlet(sc, s7_list(sc, 10, sc->value_symbol, obj,
+ sc->type_symbol,
+ (is_int_vector(obj)) ? sc->is_int_vector_symbol : ((is_float_vector(obj)) ? sc->is_float_vector_symbol : sc->is_vector_symbol),
+ sc->length_symbol, s7_length(sc, obj),
+ s7_make_symbol(sc, "dimensions"), g_vector_dimensions(sc, set_plist_1(sc, obj)),
+ s7_make_symbol(sc, "shared"),
+ ((vector_has_dimensional_info(obj)) && (is_normal_vector(shared_vector(obj)))) ? shared_vector(obj) : sc->F)));
+ case T_C_POINTER:
+ return(s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
+ sc->type_symbol, sc->is_c_pointer_symbol,
+ s7_make_symbol(sc, "s7-value"),
+ ((is_decodable(sc, (s7_pointer)raw_pointer(obj))) &&
+ (!is_free(obj))) ? g_object_to_let(sc, cons(sc, (s7_pointer)raw_pointer(obj), sc->nil)) : sc->F)));
-static hash_entry_t *hash_equal_eq(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- hash_entry_t *x;
- unsigned int loc;
- loc = hash_loc(sc, table, key) & hash_table_mask(table);
- for (x = hash_table_element(table, loc); x; x = x->next)
- if (x->key == key)
- return(x);
- return(NULL);
-}
+ case T_CONTINUATION:
+ {
+ s7_pointer let;
+ unsigned int gc_loc;
+ let = s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_continuation_symbol));
+ gc_loc = s7_gc_protect(sc, let);
+ s7_varlet(sc, let, s7_make_symbol(sc, "stack"), stack_entries(sc, continuation_stack(obj), continuation_stack_top(obj)));
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(let);
+ }
+ case T_ITERATOR:
+ {
+ s7_pointer let, seq;
+ seq = iterator_sequence(obj);
+ let = s7_inlet(sc, s7_list(sc, 8, sc->value_symbol, obj,
+ sc->type_symbol, sc->is_iterator_symbol,
+ s7_make_symbol(sc, "at-end"), s7_make_boolean(sc, iterator_is_at_end(obj)),
+ s7_make_symbol(sc, "sequence"), iterator_sequence(obj)));
+ if (is_pair(seq))
+ s7_varlet(sc, let, sc->length_symbol, s7_length(sc, seq));
+ else
+ {
+ if (is_hash_table(seq))
+ s7_varlet(sc, let, sc->length_symbol, s7_make_integer(sc, hash_table_entries(seq)));
+ else s7_varlet(sc, let, sc->length_symbol, s7_length(sc, obj));
+ }
+ if ((is_string(seq)) ||
+ (is_normal_vector(seq)) ||
+ (is_int_vector(seq)) ||
+ (is_float_vector(seq)) ||
+ (seq == sc->rootlet) ||
+ (is_c_object(seq)) ||
+ (is_hash_table(seq)))
+ s7_varlet(sc, let, s7_make_symbol(sc, "position"), s7_make_integer(sc, iterator_position(obj)));
+ else
+ {
+ if (is_pair(seq))
+ s7_varlet(sc, let, s7_make_symbol(sc, "position"), iterator_current(obj));
+ }
+ return(let);
+ }
-static hash_entry_t *hash_equal_any(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- hash_entry_t *x;
- unsigned int loc;
- loc = hash_loc(sc, table, key) & hash_table_mask(table);
+ case T_HASH_TABLE:
+ {
+ s7_pointer let;
+ let = s7_inlet(sc, s7_list(sc, 10, sc->value_symbol, obj,
+ sc->type_symbol, sc->is_hash_table_symbol,
+ sc->length_symbol, s7_length(sc, obj),
+ s7_make_symbol(sc, "entries"), s7_make_integer(sc, hash_table_entries(obj)),
+ s7_make_symbol(sc, "locked"), s7_make_boolean(sc, hash_table_checker_locked(obj))));
- /* 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 ((hash_table_checker(obj) == hash_eq) ||
+ (hash_table_checker(obj) == hash_c_function) ||
+ (hash_table_checker(obj) == hash_closure) ||
+ (hash_table_checker(obj) == hash_equal_eq) ||
+ (hash_table_checker(obj) == hash_equal_syntax) ||
+ (hash_table_checker(obj) == hash_symbol))
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->is_eq_symbol);
+ else
+ {
+ if (hash_table_checker(obj) == hash_eqv)
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->is_eqv_symbol);
+ else
+ {
+ if ((hash_table_checker(obj) == hash_equal) ||
+ (hash_table_checker(obj) == hash_empty))
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->is_equal_symbol);
+ else
+ {
+ if (hash_table_checker(obj) == hash_morally_equal)
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->is_morally_equal_symbol);
+ else
+ {
+ if ((hash_table_checker(obj) == hash_number) ||
+ (hash_table_checker(obj) == hash_int) ||
+ (hash_table_checker(obj) == hash_float) ||
+ (hash_table_checker(obj) == hash_equal_real) ||
+ (hash_table_checker(obj) == hash_equal_complex))
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->eq_symbol);
+ else
+ {
+ if (hash_table_checker(obj) == hash_string)
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->string_eq_symbol);
+ else
+ {
+ if (hash_table_checker(obj) == hash_char)
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->char_eq_symbol);
+#if (!WITH_PURE_S7)
+ else
+ {
+ if (hash_table_checker(obj) == hash_ci_char)
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->char_ci_eq_symbol);
+ else
+ {
+ if (hash_table_checker(obj) == hash_ci_string)
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->string_ci_eq_symbol);
+ }}
+#endif
+ }}}}}}
+ return(let);
+ }
- for (x = hash_table_element(table, loc); x; x = x->next)
- if (x->key == key)
- return(x);
+ case T_LET:
+ {
+ s7_pointer let;
+ let = s7_inlet(sc, s7_list(sc, 10, sc->value_symbol, obj,
+ sc->type_symbol, sc->is_let_symbol,
+ sc->length_symbol, s7_length(sc, obj),
+ s7_make_symbol(sc, "open"), s7_make_boolean(sc, has_methods(obj)),
+ sc->outlet_symbol, (obj == sc->rootlet) ? sc->nil : outlet(obj)));
+ if (obj == sc->rootlet)
+ s7_varlet(sc, let, s7_make_symbol(sc, "alias"), sc->rootlet_symbol);
+ else
+ {
+ if (obj == sc->owlet)
+ s7_varlet(sc, let, s7_make_symbol(sc, "alias"), sc->owlet_symbol);
+ else
+ {
+ if (is_funclet(obj))
+ {
+ s7_varlet(sc, let, s7_make_symbol(sc, "function"), funclet_function(obj));
+ if ((let_file(obj) > 0) &&
+ (let_file(obj) < (s7_int)sc->file_names_top) &&
+ (let_line(obj) > 0))
+ {
+ s7_varlet(sc, let, s7_make_symbol(sc, "file"), sc->file_names[let_file(obj)]);
+ s7_varlet(sc, let, s7_make_symbol(sc, "line"), make_integer(sc, let_line(obj)));
+ }
+ }
+ }
+ }
+ if (has_methods(obj))
+ {
+ s7_pointer func;
+ func = find_method(sc, obj, sc->object_to_let_symbol);
+ if (func != sc->undefined)
+ {
+ unsigned int gc_loc;
+ gc_loc = s7_gc_protect(sc, let);
+ s7_apply_function(sc, func, list_2(sc, obj, let));
+ s7_gc_unprotect_at(sc, gc_loc);
+ }
+ }
+ return(let);
+ }
- for (x = hash_table_element(table, loc); x; x = x->next)
- if (s7_is_equal(sc, x->key, key))
- return(x);
- return(NULL);
-}
+ case T_C_OBJECT:
+ {
+ s7_pointer let, clet;
+ clet = c_object_let(obj);
+ let = s7_inlet(sc, s7_list(sc, 12, sc->value_symbol, obj,
+ sc->type_symbol, sc->is_c_object_symbol,
+ sc->length_symbol, s7_length(sc, obj),
+ s7_make_symbol(sc, "c-type"), s7_make_integer(sc, c_object_type(obj)),
+ sc->let_symbol, clet,
+ s7_make_symbol(sc, "class"), c_object_scheme_name(obj)));
+ if ((is_let(clet)) &&
+ ((has_methods(clet)) || (has_methods(obj))))
+ {
+ s7_pointer func;
+ func = find_method(sc, clet, sc->object_to_let_symbol);
+ if (func != sc->undefined)
+ {
+ unsigned int gc_loc;
+ gc_loc = s7_gc_protect(sc, let);
+ s7_apply_function(sc, func, list_2(sc, obj, let));
+ s7_gc_unprotect_at(sc, gc_loc);
+ }
+ }
+ return(let);
+ }
+ case T_INPUT_PORT:
+ case T_OUTPUT_PORT:
+ {
+ s7_pointer let;
+ unsigned int gc_loc;
+ let = s7_inlet(sc, s7_list(sc, 8, sc->value_symbol, obj,
+ sc->type_symbol, (is_input_port(obj)) ? sc->is_input_port_symbol : sc->is_output_port_symbol,
+ s7_make_symbol(sc, "port-type"),
+ (is_string_port(obj)) ? sc->string_symbol :
+ ((is_file_port(obj)) ? s7_make_symbol(sc, "file") : s7_make_symbol(sc, "function")),
+ s7_make_symbol(sc, "closed"), s7_make_boolean(sc, port_is_closed(obj))));
+ gc_loc = s7_gc_protect(sc, let);
+ if (is_file_port(obj))
+ {
+ s7_varlet(sc, let, s7_make_symbol(sc, "file"), g_port_filename(sc, set_plist_1(sc, obj)));
+ if (is_input_port(obj))
+ s7_varlet(sc, let, s7_make_symbol(sc, "line"), g_port_line_number(sc, set_plist_1(sc, obj)));
+ }
+ if (port_data_size(obj) > 0)
+ {
+ s7_varlet(sc, let, sc->length_symbol, s7_make_integer(sc, port_data_size(obj)));
+ s7_varlet(sc, let, s7_make_symbol(sc, "position"), s7_make_integer(sc, port_position(obj)));
+ /* I think port_data need not be null-terminated, but s7_make_string assumes it is:
+ * both valgrind and lib*san complain about the uninitialized data during strlen.
+ */
+ s7_varlet(sc, let, s7_make_symbol(sc, "data"), s7_make_string_with_length(sc, (const char *)port_data(obj), port_position(obj)));
+ }
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(let);
+ }
-static hash_entry_t *(*default_hash_checks[NUM_TYPES])(s7_scheme *sc, s7_pointer table, s7_pointer key);
-static hash_entry_t *(*equal_hash_checks[NUM_TYPES])(s7_scheme *sc, s7_pointer table, s7_pointer key);
-static hash_entry_t *(*morally_equal_hash_checks[NUM_TYPES])(s7_scheme *sc, s7_pointer table, s7_pointer key);
+ case T_CLOSURE:
+ case T_CLOSURE_STAR:
+ case T_MACRO:
+ case T_MACRO_STAR:
+ case T_BACRO:
+ case T_BACRO_STAR:
+ {
+ s7_pointer let, sig;
+ const char* doc;
+ unsigned int gc_loc;
+ let = s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
+ sc->type_symbol, (is_procedure(obj)) ? sc->is_procedure_symbol : sc->is_macro_symbol,
+ s7_make_symbol(sc, "arity"), s7_arity(sc, obj)));
+ gc_loc = s7_gc_protect(sc, let);
-static hash_entry_t *hash_equal(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- return((*(equal_hash_checks[type(key)]))(sc, table, key));
-}
+ sig = s7_procedure_signature(sc, obj);
+ if (is_pair(sig))
+ s7_varlet(sc, let, sc->signature_symbol, sig);
+
+ doc = s7_procedure_documentation(sc, obj);
+ if (doc)
+ s7_varlet(sc, let, sc->documentation_symbol, s7_make_string(sc, doc));
+
+ if (is_let(closure_let(obj)))
+ {
+ s7_pointer flet;
+ flet = closure_let(obj);
+ if ((let_file(flet) > 0) &&
+ (let_file(flet) < (s7_int)sc->file_names_top) &&
+ (let_line(flet) > 0))
+ {
+ s7_varlet(sc, let, s7_make_symbol(sc, "file"), sc->file_names[let_file(flet)]);
+ s7_varlet(sc, let, s7_make_symbol(sc, "line"), make_integer(sc, let_line(flet)));
+ }
+ }
+
+ if (closure_setter(obj) != sc->F)
+ s7_varlet(sc, let, s7_make_symbol(sc, "setter"), closure_setter(obj));
-static hash_entry_t *hash_morally_equal(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- hash_entry_t *x;
- unsigned int loc;
- loc = hash_loc(sc, table, key) & hash_table_mask(table);
+ s7_varlet(sc, let, s7_make_symbol(sc, "source"),
+ append_in_place(sc, list_2(sc, (is_closure_star(obj)) ? sc->lambda_star_symbol : sc->lambda_symbol,
+ closure_args(obj)),
+ closure_body(obj)));
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(let);
+ }
- for (x = hash_table_element(table, loc); x; x = x->next)
- if (x->key == key)
- return(x);
+ case T_C_MACRO:
+ case T_C_FUNCTION_STAR:
+ case T_C_FUNCTION:
+ case T_C_ANY_ARGS_FUNCTION:
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ {
+ s7_pointer let, sig;
+ const char* doc;
+ let = s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
+ sc->type_symbol, (is_procedure(obj)) ? sc->is_procedure_symbol : sc->is_macro_symbol,
+ s7_make_symbol(sc, "arity"), s7_arity(sc, obj)));
- for (x = hash_table_element(table, loc); x; x = x->next)
- if (s7_is_morally_equal(sc, x->key, key))
- return(x);
- return(NULL);
-}
+ sig = s7_procedure_signature(sc, obj);
+ if (is_pair(sig))
+ s7_varlet(sc, let, sc->signature_symbol, sig);
+
+ doc = s7_procedure_documentation(sc, obj);
+ if (doc)
+ s7_varlet(sc, let, sc->documentation_symbol, s7_make_string(sc, doc));
-static hash_entry_t *hash_c_function(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- hash_entry_t *x;
- unsigned int hash_len, loc;
- s7_function f;
+ if (c_function_setter(obj) != sc->F)
+ s7_varlet(sc, let, s7_make_symbol(sc, "setter"), c_function_setter(obj));
+
+ return(let);
+ }
- f = c_function_call(hash_table_procedures_checker(table));
- hash_len = hash_table_mask(table);
- loc = hash_loc(sc, table, key) & hash_len;
-
- set_car(sc->t2_1, key);
- for (x = hash_table_element(table, loc); x; x = x->next)
- {
- set_car(sc->t2_2, x->key);
- if (is_true(sc, f(sc, sc->t2_1)))
- return(x);
+ default:
+#if DEBUGGING
+ fprintf(stderr, "object->let: %s, type: %d\n", DISPLAY(obj), type(obj));
+#endif
+ return(sc->F);
}
- return(NULL);
-}
-
-
-static hash_entry_t *hash_eq(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- /* explicit eq? as hash equality func or (for example) symbols as keys */
- hash_entry_t *x;
- unsigned int hash_len, loc;
-
- hash_len = hash_table_mask(table);
- loc = hash_loc(sc, table, key) & hash_len;
- for (x = hash_table_element(table, loc); x; x = x->next)
- if (key == x->key)
- return(x);
-
- return(NULL);
+ return(sc->F);
}
-static hash_entry_t *hash_eqv(s7_scheme *sc, s7_pointer table, s7_pointer key)
-{
- hash_entry_t *x;
- unsigned int hash_len, loc;
-
- hash_len = hash_table_mask(table);
- loc = hash_loc(sc, table, key) & hash_len;
-
- for (x = hash_table_element(table, loc); x; x = x->next)
- if (s7_is_eqv(key, x->key))
- return(x);
-
- return(NULL);
-}
+/* ---------------- stacktrace ---------------- */
-static hash_entry_t *hash_number(s7_scheme *sc, s7_pointer table, s7_pointer key)
+static s7_pointer stacktrace_find_caller(s7_scheme *sc, s7_pointer e)
{
- if (is_number(key))
+ if ((is_let(e)) && (e != sc->rootlet))
{
- hash_entry_t *x;
- unsigned int hash_len, loc;
-
- hash_len = hash_table_mask(table);
- loc = hash_loc(sc, table, key) & hash_len;
-
-#if (!WITH_GMP)
- for (x = hash_table_element(table, loc); x; x = x->next)
- if ((is_number(x->key)) &&
- (is_true(sc, c_equal_2_1(sc, key, x->key))))
- return(x);
-#else
- for (x = hash_table_element(table, loc); x; x = x->next)
- if ((is_number(x->key)) &&
- (is_true(sc, big_equal(sc, set_plist_2(sc, key, x->key)))))
- return(x);
-#endif
+ if (is_funclet(e))
+ return(funclet_function(e));
+ return(stacktrace_find_caller(sc, outlet(e)));
}
- return(NULL);
+ return(sc->F);
}
-static hash_entry_t *hash_symbol(s7_scheme *sc, s7_pointer table, s7_pointer key)
+static bool stacktrace_find_let(s7_scheme *sc, int loc, s7_pointer e)
{
- if (is_symbol(key))
- {
- hash_entry_t *x;
- for (x = hash_table_element(table, symbol_hmap(key) & hash_table_mask(table)); x; x = x->next)
- if (key == x->key)
- return(x);
- }
- return(NULL);
+ return((loc > 0) &&
+ ((stack_let(sc->stack, loc) == e) ||
+ (stacktrace_find_let(sc, loc - 4, e))));
}
-
-static hash_entry_t *hash_char(s7_scheme *sc, s7_pointer table, s7_pointer key)
+static int stacktrace_find_error_hook_quit(s7_scheme *sc)
{
- if (s7_is_character(key))
- return(hash_eq(sc, table, key));
- return(NULL);
+ int 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 hash_entry_t *hash_closure(s7_scheme *sc, s7_pointer table, s7_pointer key)
+static bool stacktrace_in_error_handler(s7_scheme *sc, int loc)
{
- hash_entry_t *x;
- unsigned int hash_len, loc;
- s7_pointer f, args, body, old_e;
-
- f = hash_table_procedures_checker(table);
- hash_len = hash_table_mask(table);
- loc = hash_loc(sc, table, key) & hash_len;
-
- old_e = sc->envir;
- args = closure_args(f); /* in lambda* case, car/cadr(args) can be lists */
- body = closure_body(f);
- new_frame_with_two_slots(sc, closure_let(f), sc->envir,
- (is_symbol(car(args))) ? car(args) : caar(args), key,
- (is_symbol(cadr(args))) ? cadr(args) : caadr(args), sc->F);
-
- for (x = hash_table_element(table, loc); x; x = x->next)
- {
- slot_set_value(next_slot(let_slots(sc->envir)), x->key);
- push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
- if (is_pair(cdr(body)))
- push_stack_no_args(sc, OP_BEGIN1, cdr(body));
- sc->code = car(body);
- eval(sc, OP_EVAL);
- if (is_true(sc, sc->value))
- {
- sc->envir = old_e;
- return(x);
- }
- }
- sc->envir = old_e;
- return(NULL);
+ return((outlet(sc->owlet) == sc->envir) ||
+ (stacktrace_find_let(sc, loc * 4, outlet(sc->owlet))) ||
+ (stacktrace_find_error_hook_quit(sc) > 0));
}
-static s7_pointer remove_from_hash_table(s7_scheme *sc, s7_pointer table, s7_pointer key, hash_entry_t *p)
+static bool stacktrace_error_hook_function(s7_scheme *sc, s7_pointer sym)
{
- hash_entry_t *x;
- unsigned int hash_len, loc;
-
- hash_len = hash_table_mask(table);
-#if DEBUGGING
- if (p->raw_hash != hash_loc(sc, table, key))
- fprintf(stderr, "%s[%d]: %s raw: %u, loc: %u\n", __func__, __LINE__, DISPLAY(key), p->raw_hash, hash_loc(sc, table, key));
-#endif
- loc = p->raw_hash & hash_len;
-
-
- x = hash_table_element(table, loc);
- if (x == p)
- hash_table_element(table, loc) = x->next;
- else
+ if (is_symbol(sym))
{
- hash_entry_t *y;
- for (y = x, x = x->next; x; y = x, x = x->next)
- if (x == p)
- {
- y->next = x->next;
- break;
- }
+ s7_pointer f;
+ f = s7_symbol_value(sc, sym);
+ return((is_procedure(f)) &&
+ (is_procedure(sc->error_hook)) &&
+ (hook_has_functions(sc->error_hook)) &&
+ (direct_memq(f, s7_hook_functions(sc, sc->error_hook))));
}
- hash_table_entries(table)--;
- if ((hash_table_entries(table) == 0) &&
- (!hash_table_checker_locked(table)))
- hash_table_checker(table) = hash_empty;
- x->next = hash_free_list;
- hash_free_list = x;
- return(sc->F);
+ return(false);
}
-/* -------------------------------- make-hash-table -------------------------------- */
-
-s7_pointer s7_make_hash_table(s7_scheme *sc, s7_int size)
+static char *stacktrace_walker(s7_scheme *sc, s7_pointer code, s7_pointer e,
+ char *notes, unsigned int gc_syms,
+ int code_cols, int total_cols, int notes_start_col,
+ bool as_comment)
{
- s7_pointer table;
- hash_entry_t **els;
- /* size is rounded up to the next power of 2 */
+ s7_pointer syms;
+ syms = gc_protected_at(sc, gc_syms);
- if ((size == 0) || /* already 2^n ? */
- ((size & (size - 1)) != 0))
+ if (is_symbol(code))
{
- if ((size & (size + 1)) != 0) /* already 2^n - 1 ? */
+ if ((!direct_memq(code, syms)) &&
+ (!is_slot(global_slot(code))))
{
- size--;
- size |= (size >> 1);
- size |= (size >> 2);
- size |= (size >> 4);
- size |= (size >> 8);
- size |= (size >> 16);
- if (s7_int_bits > 31) /* this is either 31 or 63 */
- size |= (size >> 32);
- }
- size++;
- }
-
- els = (hash_entry_t **)calloc(size, sizeof(hash_entry_t *));
- if (!els) return(s7_error(sc, make_symbol(sc, "out-of-memory"), set_elist_1(sc, make_string_wrapper(sc, "make-hash-table allocation failed!"))));
-
- new_cell(sc, table, T_HASH_TABLE | T_SAFE_PROCEDURE);
- hash_table_mask(table) = size - 1;
- hash_table_elements(table) = els;
- hash_table_checker(table) = hash_empty;
- hash_table_mapper(table) = default_hash_map;
- hash_table_entries(table) = 0;
- hash_table_set_procedures(table, sc->nil);
- add_hash_table(sc, table);
-
- return(table);
-}
-
-static s7_pointer g_is_equal(s7_scheme *sc, s7_pointer args);
-static s7_pointer g_is_morally_equal(s7_scheme *sc, s7_pointer args);
+ s7_pointer val;
-static s7_pointer g_make_hash_table(s7_scheme *sc, s7_pointer args)
-{
- #define H_make_hash_table "(make-hash-table (size 511) eq-func) returns a new hash table"
- #define Q_make_hash_table s7_make_signature(sc, 3, sc->is_hash_table_symbol, sc->is_integer_symbol, s7_make_signature(sc, 2, sc->is_procedure_symbol, sc->is_pair_symbol))
+ syms = cons(sc, code, syms);
+ gc_protected_at(sc, gc_syms) = syms;
- s7_int size;
- size = sc->default_hash_table_length;
+ val = s7_symbol_local_value(sc, code, e);
+ if ((val) && (val != sc->undefined) &&
+ (!is_any_macro(val)))
+ {
+ int typ;
- if (is_not_null(args))
- {
- s7_pointer p;
- p = car(args);
- if (!s7_is_integer(p))
- {
- s7_pointer p1;
- if (!s7_is_integer(p1 = check_values(sc, p, args)))
- method_or_bust(sc, p, sc->make_hash_table_symbol, args, T_INTEGER, 1);
- p = p1;
- }
- size = s7_integer(p);
- if (size <= 0) /* we need s7_int here to catch (make-hash-table most-negative-fixnum) etc */
- return(simple_out_of_range(sc, sc->make_hash_table_symbol, p, make_string_wrapper(sc, "should be a positive integer")));
- if (size > sc->max_vector_length)
- return(simple_out_of_range(sc, sc->make_hash_table_symbol, p, its_too_large_string));
+ typ = type(val);
+ if (typ < T_GOTO)
+ {
+ char *objstr, *str;
+ const char *spaces;
+ int objlen, new_note_len, notes_max, cur_line_len = 0, spaces_len;
+ bool new_notes_line = false, old_short_print;
+ s7_int old_len;
- if (is_not_null(cdr(args)))
- {
- s7_pointer ht, proc;
- proc = cadr(args);
+ spaces = " ";
+ spaces_len = strlen(spaces);
- if (is_c_function(proc))
- {
- if (!s7_is_aritable(sc, proc, 2))
- return(wrong_type_argument_with_type(sc, sc->make_hash_table_symbol, 3, proc, an_eq_func_string));
+ if (notes_start_col < 0) notes_start_col = 50;
+ if (notes_start_col > total_cols) notes_start_col = 0;
+ notes_max = total_cols - notes_start_col;
- ht = s7_make_hash_table(sc, size);
- if (c_function_call(proc) == g_is_equal)
- return(ht);
- if (c_function_call(proc) == g_is_eq)
- {
- hash_table_checker(ht) = hash_eq;
- hash_table_mapper(ht) = eq_hash_map;
- }
- else
- {
- if (c_function_call(proc) == g_strings_are_equal)
+ old_short_print = sc->short_print;
+ sc->short_print = true;
+ old_len = sc->print_length;
+ if (sc->print_length > 4) sc->print_length = 4;
+ objstr = s7_object_to_c_string(sc, val);
+ objlen = safe_strlen(objstr);
+ if ((objlen > notes_max) &&
+ (notes_max > 5))
{
- hash_table_checker(ht) = hash_string;
- hash_table_mapper(ht) = string_eq_hash_map;
+ objstr[notes_max - 4] = '.';
+ objstr[notes_max - 3] = '.';
+ objstr[notes_max - 2] = '.';
+ objstr[notes_max - 1] = '\0';
+ objlen = notes_max;
}
+ sc->short_print = old_short_print;
+ sc->print_length = old_len;
+
+ new_note_len = symbol_name_length(code) + 3 + objlen;
+ /* we want to append this much info to the notes, but does it need a new line? */
+ if (notes_start_col < code_cols)
+ new_notes_line = true;
else
{
-#if (!WITH_PURE_S7)
- if (c_function_call(proc) == g_strings_are_ci_equal)
+ if (notes)
{
- hash_table_checker(ht) = hash_ci_string;
- hash_table_mapper(ht) = string_ci_eq_hash_map;
+ char *last_newline;
+ last_newline = strrchr(notes, (int)'\n'); /* returns ptr to end if none = nil if not found? */
+ if (last_newline)
+ cur_line_len = strlen(notes) - strlen(last_newline);
+ else cur_line_len = strlen(notes);
+ new_notes_line = ((cur_line_len + new_note_len) > notes_max);
}
- else
- {
- if (c_function_call(proc) == g_chars_are_ci_equal)
- {
- hash_table_checker(ht) = hash_ci_char;
- hash_table_mapper(ht) = char_ci_eq_hash_map;
- }
- else
- {
-#endif
- if (c_function_call(proc) == g_chars_are_equal)
- {
- hash_table_checker(ht) = hash_char;
- hash_table_mapper(ht) = char_eq_hash_map;
- }
- else
- {
-#if (!WITH_GMP)
- if (c_function_call(proc) == g_equal)
-#else
- if ((c_function_call(proc) == g_equal) ||
- (c_function_call(proc) == big_equal))
-#endif
- {
- hash_table_checker(ht) = hash_number;
- hash_table_mapper(ht) = number_eq_hash_map;
- }
- else
- {
- if (c_function_call(proc) == g_is_eqv)
- {
- hash_table_checker(ht) = hash_eqv;
- hash_table_mapper(ht) = eqv_hash_map;
- }
- else
- {
- if (c_function_call(proc) == g_is_morally_equal)
- {
- hash_table_checker(ht) = hash_morally_equal;
- hash_table_mapper(ht) = morally_equal_hash_map;
- }
- else return(wrong_type_argument_with_type(sc, sc->make_hash_table_symbol, 3, proc,
- make_string_wrapper(sc, "a hash function")));
- }}}}}
-#if (!WITH_PURE_S7)
- }}
-#endif
- return(ht);
- }
- /* proc not c_function */
- else
- {
- if (is_pair(proc))
- {
- s7_pointer checker, mapper;
- checker = car(proc);
- mapper = cdr(proc);
+ }
- if (((is_any_c_function(checker)) || (is_any_closure(checker))) &&
- ((is_any_c_function(mapper)) || (is_any_closure(mapper))) &&
- (s7_is_aritable(sc, checker, 2)) &&
- (s7_is_aritable(sc, mapper, 1)))
+ if (new_notes_line)
{
- s7_pointer sig;
- ht = s7_make_hash_table(sc, size);
- if (is_any_c_function(checker))
- {
- sig = c_function_signature(checker);
- if ((sig) &&
- (is_pair(sig)) &&
- (car(sig) != sc->is_boolean_symbol))
- return(wrong_type_argument_with_type(sc, sc->make_hash_table_symbol, 3, proc,
- make_string_wrapper(sc, "equality function should return a boolean")));
- hash_table_checker(ht) = hash_c_function;
- }
- else hash_table_checker(ht) = hash_closure;
- if (is_any_c_function(mapper))
- {
- sig = c_function_signature(mapper);
- if ((sig) &&
- (is_pair(sig)) &&
- (car(sig) != sc->is_integer_symbol))
- return(wrong_type_argument_with_type(sc, sc->make_hash_table_symbol, 3, proc,
- make_string_wrapper(sc, "mapping function should return an integer")));
- hash_table_mapper(ht) = c_function_hash_map;
- }
- else hash_table_mapper(ht) = closure_hash_map;
- hash_table_set_procedures(ht, proc);
- return(ht);
+ new_note_len += (4 + notes_start_col + ((notes) ? strlen(notes) : 0));
+ str = (char *)malloc(new_note_len * sizeof(char));
+ snprintf(str, new_note_len, "%s\n%s%s%s%s: %s",
+ (notes) ? notes : "",
+ (as_comment) ? "; " : "",
+ (spaces_len >= notes_start_col) ? (char *)(spaces + spaces_len - notes_start_col) : "",
+ (as_comment) ? "" : " ; ",
+ symbol_name(code),
+ objstr);
}
- }
- return(wrong_type_argument_with_type(sc, sc->make_hash_table_symbol, 3, proc,
- make_string_wrapper(sc, "a cons of two functions")));
- }
- }
- }
- return(s7_make_hash_table(sc, size));
-}
-
-
-void init_hash_maps(void)
-{
- int i;
-
- default_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
- eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
- eqv_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
- string_eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
- number_eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
- char_eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
-#if (!WITH_PURE_S7)
- string_ci_eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
- char_ci_eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
-#endif
- closure_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
- c_function_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
- morally_equal_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
-
- for (i = 0; i < NUM_TYPES; i++)
- {
- default_hash_map[i] = hash_map_nil;
- string_eq_hash_map[i] = hash_map_nil;
- char_eq_hash_map[i] = hash_map_nil;
-#if (!WITH_PURE_S7)
- string_ci_eq_hash_map[i] = hash_map_nil;
- char_ci_eq_hash_map[i] = hash_map_nil;
-#endif
- number_eq_hash_map[i] = hash_map_nil;
- closure_hash_map[i] = hash_map_closure;
- c_function_hash_map[i] = hash_map_c_function;
- eq_hash_map[i] = hash_map_eq;
- eqv_hash_map[i] = hash_map_eq;
-
- equal_hash_checks[i] = hash_equal_any;
- morally_equal_hash_checks[i] = hash_equal_any;
- default_hash_checks[i] = hash_equal;
+ else
+ {
+ new_note_len += ((notes) ? strlen(notes) : 0) + 4;
+ str = (char *)malloc(new_note_len * sizeof(char));
+ snprintf(str, new_note_len, "%s%s%s: %s",
+ (notes) ? notes : "",
+ (notes) ? ", " : " ; ",
+ symbol_name(code),
+ objstr);
+ }
+ free(objstr);
+ if (notes) free(notes);
+ return(str);
+ }
+ }
+ }
+ return(notes);
}
- default_hash_map[T_INTEGER] = hash_map_int;
- default_hash_map[T_RATIO] = hash_map_ratio;
- default_hash_map[T_REAL] = hash_map_real;
- default_hash_map[T_COMPLEX] = hash_map_complex;
- default_hash_map[T_CHARACTER] = hash_map_char;
- default_hash_map[T_SYMBOL] = hash_map_symbol;
- default_hash_map[T_SYNTAX] = hash_map_syntax;
- default_hash_map[T_STRING] = hash_map_string;
- default_hash_map[T_HASH_TABLE] = hash_map_hash_table;
- default_hash_map[T_VECTOR] = hash_map_vector;
- default_hash_map[T_INT_VECTOR] = hash_map_int_vector;
- default_hash_map[T_FLOAT_VECTOR] = hash_map_float_vector;
- default_hash_map[T_LET] = hash_map_let;
- default_hash_map[T_PAIR] = hash_map_pair;
-#if WITH_GMP
- default_hash_map[T_BIG_INTEGER] = hash_map_big_int;
- default_hash_map[T_BIG_RATIO] = hash_map_big_ratio;
- default_hash_map[T_BIG_REAL] = hash_map_big_real;
- default_hash_map[T_BIG_COMPLEX] = hash_map_big_complex;
-#endif
-
- for (i = 0; i < NUM_TYPES; i++) morally_equal_hash_map[i] = default_hash_map[i];
-
- string_eq_hash_map[T_STRING] = hash_map_string;
- char_eq_hash_map[T_CHARACTER] = hash_map_char;
-#if (!WITH_PURE_S7)
- string_ci_eq_hash_map[T_STRING] = hash_map_ci_string;
- char_ci_eq_hash_map[T_CHARACTER] = hash_map_ci_char;
-#endif
-
- number_eq_hash_map[T_INTEGER] = hash_map_int;
- number_eq_hash_map[T_RATIO] = hash_map_ratio_eq;
- number_eq_hash_map[T_REAL] = hash_map_real_eq;
- number_eq_hash_map[T_COMPLEX] = hash_map_complex;
-#if (WITH_GMP)
- number_eq_hash_map[T_BIG_INTEGER] = hash_map_big_int;
- number_eq_hash_map[T_BIG_RATIO] = hash_map_big_ratio;
- number_eq_hash_map[T_BIG_REAL] = hash_map_big_real;
- number_eq_hash_map[T_BIG_COMPLEX] = hash_map_big_complex;
-#endif
-
- eqv_hash_map[T_INTEGER] = hash_map_int;
- eqv_hash_map[T_RATIO] = hash_map_ratio_eq;
- eqv_hash_map[T_REAL] = hash_map_real_eq;
- eqv_hash_map[T_COMPLEX] = hash_map_complex;
-
- morally_equal_hash_map[T_INTEGER] = hash_map_int;
- morally_equal_hash_map[T_RATIO] = hash_map_ratio_eq;
- morally_equal_hash_map[T_REAL] = hash_map_real_eq;
- morally_equal_hash_map[T_COMPLEX] = hash_map_complex;
+ if (is_pair(code))
+ {
+ notes = stacktrace_walker(sc, car(code), e, notes, gc_syms, code_cols, total_cols, notes_start_col, as_comment);
+ return(stacktrace_walker(sc, cdr(code), e, notes, gc_syms, code_cols, total_cols, notes_start_col, as_comment));
+ }
+ return(notes);
+}
- equal_hash_checks[T_REAL] = hash_equal_real;
- equal_hash_checks[T_COMPLEX] = hash_equal_complex;
- equal_hash_checks[T_SYNTAX] = hash_equal_syntax;
- equal_hash_checks[T_SYMBOL] = hash_equal_eq;
- equal_hash_checks[T_CHARACTER] = hash_equal_eq;
+static char *stacktrace_add_func(s7_scheme *sc, s7_pointer f, s7_pointer code, char *errstr, char *notes, int code_max, bool as_comment)
+{
+ int newlen, errlen;
+ char *newstr, *str;
- default_hash_checks[T_STRING] = hash_string;
- default_hash_checks[T_INTEGER] = hash_int;
- default_hash_checks[T_REAL] = hash_float;
- default_hash_checks[T_SYMBOL] = hash_symbol;
- default_hash_checks[T_CHARACTER] = hash_char;
-}
+ errlen = strlen(errstr);
+ if ((is_symbol(f)) &&
+ (f != car(code)))
+ {
+ newlen = symbol_name_length(f) + errlen + 10;
+ newstr = (char *)malloc(newlen * sizeof(char));
+ errlen = snprintf(newstr, newlen, "%s: %s", symbol_name(f), errstr);
+ }
+ else
+ {
+ newlen = errlen + 8;
+ newstr = (char *)malloc(newlen * sizeof(char));
+ if ((errlen > 2) && (errstr[2] == '('))
+ errlen = snprintf(newstr, newlen, " %s", errstr);
+ else errlen = snprintf(newstr, newlen, "%s", errstr);
+ }
+ newlen = code_max + 8 + ((notes) ? strlen(notes) : 0);
+ str = (char *)malloc(newlen * sizeof(char));
-static unsigned int resize_hash_table(s7_scheme *sc, s7_pointer table)
-{
- /* resize the table */
- unsigned int hash_len, loc;
- int i, old_size, new_size;
- hash_entry_t **new_els, **old_els;
-
- old_size = hash_table_mask(table) + 1;
- new_size = old_size * 4;
- hash_len = new_size - 1;
- new_els = (hash_entry_t **)calloc(new_size, sizeof(hash_entry_t *));
- old_els = hash_table_elements(table);
-
- for (i = 0; i < old_size; i++)
+ if (errlen >= code_max)
{
- hash_entry_t *x, *n;
- for (x = old_els[i]; x; x = n)
+ newstr[code_max - 4] = '.';
+ newstr[code_max - 3] = '.';
+ newstr[code_max - 2] = '.';
+ newstr[code_max - 1] = '\0';
+ snprintf(str, newlen, "%s%s%s\n", (as_comment) ? "; " : "", newstr, (notes) ? notes : "");
+ }
+ else
+ {
+ /* send out newstr, pad with spaces to code_max, then notes */
+ int len;
+ len = snprintf(str, newlen, "%s%s", (as_comment) ? "; " : "", newstr);
+ if (notes)
{
- n = x->next;
- loc = x->raw_hash & hash_len;
- x->next = new_els[loc];
- new_els[loc] = x;
+ int i;
+ for (i = len; i < code_max - 1; i++)
+ str[i] = ' ';
+ str[i] = '\0';
+#ifdef __OpenBSD__
+ strlcat(str, notes, newlen);
+ strlcat(str, "\n", newlen);
+#else
+ strcat(str, notes);
+ strcat(str, "\n");
+#endif
}
}
- hash_table_elements(table) = new_els;
- free(old_els);
- hash_table_mask(table) = new_size - 1;
- return(hash_len);
+ free(newstr);
+ return(str);
}
-/* -------------------------------- hash-table-ref -------------------------------- */
-
-s7_pointer s7_hash_table_ref(s7_scheme *sc, s7_pointer table, s7_pointer key)
+static char *stacktrace_1(s7_scheme *sc, int frames_max, int code_cols, int total_cols, int notes_start_col, bool as_comment)
{
- hash_entry_t *x;
- x = (*hash_table_checker(table))(sc, table, key);
- if (x) return(x->value);
- return(sc->F);
-}
-
+ char *str;
+ int loc, top, frames = 0;
+ unsigned int gc_syms;
-static s7_pointer g_hash_table_ref(s7_scheme *sc, s7_pointer args)
-{
- #define H_hash_table_ref "(hash-table-ref table key) returns the value associated with key in the hash table"
- #define Q_hash_table_ref s7_make_circular_signature(sc, 2, 3, sc->T, sc->is_hash_table_symbol, sc->T)
+ gc_syms = s7_gc_protect(sc, sc->nil);
+ str = NULL;
+ top = (sc->stack_end - sc->stack_start) / 4; /* (*s7* 'stack_top), not s7_stack_top! */
- s7_pointer table;
- table = car(args);
- if (!is_hash_table(table))
- method_or_bust(sc, table, sc->hash_table_ref_symbol, args, T_HASH_TABLE, 1);
- /*
- (define (href H . args)
- (if (null? (cdr args))
- (hash-table-ref H (car args))
- (apply href (hash-table-ref H (car args)) (cdr args))))
- */
- if (is_null(cddr(args)))
- return(s7_hash_table_ref(sc, table, cadr(args)));
- return(implicit_index(sc, s7_hash_table_ref(sc, table, cadr(args)), cddr(args)));
-}
+ if (stacktrace_in_error_handler(sc, top))
+ {
+ s7_pointer err_code;
+ err_code = slot_value(sc->error_code);
+ if (is_pair(err_code))
+ {
+ char *errstr, *notes = NULL;
+ s7_pointer cur_env, f;
+ errstr = s7_object_to_c_string(sc, err_code);
+ cur_env = outlet(sc->owlet);
+ f = stacktrace_find_caller(sc, cur_env); /* this is a symbol */
+ if ((is_let(cur_env)) &&
+ (cur_env != sc->rootlet))
+ notes = stacktrace_walker(sc, err_code, cur_env, NULL, gc_syms, code_cols, total_cols, notes_start_col, as_comment);
+ str = stacktrace_add_func(sc, f, err_code, errstr, notes, code_cols, as_comment);
+ free(errstr);
+ }
-static s7_pointer hash_table_ref_2;
-static s7_pointer g_hash_table_ref_2(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer table;
- hash_entry_t *x;
+ /* now if OP_ERROR_HOOK_QUIT is in the stack, jump past it!
+ */
+ loc = stacktrace_find_error_hook_quit(sc);
+ if (loc > 0) top = (loc + 1) / 4;
+ }
- table = car(args);
- if (!is_hash_table(table))
- method_or_bust(sc, table, sc->hash_table_ref_symbol, args, T_HASH_TABLE, 1);
+ for (loc = top - 1; loc > 0; loc--)
+ {
+ s7_pointer code;
+ int true_loc;
- x = (*hash_table_checker(table))(sc, table, cadr(args));
- if (x) return(x->value);
- return(sc->F);
-}
+ true_loc = (int)(loc + 1) * 4 - 1;
+ code = stack_code(sc->stack, true_loc); /* can code be free here? [hit this once, could not repeat it] */
-static s7_pointer hash_table_ref_ss;
-static s7_pointer g_hash_table_ref_ss(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer table;
- hash_entry_t *x;
+ if (is_pair(code))
+ {
+ char *codestr;
+ codestr = s7_object_to_c_string(sc, code);
+ if (codestr)
+ {
+ if ((!local_strcmp(codestr, "(result)")) &&
+ (!local_strcmp(codestr, "(#f)")) &&
+ (!strstr(codestr, "(stacktrace)")) &&
+ (!strstr(codestr, "(stacktrace ")))
+ {
+ s7_pointer e, f;
- table = find_symbol_checked(sc, car(args));
- if (!is_hash_table(table))
- method_or_bust(sc, table, sc->hash_table_ref_symbol, list_2(sc, table, find_symbol_checked(sc, cadr(args))), T_HASH_TABLE, 1);
-
- x = (*hash_table_checker(table))(sc, table, find_symbol_checked(sc, cadr(args)));
- if (x) return(x->value);
- return(sc->F);
-}
+ e = stack_let(sc->stack, true_loc);
+ f = stacktrace_find_caller(sc, e);
+ if (!stacktrace_error_hook_function(sc, f))
+ {
+ char *notes = NULL, *newstr;
+ int newlen;
-static s7_pointer hash_table_ref_car;
-static s7_pointer g_hash_table_ref_car(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer y, table;
- hash_entry_t *x;
+ frames++;
+ if (frames > frames_max)
+ {
+ free(codestr);
+ s7_gc_unprotect_at(sc, gc_syms);
+ return(str);
+ }
- table = find_symbol_checked(sc, car(args));
- if (!is_hash_table(table))
- method_or_bust(sc, table, sc->hash_table_ref_symbol, list_2(sc, table, car(find_symbol_checked(sc, cadadr(args)))), T_HASH_TABLE, 1);
+ if ((is_let(e)) && (e != sc->rootlet))
+ notes = stacktrace_walker(sc, code, e, NULL, gc_syms, code_cols, total_cols, notes_start_col, as_comment);
+ newstr = stacktrace_add_func(sc, f, code, codestr, notes, code_cols, as_comment);
+ free(codestr);
+ if ((notes) && (notes != newstr) && (is_let(e)) && (e != sc->rootlet)) free(notes); /* double free somehow?? */
- y = find_symbol_checked(sc, cadadr(args));
- if (!is_pair(y))
- return(simple_wrong_type_argument(sc, sc->car_symbol, y, T_PAIR));
+ newlen = strlen(newstr) + 1 + ((str) ? strlen(str) : 0);
+ codestr = (char *)malloc(newlen * sizeof(char));
+ snprintf(codestr, newlen, "%s%s", (str) ? str : "", newstr);
+ if (str) free(str);
+ free(newstr);
+ str = codestr;
+ codestr = NULL;
+ }
+ else free(codestr);
+ }
+ else free(codestr);
+ }
+ }
+ }
- x = (*hash_table_checker(table))(sc, table, car(y));
- if (x) return(x->value);
- return(sc->F);
+ s7_gc_unprotect_at(sc, gc_syms);
+ return(str);
}
-static s7_pointer hash_table_ref_pf_a(s7_scheme *sc, s7_pointer **p)
-{
- s7_pf_t f;
- s7_pointer x, y;
- f = (s7_pf_t)(**p); (*p)++;
- x = f(sc, p);
- f = (s7_pf_t)(**p); (*p)++;
- y = f(sc, p);
- return(s7_hash_table_ref(sc, x, y));
-}
-static s7_pointer hash_table_ref_pf_i(s7_scheme *sc, s7_pointer **p) /* i=implicit I think */
+s7_pointer s7_stacktrace(s7_scheme *sc)
{
- s7_pf_t f;
- s7_pointer x, y;
- x = slot_value(**p); (*p)++;
- f = (s7_pf_t)(**p); (*p)++;
- y = f(sc, p);
- return(s7_hash_table_ref(sc, x, y));
+ char *str;
+ str = stacktrace_1(sc, 30, 45, 80, 45, false);
+ return(make_string_uncopied_with_length(sc, str, safe_strlen(str)));
}
-static s7_pointer hash_table_ref_pf_s(s7_scheme *sc, s7_pointer **p)
-{
- s7_pf_t f;
- s7_pointer x, y;
- hash_entry_t *h;
- x = (**p); (*p)++;
- f = (s7_pf_t)(**p); (*p)++;
- y = f(sc, p);
- h = (*hash_table_checker(x))(sc, x, y);
- if (h) return(h->value);
- return(sc->F);
-}
-static s7_pointer hash_table_ref_pf_ps(s7_scheme *sc, s7_pointer **p)
+static s7_pointer g_stacktrace(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x, y;
- x = (**p); (*p) += 2;
- y = slot_value(**p); (*p)++;
- return(s7_hash_table_ref(sc, x, y));
-}
+ #define H_stacktrace "(stacktrace (max-frames 30) (code-cols 50) (total-cols 80) (note-col 50) as-comment) returns \
+a stacktrace as a string. Each line has two portions, the code being evaluated and a note giving \
+the value of local variables in that code. The first argument sets how many lines are displayed. \
+The next three arguments set the length and layout of those lines. 'as-comment' if #t causes each \
+line to be preceded by a semicolon."
+ #define Q_stacktrace s7_make_signature(sc, 6, sc->is_string_symbol, sc->is_integer_symbol, sc->is_integer_symbol, sc->is_integer_symbol, sc->is_integer_symbol, sc->is_boolean_symbol)
-static s7_pointer hash_table_ref_pf_r(s7_scheme *sc, s7_pointer **p)
-{
- s7_rf_t f;
- s7_pointer x;
- s7_double y;
- int hash_len;
- hash_entry_t *h;
- x = (**p); (*p)++;
- f = (s7_rf_t)(**p); (*p)++;
- y = f(sc, p);
- hash_len = hash_table_mask(x);
- h = hash_float_1(sc, x, hash_float_location(y) & hash_len, y);
- if (h) return(h->value);
- return(sc->F);
-}
+ s7_int max_frames = 30, code_cols = 50, total_cols = 80, notes_start_col = 50;
+ bool as_comment = false;
+ char *str;
-static s7_pf_t hash_table_ref_pf(s7_scheme *sc, s7_pointer expr)
-{
- if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))))
+ if (!is_null(args))
{
- s7_pointer a1;
- a1 = cadr(expr);
- if (is_symbol(a1))
- {
- s7_pointer table;
- table = s7_slot(sc, a1);
- if ((is_slot(table)) && (!is_stepper(table)) && (is_hash_table(slot_value(table))))
- {
- ptr_int loc;
- s7_pointer a2;
- a2 = caddr(expr);
- s7_xf_store(sc, slot_value(table));
- loc = rc_loc(sc);
- if (s7_arg_to_pf(sc, a2))
- return((is_symbol(a2)) ? hash_table_ref_pf_ps : hash_table_ref_pf_s);
- sc->cur_rf->cur = rc_go(sc, loc);
- if (s7_arg_to_gf(sc, a2))
- return((is_symbol(a2)) ? hash_table_ref_pf_ps : hash_table_ref_pf_s);
- sc->cur_rf->cur = rc_go(sc, loc);
- if (s7_arg_to_rf(sc, a2))
- return(hash_table_ref_pf_r);
- return(NULL);
+ if (s7_is_integer(car(args)))
+ {
+ max_frames = s7_integer(car(args));
+ if ((max_frames <= 0) || (max_frames > s7_int32_max))
+ max_frames = 30;
+ args = cdr(args);
+ if (!is_null(args))
+ {
+ if (s7_is_integer(car(args)))
+ {
+ code_cols = s7_integer(car(args));
+ if ((code_cols <= 8) || (code_cols > s7_int32_max))
+ code_cols = 50;
+ args = cdr(args);
+ if (!is_null(args))
+ {
+ if (s7_is_integer(car(args)))
+ {
+ total_cols = s7_integer(car(args));
+ if ((total_cols <= code_cols) || (total_cols > s7_int32_max))
+ total_cols = 80;
+ args = cdr(args);
+ if (!is_null(args))
+ {
+ if (s7_is_integer(car(args)))
+ {
+ notes_start_col = s7_integer(car(args));
+ if ((notes_start_col <= 0) || (notes_start_col > s7_int32_max))
+ notes_start_col = 50;
+ args = cdr(args);
+ if (!is_null(args))
+ {
+ if (s7_is_boolean(car(args)))
+ as_comment = s7_boolean(sc, car(args));
+ else return(wrong_type_argument(sc, sc->stacktrace_symbol, 5, car(args), T_BOOLEAN));
+ }
+ }
+ else return(wrong_type_argument(sc, sc->stacktrace_symbol, 4, car(args), T_INTEGER));
+ }
+ }
+ else return(wrong_type_argument(sc, sc->stacktrace_symbol, 3, car(args), T_INTEGER));
+ }
+ }
+ else return(wrong_type_argument(sc, sc->stacktrace_symbol, 2, car(args), T_INTEGER));
}
}
- if ((s7_arg_to_pf(sc, cadr(expr))) &&
- (s7_arg_to_pf(sc, caddr(expr))))
- return(hash_table_ref_pf_a);
+ else method_or_bust(sc, car(args), sc->stacktrace_symbol, args, T_INTEGER, 1);
}
- return(NULL);
+ str = stacktrace_1(sc, (int)max_frames, (int)code_cols, (int)total_cols, (int)notes_start_col, as_comment);
+ return(make_string_uncopied_with_length(sc, str, safe_strlen(str)));
}
-/* -------------------------------- hash-table-set! -------------------------------- */
+/* -------- s7_history, s7_add_to_history -------- */
-static void hash_table_set_function(s7_pointer table, int typ)
+s7_pointer s7_add_to_history(s7_scheme *sc, s7_pointer entry)
{
- 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;
- }
+#if WITH_HISTORY
+ set_current_code(sc, entry);
+#endif
+ return(entry);
}
-
-s7_pointer s7_hash_table_set(s7_scheme *sc, s7_pointer table, s7_pointer key, s7_pointer value)
+s7_pointer s7_history(s7_scheme *sc)
{
- hash_entry_t *x;
- x = (*hash_table_checker(table))(sc, table, key);
-
- if (x)
- {
- if (value == sc->F)
- return(remove_from_hash_table(sc, table, key, x));
- x->value = _NFre(value);
- }
- else
- {
- unsigned int hash_len, raw_hash, loc;
- hash_entry_t *p;
- if (value == sc->F) return(sc->F);
-
- if (!hash_table_checker_locked(table))
- hash_table_set_function(table, type(key));
-
- hash_len = hash_table_mask(table);
- if (hash_table_entries(table) > hash_len)
- hash_len = resize_hash_table(sc, table);
- raw_hash = hash_loc(sc, table, key);
-
- if (!hash_free_list)
- {
- int i;
- hash_free_list = (hash_entry_t *)malloc(16 * sizeof(hash_entry_t));
- for (p = hash_free_list, i = 0; i < 15; i++) {p->next = p + 1; p++;}
- p->next = NULL;
- }
-
- p = hash_free_list;
- hash_free_list = p->next;
- p->key = key;
- p->value = _NFre(value);
- p->raw_hash = raw_hash;
-
- loc = raw_hash & hash_len;
- p->next = hash_table_element(table, loc);
- hash_table_element(table, loc) = p;
- hash_table_entries(table)++;
- }
- return(value);
+ return(sc->cur_code);
}
-static s7_pointer hash_table_set_pf_sxs(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer key, table, value;
- s7_pf_t pf;
- table = slot_value(**p); (*p)++;
- pf = (s7_pf_t)(**p); (*p)++;
- key = pf(sc, p);
- value = slot_value(**p); (*p)++;
- return(s7_hash_table_set(sc, table, key, value));
-}
-static s7_pointer hash_table_set_pf_sxx(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer key, table, value;
- s7_pf_t pf;
- table = slot_value(**p); (*p)++;
- pf = (s7_pf_t)(**p); (*p)++;
- key = pf(sc, p);
- pf = (s7_pf_t)(**p); (*p)++;
- value = pf(sc, p);
- return(s7_hash_table_set(sc, table, key, value));
-}
-static s7_pointer hash_table_set_pf_sss(s7_scheme *sc, s7_pointer **p)
-{
- s7_pointer key, table, value;
- table = slot_value(**p); (*p)++;
- key = slot_value(**p); (*p)++;
- value = slot_value(**p); (*p)++;
- return(s7_hash_table_set(sc, table, key, value));
-}
+/* -------- error handlers -------- */
-static s7_pointer hash_table_set_pf_ssx(s7_scheme *sc, s7_pointer **p)
+static const char *make_type_name(s7_scheme *sc, const char *name, int article)
{
- s7_pf_t pf;
- s7_pointer key, table, value;
- table = slot_value(**p); (*p)++;
- key = slot_value(**p); (*p)++;
- pf = (s7_pf_t)(**p); (*p)++;
- value = pf(sc, p);
- return(s7_hash_table_set(sc, table, key, value));
-}
+ int i, slen, len;
-static s7_pf_t hash_table_set_pf(s7_scheme *sc, s7_pointer expr)
-{
- if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_pair(cdddr(expr))) && (is_null(cddddr(expr))))
+ slen = safe_strlen(name);
+ len = slen + 8;
+ if (len > sc->typnam_len)
{
- s7_pointer a1, a2, a3;
- a1 = cadr(expr);
- a2 = caddr(expr);
- a3 = cadddr(expr);
- if (is_symbol(a1))
- {
- xf_t *rc;
- a1 = s7_slot(sc, a1);
- if ((!is_slot(a1)) || (!is_hash_table(slot_value(a1))) || (is_stepper(a1))) return(NULL);
- xf_init(3);
- xf_store(a1);
- if (is_symbol(a2))
- {
- a2 = s7_slot(sc, a2);
- if (!is_slot(a2)) return(NULL);
- xf_store(a2);
- }
- else
- {
- ptr_int loc;
- loc = rc_loc(sc);
- if (!s7_arg_to_pf(sc, a2))
- {
- sc->cur_rf->cur = rc_go(sc, loc);
- if (!s7_arg_to_gf(sc, a2)) return(NULL);
- }
- }
- if (is_symbol(a3))
- {
- a3 = s7_slot(sc, a3);
- if (!is_slot(a3)) return(NULL);
- xf_store(a3);
- return((is_slot(a2)) ? hash_table_set_pf_sss : hash_table_set_pf_sxs);
- }
- else
- {
- ptr_int loc;
- loc = rc_loc(sc);
- if (!s7_arg_to_pf(sc, a3))
- {
- sc->cur_rf->cur = rc_go(sc, loc);
- if (!s7_arg_to_gf(sc, a3)) return(NULL);
- }
- return((is_slot(a2)) ? hash_table_set_pf_ssx : hash_table_set_pf_sxx);
- }
- }
+ if (sc->typnam) free(sc->typnam);
+ sc->typnam = (char *)malloc(len * sizeof(char));
+ sc->typnam_len = len;
}
- return(NULL);
+ if (article == INDEFINITE_ARTICLE)
+ {
+ i = 1;
+ sc->typnam[0] = 'a';
+ if ((name[0] == 'a') || (name[0] == 'e') || (name[0] == 'i') || (name[0] == 'o') || (name[0] == 'u'))
+ sc->typnam[i++] = 'n';
+ sc->typnam[i++] = ' ';
+ }
+ else i = 0;
+ memcpy((void *)(sc->typnam + i), (void *)name, slen);
+ sc->typnam[i + slen] = '\0';
+ return(sc->typnam);
}
-static s7_pointer g_hash_table_set(s7_scheme *sc, s7_pointer args)
+static const char *type_name_from_type(s7_scheme *sc, int typ, int article)
{
- #define H_hash_table_set "(hash-table-set! table key value) sets the value associated with key in the hash table to value"
- #define Q_hash_table_set s7_make_signature(sc, 4, sc->T, sc->is_hash_table_symbol, sc->T, sc->T)
+ static const char *frees[2] = {"free cell", "a free cell"};
+ static const char *nils[2] = {"nil", "nil"};
+ static const char *uniques[2] = {"untyped", "untyped"};
+ static const char *booleans[2] = {"boolean", "boolean"};
+ static const char *strings[2] = {"string", "a string"};
+ static const char *symbols[2] = {"symbol", "a symbol"};
+ static const char *syntaxes[2] = {"syntax", "syntactic"};
+ static const char *pairs[2] = {"pair", "a pair"};
+ static const char *gotos[2] = {"goto", "a goto (from call-with-exit)"};
+ static const char *continuations[2] = {"continuation", "a continuation"};
+ static const char *c_functions[2] = {"c-function", "a c-function"};
+ static const char *macros[2] = {"macro", "a macro"};
+ static const char *c_macros[2] = {"c-macro", "a c-macro"};
+ static const char *bacros[2] = {"bacro", "a bacro"};
+ static const char *vectors[2] = {"vector", "a vector"};
+ static const char *int_vectors[2] = {"int-vector", "an int-vector"};
+ static const char *float_vectors[2] = {"float-vector", "a float-vector"};
+ static const char *c_pointers[2] = {"C pointer", "a raw C pointer"};
+ static const char *counters[2] = {"internal counter", "an internal counter"};
+ static const char *optlists[2] = {"internal optlist", "an internal optlist"};
+ static const char *baffles[2] = {"baffle", "a baffle"};
+ static const char *slots[2] = {"slot", "a slot (variable binding)"};
+ static const char *characters[2] = {"character", "a character"};
+ static const char *catches[2] = {"catch", "a catch"};
+ static const char *dynamic_winds[2] = {"dynamic-wind", "a dynamic-wind"};
+ static const char *hash_tables[2] = {"hash-table", "a hash-table"};
+ static const char *iterators[2] = {"iterator", "an iterator"};
+ static const char *environments[2] = {"environment", "an environment"};
+ static const char *integers[2] = {"integer", "an integer"};
+ static const char *big_integers[2] = {"big integer", "a big integer"};
+ static const char *ratios[2] = {"ratio", "a ratio"};
+ static const char *big_ratios[2] = {"big ratio", "a big ratio"};
+ static const char *reals[2] = {"real", "a real"};
+ static const char *big_reals[2] = {"big real", "a big real"};
+ static const char *complexes[2] = {"complex number", "a complex number"};
+ static const char *big_complexes[2] = {"big complex number", "a big complex number"};
+ static const char *functions[2] = {"function", "a function"};
+ static const char *function_stars[2] = {"function*", "a function*"};
+ static const char *rngs[2] = {"random-state", "a random-state"};
- s7_pointer table;
- table = car(args);
- if (!is_hash_table(table))
- method_or_bust(sc, table, sc->hash_table_set_symbol, args,T_HASH_TABLE, 1);
- return(s7_hash_table_set(sc, table, cadr(args), caddr(args)));
+ switch (typ)
+ {
+ case T_FREE: return(frees[article]);
+ case T_NIL: return(nils[article]);
+ case T_EOF_OBJECT: return(uniques[article]);
+ case T_UNSPECIFIED: return(uniques[article]);
+ case T_UNDEFINED: return(uniques[article]);
+ case T_BOOLEAN: return(booleans[article]);
+ case T_STRING: return(strings[article]);
+ case T_SYMBOL: return(symbols[article]);
+ case T_SYNTAX: return(syntaxes[article]);
+ case T_PAIR: return(pairs[article]);
+ case T_GOTO: return(gotos[article]);
+ case T_CONTINUATION: return(continuations[article]);
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ case T_C_ANY_ARGS_FUNCTION:
+ case T_C_FUNCTION_STAR:
+ case T_C_FUNCTION: return(c_functions[article]);
+ case T_CLOSURE: return(functions[article]);
+ case T_CLOSURE_STAR: return(function_stars[article]);
+ case T_C_MACRO: return(c_macros[article]);
+ case T_C_POINTER: return(c_pointers[article]);
+ case T_CHARACTER: return(characters[article]);
+ case T_VECTOR: return(vectors[article]);
+ case T_INT_VECTOR: return(int_vectors[article]);
+ case T_FLOAT_VECTOR: return(float_vectors[article]);
+ case T_MACRO_STAR:
+ case T_MACRO: return(macros[article]);
+ case T_BACRO_STAR:
+ case T_BACRO: return(bacros[article]);
+ case T_CATCH: return(catches[article]); /* are these 2 possible? */
+ case T_DYNAMIC_WIND: return(dynamic_winds[article]);
+ case T_HASH_TABLE: return(hash_tables[article]);
+ case T_ITERATOR: return(iterators[article]);
+ case T_LET: return(environments[article]);
+ case T_COUNTER: return(counters[article]);
+ case T_OPTLIST: return(optlists[article]);
+ case T_BAFFLE: return(baffles[article]);
+ case T_RANDOM_STATE: return(rngs[article]);
+ case T_SLOT: return(slots[article]);
+ case T_INTEGER: return(integers[article]);
+ case T_RATIO: return(ratios[article]);
+ case T_REAL: return(reals[article]);
+ case T_COMPLEX: return(complexes[article]);
+ case T_BIG_INTEGER: return(big_integers[article]);
+ case T_BIG_RATIO: return(big_ratios[article]);
+ case T_BIG_REAL: return(big_reals[article]);
+ case T_BIG_COMPLEX: return(big_complexes[article]);
+ }
+ return(NULL);
}
-/* -------------------------------- hash-table -------------------------------- */
-static s7_pointer g_hash_table(s7_scheme *sc, s7_pointer args)
+static const char *type_name(s7_scheme *sc, s7_pointer arg, int article)
{
- #define H_hash_table "(hash-table ...) returns a hash-table containing the cons's passed as its arguments. \
-That is, (hash-table '(\"hi\" . 3) (\"ho\" . 32)) returns a new hash-table with the two key/value pairs preinstalled."
- #define Q_hash_table s7_make_circular_signature(sc, 1, 2, sc->is_hash_table_symbol, sc->is_list_symbol)
+ switch (unchecked_type(arg))
+ {
+ case T_C_OBJECT:
+ return(make_type_name(sc, object_types[c_object_type(arg)]->name, article));
- int len;
- s7_pointer x, ht;
+ 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));
- /* this accepts repeated keys: (hash-table '(a . 1) '(a . 1)) */
- for (len = 0, x = args; is_pair(x); x = cdr(x), len++)
- if ((!is_pair(car(x))) &&
- (!is_null(car(x))))
- return(wrong_type_argument(sc, sc->hash_table_symbol, position_of(x, args), car(x), T_PAIR));
+ case T_OUTPUT_PORT:
+ return(make_type_name(sc, (is_file_port(arg)) ? "output file port" : ((is_string_port(arg)) ? "output string port" : "output port"), article));
- ht = s7_make_hash_table(sc, (len > sc->default_hash_table_length) ? len : sc->default_hash_table_length);
- if (len > 0)
- {
- unsigned int ht_loc;
- ht_loc = s7_gc_protect(sc, ht); /* hash_table_set can cons, so we need to protect this */
- for (x = args; is_pair(x); x = cdr(x))
- if (is_pair(car(x)))
- s7_hash_table_set(sc, ht, caar(x), cdar(x));
- s7_gc_unprotect_at(sc, ht_loc);
+ case T_LET:
+ if (has_methods(arg))
+ {
+ s7_pointer class_name;
+ class_name = find_method(sc, arg, sc->class_name_symbol);
+ if (is_symbol(class_name))
+ return(make_type_name(sc, symbol_name(class_name), article));
+ }
+
+ default:
+ {
+ const char *str;
+ str = type_name_from_type(sc, unchecked_type(arg), article);
+ if (str) return(str);
+ }
}
- return(ht);
+ return("messed up object");
}
-/* -------------------------------- hash-table* -------------------------------- */
-static s7_pointer g_hash_table_star(s7_scheme *sc, s7_pointer args)
+static s7_pointer prepackaged_type_name(s7_scheme *sc, s7_pointer x)
{
- #define H_hash_table_star "(hash-table* ...) returns a hash-table containing the symbol/value pairs passed as its arguments. \
-That is, (hash-table* 'a 1 'b 2) returns a new hash-table with the two key/value pairs preinstalled."
- #define Q_hash_table_star s7_make_circular_signature(sc, 1, 2, sc->is_hash_table_symbol, sc->T)
-
- int len;
- s7_pointer ht;
-
- len = safe_list_length(sc, args);
- if (len & 1)
- return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_2(sc, make_string_wrapper(sc, "hash-table* got an odd number of arguments: ~S"), args)));
- len /= 2;
+ s7_pointer p;
- ht = s7_make_hash_table(sc, (len > sc->default_hash_table_length) ? len : sc->default_hash_table_length);
- if (len > 0)
+ if (has_methods(x))
{
- unsigned int ht_loc;
- 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))
- s7_hash_table_set(sc, ht, car(x), car(y));
-
- s7_gc_unprotect_at(sc, ht_loc);
+ p = find_method(sc, find_let(sc, x), sc->class_name_symbol);
+ if (is_symbol(p))
+ return(symbol_name_cell(p));
}
- return(ht);
-}
-
-static s7_pointer hash_table_copy(s7_scheme *sc, s7_pointer old_hash, s7_pointer new_hash, unsigned int start, unsigned int end)
-{
- unsigned int i, old_len, new_len, count = 0;
- hash_entry_t **old_lists, **new_lists;
- hash_entry_t *x, *p;
+ p = prepackaged_type_names[type(x)];
+ if (is_string(p)) return(p);
- old_len = hash_table_mask(old_hash) + 1;
- new_len = hash_table_mask(new_hash);
- old_lists = hash_table_elements(old_hash);
- new_lists = hash_table_elements(new_hash);
-
- if (hash_table_entries(new_hash) == 0)
+ switch (type(x))
{
- hash_table_checker(new_hash) = hash_table_checker(old_hash);
- for (i = 0; i < old_len; i++)
- for (x = old_lists[i]; x; x = x->next)
- {
- if (count >= end)
- {
- hash_table_entries(new_hash) = end - start;
- return(new_hash);
- }
- if (count >= start)
- {
- unsigned int loc;
- loc = x->raw_hash & new_len;
- p = make_hash_entry(x->key, x->value, x->raw_hash);
- p->next = new_lists[loc];
- new_lists[loc] = p;
- }
- count++;
- }
- hash_table_entries(new_hash) = count - start;
- return(new_hash);
+ case T_C_OBJECT: return(c_object_scheme_name(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));
}
-
- /* this can't be optimized much because we have to look for key matches */
- for (i = 0; i < old_len; i++)
- for (x = old_lists[i]; x; x = x->next)
- {
- if (count >= end)
- return(new_hash);
- if (count >= start)
- {
- hash_entry_t *y;
- y = (*hash_table_checker(new_hash))(sc, new_hash, x->key);
- if (y)
- y->value = x->value;
- else
- {
- unsigned int loc;
- loc = x->raw_hash & new_len;
- p = make_hash_entry(x->key, x->value, x->raw_hash);
- 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));
- }
- }
- count++;
- }
- return(new_hash);
+ return(make_string_wrapper(sc, "unknown type!"));
}
-static s7_pointer hash_table_fill(s7_scheme *sc, s7_pointer args)
+static s7_pointer type_name_string(s7_scheme *sc, s7_pointer arg)
{
- s7_pointer val, table;
- table = car(args);
- val = cadr(args);
- if (hash_table_entries(table) > 0)
+ if (type(arg) < NUM_TYPES)
{
- int len;
- hash_entry_t **entries;
- entries = hash_table_elements(table);
- len = hash_table_mask(table) + 1;
- /* hash-table-ref returns #f if it can't find a key, so val == #f here means empty the table */
- if (val == sc->F)
- {
- hash_entry_t **hp, **hn;
- hash_entry_t *p;
- hp = entries;
- if (len == 1)
- {
- if (*hp)
- {
- p = *hp;
- while (p->next) p = p->next;
- p->next = hash_free_list;
- hash_free_list = *hp;
- }
- }
- else
- {
- /* here we assume we can go by 2's */
- hn = (hash_entry_t **)(hp + len);
- for (; hp < hn; hp++)
- {
- if (*hp)
- {
- p = *hp;
- while (p->next) p = p->next;
- p->next = hash_free_list;
- hash_free_list = *hp;
- }
- hp++;
- if (*hp)
- {
- p = *hp;
- while (p->next) p = p->next;
- p->next = hash_free_list;
- hash_free_list = *hp;
- }
- }
- }
- memset(entries, 0, len * sizeof(hash_entry_t *));
- if (!hash_table_checker_locked(table))
- hash_table_checker(table) = hash_empty;
- hash_table_entries(table) = 0;
- }
- else
- {
- int i;
- hash_entry_t *x;
- for (i = 0; i < len; i++)
- for (x = entries[i]; x; x = x->next)
- x->value = val;
- /* keys haven't changed, so no need to mess with hash_table_checker */
- }
+ s7_pointer p;
+ p = prepackaged_type_names[type(arg)]; /* these use INDEFINITE_ARTICLE */
+ if (is_string(p)) return(p);
}
- return(val);
+ return(make_string_wrapper(sc, type_name(sc, arg, INDEFINITE_ARTICLE)));
}
-static s7_pointer hash_table_reverse(s7_scheme *sc, s7_pointer old_hash)
+static s7_pointer wrong_type_arg_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg_n, s7_pointer arg, s7_pointer typnam, s7_pointer descr)
{
- int i, len;
- s7_pointer new_hash;
- hash_entry_t **old_lists;
- unsigned int gc_loc;
-
- len = hash_table_mask(old_hash) + 1;
- new_hash = s7_make_hash_table(sc, len);
- gc_loc = s7_gc_protect(sc, new_hash);
-
- /* I don't think the original hash functions can make any sense in general, so ignore them */
- old_lists = hash_table_elements(old_hash);
- for (i = 0; i < len; i++)
- {
- hash_entry_t *x;
- for (x = old_lists[i]; x; x = x->next)
- s7_hash_table_set(sc, new_hash, x->value, x->key);
- }
- s7_gc_unprotect_at(sc, gc_loc);
- return(new_hash);
+ s7_pointer p;
+ p = cdr(sc->wrong_type_arg_info); /* info list is '(format_string caller arg_n arg type_name descr) */
+ set_car(p, caller); p = cdr(p);
+ set_car(p, arg_n); p = cdr(p);
+ set_car(p, arg); p = cdr(p);
+ set_car(p, (typnam == sc->gc_nil) ? prepackaged_type_name(sc, arg) : typnam);
+ p = cdr(p);
+ set_car(p, descr);
+ return(s7_error(sc, sc->wrong_type_arg_symbol, sc->wrong_type_arg_info));
}
-
-/* -------------------------------- functions -------------------------------- */
-
-bool s7_is_function(s7_pointer p)
+static s7_pointer simple_wrong_type_arg_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg, s7_pointer typnam, s7_pointer descr)
{
- return(is_c_function(p));
+ set_wlist_4(sc, cdr(sc->simple_wrong_type_arg_info), caller, arg, (typnam == sc->gc_nil) ? prepackaged_type_name(sc, arg) : typnam, descr);
+ return(s7_error(sc, sc->wrong_type_arg_symbol, sc->simple_wrong_type_arg_info));
}
-static s7_pointer fallback_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+s7_pointer s7_wrong_type_arg_error(s7_scheme *sc, const char *caller, int arg_n, s7_pointer arg, const char *descr)
{
- return(f);
+ /* info list is '(format_string caller arg_n arg type_name descr) */
+ string_value(sc->err_wrap1) = (char *)caller;
+ string_length(sc->err_wrap1) = safe_strlen(caller);
+ string_value(sc->err_wrap2) = (char *)descr;
+ string_length(sc->err_wrap2) = safe_strlen(descr);
+ if (arg_n < 0) arg_n = 0;
+
+ if (arg_n > 0)
+ return(wrong_type_arg_error_prepackaged(sc, sc->err_wrap1, make_integer(sc, arg_n), arg, type_name_string(sc, arg), sc->err_wrap2));
+ return(simple_wrong_type_arg_error_prepackaged(sc, sc->err_wrap1, arg, type_name_string(sc, arg), sc->err_wrap2));
}
-static void s7_function_set_class(s7_pointer f, s7_pointer base_f)
+
+static s7_pointer out_of_range_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg_n, s7_pointer arg, s7_pointer descr)
{
- c_function_class(f) = c_function_class(base_f);
- c_function_set_base(f, base_f);
+ /* info list is '(format_string caller arg_n arg descr) */
+ set_wlist_4(sc, cdr(sc->out_of_range_info), caller, arg_n, arg, descr);
+ return(s7_error(sc, sc->out_of_range_symbol, sc->out_of_range_info));
}
-static int c_functions = 0;
-s7_pointer s7_make_function(s7_scheme *sc, const char *name, s7_function f, int required_args, int optional_args, bool rest_arg, const char *doc)
+static s7_pointer simple_out_of_range_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg, s7_pointer descr)
{
- c_proc_t *ptr;
- unsigned int ftype = T_C_FUNCTION;
- s7_pointer x;
+ set_wlist_3(sc, cdr(sc->simple_out_of_range_info), caller, arg, descr);
+ return(s7_error(sc, sc->out_of_range_symbol, sc->simple_out_of_range_info));
+}
- x = alloc_pointer();
- unheap(x);
- ptr = (c_proc_t *)malloc(sizeof(c_proc_t));
- c_functions++;
- if (required_args == 0)
- {
- if (rest_arg)
- ftype = T_C_ANY_ARGS_FUNCTION;
- else
- {
- if (optional_args != 0)
- ftype = T_C_OPT_ARGS_FUNCTION;
- /* a thunk needs to check for no args passed */
- }
- }
- else
- {
- if (rest_arg)
- ftype = T_C_RST_ARGS_FUNCTION;
- }
+s7_pointer s7_out_of_range_error(s7_scheme *sc, const char *caller, int arg_n, s7_pointer arg, const char *descr)
+{
+ /* info list is '(format_string caller arg_n arg descr) */
+ string_value(sc->err_wrap1) = (char *)caller;
+ string_length(sc->err_wrap1) = safe_strlen(caller);
+ string_value(sc->err_wrap2) = (char *)descr;
+ string_length(sc->err_wrap2) = safe_strlen(descr);
+ if (arg_n < 0) arg_n = 0;
- set_type(x, ftype | T_PROCEDURE);
+ if (arg_n > 0)
+ return(out_of_range_error_prepackaged(sc, sc->err_wrap1, make_integer(sc, arg_n), arg, sc->err_wrap2));
+ return(simple_out_of_range_error_prepackaged(sc, sc->err_wrap1, arg, sc->err_wrap2));
+}
- c_function_data(x) = ptr;
- c_function_call(x) = f;
- /* f is _TApp but needs cast */
- c_function_set_base(x, x);
- c_function_set_setter(x, sc->F);
- c_function_name(x) = name; /* (procedure-name proc) => (format #f "~A" proc) */
- c_function_name_length(x) = safe_strlen(name);
- if (doc)
- c_function_documentation(x) = make_permanent_string(doc);
- else c_function_documentation(x) = NULL;
- c_function_signature(x) = sc->F;
- c_function_required_args(x) = required_args;
- c_function_optional_args(x) = optional_args;
- c_function_has_rest_arg(x) = rest_arg;
- if (rest_arg)
- c_function_all_args(x) = MAX_ARITY;
- else c_function_all_args(x) = required_args + optional_args;
+s7_pointer s7_wrong_number_of_args_error(s7_scheme *sc, const char *caller, s7_pointer args)
+{
+ return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_2(sc, make_string_wrapper(sc, caller), args))); /* "caller" includes the format directives */
+}
- c_function_class(x) = ++sc->f_class;
- c_function_chooser(x) = fallback_chooser;
- c_function_rp(x) = NULL;
- c_function_ip(x) = NULL;
- c_function_pp(x) = NULL;
- c_function_gp(x) = NULL;
- return(x);
+static s7_pointer division_by_zero_error(s7_scheme *sc, s7_pointer caller, s7_pointer arg)
+{
+ return(s7_error(sc, sc->division_by_zero_symbol, set_elist_3(sc, sc->division_by_zero_error_string, caller, arg)));
}
-s7_pointer s7_make_safe_function(s7_scheme *sc, const char *name, s7_function f,
- int required_args, int optional_args, bool rest_arg, const char *doc)
+
+static s7_pointer file_error(s7_scheme *sc, const char *caller, const char *descr, const char *name)
{
- s7_pointer p;
- p = s7_make_function(sc, name, f, required_args, optional_args, rest_arg, doc);
- typeflag(p) |= T_SAFE_PROCEDURE; /* not set_type(p, type(p) ...) because that accidentally clears the T_PROCEDURE bit */
- return(p);
+ return(s7_error(sc, sc->io_error_symbol,
+ set_elist_4(sc, make_string_wrapper(sc, "~A: ~A ~S"),
+ make_string_wrapper(sc, caller),
+ make_string_wrapper(sc, descr),
+ make_string_wrapper(sc, name))));
}
-s7_pointer s7_make_typed_function(s7_scheme *sc, const char *name, s7_function f,
- int required_args, int optional_args, bool rest_arg, const char *doc, s7_pointer signature)
+static s7_pointer missing_method_error(s7_scheme *sc, s7_pointer method, s7_pointer obj)
{
- s7_pointer func;
- func = s7_make_function(sc, name, f, required_args, optional_args, rest_arg, doc);
- typeflag(func) |= T_SAFE_PROCEDURE;
- if (signature) c_function_signature(func) = signature;
- return(func);
+ return(s7_error(sc, sc->missing_method_symbol, set_elist_3(sc, sc->missing_method_string, method, obj)));
}
-bool s7_is_procedure(s7_pointer x)
+static s7_pointer closure_or_f(s7_scheme *sc, s7_pointer p)
{
- return(is_procedure(x)); /* this returns "is applicable" so it is true for applicable c_objects, macros, etc */
+ s7_pointer body;
+ if (!is_closure(p)) return(p);
+ body = closure_body(p);
+ if (is_pair(cdr(body))) return(p);
+ if (!is_pair(car(body))) return(sc->F);
+ if (caar(body) == sc->quote_symbol) return(sc->F);
+ return(p);
}
-static s7_pointer g_is_procedure(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_dynamic_wind(s7_scheme *sc, s7_pointer args)
{
- #define H_is_procedure "(procedure? obj) returns #t if obj is a procedure"
- #define Q_is_procedure pl_bt
- s7_pointer x;
- int typ;
+ #define H_dynamic_wind "(dynamic-wind init body finish) calls init, then body, then finish, \
+each a function of no arguments, guaranteeing that finish is called even if body is exited"
+ #define Q_dynamic_wind s7_make_circular_signature(sc, 1, 2, sc->values_symbol, sc->is_procedure_symbol)
- x = car(args);
- if ((!is_procedure(x)) || (is_c_object(x)))
- {
- check_method(sc, x, sc->is_procedure_symbol, args);
- return(sc->F);
- }
- typ = type(x);
+ s7_pointer p;
- /* make_object sets the T_PROCEDURE bit if the object has an apply function,
- * but we currently return (procedure? "hi") -> #f, so we can't simply use
- * is_procedure.
- *
- * Unfortunately much C code depends on s7_is_procedure treating applicable
- * objects and macros as procedures. We can use arity = applicable?
- */
- return(make_boolean(sc,
- (typ == T_CLOSURE) ||
- (typ == T_CLOSURE_STAR) ||
- (typ >= T_C_FUNCTION_STAR) ||
- (typ == T_GOTO) ||
- (typ == T_CONTINUATION)));
-}
+ if (!is_thunk(sc, car(args)))
+ method_or_bust_with_type(sc, car(args), sc->dynamic_wind_symbol, args, a_thunk_string, 1);
+ if (!is_thunk(sc, cadr(args)))
+ method_or_bust_with_type(sc, cadr(args), sc->dynamic_wind_symbol, args, a_thunk_string, 2);
+ if (!is_thunk(sc, caddr(args)))
+ method_or_bust_with_type(sc, caddr(args), sc->dynamic_wind_symbol, args, a_thunk_string, 3);
+ /* this won't work:
-static void s7_function_set_setter(s7_scheme *sc, const char *getter, const char *setter)
-{
- /* this is internal, used only with c_function setters, so we don't need to worry about the GC mark choice
- */
- c_function_set_setter(s7_name_to_value(sc, getter), s7_name_to_value(sc, setter));
-}
+ (let ((final (lambda (a b c) (list a b c))))
+ (dynamic-wind
+ (lambda () #f)
+ (lambda () (set! final (lambda () (display "in final"))))
+ final))
+ * but why not? 'final' is a thunk by the time it is evaluated.
+ * catch (the error handler) is similar.
+ *
+ * It can't work here because we set up the dynamic_wind_out slot below and
+ * even if the thunk check was removed, we'd still be trying to apply the original function.
+ */
-s7_pointer s7_closure_body(s7_scheme *sc, s7_pointer p)
-{
- if (has_closure_let(p))
- return(closure_body(p));
- return(sc->nil);
-}
+ new_cell(sc, p, T_DYNAMIC_WIND); /* don't mark car/cdr, don't copy */
+ dynamic_wind_in(p) = closure_or_f(sc, car(args));
+ dynamic_wind_body(p) = cadr(args);
+ dynamic_wind_out(p) = closure_or_f(sc, caddr(args));
+ /* since we don't care about the in and out results, and they are thunks, if the body is not a pair,
+ * or is a quoted thing, we just ignore that function.
+ */
-s7_pointer s7_closure_let(s7_scheme *sc, s7_pointer p)
-{
- if (has_closure_let(p))
- return(closure_let(p));
- return(sc->nil);
+ push_stack(sc, OP_DYNAMIC_WIND, sc->nil, p); /* args will be the saved result, code = s7_dynwind_t obj */
+ if (dynamic_wind_in(p) != sc->F)
+ {
+ dynamic_wind_state(p) = DWIND_INIT;
+ push_stack(sc, OP_APPLY, sc->nil, dynamic_wind_in(p));
+ }
+ else
+ {
+ dynamic_wind_state(p) = DWIND_BODY;
+ push_stack(sc, OP_APPLY, sc->nil, dynamic_wind_body(p));
+ }
+ return(sc->F);
}
-s7_pointer s7_closure_args(s7_scheme *sc, s7_pointer p)
+s7_pointer s7_dynamic_wind(s7_scheme *sc, s7_pointer init, s7_pointer body, s7_pointer finish)
{
- if (has_closure_let(p))
- return(closure_args(p));
- return(sc->nil);
-}
+ /* this is essentially s7_call with a dynamic-wind wrapper around "body" */
+ s7_pointer p;
+ declare_jump_info();
+ sc->temp1 = ((init == sc->F) ? finish : init);
+ sc->temp2 = body;
-static s7_pointer c_procedure_source(s7_scheme *sc, s7_pointer p)
-{
- /* make it look like a scheme-level lambda */
- if (is_symbol(p))
+ store_jump_info(sc);
+ set_jump_info(sc, DYNAMIC_WIND_SET_JUMP);
+ if (jump_loc != NO_JUMP)
{
- p = s7_symbol_value(sc, p);
- if (p == sc->undefined)
- return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "procedure-source arg, '~S, is unbound"), p)));
+ if (jump_loc != ERROR_JUMP)
+ eval(sc, sc->op);
}
-
- if ((is_c_function(p)) || (is_c_macro(p)))
- return(sc->nil);
-
- check_method(sc, p, sc->procedure_source_symbol, list_1(sc, p));
- if (has_closure_let(p))
+ else
{
- s7_pointer body;
- body = closure_body(p);
- if (is_safe_closure(body))
- clear_safe_closure(body);
- return(append_in_place(sc, list_2(sc, ((is_closure_star(p)) ||
- (is_macro_star(p)) ||
- (is_bacro_star(p))) ? sc->lambda_star_symbol : sc->lambda_symbol,
- closure_args(p)), body));
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->args = sc->nil;
+
+ new_cell(sc, p, T_DYNAMIC_WIND);
+ dynamic_wind_in(p) = _NFre(init);
+ dynamic_wind_body(p) = _NFre(body);
+ dynamic_wind_out(p) = _NFre(finish);
+ push_stack(sc, OP_DYNAMIC_WIND, sc->nil, p);
+ if (init != sc->F)
+ {
+ dynamic_wind_state(p) = DWIND_INIT;
+ sc->code = init;
+ }
+ else
+ {
+ dynamic_wind_state(p) = DWIND_BODY;
+ sc->code = body;
+ }
+ eval(sc, OP_APPLY);
}
+ restore_jump_info(sc);
+ sc->temp1 = sc->nil;
+ sc->temp2 = sc->nil;
- if (!is_procedure(p))
- return(simple_wrong_type_argument_with_type(sc, sc->procedure_source_symbol, p, make_string_wrapper(sc, "a procedure or a macro")));
- return(sc->nil);
+ if (is_multiple_value(sc->value))
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+ return(sc->value);
}
-static s7_pointer g_procedure_source(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer g_catch(s7_scheme *sc, s7_pointer args)
{
- #define H_procedure_source "(procedure-source func) tries to return the definition of func"
- #define Q_procedure_source s7_make_signature(sc, 2, sc->is_list_symbol, sc->is_procedure_symbol)
- return(c_procedure_source(sc, car(args)));
-}
+ #define H_catch "(catch tag thunk handler) evaluates thunk; if an error occurs that matches the tag (#t matches all), the handler is called"
+ #define Q_catch s7_make_circular_signature(sc, 2, 3, sc->values_symbol, sc->T, sc->is_procedure_symbol)
+
+ s7_pointer p, proc, err;
+
+ /* Guile sets up the catch before looking for arg errors:
+ * (catch #t log (lambda args "hiho")) -> "hiho"
+ * which is consistent in that (catch #t (lambda () (log))...) should probably be the same as (catch #t log ...)
+ * but what if the error handler arg is messed up? Weird to handle args in reverse order with an intervening frame etc.
+ */
-PF_TO_PF(procedure_source, c_procedure_source)
+ proc = cadr(args);
+ err = caddr(args);
+ /* if (is_let(err)) check_method(sc, err, sc->catch_symbol, args); */ /* causes exit from s7! */
+ 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_handler(p) = err;
-s7_pointer s7_funclet(s7_scheme *sc, s7_pointer p)
-{
- if (has_closure_let(p))
- return(closure_let(p));
- return(sc->rootlet);
-}
+ if (is_any_macro(err))
+ push_stack(sc, OP_CATCH_2, args, p);
+ else push_stack(sc, OP_CATCH, args, p); /* args ignored but maybe safer for GC? */
+ /* not sure about these error checks -- they can be omitted */
+ if (!is_thunk(sc, proc))
+ return(wrong_type_argument_with_type(sc, sc->catch_symbol, 2, proc, a_thunk_string));
-static s7_pointer g_funclet(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer p, e;
- #define H_funclet "(funclet func) tries to return an object's environment"
- #define Q_funclet s7_make_signature(sc, 2, sc->is_let_symbol, sc->is_procedure_symbol)
+ if (!is_applicable(err))
+ return(wrong_type_argument_with_type(sc, sc->catch_symbol, 3, err, something_applicable_string));
- /* this procedure gives direct access to a function's closure -- see s7test.scm
- * for some wild examples. At least it provides a not-too-kludgey way for several functions
- * to share a closure.
+ /* should we check here for (aritable? err 2)? -- right now:
+ * (catch #t (lambda () 1) "hiho") -> 1
+ * currently this is checked only if the error handler is called
*/
- p = car(args);
- if (is_symbol(p))
+ if (is_closure(proc)) /* not also lambda* here because we need to handle the arg defaults */
{
- p = s7_symbol_value(sc, p);
- if (p == sc->undefined)
- return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "funclet arg, '~S, is unbound"), car(args)))); /* not p here */
+ /* is_thunk above checks is_aritable(proc, 0), but if it's (lambda args ...) we have to set up the frame with args=()
+ * the case that caught this: (catch #t make-hook ...)
+ */
+ sc->code = closure_body(proc);
+ 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);
}
- check_method(sc, p, sc->funclet_symbol, args);
+ else push_stack(sc, OP_APPLY, sc->nil, proc);
- if (!is_procedure_or_macro(p))
- return(simple_wrong_type_argument_with_type(sc, sc->funclet_symbol, p, make_string_wrapper(sc, "a procedure or a macro")));
+ return(sc->F);
+}
- e = find_let(sc, p);
- if ((is_null(e)) &&
- (!is_c_object(p)))
- return(sc->rootlet);
+/* s7_catch(sc, tag, body, error): return(g_catch(sc, list(sc, 3, tag, body, error))) */
- return(e);
-}
+/* error reporting info -- save filename and line number */
+
+#define remember_location(Line, File) (((File) << 20) | (Line))
+#define remembered_line_number(Line) ((Line) & 0xfffff)
+#define remembered_file_name(Line) ((((Line) >> 20) <= sc->file_names_top) ? sc->file_names[Line >> 20] : sc->F)
+/* this gives room for 4000 files each of 1000000 lines */
-s7_pointer s7_define_function(s7_scheme *sc, const char *name, s7_function fnc,
- int required_args, int optional_args, bool rest_arg, const char *doc)
+static int remember_file_name(s7_scheme *sc, const char *file)
{
- s7_pointer func, sym;
- func = s7_make_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
- sym = make_symbol(sc, name);
- s7_define(sc, sc->nil, sym, func);
- return(sym);
-}
+ int i;
+ for (i = 0; i <= sc->file_names_top; i++)
+ if (safe_strcmp(file, string_value(sc->file_names[i])))
+ return(i);
-s7_pointer s7_define_safe_function(s7_scheme *sc, const char *name, s7_function fnc,
- int required_args, int optional_args, bool rest_arg, const char *doc)
-{
- /* returns (string->symbol name), not the c_proc_t func */
- s7_pointer func, sym;
- func = s7_make_safe_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
- sym = make_symbol(sc, name);
- s7_define(sc, sc->nil, sym, func);
- return(sym);
+ sc->file_names_top++;
+ if (sc->file_names_top >= sc->file_names_size)
+ {
+ int old_size = 0;
+ if (sc->file_names_size == 0)
+ {
+ sc->file_names_size = INITIAL_FILE_NAMES_SIZE;
+ sc->file_names = (s7_pointer *)calloc(sc->file_names_size, sizeof(s7_pointer));
+ }
+ else
+ {
+ old_size = sc->file_names_size;
+ sc->file_names_size *= 2;
+ sc->file_names = (s7_pointer *)realloc(sc->file_names, sc->file_names_size * sizeof(s7_pointer));
+ }
+ for (i = old_size; i < sc->file_names_size; i++)
+ sc->file_names[i] = sc->F;
+ }
+ sc->file_names[sc->file_names_top] = s7_make_permanent_string(file);
+
+ return(sc->file_names_top);
}
-s7_pointer s7_define_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
- int required_args, int optional_args, bool rest_arg,
- const char *doc, s7_pointer signature)
+static s7_pointer init_owlet(s7_scheme *sc)
{
- /* returns (string->symbol name), not the c_proc_t func */
- s7_pointer func, sym;
- func = s7_make_typed_function(sc, name, fnc, required_args, optional_args, rest_arg, doc, signature);
- sym = make_symbol(sc, name);
- s7_define(sc, sc->nil, sym, func);
- return(sym);
+ s7_pointer e;
+ e = new_frame_in_env(sc, sc->rootlet);
+ sc->temp3 = e;
+ sc->error_type = make_slot_1(sc, e, make_symbol(sc, "error-type"), sc->F); /* the error type or tag ('division-by-zero) */
+ sc->error_data = make_slot_1(sc, e, make_symbol(sc, "error-data"), sc->F); /* the message or information passed by the error function */
+ sc->error_code = make_slot_1(sc, e, make_symbol(sc, "error-code"), sc->F); /* the code that s7 thinks triggered the error */
+ sc->error_line = make_slot_1(sc, e, make_symbol(sc, "error-line"), sc->F); /* the line number of that code */
+ sc->error_file = make_slot_1(sc, e, make_symbol(sc, "error-file"), sc->F); /* the file name of that code */
+#if WITH_HISTORY
+ sc->error_history = make_slot_1(sc, e, make_symbol(sc, "error-history"), sc->F); /* buffer of previous evaluations */
+#endif
+ return(e);
}
-s7_pointer s7_define_unsafe_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
- int required_args, int optional_args, bool rest_arg,
- const char *doc, s7_pointer signature)
+static s7_pointer g_owlet(s7_scheme *sc, s7_pointer args)
{
- /* returns (string->symbol name), not the c_proc_t func */
- s7_pointer func, sym;
- func = s7_make_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
- if (signature) c_function_signature(func) = signature;
- sym = make_symbol(sc, name);
- s7_define(sc, sc->nil, sym, func);
- return(sym);
-}
+#if WITH_HISTORY
+ #define H_owlet "(owlet) returns the environment at the point of the last error. \
+It has the additional local variables: error-type, error-data, error-code, error-line, error-file, and error-history."
+#else
+ #define H_owlet "(owlet) returns the environment at the point of the last error. \
+It has the additional local variables: error-type, error-data, error-code, error-line, and error-file."
+#endif
+ #define Q_owlet s7_make_signature(sc, 1, sc->is_let_symbol)
+ /* if owlet is not copied, (define e (owlet)), e changes as owlet does!
+ */
+ s7_pointer e, x;
+ unsigned int gc_loc;
+ e = let_copy(sc, sc->owlet);
+ gc_loc = s7_gc_protect(sc, e);
-s7_pointer s7_define_macro(s7_scheme *sc, const char *name, s7_function fnc,
- int required_args, int optional_args, bool rest_arg, const char *doc)
-{
- s7_pointer func, sym;
- func = s7_make_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
- set_type(func, T_C_MACRO | T_DONT_EVAL_ARGS); /* this used to include T_PROCEDURE */
- sym = make_symbol(sc, name);
- s7_define(sc, sc->nil, sym, func);
- return(sym);
+ /* also make sure the pairs are copied: should be error-data, error-code, and possibly error-history */
+ for (x = let_slots(e); is_slot(x); x = next_slot(x))
+ if (is_pair(slot_value(x)))
+ slot_set_value(x, protected_list_copy(sc, slot_value(x)));
+
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(e);
}
-bool s7_is_macro(s7_scheme *sc, s7_pointer x)
+static s7_pointer active_catches(s7_scheme *sc)
{
- return(is_any_macro(x));
-}
+ int i;
+ s7_pointer x, lst;
+ lst = sc->nil;
+ for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
+ switch (stack_op(sc->stack, i))
+ {
+ case OP_CATCH_ALL:
+ lst = cons(sc, sc->T, lst);
+ break;
+ case OP_CATCH_2:
+ case OP_CATCH_1:
+ case OP_CATCH:
+ x = stack_code(sc->stack, i);
+ lst = cons(sc, catch_tag(x), lst);
+ break;
+ }
+ return(reverse_in_place_unchecked(sc, sc->nil, lst));
+}
-static s7_pointer g_is_macro(s7_scheme *sc, s7_pointer args)
+static s7_pointer active_exits(s7_scheme *sc)
{
- #define H_is_macro "(macro? arg) returns #t if 'arg' is a macro or a bacro"
- #define Q_is_macro pl_bt
- check_boolean_method(sc, is_any_macro, sc->is_macro_symbol, args);
-}
+ /* (call-with-exit (lambda (exiter) (*s7* 'exits))) */
+ int i;
+ s7_pointer lst;
+ lst = sc->nil;
+ for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
+ if (stack_op(sc->stack, i) == OP_DEACTIVATE_GOTO)
+ {
+ s7_pointer func, jump;
+ func = stack_code(sc->stack, i); /* presumably this has the goto name */
+ 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);
+ 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);
+ }
+ sc->w = lst;
+ }
+ return(reverse_in_place_unchecked(sc, sc->nil, lst));
+}
-static void define_function_star_1(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc, bool safe)
+static s7_pointer stack_entries(s7_scheme *sc, s7_pointer stack, int top)
{
- s7_pointer func, sym, local_args, p;
- char *internal_arglist;
- int i, len, n_args;
- unsigned int gc_loc;
- s7_pointer *names, *defaults;
+ int i;
+ s7_pointer lst;
+ lst = sc->nil;
+ for (i = top - 1; i >= 3; i -= 4)
+ {
+ s7_pointer func, args, e;
+ opcode_t op;
+ func = stack_code(stack, i);
+ args = stack_args(stack, i);
+ e = stack_let(stack, i);
+ op = stack_op(stack, i);
+ if ((s7_is_valid(sc, func)) &&
+ (s7_is_valid(sc, args)) &&
+ (s7_is_valid(sc, e)) &&
+ (op < OP_MAX_DEFINED))
+ {
+#if DEBUGGING
+ if (op < OP_MAX_DEFINED_1)
+ lst = cons(sc, list_4(sc, func, args, e, make_string_wrapper(sc, op_names[op])), lst);
+ else lst = cons(sc, list_4(sc, func, args, e, make_integer(sc, op)), lst);
+#else
+ lst = cons(sc, list_4(sc, func, args, e, make_integer(sc, op)), lst);
+#endif
+ sc->w = lst;
+ }
+ }
+ return(reverse_in_place_unchecked(sc, sc->nil, lst));
+}
- len = safe_strlen(arglist) + 8;
- tmpbuf_malloc(internal_arglist, len);
- snprintf(internal_arglist, len, "'(%s)", arglist);
- local_args = s7_eval_c_string(sc, internal_arglist);
- gc_loc = s7_gc_protect(sc, local_args);
- tmpbuf_free(internal_arglist, len);
- n_args = safe_list_length(sc, local_args); /* currently rest arg not supported, and we don't notice :allow-other-keys etc */
- func = s7_make_function(sc, name, fnc, 0, n_args, false, doc);
- if (safe)
- set_type(func, T_C_FUNCTION_STAR | T_PROCEDURE | T_SAFE_PROCEDURE);
- else set_type(func, T_C_FUNCTION_STAR | T_PROCEDURE);
+/* catch handlers */
- c_function_call_args(func) = make_list(sc, n_args, sc->F);
- s7_remove_from_heap(sc, c_function_call_args(func));
+typedef bool (*catch_function)(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook);
+static catch_function catchers[OP_MAX_DEFINED + 1];
- sym = make_symbol(sc, name);
- s7_define(sc, sc->nil, sym, func);
+/* here and below, don't free the catcher */
- names = (s7_pointer *)malloc(n_args * sizeof(s7_pointer));
- c_function_arg_names(func) = names;
- defaults = (s7_pointer *)malloc(n_args * sizeof(s7_pointer));
- c_function_arg_defaults(func) = defaults;
- set_simple_defaults(func);
+static bool catch_all_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+ s7_pointer catcher;
+ catcher = stack_let(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);
+ return(true);
+}
- for (p = local_args, i = 0; i < n_args; p = cdr(p), i++)
+static bool catch_2_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+ /* this is the macro-error-handler case from g_catch
+ * (let () (define-macro (m . args) (apply (car args) (cadr args))) (catch #t (lambda () (error abs -1)) m))
+ */
+ s7_pointer x;
+ x = stack_code(sc->stack, i);
+ if ((catch_tag(x) == sc->T) ||
+ (catch_tag(x) == type) ||
+ (type == sc->T))
{
- s7_pointer arg;
- arg = car(p);
- if (is_pair(arg))
- {
- names[i] = s7_make_keyword(sc, symbol_name(car(arg)));
- defaults[i] = cadr(arg);
- s7_remove_from_heap(sc, cadr(arg));
- if ((is_symbol(defaults[i])) ||
- (is_pair(defaults[i])))
- {
- clear_simple_defaults(func);
- mark_function[T_C_FUNCTION_STAR] = mark_c_proc_star;
- }
- }
+ int 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);
+ sc->code = catch_handler(x);
+
+ if (needs_copied_args(sc->code))
+ sc->args = list_2(sc, type, info);
else
{
- names[i] = s7_make_keyword(sc, symbol_name(arg));
- defaults[i] = sc->F;
+ set_car(sc->t2_1, type);
+ set_car(sc->t2_2, info);
+ sc->args = sc->t2_1;
}
+ sc->op = OP_APPLY;
+ return(true);
}
- s7_gc_unprotect_at(sc, gc_loc);
-}
-
-void s7_define_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc)
-{
- define_function_star_1(sc, name, fnc, arglist, doc, false);
-}
-
-void s7_define_safe_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc)
-{
- define_function_star_1(sc, name, fnc, arglist, doc, true);
+ return(false);
}
-
-static s7_pointer set_c_function_call_args(s7_scheme *sc)
+static bool catch_1_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
{
- int i, j, n_args;
- s7_pointer arg, par, call_args, func;
- s7_pointer *df;
+ s7_pointer x;
+ x = stack_code(sc->stack, i);
+ if ((catch_tag(x) == sc->T) ||
+ (catch_tag(x) == type) ||
+ (type == sc->T))
+ {
+ unsigned int loc;
+ opcode_t op;
+ s7_pointer catcher, error_func, body;
- func = sc->code;
- n_args = c_function_all_args(func);
- call_args = c_function_call_args(func);
+ op = stack_op(sc->stack, i);
+ sc->temp4 = stack_let(sc->stack, i); /* GC protect this, since we're moving the stack top below */
+ catcher = x;
+ loc = catch_goto_loc(catcher);
+ sc->op_stack_now = (s7_pointer *)(sc->op_stack + catch_op_loc(catcher));
+ sc->stack_end = (s7_pointer *)(sc->stack_start + loc);
+ error_func = catch_handler(catcher);
- df = c_function_arg_defaults(func);
- for (i = 0, par = call_args; is_pair(par); i++, par = cdr(par))
- {
- clear_checked(par);
- set_car(par, df[i]);
- }
+ /* very often the error handler just returns either a constant ('error or #f), or
+ * the args passed to it, so there's no need to laboriously make a closure,
+ * and apply it -- just set sc->value to the closure body (or the args) and
+ * return.
+ *
+ * so first examine closure_body(error_func)
+ * if it is a constant, or quoted symbol, return that,
+ * if it is the args symbol, return (list type info)
+ */
- df = c_function_arg_names(func);
- for (i = 0, arg = sc->args, par = call_args; (i < n_args) && (is_pair(arg)); i++, arg = cdr(arg), par = cdr(par))
- {
- if (!is_keyword(car(arg)))
- {
- if (is_checked(par))
- return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, make_string_wrapper(sc, "parameter set twice, ~S in ~S"), car(par), sc->args)));
- set_checked(par);
- set_car(par, car(arg));
- }
+ /* if OP_CATCH_1, we deferred making the error handler until it is actually needed */
+ if (op == OP_CATCH_1)
+ body = cdr(error_func);
else
{
- s7_pointer p;
- for (j = 0, p = call_args; j < n_args; j++, p = cdr(p))
- if (df[j] == car(arg))
- break;
- if (j == n_args)
- return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "~A: not a parameter name?"), car(arg))));
- if (is_checked(p))
- return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_3(sc, make_string_wrapper(sc, "parameter set twice, ~S in ~S"), car(p), sc->args)));
- set_checked(p);
- arg = cdr(arg);
- set_car(p, car(arg));
+ if (is_closure(error_func))
+ body = closure_body(error_func);
+ else body = NULL;
}
- }
- if (!is_null(arg))
- return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, func, sc->args)));
-
- if (!has_simple_defaults(func))
- for (i = 0, par = call_args; i < n_args; i++, par = cdr(par))
- if (!is_checked(par))
+ if ((body) && (is_null(cdr(body))))
{
- if (is_symbol(car(par)))
- set_car(par, find_symbol_checked(sc, car(par)));
+ s7_pointer y = NULL;
+ body = car(body);
+ if (is_pair(body))
+ {
+ if (car(body) == sc->quote_symbol)
+ y = cadr(body);
+ else
+ {
+ if ((car(body) == sc->car_symbol) &&
+ (is_pair(error_func)) &&
+ (cadr(body) == car(error_func)))
+ y = type;
+ }
+ }
else
{
- if (is_pair(car(par)))
- set_car(par, s7_eval(sc, car(par), sc->nil));
+ if (is_symbol(body))
+ {
+ if ((is_pair(error_func)) &&
+ (body == car(error_func)))
+ y = list_2(sc, type, info);
+ }
+ else y = body;
}
- }
- return(call_args);
-}
-
-
-/* -------------------------------- procedure-documentation -------------------------------- */
-static s7_pointer get_doc(s7_scheme *sc, s7_pointer x)
-{
- check_closure_for(sc, x, sc->documentation_symbol);
- return(NULL);
-}
-
-const char *s7_procedure_documentation(s7_scheme *sc, s7_pointer x)
-{
- s7_pointer val;
- if (is_symbol(x))
- {
- if ((symbol_has_help(x)) &&
- (is_global(x)))
- return(symbol_help(x));
- x = s7_symbol_value(sc, x); /* this is needed by Snd */
- }
-
- if ((is_any_c_function(x)) ||
- (is_c_macro(x)))
- return((char *)c_function_documentation(x));
+ if (y)
+ {
+ if (loc > 4)
+ pop_stack(sc);
+ /* we're at OP_CATCH, normally we want to pop that away, but (handwaving...) if we're coming
+ * from s7_eval (indirectly perhaps through s7_eval_c_string), we might push the OP_EVAL_DONE
+ * to end that call, but it's pushed at the precatch stack end (far beyond the catch loc).
+ * If we catch an error, catch unwinds to its starting point, and the pop_stack above
+ * puts us at the bottom of the stack (i.e. stack_end == stack_start), OP_EVAL_DONE.
+ * Now we return true, ending up back in eval, because the error handler jumped out of eval,
+ * back to wherever we were in eval when we hit the error. eval jumps back to the start
+ * of its loop, and pops the stack to see what to do next! So the (loc > 4) at least
+ * protects against stack underflow, but ideally we'd know we came from OP_CATCH+s7_eval.
+ * We can't do anything fancy here because we have to unwind the C stack as well as s7's stack.
+ * s7_eval doesn't know anything about the catches on the stack. We can't look back for
+ * OP_EVAL_DONE -- segfault in OP_BEGIN. Hmmmm. Perhaps catch should not unwind until the
+ * end? But we want the error handler to run as a part of the calling expression, and
+ * in any case the OP_EVAL_DONE is not useful (it marks the end of the no-error case).
+ */
+ sc->value = y;
+ sc->temp4 = sc->nil;
- val = get_doc(sc, x);
- if ((val) && (is_string(val)))
- return(string_value(val));
+ if (loc == 4)
+ sc->code = cons(sc, sc->value, sc->nil); /* if we end up at op_begin, give it something it can handle */
- return(NULL);
-}
+ return(true);
+ }
+ }
+ 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;
+ }
+ else sc->code = error_func;
+ sc->temp4 = sc->nil;
-static s7_pointer c_procedure_documentation(s7_scheme *sc, s7_pointer p)
-{
- if (is_symbol(p))
- {
- if ((symbol_has_help(p)) &&
- (is_global(p)))
- return(s7_make_string(sc, symbol_help(p)));
- p = s7_symbol_value(sc, p);
- }
+ /* if user (i.e. yers truly!) copies/pastes the preceding lambda () into the
+ * error handler portion of the catch, he gets the inexplicable message:
+ * ;(): too many arguments: (a1 ())
+ * when this apply tries to call the handler. So, we need a special case
+ * error check here!
+ */
- check_method(sc, p, sc->procedure_documentation_symbol, list_1(sc, p));
- if ((!is_procedure(p)) &&
- (!s7_is_macro(sc, p)))
- return(simple_wrong_type_argument_with_type(sc, sc->procedure_documentation_symbol, p, a_procedure_string));
+ if (!s7_is_aritable(sc, sc->code, 2))
+ {
+ s7_wrong_number_of_args_error(sc, "catch error handler should accept 2 args: ~S", sc->code);
+ return(false);
+ }
- return(s7_make_string(sc, s7_procedure_documentation(sc, p)));
-}
+ /* 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;
-static s7_pointer g_procedure_documentation(s7_scheme *sc, s7_pointer args)
-{
- #define H_procedure_documentation "(procedure-documentation func) returns func's documentation string"
- #define Q_procedure_documentation s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_procedure_symbol)
- return(c_procedure_documentation(sc, car(args)));
+ /* 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,
+ * so defer it until s7_call
+ */
+ return(true);
+ }
+ return(false);
}
-PF_TO_PF(procedure_documentation, c_procedure_documentation)
-
-
-/* -------------------------------- help -------------------------------- */
-const char *s7_help(s7_scheme *sc, s7_pointer obj)
+static bool catch_dw_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
{
- if (is_syntax(obj))
- return(string_value(syntax_documentation(obj)));
-
- if (is_symbol(obj))
+ s7_pointer x;
+ x = stack_code(sc->stack, i);
+ if (dynamic_wind_state(x) == DWIND_BODY)
{
- /* here look for name */
- if (s7_symbol_documentation(sc, obj))
- return(s7_symbol_documentation(sc, obj));
- obj = s7_symbol_value(sc, obj);
+ dynamic_wind_state(x) = DWIND_FINISH; /* make sure an uncaught error in the exit thunk doesn't cause us to loop */
+ if (dynamic_wind_out(x) != sc->F)
+ {
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->code = dynamic_wind_out(x);
+ sc->args = sc->nil;
+ eval(sc, OP_APPLY); /* I guess this means no call/cc out of the exit thunk in an error-catching context */
+ }
}
-
- if (is_procedure_or_macro(obj))
- return(s7_procedure_documentation(sc, obj));
-
- /* if is string, apropos? (can scan symbol table) */
- return(NULL);
+ return(false);
}
-
-static s7_pointer g_help(s7_scheme *sc, s7_pointer args)
+static bool catch_out_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
{
- #define H_help "(help obj) returns obj's documentation"
- #define Q_help s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_boolean_symbol), sc->T)
- const char *doc;
-
- check_method(sc, car(args), sc->help_symbol, args);
- doc = s7_help(sc, car(args));
- if (!doc)
- return(sc->F);
- return(s7_make_string(sc, doc));
+ s7_pointer x;
+ x = stack_code(sc->stack, i); /* "code" = port that we opened */
+ s7_close_output_port(sc, x);
+ x = stack_args(sc->stack, i); /* "args" = port that we shadowed, if not #f */
+ if (x != sc->F)
+ sc->output_port = x;
+ return(false);
}
-static s7_pointer c_help(s7_scheme *sc, s7_pointer x) {return(g_help(sc, set_plist_1(sc, x)));}
-PF_TO_PF(help, c_help)
-
+static bool catch_in_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+ s7_close_input_port(sc, stack_code(sc->stack, i)); /* "code" = port that we opened */
+ sc->input_port = stack_args(sc->stack, i); /* "args" = port that we shadowed */
+ return(false);
+}
-/* -------------------------------- procedure-signature -------------------------------- */
-static s7_pointer get_signature(s7_scheme *sc, s7_pointer x)
+static bool catch_read_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
{
- check_closure_for(sc, x, sc->signature_symbol);
- return(sc->F);
+ pop_input_port(sc);
+ return(false);
}
-static s7_pointer s7_procedure_signature(s7_scheme *sc, s7_pointer x)
+static bool catch_eval_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
{
- if ((is_any_c_function(x)) ||
- (is_c_macro(x)))
- return((s7_pointer)c_function_signature(x));
- return(get_signature(sc, x));
+ s7_close_input_port(sc, sc->input_port);
+ pop_input_port(sc);
+ return(false);
}
-static s7_pointer c_procedure_signature(s7_scheme *sc, s7_pointer p)
+static bool catch_barrier_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
{
- if (is_symbol(p))
+ if (is_input_port(stack_args(sc->stack, i))) /* (eval-string "'(1 .)") */
{
- p = s7_symbol_value(sc, p);
- if (p == sc->undefined)
- return(sc->F);
+ if (sc->input_port == stack_args(sc->stack, i))
+ pop_input_port(sc);
+ s7_close_input_port(sc, stack_args(sc->stack, i));
}
- 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(false);
}
-static s7_pointer g_procedure_signature(s7_scheme *sc, s7_pointer args)
+static bool catch_hook_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
{
- #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)
-
- return(c_procedure_signature(sc, car(args)));
+ sc->error_hook = stack_code(sc->stack, i);
+ /* apparently there was an error during *error-hook* evaluation, but Rick wants the hook re-established anyway */
+ (*reset_hook) = true;
+ /* avoid infinite loop -- don't try to (re-)evaluate (buggy) *error-hook*! */
+ return(false);
}
-PF_TO_PF(procedure_signature, c_procedure_signature)
-
-
-/* -------------------------------- new types (c_objects) -------------------------------- */
-
-static void fallback_free(void *value) {}
-static void fallback_mark(void *value) {}
-
-static char *fallback_print(s7_scheme *sc, void *val)
+static bool catch_goto_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
{
- return(copy_string("#<unprintable object>"));
+ call_exit_active(stack_args(sc->stack, i)) = false;
+ return(false);
}
-static char *fallback_print_readably(s7_scheme *sc, void *val)
+static void init_catchers(void)
{
- return(copy_string("#<unprint-readable object>"));
+ int i;
+ for (i = 0; i <= OP_MAX_DEFINED; i++) catchers[i] = NULL;
+ catchers[OP_CATCH_ALL] = catch_all_function;
+ catchers[OP_CATCH_2] = catch_2_function;
+ catchers[OP_CATCH_1] = catch_1_function;
+ catchers[OP_CATCH] = catch_1_function;
+ catchers[OP_DYNAMIC_WIND] = catch_dw_function;
+ catchers[OP_GET_OUTPUT_STRING_1] = catch_out_function;
+ catchers[OP_UNWIND_OUTPUT] = catch_out_function;
+ catchers[OP_UNWIND_INPUT] = catch_in_function;
+ catchers[OP_READ_DONE] = catch_read_function; /* perhaps an error during (read) */
+ catchers[OP_EVAL_STRING_1] = catch_eval_function; /* perhaps an error happened before we could push the OP_EVAL_STRING_2 */
+ catchers[OP_EVAL_STRING_2] = catch_eval_function;
+ catchers[OP_BARRIER] = catch_barrier_function;
+ catchers[OP_DEACTIVATE_GOTO] = catch_goto_function;
+ catchers[OP_ERROR_HOOK_QUIT] = catch_hook_function;
}
-static bool fallback_equal(void *val1, void *val2)
+static s7_pointer g_throw(s7_scheme *sc, s7_pointer args)
{
- return(val1 == val2);
-}
+ #define H_throw "(throw tag . info) is like (error ...) but it does not affect the owlet. \
+It looks for an existing catch with a matching tag, and jumps to it if found. Otherwise it raises an error."
+ #define Q_throw pcl_t
-static s7_pointer fallback_ref(s7_scheme *sc, s7_pointer obj, s7_pointer args)
-{
- return(apply_error(sc, obj, args));
-}
+ bool ignored_flag = false;
+ int i;
+ s7_pointer type, info;
-static s7_pointer fallback_set(s7_scheme *sc, s7_pointer obj, s7_pointer args)
-{
- eval_error(sc, "attempt to set ~S?", obj);
-}
+ type = car(args);
+ info = cdr(args);
+ /* look for a catcher */
-static s7_pointer fallback_length(s7_scheme *sc, s7_pointer obj)
-{
- return(sc->F);
+ for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
+ {
+ catch_function catcher;
+ catcher = catchers[stack_op(sc->stack, i)];
+ if ((catcher) &&
+ (catcher(sc, i, type, info, &ignored_flag)))
+ {
+ if (sc->longjmp_ok) longjmp(sc->goto_start, THROW_JUMP);
+ return(sc->value);
+ }
+ }
+ if (is_let(car(args)))
+ check_method(sc, car(args), sc->throw_symbol, args);
+ return(s7_error(sc, make_symbol(sc, "uncaught-throw"),
+ set_elist_3(sc, make_string_wrapper(sc, "no catch found for (throw ~W~{~^ ~S~})"), type, info)));
}
-bool s7_is_object(s7_pointer p)
+static void s7_warn(s7_scheme *sc, int len, const char *ctrl, ...)
{
- return(is_c_object(p));
-}
+ va_list ap;
+ char *str;
-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 Q_is_c_object pl_bt
+ str = (char *)malloc(len * sizeof(char));
+ va_start(ap, ctrl);
+ len = vsnprintf(str, len, ctrl, ap);
+ va_end(ap);
- 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 */
- check_method(sc, p, sc->is_c_object_symbol, args);
- return(sc->F);
- /* <1> (*s7* 'c-types)
- ("<random-number-generator>")
- <2> (c-object? (random-state 123))
- 0
- */
+ if (port_is_closed(sc->error_port))
+ sc->error_port = sc->standard_error;
+ s7_display(sc, make_string_uncopied_with_length(sc, str, len), sc->error_port);
}
-static s7_pointer g_internal_object_set(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info)
{
- return((*(c_object_set(car(args))))(sc, car(args), cdr(args)));
-}
+ static int last_line = -1;
+ bool reset_error_hook = false;
+ s7_pointer cur_code;
+ /* type is a symbol normally, and info is compatible with format: (apply format #f info) --
+ * car(info) is the control string, cdr(info) its args
+ * type/range errors have cadr(info)=caller, caddr(info)=offending arg number
+ * null info can mean symbol table is locked so make-symbol uses s7_error to get out
+ *
+ * set up (owlet), look for a catch that matches 'type', if found
+ * call its error-handler, else if *error-hook* is bound, call it,
+ * else send out the error info ourselves.
+ */
+ sc->no_values = 0;
+ sc->format_depth = -1;
+ sc->gc_off = false; /* this is in case we were triggered from the sort function -- clumsy! */
-int s7_new_type(const char *name,
- char *(*print)(s7_scheme *sc, void *value),
- void (*gc_free)(void *value),
- bool (*equal)(void *val1, void *val2),
- void (*gc_mark)(void *val),
- s7_pointer (*ref)(s7_scheme *sc, s7_pointer obj, s7_pointer args),
- s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args))
-{
- int tag;
- tag = num_object_types++;
- if (tag >= object_types_size)
+ if (sc->current_safe_list > 0)
{
- if (object_types_size == 0)
+ clear_list_in_use(sc->safe_lists[sc->current_safe_list]);
+ sc->current_safe_list = 0;
+ }
+ 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 */
+
+ set_outlet(sc->owlet, sc->envir);
+
+ cur_code = current_code(sc);
+ slot_set_value(sc->error_code, cur_code);
+#if WITH_HISTORY
+ slot_set_value(sc->error_history, sc->cur_code);
+ if (sc->using_history1)
+ sc->cur_code = sc->eval_history2;
+ else sc->cur_code = sc->eval_history1;
+ sc->using_history1 = (!sc->using_history1);
+#endif
+
+ if ((is_pair(cur_code)) && /* can be () if unexpected close paren read error */
+ (has_line_number(cur_code)))
+ {
+ int line;
+ line = (int)pair_line(cur_code); /* cast to int (from unsigned int) for last_line */
+ if (line != last_line)
{
- object_types_size = 8;
- object_types = (c_object_t **)calloc(object_types_size, sizeof(c_object_t *));
+ last_line = line;
+ if (line > 0)
+ {
+ slot_set_value(sc->error_line, make_integer(sc, remembered_line_number(line)));
+ slot_set_value(sc->error_file, remembered_file_name(line));
+ }
+ else
+ {
+ if (in_reader(sc))
+ {
+ slot_set_value(sc->error_line, make_integer(sc, port_line_number(sc->input_port)));
+ slot_set_value(sc->error_file, make_string_wrapper_with_length(sc, port_filename(sc->input_port), port_filename_length(sc->input_port)));
+ }
+ else
+ {
+ slot_set_value(sc->error_line, sc->F);
+ slot_set_value(sc->error_file, sc->F);
+ }
+ }
}
- else
+ }
+ else
+ {
+ if (in_reader(sc))
{
- object_types_size = tag + 8;
- object_types = (c_object_t **)realloc((void *)object_types, object_types_size * sizeof(c_object_t *));
+ slot_set_value(sc->error_line, make_integer(sc, port_line_number(sc->input_port)));
+ slot_set_value(sc->error_file, make_string_wrapper_with_length(sc, port_filename(sc->input_port), port_filename_length(sc->input_port)));
+ }
+ else
+ {
+ slot_set_value(sc->error_line, sc->F);
+ slot_set_value(sc->error_file, sc->F);
}
}
- 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);
- 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;
+ { /* look for a catcher */
+ int 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)
+ {
+ catch_function catcher;
+ catcher = catchers[stack_op(sc->stack, i)];
+ if ((catcher) &&
+ (catcher(sc, i, type, info, &reset_error_hook)))
+ {
+ if (sc->longjmp_ok) longjmp(sc->goto_start, CATCH_JUMP);
+ /* all the rest of the code expects s7_error to jump, not return,
+ * so presumably if we get here, we're in trouble -- try to send out an error message
+ */
+ /* return(type); */
+ }
+ }
+ }
- if (object_types[tag]->ref != fallback_ref)
- object_types[tag]->outer_type = (T_C_OBJECT | T_PROCEDURE | T_SAFE_PROCEDURE);
- else object_types[tag]->outer_type = T_C_OBJECT;
+ /* error not caught */
+ /* (set! *error-hook* (list (lambda (hook) (apply format #t (hook 'args))))) */
- 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 ((!reset_error_hook) &&
+ (is_procedure(sc->error_hook)) &&
+ (hook_has_functions(sc->error_hook)))
+ {
+ s7_pointer error_hook_func;
+ /* (set! (hook-functions *error-hook*) (list (lambda (h) (format *stderr* "got error ~A~%" (h 'args))))) */
- object_types[tag]->ip = NULL;
- object_types[tag]->rp = NULL;
- object_types[tag]->set_ip = NULL;
- object_types[tag]->set_rp = NULL;
+ error_hook_func = sc->error_hook;
+ sc->error_hook = sc->F;
+ /* if the *error-hook* functions trigger an error, we had better not have *error-hook* still set! */
- return(tag);
-}
+ push_stack(sc, OP_ERROR_HOOK_QUIT, sc->nil, error_hook_func); /* restore *error-hook* upon successful (or any!) evaluation */
+ sc->code = error_hook_func;
+ sc->args = list_2(sc, type, info);
+ /* if we drop into the longjmp below, the hook functions are not called!
+ * OP_ERROR_HOOK_QUIT performs the longjmp, so it should be safe to go to eval.
+ */
+ eval(sc, OP_APPLY);
+ }
+ else
+ {
+ if (port_is_closed(sc->error_port))
+ sc->error_port = sc->standard_error;
+ /* if info is not a list, send object->string to current error port,
+ * else assume car(info) is a format control string, and cdr(info) are its args
+ *
+ * if at all possible, get some indication of where we are!
+ */
+ if ((!s7_is_list(sc, info)) ||
+ (!is_string(car(info))))
+ format_to_port(sc, sc->error_port, "\n;~S ~S", set_plist_2(sc, type, info), NULL, false, 7);
+ else
+ {
+ /* it's possible that the error string is just a string -- not intended for format */
+ if ((type != sc->format_error_symbol) && /* avoid an infinite loop of format errors */
+ (strchr(string_value(car(info)), '~')))
+ {
+ char *errstr;
+ int len, str_len;
+ len = string_length(car(info)) + 8;
+ tmpbuf_malloc(errstr, len);
+ str_len = snprintf(errstr, len, "\n;%s", string_value(car(info)));
+ format_to_port(sc, sc->error_port, errstr, cdr(info), NULL, false, str_len);
+ tmpbuf_free(errstr, len);
+ }
+ else format_to_port(sc, sc->error_port, "\n;~S ~S", set_plist_2(sc, type, info), NULL, false, 7);
+ }
-int s7_new_type_x(s7_scheme *sc,
- const char *name,
- char *(*print)(s7_scheme *sc, void *value),
- void (*free)(void *value),
- bool (*equal)(void *val1, void *val2),
- void (*gc_mark)(void *val),
- s7_pointer (*apply)(s7_scheme *sc, s7_pointer obj, s7_pointer args),
- s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args),
- s7_pointer (*length)(s7_scheme *sc, s7_pointer obj),
- s7_pointer (*copy)(s7_scheme *sc, s7_pointer args),
- s7_pointer (*reverse)(s7_scheme *sc, s7_pointer args),
- s7_pointer (*fill)(s7_scheme *sc, s7_pointer args))
-{
- int 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;
- return(tag);
-}
+ /* now display location at end */
+ if ((is_input_port(sc->input_port)) &&
+ (port_file(sc->input_port) != stdin) &&
+ (!port_is_closed(sc->input_port)))
+ {
+ const char *filename = NULL;
+ int line;
-static void free_object(s7_pointer a)
-{
- (*(c_object_free(a)))(c_object_value(a));
-}
+ filename = port_filename(sc->input_port);
+ line = port_line_number(sc->input_port);
+ if (filename)
+ format_to_port(sc, sc->error_port, "\n; ~A[~D]", set_plist_2(sc, make_string_wrapper(sc, filename), make_integer(sc, line)), NULL, false, 10);
+ else
+ {
+ if ((line > 0) &&
+ (slot_value(sc->error_line) != sc->F))
+ format_to_port(sc, sc->error_port, "\n; line ~D", set_plist_1(sc, make_integer(sc, line)), NULL, false, 11);
+ else
+ {
+ if (is_pair(sc->input_port_stack))
+ {
+ s7_pointer p;
+ p = car(sc->input_port_stack);
+ if ((is_input_port(p)) &&
+ (port_file(p) != stdin) &&
+ (!port_is_closed(p)))
+ {
+ filename = port_filename(p);
+ line = port_line_number(p);
+ if (filename)
+ format_to_port(sc, sc->error_port, "\n; ~A[~D]",
+ set_plist_2(sc, make_string_wrapper(sc, filename), make_integer(sc, line)), NULL, false, 10);
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ const char *call_name;
+ call_name = sc->s7_call_name;
-static bool 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))));
+ /* sc->s7_call_name = NULL; */
+ if (call_name)
+ {
+ sc->s7_call_name = NULL;
+ if ((sc->s7_call_file) &&
+ (sc->s7_call_line >= 0))
+ {
+ format_to_port(sc, sc->error_port, "\n; ~A ~A[~D]",
+ set_plist_3(sc,
+ make_string_wrapper(sc, call_name),
+ make_string_wrapper(sc, sc->s7_call_file),
+ make_integer(sc, sc->s7_call_line)),
+ NULL, false, 13);
+ }
+ }
+ }
+ s7_newline(sc, sc->error_port);
+
+ if (is_string(slot_value(sc->error_file)))
+ {
+ format_to_port(sc, sc->error_port, "; ~S, line ~D",
+ set_plist_2(sc, slot_value(sc->error_file), slot_value(sc->error_line)),
+ NULL, false, 16);
+ s7_newline(sc, sc->error_port);
+ }
+
+ /* look for __func__ in the error environment etc */
+ if (sc->error_port != sc->F)
+ {
+ char *errstr;
+ errstr = stacktrace_1(sc,
+ s7_integer(car(sc->stacktrace_defaults)),
+ s7_integer(cadr(sc->stacktrace_defaults)),
+ s7_integer(caddr(sc->stacktrace_defaults)),
+ s7_integer(cadddr(sc->stacktrace_defaults)),
+ s7_boolean(sc, s7_list_ref(sc, sc->stacktrace_defaults, 4)));
+ if (errstr)
+ {
+ port_write_string(sc->error_port)(sc, ";\n", 2, sc->error_port);
+ port_write_string(sc->error_port)(sc, errstr, strlen(errstr), sc->error_port);
+ free(errstr);
+ port_write_character(sc->error_port)(sc, '\n', sc->error_port);
+ }
+ }
+ else
+ {
+ if (is_pair(slot_value(sc->error_code)))
+ {
+ format_to_port(sc, sc->error_port, "; ~S", set_plist_1(sc, slot_value(sc->error_code)), NULL, false, 7);
+ s7_newline(sc, sc->error_port);
+ }
+ }
+
+ /* if (is_continuation(type))
+ * go into repl here with access to continuation? Or expect *error-handler* to deal with it?
+ */
+ sc->value = type;
+ /* stack_reset(sc); */
+ sc->op = OP_ERROR_QUIT;
+ }
+
+ if (sc->longjmp_ok) longjmp(sc->goto_start, ERROR_JUMP);
+ return(type);
}
-void *s7_object_value(s7_pointer obj)
+static s7_pointer apply_error(s7_scheme *sc, s7_pointer obj, s7_pointer args)
{
- return(c_object_value(obj));
+ /* the operator type is needed here else the error message is confusing:
+ * (apply '+ (list 1 2))) -> ;attempt to apply + to (1 2)?
+ */
+ static s7_pointer errstr = NULL;
+ if (is_null(obj))
+ return(s7_error(sc, sc->syntax_error_symbol, set_elist_2(sc, make_string_wrapper_with_length(sc, "attempt to apply nil to ~S?", 27), args)));
+ if (!errstr)
+ errstr = s7_make_permanent_string("attempt to apply ~A ~S to ~S?");
+ return(s7_error(sc, sc->syntax_error_symbol, set_elist_4(sc, errstr, type_name_string(sc, obj), obj, args)));
}
-void *s7_object_value_checked(s7_pointer obj, int type)
+static s7_pointer read_error_1(s7_scheme *sc, const char *errmsg, bool string_error)
{
- if ((is_c_object(obj)) &&
- (c_object_type(obj) == type))
- return(c_object_value(obj));
- return(NULL);
-}
+ /* reader errors happen before the evaluator gets involved, so forms such as:
+ * (catch #t (lambda () (car '( . ))) (lambda arg 'error))
+ * do not catch the error if we simply signal an error when we encounter it.
+ */
+ char *msg;
+ int len;
+ s7_pointer pt;
+ pt = sc->input_port;
+ if (!string_error)
+ {
+ /* make an heroic effort to find where we slid off the tracks */
-void s7_set_object_print_readably(int type, char *(*printer)(s7_scheme *sc, void *val))
-{
- object_types[type]->print_readably = printer;
-}
+ if (is_string_port(sc->input_port))
+ {
+ #define QUOTE_SIZE 40
+ unsigned int i, j, start = 0, end, slen;
+ char *recent_input = NULL;
+ /* we can run off the end in cases like (eval-string "(. . ,.)") or (eval-string " (@ . ,.)") */
+ if (port_position(pt) >= port_data_size(pt))
+ port_position(pt) = port_data_size(pt) - 1;
-int s7_object_type(s7_pointer obj)
-{
- if (is_c_object(obj))
- return(c_object_type(obj));
- return(-1);
-}
+ /* start at current position and look back a few chars */
+ for (i = port_position(pt), j = 0; (i > 0) && (j < QUOTE_SIZE); i--, j++)
+ if ((port_data(pt)[i] == '\0') ||
+ (port_data(pt)[i] == '\n') ||
+ (port_data(pt)[i] == '\r'))
+ break;
+ start = i;
+ /* start at current position and look ahead a few chars */
+ for (i = port_position(pt), j = 0; (i < port_data_size(pt)) && (j < QUOTE_SIZE); i++, j++)
+ if ((port_data(pt)[i] == '\0') ||
+ (port_data(pt)[i] == '\n') ||
+ (port_data(pt)[i] == '\r'))
+ break;
-s7_pointer s7_make_object(s7_scheme *sc, int type, void *value)
-{
- s7_pointer x;
- new_cell(sc, x, object_types[type]->outer_type);
+ end = i;
+ slen = end - start;
+ /* hopefully this is more or less the current line where the read error happened */
- /* 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
- * 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, sc->nil);
- add_c_object(sc, x);
- return(x);
-}
+ if (slen > 0)
+ {
+ recent_input = (char *)calloc((slen + 9), sizeof(char));
+ for (i = 0; i < (slen + 8); i++) recent_input[i] = '.';
+ recent_input[3] = ' ';
+ recent_input[slen + 4] = ' ';
+ for (i = 0; i < slen; i++) recent_input[i + 4] = port_data(pt)[start + i];
+ }
+ if ((port_line_number(pt) > 0) &&
+ (port_filename(pt)))
+ {
+ len = safe_strlen(recent_input) + safe_strlen(errmsg) + port_filename_length(pt) + safe_strlen(sc->current_file) + 64;
+ msg = (char *)malloc(len * sizeof(char));
+ len = snprintf(msg, len, "%s: %s %s[%u], last top-level form at: %s[%d]",
+ errmsg, (recent_input) ? recent_input : "", port_filename(pt), port_line_number(pt),
+ sc->current_file, sc->current_line);
+ }
+ else
+ {
+ len = safe_strlen(recent_input) + safe_strlen(errmsg) + safe_strlen(sc->current_file) + 64;
+ msg = (char *)malloc(len * sizeof(char));
-s7_pointer s7_object_let(s7_pointer obj)
-{
- return(c_object_let(obj));
-}
+ if ((sc->current_file) &&
+ (sc->current_line >= 0))
+ len = snprintf(msg, len, "%s: %s, last top-level form at %s[%d]",
+ errmsg, (recent_input) ? recent_input : "",
+ sc->current_file, sc->current_line);
+ else len = snprintf(msg, len, "%s: %s", errmsg, (recent_input) ? recent_input : "");
+ }
+ if (recent_input) free(recent_input);
+ return(s7_error(sc, sc->read_error_symbol, set_elist_1(sc, make_string_uncopied_with_length(sc, msg, len))));
+ }
+ }
-s7_pointer s7_object_set_let(s7_pointer obj, s7_pointer e)
-{
- c_object_set_let(obj, e);
- return(e);
-}
+ if ((port_line_number(pt) > 0) &&
+ (port_filename(pt)))
+ {
+ len = safe_strlen(errmsg) + port_filename_length(pt) + safe_strlen(sc->current_file) + 128;
+ msg = (char *)malloc(len * sizeof(char));
+ if (string_error)
+ len = snprintf(msg, len, "%s %s[%u],\n; possible culprit: \"%s...\"\n; last top-level form at %s[%d]",
+ errmsg, port_filename(pt), port_line_number(pt),
+ sc->strbuf, sc->current_file, sc->current_line);
+ else len = snprintf(msg, len, "%s %s[%u], last top-level form at %s[%d]",
+ errmsg, port_filename(pt), port_line_number(pt),
+ sc->current_file, sc->current_line);
+ return(s7_error(sc, sc->read_error_symbol, set_elist_1(sc, make_string_uncopied_with_length(sc, msg, len))));
+ }
-void s7_object_type_set_xf(int tag, s7_ip_t ip, s7_ip_t set_ip, s7_rp_t rp, s7_rp_t set_rp)
-{
- object_types[tag]->ip = ip;
- object_types[tag]->rp = rp;
- object_types[tag]->set_ip = set_ip;
- object_types[tag]->set_rp = set_rp;
+ return(s7_error(sc, (string_error) ? sc->string_read_error_symbol : sc->read_error_symbol, set_elist_1(sc, make_string_wrapper(sc, (char *)errmsg))));
}
-void s7_object_type_set_direct(int 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))
+static s7_pointer read_error(s7_scheme *sc, const char *errmsg)
{
- object_types[tag]->direct_ref = dref;
- object_types[tag]->direct_set = dset;
+ return(read_error_1(sc, errmsg, false));
}
-static s7_pointer object_length(s7_scheme *sc, s7_pointer obj)
+static s7_pointer string_read_error(s7_scheme *sc, const char *errmsg)
{
- if (c_object_length(obj))
- return((*(c_object_length(obj)))(sc, obj));
- eval_error(sc, "attempt to get length of ~S?", obj);
+ return(read_error_1(sc, errmsg, true));
}
-static s7_int object_length_to_int(s7_scheme *sc, s7_pointer obj)
+static s7_pointer g_error(s7_scheme *sc, s7_pointer args)
{
- if (c_object_length(obj))
+ #define H_error "(error type ...) signals an error. The 'type' can be used with catch to trap \
+particular errors. If the error is not caught, s7 treats the second argument as a format control string, \
+and applies it to the rest of the arguments."
+ #define Q_error pcl_t
+
+ if (is_not_null(args))
{
- s7_pointer res;
- res = (*(c_object_length(obj)))(sc, obj);
- if (s7_is_integer(res))
- return(s7_integer(res));
+ if (is_string(car(args))) /* CL-style error? -- use tag = 'no-catch */
+ {
+ s7_error(sc, sc->no_catch_symbol, args); /* this can have trailing args (implicit format) */
+ return(sc->unspecified);
+ }
+ return(s7_error(sc, car(args), cdr(args)));
}
- return(-1);
-}
-
-
-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));
- eval_error(sc, "attempt to copy ~S?", obj);
+ return(s7_error(sc, sc->nil, sc->nil));
}
-
-
-/* -------- dilambda -------- */
-
-s7_pointer s7_dilambda(s7_scheme *sc,
- const char *name,
- s7_pointer (*getter)(s7_scheme *sc, s7_pointer args),
- int get_req_args, int get_opt_args,
- s7_pointer (*setter)(s7_scheme *sc, s7_pointer args),
- int set_req_args, int set_opt_args,
- const char *documentation)
+static char *truncate_string(char *form, int len, use_write_t use_write, int *form_len)
{
- s7_pointer get_func, set_func;
- char *internal_set_name;
- int len;
-
- len = 16 + safe_strlen(name);
- internal_set_name = (char *)malloc(len * sizeof(char));
- snprintf(internal_set_name, len, "[set-%s]", name);
-
- get_func = s7_make_safe_function(sc, name, getter, get_req_args, get_opt_args, false, documentation);
- s7_define(sc, sc->nil, make_symbol(sc, name), get_func);
- set_func = s7_make_function(sc, internal_set_name, setter, set_req_args, set_opt_args, false, documentation);
- c_function_set_setter(get_func, set_func);
-
- return(get_func);
-}
+ unsigned char *f;
+ f = (unsigned char *)form;
-s7_pointer s7_typed_dilambda(s7_scheme *sc,
- const char *name,
- s7_pointer (*getter)(s7_scheme *sc, s7_pointer args),
- int get_req_args, int get_opt_args,
- s7_pointer (*setter)(s7_scheme *sc, s7_pointer args),
- int set_req_args, int set_opt_args,
- const char *documentation,
- s7_pointer get_sig, s7_pointer set_sig)
-{
- s7_pointer get_func, set_func;
- get_func = s7_dilambda(sc, name, getter, get_req_args, get_opt_args, setter, set_req_args, set_opt_args, documentation);
- set_func = c_function_setter(get_func);
- if (get_sig) c_function_signature(get_func) = get_sig;
- if (set_sig) c_function_signature(set_func) = set_sig;
- return(get_func);
+ if (use_write != USE_DISPLAY)
+ {
+ /* I guess we need to protect the outer double quotes in this case */
+ int i;
+ for (i = len - 5; i >= (len / 2); i--)
+ if (is_white_space((int)f[i]))
+ {
+ form[i] = '.';
+ form[i + 1] = '.';
+ form[i + 2] = '.';
+ form[i + 3] = '"';
+ form[i + 4] = '\0';
+ (*form_len) = i + 4;
+ return(form);
+ }
+ i = len - 5;
+ if (i > 0)
+ {
+ form[i] = '.';
+ form[i + 1] = '.';
+ form[i + 2] = '.';
+ form[i + 3] = '"';
+ form[i + 4] = '\0';
+ }
+ else
+ {
+ if (len >= 2)
+ {
+ form[len - 1] = '"';
+ form[len] = '\0';
+ }
+ }
+ }
+ else
+ {
+ int i;
+ for (i = len - 4; i >= (len / 2); i--)
+ if (is_white_space((int)f[i]))
+ {
+ form[i] = '.';
+ form[i + 1] = '.';
+ form[i + 2] = '.';
+ form[i + 3] = '\0';
+ (*form_len) = i + 3;
+ return(form);
+ }
+ i = len - 4;
+ if (i >= 0)
+ {
+ form[i] = '.';
+ form[i + 1] = '.';
+ form[i + 2] = '.';
+ form[i + 3] = '\0';
+ }
+ else form[len] = '\0';
+ }
+ return(form);
}
-bool s7_is_dilambda(s7_pointer obj)
+static char *object_to_truncated_string(s7_scheme *sc, s7_pointer p, int len)
{
- return(((is_c_function(obj)) &&
- (is_c_function(c_function_setter(obj)))) ||
- ((is_any_closure(obj)) &&
- (is_procedure(closure_setter(obj)))));
+ char *s;
+ int s_len;
+ sc->objstr_max_len = len + 2;
+ s = s7_object_to_c_string(sc, p);
+ sc->objstr_max_len = s7_int_max;
+ s_len = safe_strlen(s);
+ if (s_len > len)
+ return(truncate_string(s, len, USE_DISPLAY, &s_len));
+ return(s);
}
-static s7_pointer g_is_dilambda(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_dilambda "(dilambda? obj) returns #t if obj is a procedure with setter."
- #define Q_is_dilambda pl_bt
- check_boolean_method(sc, s7_is_dilambda, sc->is_dilambda_symbol, args);
-}
-static s7_pointer c_set_setter(s7_scheme *sc, s7_pointer p, s7_pointer setter)
+static s7_pointer tree_descend(s7_scheme *sc, s7_pointer p, unsigned int line)
{
- switch (type(p))
+ s7_pointer tp;
+ if (!is_pair(p)) return(NULL);
+ if (has_line_number(p))
{
- case T_MACRO: case T_MACRO_STAR:
- case T_BACRO: case T_BACRO_STAR:
- case T_CLOSURE: case T_CLOSURE_STAR:
- closure_set_setter(p, setter);
- break;
-
- case T_C_FUNCTION:
- case T_C_ANY_ARGS_FUNCTION:
- case T_C_OPT_ARGS_FUNCTION:
- case T_C_RST_ARGS_FUNCTION:
- c_function_set_setter(p, setter);
- if (is_any_closure(setter))
- add_setter(sc, p, setter);
- break;
-
- case T_C_FUNCTION_STAR:
- c_function_set_setter(p, setter);
- if (is_any_closure(setter))
- add_setter(sc, p, setter);
- break;
-
- case T_C_MACRO:
- if (is_any_closure(setter))
- add_setter(sc, p, setter);
- c_macro_set_setter(p, setter);
- break;
+ unsigned int x;
+ x = (unsigned int)remembered_line_number(pair_line(p));
+ if (x > 0)
+ {
+ if (line == 0) /* first line number we encounter will be the current reader location (i.e. the end of the form) */
+ line = x;
+ else
+ {
+ if (x < line)
+ return(p);
+ }
+ }
}
- return(setter);
+ tp = tree_descend(sc, car(p), line);
+ if (tp) return(tp);
+ return(tree_descend(sc, cdr(p), line));
}
-static s7_pointer g_dilambda(s7_scheme *sc, s7_pointer args)
+static char *current_input_string(s7_scheme *sc, s7_pointer pt)
{
- #define H_dilambda "(dilambda getter setter) sets getter's procedure-setter to be setter."
- #define Q_dilambda s7_make_signature(sc, 3, sc->is_procedure_symbol, sc->is_procedure_symbol, sc->is_procedure_symbol)
- s7_pointer getter, setter;
-
- getter = car(args);
- if (!is_any_procedure(getter))
- return(wrong_type_argument_with_type(sc, sc->dilambda_symbol, 1, getter, make_string_wrapper(sc, "a procedure or macro")));
-
- setter = cadr(args);
- if (!is_any_procedure(setter))
- return(wrong_type_argument_with_type(sc, sc->dilambda_symbol, 2, setter, make_string_wrapper(sc, "a procedure or macro")));
-
- c_set_setter(sc, getter, setter);
- return(getter);
+ /* try to show the current input */
+ if ((is_input_port(pt)) &&
+ (!port_is_closed(pt)) &&
+ (port_data(pt)) &&
+ (port_position(pt) > 0))
+ {
+ const unsigned char *str;
+ char *msg;
+ int i, j, start;
+ start = (int)port_position(pt) - 40;
+ if (start < 0) start = 0;
+ msg = (char *)malloc(64 * sizeof(char));
+ str = (const unsigned char *)port_data(pt);
+ for (i = start, j = 0; i < (int)port_position(pt); i++, j++)
+ msg[j] = str[i];
+ msg[j] = '\0';
+ return(msg);
+ }
+ return(NULL);
}
-s7_pointer s7_procedure_setter(s7_scheme *sc, s7_pointer obj)
+static s7_pointer missing_close_paren_error(s7_scheme *sc)
{
- if (is_c_function(obj))
- return(c_function_setter(obj));
+ int len;
+ char *msg, *syntax_msg = NULL;
+ s7_pointer pt;
- return(closure_setter(obj));
-}
+ if ((unchecked_type(sc->envir) != T_LET) &&
+ (sc->envir != sc->nil))
+ sc->envir = sc->nil;
-static s7_pointer g_procedure_setter(s7_scheme *sc, s7_pointer args)
-{
- #define H_procedure_setter "(procedure-setter obj) returns the setter associated with obj, or #f"
- #define Q_procedure_setter s7_make_signature(sc, 2, sc->T, sc->is_procedure_symbol)
- s7_pointer p;
+ pt = sc->input_port;
- p = car(args);
- switch (type(p))
+ /* check *missing-close-paren-hook* */
+ if (hook_has_functions(sc->missing_close_paren_hook))
{
- case T_MACRO: case T_MACRO_STAR:
- case T_BACRO: case T_BACRO_STAR:
- case T_CLOSURE: case T_CLOSURE_STAR:
- return(closure_setter(p));
-
- case T_C_FUNCTION:
- case T_C_FUNCTION_STAR:
- case T_C_ANY_ARGS_FUNCTION:
- case T_C_OPT_ARGS_FUNCTION:
- case T_C_RST_ARGS_FUNCTION:
- return(c_function_setter(p));
-
- case T_C_MACRO:
- return(c_macro_setter(p));
-
- case T_GOTO:
- case T_CONTINUATION:
- return(sc->F);
-
- case T_LET:
- case T_C_OBJECT:
- check_method(sc, p, s7_make_symbol(sc, "procedure-setter"), args);
- break;
+ s7_pointer result;
+ if ((port_line_number(pt) > 0) &&
+ (port_filename(pt)))
+ {
+ slot_set_value(sc->error_line, make_integer(sc, port_line_number(pt)));
+ slot_set_value(sc->error_file, make_string_wrapper(sc, port_filename(pt)));
+ }
+ result = s7_call(sc, sc->missing_close_paren_hook, sc->nil);
+ if (result != sc->unspecified)
+ return(g_throw(sc, list_1(sc, result)));
+ }
- case T_ITERATOR:
- if (is_any_closure(iterator_sequence(p)))
- return(closure_setter(iterator_sequence(p)));
- return(sc->F);
+ if (is_pair(sc->args))
+ {
+ s7_pointer p;
+ p = tree_descend(sc, sc->args, 0);
+ if ((p) && (is_pair(p)) &&
+ (has_line_number(p)))
+ {
+ int msg_len, form_len;
+ char *form;
+ form = object_to_truncated_string(sc, p, 40);
+ form_len = safe_strlen(form);
+ msg_len = form_len + 128;
+ syntax_msg = (char *)malloc(msg_len * sizeof(char));
+ snprintf(syntax_msg, msg_len, "; current form awaiting a close paren starts around line %u: %s", remembered_line_number(pair_line(p)), form);
+ free(form);
+ }
}
- return(s7_wrong_type_arg_error(sc, "procedure-setter", 0, p, "a procedure or a reasonable facsimile thereof"));
-}
-static s7_pointer g_procedure_set_setter(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer p, setter;
+ if ((port_line_number(pt) > 0) &&
+ (port_filename(pt)))
+ {
+ len = port_filename_length(pt) + safe_strlen(sc->current_file) + safe_strlen(syntax_msg) + 128;
+ msg = (char *)malloc(len * sizeof(char));
+ if (syntax_msg)
+ {
+ len = snprintf(msg, len, "missing close paren, %s[%u], last top-level form at %s[%d]\n%s",
+ port_filename(pt), port_line_number(pt),
+ sc->current_file, sc->current_line, syntax_msg);
+ free(syntax_msg);
+ }
+ else len = snprintf(msg, len, "missing close paren, %s[%u], last top-level form at %s[%d]",
+ port_filename(pt), port_line_number(pt),
+ sc->current_file, sc->current_line);
+ return(s7_error(sc, sc->read_error_symbol, set_elist_1(sc, make_string_uncopied_with_length(sc, msg, len))));
+ }
- p = car(args);
- if (!is_any_procedure(p))
- return(s7_wrong_type_arg_error(sc, "set! procedure-setter procedure", 1, p, "a procedure"));
+ if (syntax_msg)
+ {
+ len = safe_strlen(syntax_msg) + 128;
+ msg = (char *)malloc(len * sizeof(char));
+ len = snprintf(msg, len, "missing close paren\n%s\n", syntax_msg);
+ free(syntax_msg);
+ return(s7_error(sc, sc->read_error_symbol, set_elist_1(sc, make_string_uncopied_with_length(sc, msg, len))));
+ }
- setter = cadr(args);
- if ((setter != sc->F) &&
- (!is_any_procedure(setter)))
- return(s7_wrong_type_arg_error(sc, "set! procedure-setter setter", 2, setter, "a procedure or #f"));
+ {
+ char *str;
+ msg = (char *)malloc(128 * sizeof(char));
+ str = current_input_string(sc, pt);
+ len = snprintf(msg, 128, "missing close paren: %s", str);
+ free(str);
+ return(s7_error(sc, sc->read_error_symbol, set_elist_1(sc, make_string_uncopied_with_length(sc, msg, len))));
+ }
- /* should we check that p != setter?
- * :(set! (procedure-setter <) <)
- * <
- * :(set! (< 3 2) 3)
- * #f
- * :(set! (< 1) 2)
- * #t
- * can this make sense?
- */
- return(c_set_setter(sc, p, setter));
+ return(s7_error(sc, sc->read_error_symbol, set_elist_1(sc, make_string_wrapper(sc, "missing close paren"))));
}
-void s7_define_function_with_setter(s7_scheme *sc, const char *name, s7_function get_fnc, s7_function set_fnc, int req_args, int opt_args, const char *doc)
+static void improper_arglist_error(s7_scheme *sc)
{
- s7_dilambda(sc, name, get_fnc, req_args, opt_args, set_fnc, req_args + 1, opt_args, doc);
+ /* sc->code is the last (dotted) arg, sc->args is the arglist reversed not including sc->code
+ * the original was `(,@(reverse args) . ,code) essentially
+ */
+ if (sc->args == sc->nil) /* (abs . 1) */
+ s7_error(sc, sc->syntax_error_symbol, set_elist_1(sc, make_string_wrapper(sc, "function call is a dotted list?")));
+ else s7_error(sc, sc->syntax_error_symbol,
+ set_elist_2(sc, make_string_wrapper(sc, "improper list of arguments: ~S"),
+ append_in_place(sc, sc->args = safe_reverse_in_place(sc, sc->args), sc->code)));
}
-/* -------------------------------- arity -------------------------------- */
-static s7_pointer closure_arity_to_cons(s7_scheme *sc, s7_pointer x, s7_pointer x_args)
-{
- /* x_args is unprocessed -- it is exactly the list as used in the closure[*] definition
- */
- int len;
+/* -------------------------------- leftovers -------------------------------- */
- if (is_symbol(x_args)) /* any number of args is ok */
- return(s7_cons(sc, small_int(0), max_arity));
- if (closure_arity_unknown(x))
- closure_arity(x) = s7_list_length(sc, x_args);
- len = closure_arity(x);
- if (len < 0) /* dotted list => rest arg, (length '(a b . c)) is -2 */
- return(s7_cons(sc, s7_make_integer(sc, -len), max_arity));
- return(s7_cons(sc, s7_make_integer(sc, len), s7_make_integer(sc, len)));
+void (*s7_begin_hook(s7_scheme *sc))(s7_scheme *sc, bool *val)
+{
+ return(sc->begin_hook);
}
-static void closure_star_arity_1(s7_scheme *sc, s7_pointer x, s7_pointer args)
+
+void s7_set_begin_hook(s7_scheme *sc, void (*hook)(s7_scheme *sc, bool *val))
{
- if (closure_arity_unknown(x))
- {
- if (is_null(args))
- closure_arity(x) = 0;
- else
- {
- if (allows_other_keys(args))
- closure_arity(x) = -1;
- else
- {
- s7_pointer p;
- int i;
- for (i = 0, p = args; is_pair(p); p = cdr(p))
- {
- s7_pointer arg;
- arg = car(p);
- if (arg == sc->key_rest_symbol)
- break;
- i++;
- }
- if (is_null(p))
- closure_arity(x) = i;
- else closure_arity(x) = -1; /* see below */
- }
- }
- }
+ sc->begin_hook = hook;
}
-static s7_pointer closure_star_arity_to_cons(s7_scheme *sc, s7_pointer x, s7_pointer x_args)
+
+static bool call_begin_hook(s7_scheme *sc)
{
- if (is_symbol(x_args))
- return(s7_cons(sc, small_int(0), max_arity));
+ bool result = false;
+ /* originally begin_hook was bool (*hook)(s7_scheme *sc): the value was returned directly,
+ * rather than going through a *bool arg (&result below). That works in gcc (Linux/OSX),
+ * but does not work in MS Visual C++. In the latter, the compiler apparently completely
+ * eliminates any local, returning (for example) a thread-relative stack-allocated value
+ * directly, but then by the time we get here, that variable has vanished, and we get
+ * garbage. We had to thwart the optimization by adding if ((flag) && (!flag)) fprintf(...);
+ * So, in the new form (26-Jun-13), the value is passed directly into an s7 variable
+ * that I hope can't be optimized out of existence.
+ */
+ opcode_t op;
+ op = sc->op;
- closure_star_arity_1(sc, x, x_args);
+ push_stack(sc, OP_BARRIER, sc->args, sc->code);
+ sc->begin_hook(sc, &result);
+ if (result)
+ {
+ /* set (owlet) in case we were interrupted and need to see why something was hung */
+ slot_set_value(sc->error_type, sc->F);
+ slot_set_value(sc->error_data, sc->value); /* was sc->F but we now clobber this below */
+ slot_set_value(sc->error_code, current_code(sc));
+ slot_set_value(sc->error_line, sc->F);
+ slot_set_value(sc->error_file, sc->F);
+#if WITH_HISTORY
+ slot_set_value(sc->error_history, sc->F);
+#endif
+ set_outlet(sc->owlet, sc->envir);
- if (closure_arity(x) == -1)
- return(s7_cons(sc, small_int(0), max_arity));
- return(s7_cons(sc, small_int(0), s7_make_integer(sc, closure_arity(x))));
+ sc->value = s7_make_symbol(sc, "begin-hook-interrupt");
+ /* otherwise the evaluator returns whatever random thing is in sc->value (normally #<closure>)
+ * which makes debugging unnecessarily difficult.
+ */
+ s7_quit(sc); /* don't call gc here -- perhaps at restart somehow? */
+ 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 */
+ return(false);
}
-
-static int closure_arity_to_int(s7_scheme *sc, s7_pointer x)
+static s7_pointer apply_list_star(s7_scheme *sc, s7_pointer d)
{
- /* not lambda* here */
- if (closure_arity_unknown(x))
+ s7_pointer p, q;
+ /* we check this ahead of time: if (is_null(cdr(d))) return(car(d)); */
+ p = cons(sc, car(d), cdr(d));
+ q = p;
+ while (is_not_null(cdr(cdr(p))))
{
- int i;
- s7_pointer b;
- for (i = 0, b = closure_args(x); is_pair(b); i++, b = cdr(b)) {};
- if (is_null(b))
- closure_arity(x) = i;
- else
- {
- if (i == 0)
- return(-1);
- closure_arity(x) = -i;
- }
+ d = cdr(d);
+ set_cdr(p, cons(sc, car(d), cdr(d)));
+ if (is_not_null(cdr(d)))
+ p = cdr(p);
}
- return(closure_arity(x));
+ set_cdr(p, cadr(p));
+ return(q);
}
-
-static int closure_star_arity_to_int(s7_scheme *sc, s7_pointer x)
+static s7_pointer apply_list_error(s7_scheme *sc, s7_pointer lst)
{
- /* not lambda here */
- closure_star_arity_1(sc, x, closure_args(x));
- return(closure_arity(x));
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "apply's last argument should be a proper list: ~S"), lst)));
}
-s7_pointer s7_arity(s7_scheme *sc, s7_pointer x)
+static s7_pointer g_apply(s7_scheme *sc, s7_pointer args)
{
- switch (type(x))
- {
- case T_C_OPT_ARGS_FUNCTION:
- case T_C_RST_ARGS_FUNCTION:
- case T_C_FUNCTION:
- return(s7_cons(sc, s7_make_integer(sc, c_function_required_args(x)), s7_make_integer(sc, c_function_all_args(x))));
+ #define H_apply "(apply func ...) applies func to the rest of the arguments"
+ #define Q_apply s7_make_circular_signature(sc, 2, 3, sc->values_symbol, s7_make_signature(sc, 2, sc->is_procedure_symbol, sc->is_sequence_symbol), sc->T)
- case T_C_ANY_ARGS_FUNCTION:
- case T_C_FUNCTION_STAR:
- return(s7_cons(sc, small_int(0), s7_make_integer(sc, c_function_all_args(x)))); /* should this be *2? */
+ /* can apply always be replaced with apply values?
+ * (apply + '(1 2 3)) is the same as (+ (apply values '(1 2 3)))
+ * not if apply* in disguise, I think:
+ * (apply + 1 2 ()) -> 3
+ * (apply + 1 2 (apply values ())) -> error
+ */
+ sc->code = car(args);
+ if (is_null(cdr(args)))
+ {
+ sc->args = sc->nil;
+ push_stack(sc, OP_APPLY, sc->args, sc->code);
+ return(sc->nil);
+ }
- case T_MACRO:
- case T_BACRO:
- case T_CLOSURE:
- return(closure_arity_to_cons(sc, x, closure_args(x)));
+ if (is_safe_procedure(sc->code))
+ {
+ s7_pointer p, q;
+
+ for (q = args, p = cdr(args); is_not_null(cdr(p)); q = p, p = cdr(p));
+ /* the last arg is supposed to be a list, it will be spliced onto the end of the previous arg list (if any) below */
+
+ if (!is_proper_list(sc, car(p))) /* (apply + #f) etc */
+ return(apply_list_error(sc, args));
+ set_cdr(q, car(p));
+ /* this would work: if (is_c_function(sc->code)) return(c_function_call(sc->code)(sc, cdr(args)));
+ * but it omits the arg number check, but if we copy the APPLY table here (returning sc->value)
+ * the overhead from the now non-inline function calls is greater than the fewer-eval-jumps savings.
+ */
+ push_stack(sc, OP_APPLY, cdr(args), sc->code);
+ return(sc->nil);
+ }
- case T_MACRO_STAR:
- case T_BACRO_STAR:
- case T_CLOSURE_STAR:
- return(closure_star_arity_to_cons(sc, x, closure_args(x)));
+ /* here we may have to copy the arg list */
+ if (is_null(cddr(args)))
+ sc->args = cadr(args);
+ else sc->args = apply_list_star(sc, cdr(args));
+ if (!is_proper_list(sc, sc->args))
+ return(apply_list_error(sc, args));
+
+ push_stack(sc, OP_APPLY, (needs_copied_args(sc->code)) ? copy_list(sc, sc->args) : sc->args, sc->code);
+ return(sc->nil);
+}
- case T_C_MACRO:
- return(s7_cons(sc, s7_make_integer(sc, c_macro_required_args(x)), s7_make_integer(sc, c_macro_all_args(x))));
- case T_GOTO:
- case T_CONTINUATION:
- return(s7_cons(sc, small_int(0), max_arity));
+s7_pointer s7_apply_function(s7_scheme *sc, s7_pointer fnc, s7_pointer args)
+{
+ TRACK(sc);
+#if DEBUGGING
+ {
+ s7_pointer p;
+ int argnum;
+ _NFre(fnc);
+ for (argnum = 0, p = _NFre(args); is_pair(p); argnum++, p = _NFre(cdr(p)))
+ _NFre(car(p));
+ }
+#endif
+ if (sc->safety > NO_SAFETY)
+ set_current_code(sc, cons(sc, fnc, args));
+ else set_current_code(sc, fnc);
- case T_STRING:
- if (string_length(x) == 0)
- return(sc->F);
+ if (is_c_function(fnc))
+ return(c_function_call(fnc)(sc, args));
- case T_LET:
- /* check_method(sc, x, sc->arity_symbol, args); */
- return(s7_cons(sc, small_int(1), small_int(1)));
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->code = fnc;
+ sc->args = (needs_copied_args(sc->code)) ? copy_list(sc, args) : args;
+ eval(sc, OP_APPLY);
+ /* we're limited in choices here -- the caller might be (say) car(sc->t1_1) = c_call(...) where the c_call
+ * happens to fallback on a method -- we can't just push OP_APPLY and drop back into the evaluator normally.
+ */
+ return(sc->value);
+}
- case T_C_OBJECT:
- /* check_method(sc, x, sc->arity_symbol, args); */
- if (is_procedure(x))
- return(s7_cons(sc, small_int(0), max_arity));
- return(sc->F);
- case T_INT_VECTOR:
- case T_FLOAT_VECTOR:
- case T_VECTOR:
- if (vector_length(x) == 0)
- return(sc->F);
+s7_pointer s7_eval(s7_scheme *sc, s7_pointer code, s7_pointer e)
+{
+ declare_jump_info();
+ TRACK(sc);
- case T_PAIR:
- case T_HASH_TABLE:
- return(s7_cons(sc, small_int(1), max_arity));
+ if (sc->safety > NO_SAFETY)
+ {
+ if (!s7_is_valid(sc, code))
+ fprintf(stderr, "bad code arg to %s: %p\n", __func__, code);
+ if (!s7_is_valid(sc, e))
+ fprintf(stderr, "bad environment arg to %s: %p\n", __func__, e);
+ }
- case T_ITERATOR:
- return(s7_cons(sc, small_int(0), small_int(0)));
+#if DEBUGGING
+ _NFre(code);
+#endif
- case T_SYNTAX:
- return(s7_cons(sc, small_int(syntax_min_args(x)), (syntax_max_args(x) == -1) ? max_arity : small_int(syntax_max_args(x))));
+ store_jump_info(sc);
+ set_jump_info(sc, EVAL_SET_JUMP);
+ if (jump_loc != NO_JUMP)
+ {
+ if (jump_loc != ERROR_JUMP)
+ eval(sc, sc->op);
}
- return(sc->F);
+ else
+ {
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->code = code;
+ if ((e != sc->rootlet) &&
+ (is_let(e)))
+ sc->envir = e;
+ else sc->envir = sc->nil;
+ eval(sc, OP_EVAL);
+ }
+ restore_jump_info(sc);
+
+ if (is_multiple_value(sc->value))
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+ return(sc->value);
}
-static s7_pointer g_arity(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_eval(s7_scheme *sc, s7_pointer args)
{
- #define H_arity "(arity obj) the min and max acceptable args for obj if it is applicable, otherwise #f."
- #define Q_arity s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_boolean_symbol), sc->T)
- /* check_method(sc, p, sc->arity_symbol, args); */
- return(s7_arity(sc, car(args)));
-}
+ #define H_eval "(eval code (env (curlet))) evaluates code in the environment env. 'env' \
+defaults to the curlet; to evaluate something in the top-level environment instead, \
+pass (rootlet):\n\
+\n\
+ (define x 32) \n\
+ (let ((x 3))\n\
+ (eval 'x (rootlet)))\n\
+\n\
+ returns 32"
+ #define Q_eval s7_make_signature(sc, 3, sc->values_symbol, sc->T, sc->is_let_symbol)
+
+ if (is_not_null(cdr(args)))
+ {
+ s7_pointer e;
+ e = cadr(args);
+ if (!is_let(e))
+ return(wrong_type_argument_with_type(sc, sc->eval_symbol, 2, e, a_let_string));
+ if (e == sc->rootlet)
+ sc->envir = sc->nil;
+ else sc->envir = e;
+ }
+ sc->code = car(args);
+ if (sc->safety > NO_SAFETY)
+ {
+ if (cyclic_sequences(sc, sc->code, false) == sc->T)
+ return(wrong_type_argument_with_type(sc, sc->eval_symbol, 1, sc->code, a_proper_list_string));
+ sc->code = copy_body(sc, sc->code);
+ }
+ else
+ {
+ if (is_optimized(sc->code))
+ clear_all_optimizations(sc, sc->code);
+ }
+ if (s7_stack_top(sc) < 12)
+ push_stack(sc, OP_BARRIER, sc->nil, sc->nil);
+ push_stack(sc, OP_EVAL, sc->args, sc->code);
-PF_TO_PF(arity, s7_arity)
+ return(sc->nil);
+}
-static bool closure_is_aritable(s7_scheme *sc, s7_pointer x, s7_pointer x_args, int args)
+s7_pointer s7_call(s7_scheme *sc, s7_pointer func, s7_pointer args)
{
- /* x_args is unprocessed -- it is exactly the list as used in the closure definition
- */
- int len;
+ declare_jump_info();
+ TRACK(sc);
- if (args == 0)
- return(!is_pair(x_args));
+ if (sc->safety > NO_SAFETY)
+ set_current_code(sc, cons(sc, func, args));
+ else set_current_code(sc, func);
- if (is_symbol(x_args)) /* any number of args is ok */
- return(true);
+ if (is_c_function(func))
+ return(c_function_call(func)(sc, _NFre(args))); /* no check for wrong-number-of-args -- is that reasonable? */
- len = closure_arity(x);
- if (len == CLOSURE_ARITY_NOT_SET)
+ sc->temp1 = _NFre(func); /* this is feeble GC protection */
+ sc->temp2 = _NFre(args);
+
+ store_jump_info(sc);
+ set_jump_info(sc, S7_CALL_SET_JUMP);
+ if (jump_loc != NO_JUMP)
{
- len = s7_list_length(sc, x_args);
- closure_arity(x) = len;
+ if (jump_loc != ERROR_JUMP)
+ eval(sc, sc->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);
}
- if (len < 0) /* dotted list => rest arg, (length '(a b . c)) is -2 */
- return((-len) <= args); /* so we have enough to take care of the required args */
- return(args == len); /* in a normal lambda list, there are no other possibilities */
+ else
+ {
+ if (sc->safety > NO_SAFETY)
+ check_list_validity(sc, "s7_call", args);
+
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code); /* this saves the current evaluation and will eventually finish this (possibly) nested call */
+ sc->code = func;
+ sc->args = (needs_copied_args(func)) ? copy_list(sc, args) : args;
+ /* besides a closure, "func" can also be an object (T_C_OBJECT) -- in Snd, a generator for example */
+ eval(sc, OP_APPLY);
+ }
+ restore_jump_info(sc);
+ /* don't clear temp1 or temp2 here -- lots of (Snd) code calls s7_call repeatedly and assumes the
+ * "func" arg is protected between calls.
+ */
+ return(sc->value);
}
-static bool closure_star_is_aritable(s7_scheme *sc, s7_pointer x, s7_pointer x_args, int args)
+s7_pointer s7_call_with_location(s7_scheme *sc, s7_pointer func, s7_pointer args, const char *caller, const char *file, int line)
{
- if (is_symbol(x_args))
- return(true);
+ s7_pointer result;
- closure_star_arity_1(sc, x, x_args);
- return((closure_arity(x) == -1) ||
- (args <= closure_arity(x)));
+ if (caller)
+ {
+ sc->s7_call_name = caller;
+ sc->s7_call_file = file;
+ sc->s7_call_line = line;
+ }
+
+ result = s7_call(sc, func, args);
+
+ if (caller)
+ {
+ sc->s7_call_name = NULL;
+ sc->s7_call_file = NULL;
+ sc->s7_call_line = -1;
+ }
+ return(result);
}
-bool s7_is_aritable(s7_scheme *sc, s7_pointer x, int args)
+static s7_pointer implicit_index(s7_scheme *sc, s7_pointer obj, s7_pointer indices)
{
- switch (type(x))
+ /* (let ((lst '("12" "34"))) (lst 0 1)) -> #\2
+ * (let ((lst (list #(1 2) #(3 4)))) (lst 0 1)) -> 2
+ *
+ * this can get tricky:
+ * ((list (lambda (a) (+ a 1)) (lambda (b) (* b 2))) 1 2) -> 4
+ * but what if func takes rest/optional args, etc?
+ * ((list (lambda args (car args))) 0 "hi" 0)
+ * should this return #\h or "hi"??
+ * currently it is "hi" which is consistent with
+ * ((lambda args (car args)) "hi" 0)
+ * but...
+ * ((lambda (arg) arg) "hi" 0)
+ * is currently an error (too many arguments)
+ * it should be (((lambda (arg) arg) "hi") 0) -> #\h
+ *
+ * this applies to non-homogeneous cases, so float|int-vectors don't get here
+ */
+
+ switch (type(obj))
{
- case T_C_OPT_ARGS_FUNCTION:
- 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));
+ case T_VECTOR: /* (#(#(1 2) #(3 4)) 1 1) -> 4 */
+ return(vector_ref_1(sc, obj, indices));
- case T_C_ANY_ARGS_FUNCTION:
- case T_C_FUNCTION_STAR:
- return((int)c_function_all_args(x) >= args);
+ case T_STRING: /* (#("12" "34") 0 1) -> #\2 */
+ if (is_null(cdr(indices)))
+ {
+ if (is_byte_vector(obj)) /* ((vector (byte-vector 1)) 0 0) */
+ return(small_int((unsigned int)(character(string_ref_1(sc, obj, car(indices))))));
+ return(string_ref_1(sc, obj, car(indices)));
+ }
+ return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, obj, indices)));
- case T_MACRO:
- case T_BACRO:
- case T_CLOSURE:
- return(closure_is_aritable(sc, x, closure_args(x), args));
+ case T_PAIR: /* (#((1 2) (3 4)) 1 0) -> 3, (#((1 (2 3))) 0 1 0) -> 2 */
+ obj = list_ref_1(sc, obj, car(indices));
+ if (is_pair(cdr(indices)))
+ return(implicit_index(sc, obj, cdr(indices)));
+ return(obj);
- case T_MACRO_STAR:
- case T_BACRO_STAR:
- case T_CLOSURE_STAR:
- return(closure_star_is_aritable(sc, x, closure_args(x), args));
+ case T_HASH_TABLE: /* ((vector (hash-table '(a . 1) '(b . 2))) 0 'a) -> 1 */
+ obj = s7_hash_table_ref(sc, obj, car(indices));
+ if (is_pair(cdr(indices)))
+ return(implicit_index(sc, obj, cdr(indices)));
+ return(obj);
- case T_C_MACRO:
- return(((int)c_macro_required_args(x) <= args) &&
- ((int)c_macro_all_args(x) >= args));
+ case T_C_OBJECT:
+ return((*(c_object_ref(obj)))(sc, obj, indices));
- case T_GOTO:
- case T_CONTINUATION:
- return(true);
+ case T_LET:
+ obj = s7_let_ref(sc, obj, car(indices));
+ if (is_pair(cdr(indices)))
+ return(implicit_index(sc, obj, cdr(indices)));
+ return(obj);
- case T_STRING:
- return((args == 1) &&
- (string_length(x) > 0)); /* ("" 0) -> error */
+ default: /* (#(a b c) 0 1) -> error, but ((list (lambda (x) x)) 0 "hi") -> "hi" */
+ if (is_applicable(obj))
+ return(g_apply(sc, list_2(sc, obj, indices)));
+ return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, obj, indices)));
+ }
+}
- case T_C_OBJECT:
- /* check_method(sc, x, sc->is_aritable_symbol, list_2(sc, x, s7_make_integer(sc, args))); -- see below */
- return(is_procedure(x)); /* i.e. is_applicable */
- case T_INT_VECTOR:
- case T_FLOAT_VECTOR:
- case T_VECTOR:
- return((args > 0) &&
- (vector_length(x) > 0) && /* (#() 0) -> error */
- ((unsigned int)args <= vector_rank(x)));
+/* -------------------------------- type-of -------------------------------- */
+static s7_pointer type_to_typers[NUM_TYPES];
+static void init_typers(s7_scheme *sc)
+{
+ type_to_typers[T_FREE] = sc->F;
+ type_to_typers[T_PAIR] = sc->is_pair_symbol;
+ type_to_typers[T_NIL] = sc->is_null_symbol;
+ type_to_typers[T_EOF_OBJECT] = sc->is_eof_object_symbol;
+ type_to_typers[T_UNDEFINED] = sc->is_undefined_symbol;
+ type_to_typers[T_UNSPECIFIED] = sc->is_unspecified_symbol;
+ type_to_typers[T_BOOLEAN] = sc->is_boolean_symbol;
+ type_to_typers[T_CHARACTER] = sc->is_char_symbol;
+ type_to_typers[T_SYMBOL] = sc->is_symbol_symbol; /* and keyword? */
+ type_to_typers[T_SYNTAX] = sc->is_syntax_symbol;
+ type_to_typers[T_INTEGER] = sc->is_integer_symbol;
+ type_to_typers[T_RATIO] = sc->is_rational_symbol;
+ type_to_typers[T_REAL] = sc->is_float_symbol;
+ type_to_typers[T_COMPLEX] = sc->is_complex_symbol;
+ type_to_typers[T_BIG_INTEGER] = sc->is_integer_symbol;
+ type_to_typers[T_BIG_RATIO] = sc->is_rational_symbol;
+ type_to_typers[T_BIG_REAL] = sc->is_float_symbol;
+ type_to_typers[T_BIG_COMPLEX] = sc->is_complex_symbol;
+ type_to_typers[T_STRING] = sc->is_string_symbol; /* and byte-vector? */
+ type_to_typers[T_C_OBJECT] = sc->is_c_object_symbol;
+ type_to_typers[T_VECTOR] = sc->is_vector_symbol;
+ type_to_typers[T_INT_VECTOR] = sc->is_int_vector_symbol;
+ type_to_typers[T_FLOAT_VECTOR] = sc->is_float_vector_symbol;
+ type_to_typers[T_CATCH] = sc->F;
+ type_to_typers[T_DYNAMIC_WIND] = sc->F;
+ type_to_typers[T_HASH_TABLE] = sc->is_hash_table_symbol;
+ type_to_typers[T_LET] = sc->is_let_symbol;
+ type_to_typers[T_ITERATOR] = sc->is_iterator_symbol;
+ type_to_typers[T_STACK] = sc->F;
+ type_to_typers[T_COUNTER] = sc->F;
+ type_to_typers[T_OPTLIST] = sc->F;
+ type_to_typers[T_SLOT] = sc->F;
+ type_to_typers[T_C_POINTER] = sc->is_c_pointer_symbol;
+ type_to_typers[T_OUTPUT_PORT] = sc->is_output_port_symbol;
+ type_to_typers[T_INPUT_PORT] = sc->is_input_port_symbol;
+ type_to_typers[T_BAFFLE] = sc->F;
+ type_to_typers[T_RANDOM_STATE] = sc->is_random_state_symbol;
+ type_to_typers[T_GOTO] = sc->F; /* (continuation? goto) -> #f -- we need a type indicator for this */
+ type_to_typers[T_CONTINUATION] = sc->is_continuation_symbol;
+ type_to_typers[T_CLOSURE] = sc->is_procedure_symbol;
+ type_to_typers[T_CLOSURE_STAR] = sc->is_procedure_symbol;
+ type_to_typers[T_C_MACRO] = sc->is_macro_symbol;
+ type_to_typers[T_MACRO] = sc->is_macro_symbol;
+ type_to_typers[T_MACRO_STAR] = sc->is_macro_symbol;
+ type_to_typers[T_BACRO] = sc->is_macro_symbol;
+ type_to_typers[T_BACRO_STAR] = sc->is_macro_symbol;
+ type_to_typers[T_C_FUNCTION] = sc->is_procedure_symbol;
+ type_to_typers[T_C_FUNCTION_STAR] = sc->is_procedure_symbol;
+ type_to_typers[T_C_ANY_ARGS_FUNCTION] = sc->is_procedure_symbol;
+ type_to_typers[T_C_OPT_ARGS_FUNCTION] = sc->is_procedure_symbol;
+ type_to_typers[T_C_RST_ARGS_FUNCTION] = sc->is_procedure_symbol;
+}
+
+s7_pointer s7_type_of(s7_pointer arg) {return(type_to_typers[type(arg)]);}
+
+static s7_pointer g_type_of(s7_scheme *sc, s7_pointer args)
+{
+ #define H_type_of "(type-of obj) returns a symbol describing obj's type"
+ #define Q_type_of s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_symbol_symbol, sc->is_boolean_symbol), sc->T)
+ int tp;
+
+ tp = type(car(args));
+ if ((tp >= 0) && (tp < NUM_TYPES))
+ return(type_to_typers[type(car(args))]);
+ return(s7_make_symbol(sc, "unknown!"));
+}
- case T_LET:
- /* check_method(sc, x, sc->is_aritable_symbol, list_2(sc, x, s7_make_integer(sc, args))); */
- /* this slows us down a lot */
- case T_HASH_TABLE:
- case T_PAIR:
- return(args == 1);
- case T_ITERATOR:
- return(args == 0);
+/* -------------------------------- s7-version -------------------------------- */
+static s7_pointer g_s7_version(s7_scheme *sc, s7_pointer args)
+{
+ #define H_s7_version "(s7-version) returns some string describing the current s7"
+ #define Q_s7_version pcl_s
- case T_SYNTAX:
- return((args >= syntax_min_args(x)) && ((args <= syntax_max_args(x)) || (syntax_max_args(x) == -1)));
- }
- return(false);
+ return(s7_make_string(sc, "s7 " S7_VERSION ", " S7_DATE));
}
-static s7_pointer g_is_aritable(s7_scheme *sc, s7_pointer args)
+static s7_pointer s7_version_p(void) {return(s7_make_string(cur_sc, "s7 " S7_VERSION ", " S7_DATE));}
+
+
+void s7_quit(s7_scheme *sc)
{
- #define H_is_aritable "(aritable? obj num-args) returns #t if 'obj can be applied to 'num-args arguments."
- #define Q_is_aritable s7_make_signature(sc, 3, sc->is_boolean_symbol, sc->T, sc->is_integer_symbol)
+ sc->longjmp_ok = false;
- s7_pointer n;
- s7_int num;
+ pop_input_port(sc);
+ stack_reset(sc);
+ push_stack(sc, OP_EVAL_DONE, sc->nil, sc->nil);
+}
+
+/* -------------------------------- exit -------------------------------- */
+static s7_pointer g_emergency_exit(s7_scheme *sc, s7_pointer args)
+{
+ #define H_emergency_exit "(emergency-exit obj) exits s7 immediately"
+ #define Q_emergency_exit pcl_t
+
+ s7_pointer obj;
+#ifndef EXIT_SUCCESS
+ #define EXIT_SUCCESS 0
+ #define EXIT_FAILURE 1
+#endif
+ if (is_null(args))
+ _exit(EXIT_SUCCESS); /* r7rs spec says use _exit here */
+ obj = car(args);
+ if (obj == sc->F)
+ _exit(EXIT_FAILURE);
+ if ((obj == sc->T) || (!s7_is_integer(obj)))
+ _exit(EXIT_SUCCESS);
+ _exit((int)s7_integer(obj));
+ return(sc->F);
+}
+
+
+static s7_pointer g_exit(s7_scheme *sc, s7_pointer args)
+{
+ #define H_exit "(exit obj) exits s7"
+ #define Q_exit pcl_t
+
+ s7_quit(sc);
+ return(g_emergency_exit(sc, args));
+}
- n = cadr(args);
- if (!s7_is_integer(n)) /* remember gmp case! */
- method_or_bust(sc, n, sc->is_aritable_symbol, args, T_INTEGER, 2);
- num = s7_integer(n);
- if (num < 0)
- return(out_of_range(sc, sc->is_aritable_symbol, small_int(2), n, its_negative_string));
- if (num > MAX_ARITY) num = MAX_ARITY;
+#if DEBUGGING
+static s7_pointer g_abort(s7_scheme *sc, s7_pointer args) {abort();}
+#endif
- return(make_boolean(sc, s7_is_aritable(sc, car(args), (int)num)));
-}
-static s7_pointer c_is_aritable(s7_scheme *sc, s7_pointer x, s7_int y) {return(make_boolean(sc, s7_is_aritable(sc, x, y)));}
-PIF_TO_PF(is_aritable, c_is_aritable)
+/* -------------------------------- optimizer stuff -------------------------------- */
+static s7_function all_x_function[OPT_MAX_DEFINED];
+#define is_all_x_op(Op) (all_x_function[Op])
-static s7_pointer is_aritable_ic;
-static s7_pointer g_is_aritable_ic(s7_scheme *sc, s7_pointer args)
+static bool is_all_x_safe(s7_scheme *sc, s7_pointer p)
{
- return(make_boolean(sc, s7_is_aritable(sc, car(args), (int)integer(cadr(args)))));
+ return((!is_pair(p)) ||
+ ((is_optimized(p)) && (is_all_x_op(optimize_op(p)))) ||
+ ((car(p) == sc->quote_symbol) && (is_pair(cdr(p))) && (is_null(cddr(p))))); /* (if #t (quote . -1)) */
}
-static s7_pointer is_aritable_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static int all_x_count(s7_scheme *sc, s7_pointer x)
{
- if (args == 2)
- {
- s7_pointer arg2;
- arg2 = caddr(expr);
- if ((s7_is_integer(arg2)) &&
- (s7_integer(arg2) < MAX_ARITY) &&
- (s7_integer(arg2) >= 0))
- return(is_aritable_ic);
- }
- return(f);
+ int count = 0;
+ s7_pointer p;
+ for (p = cdr(x); is_pair(p); p = cdr(p))
+ if (is_all_x_safe(sc, car(p)))
+ count++;
+ return(count);
}
-/* -------- sequence? -------- */
-static s7_pointer g_is_sequence(s7_scheme *sc, s7_pointer args)
+static s7_pointer apply_boolean_method(s7_scheme *sc, s7_pointer obj, s7_pointer method)
{
- #define H_is_sequence "(sequence? obj) returns #t if obj is a sequence (vector, string, pair, etc)"
- #define Q_is_sequence pl_bt
- check_boolean_method(sc, is_simple_sequence, sc->is_sequence_symbol, args);
+ s7_pointer func;
+ func = find_method(sc, find_let(sc, obj), method);
+ if (func == sc->undefined) return(sc->F);
+ return(s7_apply_function(sc, func, list_1(sc, obj)));
}
+#define all_x_bool(Sc, Checker, Method, Arg1) \
+ { \
+ s7_pointer Arg = Arg1; \
+ if (Checker(Arg)) return(Sc->T); \
+ if (!has_methods(Arg)) return(sc->F); \
+ return(apply_boolean_method(sc, Arg, Method)); \
+ }
+#define all_x_not_bool(Sc, Checker, Method, Arg1) \
+ { \
+ s7_pointer Arg = Arg1; \
+ if (Checker(Arg)) return(Sc->F); \
+ if (!has_methods(Arg)) return(sc->T); \
+ return((apply_boolean_method(sc, Arg, Method) == sc->F) ? sc->T : sc->F); \
+ }
-/* -------------------------------- symbol-access ------------------------------------------------ */
-static unsigned int protect_accessor(s7_scheme *sc, s7_pointer acc)
+/* arg here is the full expression */
+static s7_pointer all_x_c(s7_scheme *sc, s7_pointer arg) {return(arg);}
+static s7_pointer all_x_q(s7_scheme *sc, s7_pointer arg) {return(cadr(arg));}
+static s7_pointer all_x_unsafe_s(s7_scheme *sc, s7_pointer arg){return(find_symbol_checked(sc, arg));}
+static s7_pointer all_x_s(s7_scheme *sc, s7_pointer arg) {return(find_symbol_unchecked(sc, arg));}
+static s7_pointer local_x_s(s7_scheme *sc, s7_pointer arg) {return(local_symbol_value(arg));}
+static s7_pointer all_x_k(s7_scheme *sc, s7_pointer arg) {return(arg);}
+static s7_pointer all_x_c_c(s7_scheme *sc, s7_pointer arg) {return(c_call(arg)(sc, cdr(arg)));}
+static s7_pointer all_x_not_c_c(s7_scheme *sc, s7_pointer arg) {return(make_boolean(sc, is_false(sc, c_call(cadr(arg))(sc, cdadr(arg)))));}
+
+static s7_pointer all_x_c_add1(s7_scheme *sc, s7_pointer arg)
{
- unsigned int loc;
- if (sc->protected_accessors_size == sc->protected_accessors_loc)
- {
- int i, new_size, size;
- size = sc->protected_accessors_size;
- new_size = 2 * size;
- vector_elements(sc->protected_accessors) = (s7_pointer *)realloc(vector_elements(sc->protected_accessors), new_size * sizeof(s7_pointer));
- vector_length(sc->protected_accessors) = new_size;
- for (i = size; i < new_size; i++)
- vector_element(sc->protected_accessors, i) = sc->gc_nil;
- sc->protected_accessors_size = new_size;
- }
- loc = sc->protected_accessors_loc++;
- vector_element(sc->protected_accessors, loc) = acc;
- return(loc);
+ s7_pointer x;
+ x = find_symbol_unchecked(sc, cadr(arg));
+ if (is_integer(x))
+ return(make_integer(sc, integer(x) + 1));
+ return(g_add_s1_1(sc, x, cdr(arg))); /* arg=(+ x 1) */
}
-s7_pointer s7_symbol_access(s7_scheme *sc, s7_pointer sym)
+static s7_pointer local_x_c_add1(s7_scheme *sc, s7_pointer arg)
{
- /* these refer to the rootlet */
- if ((is_slot(global_slot(sym))) &&
- (slot_has_accessor(global_slot(sym))))
- return(slot_accessor(global_slot(sym)));
- return(sc->F);
+ s7_pointer x;
+ x = local_symbol_value(cadr(arg));
+ if (is_integer(x))
+ return(make_integer(sc, integer(x) + 1));
+ return(g_add_s1_1(sc, x, cdr(arg))); /* arg=(+ x 1) */
}
-s7_pointer s7_symbol_set_access(s7_scheme *sc, s7_pointer symbol, s7_pointer func)
+static s7_pointer all_x_c_addi(s7_scheme *sc, s7_pointer arg)
{
- if (slot_has_accessor(global_slot(symbol)))
- {
- unsigned int index;
- index = symbol_global_accessor_index(symbol);
- if (index < sc->protected_accessors_size)
- {
- if (is_immutable(vector_element(sc->protected_accessors, index)))
- return(func);
- vector_element(sc->protected_accessors, index) = func;
- slot_set_accessor(global_slot(symbol), func);
- return(func);
- }
- }
- if (func != sc->F)
- {
- slot_set_has_accessor(global_slot(symbol));
- symbol_set_has_accessor(symbol);
- symbol_global_accessor_index(symbol) = protect_accessor(sc, func);
- }
- slot_set_accessor(global_slot(symbol), func);
- return(func);
+ s7_pointer x;
+ x = find_symbol_unchecked(sc, cadr(arg));
+ if (is_integer(x))
+ return(make_integer(sc, integer(x) + integer(caddr(arg))));
+ return(g_add_2(sc, set_plist_2(sc, x, caddr(arg))));
}
-/* (let () (define xxx 23) (define (hix) (set! xxx 24)) (hix) (set! (symbol-access 'xxx) (lambda (sym val) (format *stderr* "val: ~A~%" val) val)) (hix))
- * so set symbol-access before use!
- */
-
-static s7_pointer g_symbol_access(s7_scheme *sc, s7_pointer args)
+static s7_pointer local_x_c_addi(s7_scheme *sc, s7_pointer arg)
{
- #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)
- s7_pointer sym, p;
-
- sym = car(args);
- if (!is_symbol(sym))
- method_or_bust(sc, sym, sc->symbol_access_symbol, args, T_SYMBOL, 0);
- if (is_keyword(sym))
- return(sc->F);
-
- if (is_pair(cdr(args)))
- {
- s7_pointer e, old_e;
- e = cadr(args);
- if ((e == sc->rootlet) || (e == sc->nil))
- p = global_slot(sym);
- else
- {
- if (!is_let(e))
- return(wrong_type_argument(sc, sc->symbol_access_symbol, 2, e, T_LET));
- old_e = sc->envir;
- sc->envir = e;
- p = find_symbol(sc, sym);
- sc->envir = old_e;
- }
- }
- else p = find_symbol(sc, sym);
+ s7_pointer x;
+ x = local_symbol_value(cadr(arg));
+ if (is_integer(x))
+ return(make_integer(sc, integer(x) + integer(caddr(arg))));
+ return(g_add_2(sc, set_plist_2(sc, x, caddr(arg))));
+}
- if (!is_slot(p))
+static s7_pointer all_x_c_char_eq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer c;
+ c = find_symbol_unchecked(sc, cadr(arg));
+ if (c == caddr(arg))
+ return(sc->T);
+ if (s7_is_character(c))
return(sc->F);
-
- if (slot_has_accessor(p))
- return(slot_accessor(p));
-
- return(sc->F);
+ method_or_bust(sc, c, sc->char_eq_symbol, set_plist_2(sc, c, caddr(arg)), T_CHARACTER, 1);
}
+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));
+ 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)));
+}
-static s7_pointer g_symbol_set_access(s7_scheme *sc, s7_pointer args)
+static s7_pointer local_x_not_is_eq_car_q(s7_scheme *sc, s7_pointer arg)
{
- s7_pointer sym, func, p;
+ s7_pointer lst, a;
+ a = cdadr(arg);
+ lst = local_symbol_value(cadar(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)));
+}
- sym = car(args);
- if (!is_symbol(sym)) /* no check method because no method name? */
- return(s7_wrong_type_arg_error(sc, "set! symbol-access", 1, sym, "a symbol"));
- if (is_keyword(sym))
- return(s7_wrong_type_arg_error(sc, "set! symbol-access", 1, sym, "a normal symbol (a keyword can't be set)"));
+static s7_pointer all_x_is_pair_cdr(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer p;
+ p = find_symbol_unchecked(sc, cadadr(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)))));
+}
- /* (set! (symbol-access sym) f) or (set! (symbol-access sym env) f) */
- if (is_pair(cddr(args)))
- {
- s7_pointer e, old_e;
- e = cadr(args);
- func = caddr(args);
- if ((e == sc->rootlet) || (e == sc->nil))
- p = global_slot(sym);
- else
- {
- if (!is_let(e))
- return(s7_wrong_type_arg_error(sc, "set! symbol-access", 2, e, "a let"));
- old_e = sc->envir;
- sc->envir = e;
- p = find_symbol(sc, sym);
- sc->envir = old_e;
- }
- }
- else
- {
- p = find_symbol(sc, sym);
- func = cadr(args);
- }
+static s7_pointer local_x_is_pair_cdr(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer p;
+ p = local_symbol_value(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)))));
+}
- if ((!is_procedure_or_macro(func)) &&
- (func != sc->F))
- return(s7_wrong_type_arg_error(sc, "set! symbol-access", 3, func, "a function or #f"));
+static s7_pointer all_x_c_s(s7_scheme *sc, s7_pointer arg)
+{
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(arg)));
+ return(c_call(arg)(sc, sc->t1_1));
+}
- if (!is_slot(p))
- return(sc->F);
+static s7_pointer local_x_c_s(s7_scheme *sc, s7_pointer arg)
+{
+ set_car(sc->t1_1, local_symbol_value(cadr(arg)));
+ return(c_call(arg)(sc, sc->t1_1));
+}
- if (p == global_slot(sym))
- {
- s7_symbol_set_access(sc, sym, func); /* special GC protection for global vars */
- return(func);
- }
+static s7_pointer all_x_cdr_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer val;
+ val = find_symbol_unchecked(sc, cadr(arg));
+ return((is_pair(val)) ? cdr(val) : g_cdr(sc, set_plist_1(sc, val)));
+}
- slot_set_accessor(p, func);
- if (func != sc->F)
- {
- slot_set_has_accessor(p);
- symbol_set_has_accessor(sym);
- }
- return(func);
+static s7_pointer local_x_cdr_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer val;
+ val = local_symbol_value(cadr(arg));
+ return((is_pair(val)) ? cdr(val) : g_cdr(sc, set_plist_1(sc, val)));
}
+static s7_pointer all_x_car_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer val;
+ val = find_symbol_unchecked(sc, cadr(arg));
+ return((is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val)));
+}
-static s7_pointer bind_accessed_symbol(s7_scheme *sc, opcode_t op, s7_pointer symbol, s7_pointer new_value)
+static s7_pointer local_x_car_s(s7_scheme *sc, s7_pointer arg)
{
- /* this refers to (define (sym ...)) and friends -- define cases
- * see call_accessor for the set! cases
- */
- s7_pointer func;
+ s7_pointer val;
+ val = local_symbol_value(cadr(arg));
+ return((is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val)));
+}
- func = g_symbol_access(sc, set_plist_2(sc, symbol, sc->envir));
- if (is_procedure_or_macro(func))
- {
- if (is_c_function(func))
- {
- s7_pointer old_value;
- old_value = new_value;
- set_car(sc->t2_1, symbol);
- set_car(sc->t2_2, new_value);
- new_value = c_function_call(func)(sc, sc->t2_1);
- if (new_value == sc->error_symbol)
- return(s7_error(sc, sc->error_symbol, set_elist_3(sc, make_string_wrapper(sc, "can't bind ~S to ~S"), symbol, old_value)));
- }
- else
- {
- sc->args = list_2(sc, symbol, new_value);
- push_stack(sc, op, sc->args, sc->code);
- sc->code = func;
- return(sc->no_value); /* this means the accessor in set! needs to goto APPLY to get the new value */
- }
- }
- return(new_value);
+static s7_pointer all_x_cadr_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer val;
+ val = find_symbol_unchecked(sc, cadr(arg));
+ return(((is_pair(val)) && (is_pair(cdr(val)))) ? cadr(val) : g_cadr(sc, set_plist_1(sc, val)));
}
+static s7_pointer local_x_cadr_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer val;
+ val = local_symbol_value(cadr(arg));
+ return(((is_pair(val)) && (is_pair(cdr(val)))) ? cadr(val) : g_cadr(sc, set_plist_1(sc, val)));
+}
+static s7_pointer all_x_is_null_s(s7_scheme *sc, s7_pointer arg)
+{
+ all_x_bool(sc, is_null, sc->is_null_symbol, find_symbol_unchecked(sc, cadr(arg)));
+}
-/* -------------------------------- hooks -------------------------------- */
+static s7_pointer local_x_is_null_s(s7_scheme *sc, s7_pointer arg)
+{
+ all_x_bool(sc, is_null, sc->is_null_symbol, local_symbol_value(cadr(arg)));
+}
-s7_pointer s7_hook_functions(s7_scheme *sc, s7_pointer hook)
+static s7_pointer all_x_is_symbol_s(s7_scheme *sc, s7_pointer arg)
{
- return(s7_symbol_local_value(sc, sc->body_symbol, closure_let(hook)));
+ all_x_bool(sc, is_symbol, sc->is_symbol_symbol, find_symbol_unchecked(sc, cadr(arg)));
}
+static s7_pointer local_x_is_symbol_s(s7_scheme *sc, s7_pointer arg)
+{
+ all_x_bool(sc, is_symbol, sc->is_symbol_symbol, local_symbol_value(cadr(arg)));
+}
-s7_pointer s7_hook_set_functions(s7_scheme *sc, s7_pointer hook, s7_pointer functions)
+static s7_pointer all_x_is_pair_s(s7_scheme *sc, s7_pointer arg)
{
- if (s7_is_list(sc, functions))
- s7_let_set(sc, closure_let(hook), sc->body_symbol, functions);
- return(functions);
+ all_x_bool(sc, is_pair, sc->is_pair_symbol, find_symbol_unchecked(sc, cadr(arg)));
}
+static s7_pointer local_x_is_pair_s(s7_scheme *sc, s7_pointer arg)
+{
+ all_x_bool(sc, is_pair, sc->is_pair_symbol, local_symbol_value(cadr(arg)));
+}
+static s7_pointer all_x_is_keyword_s(s7_scheme *sc, s7_pointer arg)
+{
+ all_x_bool(sc, is_keyword, sc->is_keyword_symbol, find_symbol_unchecked(sc, cadr(arg)));
+}
-/* -------------------------------- eq etc -------------------------------- */
+static s7_pointer all_x_is_integer_s(s7_scheme *sc, s7_pointer arg)
+{
+ all_x_bool(sc, is_integer, sc->is_integer_symbol, find_symbol_unchecked(sc, cadr(arg)));
+}
-bool s7_is_eq(s7_pointer obj1, s7_pointer obj2)
+static s7_pointer all_x_is_procedure_s(s7_scheme *sc, s7_pointer arg)
{
- return(obj1 == obj2); /* so floats and NaNs might be eq? but not eqv? */
+ all_x_bool(sc, is_procedure, sc->is_procedure_symbol, find_symbol_unchecked(sc, cadr(arg)));
}
+static s7_pointer all_x_is_string_s(s7_scheme *sc, s7_pointer arg)
+{
+ all_x_bool(sc, is_string, sc->is_string_symbol, find_symbol_unchecked(sc, cadr(arg)));
+}
-static s7_pointer g_is_eq(s7_scheme *sc, s7_pointer args)
+static s7_pointer all_x_is_vector_s(s7_scheme *sc, s7_pointer arg)
{
- #define H_is_eq "(eq? obj1 obj2) returns #t if obj1 is eq to (the same object as) obj2"
- #define Q_is_eq pcl_bt
- return(make_boolean(sc, ((car(args) == cadr(args)) ||
- ((is_unspecified(car(args))) && (is_unspecified(cadr(args)))))));
- /* (eq? (apply apply apply values '(())) #<unspecified>) should return #t
- */
+ all_x_bool(sc, s7_is_vector, sc->is_vector_symbol, find_symbol_unchecked(sc, cadr(arg)));
}
+static s7_pointer all_x_is_proper_list_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer lst;
+ lst = find_symbol_unchecked(sc, cadr(arg));
+ if (is_proper_list(sc, lst)) return(sc->T);
+ if (!has_methods(lst)) return(sc->F);
+ return(apply_boolean_method(sc, lst, sc->is_proper_list_symbol));
+}
-bool s7_is_eqv(s7_pointer a, s7_pointer b)
+static s7_pointer all_x_not_s(s7_scheme *sc, s7_pointer arg)
{
- if ((a == b) && (!is_number(a)))
- return(true);
+ return(make_boolean(sc, is_false(sc, find_symbol_unchecked(sc, cadr(arg)))));
+}
-#if WITH_GMP
- if ((is_big_number(a)) || (is_big_number(b)))
- return(big_numbers_are_eqv(a, b));
-#endif
+static s7_pointer all_x_not_is_pair(s7_scheme *sc, s7_pointer arg)
+{
+ all_x_not_bool(sc, is_pair, sc->is_pair_symbol, find_symbol_unchecked(sc, cadadr(arg)));
+}
- if (type(a) != type(b))
- return(false);
+static s7_pointer local_x_not_is_pair(s7_scheme *sc, s7_pointer arg)
+{
+ all_x_not_bool(sc, is_pair, sc->is_pair_symbol, local_symbol_value(cadadr(arg)));
+}
- if (is_string(a))
- return(string_value(a) == string_value(b));
+static s7_pointer all_x_c_sc(s7_scheme *sc, s7_pointer arg)
+{
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg)));
+ set_car(sc->t2_2, caddr(arg));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- if (s7_is_number(a))
- return(numbers_are_eqv(a, b));
+static s7_pointer local_x_c_sc(s7_scheme *sc, s7_pointer arg)
+{
+ set_car(sc->t2_1, local_symbol_value(cadr(arg)));
+ set_car(sc->t2_2, caddr(arg));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- if (is_unspecified(a)) /* types are the same so we know b is also unspecified */
- return(true);
+static s7_pointer all_x_c_cs(s7_scheme *sc, s7_pointer arg)
+{
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(arg)));
+ set_car(sc->t2_1, cadr(arg));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- return(false);
+static s7_pointer all_x_c_ss(s7_scheme *sc, s7_pointer arg)
+{
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
}
+static s7_pointer all_x_c_ls(s7_scheme *sc, s7_pointer arg)
+{
+ set_car(sc->t2_1, local_symbol_value(cadr(arg)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
+}
-static s7_pointer g_is_eqv(s7_scheme *sc, s7_pointer args)
+static s7_pointer x_c_hash_table_ref_ss(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
- #define H_is_eqv "(eqv? obj1 obj2) returns #t if obj1 is equivalent to obj2"
- #define Q_is_eqv pcl_bt
- return(make_boolean(sc, s7_is_eqv(car(args), cadr(args))));
+ hash_entry_t *x;
+ if (!is_hash_table(table))
+ return(g_hash_table(sc, set_plist_2(sc, table, key)));
+ x = (*hash_table_checker(table))(sc, table, key);
+ if (x) return(x->value);
+ return(sc->F);
}
+static s7_pointer all_x_c_hash_table_ref_ss(s7_scheme *sc, s7_pointer arg)
+{
+ return(x_c_hash_table_ref_ss(sc, find_symbol_unchecked(sc, cadr(arg)), find_symbol_unchecked(sc, caddr(arg))));
+}
+static s7_pointer local_x_c_hash_table_ref_ss(s7_scheme *sc, s7_pointer arg)
+{
+ return(x_c_hash_table_ref_ss(sc, local_symbol_value(cadr(arg)), local_symbol_value(caddr(arg))));
+}
-static bool floats_are_morally_equal(s7_scheme *sc, s7_double x, s7_double y)
+static s7_pointer all_x_c_hash_table_ref_car(s7_scheme *sc, s7_pointer arg)
{
- if (x == y) return(true);
+ s7_pointer table, lst;
+ hash_entry_t *x;
- if ((is_NaN(x)) || (is_NaN(y)))
- return((is_NaN(x)) && (is_NaN(y)));
+ table = find_symbol_unchecked(sc, cadr(arg));
+ lst = find_symbol_unchecked(sc, cadr(caddr(arg)));
+ if (!is_pair(lst))
+ return(simple_wrong_type_argument(sc, sc->car_symbol, lst, T_PAIR));
- return(fabs(x - y) <= sc->morally_equal_float_epsilon);
+ if (!is_hash_table(table))
+ return(g_hash_table(sc, set_plist_2(sc, table, car(lst))));
+
+ x = (*hash_table_checker(table))(sc, table, car(lst));
+ if (x) return(x->value);
+ return(sc->F);
}
-static bool eq_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer local_x_c_ss(s7_scheme *sc, s7_pointer arg)
{
- return(x == y);
+ set_car(sc->t2_1, local_symbol_value(cadr(arg)));
+ set_car(sc->t2_2, local_symbol_value(caddr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
}
-static bool symbol_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer all_x_c_qs(s7_scheme *sc, s7_pointer arg)
{
- 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))) &&
- (is_syntax(slot_value(global_slot(y)))) &&
- (syntax_symbol(slot_value(global_slot(x))) == syntax_symbol(slot_value(global_slot(y)))));
+ set_car(sc->t2_1, cadadr(arg));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
}
-static bool unspecified_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer all_x_c_sq(s7_scheme *sc, s7_pointer arg)
{
- return(is_unspecified(y));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg)));
+ set_car(sc->t2_2, cadr(caddr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
}
-static bool c_pointer_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer local_x_c_sq(s7_scheme *sc, s7_pointer arg)
{
- return((s7_is_c_pointer(y)) && (raw_pointer(x) == raw_pointer(y)));
+ set_car(sc->t2_1, local_symbol_value(cadr(arg)));
+ set_car(sc->t2_2, cadr(caddr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
}
-static bool string_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer all_x_c_cq(s7_scheme *sc, s7_pointer arg)
{
- return((is_string(y)) && (scheme_strings_are_equal(x, y)));
+ set_car(sc->t2_1, cadr(arg));
+ set_car(sc->t2_2, cadr(caddr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
}
-static bool syntax_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer all_x_c_sss(s7_scheme *sc, s7_pointer arg)
{
- return((is_syntax(y)) && (syntax_symbol(x) == syntax_symbol(y)));
+ set_car(sc->t3_1, find_symbol_unchecked(sc, cadr(arg)));
+ set_car(sc->t3_2, find_symbol_unchecked(sc, caddr(arg)));
+ set_car(sc->t3_3, find_symbol_unchecked(sc, cadddr(arg)));
+ return(c_call(arg)(sc, sc->t3_1));
}
-static bool c_object_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer all_x_c_scs(s7_scheme *sc, s7_pointer arg)
{
- return((is_c_object(y)) && (objects_are_equal(sc, x, y)));
+ set_car(sc->t3_1, find_symbol_unchecked(sc, cadr(arg)));
+ set_car(sc->t3_3, find_symbol_unchecked(sc, cadddr(arg)));
+ set_car(sc->t3_2, caddr(arg));
+ return(c_call(arg)(sc, sc->t3_1));
}
-static bool port_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer all_x_c_css(s7_scheme *sc, s7_pointer arg)
{
- if (x == y) return(true);
- if ((!morally) || (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)) &&
- (port_data_size(x) == port_data_size(y)) &&
- (local_strncmp((const char *)port_data(x), (const char *)port_data(y), (is_input_port(x)) ? port_data_size(x) : port_position(x))));
+ set_car(sc->t3_2, find_symbol_unchecked(sc, caddr(arg)));
+ set_car(sc->t3_3, find_symbol_unchecked(sc, cadddr(arg)));
+ set_car(sc->t3_1, cadr(arg));
+ return(c_call(arg)(sc, sc->t3_1));
}
-static int equal_ref(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+static s7_pointer all_x_c_csc(s7_scheme *sc, s7_pointer arg)
{
- /* here we know x and y are pointers to the same type of structure */
- int ref_x, ref_y;
- ref_x = peek_shared_ref(ci, x);
- ref_y = peek_shared_ref(ci, y);
-
- if ((ref_x != 0) && (ref_y != 0))
- return((ref_x == ref_y) ? 1 : 0);
-
- /* 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)
- add_shared_ref(ci, x, ref_y);
- else add_equal_ref(ci, x, y);
- }
- return(-1);
+ set_car(sc->t3_2, find_symbol_unchecked(sc, caddr(arg)));
+ set_car(sc->t3_1, cadr(arg));
+ set_car(sc->t3_3, cadddr(arg));
+ return(c_call(arg)(sc, sc->t3_1));
}
-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 s7_pointer all_x_c_ssc(s7_scheme *sc, s7_pointer arg)
{
- hash_entry_t **lists;
- int i, len;
- shared_info *nci = ci;
-
- if (x == y)
- return(true);
- if (!is_hash_table(y))
- {
- if ((morally) && (has_methods(y)))
- {
- s7_pointer equal_func;
- 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(false);
- }
- if (ci)
- {
- i = equal_ref(sc, x, y, ci);
- if (i == 0) return(false);
- if (i == 1) return(true);
- }
-
- if (hash_table_entries(x) != hash_table_entries(y))
- return(false);
- if (hash_table_entries(x) == 0)
- return(true);
- if ((!morally) &&
- ((hash_table_checker_locked(x)) || (hash_table_checker_locked(y))))
- {
- if (hash_table_checker(x) != hash_table_checker(y))
- return(false);
- if (hash_table_mapper(x) != hash_table_mapper(y))
- return(false);
- }
-
- 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);
+ set_car(sc->t3_1, find_symbol_unchecked(sc, cadr(arg)));
+ set_car(sc->t3_2, find_symbol_unchecked(sc, caddr(arg)));
+ set_car(sc->t3_3, cadddr(arg));
+ return(c_call(arg)(sc, sc->t3_1));
+}
- if ((!y_val) ||
- (!s7_is_equal_1(sc, p->value, y_val->value, nci, morally)))
- return(false);
- }
- }
- /* if we get here, every key/value in x has a corresponding key/value in y, and the number of entries match,
- * so surely the tables are equal??
- */
- return(true);
+static s7_pointer all_x_c_opcq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t1_1, c_call(largs)(sc, cdr(largs)));
+ return(c_call(arg)(sc, sc->t1_1));
}
+static s7_pointer all_x_c_s_opcq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = caddr(arg);
+ set_car(sc->t2_2, c_call(largs)(sc, cdr(largs)));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
+}
-static bool slots_match(s7_scheme *sc, s7_pointer px, s7_pointer y, bool morally, shared_info *nci)
+static s7_pointer all_x_c_c_opcq(s7_scheme *sc, s7_pointer arg)
{
- 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(false);
+ s7_pointer largs;
+ largs = caddr(arg);
+ set_car(sc->t2_2, c_call(largs)(sc, cdr(largs)));
+ set_car(sc->t2_1, cadr(arg));
+ return(c_call(arg)(sc, sc->t2_1));
}
-static bool let_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer all_x_c_opcq_s(s7_scheme *sc, s7_pointer arg)
{
- /* 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 largs;
+ largs = cadr(arg);
+ set_car(sc->t2_1, c_call(largs)(sc, cdr(largs)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- s7_pointer ex, ey, px, py;
- shared_info *nci = ci;
- int x_len, y_len;
+static s7_pointer all_x_c_opcq_c(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t2_1, c_call(largs)(sc, cdr(largs)));
+ set_car(sc->t2_2, caddr(arg));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- if (x == y)
- return(true);
+static int next_tx(s7_scheme *sc)
+{
+ sc->t_temp_ctr++;
+ if (sc->t_temp_ctr >= T_TEMPS_SIZE) sc->t_temp_ctr = 0;
+ return(sc->t_temp_ctr);
+}
- if (morally)
+static s7_pointer safe_list_if_possible(s7_scheme *sc, int num_args)
+{
+ if ((num_args != 0) &&
+ (num_args < NUM_SAFE_LISTS))
{
- 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))
+ sc->current_safe_list = num_args;
+ if (!is_pair(sc->safe_lists[num_args]))
+ sc->safe_lists[num_args] = permanent_list(sc, num_args);
+ if (!list_is_in_use(sc->safe_lists[num_args]))
{
- 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))));
+ set_list_in_use(sc->safe_lists[num_args]);
+ return(sc->safe_lists[num_args]);
}
}
- if (!is_let(y))
- return(false);
- if ((x == sc->rootlet) || (y == sc->rootlet))
- return(false);
-
- if (ci)
- {
- int i;
- i = equal_ref(sc, x, y, ci);
- if (i == 0) return(false);
- if (i == 1) return(true);
- }
+ return(make_list(sc, num_args, sc->nil));
+}
- clear_syms_in_list(sc);
- for (x_len = 0, ex = x; (is_let(ex)) && (ex != sc->rootlet); ex = outlet(ex))
- for (px = let_slots(ex); is_slot(px); px = next_slot(px))
- if (symbol_tag(slot_symbol(px)) != sc->syms_tag)
- {
- add_sym_to_list(sc, slot_symbol(px));
- x_len++;
- }
+static s7_pointer all_x_c_all_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer args, p;
+ int tx;
+ tx = next_tx(sc);
+ sc->t_temps[tx] = safe_list_if_possible(sc, integer(arglist_length(arg)));
+ for (args = cdr(arg), p = sc->t_temps[tx]; is_pair(args); args = cdr(args), p = cdr(p))
+ set_car(p, find_symbol_unchecked(sc, car(args)));
+ clear_list_in_use(sc->t_temps[tx]);
+ sc->current_safe_list = 0;
+ return(c_call(arg)(sc, sc->t_temps[tx]));
+}
- 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 (symbol_tag(slot_symbol(py)) != sc->syms_tag) /* symbol in y, not in x */
- return(false);
+/* h_safe_c_all_x (etc), h_safe_c_s_opaq, h_safe_c_c_opscq, h_safe_c_scc */
+
+static s7_pointer all_x_c_opcq_opcq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ int tx;
+ tx = next_tx(sc);
+ largs = cadr(arg);
+ sc->t_temps[tx] = c_call(largs)(sc, cdr(largs));
+ largs = caddr(arg);
+ set_car(sc->t2_2, c_call(largs)(sc, cdr(largs)));
+ set_car(sc->t2_1, sc->t_temps[tx]);
+ return(c_call(arg)(sc, sc->t2_1));
+}
- for (y_len = 0, ey = y; (is_let(ey)) && (ey != sc->rootlet); ey = outlet(ey))
- for (py = let_slots(ey); is_slot(py); py = next_slot(py))
- if (symbol_tag(slot_symbol(py)) != 0)
- {
- y_len ++;
- symbol_set_tag(slot_symbol(py), 0);
- }
-
- if (x_len != y_len) /* symbol in x, not in y */
- return(false);
+static s7_pointer all_x_c_opsq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t1_1, c_call(largs)(sc, sc->t1_1));
+ return(c_call(arg)(sc, sc->t1_1));
+}
- if (!nci) nci = new_shared_info(sc);
+static s7_pointer local_x_c_opsq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t1_1, local_symbol_value(cadr(largs)));
+ set_car(sc->t1_1, c_call(largs)(sc, sc->t1_1));
+ return(c_call(arg)(sc, sc->t1_1));
+}
- for (ex = x; (is_let(ex)) && (ex != sc->rootlet); ex = outlet(ex))
- for (px = let_slots(ex); is_slot(px); px = next_slot(px))
- 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))
- return(false);
- }
- return(true);
+static s7_pointer all_x_c_car_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer val;
+ val = find_symbol_unchecked(sc, cadadr(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));
}
-static bool closure_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer local_x_c_car_s(s7_scheme *sc, s7_pointer arg)
{
- 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), (morally) ? sc->is_morally_equal_symbol : sc->is_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)));
+ s7_pointer val;
+ val = local_symbol_value(cadadr(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));
}
-static bool pair_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer all_x_c_cdr_s(s7_scheme *sc, s7_pointer arg)
{
- int i;
- s7_pointer px, py;
- shared_info *nci = ci;
+ s7_pointer val;
+ val = find_symbol_unchecked(sc, cadadr(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));
+}
- if (x == y)
- return(true);
- if (!is_pair(y))
- {
- if ((morally) && (has_methods(y)))
- {
- s7_pointer equal_func;
- 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(false);
- }
- if (ci)
- {
- i = equal_ref(sc, x, y, ci);
- if (i == 0) return(false);
- if (i == 1) return(true);
- }
- else nci = new_shared_info(sc);
+static s7_pointer local_x_c_cdr_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer val;
+ val = local_symbol_value(cadadr(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));
+}
- if (!s7_is_equal_1(sc, car(x), car(y), nci, morally)) 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);
- i = equal_ref(sc, px, py, nci);
- if (i == 0) return(false);
- if (i == 1) return(true);
- }
- return(s7_is_equal_1(sc, px, py, nci, morally));
+static s7_pointer all_x_c_not_opsq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(largs)));
+ if (c_call(largs)(sc, sc->t1_1) == sc->F)
+ return(sc->T);
+ return(sc->F);
}
-static bool vector_rank_match(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_pointer local_x_c_not_opsq(s7_scheme *sc, s7_pointer arg)
{
- int x_dims, y_dims;
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t1_1, local_symbol_value(cadr(largs)));
+ if (c_call(largs)(sc, sc->t1_1) == sc->F)
+ return(sc->T);
+ return(sc->F);
+}
- if (vector_has_dimensional_info(x))
- x_dims = vector_ndims(x);
- else x_dims = 1;
- if (vector_has_dimensional_info(y))
- y_dims = vector_ndims(y);
- else y_dims = 1;
+static s7_pointer all_x_c_opssq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(largs)));
+ set_car(sc->t1_1, c_call(largs)(sc, sc->t2_1));
+ return(c_call(arg)(sc, sc->t1_1));
+}
- if (x_dims != y_dims)
- return(false);
+static s7_pointer all_x_c_not_opssq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(largs)));
+ if (c_call(largs)(sc, sc->t2_1) == sc->F)
+ return(sc->T);
+ return(sc->F);
+}
- if (x_dims > 1)
- {
- int j;
- for (j = 0; j < x_dims; j++)
- if (vector_dimension(x, j) != vector_dimension(y, j))
- return(false);
- }
- return(true);
+static s7_pointer local_x_c_opssq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t2_1, local_symbol_value(cadr(largs)));
+ set_car(sc->t2_2, local_symbol_value(caddr(largs)));
+ set_car(sc->t1_1, c_call(largs)(sc, sc->t2_1));
+ return(c_call(arg)(sc, sc->t1_1));
}
+static s7_pointer all_x_c_opscq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, caddr(largs));
+ set_car(sc->t1_1, c_call(largs)(sc, sc->t2_1));
+ return(c_call(arg)(sc, sc->t1_1));
+}
-static bool vector_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer all_x_c_opcsq(s7_scheme *sc, s7_pointer arg)
{
- s7_int i, len;
- shared_info *nci = ci;
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(largs)));
+ set_car(sc->t2_1, cadr(largs));
+ set_car(sc->t1_1, c_call(largs)(sc, sc->t2_1));
+ return(c_call(arg)(sc, sc->t1_1));
+}
- if (x == y)
- return(true);
- if (!s7_is_vector(y))
- {
- if ((morally) && (has_methods(y)))
- {
- s7_pointer equal_func;
- 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(false);
- }
- 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 (!vector_rank_match(sc, x, y))
- return(false);
+static s7_pointer all_x_c_opsqq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, cadr(caddr(largs)));
+ set_car(sc->t1_1, c_call(largs)(sc, sc->t2_1));
+ return(c_call(arg)(sc, sc->t1_1));
+}
- 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 */
- return(false);
- return(true);
- }
+static s7_pointer all_x_c_opqsq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(largs)));
+ set_car(sc->t2_1, cadadr(largs));
+ set_car(sc->t1_1, c_call(largs)(sc, sc->t2_1));
+ return(c_call(arg)(sc, sc->t1_1));
+}
- if (is_float_vector(x))
- {
- if (!morally)
- {
- 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);
- }
- 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++)
- {
- 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);
- }
- }
+static s7_pointer all_x_c_opcsq_c(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(largs)));
+ set_car(sc->t2_1, cadr(largs));
+ set_car(sc->t2_1, c_call(largs)(sc, sc->t2_1));
+ set_car(sc->t2_2, caddr(arg));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- 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);
- }
+static s7_pointer all_x_c_opssq_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(largs)));
+ set_car(sc->t2_1, c_call(largs)(sc, sc->t2_1));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- if (ci)
- {
- i = equal_ref(sc, x, y, ci);
- if (i == 0) return(false);
- if (i == 1) return(true);
- }
- else nci = new_shared_info(sc);
+static s7_pointer all_x_c_opscq_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, caddr(largs));
+ set_car(sc->t2_1, c_call(largs)(sc, sc->t2_1));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- for (i = 0; i < len; i++)
- if (!(s7_is_equal_1(sc, vector_element(x, i), vector_element(y, i), nci, morally)))
- return(false);
- return(true);
+static s7_pointer all_x_c_opscq_c(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, caddr(largs));
+ set_car(sc->t2_1, c_call(largs)(sc, sc->t2_1));
+ set_car(sc->t2_2, caddr(arg));
+ return(c_call(arg)(sc, sc->t2_1));
}
-static bool iterator_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer local_x_c_opssq_s(s7_scheme *sc, s7_pointer arg)
{
- if (x == y) return(true);
- if (!is_iterator(y)) return(false);
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t2_1, local_symbol_value(cadr(largs)));
+ set_car(sc->t2_2, local_symbol_value(caddr(largs)));
+ set_car(sc->t2_1, c_call(largs)(sc, sc->t2_1));
+ set_car(sc->t2_2, local_symbol_value(caddr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- switch (type(iterator_sequence(x)))
- {
- 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)));
+static s7_pointer all_x_c_opssq_c(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(largs)));
+ set_car(sc->t2_1, c_call(largs)(sc, sc->t2_1));
+ set_car(sc->t2_2, caddr(arg));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- 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)));
+static s7_pointer all_x_c_opsq_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_1, c_call(largs)(sc, sc->t1_1));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- case T_PAIR:
- return((iterator_sequence(x) == iterator_sequence(y)) &&
- (iterator_next(x) == iterator_next(y)) && /* even if seqs are equal, one might be at end */
- (iterator_current(x) == iterator_current(y))); /* current pointer into the sequence */
+static s7_pointer all_x_c_opsq_q(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_1, c_call(largs)(sc, sc->t1_1));
+ set_car(sc->t2_2, cadr(caddr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- case T_HASH_TABLE:
- return((iterator_sequence(x) == iterator_sequence(y)) &&
- (iterator_next(x) == iterator_next(y)) &&
- (iterator_current(x) == iterator_current(y)) &&
- (iterator_hash_current(x) == iterator_hash_current(y)) &&
- (iterator_position(x) == iterator_position(y)));
+static s7_pointer all_x_c_opsq_qs(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t3_1, c_call(largs)(sc, sc->t1_1));
+ set_car(sc->t3_2, cadr(caddr(arg)));
+ set_car(sc->t3_3, find_symbol_unchecked(sc, cadddr(arg)));
+ return(c_call(arg)(sc, sc->t3_1));
+}
- default:
- break;
- }
- return(false);
+static s7_pointer local_x_c_opsq_c(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t1_1, local_symbol_value(cadr(largs)));
+ set_car(sc->t2_1, c_call(largs)(sc, sc->t1_1));
+ set_car(sc->t2_2, caddr(arg));
+ return(c_call(arg)(sc, sc->t2_1));
}
-static bool bignum_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer all_x_c_opsq_c(s7_scheme *sc, s7_pointer arg)
{
- 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
+ s7_pointer largs;
+ largs = cadr(arg);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_1, c_call(largs)(sc, sc->t1_1));
+ set_car(sc->t2_2, caddr(arg));
+ return(c_call(arg)(sc, sc->t2_1));
}
-static bool integer_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer all_x_c_s_opssq(s7_scheme *sc, s7_pointer arg)
{
-#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);
- }
-#endif
- if (is_integer(y))
- return(integer(x) == integer(y));
- if ((!morally) || (!is_number(y)))
- return(false);
+ s7_pointer largs;
+ largs = caddr(arg);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(largs)));
+ set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- if (is_t_real(y))
- return((!is_NaN(real(y))) &&
- (fabs(integer(x) - real(y)) <= sc->morally_equal_float_epsilon));
+static s7_pointer all_x_c_c_opssq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = caddr(arg);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(largs)));
+ set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1));
+ set_car(sc->t2_1, cadr(arg));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- if (is_t_ratio(y))
- return(s7_fabsl(integer(x) - fraction(y)) <= sc->morally_equal_float_epsilon);
+static s7_pointer local_x_c_s_opssq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = caddr(arg);
+ set_car(sc->t2_1, local_symbol_value(cadr(largs)));
+ set_car(sc->t2_2, local_symbol_value(caddr(largs)));
+ set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1));
+ set_car(sc->t2_1, local_symbol_value(cadr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- return((!is_NaN(real_part(y))) &&
- (!is_NaN(imag_part(y))) &&
- (fabs(integer(x) - real_part(y)) <= sc->morally_equal_float_epsilon) &&
- (fabs(imag_part(y)) <= sc->morally_equal_float_epsilon));
+static s7_pointer all_x_c_s_opscq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = caddr(arg);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, caddr(largs));
+ set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
}
-/* 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 s7_pointer all_x_c_s_opsq(s7_scheme *sc, s7_pointer arg)
{
-#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);
- }
-#endif
- if (!morally)
- return((s7_is_ratio(y)) &&
- (numerator(x) == numerator(y)) &&
- (denominator(x) == denominator(y)));
+ s7_pointer largs;
+ largs = caddr(arg);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, c_call(largs)(sc, sc->t1_1));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- if (is_t_ratio(y))
- return(s7_fabsl(fraction(x) - fraction(y)) <= sc->morally_equal_float_epsilon);
+static s7_pointer local_x_c_s_opsq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = caddr(arg);
+ set_car(sc->t1_1, local_symbol_value(cadr(largs)));
+ set_car(sc->t2_2, c_call(largs)(sc, sc->t1_1));
+ set_car(sc->t2_1, local_symbol_value(cadr(arg)));
+ return(c_call(arg)(sc, sc->t2_1));
+}
- if (is_t_real(y))
- return(floats_are_morally_equal(sc, fraction(x), real(y)));
+static s7_pointer all_x_c_op_s_opsq_q(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer outer, args;
+ outer = cadr(arg);
+ args = caddr(outer);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(args)));
+ set_car(sc->t2_2, c_call(args)(sc, sc->t1_1));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(outer)));
+ set_car(sc->t1_1, c_call(outer)(sc, sc->t2_1));
+ return(c_call(arg)(sc, sc->t1_1));
+}
- if (is_integer(y))
- return(s7_fabsl(fraction(x) - integer(y)) <= sc->morally_equal_float_epsilon);
+static s7_pointer all_x_c_op_opsq_s_q(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer outer, args;
+ outer = cadr(arg);
+ args = cadr(outer);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(args)));
+ set_car(sc->t2_1, c_call(args)(sc, sc->t1_1));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(outer)));
+ set_car(sc->t1_1, c_call(outer)(sc, sc->t2_1));
+ return(c_call(arg)(sc, sc->t1_1));
+}
- if (is_t_complex(y))
- return((!is_NaN(real_part(y))) &&
- (!is_NaN(imag_part(y))) &&
- (s7_fabsl(fraction(x) - real_part(y)) <= sc->morally_equal_float_epsilon) &&
- (fabs(imag_part(y)) <= sc->morally_equal_float_epsilon));
- return(false);
+static s7_pointer all_x_c_c_opsq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = caddr(arg);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, c_call(largs)(sc, sc->t1_1));
+ set_car(sc->t2_1, cadr(arg));
+ return(c_call(arg)(sc, sc->t2_1));
}
-static bool real_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer all_x_c_opsq_opsq(s7_scheme *sc, s7_pointer arg)
{
-#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);
- }
-#endif
- if (!morally)
- return((is_t_real(y)) &&
- (real(x) == real(y)));
- if (!is_number(y)) return(false);
+ s7_pointer largs;
+ int tx;
+ tx = next_tx(sc);
+ largs = cdr(arg);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(car(largs))));
+ sc->t_temps[tx] = c_call(car(largs))(sc, sc->t1_1);
+ largs = cadr(largs);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, c_call(largs)(sc, sc->t1_1));
+ set_car(sc->t2_1, sc->t_temps[tx]);
+ return(c_call(arg)(sc, sc->t2_1));
+}
- if (is_t_real(y))
- return(floats_are_morally_equal(sc, real(x), real(y)));
+static s7_pointer all_x_c_opcq_opsq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ int tx;
+ tx = next_tx(sc);
+ largs = cdr(arg);
+ sc->t_temps[tx] = c_call(car(largs))(sc, cdar(largs));
+ largs = cadr(largs);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, c_call(largs)(sc, sc->t1_1));
+ set_car(sc->t2_1, sc->t_temps[tx]);
+ return(c_call(arg)(sc, sc->t2_1));
+}
- if (is_integer(y))
- return((!is_NaN(real(x))) &&
- (fabs(real(x) - integer(y)) <= sc->morally_equal_float_epsilon));
+static s7_pointer all_x_c_opsq_opcq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ int tx;
+ tx = next_tx(sc);
+ largs = cdr(arg);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(car(largs))));
+ sc->t_temps[tx] = c_call(car(largs))(sc, sc->t1_1);
+ largs = cadr(largs);
+ set_car(sc->t2_2, c_call(largs)(sc, cdr(largs)));
+ set_car(sc->t2_1, sc->t_temps[tx]);
+ return(c_call(arg)(sc, sc->t2_1));
+}
- if (is_t_ratio(y))
- return(floats_are_morally_equal(sc, real(x), fraction(y)));
+static s7_pointer all_x_c_opsq_opssq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ int tx;
+ tx = next_tx(sc);
+ largs = cdr(arg);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(car(largs))));
+ sc->t_temps[tx] = c_call(car(largs))(sc, sc->t1_1);
+ largs = cadr(largs);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(largs)));
+ set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1));
+ set_car(sc->t2_1, sc->t_temps[tx]);
+ return(c_call(arg)(sc, sc->t2_1));
+}
- if (is_NaN(real(x)))
- return((is_NaN(real_part(y))) &&
- (fabs(imag_part(y)) <= sc->morally_equal_float_epsilon));
+static s7_pointer all_x_c_opssq_opsq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ int tx;
+ tx = next_tx(sc);
+ largs = cdr(arg);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(car(largs))));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(car(largs))));
+ sc->t_temps[tx] = c_call(car(largs))(sc, sc->t2_1);
+ largs = cadr(largs);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, c_call(largs)(sc, sc->t1_1));
+ set_car(sc->t2_1, sc->t_temps[tx]);
+ return(c_call(arg)(sc, sc->t2_1));
+}
- return((!is_NaN(real(x))) &&
- (!is_NaN(real_part(y))) &&
- (!is_NaN(imag_part(y))) &&
- ((real(x) == real_part(y)) ||
- (fabs(real(x) - real_part(y)) <= sc->morally_equal_float_epsilon)) &&
- (fabs(imag_part(y)) <= sc->morally_equal_float_epsilon));
+static s7_pointer all_x_c_opssq_opcq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ int tx;
+ tx = next_tx(sc);
+ largs = cdr(arg);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(car(largs))));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(car(largs))));
+ sc->t_temps[tx] = c_call(car(largs))(sc, sc->t2_1);
+ largs = cadr(largs);
+ set_car(sc->t2_2, c_call(largs)(sc, cdr(largs)));
+ set_car(sc->t2_1, sc->t_temps[tx]);
+ return(c_call(arg)(sc, sc->t2_1));
}
-static bool complex_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer all_x_c_opssq_opssq(s7_scheme *sc, s7_pointer arg)
{
-#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);
- }
-#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);
+ s7_pointer largs;
+ int tx;
+ tx = next_tx(sc);
+ largs = cdr(arg);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(car(largs))));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(car(largs))));
+ sc->t_temps[tx] = c_call(car(largs))(sc, sc->t2_1);
+ largs = cadr(largs);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(largs)));
+ set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1));
+ set_car(sc->t2_1, sc->t_temps[tx]);
+ return(c_call(arg)(sc, sc->t2_1));
+}
- if (is_integer(y))
- return((!is_NaN(real_part(x))) &&
- (!is_NaN(imag_part(x))) &&
- (fabs(real_part(x) - integer(y)) <= sc->morally_equal_float_epsilon) &&
- (fabs(imag_part(x)) <= sc->morally_equal_float_epsilon));
+static s7_pointer all_x_c_op_opssq_q_c(s7_scheme *sc, s7_pointer code)
+{
+ s7_pointer arg;
+ arg = cadadr(code);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(arg)));
+ set_car(sc->t1_1, c_call(arg)(sc, sc->t2_1));
+ set_car(sc->t2_1, c_call(cadr(code))(sc, sc->t1_1));
+ set_car(sc->t2_2, caddr(code));
+ return(c_call(code)(sc, sc->t2_1));
+}
- if (s7_is_ratio(y))
- return((!is_NaN(real_part(x))) &&
- (!is_NaN(imag_part(x))) &&
- (s7_fabsl(real_part(x) - fraction(y)) <= sc->morally_equal_float_epsilon) &&
- (fabs(imag_part(x)) <= sc->morally_equal_float_epsilon));
+static s7_pointer all_x_c_op_opsq_q(s7_scheme *sc, s7_pointer code)
+{
+ s7_pointer arg;
+ arg = cadadr(code);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(arg)));
+ set_car(sc->t1_1, c_call(arg)(sc, sc->t1_1));
+ set_car(sc->t1_1, c_call(cadr(code))(sc, sc->t1_1));
+ return(c_call(code)(sc, sc->t1_1));
+}
- if (is_real(y))
- {
- if (is_NaN(imag_part(x)))
- return(false);
- if (is_NaN(real(y)))
- return((is_NaN(real_part(x))) &&
- (fabs(imag_part(x)) <= sc->morally_equal_float_epsilon));
- return(((real_part(x) == real(y)) ||
- (fabs(real_part(x) - real(y)) <= sc->morally_equal_float_epsilon)) &&
- (fabs(imag_part(x)) <= sc->morally_equal_float_epsilon));
- }
+static s7_pointer all_x_c_s_op_s_opsqq(s7_scheme *sc, s7_pointer code)
+{
+ s7_pointer args, val, val1;
+ args = caddr(code);
+ val1 = caddr(args);
+ val = find_symbol_unchecked(sc, cadr(args));
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(val1)));
+ set_car(sc->t2_2, c_call(val1)(sc, sc->t1_1));
+ set_car(sc->t2_1, val);
+ set_car(sc->t2_2, c_call(args)(sc, sc->t2_1));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(code)));
+ return(c_call(code)(sc, sc->t2_1));
+}
- /* should (morally-equal? nan.0 (complex nan.0 nan.0)) be #t (it's #f above)? */
- if (is_NaN(real_part(x)))
- return((is_NaN(real_part(y))) &&
- (((is_NaN(imag_part(x))) && (is_NaN(imag_part(y)))) ||
- (imag_part(x) == imag_part(y)) ||
- (fabs(imag_part(x) - imag_part(y)) <= sc->morally_equal_float_epsilon)));
+static s7_pointer all_x_c_op_opsq_q_s(s7_scheme *sc, s7_pointer code)
+{
+ s7_pointer arg;
+ arg = cadadr(code);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(arg)));
+ set_car(sc->t1_1, c_call(arg)(sc, sc->t1_1));
+ set_car(sc->t2_1, c_call(cadr(code))(sc, sc->t1_1));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(code)));
+ return(c_call(code)(sc, sc->t2_1));
+}
- if (is_NaN(imag_part(x)))
- return((is_NaN(imag_part(y))) &&
- ((real_part(x) == real_part(y)) ||
- (fabs(real_part(x) - real_part(y)) <= sc->morally_equal_float_epsilon)));
+static s7_pointer all_x_c_op_opsq_q_c(s7_scheme *sc, s7_pointer code)
+{
+ s7_pointer arg;
+ arg = cadadr(code);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(arg)));
+ set_car(sc->t1_1, c_call(arg)(sc, sc->t1_1));
+ set_car(sc->t2_1, c_call(cadr(code))(sc, sc->t1_1));
+ set_car(sc->t2_2, caddr(code));
+ return(c_call(code)(sc, sc->t2_1));
+}
- if ((is_NaN(real_part(y))) ||
- (is_NaN(imag_part(y))))
- return(false);
+static s7_pointer all_x_c_a(s7_scheme *sc, s7_pointer arg)
+{
+ set_car(sc->t1_1, c_call(cdr(arg))(sc, cadr(arg)));
+ return(c_call(arg)(sc, sc->t1_1));
+}
- return(((real_part(x) == real_part(y)) ||
- (fabs(real_part(x) - real_part(y)) <= sc->morally_equal_float_epsilon)) &&
- ((imag_part(x) == imag_part(y)) ||
- (fabs(imag_part(x) - imag_part(y)) <= sc->morally_equal_float_epsilon)));
+static s7_pointer all_x_c_ssa(s7_scheme *sc, s7_pointer arg)
+{
+ int tx;
+ tx = next_tx(sc);
+ sc->t_temps[tx] = c_call(cdddr(arg))(sc, cadddr(arg));
+ set_car(sc->t3_1, find_symbol_unchecked(sc, cadr(arg)));
+ set_car(sc->t3_2, find_symbol_unchecked(sc, caddr(arg)));
+ set_car(sc->t3_3, sc->t_temps[tx]);
+ return(c_call(arg)(sc, sc->t3_1));
}
-static bool rng_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer all_x_c_sas(s7_scheme *sc, s7_pointer arg)
{
-#if WITH_GMP
- return(x == y);
-#else
- return((x == y) ||
- ((is_random_state(y)) &&
- (random_seed(x) == random_seed(y)) &&
- (random_carry(x) == random_carry(y))));
-#endif
+ int tx;
+ tx = next_tx(sc);
+ sc->t_temps[tx] = c_call(cddr(arg))(sc, caddr(arg));
+ set_car(sc->t3_1, find_symbol_unchecked(sc, cadr(arg)));
+ set_car(sc->t3_3, find_symbol_unchecked(sc, cadddr(arg)));
+ set_car(sc->t3_2, sc->t_temps[tx]);
+ return(c_call(arg)(sc, sc->t3_1));
}
+static s7_pointer all_x_c_sca(s7_scheme *sc, s7_pointer arg)
+{
+ int tx;
+ tx = next_tx(sc);
+ sc->t_temps[tx] = c_call(cdddr(arg))(sc, cadddr(arg));
+ set_car(sc->t3_1, find_symbol_unchecked(sc, cadr(arg)));
+ set_car(sc->t3_2, caddr(arg));
+ set_car(sc->t3_3, sc->t_temps[tx]);
+ return(c_call(arg)(sc, sc->t3_1));
+}
+static s7_pointer all_x_c_csa(s7_scheme *sc, s7_pointer arg)
+{
+ int tx;
+ tx = next_tx(sc);
+ sc->t_temps[tx] = c_call(cdddr(arg))(sc, cadddr(arg));
+ set_car(sc->t3_1, cadr(arg));
+ set_car(sc->t3_2, find_symbol_unchecked(sc, caddr(arg)));
+ set_car(sc->t3_3, sc->t_temps[tx]);
+ return(c_call(arg)(sc, sc->t3_1));
+}
-static bool (*equals[NUM_TYPES])(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally);
+static s7_pointer all_x_c_ca(s7_scheme *sc, s7_pointer arg)
+{
+ int tx;
+ tx = next_tx(sc);
+ sc->t_temps[tx] = c_call(cddr(arg))(sc, caddr(arg));
+ set_car(sc->t2_1, cadr(arg));
+ set_car(sc->t2_2, sc->t_temps[tx]);
+ return(c_call(arg)(sc, sc->t2_1));
+}
-static void init_equals(void)
+static s7_pointer all_x_c_ac(s7_scheme *sc, s7_pointer arg)
{
- int i;
- for (i = 0; i < NUM_TYPES; i++) equals[i] = eq_equal;
- equals[T_SYMBOL] = symbol_equal;
- equals[T_C_POINTER] = c_pointer_equal;
- equals[T_UNSPECIFIED] = unspecified_equal;
- equals[T_STRING] = string_equal;
- equals[T_SYNTAX] = syntax_equal;
- equals[T_C_OBJECT] = c_object_equal;
- equals[T_RANDOM_STATE] = rng_equal;
- equals[T_ITERATOR] = iterator_equal;
- equals[T_INPUT_PORT] = port_equal;
- equals[T_OUTPUT_PORT] = port_equal;
- equals[T_MACRO] = closure_equal;
- equals[T_MACRO_STAR] = closure_equal;
- equals[T_BACRO] = closure_equal;
- equals[T_BACRO_STAR] = closure_equal;
- equals[T_CLOSURE] = closure_equal;
- equals[T_CLOSURE_STAR] = closure_equal;
- equals[T_HASH_TABLE] = hash_table_equal;
- equals[T_LET] = let_equal;
- equals[T_PAIR] = pair_equal;
- equals[T_VECTOR] = vector_equal;
- equals[T_INT_VECTOR] = vector_equal;
- equals[T_FLOAT_VECTOR] = vector_equal;
- equals[T_INTEGER] = integer_equal;
- equals[T_RATIO] = fraction_equal;
- equals[T_REAL] = real_equal;
- equals[T_COMPLEX] = complex_equal;
- equals[T_BIG_INTEGER] = bignum_equal;
- equals[T_BIG_RATIO] = bignum_equal;
- equals[T_BIG_REAL] = bignum_equal;
- equals[T_BIG_COMPLEX] = bignum_equal;
+ int tx;
+ tx = next_tx(sc);
+ sc->t_temps[tx] = c_call(cdr(arg))(sc, cadr(arg));
+ set_car(sc->t2_2, caddr(arg));
+ set_car(sc->t2_1, sc->t_temps[tx]);
+ return(c_call(arg)(sc, sc->t2_1));
}
-static bool s7_is_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static s7_pointer all_x_c_sa(s7_scheme *sc, s7_pointer arg)
{
- return((*(equals[type(x)]))(sc, x, y, ci, morally));
+ int tx;
+ tx = next_tx(sc);
+ sc->t_temps[tx] = c_call(cddr(arg))(sc, caddr(arg));
+ set_car(sc->t2_1, find_symbol_checked(sc, cadr(arg)));
+ set_car(sc->t2_2, sc->t_temps[tx]);
+ return(c_call(arg)(sc, sc->t2_1));
}
-bool s7_is_equal(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_pointer all_x_c_as(s7_scheme *sc, s7_pointer arg)
{
- return(s7_is_equal_1(sc, x, y, NULL, false));
+ int tx;
+ tx = next_tx(sc);
+ sc->t_temps[tx] = c_call(cdr(arg))(sc, cadr(arg));
+ set_car(sc->t2_2, find_symbol_checked(sc, caddr(arg)));
+ set_car(sc->t2_1, sc->t_temps[tx]);
+ return(c_call(arg)(sc, sc->t2_1));
}
-bool s7_is_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_pointer all_x_if_x2(s7_scheme *sc, s7_pointer arg)
{
- return(s7_is_equal_1(sc, x, y, NULL, true));
+ s7_pointer p;
+ p = cdr(arg);
+ if (is_true(sc, c_call(p)(sc, car(p))))
+ p = cdr(p);
+ else p = cddr(p);
+ return(c_call(p)(sc, car(p)));
}
-static s7_pointer g_is_equal(s7_scheme *sc, s7_pointer args)
+static s7_pointer all_x_and2(s7_scheme *sc, s7_pointer arg)
{
- #define H_is_equal "(equal? obj1 obj2) returns #t if obj1 is equal to obj2"
- #define Q_is_equal pcl_bt
- return(make_boolean(sc, s7_is_equal(sc, car(args), cadr(args))));
+ /* arg is the full expr: (and ...) */
+ s7_pointer p, val;
+ p = cdr(arg);
+ val = c_call(p)(sc, car(p));
+ if (val == sc->F) return(val);
+ p = cdr(p);
+ return(c_call(p)(sc, car(p)));
}
-static s7_pointer g_is_morally_equal(s7_scheme *sc, s7_pointer args)
+static s7_pointer all_x_and3(s7_scheme *sc, s7_pointer arg)
{
- #define H_is_morally_equal "(morally-equal? obj1 obj2) returns #t if obj1 is close enough to obj2."
- #define Q_is_morally_equal pcl_bt
- return(make_boolean(sc, s7_is_morally_equal(sc, car(args), cadr(args))));
+ s7_pointer p, val;
+ p = cdr(arg);
+ val = c_call(p)(sc, car(p));
+ if (val == sc->F) return(val);
+ p = cdr(p);
+ val = c_call(p)(sc, car(p));
+ if (val == sc->F) return(val);
+ p = cdr(p);
+ return(c_call(p)(sc, car(p)));
}
+static s7_pointer all_x_or2(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer p, val;
+ p = cdr(arg);
+ val = c_call(p)(sc, car(p));
+ if (val != sc->F) return(val);
+ p = cdr(p);
+ return(c_call(p)(sc, car(p)));
+}
+static s7_pointer all_x_closure_s(s7_scheme *sc, s7_pointer code)
+{
+ /* no gain from all_x for the body rather than safe_c_c */
+ 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 = car(closure_body(opt_lambda(code)));
+ result = c_call(code)(sc, cdr(code));
+ sc->envir = old_e;
+ return(result);
+}
-/* ---------------------------------------- length, copy, fill ---------------------------------------- */
+static s7_pointer all_x_closure_a(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)), c_call(cdr(code))(sc, cadr(code)));
+ code = car(closure_body(opt_lambda(code)));
+ result = c_call(code)(sc, cdr(code));
+ sc->envir = old_e;
+ return(result);
+}
-static s7_pointer s7_length(s7_scheme *sc, s7_pointer lst)
+static void all_x_function_init(void)
{
- switch (type(lst))
- {
- case T_PAIR:
- {
- int 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));
- }
+ int i;
+ for (i = 0; i < OPT_MAX_DEFINED; i++)
+ all_x_function[i] = NULL;
- case T_NIL:
- return(small_int(0));
+ all_x_function[HOP_SAFE_C_C] = all_x_c_c;
+ all_x_function[HOP_SAFE_C_OR2] = all_x_or2;
+ all_x_function[HOP_SAFE_C_AND2] = all_x_and2;
+ all_x_function[HOP_SAFE_C_A] = all_x_c_a;
+ all_x_function[HOP_SAFE_C_S] = all_x_c_s;
+ all_x_function[HOP_SAFE_C_L] = local_x_c_s;
+ all_x_function[HOP_SAFE_CAR_S] = all_x_car_s;
+ all_x_function[HOP_SAFE_CDR_S] = all_x_cdr_s;
+ all_x_function[HOP_SAFE_CADR_S] = all_x_cadr_s;
+ all_x_function[HOP_SAFE_IS_PAIR_S] = all_x_is_pair_s;
+ all_x_function[HOP_SAFE_IS_NULL_S] = all_x_is_null_s;
+ all_x_function[HOP_SAFE_IS_SYMBOL_S] = all_x_is_symbol_s;
- case T_INT_VECTOR:
- case T_FLOAT_VECTOR:
- case T_VECTOR:
- return(make_integer(sc, vector_length(lst)));
+ all_x_function[HOP_SAFE_C_opCq] = all_x_c_opcq;
+ all_x_function[HOP_SAFE_C_opSq] = all_x_c_opsq;
+ all_x_function[HOP_SAFE_C_opSSq] = all_x_c_opssq;
+ all_x_function[HOP_SAFE_C_opSCq] = all_x_c_opscq;
+ all_x_function[HOP_SAFE_C_opCSq] = all_x_c_opcsq;
+ all_x_function[HOP_SAFE_C_opSQq] = all_x_c_opsqq;
+ all_x_function[HOP_SAFE_C_opQSq] = all_x_c_opqsq;
- case T_STRING:
- return(make_integer(sc, string_length(lst)));
+ all_x_function[HOP_SAFE_C_SC] = all_x_c_sc;
+ all_x_function[HOP_SAFE_C_CS] = all_x_c_cs;
+ all_x_function[HOP_SAFE_C_CQ] = all_x_c_cq;
+ all_x_function[HOP_SAFE_C_SQ] = all_x_c_sq;
+ all_x_function[HOP_SAFE_C_QS] = all_x_c_qs;
+ all_x_function[HOP_SAFE_C_SS] = all_x_c_ss;
- case T_ITERATOR:
- return(make_integer(sc, iterator_length(lst))); /* in several cases, this is incorrect */
+ all_x_function[HOP_SAFE_C_opSq_S] = all_x_c_opsq_s;
+ all_x_function[HOP_SAFE_C_opSq_C] = all_x_c_opsq_c;
+ all_x_function[HOP_SAFE_C_opSq_Q] = all_x_c_opsq_q;
+ all_x_function[HOP_SAFE_C_opSq_QS] = all_x_c_opsq_qs;
+ all_x_function[HOP_SAFE_C_S_opSq] = all_x_c_s_opsq;
+ all_x_function[HOP_SAFE_C_S_opCq] = all_x_c_s_opcq;
+ all_x_function[HOP_SAFE_C_opCq_S] = all_x_c_opcq_s;
+ all_x_function[HOP_SAFE_C_opCq_C] = all_x_c_opcq_c;
+ all_x_function[HOP_SAFE_C_C_opSq] = all_x_c_c_opsq;
+ all_x_function[HOP_SAFE_C_C_opCq] = all_x_c_c_opcq;
+ all_x_function[HOP_SAFE_C_opCSq_C] = all_x_c_opcsq_c;
+ all_x_function[HOP_SAFE_C_opSSq_C] = all_x_c_opssq_c;
+ all_x_function[HOP_SAFE_C_opSCq_S] = all_x_c_opscq_s;
+ all_x_function[HOP_SAFE_C_opSCq_C] = all_x_c_opscq_c;
+ all_x_function[HOP_SAFE_C_opSSq_S] = all_x_c_opssq_s;
+ all_x_function[HOP_SAFE_C_S_opSSq] = all_x_c_s_opssq;
+ all_x_function[HOP_SAFE_C_C_opSSq] = all_x_c_c_opssq;
+ all_x_function[HOP_SAFE_C_S_opSCq] = all_x_c_s_opscq;
+ all_x_function[HOP_SAFE_C_opSq_opSq] = all_x_c_opsq_opsq;
+ all_x_function[HOP_SAFE_C_opSq_opCq] = all_x_c_opsq_opcq;
+ all_x_function[HOP_SAFE_C_opCq_opSq] = all_x_c_opcq_opsq;
+ all_x_function[HOP_SAFE_C_opSq_opSSq] = all_x_c_opsq_opssq;
+ all_x_function[HOP_SAFE_C_opCq_opCq] = all_x_c_opcq_opcq;
+ all_x_function[HOP_SAFE_C_opSSq_opSq] = all_x_c_opssq_opsq;
+ all_x_function[HOP_SAFE_C_opSSq_opCq] = all_x_c_opssq_opcq;
+ all_x_function[HOP_SAFE_C_opSSq_opSSq] = all_x_c_opssq_opssq;
+ all_x_function[HOP_SAFE_C_op_opSSq_q_C] = all_x_c_op_opssq_q_c;
+ all_x_function[HOP_SAFE_C_op_opSq_q] = all_x_c_op_opsq_q;
+ all_x_function[HOP_SAFE_C_op_opSq_q_S] = all_x_c_op_opsq_q_s;
+ all_x_function[HOP_SAFE_C_op_opSq_q_C] = all_x_c_op_opsq_q_c;
+ all_x_function[HOP_SAFE_C_op_S_opSq_q] = all_x_c_op_s_opsq_q;
+ all_x_function[HOP_SAFE_C_op_opSq_S_q] = all_x_c_op_opsq_s_q;
+ all_x_function[HOP_SAFE_C_S_op_S_opSqq] = all_x_c_s_op_s_opsqq;
+ all_x_function[HOP_SAFE_C_CSA] = all_x_c_csa;
+ all_x_function[HOP_SAFE_C_SCA] = all_x_c_sca;
+ all_x_function[HOP_SAFE_C_SAS] = all_x_c_sas;
+ all_x_function[HOP_SAFE_C_SSA] = all_x_c_ssa;
+ all_x_function[HOP_SAFE_C_SSC] = all_x_c_ssc;
+ all_x_function[HOP_SAFE_C_SSS] = all_x_c_sss;
+ all_x_function[HOP_SAFE_C_SCS] = all_x_c_scs;
+ all_x_function[HOP_SAFE_C_CSS] = all_x_c_css;
+ all_x_function[HOP_SAFE_C_CSC] = all_x_c_csc;
+ all_x_function[HOP_SAFE_CLOSURE_S_C] = all_x_closure_s;
+ all_x_function[HOP_SAFE_CLOSURE_A_C] = all_x_closure_a;
+ all_x_function[HOP_SAFE_C_ALL_S] = all_x_c_all_s;
+}
- case T_HASH_TABLE:
- return(make_integer(sc, hash_table_mask(lst) + 1));
+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_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);
+static s7_pointer g_and_2(s7_scheme *sc, s7_pointer args);
+static s7_pointer g_and_3(s7_scheme *sc, s7_pointer args);
+static s7_pointer g_or_2(s7_scheme *sc, s7_pointer args);
+static s7_pointer check_quote(s7_scheme *sc, s7_pointer code);
- case T_C_OBJECT:
- check_method(sc, lst, sc->length_symbol, list_1(sc, lst));
- return(object_length(sc, lst));
+static s7_function all_x_eval(s7_scheme *sc, s7_pointer holder, s7_pointer e, safe_sym_t *checker)
+{
+ s7_pointer arg;
+ arg = car(holder);
+ if (is_pair(arg))
+ {
+ if (is_optimized(arg))
+ {
+ 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 (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);
+ }
+ if (c_call(arg) == g_add_cs1)
+ return(all_x_c_add1);
+ if (c_call(arg) == g_add_cl1)
+ return(local_x_c_add1);
+ if (c_call(arg) == g_if_x2)
+ return(all_x_if_x2);
+ if (c_call(arg) == g_and_2)
+ return(all_x_and2);
+ if (c_call(arg) == g_or_2)
+ return(all_x_or2);
+ if (c_call(arg) == g_and_3)
+ return(all_x_and3);
+ if ((c_call(arg) == g_add_si) &&
+ (checker(sc, cadr(arg), e)))
+ return((is_local_symbol(cdr(arg))) ? local_x_c_addi : all_x_c_addi);
+ if ((c_call(arg) == g_char_equal_s_ic) &&
+ (checker(sc, cadr(arg), e)))
+ return(all_x_c_char_eq);
+ 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);
+ return(all_x_not_c_c);
+ }
+ if (c_call(arg) == g_hash_table_ref_ss)
+ return((is_local_symbol(cdr(arg)) && is_local_symbol(cddr(arg))) ? local_x_c_hash_table_ref_ss : all_x_c_hash_table_ref_ss);
+ if (c_call(arg) == g_hash_table_ref_car)
+ return(all_x_c_hash_table_ref_car);
+ return(all_x_c_c);
+
+ case HOP_SAFE_C_S:
+ {
+ bool is_local;
+ is_local = is_local_symbol(cdr(arg));
+ if (car(arg) == sc->cdr_symbol) return((is_local) ? local_x_cdr_s : all_x_cdr_s);
+ if (car(arg) == sc->car_symbol) return((is_local) ? local_x_car_s : all_x_car_s);
+ if (car(arg) == sc->cadr_symbol) return((is_local) ? local_x_cadr_s : all_x_cadr_s);
+ if (car(arg) == sc->is_null_symbol) return((is_local) ? local_x_is_null_s : all_x_is_null_s);
+ if (car(arg) == sc->is_pair_symbol) return((is_local) ? local_x_is_pair_s : all_x_is_pair_s);
+ if (car(arg) == sc->is_symbol_symbol) return((is_local) ? local_x_is_symbol_s : all_x_is_symbol_s);
+ if (car(arg) == sc->is_keyword_symbol) return(all_x_is_keyword_s);
+ if (car(arg) == sc->is_integer_symbol) return(all_x_is_integer_s);
+ if (car(arg) == sc->is_procedure_symbol) return(all_x_is_procedure_s);
+ if (car(arg) == sc->is_string_symbol) return(all_x_is_string_s);
+ if (car(arg) == sc->is_vector_symbol) return(all_x_is_vector_s);
+ if (car(arg) == sc->is_proper_list_symbol) return(all_x_is_proper_list_s);
+ if (car(arg) == sc->not_symbol) return(all_x_not_s);
+ return(all_x_c_s);
+ }
- case T_LET:
- check_method(sc, lst, sc->length_symbol, list_1(sc, lst));
- return(make_integer(sc, let_length(sc, lst)));
+ case HOP_SAFE_C_L:
+ if (car(arg) == sc->cdr_symbol) return(local_x_cdr_s);
+ if (car(arg) == sc->car_symbol) return(local_x_car_s);
+ if (car(arg) == sc->cadr_symbol) return(local_x_cadr_s);
+ if (car(arg) == sc->is_null_symbol) return(local_x_is_null_s);
+ if (car(arg) == sc->is_pair_symbol) return(local_x_is_pair_s);
+ if (car(arg) == sc->is_symbol_symbol) return(local_x_is_symbol_s);
+ return(local_x_c_s);
+
+ 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);
+ return((is_local_symbol(cdr(cadr(arg)))) ? local_x_c_opsq : all_x_c_opsq);
- case T_CLOSURE:
- case T_CLOSURE_STAR:
- if (has_methods(lst))
- return(make_integer(sc, closure_length(sc, lst)));
- return(sc->F);
+ case HOP_SAFE_C_opSq_C:
+ return((is_local_symbol(cdr(cadr(arg)))) ? local_x_c_opsq_c : all_x_c_opsq_c);
- case T_INPUT_PORT:
- if (is_string_port(lst))
- return(make_integer(sc, port_data_size(lst)));
- return(sc->F);
+ case HOP_SAFE_C_SC:
+ return((is_local_symbol(cdr(arg))) ? local_x_c_sc : all_x_c_sc);
+ case HOP_SAFE_C_SQ:
+ return((is_local_symbol(cdr(arg))) ? local_x_c_sq : all_x_c_sq);
+
+ case HOP_SAFE_C_SS:
+ if ((is_local_symbol(cdr(arg))) &&
+ (is_local_symbol(cddr(arg))))
+ return(local_x_c_ss);
+ if (is_local_symbol(cdr(arg)))
+ return(all_x_c_ls);
+ return(all_x_c_ss);
+
+ case HOP_SAFE_C_opSSq:
+ if (car(arg) == sc->not_symbol)
+ return(all_x_c_not_opssq);
+ if ((is_local_symbol(cdr(cadr(arg)))) &&
+ (is_local_symbol(cddr(cadr(arg)))))
+ return(local_x_c_opssq);
+ return(all_x_c_opssq);
- default:
- return(sc->F);
- }
- return(sc->F);
-}
+ case HOP_SAFE_C_opSSq_S:
+ if ((is_local_symbol(cdr(cadr(arg)))) &&
+ (is_local_symbol(cddr(cadr(arg)))) &&
+ (is_local_symbol(cddr(arg))))
+ return(local_x_c_opssq_s);
+ return(all_x_c_opssq_s);
+
+ case HOP_SAFE_C_S_opSSq:
+ if ((is_local_symbol(cdr(caddr(arg)))) &&
+ (is_local_symbol(cddr(caddr(arg)))) &&
+ (is_local_symbol(cdr(arg))))
+ return(local_x_c_s_opssq);
+ return(all_x_c_s_opssq);
+
+ case HOP_SAFE_C_S_opSq:
+ if ((is_local_symbol(cdr(caddr(arg)))) &&
+ (is_local_symbol(cdr(arg))))
+ return(local_x_c_s_opsq);
+ return(all_x_c_s_opsq);
-static s7_pointer g_length(s7_scheme *sc, s7_pointer args)
-{
- #define H_length "(length obj) returns the length of obj, which can be a list, vector, string, or hash-table. \
-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)));
+ case HOP_SAFE_C_AA:
+ if (is_symbol(cadr(arg)))
+ return(all_x_c_sa);
+ if (is_symbol(caddr(arg)))
+ return(all_x_c_as);
+ if (!is_pair(cadr(arg)))
+ return(all_x_c_ca);
+ if (!is_pair(caddr(arg)))
+ return(all_x_c_ac);
+ return(NULL);
+
+ default:
+ return(all_x_function[optimize_op(arg)]);
+ }
+ }
+ if (car(arg) == sc->quote_symbol)
+ {
+ check_quote(sc, cdr(arg));
+ return(all_x_q);
+ }
+ return(NULL);
+ }
+ if (is_symbol(arg))
+ {
+ if ((is_keyword(arg)) ||
+ ((arg == sc->else_symbol) &&
+ (is_global(arg))))
+ return(all_x_k);
+ if (is_local_symbol(holder))
+ return(local_x_s);
+ if (checker(sc, arg, e))
+ return(all_x_s);
+ return(all_x_unsafe_s);
+ }
+ return(all_x_c);
}
-/* what about (length file)? input port, read_file gets the file length, so perhaps save it
- * but we're actually looking at the port, so its length is what remains to be read? (if input port)
- */
-
-PF_TO_PF(length, s7_length)
-
+/* -------------------------------------------------------------------------------- */
-/* -------------------------------- copy -------------------------------- */
-
-static s7_pointer copy_to_string_error = NULL, copy_to_byte_vector_error = NULL;
+typedef s7_int (*s7_i_pi_t)(s7_pointer p, s7_int i1);
+typedef s7_int (*s7_i_pii_t)(s7_pointer p, s7_int i1, s7_int i2);
+typedef s7_int (*s7_i_iii_t)(s7_int i1, s7_int i2, s7_int i3);
+typedef s7_pointer (*s7_p_p_t)(s7_pointer p);
+typedef s7_pointer (*s7_p_t)(void);
+typedef bool (*s7_b_pp_t)(s7_pointer p1, s7_pointer p2);
+typedef bool (*s7_b_pi_t)(s7_pointer p1, s7_int i2);
+typedef bool (*s7_b_d_t)(s7_double p1);
+typedef bool (*s7_b_i_t)(s7_int p1);
+typedef bool (*s7_b_ii_t)(s7_int p1, s7_int p2);
+typedef bool (*s7_b_dd_t)(s7_double p1, s7_double p2);
+typedef s7_pointer (*s7_p_pp_t)(s7_pointer p1, s7_pointer p2);
+typedef s7_pointer (*s7_p_ppi_t)(s7_pointer p1, s7_pointer p2, s7_int i1);
+typedef s7_pointer (*s7_p_ppp_t)(s7_pointer p1, s7_pointer p2, s7_pointer p3);
+typedef s7_pointer (*s7_p_pi_t)(s7_pointer p1, s7_int i1);
+typedef s7_pointer (*s7_p_pip_t)(s7_pointer p1, s7_int i1, s7_pointer p2);
+typedef s7_pointer (*s7_p_ii_t)(s7_int i1, s7_int i2);
-static void set_string_error_source(s7_scheme *sc, s7_pointer source)
-{
- if (!copy_to_string_error)
- copy_to_string_error = s7_make_permanent_string("copy ~A to string, ~S is not a character");
- if (!copy_to_byte_vector_error)
- copy_to_byte_vector_error = s7_make_permanent_string("copy ~A to byte-vector, ~S is not a byte");
- set_cadr(sc->elist_3, prepackaged_type_name(sc, source));
-}
+enum {o_d_v, o_d_vd, o_d_vdd, o_d_vid, o_d_id, o_d_pi, o_d_ip, o_d_pd, o_d_pid, o_d, o_d_d, o_d_dd, o_d_ddd, o_d_dddd,
+ o_i_d, o_i_i, o_i_ii, o_i_iii, o_i_p, o_i_pi, o_i_pii, o_d_p, o_b_p, o_b_pp, o_b_pp_direct, o_b_pi, o_b_ii, o_b_dd,
+ o_p, o_p_p, o_p_ii,
+ o_p_pp, o_p_pp_direct, o_p_ppp, o_p_ppp_direct, o_p_pi, o_p_pi_direct, o_p_ppi, o_p_pip, o_p_pip_direct, o_b_i, o_b_d};
-static s7_pointer string_setter(s7_scheme *sc, s7_pointer str, s7_int loc, s7_pointer val)
+static void add_opt_func(s7_pointer f, int typ, void *func)
{
- if (s7_is_character(val))
+ if (is_c_function(f))
{
- string_value(str)[loc] = s7_character(val);
- return(val);
+ opt_funcs *op;
+ op = (opt_funcs *)malloc(sizeof(opt_funcs));
+ op->typ = typ;
+ op->func = func;
+ op->next = c_function_opt_data(f);
+ c_function_opt_data(f) = op;
}
- /* (copy #(3) "123"): wrong type arg because not a char, but it's very confusing to report
- * error: copy argument 3, 3, is an integer but should be a character
- * perhaps better, copy #(3) to string, 3 is not a character
- */
-#if DEBUGGING
- if (!copy_to_string_error) {fprintf(stderr, "string_error not set\n"); abort();}
-#endif
- set_car(sc->elist_3, copy_to_string_error);
- set_caddr(sc->elist_3, val);
- return(s7_error(sc, sc->wrong_type_arg_symbol, sc->elist_3));
}
-static s7_pointer byte_vector_setter(s7_scheme *sc, s7_pointer str, s7_int loc, s7_pointer val)
+static void *opt_func(s7_pointer f, int typ)
{
- if (s7_is_integer(val))
+ if (is_c_function(f))
{
- s7_int byte;
- byte = s7_integer(val);
- if ((byte >= 0) && (byte < 256))
- string_value(str)[loc] = (unsigned char)byte;
- else return(simple_wrong_type_argument_with_type(sc, sc->copy_symbol, val, an_unsigned_byte_string));
- return(val);
+ opt_funcs *p;
+ for (p = c_function_opt_data(f); p; p = p->next)
+ if (p->typ == typ)
+ return(p->func);
}
-#if DEBUGGING
- if (!copy_to_byte_vector_error) {fprintf(stderr, "byte_vector_error not set\n"); abort();}
-#endif
- set_car(sc->elist_3, copy_to_byte_vector_error);
- set_caddr(sc->elist_3, val);
- return(s7_error(sc, sc->wrong_type_arg_symbol, sc->elist_3));
+ return(NULL);
}
-static s7_pointer string_getter(s7_scheme *sc, s7_pointer str, s7_int loc)
-{
- return(s7_make_character(sc, (unsigned char)(string_value(str)[loc]))); /* cast needed else (copy (string (integer->char 255))...) is trouble */
-}
+/* clm2xen.c */
+void s7_set_d_function(s7_pointer f, s7_d_t df) {add_opt_func(f, o_d, (void *)df);}
+s7_d_t s7_d_function(s7_pointer f) {return((s7_d_t)opt_func(f, o_d));}
-static s7_pointer byte_vector_getter(s7_scheme *sc, s7_pointer str, s7_int loc)
-{
- return(make_integer(sc, (unsigned char)(string_value(str)[loc])));
-}
+void s7_set_d_d_function(s7_pointer f, s7_d_d_t df) {add_opt_func(f, o_d_d, (void *)df);}
+s7_d_d_t s7_d_d_function(s7_pointer f) {return((s7_d_d_t)opt_func(f, o_d_d));}
-static s7_pointer c_object_setter(s7_scheme *sc, s7_pointer obj, s7_int loc, s7_pointer val)
-{
- 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));
-}
+void s7_set_d_dd_function(s7_pointer f, s7_d_dd_t df) {add_opt_func(f, o_d_dd, (void *)df);}
+s7_d_dd_t s7_d_dd_function(s7_pointer f) {return((s7_d_dd_t)opt_func(f, o_d_dd));}
-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));
-}
+void s7_set_d_v_function(s7_pointer f, s7_d_v_t df) {add_opt_func(f, o_d_v, (void *)df);}
+s7_d_v_t s7_d_v_function(s7_pointer f) {return((s7_d_v_t)opt_func(f, o_d_v));}
-static s7_pointer let_setter(s7_scheme *sc, s7_pointer e, s7_int loc, s7_pointer val)
-{
- /* loc is irrelevant here
- * val has to be of the form (cons symbol value)
- * if symbol is already in e, its value is changed, otherwise a new slot is added to e
- */
- static s7_pointer ls_err = NULL;
- s7_pointer sym;
- if (!is_pair(val))
- {
- if (!ls_err) ls_err = s7_make_permanent_string("(cons symbol value)");
- return(wrong_type_argument_with_type(sc, sc->copy_symbol, 3, e, ls_err));
- }
- sym = car(val);
- if (!is_symbol(sym))
- {
- if (!ls_err) ls_err = s7_make_permanent_string("(cons symbol value)");
- return(wrong_type_argument_with_type(sc, sc->copy_symbol, 3, e, ls_err));
- }
- if ((symbol_id(sym) < let_id(e)) ||
- (s7_let_set(sc, e, sym, cdr(val)) != cdr(val)))
- make_slot_1(sc, e, sym, cdr(val));
- return(val);
-}
+void s7_set_d_vd_function(s7_pointer f, s7_d_vd_t df) {add_opt_func(f, o_d_vd, (void *)df);}
+s7_d_vd_t s7_d_vd_function(s7_pointer f) {return((s7_d_vd_t)opt_func(f, o_d_vd));}
-static s7_pointer hash_table_setter(s7_scheme *sc, s7_pointer e, s7_int loc, s7_pointer val)
-{
- /* loc is irrelevant here
- * val has to be of the form (cons key value)
- * if key is already in e, its value is changed, otherwise a new slot is added to e
- */
- if (!is_pair(val))
- return(wrong_type_argument_with_type(sc, sc->copy_symbol, 1, e, a_list_string));
- return(s7_hash_table_set(sc, e, car(val), cdr(val)));
-}
+void s7_set_d_vdd_function(s7_pointer f, s7_d_vdd_t df) {add_opt_func(f, o_d_vdd, (void *)df);}
+s7_d_vdd_t s7_d_vdd_function(s7_pointer f) {return((s7_d_vdd_t)opt_func(f, o_d_vdd));}
+void s7_set_d_vid_function(s7_pointer f, s7_d_vid_t df) {add_opt_func(f, o_d_vid, (void *)df);}
+s7_d_vid_t s7_d_vid_function(s7_pointer f) {return((s7_d_vid_t)opt_func(f, o_d_vid));}
-s7_pointer s7_copy(s7_scheme *sc, s7_pointer args)
-{
- #define H_copy "(copy obj) returns a copy of obj, (copy src dest) copies src into dest, (copy src dest start end) copies src from start to end."
- /* #define Q_copy s7_make_circular_signature(sc, 3, 4, sc->T, sc->is_sequence_symbol, sc->is_sequence_symbol, sc->is_integer_symbol) */
- /* this is not right when c-object types are handled in lint -- a generator or Snd object need not consider itself a sequence,
- * but it can provide a copy method. So, I think I'll just use #t
- */
- #define Q_copy s7_make_circular_signature(sc, 3, 4, sc->T, sc->T, sc->T, sc->is_integer_symbol)
+void s7_set_d_id_function(s7_pointer f, s7_d_id_t df) {add_opt_func(f, o_d_id, (void *)df);}
+s7_d_id_t s7_d_id_function(s7_pointer f) {return((s7_d_id_t)opt_func(f, o_d_id));}
- s7_pointer source, dest;
- s7_int i, j, dest_len, start, end, source_len;
- s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_int loc, s7_pointer val) = NULL;
- s7_pointer (*get)(s7_scheme *sc, s7_pointer obj, s7_int loc) = NULL;
- bool have_indices;
+void s7_set_d_pid_function(s7_pointer f, s7_d_pid_t df) {add_opt_func(f, o_d_pid, (void *)df);}
+s7_d_pid_t s7_d_pid_function(s7_pointer f) {return((s7_d_pid_t)opt_func(f, o_d_pid));}
- source = car(args);
- if (is_null(cdr(args))) /* (copy obj) */
- {
- switch (type(source))
- {
- case T_STRING:
- {
- s7_pointer ns;
- ns = s7_make_string_with_length(sc, string_value(source), string_length(source));
- if (is_byte_vector(source))
- set_byte_vector(ns);
- return(ns);
- }
-
- case T_C_OBJECT:
- return(object_copy(sc, args));
+void s7_set_d_ip_function(s7_pointer f, s7_d_ip_t df) {add_opt_func(f, o_d_ip, (void *)df);}
+s7_d_ip_t s7_d_ip_function(s7_pointer f) {return((s7_d_ip_t)opt_func(f, o_d_ip));}
- case T_RANDOM_STATE:
- return(rng_copy(sc, args));
-
- case T_HASH_TABLE: /* this has to copy nearly everything */
- {
- unsigned int gc_loc;
- s7_pointer new_hash;
- 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);
- 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));
- s7_gc_unprotect_at(sc, gc_loc);
- return(new_hash);
- }
-
- case T_ITERATOR:
- return(iterator_copy(sc, source));
-
- case T_LET:
- check_method(sc, source, sc->copy_symbol, args);
- return(let_copy(sc, source)); /* this copies only the local env and points to outer envs */
-
- case T_CLOSURE: case T_CLOSURE_STAR:
- case T_MACRO: case T_MACRO_STAR:
- case T_BACRO: case T_BACRO_STAR:
- check_method(sc, source, sc->copy_symbol, args);
- return(copy_closure(sc, source));
-
- case T_INT_VECTOR:
- case T_FLOAT_VECTOR:
- case T_VECTOR:
- return(s7_vector_copy(sc, source)); /* "shallow" copy */
-
- case T_PAIR: /* top level only, as in the other cases, last arg checks for circles */
- return(protected_list_copy(sc, source));
-
- case T_INTEGER:
- new_cell(sc, dest, T_INTEGER);
- integer(dest) = integer(source);
- return(dest);
+void s7_set_d_pd_function(s7_pointer f, s7_d_pd_t df) {add_opt_func(f, o_d_pd, (void *)df);}
+s7_d_pd_t s7_d_pd_function(s7_pointer f) {return((s7_d_pd_t)opt_func(f, o_d_pd));}
- case T_RATIO:
- new_cell(sc, dest, T_RATIO);
- numerator(dest) = numerator(source);
- denominator(dest) = denominator(source);
- return(dest);
+void s7_set_i_p_function(s7_pointer f, s7_i_p_t df) {add_opt_func(f, o_i_p, (void *)df);}
+s7_i_p_t s7_i_p_function(s7_pointer f) {return((s7_i_p_t)opt_func(f, o_i_p));}
- case T_REAL:
- new_cell(sc, dest, T_REAL);
- set_real(dest, real(source));
- return(dest);
+void s7_set_d_p_function(s7_pointer f, s7_d_p_t df) {add_opt_func(f, o_d_p, (void *)df);}
+s7_d_p_t s7_d_p_function(s7_pointer f) {return((s7_d_p_t)opt_func(f, o_d_p));}
- case T_COMPLEX:
- new_cell(sc, dest, T_COMPLEX);
- set_real_part(dest, real_part(source));
- set_imag_part(dest, imag_part(source));
- return(dest);
+void s7_set_b_p_function(s7_pointer f, s7_b_p_t df) {add_opt_func(f, o_b_p, (void *)df);}
+s7_b_p_t s7_b_p_function(s7_pointer f) {return((s7_b_p_t)opt_func(f, o_b_p));}
-#if WITH_GMP
- case T_BIG_INTEGER: return(mpz_to_big_integer(sc, big_integer(source)));
- case T_BIG_RATIO: return(mpq_to_big_ratio(sc, big_ratio(source)));
- case T_BIG_REAL: return(mpfr_to_big_real(sc, big_real(source)));
- case T_BIG_COMPLEX: return(mpc_to_big_complex(sc, big_complex(source)));
-#endif
-
- case T_C_POINTER:
- return(s7_make_c_pointer(sc, s7_c_pointer(source)));
- }
- return(source);
- }
+void s7_set_d_pi_function(s7_pointer f, s7_d_pi_t df) {add_opt_func(f, o_d_pi, (void *)df);}
+s7_d_pi_t s7_d_pi_function(s7_pointer f) {return((s7_d_pi_t)opt_func(f, o_d_pi));}
- have_indices = (is_pair(cddr(args)));
- dest = cadr(args);
- if ((source == dest) && (!have_indices))
- return(dest);
-
- switch (type(source))
- {
- case T_PAIR:
- if (dest == sc->key_readable_symbol) /* a kludge, but I can't think of anything less stupid */
- return(copy_body(sc, source));
+/* cload.scm */
+void s7_set_d_ddd_function(s7_pointer f, s7_d_ddd_t df) {add_opt_func(f, o_d_ddd, (void *)df);}
+s7_d_ddd_t s7_d_ddd_function(s7_pointer f) {return((s7_d_ddd_t)opt_func(f, o_d_ddd));}
- end = s7_list_length(sc, source);
- if (end == 0)
- end = circular_list_entries(source);
- else
- {
- if (end < 0) end = -end;
- }
- break;
+void s7_set_d_dddd_function(s7_pointer f, s7_d_dddd_t df) {add_opt_func(f, o_d_dddd, (void *)df);}
+s7_d_dddd_t s7_d_dddd_function(s7_pointer f) {return((s7_d_dddd_t)opt_func(f, o_d_dddd));}
- case T_INT_VECTOR:
- case T_FLOAT_VECTOR:
- case T_VECTOR:
- get = vector_getter(source);
- end = vector_length(source);
- break;
+void s7_set_i_i_function(s7_pointer f, s7_i_i_t df) {add_opt_func(f, o_i_i, (void *)df);}
+s7_i_i_t s7_i_i_function(s7_pointer f) {return((s7_i_i_t)opt_func(f, o_i_i));}
- case T_STRING:
- if (is_byte_vector(source))
- get = byte_vector_getter;
- else get = string_getter;
- end = string_length(source);
- break;
+void s7_set_i_ii_function(s7_pointer f, s7_i_ii_t df) {add_opt_func(f, o_i_ii, (void *)df);}
+s7_i_ii_t s7_i_ii_function(s7_pointer f) {return((s7_i_ii_t)opt_func(f, o_i_ii));}
- case T_HASH_TABLE:
- end = hash_table_entries(source);
- break;
+void s7_set_i_d_function(s7_pointer f, s7_i_d_t df) {add_opt_func(f, o_i_d, (void *)df);}
+s7_i_d_t s7_i_d_function(s7_pointer f) {return((s7_i_d_t)opt_func(f, o_i_d));}
- case T_C_OBJECT:
- check_method(sc, source, sc->copy_symbol, args);
- {
- s7_pointer x;
- x = object_copy(sc, args);
- if (x == dest)
- 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);
- if (!get) get = c_object_getter;
- end = object_length_to_int(sc, source);
- break;
+static void s7_set_i_iii_function(s7_pointer f, s7_i_iii_t df) {add_opt_func(f, o_i_iii, (void *)df);}
+s7_i_iii_t s7_i_iii_function(s7_pointer f) {return((s7_i_iii_t)opt_func(f, o_i_iii));}
- case T_LET:
- check_method(sc, source, sc->copy_symbol, args);
- if (source == sc->rootlet)
- return(wrong_type_argument_with_type(sc, sc->copy_symbol, 1, source, make_string_wrapper(sc, "a sequence other than the rootlet")));
- end = let_length(sc, source);
- break;
+static void s7_set_p_pi_function(s7_pointer f, s7_p_pi_t df) {add_opt_func(f, o_p_pi, (void *)df);}
+static s7_p_pi_t s7_p_pi_function(s7_pointer f) {return((s7_p_pi_t)opt_func(f, o_p_pi));}
- case T_NIL:
- end = 0;
- if (is_sequence(dest))
- break;
+static void s7_set_p_ppi_function(s7_pointer f, s7_p_ppi_t df) {add_opt_func(f, o_p_ppi, (void *)df);}
+static s7_p_ppi_t s7_p_ppi_function(s7_pointer f) {return((s7_p_ppi_t)opt_func(f, o_p_ppi));}
- default:
- return(wrong_type_argument_with_type(sc, sc->copy_symbol, 1, source, a_sequence_string));
- /* copy doesn't have to duplicate fill!, so (copy 1 #(...)) need not be supported */
- }
+static void s7_set_i_pi_function(s7_pointer f, s7_i_pi_t df) {add_opt_func(f, o_i_pi, (void *)df);}
+static s7_i_pi_t s7_i_pi_function(s7_pointer f) {return((s7_i_pi_t)opt_func(f, o_i_pi));}
- start = 0;
- if (have_indices)
- {
- s7_pointer p;
- p = start_and_end(sc, sc->copy_symbol, NULL, cddr(args), args, 3, &start, &end);
- if (p != sc->gc_nil) return(p);
- }
- if ((start == 0) && (source == dest))
- return(dest);
- source_len = end - start;
+static void s7_set_i_pii_function(s7_pointer f, s7_i_pii_t df) {add_opt_func(f, o_i_pii, (void *)df);}
+static s7_i_pii_t s7_i_pii_function(s7_pointer f) {return((s7_i_pii_t)opt_func(f, o_i_pii));}
- switch (type(dest))
- {
- case T_PAIR:
- dest_len = s7_list_length(sc, dest);
- if (dest_len == 0)
- dest_len = circular_list_entries(dest);
- else
- {
- if (dest_len < 0)
- dest_len = -dest_len;
- }
- break;
+static void s7_set_b_d_function(s7_pointer f, s7_b_d_t df) {add_opt_func(f, o_b_d, (void *)df);}
+static s7_b_d_t s7_b_d_function(s7_pointer f) {return((s7_b_d_t)opt_func(f, o_b_d));}
- case T_INT_VECTOR:
- case T_FLOAT_VECTOR:
- case T_VECTOR:
- set = vector_setter(dest);
- dest_len = vector_length(dest);
- break;
+static void s7_set_b_i_function(s7_pointer f, s7_b_i_t df) {add_opt_func(f, o_b_i, (void *)df);}
+static s7_b_i_t s7_b_i_function(s7_pointer f) {return((s7_b_i_t)opt_func(f, o_b_i));}
- case T_STRING:
- if (is_byte_vector(dest))
- set = byte_vector_setter;
- else set = string_setter;
- dest_len = string_length(dest);
- break;
+static void s7_set_b_pp_function(s7_pointer f, s7_b_pp_t df) {add_opt_func(f, o_b_pp, (void *)df);}
+static s7_b_pp_t s7_b_pp_function(s7_pointer f) {return((s7_b_pp_t)opt_func(f, o_b_pp));}
- case T_HASH_TABLE:
- set = hash_table_setter;
- dest_len = source_len;
- break;
+#if (!WITH_GMP)
+static void s7_set_b_pi_function(s7_pointer f, s7_b_pi_t df) {add_opt_func(f, o_b_pi, (void *)df);}
+#endif
+static s7_b_pi_t s7_b_pi_function(s7_pointer f) {return((s7_b_pi_t)opt_func(f, o_b_pi));}
- case T_C_OBJECT:
- set = c_object_direct_set(dest);
- if (!set) set = c_object_setter;
- dest_len = object_length_to_int(sc, dest);
- break;
+static void s7_set_b_ii_function(s7_pointer f, s7_b_ii_t df) {add_opt_func(f, o_b_ii, (void *)df);}
+static s7_b_ii_t s7_b_ii_function(s7_pointer f) {return((s7_b_ii_t)opt_func(f, o_b_ii));}
- case T_LET:
- if (dest == sc->rootlet)
- return(wrong_type_argument_with_type(sc, sc->copy_symbol, 2, dest, make_string_wrapper(sc, "a sequence other than the rootlet")));
- set = let_setter;
- dest_len = source_len; /* grows via set, so dest_len isn't relevant */
- break;
+static void s7_set_b_dd_function(s7_pointer f, s7_b_dd_t df) {add_opt_func(f, o_b_dd, (void *)df);}
+static s7_b_dd_t s7_b_dd_function(s7_pointer f) {return((s7_b_dd_t)opt_func(f, o_b_dd));}
- case T_NIL:
- return(sc->nil);
+static void s7_set_p_p_function(s7_pointer f, s7_p_p_t df) {add_opt_func(f, o_p_p, (void *)df);}
+static s7_p_p_t s7_p_p_function(s7_pointer f) {return((s7_p_p_t)opt_func(f, o_p_p));}
- default:
- return(wrong_type_argument_with_type(sc, sc->copy_symbol, 2, dest, a_sequence_string));
- }
+static void s7_set_p_function(s7_pointer f, s7_p_t df) {add_opt_func(f, o_p, (void *)df);}
+static s7_p_t s7_p_function(s7_pointer f) {return((s7_p_t)opt_func(f, o_p));}
- if ((source_len == 0) || (dest_len == 0))
- return(dest);
+static void s7_set_p_pp_function(s7_pointer f, s7_p_pp_t df) {add_opt_func(f, o_p_pp, (void *)df);}
+static s7_p_pp_t s7_p_pp_function(s7_pointer f) {return((s7_p_pp_t)opt_func(f, o_p_pp));}
- /* end is source_len if not set explicitly */
- if (dest_len < source_len)
+static void s7_set_p_ppp_function(s7_pointer f, s7_p_ppp_t df) {add_opt_func(f, o_p_ppp, (void *)df);}
+static s7_p_ppp_t s7_p_ppp_function(s7_pointer f) {return((s7_p_ppp_t)opt_func(f, o_p_ppp));}
+
+static void s7_set_p_pip_function(s7_pointer f, s7_p_pip_t df) {add_opt_func(f, o_p_pip, (void *)df);}
+static s7_p_pip_t s7_p_pip_function(s7_pointer f) {return((s7_p_pip_t)opt_func(f, o_p_pip));}
+
+static void s7_set_p_pi_direct_function(s7_pointer f, s7_p_pi_t df) {add_opt_func(f, o_p_pi_direct, (void *)df);}
+static s7_p_pi_t s7_p_pi_direct_function(s7_pointer f) {return((s7_p_pi_t)opt_func(f, o_p_pi_direct));}
+
+static void s7_set_p_pip_direct_function(s7_pointer f, s7_p_pip_t df) {add_opt_func(f, o_p_pip_direct, (void *)df);}
+static s7_p_pip_t s7_p_pip_direct_function(s7_pointer f) {return((s7_p_pip_t)opt_func(f, o_p_pip_direct));}
+
+static void s7_set_p_pp_direct_function(s7_pointer f, s7_p_pp_t df) {add_opt_func(f, o_p_pp_direct, (void *)df);}
+static s7_p_pp_t s7_p_pp_direct_function(s7_pointer f) {return((s7_p_pp_t)opt_func(f, o_p_pp_direct));}
+
+static void s7_set_p_ppp_direct_function(s7_pointer f, s7_p_ppp_t df) {add_opt_func(f, o_p_ppp_direct, (void *)df);}
+static s7_p_ppp_t s7_p_ppp_direct_function(s7_pointer f) {return((s7_p_ppp_t)opt_func(f, o_p_ppp_direct));}
+
+static void s7_set_b_pp_direct_function(s7_pointer f, s7_b_pp_t df) {add_opt_func(f, o_b_pp_direct, (void *)df);}
+static s7_b_pp_t s7_b_pp_direct_function(s7_pointer f) {return((s7_b_pp_t)opt_func(f, o_b_pp_direct));}
+
+static void s7_set_p_ii_function(s7_pointer f, s7_p_ii_t df) {add_opt_func(f, o_p_ii, (void *)df);}
+static s7_p_ii_t s7_p_ii_function(s7_pointer f) {return((s7_p_ii_t)opt_func(f, o_p_ii));}
+
+
+#if DEBUGGING
+static opt_info *alloc_opo(s7_scheme *sc, s7_pointer expr)
+#else
+#define alloc_opo(Sc, Expr) alloc_opo_1(Sc)
+static opt_info *alloc_opo_1(s7_scheme *sc)
+#endif
+{
+ opt_info *o;
+ if (sc->pc >= OPTS_SIZE)
{
- end = dest_len + start;
- source_len = dest_len;
+#if DEBUGGING
+ fprintf(stderr, "opts overflow: %s\n", DISPLAY(expr));
+#endif
+ longjmp(sc->opt_exit, 1);
}
+ o = sc->opts[sc->pc++];
+ o->v8.fd = NULL;
+#if DEBUGGING
+ o->expr = expr;
+#endif
+ return(o);
+}
- if ((source != dest) &&
- (type(source) == type(dest)))
+#define OPT_PRINT 0
+
+/* t600 has tests, t593 runs t*.scm */
+
+static bool return_false(s7_scheme *sc, s7_pointer expr, const char *func, int line)
+{
+#if OPT_PRINT
+ /* if (strcmp(func, "cell_optimize") == 0) */
+ fprintf(stderr, " %s%s[%d]%s: %s\n", BOLD_TEXT, func, line, UNBOLD_TEXT, DISPLAY_80(expr));
+#endif
+ return(false);
+}
+
+#define is_opt_int(p) is_t_integer(p)
+#define is_opt_real(p) is_real(p)
+
+
+/* all_x fallback for all optimizers */
+static s7_function all_x_optimize(s7_scheme *sc, s7_pointer expr)
+{
+ if ((is_optimized(car(expr))) &&
+ (is_all_x_safe(sc, car(expr))))
{
- switch (type(source))
- {
- case T_PAIR:
- {
- s7_pointer ps, pd;
+ sc->unwraps++;
+ /* fprintf(stderr, "%s\n", DISPLAY_80(expr)); */
+ /* lt: (if (eq? (var-name v) named-let) (values) (var-initial-value v))
+ * s7test (eq? (car a) 'car) (list (cdr slot) '(gensym))
+ * tgen: (out-any i x 0)
+ */
+ return(all_x_eval(sc, expr, sc->envir, let_symbol_is_safe));
+ }
+ return(NULL);
+}
- ps = source;
- for (i = 0; i < start; i++)
- ps = cdr(ps);
- for (pd = dest; (i < end) && is_pair(ps) && is_pair(pd); i++, ps = cdr(ps), pd = cdr(pd))
- set_car(pd, car(ps));
- return(dest);
- }
+static s7_double opt_float_any(s7_scheme *sc, s7_pointer expr)
+{
+ /* caller for s7_float_optimize */
+ cur_sc = sc;
+ sc->pc = 0;
+ return(sc->opts[0]->v7.fd(sc->opts[0]));
+}
- case T_VECTOR:
- memcpy((void *)(vector_elements(dest)), (void *)((vector_elements(source)) + start), source_len * sizeof(s7_pointer));
- return(dest);
+static s7_pointer opt_bool_any(s7_scheme *sc, s7_pointer expr)
+{
+ /* caller for s7_bool_optimize */
+ cur_sc = sc;
+ sc->pc = 0;
+ return((sc->opts[0]->v7.fb(sc->opts[0])) ? sc->T : sc->F);
+}
- case T_INT_VECTOR:
- memcpy((void *)(int_vector_elements(dest)), (void *)((int_vector_elements(source)) + start), source_len * sizeof(s7_int));
- return(dest);
+static s7_pointer opt_float_any_nr(s7_scheme *sc, s7_pointer expr)
+{
+ cur_sc = sc;
+ sc->pc = 0;
+ sc->opts[0]->v7.fd(sc->opts[0]);
+ return(NULL);
+}
- case T_FLOAT_VECTOR:
- memcpy((void *)(float_vector_elements(dest)), (void *)((float_vector_elements(source)) + start), source_len * sizeof(s7_double));
- return(dest);
+static s7_pointer opt_int_any_nr(s7_scheme *sc, s7_pointer expr)
+{
+ cur_sc = sc;
+ sc->pc = 0;
+ sc->opts[0]->v7.fi(sc->opts[0]);
+ return(NULL);
+}
- case T_STRING: /* this is 4 cases (string/byte-vector) */
- memcpy((void *)string_value(dest), (void *)((string_value(source)) + start), source_len * sizeof(char));
- return(dest);
+static s7_pointer opt_cell_any_nr(s7_scheme *sc, s7_pointer expr)
+{
+ cur_sc = sc;
+ sc->pc = 0;
+ return(sc->opts[0]->v7.fp(sc->opts[0])); /* faster than returning NULL */
+}
- case T_C_OBJECT:
- {
- s7_pointer mi, mj;
- unsigned int gc_loc1, gc_loc2;
- s7_pointer (*ref)(s7_scheme *sc, s7_pointer obj, s7_pointer args);
- s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args);
+static s7_pointer opt_bool_any_nr(s7_scheme *sc, s7_pointer expr)
+{
+ cur_sc = sc;
+ sc->pc = 0;
+ sc->opts[0]->v7.fb(sc->opts[0]);
+ return(NULL);
+}
- mi = make_mutable_integer(sc, start);
- 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);
- for (i = start, j = 0; i < end; i++, j++)
- {
- integer(mi) = i;
- integer(mj) = j;
- set_car(sc->t1_1, mi);
- set_car(sc->t2_2, ref(sc, source, sc->t1_1));
- set_car(sc->t2_1, mj);
- set(sc, dest, sc->t2_1);
- }
- s7_gc_unprotect_at(sc, gc_loc1);
- s7_gc_unprotect_at(sc, gc_loc2);
- return(dest);
- }
+/* callers for s7_optimize */
+static s7_pointer opt_wrap_float(s7_scheme *sc, s7_pointer expr) {cur_sc = sc; sc->pc = 0; return(make_real(sc, sc->opts[0]->v7.fd(sc->opts[0])));}
+static s7_pointer opt_wrap_int(s7_scheme *sc, s7_pointer expr) {cur_sc = sc; sc->pc = 0; return(make_integer(sc, sc->opts[0]->v7.fi(sc->opts[0])));}
+static s7_pointer opt_wrap_cell(s7_scheme *sc, s7_pointer expr) {cur_sc = sc; sc->pc = 0; return(sc->opts[0]->v7.fp(sc->opts[0]));}
+static s7_pointer opt_wrap_bool(s7_scheme *sc, s7_pointer expr) {cur_sc = sc; sc->pc = 0; return((sc->opts[0]->v7.fb(sc->opts[0])) ? sc->T : sc->F);}
- case T_LET:
- break;
+static s7_pointer b_to_p(void *p) {opt_info *o = (opt_info *)p; return((o->v8.fb(o)) ? cur_sc->T : cur_sc->F);}
+static bool p_to_b(void *p) {opt_info *o = (opt_info *)p; return(o->v8.fp(o) != cur_sc->F);}
+static s7_pointer d_to_p(void *p) {opt_info *o = (opt_info *)p; return(make_real(cur_sc, o->v8.fd(o)));}
+static s7_pointer d_to_p_nr(void *p) {opt_info *o = (opt_info *)p; o->v8.fd(o); return(NULL);}
+static s7_pointer i_to_p(void *p) {opt_info *o = (opt_info *)p; return(make_integer(cur_sc, o->v8.fi(o)));}
+static s7_pointer i_to_p_nr(void *p) {opt_info *o = (opt_info *)p; o->v8.fi(o); return(NULL);}
- case T_HASH_TABLE:
- {
- s7_pointer p;
- p = hash_table_copy(sc, source, dest, start, end);
- if ((hash_table_checker(source) != hash_table_checker(dest)) &&
- (!hash_table_checker_locked(dest)))
- {
- if (hash_table_checker(dest) == hash_empty)
- hash_table_checker(dest) = hash_table_checker(source);
- else hash_table_checker(dest) = hash_equal;
- }
- return(p);
- }
- break;
- default:
- return(dest);
+/* -------------------------------- int opts -------------------------------- */
+
+static s7_int opt_unwrap_int(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(integer(o->v2.all_f(cur_sc, car(o->v1.p))));
+}
+
+static s7_int opt_i_c(void *p) {opt_info *o = (opt_info *)p; return(o->v1.i);}
+static s7_int opt_i_s(void *p) {opt_info *o = (opt_info *)p; return(integer(slot_value(o->v1.p)));}
+
+static bool opt_int_not_pair(s7_scheme *sc, s7_pointer car_x)
+{
+ opt_info *opc;
+ if (is_opt_int(car_x))
+ {
+ opc = alloc_opo(sc, car_x);
+ opc->v1.i = integer(car_x);
+ opc->v7.fi = opt_i_c;
+ return(true);
+ }
+ if (is_symbol(car_x))
+ {
+ s7_pointer p;
+ p = find_symbol(sc, car_x);
+ if ((is_slot(p)) &&
+ (is_opt_int(slot_value(p))))
+ {
+ opc = alloc_opo(sc, car_x);
+ opc->v1.p = p;
+ opc->v7.fi = opt_i_s;
+ return(true);
}
}
+ return(return_false(sc, car_x, __func__, __LINE__));
+}
- switch (type(source))
- {
- case T_PAIR:
- {
- s7_pointer p;
- p = source;
- if (start > 0)
- for (i = 0; i < start; i++)
- p = cdr(p);
- /* dest won't be a pair here -- the pair->pair case was caught above */
- if (is_string(dest)) set_string_error_source(sc, source);
- for (i = start, j = 0; i < end; i++, j++, p = cdr(p))
- set(sc, dest, j, car(p));
- return(dest);
- }
+/* -------- i_idp -------- */
+static s7_int opt_i_i_c(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v2.i_i_f(o->v1.i));
+}
- case T_LET:
- /* implicit index can give n-way reality check (ht growth by new entries)
- * if shadowed entries are they unshadowed by reversal?
- */
- {
- /* source and dest can't be rootlet (checked above) */
- s7_pointer slot;
- slot = let_slots(source);
- for (i = 0; i < start; i++) slot = next_slot(slot);
- if (is_pair(dest))
- {
- s7_pointer p;
- for (i = start, p = dest; i < end; i++, p = cdr(p), slot = next_slot(slot))
- set_car(p, cons(sc, slot_symbol(slot), slot_value(slot)));
- }
- else
- {
- if (is_let(dest))
- {
- for (i = start; i < end; i++, slot = next_slot(slot))
- make_slot_1(sc, dest, slot_symbol(slot), slot_value(slot));
- }
- else
- {
- if (is_hash_table(dest))
- {
- for (i = start; i < end; i++, slot = next_slot(slot))
- s7_hash_table_set(sc, dest, slot_symbol(slot), slot_value(slot));
- }
- else
- {
- for (i = start, j = 0; i < end; i++, j++, slot = next_slot(slot))
- set(sc, dest, j, cons(sc, slot_symbol(slot), slot_value(slot)));
- }
- }
- }
- return(dest);
- }
+static s7_int opt_i_i_s(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v2.i_i_f(integer(slot_value(o->v1.p))));
+}
+
+static s7_int opt_i_i_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v2.i_i_f(o1->v7.fi(o1)));
+}
+
+
+static s7_int opt_i_d_c(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v2.i_d_f(o->v1.x));
+}
- case T_HASH_TABLE:
- {
- int loc, skip;
- hash_entry_t **elements;
- hash_entry_t *x = NULL;
- elements = hash_table_elements(source);
- loc = -1;
+static s7_int opt_i_d_s(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v2.i_d_f(real(slot_value(o->v1.p))));
+}
- skip = start;
- while (skip > 0)
- {
- while (!x) x = elements[++loc];
- skip--;
- x = x->next;
- }
+static s7_int opt_i_d_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v2.i_d_f(o1->v7.fd(o1)));
+}
- if (is_pair(dest))
+static s7_int opt_i_p_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v2.i_p_f(o1->v7.fp(o1)));
+}
+
+static bool i_idp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_i_i_t func;
+ s7_i_d_t idf;
+ s7_i_p_t ipf;
+ int start;
+ start = sc->pc;
+
+ func = s7_i_i_function(s_func);
+ if (func)
+ {
+ opc->v2.i_i_f = func;
+ if (is_opt_int(cadr(car_x)))
{
- s7_pointer p;
- for (i = start, p = dest; i < end; i++, p = cdr(p))
- {
- while (!x) x = elements[++loc];
- set_car(p, cons(sc, x->key, x->value));
- x = x->next;
- }
+ opc->v1.i = integer(cadr(car_x));
+ opc->v7.fi = opt_i_i_c;
+ return(true);
}
- else
+ if (is_symbol(cadr(car_x)))
{
- if (is_let(dest))
- {
- for (i = start; i < end; i++)
- {
- while (!x) x = elements[++loc];
- make_slot_1(sc, dest, x->key, x->value);
- x = x->next;
- }
- }
- else
+ opc->v1.p = find_symbol(sc, cadr(car_x));
+ if ((is_slot(opc->v1.p)) &&
+ (is_integer(slot_value(opc->v1.p))))
{
- for (i = start, j = 0; i < end; i++, j++)
- {
- while (!x) x = elements[++loc];
- set(sc, dest, j, cons(sc, x->key, x->value));
- x = x->next;
- }
+ opc->v7.fi = opt_i_i_s;
+ return(true);
}
+ return(return_false(sc, car_x, __func__, __LINE__));
}
- return(dest);
- }
-
- case T_FLOAT_VECTOR:
- if (is_int_vector(dest))
- {
- for (i = start, j = 0; i < end; i++, j++)
- int_vector_element(dest, j) = (s7_int)(float_vector_element(source, i));
- return(dest);
- }
- break;
-
- case T_INT_VECTOR:
- if (is_float_vector(dest))
+ else /* is pair arg */
{
- for (i = start, j = 0; i < end; i++, j++)
- float_vector_element(dest, j) = (s7_double)(int_vector_element(source, i));
- return(dest);
+ if (int_optimize(sc, cdr(car_x)))
+ {
+ opc->v7.fi = opt_i_i_f;
+ return(true);
+ }
+ pc_fallback(sc, start);
}
- if (is_string(dest)) /* includes byte-vector, as below */
+ }
+ idf = s7_i_d_function(s_func);
+ if (idf)
+ {
+ opc->v2.i_d_f = idf;
+ if (is_real(cadr(car_x)))
{
- for (i = start, j = 0; i < end; i++, j++)
- string_value(dest)[j] = (unsigned char)int_vector_element(source, i);
- return(dest);
+ opc->v1.x = s7_number_to_real(sc, cadr(car_x));
+ opc->v7.fi = opt_i_d_c;
+ return(true);
}
- break;
-
- case T_STRING:
- if (is_normal_vector(dest))
+ if (is_symbol(cadr(car_x)))
{
- if (is_byte_vector(source))
- {
- for (i = start, j = 0; i < end; i++, j++)
- vector_element(dest, j) = make_integer(sc, (s7_int)((unsigned char)string_value(source)[i]));
- }
- else
+ opc->v1.p = find_symbol(sc, cadr(car_x));
+ if (is_slot(opc->v1.p))
{
- for (i = start, j = 0; i < end; i++, j++)
- vector_element(dest, j) = s7_make_character(sc, (unsigned char)string_value(source)[i]);
+ if (is_float(slot_value(opc->v1.p)))
+ opc->v7.fi = opt_i_d_s;
+ else
+ {
+ if (float_optimize(sc, cdr(car_x)))
+ opc->v7.fi = opt_i_d_f;
+ else return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ return(true);
}
- return(dest);
}
- if (is_int_vector(dest))
+ else /* is pair arg */
{
- for (i = start, j = 0; i < end; i++, j++)
- int_vector_element(dest, j) = (s7_int)((unsigned char)(string_value(source)[i]));
- return(dest);
+ if (float_optimize(sc, cdr(car_x)))
+ {
+ opc->v7.fi = opt_i_d_f;
+ return(true);
+ }
+ pc_fallback(sc, start);
}
- if (is_float_vector(dest))
+ }
+ ipf = s7_i_p_function(s_func);
+ if (ipf)
+ {
+ opc->v2.i_p_f = ipf;
+ if (cell_optimize(sc, cdr(car_x)))
{
- for (i = start, j = 0; i < end; i++, j++)
- float_vector_element(dest, j) = (s7_double)((unsigned char)(string_value(source)[i]));
- return(dest);
+ opc->v7.fi = opt_i_p_f;
+ return(true);
}
+ pc_fallback(sc, start);
}
+ return(false);
+}
- if (is_pair(dest))
- {
- s7_pointer p;
- for (i = start, p = dest; i < end; i++, p = cdr(p))
- set_car(p, get(sc, source, i));
- }
- else
+
+/* -------- i_pi -------- */
+
+static s7_int opt_i_pi_ss(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.i_pi_f(slot_value(o->v1.p), integer(slot_value(o->v2.p))));
+}
+
+static s7_int opt_i_pi_sf(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.i_pi_f(slot_value(o->v1.p), o1->v7.fi(o1)));
+}
+
+static bool i_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_i_pi_t pfunc;
+ pfunc = s7_i_pi_function(s_func);
+ if (pfunc)
{
- /* if source == dest here, we're moving data backwards, so this is safe in either case */
- if (is_string(dest)) set_string_error_source(sc, source);
- for (i = start, j = 0; i < end; i++, j++)
- set(sc, dest, j, get(sc, source, i));
+ s7_pointer sig;
+ sig = s7_procedure_signature(sc, s_func);
+ if (is_pair(sig))
+ {
+ s7_pointer arg1, arg2;
+ int start;
+ start = sc->pc;
+ arg1 = cadr(car_x);
+ arg2 = caddr(car_x);
+
+ if ((is_symbol(cadr(sig))) &&
+ (is_symbol(arg1)))
+ {
+ s7_pointer obj, checker;
+ checker = s7_symbol_value(sc, cadr(sig));
+ obj = s7_symbol_value(sc, arg1);
+ if (s7_apply_function(sc, checker, set_plist_1(sc, obj)) == sc->T)
+ {
+ opc->v1.p = find_symbol(sc, arg1);
+ if (is_slot(opc->v1.p))
+ {
+ if ((car(car_x) == sc->int_vector_ref_symbol) &&
+ ((!is_int_vector(slot_value(opc->v1.p))) ||
+ (vector_rank(slot_value(opc->v1.p)) > 1)))
+ return(return_false(sc, car_x, __func__, __LINE__));
+
+ opc->v3.i_pi_f = pfunc;
+ if (is_symbol(arg2))
+ {
+ opc->v2.p = find_symbol(sc, arg2);
+ if ((is_slot(opc->v2.p)) &&
+ (is_opt_int(slot_value(opc->v2.p))))
+ {
+ opc->v7.fi = opt_i_pi_ss;
+ if ((car(car_x) == sc->int_vector_ref_symbol) &&
+ (is_step_end(opc->v2.p)) &&
+ (denominator(slot_value(opc->v2.p)) <= vector_length(slot_value(opc->v1.p))))
+ opc->v3.i_pi_f = int_vector_ref_unchecked;
+ return(true);
+ }
+ }
+ if (int_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fi = opt_i_pi_sf;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ }
+ }
+ else return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ }
}
- /* some choices probably should raise an error, but don't:
- * (copy (make-hash-table) "1") ; nothing to copy (empty hash table), so no error
- */
- return(dest);
+ return(false);
}
-#define g_copy s7_copy
+/* -------- i_ii -------- */
+static s7_int opt_i_ii_cc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.i_ii_f(o->v1.i, o->v2.i));
+}
-static s7_pointer c_copy(s7_scheme *sc, s7_pointer x) {return(s7_copy(sc, set_plist_1(sc, x)));}
-PF_TO_PF(copy, c_copy)
+static s7_int opt_i_ii_cs(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.i_ii_f(o->v1.i, integer(slot_value(o->v2.p))));
+}
+static s7_int opt_i_ii_sc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.i_ii_f(integer(slot_value(o->v1.p)), o->v2.i));
+}
+static s7_int opt_i_ii_ss(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.i_ii_f(integer(slot_value(o->v1.p)), integer(slot_value(o->v2.p))));
+}
-/* -------------------------------- reverse -------------------------------- */
-
-static s7_pointer g_reverse(s7_scheme *sc, s7_pointer args)
+static s7_int opt_i_ii_cf(void *p)
{
- #define H_reverse "(reverse lst) returns a list with the elements of lst in reverse order. reverse \
-also accepts a string or vector argument."
- #define Q_reverse s7_make_signature(sc, 2, sc->is_sequence_symbol, sc->is_sequence_symbol)
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.i_ii_f(o->v1.i, o1->v7.fi(o1)));
+}
- s7_pointer p, np;
+static s7_int opt_i_ii_fc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.i_ii_f(o1->v7.fi(o1), o->v2.i));
+}
- p = car(args);
- sc->temp3 = p;
- np = sc->nil;
+static s7_int opt_i_ii_sf(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.i_ii_f(integer(slot_value(o->v1.p)), o1->v7.fi(o1)));
+}
- switch (type(p))
- {
- case T_NIL:
- return(sc->nil);
+static s7_int opt_i_ii_ff(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_int i1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ i1 = o1->v7.fi(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.i_ii_f(i1, o1->v7.fi(o1)));
+}
- case T_PAIR:
- return(s7_reverse(sc, p));
+static s7_int opt_i_ii_fco(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.i_ii_f(o->v4.i_pi_f(slot_value(o->v1.p), integer(slot_value(o->v2.p))), o->v5.i));
+}
- case T_STRING:
- {
- char *source, *dest, *end;
- int len;
- len = string_length(p);
- source = string_value(p);
- end = (char *)(source + len);
- dest = (char *)malloc((len + 1) * sizeof(char));
- dest[len] = 0;
- np = make_string_uncopied_with_length(sc, dest, len);
- dest += len;
- while (source < end) *(--dest) = *source++;
- if (is_byte_vector(p))
- set_byte_vector(np);
- }
- break;
+static bool i_ii_fc_combinable(s7_scheme *sc, opt_info *opc)
+{
+ if ((sc->pc > 1) &&
+ (opc == sc->opts[sc->pc - 2]))
+ {
+ opt_info *o1;
+ o1 = sc->opts[sc->pc - 1];
+ if (o1->v7.fi == opt_i_pi_ss)
+ {
+ opc->v5.i = opc->v2.i; /* move v2.i ("c" in fc = arg2) out of the symbols' way */
+ opc->v4.i_pi_f = o1->v3.i_pi_f;
+ opc->v1.p = o1->v1.p;
+ opc->v2.p = o1->v2.p;
+ opc->v7.fi = opt_i_ii_fco;
+ sc->pc--;
+ return(true);
+ }
+ }
+ return(false);
+}
- case T_INT_VECTOR:
- {
- s7_int *source, *dest, *end;
- s7_int len;
- len = vector_length(p);
- if (vector_rank(p) > 1)
- np = g_make_vector_1(sc, set_plist_3(sc, g_vector_dimensions(sc, set_plist_1(sc, p)), small_int(0), sc->T), sc->make_int_vector_symbol);
- else np = make_vector_1(sc, len, NOT_FILLED, T_INT_VECTOR);
- source = int_vector_elements(p);
- end = (s7_int *)(source + len);
- dest = (s7_int *)(int_vector_elements(np) + len);
- while (source < end) *(--dest) = *source++;
- }
- break;
+static bool i_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_i_ii_t ifunc;
+ ifunc = s7_i_ii_function(s_func);
+ if (ifunc)
+ {
+ s7_pointer sig;
+ sig = s7_procedure_signature(sc, s_func);
+ if (is_pair(sig))
+ {
+ s7_pointer arg1, arg2;
+ int start;
+ start = sc->pc;
+ arg1 = cadr(car_x);
+ arg2 = caddr(car_x);
+
+ opc->v3.i_ii_f = ifunc;
+ if (is_opt_int(arg1))
+ {
+ opc->v1.i = integer(arg1);
+ if (is_opt_int(arg2))
+ {
+ opc->v2.i = integer(arg2);
+ opc->v7.fi = opt_i_ii_cc;
+ return(true);
+ }
+ if (is_symbol(arg2))
+ {
+ opc->v2.p = find_symbol(sc, arg2);
+ if (is_slot(opc->v2.p))
+ {
+ if (is_integer(slot_value(opc->v2.p)))
+ {
+ opc->v7.fi = opt_i_ii_cs;
+ return(true);
+ }
+ }
+ }
+ else
+ {
+ if (int_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fi = opt_i_ii_cf;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ }
+ }
+ else
+ {
+ if (is_symbol(arg1))
+ {
+ opc->v1.p = find_symbol(sc, arg1);
+ if (is_slot(opc->v1.p))
+ {
+ if (is_opt_int(slot_value(opc->v1.p)))
+ {
+ if (is_opt_int(arg2))
+ {
+ opc->v2.i = integer(arg2);
+ opc->v7.fi = opt_i_ii_sc;
+#if (!WITH_GMP)
+ if ((car(car_x) == sc->modulo_symbol) &&
+ (integer(arg2) > 1))
+ opc->v3.i_ii_f = modulo_i_ii_direct;
+#endif
+ return(true);
+ }
+ if (is_symbol(arg2))
+ {
+ opc->v2.p = find_symbol(sc, arg2);
+ if ((is_slot(opc->v2.p)) &&
+ (is_opt_int(slot_value(opc->v2.p))))
+ {
+ opc->v7.fi = opt_i_ii_ss;
+ return(true);
+ }
+ }
+ else
+ {
+ if (int_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fi = opt_i_ii_sf;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ }
+ }
+ }
+ }
+ else
+ {
+ if (is_opt_int(arg2))
+ {
+ opc->v2.i = integer(arg2);
+ if (int_optimize(sc, cdr(car_x)))
+ {
+ if (!i_ii_fc_combinable(sc, opc))
+ opc->v7.fi = opt_i_ii_fc;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ }
+ else
+ {
+ if ((int_optimize(sc, cdr(car_x))) &&
+ (int_optimize(sc, cddr(car_x))))
+ {
+ opc->v7.fi = opt_i_ii_ff;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ }
+ }
+ }
+ }
+ }
+ return(false);
+}
- case T_FLOAT_VECTOR:
- {
- s7_double *source, *dest, *end;
- s7_int len;
- len = vector_length(p);
- if (vector_rank(p) > 1)
- np = g_make_vector_1(sc, set_plist_3(sc, g_vector_dimensions(sc, set_plist_1(sc, p)), real_zero, sc->T), sc->make_float_vector_symbol);
- else np = make_vector_1(sc, len, NOT_FILLED, T_FLOAT_VECTOR);
- source = float_vector_elements(p);
- end = (s7_double *)(source + len);
- dest = (s7_double *)(float_vector_elements(np) + len);
- while (source < end) *(--dest) = *source++;
- }
- break;
+/* -------- i_iii -------- */
+static s7_int opt_i_iii_fff(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_int i1, i2;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ i1 = o1->v7.fi(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ i2 = o1->v7.fi(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.i_iii_f(i1, i2, o1->v7.fi(o1)));
+}
- case T_VECTOR:
- {
- s7_pointer *source, *dest, *end;
- s7_int len;
- len = vector_length(p);
- if (vector_rank(p) > 1)
- np = g_make_vector(sc, set_plist_1(sc, g_vector_dimensions(sc, list_1(sc, p))));
- else np = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
- source = vector_elements(p);
- end = (s7_pointer *)(source + len);
- dest = (s7_pointer *)(vector_elements(np) + len);
- while (source < end) *(--dest) = *source++;
- }
- break;
+static bool i_iii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_i_iii_t ifunc;
+ ifunc = s7_i_iii_function(s_func);
+ if (ifunc)
+ {
+ int start;
+ start = sc->pc;
+ if ((int_optimize(sc, cdr(car_x))) &&
+ (int_optimize(sc, cddr(car_x))) &&
+ (int_optimize(sc, cdddr(car_x))))
+ {
+ opc->v3.i_iii_f = ifunc;
+ opc->v7.fi = opt_i_iii_fff;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ return(false);
+}
- case T_HASH_TABLE:
- return(hash_table_reverse(sc, p));
+/* -------- i_pii -------- */
+static s7_int opt_i_pii_ssf(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.i_pii_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o1->v7.fi(o1)));
+}
- case T_C_OBJECT:
- check_method(sc, p, sc->reverse_symbol, args);
- if (c_object_reverse(p))
- return((*(c_object_reverse(p)))(sc, args));
- eval_error(sc, "attempt to reverse ~S?", p);
+static s7_int opt_i_pii_sff(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1, *o2;
+ s7_int i1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ i1 = o1->v7.fi(o1);
+ o2 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.i_pii_f(slot_value(o->v1.p), i1, o2->v7.fi(o2)));
+}
- default:
- method_or_bust_with_type(sc, p, sc->reverse_symbol, args, a_sequence_string, 0);
+static bool opt_int_vector_set(s7_scheme *sc, opt_info *opc, s7_pointer v, s7_pointer indexp, s7_pointer valp)
+{
+ s7_pointer settee;
+ /* fprintf(stderr, "opt intv: %s %s %s\n", DISPLAY(v), DISPLAY(indexp), DISPLAY(valp)); */
+ settee = find_symbol(sc, v);
+ if (is_slot(settee))
+ {
+ opc->v1.p = settee;
+ if ((is_int_vector(slot_value(settee))) &&
+ (vector_rank(slot_value(settee)) == 1))
+ {
+ opc->v3.i_pii_f = int_vector_set_i;
+ if (is_symbol(car(indexp)))
+ {
+ s7_pointer slot;
+ slot = find_symbol(sc, car(indexp));
+ if ((is_slot(slot)) &&
+ (is_integer(slot_value(slot))) &&
+ (int_optimize(sc, valp)))
+ {
+ opc->v7.fi = opt_i_pii_ssf;
+ opc->v2.p = slot;
+ if ((is_step_end(opc->v2.p)) &&
+ (denominator(slot_value(opc->v2.p)) <= vector_length(slot_value(settee))))
+ opc->v3.i_pii_f = int_vector_set_unchecked;
+ return(true);
+ }
+ }
+ else
+ {
+ if ((int_optimize(sc, indexp)) &&
+ (int_optimize(sc, valp)))
+ {
+ opc->v7.fi = opt_i_pii_sff;
+ return(true);
+ }
+ }
+ }
}
- return(np);
+ return(return_false(sc, v, __func__, __LINE__));
}
-static s7_pointer c_reverse(s7_scheme *sc, s7_pointer x) {return(g_reverse(sc, set_plist_1(sc, x)));}
-PF_TO_PF(reverse, c_reverse)
+static bool i_pii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_i_pii_t pfunc;
+ pfunc = s7_i_pii_function(s_func);
+ if (pfunc)
+ {
+ s7_pointer sig;
+ sig = s7_procedure_signature(sc, s_func);
+ if ((is_pair(sig)) &&
+ (is_symbol(cadr(car_x))))
+ {
+ s7_pointer obj, checker;
+
+ if (car(car_x) == sc->int_vector_set_symbol)
+ return(opt_int_vector_set(sc, opc, cadr(car_x), cddr(car_x), cdddr(car_x)));
+
+ checker = s7_symbol_value(sc, cadr(sig));
+ obj = s7_symbol_value(sc, cadr(car_x));
+ if (s7_apply_function(sc, checker, set_plist_1(sc, obj)) == sc->T)
+ {
+ int start;
+ start = sc->pc;
+ opc->v3.i_pii_f = pfunc;
+ opc->v1.p = find_symbol(sc, cadr(car_x));
+ if (is_slot(opc->v1.p))
+ {
+ s7_pointer arg2;
+ arg2 = caddr(car_x);
+ if (is_symbol(arg2))
+ {
+ opc->v2.p = find_symbol(sc, arg2);
+ if ((is_slot(opc->v2.p)) &&
+ (is_opt_int(slot_value(opc->v2.p))) &&
+ (int_optimize(sc, cdddr(car_x))))
+ {
+ opc->v7.fi = opt_i_pii_ssf;
+ return(true);
+ }
+ }
+ else
+ {
+ if ((int_optimize(sc, cddr(car_x))) &&
+ (int_optimize(sc, cdddr(car_x))))
+ {
+ opc->v7.fi = opt_i_pii_sff;
+ return(true);
+ }
+ }
+ pc_fallback(sc, start);
+ }
+ }
+ else return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ }
+ return(false);
+}
-static s7_pointer c_reverse_in_place(s7_scheme *sc, s7_pointer p)
+/* -------- i_add|multiply_any -------- */
+static s7_int opt_i_add_any_f(void *p)
{
- switch (type(p))
+ opt_info *o = (opt_info *)p;
+ s7_int sum = 0;
+ int i;
+ for (i = 0; i < o->v1.i; i++)
{
- case T_NIL:
- return(sc->nil);
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ sum += o1->v7.fi(o1);
+ }
+ return(sum);
+}
- case T_PAIR:
- {
- s7_pointer np;
- np = reverse_in_place(sc, sc->nil, p);
- if (is_null(np))
- return(simple_wrong_type_argument_with_type(sc, sc->reverseb_symbol, p, a_proper_list_string));
- return(np);
- }
- break;
- /* (reverse! p) is supposed to change p directly and lisp programmers expect reverse! to be fast
- * so in a sense this is different from the other cases: it assumes (set! p (reverse! p))
- * To make (reverse! p) direct:
- * for (l = p, r = cdr(p); is_pair(r); l = r, r = cdr(r)) opt1(r) = l;
- * if (!is_null(r)) return(simple_wrong_type_argument_with_type(sc, sc->reverseb_symbol, p, a_proper_list_string));
- * for (r = l, l = p; l != r; l = cdr(l)) {t = car(l); set_car(l, car(r)); set_car(r, t); if (cdr(l) != r) r = opt1(r);}
- */
+static s7_int opt_i_add2(void *p)
+{
+ s7_int sum;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ sum = o1->v7.fi(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(sum + o1->v7.fi(o1));
+}
- case T_STRING:
- {
- int len;
- char *s1, *s2;
- len = string_length(p);
- if (len < 2) return(p);
- s1 = string_value(p);
- s2 = (char *)(s1 + len - 1);
- while (s1 < s2) {char c; c = *s1; *s1++ = *s2; *s2-- = c;}
- }
- break;
+static s7_int opt_i_mul2(void *p)
+{
+ s7_int sum;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ sum = o1->v7.fi(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(sum * o1->v7.fi(o1));
+}
- case T_INT_VECTOR:
- {
- s7_int len;
- s7_int *s1, *s2;
- len = vector_length(p);
- if (len < 2) return(p);
- s1 = int_vector_elements(p);
- s2 = (s7_int *)(s1 + len - 1);
- while (s1 < s2) {s7_int c; c = *s1; *s1++ = *s2; *s2-- = c;}
- }
- break;
+static s7_int opt_i_multiply_any_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ s7_int sum = 1;
+ int i;
+ for (i = 0; i < o->v1.i; i++)
+ {
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ sum *= o1->v7.fi(o1);
+ }
+ return(sum);
+}
+
+static bool i_add_any_ok(s7_scheme *sc, opt_info *opc, s7_pointer car_x)
+{
+ s7_pointer p, head;
+ int cur_len = 0, start;
+ start = sc->pc;
+ head = car(car_x);
+ for (p = cdr(car_x); is_pair(p); p = cdr(p))
+ {
+ if (is_pair(cdr(p)))
+ {
+ /* TODO: 3-way case if it were able to handle symbols and constants */
+ if (!int_optimize(sc, set_plist_1(sc, set_elist_3(sc, head, car(p), cadr(p)))))
+ break;
+ cur_len++;
+ p = cdr(p);
+ }
+ else
+ {
+ if (!int_optimize(sc, p))
+ break;
+ cur_len++;
+ }
+ }
+ if (is_null(p))
+ {
+ opc->v1.i = cur_len;
+ if (cur_len == 2)
+ opc->v7.fi = (head == sc->add_symbol) ? opt_i_add2 :opt_i_mul2;
+ else opc->v7.fi = (head == sc->add_symbol) ? opt_i_add_any_f : opt_i_multiply_any_f;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ return(false);
+}
- case T_FLOAT_VECTOR:
- {
- s7_int len;
- s7_double *s1, *s2;
- len = vector_length(p);
- if (len < 2) return(p);
- s1 = float_vector_elements(p);
- s2 = (s7_double *)(s1 + len - 1);
- while (s1 < s2) {s7_double c; c = *s1; *s1++ = *s2; *s2-- = c;}
- }
- break;
+/* -------- int_all_x -------- */
+static bool int_all_x_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer expr)
+{
+ s7_pointer sig;
+ s7_function opt;
+ sig = s7_procedure_signature(sc, s_func);
+ if ((is_pair(sig)) &&
+ (car(sig) == sc->is_integer_symbol))
+ {
+ /* fallback on the more general case (all_x_eval, but still guaranteed to be an integer) */
+ opt = all_x_optimize(sc, expr);
+ if (opt)
+ {
+ opc->v2.all_f = opt;
+ opc->v7.fi = opt_unwrap_int;
+ opc->v1.p = expr;
+ return(true);
+ }
+ }
+ return(false);
+}
- case T_VECTOR:
- {
- s7_int len;
- s7_pointer *s1, *s2;
- len = vector_length(p);
- if (len < 2) return(p);
- s1 = vector_elements(p);
- s2 = (s7_pointer *)(s1 + len - 1);
- while (s1 < s2) {s7_pointer c; c = *s1; *s1++ = *s2; *s2-- = c;}
- }
- break;
+/* -------- set_i_i -------- */
+static s7_int opt_set_i_i_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_int x;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ x = o1->v7.fi(o1);
+ if (is_mutable(slot_value(o->v1.p)))
+ integer(slot_value(o->v1.p)) = x;
+ else slot_set_value(o->v1.p, make_integer(cur_sc, x));
+ return(x);
+}
- default:
- if ((is_simple_sequence(p)) &&
- (!has_methods(p)))
- return(simple_wrong_type_argument_with_type(sc, sc->reverseb_symbol, p, make_string_wrapper(sc, "a vector, string, or list")));
- method_or_bust_with_type(sc, p, sc->reverseb_symbol, list_1(sc, p), a_sequence_string, 0);
+static s7_int opt_set_i_i_fo(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ s7_int x;
+ x = o->v4.i_ii_f(integer(slot_value(o->v3.p)), o->v2.i);
+ if (is_mutable(slot_value(o->v1.p)))
+ integer(slot_value(o->v1.p)) = x;
+ else slot_set_value(o->v1.p, make_integer(cur_sc, x));
+ return(x);
+}
+
+static bool set_i_i_f_combinable(s7_scheme *sc, opt_info *opc)
+{
+ if ((sc->pc > 1) &&
+ (opc == sc->opts[sc->pc - 2]))
+ {
+ opt_info *o1;
+ o1 = sc->opts[sc->pc - 1];
+ if (o1->v7.fi == opt_i_ii_sc)
+ {
+ opc->v4.i_ii_f = o1->v3.i_ii_f;
+ opc->v3.p = o1->v1.p;
+ opc->v2.i = o1->v2.i;
+ opc->v7.fi = opt_set_i_i_fo;
+ sc->pc--;
+ return(true);
+ }
+ }
+ return(false);
+}
+
+static bool i_syntax_ok(s7_scheme *sc, s7_pointer car_x, int len)
+{
+ if ((car(car_x) == sc->set_symbol) &&
+ (len == 3))
+ {
+ opt_info *opc;
+ opc = alloc_opo(sc, car_x);
+ if (is_symbol(cadr(car_x))) /* (set! i 3) */
+ {
+ s7_pointer settee;
+ if ((is_immutable(cadr(car_x))) ||
+ (symbol_has_accessor(cadr(car_x))))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ settee = find_symbol(sc, cadr(car_x));
+ if (is_slot(settee))
+ {
+ opc->v1.p = settee;
+ if ((is_integer(slot_value(settee))) &&
+ (int_optimize(sc, cddr(car_x))))
+ {
+ if (!set_i_i_f_combinable(sc, opc))
+ opc->v7.fi = opt_set_i_i_f;
+ return(true);
+ }
+ }
+ }
+ else
+ {
+ if ((is_pair(cadr(car_x))) && /* if is_pair(settee) get setter */
+ (is_symbol(caadr(car_x))) &&
+ (is_pair(cdadr(car_x))) && /* (set! (f . y) z)? */
+ (is_null(cddadr(car_x))))
+ return(opt_int_vector_set(sc, opc, caadr(car_x), cdadr(car_x), cddr(car_x)));
+ }
}
- return(p);
+ return(return_false(sc, car_x, __func__, __LINE__));
}
-static s7_pointer g_reverse_in_place(s7_scheme *sc, s7_pointer args)
+static bool i_implicit_ok(s7_scheme *sc, s7_pointer car_x, int len)
{
- #define H_reverse_in_place "(reverse! lst) reverses lst in place"
- #define Q_reverse_in_place s7_make_signature(sc, 2, sc->is_sequence_symbol, sc->is_sequence_symbol)
- return(c_reverse_in_place(sc, car(args)));
+ s7_pointer s_slot, head;
+ head = car(car_x);
+ s_slot = find_symbol(sc, head);
+ if ((is_slot(s_slot)) &&
+ (len == 2) &&
+ (is_int_vector(slot_value(s_slot))) &&
+ (vector_rank(slot_value(s_slot)) == 1))
+ {
+ /* implicit int-vector-ref */
+ opt_info *opc;
+ opc = alloc_opo(sc, car_x);
+ opc->v1.p = s_slot;
+ if (is_symbol(cadr(car_x)))
+ {
+ s7_pointer slot;
+ slot = find_symbol(sc, cadr(car_x));
+ if ((is_slot(slot)) &&
+ (is_integer(slot_value(slot))))
+ {
+ opc->v7.fi = opt_i_pi_ss;
+ opc->v3.i_pi_f = int_vector_ref_i;
+ opc->v2.p = slot;
+ if ((is_step_end(opc->v2.p)) &&
+ (denominator(slot_value(opc->v2.p)) <= vector_length(slot_value(opc->v1.p))))
+ opc->v3.i_pi_f = int_vector_ref_unchecked;
+ return(true);
+ }
+ }
+ else
+ {
+ if (int_optimize(sc, cdr(car_x)))
+ {
+ opc->v7.fi = opt_i_pi_sf;
+ opc->v3.i_pi_f = int_vector_ref_i;
+ return(true);
+ }
+ }
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
}
-PF_TO_PF(reverse_in_place, c_reverse_in_place)
+/* ------------------------------------- float opts ------------------------------------------- */
-/* -------------------------------- fill! -------------------------------- */
+static s7_double opt_d_c(void *p) {opt_info *o = (opt_info *)p; return(o->v1.x);}
+static s7_double opt_D_s(void *p) {opt_info *o = (opt_info *)p; return(s7_number_to_real(cur_sc, slot_value(o->v1.p)));}
+static s7_double opt_d_s(void *p) {opt_info *o = (opt_info *)p; return(real(slot_value(o->v1.p)));}
-static s7_pointer list_fill(s7_scheme *sc, s7_pointer args)
+static bool opt_float_not_pair(s7_scheme *sc, s7_pointer car_x)
{
- /* ambiguous ("tree-fill"?) but if it's like vector-fill, we just stomp on the top level */
- s7_pointer x, y, obj, val;
- s7_int i, start = 0, end, len;
-
- obj = car(args);
- len = s7_list_length(sc, obj);
- end = len;
- if (end < 0) end = -end; else {if (end == 0) end = 123123123;}
- val = cadr(args);
-
- if (!is_null(cddr(args)))
+ opt_info *opc;
+ if (is_real(car_x))
{
- s7_pointer p;
- p = start_and_end(sc, sc->fill_symbol, sc->fill_symbol, cddr(args), args, 3, &start, &end);
- if (p != sc->gc_nil) return(p);
- if (start == end) return(val);
+ if ((s7_is_ratio(car_x)) ||
+ (!is_opt_real(car_x)))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc = alloc_opo(sc, car_x);
+ opc->v1.x = s7_number_to_real(sc, car_x);
+ opc->v7.fd = opt_d_c;
+ return(true);
}
-
- if (len > 0)
+ if (is_symbol(car_x))
{
- s7_int i;
s7_pointer p;
- if (end < len) len = end;
- for (i = 0, p = obj; i < start; p = cdr(p), i++);
- for (; i < len; p = cdr(p), i++) set_car(p, val);
- return(val);
- }
-
- for (x = obj, y = obj, i = 0; ;i++)
- {
- if ((end > 0) && (i >= end))
- return(val);
- if (i >= start) set_car(x, val);
- if (!is_pair(cdr(x)))
- {
- if (!is_null(cdr(x)))
- set_cdr(x, val);
- return(val);
+ p = find_symbol(sc, car_x);
+ if ((is_slot(p)) &&
+ (is_opt_real(slot_value(p))))
+ {
+ if (s7_is_ratio(slot_value(p)))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc = alloc_opo(sc, car_x);
+ opc->v1.p = p;
+ opc->v7.fd = (is_float(slot_value(p))) ? opt_d_s : opt_D_s;
+ return(true);
}
- x = cdr(x);
- if ((i & 1) != 0) y = cdr(y);
- if (x == y) return(val);
}
- return(val);
+ return(return_false(sc, car_x, __func__, __LINE__));
}
+/* -------- d -------- */
+static s7_double opt_d_f(void *p) {opt_info *o = (opt_info *)p; return(o->v1.d_f());}
-s7_pointer s7_fill(s7_scheme *sc, s7_pointer args)
+static bool d_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func)
{
- #define H_fill "(fill! obj val (start 0) end) fills obj with val"
- #define Q_fill s7_make_circular_signature(sc, 3, 4, sc->T, sc->is_sequence_symbol, sc->T, sc->is_integer_symbol)
- s7_pointer p;
-
- p = car(args);
- switch (type(p))
+ s7_d_t func; /* (f): (mus-srate) */
+ func = s7_d_function(s_func);
+ if (func)
{
- case T_STRING:
- return(g_string_fill(sc, args)); /* redundant type check here and below */
-
- case T_INT_VECTOR:
- case T_FLOAT_VECTOR:
- case T_VECTOR:
- return(g_vector_fill(sc, args));
-
- case T_PAIR:
- return(list_fill(sc, args));
+ opc->v7.fd = opt_d_f;
+ opc->v1.d_f = func;
+ return(true);
+ }
+ return(false);
+}
- case T_NIL:
- return(cadr(args)); /* this parallels the empty vector case */
+/* -------- d_d -------- */
+static s7_double opt_d_d_c(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_d_f(o->v1.x));
+}
- case T_HASH_TABLE:
- return(hash_table_fill(sc, args));
+static s7_double opt_d_d_s(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_d_f(real(slot_value(o->v1.p))));
+}
- case T_LET:
- check_method(sc, p, sc->fill_symbol, args);
- return(let_fill(sc, args));
+static s7_double opt_d_d_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.d_d_f(o1->v7.fd(o1)));
+}
- case T_C_OBJECT:
- check_method(sc, p, sc->fill_symbol, args);
- if (c_object_fill(p))
- return((*(c_object_fill(p)))(sc, args));
- eval_error(sc, "attempt to fill ~S?", p);
+static bool d_d_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_d_d_t func;
+ int start;
+ start = sc->pc;
- default:
- check_method(sc, p, sc->fill_symbol, args);
+ func = s7_d_d_function(s_func);
+ if (func)
+ {
+ opc->v3.d_d_f = func;
+ if (is_real(cadr(car_x)))
+ {
+ opc->v1.x = s7_number_to_real(sc, cadr(car_x));
+ opc->v7.fd = opt_d_d_c;
+ return(true);
+ }
+ if (is_symbol(cadr(car_x)))
+ {
+ opc->v1.p = find_symbol(sc, cadr(car_x));
+ if ((is_slot(opc->v1.p)) &&
+ (!has_methods(slot_value(opc->v1.p))))
+ {
+ if (is_float(slot_value(opc->v1.p)))
+ opc->v7.fd = opt_d_d_s;
+ else
+ {
+ if (float_optimize(sc, cdr(car_x)))
+ opc->v7.fd = opt_d_d_f;
+ else return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ return(true);
+ }
+ }
+ else /* is pair arg */
+ {
+ if (float_optimize(sc, cdr(car_x)))
+ {
+ opc->v7.fd = opt_d_d_f;
+ return(true);
+ }
+ }
+ pc_fallback(sc, start);
}
- return(wrong_type_argument_with_type(sc, sc->fill_symbol, 1, p, a_sequence_string)); /* (fill! 1 0) */
+ return(false);
}
-#define g_fill s7_fill
-/* perhaps (fill iterator obj) could fill the underlying sequence (if any) -- not let/closure
- * similarly for length, reverse etc
- */
-
-static s7_pointer c_fill(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(s7_fill(sc, set_plist_2(sc, x, y)));}
-PF2_TO_PF(fill, c_fill)
-
-
-/* -------------------------------- append -------------------------------- */
+/* -------- d_v -------- */
+static s7_double opt_d_v(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_v_f(o->v5.obj));
+}
-static s7_int sequence_length(s7_scheme *sc, s7_pointer lst)
+static bool d_v_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
{
- switch (type(lst))
+ s7_d_v_t flt_func;
+ flt_func = s7_d_v_function(s_func);
+ if (flt_func)
{
- case T_PAIR:
- {
- int len;
- len = s7_list_length(sc, lst);
- if (len == 0) return(-1);
- return(len);
- }
- case T_NIL: return(0);
- case T_INT_VECTOR:
- case T_FLOAT_VECTOR:
- case T_VECTOR: return(vector_length(lst));
- case T_STRING: return(string_length(lst));
- case T_HASH_TABLE: return(hash_table_entries(lst));
- case T_LET: return(let_length(sc, lst));
- case T_C_OBJECT:
- {
- s7_pointer x;
- x = object_length(sc, lst);
- if (s7_is_integer(x))
- return(s7_integer(x));
- }
+ s7_pointer sig;
+ sig = s7_procedure_signature(sc, s_func);
+ if ((is_pair(sig)) &&
+ (is_symbol(cadr(car_x)))) /* look for (oscil g) */
+ {
+ s7_pointer slot, obj, checker;
+ checker = s7_symbol_value(sc, cadr(sig));
+ slot = find_symbol(sc, cadr(car_x));
+ obj = slot_value(slot);
+ 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->v3.d_v_f = flt_func;
+ opc->v7.fd = opt_d_v;
+ return(true);
+ }
+ }
}
- return(-1);
+ return(false);
}
-static s7_int total_sequence_length(s7_scheme *sc, s7_pointer args, s7_pointer caller, int typ)
+/* -------- d_p -------- */
+static s7_double opt_d_p_s(void *p)
{
- s7_pointer p;
- int i;
- s7_int len = 0;
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_p_f(slot_value(o->v1.p)));
+}
- for (i = 1, p = args; is_pair(p); p = cdr(p), i++)
+static s7_double opt_d_p_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.d_p_f(o1->v7.fp(o1)));
+}
+
+static bool d_p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_d_p_t dpf;
+ int start;
+ start = sc->pc;
+ dpf = s7_d_p_function(s_func);
+ if (dpf)
{
- s7_pointer seq;
- s7_int n;
- seq = car(p);
- n = sequence_length(sc, seq);
- if ((n > 0) &&
- (typ != T_FREE) &&
- ((type(seq) == T_HASH_TABLE) || /* can't append hash-tables (no obvious meaning to the operation) */
- ((type(seq) == T_LET) && /* similarly for lets, unless this is a mock-string or something similar */
- ((!has_methods(seq)) || (find_method(sc, seq, sc->append_symbol) == sc->undefined)))))
+ opc->v3.d_p_f = dpf;
+ if (is_symbol(cadr(car_x)))
{
- wrong_type_argument(sc, sc->append_symbol, i, seq, typ);
- return(0);
+ opc->v1.p = find_symbol(sc, cadr(car_x));
+ if ((is_slot(opc->v1.p)) &&
+ (!has_methods(slot_value(opc->v1.p))))
+ {
+ opc->v7.fd = opt_d_p_s;
+ return(true);
+ }
+ else return(return_false(sc, car_x, __func__, __LINE__));
}
- if (n < 0)
+ if (cell_optimize(sc, cdr(car_x)))
{
- wrong_type_argument_with_type(sc, sc->append_symbol, i, seq, (is_pair(seq)) ? a_proper_list_string : a_sequence_string);
- return(0);
+ opc->v7.fd = opt_d_p_f;
+ return(true);
}
- len += n;
+ pc_fallback(sc, start);
}
- return(len);
+ return(false);
}
-static s7_pointer vector_append(s7_scheme *sc, s7_pointer args, int typ)
-{
- s7_pointer new_vec;
- s7_int len;
+/* -------- d_pi -------- */
- len = total_sequence_length(sc, args, sc->vector_append_symbol, (typ == T_VECTOR) ? T_FREE : ((typ == T_FLOAT_VECTOR) ? T_REAL : T_INTEGER));
- new_vec = make_vector_1(sc, len, (typ == T_VECTOR) ? FILLED : NOT_FILLED, typ); /* might hit GC in loop below so we can't use NOT_FILLED here */
+static s7_double opt_d_pi_sc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_pi_f(slot_value(o->v1.p), o->v2.i));
+}
- if (len > 0)
- {
- s7_pointer p, sv;
- int i;
+static s7_double opt_d_pi_ss(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_pi_f(slot_value(o->v1.p), integer(slot_value(o->v2.p))));
+}
- sc->temp9 = new_vec; /* s7_copy below can call s7_error so s7_gc_protect here is tricky -- use a preset position perhaps? */
- sv = make_subvector(sc, new_vec);
- sc->temp10 = sv;
+static s7_double opt_d_pi_sf(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.d_pi_f(slot_value(o->v1.p), o1->v7.fi(o1)));
+}
- for (i = 0, p = args; is_pair(p); p = cdr(p))
+static bool d_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ if (is_symbol(cadr(car_x)))
+ {
+ s7_d_pi_t ifunc;
+ ifunc = s7_d_pi_function(s_func);
+ if (ifunc)
{
- s7_int n;
- s7_pointer x;
- x = car(p);
- n = sequence_length(sc, x);
- if (n > 0)
+ s7_pointer arg2;
+ int start;
+ start = sc->pc;
+ opc->v1.p = find_symbol(sc, cadr(car_x));
+ if (!is_slot(opc->v1.p))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ if ((car(car_x) == sc->float_vector_ref_symbol) &&
+ ((!is_float_vector(slot_value(opc->v1.p))) ||
+ (vector_rank(slot_value(opc->v1.p)) > 1)))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc->v3.d_pi_f = ifunc;
+ arg2 = caddr(car_x);
+ if (!is_pair(arg2))
{
- vector_length(sv) = n;
- s7_copy(sc, set_plist_2(sc, x, sv));
- vector_length(sv) = 0; /* so GC doesn't march off the end */
- i += n;
- if (typ == T_VECTOR)
- vector_elements(sv) = (s7_pointer *)(vector_elements(new_vec) + i);
- else
+ if (is_opt_int(arg2))
{
- if (typ == T_FLOAT_VECTOR)
- float_vector_elements(sv) = (s7_double *)(float_vector_elements(new_vec) + i);
- else int_vector_elements(sv) = (s7_int *)(int_vector_elements(new_vec) + i);
+ opc->v2.i = integer(arg2);
+ opc->v7.fd = opt_d_pi_sc;
+ return(true);
}
+ if (is_symbol(arg2))
+ {
+ opc->v2.p = find_symbol(sc, arg2);
+ if ((is_slot(opc->v2.p)) &&
+ (is_integer(slot_value(opc->v2.p))))
+ {
+ opc->v7.fd = opt_d_pi_ss;
+ if ((car(car_x) == sc->float_vector_ref_symbol) &&
+ (is_step_end(opc->v2.p)) &&
+ (denominator(slot_value(opc->v2.p)) <= vector_length(slot_value(opc->v1.p))))
+ opc->v3.d_pi_f = float_vector_ref_unchecked;
+ return(true);
+ }
+ }
+ }
+ else
+ {
+ if (int_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fd = opt_d_pi_sf;
+ return(true);
+ }
+ pc_fallback(sc, start);
}
}
- set_plist_2(sc, sc->nil, sc->nil);
- sc->temp9 = sc->nil;
- sc->temp10 = sc->nil;
- vector_length(sv) = 0;
}
- return(new_vec);
+ return(false);
}
-static s7_pointer string_append(s7_scheme *sc, s7_pointer args)
+/* -------- d_ip -------- */
+static s7_double opt_d_ip_ss(void *p)
{
- s7_pointer new_str;
- s7_int len;
-
- len = total_sequence_length(sc, args, sc->string_append_symbol, (is_byte_vector(car(args))) ? T_INTEGER : T_CHARACTER);
- new_str = make_empty_string(sc, len, 0);
- if (is_byte_vector(car(args)))
- set_byte_vector(new_str);
+ opt_info *o = (opt_info *)p;
+ /* PERHAPS: type check */
+ return(o->v3.d_ip_f(integer(slot_value(o->v1.p)), slot_value(o->v2.p)));
+}
- if (len > 0)
+static bool d_ip_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ if ((is_symbol(cadr(car_x))) &&
+ (is_symbol(caddr(car_x))))
{
- s7_pointer p, sv;
- int i;
-
- sc->temp9 = new_str;
- sv = make_string_wrapper_with_length(sc, (const char *)string_value(new_str), len);
- if (is_byte_vector(new_str))
- set_byte_vector(sv);
- sc->temp10 = sv;
-
- for (i = 0, p = args; is_pair(p); p = cdr(p))
+ s7_d_ip_t pfunc;
+ pfunc = s7_d_ip_function(s_func);
+ if (pfunc)
{
- s7_pointer x;
- s7_int n;
- x = car(p);
- n = sequence_length(sc, x);
- if (n > 0)
+ opc->v3.d_ip_f = pfunc;
+ opc->v1.p = find_symbol(sc, cadr(car_x));
+ opc->v2.p = find_symbol(sc, caddr(car_x));
+ if ((is_slot(opc->v1.p)) &&
+ (is_integer(slot_value(opc->v1.p))) &&
+ (is_slot(opc->v2.p)))
{
- string_length(sv) = n;
- s7_copy(sc, set_plist_2(sc, x, sv));
- i += n;
- string_value(sv) = (char *)(string_value(new_str) + i);
+ /* (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .4 :reverb-amount .5)) */
+ opc->v7.fd = opt_d_ip_ss;
+ return(true);
}
}
- set_plist_2(sc, sc->nil, sc->nil);
- sc->temp9 = sc->nil;
- sc->temp10 = sc->nil;
- string_length(sv) = 0;
}
+ return(false);
+}
- return(new_str);
+/* -------- d_pd -------- */
+static s7_double opt_d_pd_sf(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.d_pd_f(slot_value(o->v1.p), o1->v7.fd(o1)));
}
-static s7_pointer hash_table_append(s7_scheme *sc, s7_pointer args)
+static s7_double opt_d_pd_ss(void *p)
{
- s7_pointer new_hash, p;
- new_hash = s7_make_hash_table(sc, sc->default_hash_table_length);
- for (p = args; is_pair(p); p = cdr(p))
- s7_copy(sc, set_plist_2(sc, car(p), new_hash));
- set_plist_2(sc, sc->nil, sc->nil);
- return(new_hash);
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_pd_f(slot_value(o->v1.p), real(slot_value(o->v2.p))));
}
-static s7_pointer let_append(s7_scheme *sc, s7_pointer args)
+static bool d_pd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
{
- s7_pointer new_let, p, e;
-
- e = car(args);
- check_method(sc, e, sc->append_symbol, args);
- new_let = new_frame_in_env(sc, sc->nil);
- for (p = args; is_pair(p); p = cdr(p))
- s7_copy(sc, set_plist_2(sc, car(p), new_let));
- set_plist_2(sc, sc->nil, sc->nil);
- return(new_let);
+ if (is_symbol(cadr(car_x)))
+ {
+ s7_d_pd_t func;
+ func = s7_d_pd_function(s_func);
+ if (func)
+ {
+ s7_pointer arg2;
+ int start;
+ start = sc->pc;
+ arg2 = caddr(car_x);
+ opc->v3.d_pd_f = func;
+ opc->v1.p = find_symbol(sc, cadr(car_x));
+ if (!is_slot(opc->v1.p))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ if (is_symbol(arg2))
+ {
+ opc->v2.p = find_symbol(sc, arg2);
+ if ((is_slot(opc->v2.p)) &&
+ (is_float(slot_value(opc->v2.p))))
+ {
+ opc->v7.fd = opt_d_pd_ss;
+ return(true);
+ }
+ }
+ if (float_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fd = opt_d_pd_sf;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ }
+ }
+ return(false);
}
-static s7_pointer g_append(s7_scheme *sc, s7_pointer args)
+/* -------- d_vd -------- */
+static s7_double opt_d_vd_c(void *p)
{
- #define H_append "(append ...) returns its argument sequences appended into one sequence"
- #define Q_append s7_make_circular_signature(sc, 0, 1, sc->T)
- s7_pointer a1;
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_vd_f(o->v5.obj, o->v2.x));
+}
- if (is_null(args)) return(sc->nil); /* (append) -> () */
- a1 = car(args); /* first arg determines result type unless all args but last are empty (sigh) */
- if (is_null(cdr(args))) return(a1); /* (append <anything>) -> <anything> */
+static s7_double opt_d_vd_s(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_vd_f(o->v5.obj, real(slot_value(o->v2.p))));
+}
- switch (type(a1))
- {
- case T_NIL:
- case T_PAIR:
- return(g_list_append(sc, args)); /* only list case accepts any trailing arg because dotted lists are special */
+static s7_double opt_d_vd_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.d_vd_f(o->v5.obj, o1->v7.fd(o1)));
+}
- case T_VECTOR:
- case T_INT_VECTOR:
- case T_FLOAT_VECTOR:
- return(vector_append(sc, args, type(a1)));
+static s7_double opt_d_vd_o(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_vd_f(o->v5.obj, o->v4.d_v_f(o->v6.obj)));
+}
- case T_STRING:
- return(string_append(sc, args));
+static s7_double opt_d_vd_o1(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ cur_sc->pc += 2;
+ o1 = cur_sc->opts[cur_sc->pc];
+ return(o->v3.d_vd_f(o->v5.obj, o->v4.d_dd_f(real(slot_value(o->v2.p)), o1->v7.fd(o1))));
+}
- case T_HASH_TABLE:
- return(hash_table_append(sc, args));
+static s7_double opt_d_vd_o2(void *p)
+{
+ opt_info *o = (opt_info *)p; /* v1.p = v6 obj slot */
+ return(o->v4.d_vd_f(o->v6.obj, o->v5.d_vd_f(o->v2.obj, real(slot_value(o->v3.p)))));
+}
- case T_LET:
- return(let_append(sc, args));
+static s7_double opt_d_vd_o3(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_vd_f(o->v5.obj, o->v4.d_dd_f(o->v6.x, real(slot_value(o->v2.p)))));
+}
- default:
- check_method(sc, a1, sc->append_symbol, args);
- }
- return(wrong_type_argument_with_type(sc, sc->append_symbol, 1, a1, a_sequence_string)); /* (append 1 0) */
+static s7_double opt_d_vd_ff(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ cur_sc->pc += 2;
+ o1 = cur_sc->opts[cur_sc->pc];
+ return(o->v3.d_vd_f(o->v5.obj, o->v2.d_vd_f(o->v4.obj, o1->v7.fd(o1))));
}
-static s7_pointer object_to_list(s7_scheme *sc, s7_pointer obj)
+static s7_double opt_d_dd_cs(void *p);
+static s7_double opt_d_dd_sf(void *p);
+
+static bool d_vd_f_combinable(s7_scheme *sc, int start)
{
- /* used only in format_to_port_1 and (map values ...) */
- switch (type(obj))
+ opt_info *opc, *o1;
+ opc = sc->opts[start - 1];
+ o1 = sc->opts[start];
+ if (o1->v7.fd == opt_d_v)
{
- case T_INT_VECTOR:
- case T_FLOAT_VECTOR:
- case T_VECTOR:
- return(s7_vector_to_list(sc, obj));
+ opc->v2.p = o1->v1.p;
+ opc->v6.obj = o1->v5.obj;
+ opc->v4.d_v_f = o1->v3.d_v_f;
+ opc->v7.fd = opt_d_vd_o;
+ sc->pc--;
+ return(true);
+ }
+ if (o1->v7.fd == opt_d_vd_s)
+ {
+ opc->v6.obj = opc->v5.obj;
+ opc->v4.d_vd_f = opc->v3.d_vd_f; /* room for symbols */
+ opc->v2.obj = o1->v5.obj;
+ opc->v5.d_vd_f = o1->v3.d_vd_f;
+ opc->v3.p = o1->v2.p;
+ opc->v7.fd = opt_d_vd_o2;
+ sc->pc--;
+ return(true);
+ }
+ if (o1->v7.fd == opt_d_dd_cs)
+ {
+ opc->v4.d_dd_f = o1->v3.d_dd_f;
+ opc->v6.x = o1->v2.x;
+ opc->v2.p = o1->v1.p;
+ opc->v7.fd = opt_d_vd_o3;
+ sc->pc--;
+ return(true);
+ }
+ if (o1->v7.fd == opt_d_dd_sf)
+ {
+ opc->v2.p = o1->v1.p;
+ opc->v4.d_dd_f = o1->v3.d_dd_f;
+ opc->v7.fd = opt_d_vd_o1;
+ return(true);
+ }
+ if (o1->v7.fd == opt_d_vd_f)
+ {
+ opc->v2.d_vd_f = o1->v3.d_vd_f;
+ opc->v4.obj = o1->v5.obj;
+ opc->v7.fd = opt_d_vd_ff;
+ return(true);
+ }
+ return(false);
+}
- case T_STRING:
- if (is_byte_vector(obj))
- return(byte_vector_to_list(sc, string_value(obj), string_length(obj)));
- return(s7_string_to_list(sc, string_value(obj), string_length(obj)));
- case T_HASH_TABLE:
- if (hash_table_entries(obj) > 0)
+static bool d_vd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ if (is_symbol(cadr(car_x)))
+ {
+ s7_d_vd_t vfunc;
+ vfunc = s7_d_vd_function(s_func);
+ if (vfunc)
{
- s7_pointer x, iterator;
- iterator = s7_make_iterator(sc, obj);
- sc->temp8 = iterator;
- sc->w = sc->nil;
- while (true)
+ s7_pointer sig;
+ sig = s7_procedure_signature(sc, s_func);
+ if ((is_pair(sig)) &&
+ (is_symbol(cadr(sig))))
{
- x = s7_iterate(sc, iterator);
- if (iterator_is_at_end(iterator)) break;
- sc->w = cons(sc, x, sc->w);
- }
- x = sc->w;
- sc->w = sc->nil;
- sc->temp8 = sc->nil;
- return(x);
- }
- return(sc->nil);
-
- case T_LET:
-#if (!WITH_PURE_S7)
- check_method(sc, obj, sc->let_to_list_symbol, list_1(sc, obj));
-#endif
- return(s7_let_to_list(sc, obj));
-
- case T_ITERATOR:
- {
- s7_pointer result, p = NULL;
- int results = 0;
- result = sc->nil;
- while (true)
- {
- s7_pointer val;
- val = s7_iterate(sc, obj);
- if ((val == sc->ITERATOR_END) &&
- (iterator_is_at_end(obj)))
- {
- sc->temp8 = sc->nil;
- return(result);
- }
- if (sc->safety > 0)
- {
- results++;
- if (results > 10000)
- {
- fprintf(stderr, "iterator in object->list is creating a very long list!\n");
- results = S7_LONG_MIN;
- }
- }
- if (val != sc->no_value)
- {
- if (is_null(result))
- {
- if (is_multiple_value(val))
- {
- result = multiple_value(val);
- clear_multiple_value(val);
- for (p = result; is_pair(cdr(p)); p = cdr(p));
- }
- else
- {
- result = cons(sc, val, sc->nil);
- p = result;
- }
- sc->temp8 = result;
- }
- else
- {
- if (is_multiple_value(val))
- {
- set_cdr(p, multiple_value(val));
- clear_multiple_value(val);
- for (; is_pair(cdr(p)); p = cdr(p));
- }
- else
- {
- set_cdr(p, cons(sc, val, sc->nil));
- p = cdr(p);
- }
- }
- }
- }
- }
-
- case T_C_OBJECT:
- {
- long int i, len; /* the "long" matters on 64-bit machines */
- s7_pointer x, z, result;
- unsigned int gc_z;
-
- x = object_length(sc, obj);
- if (s7_is_integer(x))
- len = s7_integer(x);
- else return(sc->F);
-
- if (len < 0)
- return(sc->F);
- if (len == 0)
- return(sc->nil);
-
- result = make_list(sc, len, sc->nil);
- sc->temp8 = result;
- z = list_1(sc, sc->F);
- gc_z = s7_gc_protect(sc, z);
-
- set_car(sc->z2_1, sc->x);
- set_car(sc->z2_2, sc->z);
- 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));
- }
- sc->x = car(sc->z2_1);
- sc->z = car(sc->z2_2);
- s7_gc_unprotect_at(sc, gc_z);
- sc->temp8 = sc->nil;
- return(result);
- }
+ s7_pointer slot, obj, checker;
+ checker = s7_symbol_value(sc, cadr(sig));
+ slot = find_symbol(sc, cadr(car_x));
+ obj = slot_value(slot);
+ if (s7_apply_function(sc, checker, set_plist_1(sc, obj)) == sc->T)
+ {
+ s7_pointer arg2;
+ int start;
+ start = sc->pc;
+ arg2 = caddr(car_x);
+ opc->v3.d_vd_f = vfunc;
+ if (!is_pair(arg2))
+ {
+ opc->v1.p = slot;
+ opc->v5.obj = (void *)s7_object_value(obj);
+ if (is_real(arg2))
+ {
+ opc->v2.x = s7_number_to_real(sc, arg2);
+ opc->v7.fd = opt_d_vd_c;
+ return(true);
+ }
+ opc->v2.p = find_symbol(sc, arg2);
+ if (is_slot(opc->v2.p))
+ {
+ if (is_float(slot_value(opc->v2.p)))
+ opc->v7.fd = opt_d_vd_s;
+ else
+ {
+ if (float_optimize(sc, cddr(car_x)))
+ {
+ if (!d_vd_f_combinable(sc, start))
+ opc->v7.fd = opt_d_vd_f;
+ }
+ else return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ return(true);
+ }
+ }
+ else /* is pair arg2 */
+ {
+ if (float_optimize(sc, cddr(car_x)))
+ {
+ opc->v1.p = slot;
+ opc->v5.obj = (void *)s7_object_value(obj);
+ if (!d_vd_f_combinable(sc, start))
+ opc->v7.fd = opt_d_vd_f;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ }
+ }
+ }
+ }
}
- return(obj);
+ return(false);
}
+/* -------- d_id -------- */
+static s7_double opt_d_id_sf(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.d_id_f(integer(slot_value(o->v1.p)), o1->v7.fd(o1)));
+}
-/* -------------------------------- object->let -------------------------------- */
-
-static bool is_decodable(s7_scheme *sc, s7_pointer p);
-static s7_pointer stack_entries(s7_scheme *sc, s7_pointer stack, int top);
-
-static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args)
+static s7_double opt_d_id_sfo(void *p)
{
- #define H_object_to_let "(object->let obj) returns a let (namespace) describing obj."
- #define Q_object_to_let s7_make_signature(sc, 2, sc->is_let_symbol, sc->T)
+ opt_info *o = (opt_info *)p;
+ return(o->v4.d_id_f(integer(slot_value(o->v1.p)), o->v5.d_vd_f(o->v6.obj, real(slot_value(o->v3.p)))));
+}
- s7_pointer obj;
- obj = car(args);
+static s7_double opt_d_id_sfo1(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_id_f(integer(slot_value(o->v1.p)), o->v5.d_v_f(o->v2.obj)));
+}
- switch (type(obj))
+static bool d_id_sf_combinable(s7_scheme *sc, opt_info *opc)
+{
+ if ((sc->pc > 1) &&
+ (opc == sc->opts[sc->pc - 2]))
{
- case T_NIL:
- return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_null_symbol)));
-
- case T_UNSPECIFIED:
- return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, obj)));
-
- case T_SYNTAX:
- return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, s7_make_symbol(sc, "syntax?"))));
+ opt_info *o1;
+ o1 = sc->opts[sc->pc - 1];
+ if (o1->v7.fd == opt_d_vd_s)
+ {
+ opc->v4.d_id_f = opc->v3.d_id_f;
+ opc->v2.p = o1->v1.p;
+ opc->v6.obj = o1->v5.obj;
+ opc->v5.d_vd_f = o1->v3.d_vd_f;
+ opc->v3.p = o1->v2.p;
+ opc->v7.fd = opt_d_id_sfo;
+ sc->pc--;
+ return(true);
+ }
+ if (o1->v7.fd == opt_d_v)
+ {
+ opc->v6.p = o1->v1.p;
+ opc->v2.obj = o1->v5.obj;
+ opc->v5.d_v_f = o1->v3.d_v_f;
+ opc->v7.fd = opt_d_id_sfo1;
+ sc->pc--;
+ return(true);
+ }
+ }
+ return(false);
+}
- case T_UNIQUE:
- return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, (is_eof(obj)) ? sc->is_eof_object_symbol : obj)));
+static bool d_id_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ if (is_symbol(cadr(car_x)))
+ {
+ s7_d_id_t flt_func;
+ flt_func = s7_d_id_function(s_func);
+ if (flt_func)
+ {
+ int start;
+ start = sc->pc;
+ opc->v3.d_id_f = flt_func;
+ opc->v1.p = find_symbol(sc, cadr(car_x));
+ if ((is_slot(opc->v1.p)) &&
+ (is_integer(slot_value(opc->v1.p))) &&
+ (float_optimize(sc, cddr(car_x))))
+ {
+ if (!d_id_sf_combinable(sc, opc))
+ opc->v7.fd = opt_d_id_sf;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ }
+ }
+ return(false);
+}
- case T_BOOLEAN:
- return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_boolean_symbol)));
-
- case T_SYMBOL:
- return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, (is_keyword(obj)) ? sc->is_keyword_symbol : sc->is_symbol_symbol)));
-
- case T_CHARACTER:
- return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_char_symbol)));
-
- case T_INTEGER:
- case T_BIG_INTEGER:
- return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_integer_symbol)));
-
- case T_RATIO:
- case T_BIG_RATIO:
- return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_rational_symbol)));
-
- case T_REAL:
- case T_BIG_REAL:
- return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_real_symbol)));
-
- case T_COMPLEX:
- case T_BIG_COMPLEX:
- return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_complex_symbol)));
+/* -------- d_dd -------- */
- case T_STRING:
- return(s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
- sc->type_symbol, (is_byte_vector(obj)) ? sc->is_byte_vector_symbol : sc->is_string_symbol,
- sc->length_symbol, s7_length(sc, obj))));
+static s7_double opt_d_dd_cc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_dd_f(o->v1.x, o->v2.x));
+}
- case T_PAIR:
- return(s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
- sc->type_symbol, sc->is_pair_symbol,
- sc->length_symbol, s7_length(sc, obj))));
+static s7_double opt_d_dd_cs(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_dd_f(o->v2.x, real(slot_value(o->v1.p))));
+}
- case T_RANDOM_STATE:
-#if WITH_GMP
- return(s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_random_state_symbol)));
-#else
- return(s7_inlet(sc, s7_list(sc, 8, sc->value_symbol, obj,
- sc->type_symbol, sc->is_random_state_symbol,
- s7_make_symbol(sc, "seed"), s7_make_integer(sc, random_seed(obj)),
- s7_make_symbol(sc, "carry"), s7_make_integer(sc, random_carry(obj)))));
-#endif
+static s7_double opt_d_dd_sc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_dd_f(real(slot_value(o->v1.p)), o->v2.x));
+}
- case T_GOTO:
- return(s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
- sc->type_symbol, s7_make_symbol(sc, "goto?"),
- s7_make_symbol(sc, "active"), s7_make_boolean(sc, call_exit_active(obj)))));
+static s7_double opt_d_dd_ss(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_dd_f(real(slot_value(o->v1.p)), real(slot_value(o->v2.p))));
+}
- case T_INT_VECTOR:
- case T_FLOAT_VECTOR:
- case T_VECTOR:
- return(s7_inlet(sc, s7_list(sc, 10, sc->value_symbol, obj,
- sc->type_symbol,
- (is_int_vector(obj)) ? sc->is_int_vector_symbol : ((is_float_vector(obj)) ? sc->is_float_vector_symbol : sc->is_vector_symbol),
- sc->length_symbol, s7_length(sc, obj),
- s7_make_symbol(sc, "dimensions"), g_vector_dimensions(sc, list_1(sc, obj)),
- s7_make_symbol(sc, "shared"),
- ((vector_has_dimensional_info(obj)) && (is_normal_vector(shared_vector(obj)))) ? shared_vector(obj) : sc->F)));
+static s7_double opt_d_dd_cf(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.d_dd_f(o->v1.x, o1->v7.fd(o1)));
+}
- case T_C_POINTER:
- return(s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
- sc->type_symbol, sc->is_c_pointer_symbol,
- s7_make_symbol(sc, "s7-value"),
- ((is_decodable(sc, (s7_pointer)raw_pointer(obj))) &&
- (!is_free(obj))) ? g_object_to_let(sc, cons(sc, (s7_pointer)raw_pointer(obj), sc->nil)) : sc->F)));
+static s7_double opt_d_dd_fc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.d_dd_f(o1->v7.fd(o1), o->v2.x));
+}
- case T_CONTINUATION:
- {
- s7_pointer let;
- unsigned int gc_loc;
- let = s7_inlet(sc, s7_list(sc, 4, sc->value_symbol, obj, sc->type_symbol, sc->is_continuation_symbol));
- gc_loc = s7_gc_protect(sc, let);
- s7_varlet(sc, let, s7_make_symbol(sc, "stack"), stack_entries(sc, continuation_stack(obj), continuation_stack_top(obj)));
- s7_gc_unprotect_at(sc, gc_loc);
- return(let);
- }
+static s7_double opt_d_dd_sf(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.d_dd_f(real(slot_value(o->v1.p)), o1->v7.fd(o1)));
+}
- case T_ITERATOR:
- {
- s7_pointer let, seq;
- seq = iterator_sequence(obj);
- let = s7_inlet(sc, s7_list(sc, 8, sc->value_symbol, obj,
- sc->type_symbol, sc->is_iterator_symbol,
- s7_make_symbol(sc, "at-end"), s7_make_boolean(sc, iterator_is_at_end(obj)),
- s7_make_symbol(sc, "sequence"), iterator_sequence(obj)));
- if (is_pair(seq))
- s7_varlet(sc, let, sc->length_symbol, s7_length(sc, seq));
- else
- {
- if (is_hash_table(seq))
- s7_varlet(sc, let, sc->length_symbol, s7_make_integer(sc, hash_table_entries(seq)));
- else s7_varlet(sc, let, sc->length_symbol, s7_length(sc, obj));
- }
- if ((is_string(seq)) ||
- (is_normal_vector(seq)) ||
- (is_int_vector(seq)) ||
- (is_float_vector(seq)) ||
- (seq == sc->rootlet) ||
- (is_c_object(seq)) ||
- (is_hash_table(seq)))
- s7_varlet(sc, let, s7_make_symbol(sc, "position"), s7_make_integer(sc, iterator_position(obj)));
- else
- {
- if (is_pair(seq))
- s7_varlet(sc, let, s7_make_symbol(sc, "position"), iterator_current(obj));
- }
- return(let);
- }
+static s7_double opt_d_dd_fs(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.d_dd_f(o1->v7.fd(o1), real(slot_value(o->v1.p))));
+}
- case T_HASH_TABLE:
- {
- s7_pointer let;
- let = s7_inlet(sc, s7_list(sc, 10, sc->value_symbol, obj,
- sc->type_symbol, sc->is_hash_table_symbol,
- sc->length_symbol, s7_length(sc, obj),
- s7_make_symbol(sc, "entries"), s7_make_integer(sc, hash_table_entries(obj)),
- s7_make_symbol(sc, "locked"), s7_make_boolean(sc, hash_table_checker_locked(obj))));
+static s7_double opt_d_dd_ff(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1, *o2;
+ s7_double x1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ x1 = o1->v7.fd(o1);
+ o2 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.d_dd_f(x1, o2->v7.fd(o2)));
+}
- if ((hash_table_checker(obj) == hash_eq) ||
- (hash_table_checker(obj) == hash_c_function) ||
- (hash_table_checker(obj) == hash_closure) ||
- (hash_table_checker(obj) == hash_equal_eq) ||
- (hash_table_checker(obj) == hash_equal_syntax) ||
- (hash_table_checker(obj) == hash_symbol))
- s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->is_eq_symbol);
- else
- {
- if (hash_table_checker(obj) == hash_eqv)
- s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->is_eqv_symbol);
- else
- {
- if ((hash_table_checker(obj) == hash_equal) ||
- (hash_table_checker(obj) == hash_empty))
- s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->is_equal_symbol);
- else
- {
- if (hash_table_checker(obj) == hash_morally_equal)
- s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->is_morally_equal_symbol);
- else
- {
- if ((hash_table_checker(obj) == hash_number) ||
- (hash_table_checker(obj) == hash_int) ||
- (hash_table_checker(obj) == hash_float) ||
- (hash_table_checker(obj) == hash_equal_real) ||
- (hash_table_checker(obj) == hash_equal_complex))
- s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->eq_symbol);
- else
- {
- if (hash_table_checker(obj) == hash_string)
- s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->string_eq_symbol);
- else
- {
- if (hash_table_checker(obj) == hash_char)
- s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->char_eq_symbol);
-#if (!WITH_PURE_S7)
- else
- {
- if (hash_table_checker(obj) == hash_ci_char)
- s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->char_ci_eq_symbol);
- else
- {
- if (hash_table_checker(obj) == hash_ci_string)
- s7_varlet(sc, let, s7_make_symbol(sc, "function"), sc->string_ci_eq_symbol);
- }}
-#endif
- }}}}}}
- return(let);
- }
+static s7_double opt_d_dd_fso(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v4.d_dd_f(o->v5.d_pi_f(slot_value(o->v2.p), integer(slot_value(o->v3.p))), real(slot_value(o->v1.p))));
+}
- case T_LET:
- {
- s7_pointer let;
- let = s7_inlet(sc, s7_list(sc, 10, sc->value_symbol, obj,
- sc->type_symbol, sc->is_let_symbol,
- sc->length_symbol, s7_length(sc, obj),
- s7_make_symbol(sc, "open"), s7_make_boolean(sc, has_methods(obj)),
- sc->outlet_symbol, (obj == sc->rootlet) ? sc->nil : outlet(obj)));
- if (obj == sc->rootlet)
- s7_varlet(sc, let, s7_make_symbol(sc, "alias"), sc->rootlet_symbol);
- else
- {
- if (obj == sc->owlet)
- s7_varlet(sc, let, s7_make_symbol(sc, "alias"), sc->owlet_symbol);
- else
- {
- if (is_function_env(obj))
- {
- s7_varlet(sc, let, s7_make_symbol(sc, "function"), funclet_function(obj));
- if ((let_file(obj) > 0) &&
- (let_file(obj) < (s7_int)sc->file_names_top) &&
- (let_line(obj) > 0))
- {
- s7_varlet(sc, let, s7_make_symbol(sc, "file"), sc->file_names[let_file(obj)]);
- s7_varlet(sc, let, s7_make_symbol(sc, "line"), make_integer(sc, let_line(obj)));
- }
- }
- }
- }
- if (has_methods(obj))
- {
- s7_pointer func;
- func = find_method(sc, obj, sc->object_to_let_symbol);
- if (func != sc->undefined)
- {
- unsigned int gc_loc;
- gc_loc = s7_gc_protect(sc, let);
- s7_apply_function(sc, func, list_2(sc, obj, let));
- s7_gc_unprotect_at(sc, gc_loc);
- }
- }
- return(let);
- }
+static bool d_dd_fs_combinable(s7_scheme *sc, opt_info *opc)
+{
+ if ((sc->pc > 1) &&
+ (opc == sc->opts[sc->pc - 2]))
+ {
+ opt_info *o1;
+ o1 = sc->opts[sc->pc - 1];
+ if (o1->v7.fd == opt_d_pi_ss)
+ {
+ opc->v4.d_dd_f = opc->v3.d_dd_f; /* need room for 3 symbols */
+ opc->v2.p = o1->v1.p;
+ opc->v3.p = o1->v2.p;
+ opc->v5.d_pi_f = o1->v3.d_pi_f;
+ opc->v7.fd = opt_d_dd_fso;
+ sc->pc--;
+ return(true);
+ }
+ }
+ return(false);
+}
- case T_C_OBJECT:
- {
- s7_pointer let, clet;
- clet = c_object_let(obj);
- let = s7_inlet(sc, s7_list(sc, 12, sc->value_symbol, obj,
- sc->type_symbol, sc->is_c_object_symbol,
- sc->length_symbol, s7_length(sc, obj),
- s7_make_symbol(sc, "c-type"), s7_make_integer(sc, c_object_type(obj)),
- sc->let_symbol, clet,
- s7_make_symbol(sc, "class"), c_object_scheme_name(obj)));
- if ((is_let(clet)) &&
- ((has_methods(clet)) || (has_methods(obj))))
- {
- s7_pointer func;
- func = find_method(sc, clet, sc->object_to_let_symbol);
- if (func != sc->undefined)
- {
- unsigned int gc_loc;
- gc_loc = s7_gc_protect(sc, let);
- s7_apply_function(sc, func, list_2(sc, obj, let));
- s7_gc_unprotect_at(sc, gc_loc);
- }
- }
- return(let);
- }
+static s7_double opt_d_dd_ff_o1(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o2;
+ s7_double x1;
+ x1 = o->v2.d_v_f(o->v1.obj);
+ o2 = cur_sc->opts[cur_sc->pc += 2];
+ return(o->v3.d_dd_f(x1, o2->v7.fd(o2)));
+}
- case T_INPUT_PORT:
- case T_OUTPUT_PORT:
- {
- s7_pointer let;
- unsigned int gc_loc;
- let = s7_inlet(sc, s7_list(sc, 8, sc->value_symbol, obj,
- sc->type_symbol, (is_input_port(obj)) ? sc->is_input_port_symbol : sc->is_output_port_symbol,
- s7_make_symbol(sc, "port-type"),
- (is_string_port(obj)) ? sc->string_symbol :
- ((is_file_port(obj)) ? s7_make_symbol(sc, "file") : s7_make_symbol(sc, "function")),
- s7_make_symbol(sc, "closed"), s7_make_boolean(sc, port_is_closed(obj))));
- gc_loc = s7_gc_protect(sc, let);
- if (is_file_port(obj))
- {
- s7_varlet(sc, let, s7_make_symbol(sc, "file"), g_port_filename(sc, list_1(sc, obj)));
- if (is_input_port(obj))
- s7_varlet(sc, let, s7_make_symbol(sc, "line"), g_port_line_number(sc, list_1(sc, obj)));
- }
- if (port_data_size(obj) > 0)
- {
- s7_varlet(sc, let, sc->length_symbol, s7_make_integer(sc, port_data_size(obj)));
- s7_varlet(sc, let, s7_make_symbol(sc, "position"), s7_make_integer(sc, port_position(obj)));
- /* I think port_data need not be null-terminated, but s7_make_string assumes it is:
- * both valgrind and lib*san complain about the uninitialized data during strlen.
- */
- s7_varlet(sc, let, s7_make_symbol(sc, "data"), s7_make_string_with_length(sc, (const char *)port_data(obj), port_data_size(obj)));
- }
- s7_gc_unprotect_at(sc, gc_loc);
- return(let);
- }
+static s7_double opt_d_dd_ff_o2(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ s7_double x1;
+ x1 = o->v4.d_v_f(o->v1.obj);
+ return(o->v3.d_dd_f(x1, o->v5.d_v_f(o->v2.obj)));
+}
- case T_CLOSURE:
- case T_CLOSURE_STAR:
- case T_MACRO:
- case T_MACRO_STAR:
- case T_BACRO:
- case T_BACRO_STAR:
- {
- s7_pointer let, sig;
- const char* doc;
- unsigned int gc_loc;
- let = s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
- sc->type_symbol, (is_procedure(obj)) ? sc->is_procedure_symbol : sc->is_macro_symbol,
- s7_make_symbol(sc, "arity"), s7_arity(sc, obj)));
- gc_loc = s7_gc_protect(sc, let);
+static s7_double opt_d_dd_ff_o3(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ s7_double x1;
+ x1 = o->v5.d_v_f(o->v1.obj);
+ return(o->v4.d_dd_f(x1, o->v6.d_vd_f(o->v2.obj, real(slot_value(o->v3.p)))));
+}
- sig = s7_procedure_signature(sc, obj);
- if (is_pair(sig))
- s7_varlet(sc, let, sc->signature_symbol, sig);
-
- doc = s7_procedure_documentation(sc, obj);
- if (doc)
- s7_varlet(sc, let, sc->documentation_symbol, s7_make_string(sc, doc));
-
- if (is_let(closure_let(obj)))
- {
- s7_pointer flet;
- flet = closure_let(obj);
- if ((let_file(flet) > 0) &&
- (let_file(flet) < (s7_int)sc->file_names_top) &&
- (let_line(flet) > 0))
- {
- s7_varlet(sc, let, s7_make_symbol(sc, "file"), sc->file_names[let_file(flet)]);
- s7_varlet(sc, let, s7_make_symbol(sc, "line"), make_integer(sc, let_line(flet)));
- }
- }
-
- if (closure_setter(obj) != sc->F)
- s7_varlet(sc, let, s7_make_symbol(sc, "setter"), closure_setter(obj));
+static s7_double opt_d_dd_fff(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1, *o2;
+ s7_double x1, x2;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ x1 = o1->v4.d_dd_f(o1->v5.d_pi_f(slot_value(o1->v2.p), integer(slot_value(o1->v3.p))), real(slot_value(o1->v1.p))); /* dd_fso */
+ o2 = cur_sc->opts[++cur_sc->pc];
+ x2 = o2->v4.d_dd_f(o2->v5.d_pi_f(slot_value(o2->v2.p), integer(slot_value(o2->v3.p))), real(slot_value(o2->v1.p))); /* dd_fso */
+ return(o->v3.d_dd_f(x1, x2));
+}
- s7_varlet(sc, let, s7_make_symbol(sc, "source"),
- append_in_place(sc, list_2(sc, (is_closure_star(obj)) ? sc->lambda_star_symbol : sc->lambda_symbol,
- closure_args(obj)),
- closure_body(obj)));
- s7_gc_unprotect_at(sc, gc_loc);
- return(let);
- }
+static bool d_dd_ff_combinable(s7_scheme *sc, int start)
+{
+ opt_info *opc, *o1;
+ opc = sc->opts[start - 1];
+ o1 = sc->opts[start];
+ if (o1->v7.fd == opt_d_v)
+ {
+ opt_info *o2;
+ o2 = sc->opts[start + 1];
+ if ((o2->v7.fd == opt_d_v) &&
+ (sc->pc == start + 2))
+ {
+ opc->v6.p = o1->v1.p;
+ opc->v1.obj = o1->v5.obj;
+ opc->v4.d_v_f = o1->v3.d_v_f;
+ opc->v2.obj = o2->v5.obj;
+ opc->v5.d_v_f = o2->v3.d_v_f;
+ opc->v7.fd = opt_d_dd_ff_o2;
+ sc->pc -= 2;
+ }
+ else
+ {
+ if ((o2->v7.fd == opt_d_vd_s) &&
+ (sc->pc == start + 2))
+ {
+ opc->v4.d_dd_f = opc->v3.d_dd_f; /* make room for symbols */
+ opc->v1.obj = o1->v5.obj;
+ opc->v5.d_v_f = o1->v3.d_v_f;
+ opc->v2.obj = o2->v5.obj;
+ opc->v6.d_vd_f = o2->v3.d_vd_f;
+ opc->v3.p = o2->v2.p;
+ opc->v7.fd = opt_d_dd_ff_o3;
+ sc->pc -= 2;
+ }
+ else
+ {
+ opc->v5.p = o1->v1.p;
+ opc->v1.obj = o1->v5.obj;
+ opc->v2.d_v_f = o1->v3.d_v_f;
+ opc->v7.fd = opt_d_dd_ff_o1;
+ }
+ }
+ return(true);
+ }
+ if (o1->v7.fd == opt_d_dd_fso)
+ {
+ opt_info *o2;
+ o2 = sc->opts[start + 1];
+ if (o2->v7.fd == opt_d_dd_fso)
+ {
+ opc->v7.fd = opt_d_dd_fff;
+ return(true);
+ }
+ }
+ return(false);
+}
- case T_C_MACRO:
- case T_C_FUNCTION_STAR:
- case T_C_FUNCTION:
- case T_C_ANY_ARGS_FUNCTION:
- case T_C_OPT_ARGS_FUNCTION:
- case T_C_RST_ARGS_FUNCTION:
- {
- s7_pointer let, sig;
- const char* doc;
- let = s7_inlet(sc, s7_list(sc, 6, sc->value_symbol, obj,
- sc->type_symbol, (is_procedure(obj)) ? sc->is_procedure_symbol : sc->is_macro_symbol,
- s7_make_symbol(sc, "arity"), s7_arity(sc, obj)));
+static s7_double opt_d_dd_cfo(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_dd_f(o->v2.x, o->v4.d_v_f(o->v1.obj)));
+}
- sig = s7_procedure_signature(sc, obj);
- if (is_pair(sig))
- s7_varlet(sc, let, sc->signature_symbol, sig);
-
- doc = s7_procedure_documentation(sc, obj);
- if (doc)
- s7_varlet(sc, let, sc->documentation_symbol, s7_make_string(sc, doc));
+static s7_double opt_d_dd_cfo1(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.d_dd_f(o->v4.x, o->v5.d_vd_f(o->v6.obj, real(slot_value(o->v2.p)))));
+}
- if (c_function_setter(obj) != sc->F)
- s7_varlet(sc, let, s7_make_symbol(sc, "setter"), c_function_setter(obj));
-
- return(let);
- }
+static bool d_dd_cf_combinable(s7_scheme *sc, opt_info *opc)
+{
+ if ((sc->pc > 1) &&
+ (opc == sc->opts[sc->pc - 2]))
+ {
+ opt_info *o1;
+ o1 = sc->opts[sc->pc - 1];
+ if (o1->v7.fd == opt_d_v)
+ {
+ opc->v2.x = opc->v1.x;
+ opc->v6.p = o1->v1.p;
+ opc->v1.obj = o1->v5.obj;
+ opc->v4.d_v_f = o1->v3.d_v_f;
+ opc->v7.fd = opt_d_dd_cfo;
+ sc->pc--;
+ return(true);
+ }
+ if (o1->v7.fd == opt_d_vd_s)
+ {
+ opc->v4.x = opc->v1.x;
+ opc->v1.p = o1->v1.p;
+ opc->v6.obj = o1->v5.obj;
+ opc->v2.p = o1->v2.p;
+ opc->v5.d_vd_f = o1->v3.d_vd_f;
+ opc->v7.fd = opt_d_dd_cfo1;
+ sc->pc--;
+ return(true);
+ }
+ }
+ return(false);
+}
- default:
-#if DEBUGGING
- fprintf(stderr, "object->let: %s, type: %d\n", DISPLAY(obj), type(obj));
-#endif
- return(sc->F);
+static bool d_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_d_dd_t func;
+ func = s7_d_dd_function(s_func);
+ if (func)
+ {
+ s7_pointer arg1, arg2;
+ int start;
+ start = sc->pc;
+ arg1 = cadr(car_x);
+ arg2 = caddr(car_x);
+ opc->v3.d_dd_f = func;
+ if (is_real(arg1))
+ {
+ if (is_real(arg2))
+ {
+ if ((!is_t_real(arg1)) && (!is_t_real(arg2)))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc->v1.x = s7_number_to_real(sc, arg1);
+ opc->v2.x = s7_number_to_real(sc, arg2);
+ opc->v7.fd = opt_d_dd_cc;
+ return(true);
+ }
+ if (is_symbol(arg2))
+ {
+ opc->v1.p = find_symbol(sc, arg2);
+ if (is_slot(opc->v1.p))
+ {
+ if (is_float(slot_value(opc->v1.p)))
+ {
+ opc->v2.x = s7_number_to_real(sc, arg1);
+ opc->v7.fd = opt_d_dd_cs;
+ }
+ else
+ {
+ opc->v1.x = s7_number_to_real(sc, arg1); /* cf combine v1.x = arg1 */
+ if (float_optimize(sc, cddr(car_x)))
+ {
+ if (!d_dd_cf_combinable(sc, opc))
+ opc->v7.fd = opt_d_dd_cf;
+ }
+ else return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ return(true);
+ }
+ pc_fallback(sc, start);
+ }
+ else
+ {
+ if (float_optimize(sc, cddr(car_x)))
+ {
+ opc->v1.x = s7_number_to_real(sc, arg1);
+ if (!d_dd_cf_combinable(sc, opc))
+ opc->v7.fd = opt_d_dd_cf;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ }
+ }
+ else
+ {
+ if (is_symbol(arg1))
+ {
+ opc->v1.p = find_symbol(sc, arg1);
+ if ((is_slot(opc->v1.p)) &&
+ (is_real(slot_value(opc->v1.p))))
+ {
+ if (is_float(slot_value(opc->v1.p)))
+ {
+ if (is_real(arg2))
+ {
+ opc->v2.x = s7_number_to_real(sc, arg2);
+ opc->v7.fd = opt_d_dd_sc;
+ return(true);
+ }
+ if (is_symbol(arg2))
+ {
+ opc->v2.p = find_symbol(sc, arg2);
+ if (is_slot(opc->v2.p))
+ {
+ if (is_float(slot_value(opc->v2.p)))
+ opc->v7.fd = opt_d_dd_ss;
+ else
+ {
+ if (float_optimize(sc, cddr(car_x)))
+ opc->v7.fd = opt_d_dd_sf;
+ else return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ return(true);
+ }
+ }
+ else
+ {
+ if (float_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fd = opt_d_dd_sf;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ }
+ }
+ else
+ {
+ if ((float_optimize(sc, cdr(car_x))) &&
+ (float_optimize(sc, cddr(car_x))))
+ {
+ if (!d_dd_ff_combinable(sc, start))
+ opc->v7.fd = opt_d_dd_ff;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ }
+ }
+ else return(return_false(sc, car_x, __func__, __LINE__)); /* arg1 trouble */
+ /* TODO: d_ddd has a similar bug and check arg2 */
+ }
+ else
+ {
+ if (float_optimize(sc, cdr(car_x)))
+ {
+ if (is_real(arg2))
+ {
+ opc->v2.x = s7_number_to_real(sc, arg2);
+ opc->v7.fd = opt_d_dd_fc;
+ return(true);
+ }
+ if (is_symbol(arg2))
+ {
+ opc->v1.p = find_symbol(sc, arg2);
+ if (is_slot(opc->v1.p))
+ {
+ if (is_float(slot_value(opc->v1.p)))
+ {
+ if (!d_dd_fs_combinable(sc, opc))
+ opc->v7.fd = opt_d_dd_fs;
+ }
+ else
+ {
+ if (float_optimize(sc, cddr(car_x)))
+ {
+ if (!d_dd_ff_combinable(sc, start))
+ opc->v7.fd = opt_d_dd_ff;
+ }
+ else return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ return(true);
+ }
+ }
+ else
+ {
+ if (float_optimize(sc, cddr(car_x)))
+ {
+ if (!d_dd_ff_combinable(sc, start))
+ opc->v7.fd = opt_d_dd_ff;
+ return(true);
+ }
+ }
+ }
+ pc_fallback(sc, start);
+ }
+ }
}
-
- return(sc->F);
+ return(false);
}
+/* -------- d_ddd -------- */
+static s7_double opt_d_ddd_ssf(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v4.d_ddd_f(real(slot_value(o->v1.p)), real(slot_value(o->v2.p)), o1->v7.fd(o1)));
+}
+static s7_double opt_d_ddd_sff(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_double x1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ x1 = o1->v7.fd(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v4.d_ddd_f(real(slot_value(o->v1.p)), x1, o1->v7.fd(o1)));
+}
-/* ---------------- stacktrace ---------------- */
+static s7_double opt_d_ddd_fff(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1, *o2, *o3;
+ s7_double x1, x2;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ x1 = o1->v7.fd(o1); /* this could involve nested funcs, incrementing pc internally */
+ o2 = cur_sc->opts[++cur_sc->pc];
+ x2 = o2->v7.fd(o2);
+ o3 = cur_sc->opts[++cur_sc->pc];
+ return(o->v4.d_ddd_f(x1, x2, o3->v7.fd(o3)));
+}
-static s7_pointer stacktrace_find_caller(s7_scheme *sc, s7_pointer e)
+static bool d_ddd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
{
- if ((is_let(e)) && (e != sc->rootlet))
+ s7_d_ddd_t f;
+
+ f = s7_d_ddd_function(s_func);
+ if (f)
{
- if (is_function_env(e))
- return(funclet_function(e));
- return(stacktrace_find_caller(sc, outlet(e)));
+ int start;
+ s7_pointer arg1, arg2;
+ arg1 = cadr(car_x);
+ arg2 = caddr(car_x);
+ start = sc->pc;
+ opc->v4.d_ddd_f = f;
+ if (is_symbol(arg1))
+ {
+ s7_pointer slot;
+ slot = find_symbol(sc, arg1);
+ opc->v1.p = slot;
+ if ((is_slot(slot)) &&
+ (is_float(slot_value(slot))))
+ {
+ if (is_symbol(arg2))
+ {
+ s7_pointer slot;
+ slot = find_symbol(sc, arg2);
+ opc->v2.p = slot;
+ if ((is_slot(slot)) &&
+ (is_float(slot_value(slot))))
+ {
+ if (float_optimize(sc, cdddr(car_x)))
+ {
+ opc->v7.fd = opt_d_ddd_ssf;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ }
+ }
+ if ((float_optimize(sc, cddr(car_x))) &&
+ (float_optimize(sc, cdddr(car_x))))
+ {
+ opc->v7.fd = opt_d_ddd_sff;
+ return(true);
+ }
+ }
+ pc_fallback(sc, start);
+ }
+ if ((float_optimize(sc, cdr(car_x))) &&
+ (float_optimize(sc, cddr(car_x))) &&
+ (float_optimize(sc, cdddr(car_x))))
+ {
+ opc->v7.fd = opt_d_ddd_fff;
+ return(true);
+ }
+ pc_fallback(sc, start);
}
- return(sc->F);
+ return(false);
}
-static bool stacktrace_find_let(s7_scheme *sc, int loc, s7_pointer e)
+/* -------- d_pid -------- */
+static s7_double opt_d_pid_ssf(void *p)
{
- return((loc > 0) &&
- ((stack_let(sc->stack, loc) == e) ||
- (stacktrace_find_let(sc, loc - 4, e))));
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v4.d_pid_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o1->v7.fd(o1)));
}
-static int stacktrace_find_error_hook_quit(s7_scheme *sc)
+static s7_double opt_d_pid_sss(void *p)
{
- int 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);
+ opt_info *o = (opt_info *)p;
+ return(o->v4.d_pid_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), real(slot_value(o->v3.p))));
}
-static bool stacktrace_in_error_handler(s7_scheme *sc, int loc)
+static s7_double opt_d_pid_sff(void *p)
{
- return((outlet(sc->owlet) == sc->envir) ||
- (stacktrace_find_let(sc, loc * 4, outlet(sc->owlet))) ||
- (stacktrace_find_error_hook_quit(sc) > 0));
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_int pos;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ pos = o1->v7.fi(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v4.d_pid_f(slot_value(o->v1.p), pos, o1->v7.fd(o1)));
}
+static s7_double opt_d_pid_sso(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v4.d_pid_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o->v5.d_v_f(o->v3.obj)));
+}
-static bool stacktrace_error_hook_function(s7_scheme *sc, s7_pointer sym)
+static s7_double opt_d_pid_ss_ss(void *p)
{
- if (is_symbol(sym))
+ opt_info *o = (opt_info *)p;
+ return(o->v4.d_pid_f(slot_value(o->v1.p),
+ integer(slot_value(o->v2.p)),
+ o->v3.d_pi_f(slot_value(o->v5.p),
+ integer(slot_value(o->v6.p)))));
+}
+
+static bool d_pid_ssf_combinable(s7_scheme *sc, opt_info *opc)
+{
+ if ((sc->pc > 1) &&
+ (opc == sc->opts[sc->pc - 2]))
{
- s7_pointer f;
- f = s7_symbol_value(sc, sym);
- return((is_procedure(f)) &&
- (is_procedure(sc->error_hook)) &&
- (hook_has_functions(sc->error_hook)) &&
- (direct_memq(f, s7_hook_functions(sc, sc->error_hook))));
+ opt_info *o1;
+ o1 = sc->opts[sc->pc - 1];
+ if (o1->v7.fd == opt_d_v)
+ {
+ opc->v6.p = o1->v1.p;
+ opc->v3.obj = o1->v5.obj;
+ opc->v5.d_v_f = o1->v3.d_v_f;
+ opc->v7.fd = opt_d_pid_sso;
+ sc->pc--;
+ return(true);
+ }
+ if (o1->v7.fd == opt_d_pi_ss)
+ {
+ opc->v3.d_pi_f = o1->v3.d_pi_f;
+ opc->v5.p = o1->v1.p;
+ opc->v6.p = o1->v2.p;
+ opc->v7.fd = opt_d_pid_ss_ss;
+ sc->pc--;
+ return(true);
+ }
}
return(false);
}
-static char *stacktrace_walker(s7_scheme *sc, s7_pointer code, s7_pointer e,
- char *notes, unsigned int gc_syms,
- int code_cols, int total_cols, int notes_start_col,
- bool as_comment)
+static bool opt_float_vector_set(s7_scheme *sc, opt_info *opc, s7_pointer v, s7_pointer indexp, s7_pointer valp)
{
- s7_pointer syms;
- syms = gc_protected_at(sc, gc_syms);
-
- if (is_symbol(code))
+ s7_pointer settee;
+ settee = find_symbol(sc, v);
+ if (is_slot(settee))
{
- if ((!direct_memq(code, syms)) &&
- (!is_slot(global_slot(code))))
+ opc->v1.p = settee;
+ if ((is_float_vector(slot_value(settee))) &&
+ (vector_rank(slot_value(settee)) == 1))
{
- s7_pointer val;
-
- syms = cons(sc, code, syms);
- gc_protected_at(sc, gc_syms) = syms;
-
- val = s7_symbol_local_value(sc, code, e);
- if ((val) && (val != sc->undefined) &&
- (!is_any_macro(val)))
+ opc->v4.d_pid_f = float_vector_set_d;
+ if (is_symbol(car(indexp)))
{
- int typ;
-
- typ = type(val);
- if (typ < T_GOTO)
+ s7_pointer slot;
+ slot = find_symbol(sc, car(indexp));
+ if ((is_slot(slot)) &&
+ (is_integer(slot_value(slot))))
{
- char *objstr, *str;
- const char *spaces;
- int objlen, new_note_len, notes_max, cur_line_len = 0, spaces_len;
- bool new_notes_line = false, old_short_print;
- s7_int old_len;
-
- spaces = " ";
- spaces_len = strlen(spaces);
-
- if (notes_start_col < 0) notes_start_col = 50;
- if (notes_start_col > total_cols) notes_start_col = 0;
- notes_max = total_cols - notes_start_col;
-
- old_short_print = sc->short_print;
- sc->short_print = true;
- old_len = sc->print_length;
- if (sc->print_length > 4) sc->print_length = 4;
- objstr = s7_object_to_c_string(sc, val);
- objlen = safe_strlen(objstr);
- if ((objlen > notes_max) &&
- (notes_max > 5))
+ opc->v2.p = slot;
+ if ((is_step_end(opc->v2.p)) &&
+ (denominator(slot_value(opc->v2.p)) <= vector_length(slot_value(settee))))
+ opc->v4.d_pid_f = float_vector_set_unchecked;
+ if (is_symbol(car(valp)))
{
- objstr[notes_max - 4] = '.';
- objstr[notes_max - 3] = '.';
- objstr[notes_max - 2] = '.';
- objstr[notes_max - 1] = '\0';
- objlen = notes_max;
+ s7_pointer val_slot;
+ val_slot = find_symbol(sc, car(valp));
+ if ((is_slot(val_slot)) &&
+ (is_float(slot_value(val_slot))))
+ {
+ opc->v3.p = val_slot;
+ opc->v7.fd = opt_d_pid_sss;
+ return(true);
+ }
}
- sc->short_print = old_short_print;
- sc->print_length = old_len;
+ if (float_optimize(sc, valp))
+ {
+ if (!d_pid_ssf_combinable(sc, opc))
+ opc->v7.fd = opt_d_pid_ssf;
+ return(true);
+ }
+ }
+ }
+ else
+ {
+ if ((int_optimize(sc, indexp)) &&
+ (float_optimize(sc, valp)))
+ {
+ opc->v7.fd = opt_d_pid_sff;
+ return(true);
+ }
+ }
+ }
+ }
+ return(false);
+}
- new_note_len = symbol_name_length(code) + 3 + objlen;
- /* we want to append this much info to the notes, but does it need a new line? */
- if (notes_start_col < code_cols)
- new_notes_line = true;
- else
+static bool d_pid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_d_pid_t f;
+ f = s7_d_pid_function(s_func);
+ if ((f) &&
+ (is_symbol(cadr(car_x))))
+ {
+ s7_pointer head;
+ int start;
+ start = sc->pc;
+
+ head = car(car_x);
+ opc->v4.d_pid_f = f;
+
+ if (head == sc->float_vector_set_symbol)
+ return(opt_float_vector_set(sc, opc, cadr(car_x), cddr(car_x), cdddr(car_x)));
+
+ opc->v1.p = find_symbol(sc, cadr(car_x));
+ if (is_slot(opc->v1.p))
+ {
+ if (is_symbol(caddr(car_x)))
+ {
+ opc->v2.p = find_symbol(sc, caddr(car_x));
+ if ((is_slot(opc->v2.p)) &&
+ (is_integer(slot_value(opc->v2.p))))
+ {
+ if (is_symbol(cadddr(car_x)))
{
- if (notes)
+ s7_pointer val_slot;
+ val_slot = find_symbol(sc, cadddr(car_x));
+ if ((is_slot(val_slot)) &&
+ (is_float(slot_value(val_slot))))
{
- char *last_newline;
- last_newline = strrchr(notes, (int)'\n'); /* returns ptr to end if none = nil if not found? */
- if (last_newline)
- cur_line_len = strlen(notes) - strlen(last_newline);
- else cur_line_len = strlen(notes);
- new_notes_line = ((cur_line_len + new_note_len) > notes_max);
+ opc->v3.p = val_slot;
+ opc->v7.fd = opt_d_pid_sss;
+ return(true);
}
}
-
- if (new_notes_line)
+ if (float_optimize(sc, cdddr(car_x)))
{
- new_note_len += (4 + notes_start_col + ((notes) ? strlen(notes) : 0));
- str = (char *)malloc(new_note_len * sizeof(char));
- snprintf(str, new_note_len, "%s\n%s%s%s%s: %s",
- (notes) ? notes : "",
- (as_comment) ? "; " : "",
- (spaces_len >= notes_start_col) ? (char *)(spaces + spaces_len - notes_start_col) : "",
- (as_comment) ? "" : " ; ",
- symbol_name(code),
- objstr);
+ if (!d_pid_ssf_combinable(sc, opc))
+ opc->v7.fd = opt_d_pid_ssf;
+ return(true);
}
- else
+ pc_fallback(sc, start);
+ }
+ }
+ else
+ {
+ if ((int_optimize(sc, cddr(car_x))) &&
+ (float_optimize(sc, cdddr(car_x))))
+ {
+ opc->v7.fd = opt_d_pid_sff;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ }
+ }
+ }
+ return(false);
+}
+
+/* -------- d_vid -------- */
+static s7_double opt_d_vid_ssf(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ /* PERHAPS: check index type as above */
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v4.d_vid_f(o->v5.obj, integer(slot_value(o->v2.p)), o1->v7.fd(o1)));
+}
+
+/* d_vid_ssf -> d_dd_ff_o1 -> d_vd_o1 -> d_dd_ff_o3 */
+static s7_double opt_fmv(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1, *o2, *o3;
+ s7_double amp_env, index_env, vib;
+
+ o1 = cur_sc->opts[++cur_sc->pc]; /* ff_o1 */
+ amp_env = o1->v2.d_v_f(o1->v1.obj);
+ o2 = cur_sc->opts[cur_sc->pc += 2];
+ cur_sc->pc += 2;
+ o3 = cur_sc->opts[cur_sc->pc];
+ index_env = o3->v5.d_v_f(o3->v1.obj);
+ vib = real(slot_value(o2->v2.p));
+ /* increment pc? */
+
+ return(o->v4.d_vid_f(o->v5.obj,
+ integer(slot_value(o->v2.p)),
+ o1->v3.d_dd_f(amp_env,
+ o2->v3.d_vd_f(o2->v5.obj,
+ o2->v4.d_dd_f(vib,
+ o3->v4.d_dd_f(index_env,
+ o3->v6.d_vd_f(o3->v2.obj, vib)))))));
+}
+
+static bool d_vid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ if ((is_symbol(cadr(car_x))) &&
+ (is_symbol(caddr(car_x))))
+ {
+ s7_d_vid_t flt;
+ flt = s7_d_vid_function(s_func);
+ if (flt)
+ {
+ s7_pointer sig;
+ opc->v4.d_vid_f = flt;
+ sig = s7_procedure_signature(sc, s_func);
+ if (is_pair(sig))
+ {
+ int start;
+ s7_pointer slot, obj, checker;
+ start = sc->pc;
+ checker = s7_symbol_value(sc, cadr(sig));
+ slot = find_symbol(sc, cadr(car_x));
+ obj = slot_value(slot);
+ if (s7_apply_function(sc, checker, set_plist_1(sc, obj)) == sc->T)
+ {
+ opc->v7.fd = opt_d_vid_ssf;
+ opc->v1.p = slot;
+ opc->v5.obj = (void *)s7_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))) &&
+ (float_optimize(sc, cdddr(car_x))))
{
- new_note_len += ((notes) ? strlen(notes) : 0) + 4;
- str = (char *)malloc(new_note_len * sizeof(char));
- snprintf(str, new_note_len, "%s%s%s: %s",
- (notes) ? notes : "",
- (notes) ? ", " : " ; ",
- symbol_name(code),
- objstr);
+ opt_info *o1;
+ o1 = sc->opts[start];
+ if (o1->v7.fd == opt_d_dd_ff_o1)
+ {
+ o1 = sc->opts[start + 2];
+ if (o1->v7.fd == opt_d_vd_o1)
+ {
+ o1 = sc->opts[start + 4];
+ if (o1->v7.fd == opt_d_dd_ff_o3)
+ opc->v7.fd = opt_fmv;
+ }
+ }
+ return(true);
}
- free(objstr);
- if (notes) free(notes);
- return(str);
}
+ pc_fallback(sc, start);
}
}
- return(notes);
}
- if (is_pair(code))
+ return(false);
+}
+
+/* -------- d_vdd -------- */
+static s7_double opt_d_vdd_ff(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1, *o2;
+ s7_double x1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ x1 = o1->v7.fd(o1);
+ o2 = cur_sc->opts[++cur_sc->pc];
+ return(o->v4.d_vdd_f(o->v5.obj, x1, o2->v7.fd(o2)));
+}
+
+static bool d_vdd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_d_vdd_t flt;
+ flt = s7_d_vdd_function(s_func);
+ if (flt)
{
- notes = stacktrace_walker(sc, car(code), e, notes, gc_syms, code_cols, total_cols, notes_start_col, as_comment);
- return(stacktrace_walker(sc, cdr(code), e, notes, gc_syms, code_cols, total_cols, notes_start_col, as_comment));
+ s7_pointer sig;
+ opc->v4.d_vdd_f = flt;
+ sig = s7_procedure_signature(sc, s_func);
+ if (is_pair(sig))
+ {
+ s7_pointer slot, obj, checker;
+ checker = s7_symbol_value(sc, cadr(sig));
+ slot = find_symbol(sc, cadr(car_x));
+ obj = slot_value(slot);
+ if (s7_apply_function(sc, checker, set_plist_1(sc, obj)) == sc->T)
+ {
+ int start;
+ start = sc->pc;
+ if ((float_optimize(sc, cddr(car_x))) &&
+ (float_optimize(sc, cdddr(car_x))))
+ {
+ opc->v1.p = slot;
+ opc->v5.obj = (void *)s7_object_value(obj);
+ opc->v7.fd = opt_d_vdd_ff;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ }
+ }
}
- return(notes);
+ return(false);
}
-static char *stacktrace_add_func(s7_scheme *sc, s7_pointer f, s7_pointer code, char *errstr, char *notes, int code_max, bool as_comment)
+
+/* -------- d_dddd -------- */
+static s7_double opt_d_dddd_ffff(void *p)
{
- int newlen, errlen;
- char *newstr, *str;
+ opt_info *o = (opt_info *)p;
+ opt_info *o1, *o2, *o3, *o4;
+ s7_double x1, x2, x3;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ x1 = o1->v7.fd(o1);
+ o2 = cur_sc->opts[++cur_sc->pc];
+ x2 = o2->v7.fd(o2);
+ o3 = cur_sc->opts[++cur_sc->pc];
+ x3 = o3->v7.fd(o3);
+ o4 = cur_sc->opts[++cur_sc->pc];
+ return(o->v1.d_dddd_f(x1, x2, x3, o4->v7.fd(o4)));
+}
- errlen = strlen(errstr);
- if ((is_symbol(f)) &&
- (f != car(code)))
- {
- newlen = symbol_name_length(f) + errlen + 10;
- newstr = (char *)malloc(newlen * sizeof(char));
- errlen = snprintf(newstr, newlen, "%s: %s", symbol_name(f), errstr);
- }
- else
+static bool d_dddd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_d_dddd_t f;
+ f = s7_d_dddd_function(s_func);
+ if (f)
{
- newlen = errlen + 8;
- newstr = (char *)malloc(newlen * sizeof(char));
- if ((errlen > 2) && (errstr[2] == '('))
- errlen = snprintf(newstr, newlen, " %s", errstr);
- else errlen = snprintf(newstr, newlen, "%s", errstr);
+ if ((float_optimize(sc, cdr(car_x))) &&
+ (float_optimize(sc, cddr(car_x))) &&
+ (float_optimize(sc, cdddr(car_x))) &&
+ (float_optimize(sc, cddddr(car_x))))
+ {
+ opc->v1.d_dddd_f = f;
+ opc->v7.fd = opt_d_dddd_ffff;
+ return(true);
+ }
}
+ return(false);
+}
- newlen = code_max + 8 + ((notes) ? strlen(notes) : 0);
- str = (char *)malloc(newlen * sizeof(char));
-
- if (errlen >= code_max)
+/* -------- d_add|multiply|subtract_any ------- */
+static s7_double opt_d_add_any_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ s7_double sum = 0.0;
+ int i;
+ for (i = 0; i < o->v1.i; i++)
{
- newstr[code_max - 4] = '.';
- newstr[code_max - 3] = '.';
- newstr[code_max - 2] = '.';
- newstr[code_max - 1] = '\0';
- snprintf(str, newlen, "%s%s%s\n", (as_comment) ? "; " : "", newstr, (notes) ? notes : "");
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ sum += o1->v7.fd(o1);
}
- else
+ return(sum);
+}
+
+static s7_double opt_d_subtract_any_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_double sum;
+ int i;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ sum = o1->v7.fd(o1);
+ for (i = 1; i < o->v1.i; i++)
{
- /* send out newstr, pad with spaces to code_max, then notes */
- int len;
- len = snprintf(str, newlen, "%s%s", (as_comment) ? "; " : "", newstr);
- if (notes)
- {
- int i;
- for (i = len; i < code_max - 1; i++)
- str[i] = ' ';
- str[i] = '\0';
-#ifdef __OpenBSD__
- strlcat(str, notes, newlen);
- strlcat(str, "\n", newlen);
-#else
- strcat(str, notes);
- strcat(str, "\n");
-#endif
- }
+ o1 = cur_sc->opts[++cur_sc->pc];
+ sum -= o1->v7.fd(o1);
}
- free(newstr);
- return(str);
+ return(sum);
}
+static s7_double opt_d_add2(void *p)
+{
+ s7_double sum;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ sum = o1->v7.fd(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(sum + o1->v7.fd(o1));
+}
-static char *stacktrace_1(s7_scheme *sc, int frames_max, int code_cols, int total_cols, int notes_start_col, bool as_comment)
+static s7_double opt_d_mul2(void *p)
{
- char *str;
- int loc, top, frames = 0;
- unsigned int gc_syms;
+ s7_double sum;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ sum = o1->v7.fd(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(sum * o1->v7.fd(o1));
+}
- gc_syms = s7_gc_protect(sc, sc->nil);
- str = NULL;
- top = (sc->stack_end - sc->stack_start) / 4; /* (*s7* 'stack_top), not s7_stack_top! */
+static s7_double opt_d_multiply_any_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ s7_double sum = 1.0;
+ int i;
+ for (i = 0; i < o->v1.i; i++)
+ {
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ sum *= o1->v7.fd(o1);
+ }
+ return(sum);
+}
- if (stacktrace_in_error_handler(sc, top))
+static bool d_add_any_ok(s7_scheme *sc, opt_info *opc, s7_pointer car_x, int len)
+{
+ s7_pointer head;
+ int start;
+ start = sc->pc;
+ head = car(car_x);
+ if ((head == sc->add_symbol) ||
+ (head == sc->multiply_symbol))
{
- s7_pointer err_code;
- err_code = slot_value(sc->error_code);
- if (is_pair(err_code))
+ s7_pointer p;
+ int cur_len = 0;
+ for (p = cdr(car_x); is_pair(p); p = cdr(p))
{
- char *errstr, *notes = NULL;
- s7_pointer cur_env, f;
-
- errstr = s7_object_to_c_string(sc, err_code);
- cur_env = outlet(sc->owlet);
- f = stacktrace_find_caller(sc, cur_env); /* this is a symbol */
- if ((is_let(cur_env)) &&
- (cur_env != sc->rootlet))
- notes = stacktrace_walker(sc, err_code, cur_env, NULL, gc_syms, code_cols, total_cols, notes_start_col, as_comment);
- str = stacktrace_add_func(sc, f, err_code, errstr, notes, code_cols, as_comment);
- free(errstr);
+ if (is_pair(cdr(p)))
+ {
+ if (!float_optimize(sc, set_plist_1(sc, set_elist_3(sc, head, car(p), cadr(p)))))
+ break;
+ cur_len++;
+ p = cdr(p);
+ }
+ else
+ {
+ if (!float_optimize(sc, p))
+ break;
+ cur_len++;
+ }
+ }
+ if (is_null(p))
+ {
+ opc->v1.i = cur_len;
+ if (cur_len == 2)
+ opc->v7.fd = (head == sc->add_symbol) ? opt_d_add2 :opt_d_mul2;
+ else opc->v7.fd = (head == sc->add_symbol) ? opt_d_add_any_f : opt_d_multiply_any_f;
+ return(true);
}
-
- /* now if OP_ERROR_HOOK_QUIT is in the stack, jump past it!
- */
- loc = stacktrace_find_error_hook_quit(sc);
- if (loc > 0) top = (loc + 1) / 4;
}
-
- for (loc = top - 1; loc > 0; loc--)
+ else
{
- s7_pointer code;
- int true_loc;
-
- true_loc = (int)(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))
+ if (head == sc->subtract_symbol)
{
- char *codestr;
- codestr = s7_object_to_c_string(sc, code);
- if (codestr)
+ s7_pointer p;
+ opc->v1.i = (len - 1);
+ for (p = cdr(car_x); is_pair(p); p = cdr(p))
+ if (!float_optimize(sc, p))
+ break;
+ if (is_null(p))
{
- if ((!local_strcmp(codestr, "(result)")) &&
- (!local_strcmp(codestr, "(#f)")) &&
- (!strstr(codestr, "(stacktrace)")) &&
- (!strstr(codestr, "(stacktrace ")))
- {
- s7_pointer e, f;
-
- e = stack_let(sc->stack, true_loc);
- f = stacktrace_find_caller(sc, e);
- if (!stacktrace_error_hook_function(sc, f))
- {
- char *notes = NULL, *newstr;
- int newlen;
-
- frames++;
- if (frames > frames_max)
- {
- free(codestr);
- s7_gc_unprotect_at(sc, gc_syms);
- return(str);
- }
-
- if ((is_let(e)) && (e != sc->rootlet))
- notes = stacktrace_walker(sc, code, e, NULL, gc_syms, code_cols, total_cols, notes_start_col, as_comment);
- newstr = stacktrace_add_func(sc, f, code, codestr, notes, code_cols, as_comment);
- free(codestr);
- if ((notes) && (notes != newstr) && (is_let(e)) && (e != sc->rootlet)) free(notes); /* double free somehow?? */
-
- newlen = strlen(newstr) + 1 + ((str) ? strlen(str) : 0);
- codestr = (char *)malloc(newlen * sizeof(char));
- snprintf(codestr, newlen, "%s%s", (str) ? str : "", newstr);
- if (str) free(str);
- free(newstr);
- str = codestr;
- codestr = NULL;
- }
- else free(codestr);
- }
- else free(codestr);
+ opc->v7.fd = opt_d_subtract_any_f;
+ return(true);
}
}
}
-
- s7_gc_unprotect_at(sc, gc_syms);
- return(str);
+ pc_fallback(sc, start);
+ return(false);
}
-
-s7_pointer s7_stacktrace(s7_scheme *sc)
+/* -------- float_all_x -------- */
+static s7_double opt_unwrap_float(void *p)
{
- char *str;
- str = stacktrace_1(sc, 30, 45, 80, 45, false);
- return(make_string_uncopied_with_length(sc, str, safe_strlen(str)));
+ opt_info *o = (opt_info *)p;
+ return(s7_number_to_real(cur_sc, o->v2.all_f(cur_sc, car(o->v1.p))));
}
-
-static s7_pointer g_stacktrace(s7_scheme *sc, s7_pointer args)
+static bool float_all_x_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer expr)
{
- #define H_stacktrace "(stacktrace (max-frames 30) (code-cols 50) (total-cols 80) (note-col 50) as-comment) returns \
-a stacktrace as a string. Each line has two portions, the code being evaluated and a note giving \
-the value of local variables in that code. The first argument sets how many lines are displayed. \
-The next three arguments set the length and layout of those lines. 'as-comment' if #t causes each \
-line to be preceded by a semicolon."
- #define Q_stacktrace s7_make_signature(sc, 6, sc->is_string_symbol, sc->is_integer_symbol, sc->is_integer_symbol, sc->is_integer_symbol, sc->is_integer_symbol, sc->is_boolean_symbol)
+ s7_pointer sig;
+ s7_function opt;
+ sig = s7_procedure_signature(sc, s_func);
+ if ((is_pair(sig)) &&
+ ((car(sig) == sc->is_float_symbol) ||
+ (car(sig) == sc->is_real_symbol)))
+ {
+ /* fallback on the more general case (all_x_eval, but still guaranteed to be a number) */
+ opt = all_x_optimize(sc, expr);
+ if (opt)
+ {
+ opc->v2.all_f = opt;
+ opc->v7.fd = opt_unwrap_float;
+ opc->v1.p = expr;
+ return(true);
+ }
+ }
+ return(false);
+}
- s7_int max_frames = 30, code_cols = 50, total_cols = 80, notes_start_col = 50;
- bool as_comment = false;
- char *str;
+/* -------- d_syntax -------- */
+static s7_double opt_set_d_d_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_double x;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ x = o1->v7.fd(o1);
+ if (is_mutable(slot_value(o->v1.p)))
+ real(slot_value(o->v1.p)) = x;
+ else slot_set_value(o->v1.p, make_real(cur_sc, x));
+ return(x);
+}
- if (!is_null(args))
+static bool d_syntax_ok(s7_scheme *sc, s7_pointer car_x, int len)
+{
+ if ((len == 3) &&
+ (car(car_x) == sc->set_symbol))
{
- if (s7_is_integer(car(args)))
+ opt_info *opc;
+ opc = alloc_opo(sc, car_x);
+ if (is_symbol(cadr(car_x)))
{
- max_frames = s7_integer(car(args));
- if ((max_frames <= 0) || (max_frames > s7_int32_max))
- max_frames = 30;
- args = cdr(args);
- if (!is_null(args))
+ s7_pointer settee;
+ if ((is_immutable(cadr(car_x))) ||
+ (symbol_has_accessor(cadr(car_x))))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ settee = find_symbol(sc, cadr(car_x));
+ if (is_slot(settee))
{
- if (s7_is_integer(car(args)))
+ opc->v1.p = settee;
+ if ((is_t_real(slot_value(settee))) &&
+ (float_optimize(sc, cddr(car_x))))
{
- code_cols = s7_integer(car(args));
- if ((code_cols <= 8) || (code_cols > s7_int32_max))
- code_cols = 50;
- args = cdr(args);
- if (!is_null(args))
- {
- if (s7_is_integer(car(args)))
- {
- total_cols = s7_integer(car(args));
- if ((total_cols <= code_cols) || (total_cols > s7_int32_max))
- total_cols = 80;
- args = cdr(args);
- if (!is_null(args))
- {
- if (s7_is_integer(car(args)))
- {
- notes_start_col = s7_integer(car(args));
- if ((notes_start_col <= 0) || (notes_start_col > s7_int32_max))
- notes_start_col = 50;
- args = cdr(args);
- if (!is_null(args))
- {
- if (s7_is_boolean(car(args)))
- as_comment = s7_boolean(sc, car(args));
- else return(wrong_type_argument(sc, sc->stacktrace_symbol, 5, car(args), T_BOOLEAN));
- }
- }
- else return(wrong_type_argument(sc, sc->stacktrace_symbol, 4, car(args), T_INTEGER));
- }
- }
- else return(wrong_type_argument(sc, sc->stacktrace_symbol, 3, car(args), T_INTEGER));
- }
+ opc->v7.fd = opt_set_d_d_f;
+ return(true);
}
- else return(wrong_type_argument(sc, sc->stacktrace_symbol, 2, car(args), T_INTEGER));
}
}
- else method_or_bust(sc, car(args), sc->stacktrace_symbol, args, T_INTEGER, 1);
+ else
+ {
+ /* if is_pair(settee) get setter */
+ if ((is_pair(cadr(car_x))) &&
+ (is_symbol(caadr(car_x))) &&
+ (is_pair(cdadr(car_x))) &&
+ (is_null(cddadr(car_x))))
+ return(opt_float_vector_set(sc, opc, caadr(car_x), cdadr(car_x), cddr(car_x)));
+ }
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
+}
+
+static bool d_implicit_ok(s7_scheme *sc, s7_pointer car_x, int len)
+{
+ s7_pointer s_slot;
+ s_slot = find_symbol(sc, car(car_x));
+ if ((is_slot(s_slot)) &&
+ (len == 2) &&
+ (is_float_vector(slot_value(s_slot))) &&
+ (vector_rank(slot_value(s_slot)) == 1))
+ {
+ /* implicit float-vector-ref */
+ opt_info *opc;
+ opc = alloc_opo(sc, car_x);
+ opc->v1.p = s_slot;
+ if (is_symbol(cadr(car_x)))
+ {
+ s7_pointer slot;
+ slot = find_symbol(sc, cadr(car_x));
+ if ((is_slot(slot)) &&
+ (is_integer(slot_value(slot))))
+ {
+ opc->v7.fd = opt_d_pi_ss;
+ opc->v3.d_pi_f = float_vector_ref_d;
+ opc->v2.p = slot;
+ if ((is_step_end(opc->v2.p)) &&
+ (denominator(slot_value(opc->v2.p)) <= vector_length(slot_value(opc->v1.p))))
+ opc->v3.d_pi_f = float_vector_ref_unchecked;
+ return(true);
+ }
+ }
+ else
+ {
+ if (int_optimize(sc, cdr(car_x)))
+ {
+ opc->v7.fd = opt_d_pi_sf;
+ opc->v3.d_pi_f = float_vector_ref_d;
+ }
+ }
}
- str = stacktrace_1(sc, (int)max_frames, (int)code_cols, (int)total_cols, (int)notes_start_col, as_comment);
- return(make_string_uncopied_with_length(sc, str, safe_strlen(str)));
+ return(return_false(sc, car_x, __func__, __LINE__));
}
+/* -------------------------------- bool opts -------------------------------- */
+static bool opt_b_t(void *p)
+{
+ return(true);
+}
-/* -------- error handlers -------- */
+static bool opt_b_f(void *p)
+{
+ return(false);
+}
-static const char *make_type_name(s7_scheme *sc, const char *name, int article)
+static bool opt_b_s(void *p)
{
- int i, slen, len;
+ opt_info *o = (opt_info *)p;
+ return(slot_value(o->v1.p) != cur_sc->F);
+}
- slen = safe_strlen(name);
- len = slen + 8;
- if (len > sc->typnam_len)
+static bool opt_bool_not_pair(s7_scheme *sc, s7_pointer car_x)
+{
+ opt_info *opc;
+ s7_pointer p;
+ if (!is_symbol(car_x))
{
- if (sc->typnam) free(sc->typnam);
- sc->typnam = (char *)malloc(len * sizeof(char));
- sc->typnam_len = len;
+ if (!s7_is_boolean(car_x))
+ return(return_false(sc, car_x, __func__, __LINE__)); /* i.e. use cell_optimize */
+ opc = alloc_opo(sc, car_x);
+ opc->v7.fb = ((car_x == sc->F) ? opt_b_f : opt_b_t);
+ return(true);
}
- if (article == INDEFINITE_ARTICLE)
+ p = find_symbol(sc, car_x);
+ if (is_slot(p))
{
- i = 1;
- sc->typnam[0] = 'a';
- if ((name[0] == 'a') || (name[0] == 'e') || (name[0] == 'i') || (name[0] == 'o') || (name[0] == 'u'))
- sc->typnam[i++] = 'n';
- sc->typnam[i++] = ' ';
+ if ((has_methods(slot_value(p))) ||
+ (!s7_is_boolean(slot_value(p))))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc = alloc_opo(sc, car_x);
+ opc->v1.p = p;
+ opc->v7.fb = opt_b_s;
+ return(true);
}
- else i = 0;
- memcpy((void *)(sc->typnam + i), (void *)name, slen);
- sc->typnam[i + slen] = '\0';
- return(sc->typnam);
+ return(return_false(sc, car_x, __func__, __LINE__));
}
-
-static const char *type_name_from_type(s7_scheme *sc, int typ, int article)
+/* -------- b_idp -------- */
+static bool opt_b_i_s(void *p)
{
- static const char *frees[2] = {"free cell", "a free cell"};
- static const char *nils[2] = {"nil", "nil"};
- static const char *uniques[2] = {"untyped", "untyped"};
- static const char *booleans[2] = {"boolean", "boolean"};
- static const char *strings[2] = {"string", "a string"};
- static const char *symbols[2] = {"symbol", "a symbol"};
- static const char *syntaxes[2] = {"syntax", "syntactic"};
- static const char *pairs[2] = {"pair", "a pair"};
- static const char *gotos[2] = {"goto", "a goto (from call-with-exit)"};
- static const char *continuations[2] = {"continuation", "a continuation"};
- static const char *c_functions[2] = {"c-function", "a c-function"};
- static const char *macros[2] = {"macro", "a macro"};
- static const char *c_macros[2] = {"c-macro", "a c-macro"};
- static const char *bacros[2] = {"bacro", "a bacro"};
- static const char *vectors[2] = {"vector", "a vector"};
- static const char *int_vectors[2] = {"int-vector", "an int-vector"};
- static const char *float_vectors[2] = {"float-vector", "a float-vector"};
- static const char *c_pointers[2] = {"C pointer", "a raw C pointer"};
- static const char *counters[2] = {"internal counter", "an internal counter"};
- static const char *baffles[2] = {"baffle", "a baffle"};
- static const char *slots[2] = {"slot", "a slot (variable binding)"};
- static const char *characters[2] = {"character", "a character"};
- static const char *catches[2] = {"catch", "a catch"};
- static const char *dynamic_winds[2] = {"dynamic-wind", "a dynamic-wind"};
- static const char *hash_tables[2] = {"hash-table", "a hash-table"};
- static const char *iterators[2] = {"iterator", "an iterator"};
- static const char *environments[2] = {"environment", "an environment"};
- static const char *integers[2] = {"integer", "an integer"};
- static const char *big_integers[2] = {"big integer", "a big integer"};
- static const char *ratios[2] = {"ratio", "a ratio"};
- static const char *big_ratios[2] = {"big ratio", "a big ratio"};
- static const char *reals[2] = {"real", "a real"};
- static const char *big_reals[2] = {"big real", "a big real"};
- static const char *complexes[2] = {"complex number", "a complex number"};
- static const char *big_complexes[2] = {"big complex number", "a big complex number"};
- static const char *functions[2] = {"function", "a function"};
- static const char *function_stars[2] = {"function*", "a function*"};
- static const char *rngs[2] = {"random-state", "a random-state"};
+ opt_info *o = (opt_info *)p;
+ return(o->v2.b_i_f(integer(slot_value(o->v1.p))));
+}
- switch (typ)
- {
- case T_FREE: return(frees[article]);
- case T_NIL: return(nils[article]);
- case T_UNIQUE: return(uniques[article]);
- case T_UNSPECIFIED: return(uniques[article]);
- case T_BOOLEAN: return(booleans[article]);
- case T_STRING: return(strings[article]);
- case T_SYMBOL: return(symbols[article]);
- case T_SYNTAX: return(syntaxes[article]);
- case T_PAIR: return(pairs[article]);
- case T_GOTO: return(gotos[article]);
- case T_CONTINUATION: return(continuations[article]);
- case T_C_OPT_ARGS_FUNCTION:
- case T_C_RST_ARGS_FUNCTION:
- case T_C_ANY_ARGS_FUNCTION:
- case T_C_FUNCTION_STAR:
- case T_C_FUNCTION: return(c_functions[article]);
- case T_CLOSURE: return(functions[article]);
- case T_CLOSURE_STAR: return(function_stars[article]);
- case T_C_MACRO: return(c_macros[article]);
- case T_C_POINTER: return(c_pointers[article]);
- case T_CHARACTER: return(characters[article]);
- case T_VECTOR: return(vectors[article]);
- case T_INT_VECTOR: return(int_vectors[article]);
- case T_FLOAT_VECTOR: return(float_vectors[article]);
- case T_MACRO_STAR:
- case T_MACRO: return(macros[article]);
- case T_BACRO_STAR:
- case T_BACRO: return(bacros[article]);
- case T_CATCH: return(catches[article]); /* are these 2 possible? */
- case T_DYNAMIC_WIND: return(dynamic_winds[article]);
- case T_HASH_TABLE: return(hash_tables[article]);
- case T_ITERATOR: return(iterators[article]);
- case T_LET: return(environments[article]);
- case T_COUNTER: return(counters[article]);
- case T_BAFFLE: return(baffles[article]);
- case T_RANDOM_STATE: return(rngs[article]);
- case T_SLOT: return(slots[article]);
- case T_INTEGER: return(integers[article]);
- case T_RATIO: return(ratios[article]);
- case T_REAL: return(reals[article]);
- case T_COMPLEX: return(complexes[article]);
- case T_BIG_INTEGER: return(big_integers[article]);
- case T_BIG_RATIO: return(big_ratios[article]);
- case T_BIG_REAL: return(big_reals[article]);
- case T_BIG_COMPLEX: return(big_complexes[article]);
- }
- return(NULL);
+static bool opt_b_i_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v2.b_i_f(o1->v7.fi(o1)));
}
+static bool opt_b_d_s(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v2.b_d_f(real(slot_value(o->v1.p))));
+}
-static const char *type_name(s7_scheme *sc, s7_pointer arg, int article)
+static bool opt_b_d_f(void *p)
{
- switch (unchecked_type(arg))
- {
- case T_C_OBJECT:
- return(make_type_name(sc, object_types[c_object_type(arg)]->name, article));
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v2.b_d_f(o1->v7.fd(o1)));
+}
- 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));
+static bool opt_b_p_s(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v2.b_p_f(slot_value(o->v1.p)));
+}
- case T_OUTPUT_PORT:
- return(make_type_name(sc, (is_file_port(arg)) ? "output file port" : ((is_string_port(arg)) ? "output string port" : "output port"), article));
+static bool opt_b_p_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v2.b_p_f(o1->v7.fp(o1)));
+}
- case T_LET:
- if (has_methods(arg))
+static bool b_idp_ok(s7_scheme *sc, s7_pointer s_func, s7_pointer car_x, s7_pointer arg_type)
+{
+ int cur_index;
+ s7_b_p_t bpf;
+ opt_info *opc;
+
+ opc = alloc_opo(sc, car_x);
+ cur_index = sc->pc;
+
+ if (arg_type == sc->is_integer_symbol)
+ {
+ s7_b_i_t bif;
+ bif = s7_b_i_function(s_func);
+ if (bif)
{
- s7_pointer class_name;
- class_name = find_method(sc, arg, sc->class_name_symbol);
- if (is_symbol(class_name))
- return(make_type_name(sc, symbol_name(class_name), article));
+ opc->v2.b_i_f = bif;
+ if (is_symbol(cadr(car_x)))
+ {
+ opc->v1.p = find_symbol(sc, cadr(car_x));
+ opc->v7.fb = opt_b_i_s;
+ return(true);
+ }
+ if (int_optimize(sc, cdr(car_x)))
+ {
+ opc->v7.fb = opt_b_i_f;
+ return(true);
+ }
}
-
- default:
- {
- const char *str;
- str = type_name_from_type(sc, unchecked_type(arg), article);
- if (str) return(str);
- }
}
- return("messed up object");
-}
-
-
-static s7_pointer prepackaged_type_name(s7_scheme *sc, s7_pointer x)
-{
- s7_pointer p;
-
- if (has_methods(x))
+ else
{
- p = find_method(sc, find_let(sc, x), sc->class_name_symbol);
- if (is_symbol(p))
- return(symbol_name_cell(p));
+ if (arg_type == sc->is_float_symbol)
+ {
+ s7_b_d_t bdf;
+ bdf = s7_b_d_function(s_func);
+ if (bdf)
+ {
+ opc->v2.b_d_f = bdf;
+ if (is_symbol(cadr(car_x)))
+ {
+ opc->v1.p = find_symbol(sc, cadr(car_x));
+ opc->v7.fb = opt_b_d_s;
+ return(true);
+ }
+ if (float_optimize(sc, cdr(car_x)))
+ {
+ opc->v7.fb = opt_b_d_f;
+ return(true);
+ }
+ }
+ }
}
-
- p = prepackaged_type_names[type(x)];
- if (is_string(p)) return(p);
-
- switch (type(x))
+ pc_fallback(sc, cur_index);
+
+ bpf = s7_b_p_function(s_func);
+ if (bpf)
{
- case T_C_OBJECT: return(c_object_scheme_name(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));
+ opc->v2.b_p_f = bpf;
+ if (is_symbol(cadr(car_x)))
+ {
+ s7_pointer p;
+ p = find_symbol(sc, cadr(car_x));
+ if ((!is_slot(p)) ||
+ (has_methods(slot_value(p))))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc->v1.p = p;
+ opc->v7.fb = opt_b_p_s;
+ return(true);
+ }
+ if (cell_optimize(sc, cdr(car_x)))
+ {
+ opc->v7.fb = opt_b_p_f;
+ return(true);
+ }
}
- return(make_string_wrapper(sc, "unknown type!"));
+ return(false);
}
-static s7_pointer type_name_string(s7_scheme *sc, s7_pointer arg)
+
+/* -------- b_pp -------- */
+static bool opt_b_pp_ff(void *p)
{
- if (type(arg) < NUM_TYPES)
- {
- s7_pointer p;
- p = prepackaged_type_names[type(arg)]; /* these use INDEFINITE_ARTICLE */
- if (is_string(p)) return(p);
- }
- return(make_string_wrapper(sc, type_name(sc, arg, INDEFINITE_ARTICLE)));
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_pointer p1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ p1 = o1->v7.fp(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.b_pp_f(p1, o1->v7.fp(o1)));
}
-
-static s7_pointer wrong_type_arg_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg_n, s7_pointer arg, s7_pointer typnam, s7_pointer descr)
+static bool opt_b_pp_sf(void *p)
{
- s7_pointer p;
- p = cdr(sc->wrong_type_arg_info); /* info list is '(format_string caller arg_n arg type_name descr) */
- set_car(p, caller); p = cdr(p);
- set_car(p, arg_n); p = cdr(p);
- set_car(p, arg); p = cdr(p);
- set_car(p, (typnam == sc->gc_nil) ? prepackaged_type_name(sc, arg) : typnam);
- p = cdr(p);
- set_car(p, descr);
- return(s7_error(sc, sc->wrong_type_arg_symbol, sc->wrong_type_arg_info));
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.b_pp_f(slot_value(o->v1.p), o1->v7.fp(o1)));
}
+static bool opt_b_pp_fs(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.b_pp_f(o1->v7.fp(o1), slot_value(o->v1.p)));
+}
-static s7_pointer simple_wrong_type_arg_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg, s7_pointer typnam, s7_pointer descr)
+static bool opt_b_pp_ss(void *p)
{
- set_wlist_4(sc, cdr(sc->simple_wrong_type_arg_info), caller, arg, (typnam == sc->gc_nil) ? prepackaged_type_name(sc, arg) : typnam, descr);
- return(s7_error(sc, sc->wrong_type_arg_symbol, sc->simple_wrong_type_arg_info));
+ opt_info *o = (opt_info *)p;
+ return(o->v3.b_pp_f(slot_value(o->v1.p), slot_value(o->v2.p)));
}
+static bool opt_b_pp_sc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.b_pp_f(slot_value(o->v1.p), o->v2.p));
+}
-s7_pointer s7_wrong_type_arg_error(s7_scheme *sc, const char *caller, int arg_n, s7_pointer arg, const char *descr)
+static bool opt_b_pp_sfo(void *p)
{
- /* info list is '(format_string caller arg_n arg type_name descr) */
- if (arg_n < 0) arg_n = 0;
- if (arg_n > 0)
- return(wrong_type_arg_error_prepackaged(sc, make_string_wrapper(sc, caller),
- make_integer(sc, arg_n), arg, type_name_string(sc, arg),
- make_string_wrapper(sc, descr)));
- return(simple_wrong_type_arg_error_prepackaged(sc, make_string_wrapper(sc, caller),
- arg, type_name_string(sc, arg),
- make_string_wrapper(sc, descr)));
+ opt_info *o = (opt_info *)p;
+ return(o->v3.b_pp_f(slot_value(o->v1.p), o->v4.p_p_f(slot_value(o->v2.p))));
}
+static s7_pointer opt_p_p_s(void *p); /* TODO: remove this when p* precedes b* */
-static s7_pointer out_of_range_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg_n, s7_pointer arg, s7_pointer descr)
+static bool b_pp_sf_combinable(s7_scheme *sc, opt_info *opc)
{
- /* info list is '(format_string caller arg_n arg descr) */
- set_wlist_4(sc, cdr(sc->out_of_range_info), caller, arg_n, arg, descr);
- return(s7_error(sc, sc->out_of_range_symbol, sc->out_of_range_info));
+ if ((sc->pc > 1) &&
+ (opc == sc->opts[sc->pc - 2]))
+ {
+ opt_info *o1;
+ o1 = sc->opts[sc->pc - 1];
+ if (o1->v7.fp == opt_p_p_s)
+ {
+ opc->v2.p = o1->v1.p;
+ opc->v4.p_p_f = o1->v2.p_p_f;
+ opc->v7.fb = opt_b_pp_sfo;
+ sc->pc--;
+ return(true);
+ }
+ }
+ return(false);
}
+static bool opt_b_pp_ffo(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ s7_pointer b1;
+ b1 = o->v4.p_p_f(slot_value(o->v1.p));
+ return(o->v3.b_pp_f(b1, o->v5.p_p_f(slot_value(o->v2.p))));
+}
-static s7_pointer simple_out_of_range_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg, s7_pointer descr)
+static bool b_pp_ff_combinable(s7_scheme *sc, opt_info *opc)
{
- set_wlist_3(sc, cdr(sc->simple_out_of_range_info), caller, arg, descr);
- return(s7_error(sc, sc->out_of_range_symbol, sc->simple_out_of_range_info));
+ if ((sc->pc > 2) &&
+ (opc == sc->opts[sc->pc - 3]))
+ {
+ opt_info *o1, *o2;
+ o1 = sc->opts[sc->pc - 2];
+ o2 = sc->opts[sc->pc - 1];
+ if ((o1->v7.fp == opt_p_p_s) &&
+ (o2->v7.fp == opt_p_p_s))
+ {
+ opc->v1.p = o1->v1.p;
+ opc->v4.p_p_f = o1->v2.p_p_f;
+ opc->v2.p = o2->v1.p;
+ opc->v5.p_p_f = o2->v2.p_p_f;
+ opc->v7.fb = opt_b_pp_ffo;
+ sc->pc -= 2;
+ return(true);
+ }
+ }
+ return(false);
+}
+
+static bool b_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, s7_pointer arg1, s7_pointer arg2)
+{
+ if ((is_symbol(arg1)) &&
+ (is_symbol(arg2)))
+ {
+ opc->v1.p = find_symbol(sc, arg1);
+ opc->v2.p = find_symbol(sc, arg2);
+ if ((is_slot(opc->v1.p)) &&
+ (!has_methods(slot_value(opc->v1.p))) &&
+ (is_slot(opc->v2.p)) &&
+ (!has_methods(slot_value(opc->v2.p))))
+ {
+ opc->v7.fb = opt_b_pp_ss;
+ return(true);
+ }
+ }
+ if (is_symbol(arg1))
+ {
+ opc->v1.p = find_symbol(sc, arg1);
+ if ((!is_slot(opc->v1.p)) ||
+ (has_methods(slot_value(opc->v1.p))))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ if ((!is_symbol(arg2)) &&
+ (!is_pair(arg2)))
+ {
+ opc->v2.p = arg2;
+ opc->v7.fb = opt_b_pp_sc;
+ return(true);
+ }
+ if (cell_optimize(sc, cddr(car_x)))
+ {
+ if (!b_pp_sf_combinable(sc, opc))
+ opc->v7.fb = opt_b_pp_sf;
+ return(true);
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ if (is_symbol(arg2))
+ {
+ if (cell_optimize(sc, cdr(car_x)))
+ {
+ opc->v1.p = find_symbol(sc, arg2);
+ if ((!is_slot(opc->v1.p)) ||
+ (has_methods(slot_value(opc->v1.p))))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc->v7.fb = opt_b_pp_fs;
+ return(true);
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+
+ if ((cell_optimize(sc, cdr(car_x))) &&
+ (cell_optimize(sc, cddr(car_x))))
+ {
+ if (!b_pp_ff_combinable(sc, opc))
+ opc->v7.fb = opt_b_pp_ff;
+ if ((s7_b_pp_direct_function(s_func)) &&
+ (is_pair(cadr(car_x))) &&
+ (is_pair(caddr(car_x))) &&
+ (caadr(car_x) == caaddr(car_x)))
+ {
+ s7_pointer arg_slot, call_sig;
+ call_sig = s7_procedure_signature(sc, s_func);
+ arg_slot = find_symbol(sc, caadr(car_x));
+ if ((is_c_function(slot_value(arg_slot))) &&
+ (cadr(call_sig) == caddr(call_sig)))
+ {
+ s7_pointer arg_sig;
+ arg_sig = s7_procedure_signature(sc, slot_value(arg_slot));
+ if ((is_pair(arg_sig)) &&
+ (car(arg_sig) == cadr(call_sig)))
+ opc->v3.b_pp_f = s7_b_pp_direct_function(s_func);
+ }
+ }
+ return(true);
+ }
+ return(false);
}
-s7_pointer s7_out_of_range_error(s7_scheme *sc, const char *caller, int arg_n, s7_pointer arg, const char *descr)
+/* -------- b_pi -------- */
+static bool opt_b_pi_fs(void *p)
{
- /* info list is '(format_string caller arg_n arg descr) */
- if (arg_n < 0) arg_n = 0;
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v2.b_pi_f(o1->v7.fp(o1), integer(slot_value(o->v1.p))));
+}
- if (arg_n > 0)
- return(out_of_range_error_prepackaged(sc, make_string_wrapper(sc, caller), make_integer(sc, arg_n), arg, make_string_wrapper(sc, descr)));
- return(simple_out_of_range_error_prepackaged(sc, make_string_wrapper(sc, caller), arg, make_string_wrapper(sc, descr)));
+static bool b_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, s7_pointer arg2)
+{
+ s7_b_pi_t bpif;
+ bpif = s7_b_pi_function(s_func);
+ if (bpif)
+ {
+ opc->v1.p = find_symbol(sc, arg2); /* slot checked in opt_arg_type */
+ if (cell_optimize(sc, cdr(car_x)))
+ {
+ opc->v2.b_pi_f = bpif;
+ opc->v7.fb = opt_b_pi_fs;
+ return(true);
+ }
+ }
+ return(false);
}
-s7_pointer s7_wrong_number_of_args_error(s7_scheme *sc, const char *caller, s7_pointer args)
+/* -------- b_dd -------- */
+static bool opt_b_dd_ss(void *p)
{
- return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_2(sc, make_string_wrapper(sc, caller), args))); /* "caller" includes the format directives */
+ opt_info *o = (opt_info *)p;
+ return(o->v3.b_dd_f(real(slot_value(o->v1.p)), real(slot_value(o->v2.p))));
}
+static bool opt_b_dd_sc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.b_dd_f(real(slot_value(o->v1.p)), o->v2.x));
+}
-static s7_pointer division_by_zero_error(s7_scheme *sc, s7_pointer caller, s7_pointer arg)
+static bool opt_b_dd_sf(void *p)
{
- return(s7_error(sc, sc->division_by_zero_symbol, set_elist_3(sc, sc->division_by_zero_error_string, caller, arg)));
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.b_dd_f(real(slot_value(o->v1.p)), o1->v7.fd(o1)));
}
+static bool opt_b_dd_fs(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.b_dd_f(o1->v7.fd(o1), real(slot_value(o->v1.p))));
+}
-static s7_pointer file_error(s7_scheme *sc, const char *caller, const char *descr, const char *name)
+static bool opt_b_dd_fc(void *p)
{
- return(s7_error(sc, sc->io_error_symbol,
- set_elist_4(sc, make_string_wrapper(sc, "~A: ~A ~S"),
- make_string_wrapper(sc, caller),
- make_string_wrapper(sc, descr),
- make_string_wrapper(sc, name))));
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.b_dd_f(o1->v7.fd(o1), o->v1.x));
}
+static bool opt_b_dd_ff(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_double x1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ x1 = o1->v7.fd(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.b_dd_f(x1, o1->v7.fd(o1)));
+}
-static s7_pointer closure_or_f(s7_scheme *sc, s7_pointer p)
+static bool b_dd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, s7_pointer arg1, s7_pointer arg2)
{
- s7_pointer body;
- if (!is_closure(p)) return(p);
- body = closure_body(p);
- if (is_pair(cdr(body))) return(p);
- if (!is_pair(car(body))) return(sc->F);
- if (caar(body) == sc->quote_symbol) return(sc->F);
- return(p);
+ s7_b_dd_t bif;
+ int cur_index;
+ cur_index = sc->pc;
+ bif = s7_b_dd_function(s_func);
+ if (bif)
+ {
+ opc->v3.b_dd_f = bif;
+
+ if (is_symbol(arg1))
+ {
+ opc->v1.p = find_symbol(sc, arg1);
+ if (is_symbol(arg2))
+ {
+ opc->v2.p = find_symbol(sc, arg2);
+ opc->v7.fb = opt_b_dd_ss;
+ return(true);
+ }
+ if (is_real(arg2))
+ {
+ opc->v2.x = s7_number_to_real(cur_sc, arg2);
+ opc->v7.fb = opt_b_dd_sc;
+ return(true);
+ }
+ if (float_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fb = opt_b_dd_sf;
+ return(true);
+ }
+ }
+ pc_fallback(sc, cur_index);
+ if (float_optimize(sc, cdr(car_x)))
+ {
+ if (is_symbol(arg2))
+ {
+ opc->v1.p = find_symbol(sc, arg2);
+ opc->v7.fb = opt_b_dd_fs;
+ return(true);
+ }
+ if (is_real(arg2))
+ {
+ opc->v1.x = s7_number_to_real(cur_sc, arg2);
+ opc->v7.fb = opt_b_dd_fc;
+ return(true);
+ }
+ if (float_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fb = opt_b_dd_ff;
+ return(true);
+ }
+ }
+ }
+ pc_fallback(sc, cur_index);
+ return(false);
}
-static s7_pointer g_dynamic_wind(s7_scheme *sc, s7_pointer args)
+/* -------- b_ii -------- */
+static bool opt_b_ii_ss(void *p)
{
- #define H_dynamic_wind "(dynamic-wind init body finish) calls init, then body, then finish, \
-each a function of no arguments, guaranteeing that finish is called even if body is exited"
- #define Q_dynamic_wind s7_make_circular_signature(sc, 1, 2, sc->values_symbol, sc->is_procedure_symbol)
+ opt_info *o = (opt_info *)p;
+ return(o->v3.b_ii_f(integer(slot_value(o->v1.p)), integer(slot_value(o->v2.p))));
+}
- s7_pointer p;
+static bool opt_b_ii_sc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.b_ii_f(integer(slot_value(o->v1.p)), o->v2.i));
+}
- if (!is_thunk(sc, car(args)))
- method_or_bust_with_type(sc, car(args), sc->dynamic_wind_symbol, args, a_thunk_string, 1);
- if (!is_thunk(sc, cadr(args)))
- method_or_bust_with_type(sc, cadr(args), sc->dynamic_wind_symbol, args, a_thunk_string, 2);
- if (!is_thunk(sc, caddr(args)))
- method_or_bust_with_type(sc, caddr(args), sc->dynamic_wind_symbol, args, a_thunk_string, 3);
+static bool opt_b_ii_ff(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_int i1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ i1 = o1->v7.fi(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.b_ii_f(i1, o1->v7.fi(o1)));
+}
- /* this won't work:
+static bool opt_b_ii_fs(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.b_ii_f(o1->v7.fi(o1), integer(slot_value(o->v2.p))));
+}
- (let ((final (lambda (a b c) (list a b c))))
- (dynamic-wind
- (lambda () #f)
- (lambda () (set! final (lambda () (display "in final"))))
- final))
+static bool opt_b_ii_fc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.b_ii_f(o1->v7.fi(o1), o->v2.i));
+}
- * but why not? 'final' is a thunk by the time it is evaluated.
- * catch (the error handler) is similar.
- *
- * It can't work here because we set up the dynamic_wind_out slot below and
- * even if the thunk check was removed, we'd still be trying to apply the original function.
- */
+static bool opt_b_ii_sf(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.b_ii_f(integer(slot_value(o->v1.p)), o1->v7.fi(o1)));
+}
- new_cell(sc, p, T_DYNAMIC_WIND); /* don't mark car/cdr, don't copy */
- dynamic_wind_in(p) = closure_or_f(sc, car(args));
- dynamic_wind_body(p) = cadr(args);
- dynamic_wind_out(p) = closure_or_f(sc, caddr(args));
+static bool b_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, s7_pointer arg1, s7_pointer arg2)
+{
+ s7_b_ii_t bif;
+ bif = s7_b_ii_function(s_func);
+ if (bif)
+ {
+ opc->v3.b_ii_f = bif;
+ if (is_symbol(arg1))
+ {
+ opc->v1.p = find_symbol(sc, arg1);
+ if (is_symbol(arg2))
+ {
+ opc->v2.p = find_symbol(sc, arg2);
+ opc->v7.fb = opt_b_ii_ss;
+ return(true);
+ }
+ if (is_opt_int(arg2))
+ {
+ opc->v2.i = integer(arg2);
+ opc->v7.fb = opt_b_ii_sc;
+ return(true);
+ }
+ if (int_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fb = opt_b_ii_sf;
+ return(true);
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ if (is_symbol(arg2))
+ {
+ if (int_optimize(sc, cdr(car_x)))
+ {
+ opc->v2.p = find_symbol(sc, arg2);
+ opc->v7.fb = opt_b_ii_fs;
+ return(true);
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ if ((is_opt_int(arg2)) &&
+ (int_optimize(sc, cdr(car_x))))
+ {
+ opc->v2.i = integer(arg2);
+ opc->v7.fb = opt_b_ii_fc;
+ return(true);
+ }
+ else
+ {
+ if ((int_optimize(sc, cdr(car_x))) &&
+ (int_optimize(sc, cddr(car_x))))
+ {
+ opc->v7.fb = opt_b_ii_ff;
+ return(true);
+ }
+ }
+ }
+ return(false);
+}
- /* since we don't care about the in and out results, and they are thunks, if the body is not a pair,
- * or is a quoted thing, we just ignore that function.
- */
+/* -------- b_or|and -------- */
+static bool opt_and_bb(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ if (o1->v7.fb(o1))
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o1->v7.fb(o1));
+ }
+ cur_sc->pc = o->v1.i;
+ return(false);
+}
- push_stack(sc, OP_DYNAMIC_WIND, sc->nil, p); /* args will be the saved result, code = s7_dynwind_t obj */
- if (dynamic_wind_in(p) != sc->F)
+static bool opt_and_bb1(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ if (o->v8.fb(o))
{
- dynamic_wind_state(p) = DWIND_INIT;
- push_stack(sc, OP_APPLY, sc->nil, dynamic_wind_in(p));
+ opt_info *o1;
+ cur_sc->pc += 2;
+ o1 = cur_sc->opts[cur_sc->pc];
+ return(o1->v7.fb(o1));
}
- else
+ cur_sc->pc = o->v4.i;
+ return(false);
+}
+
+static bool opt_and_any_b(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ int i;
+ for (i = 0; i < o->v1.i; i++)
{
- dynamic_wind_state(p) = DWIND_BODY;
- push_stack(sc, OP_APPLY, sc->nil, dynamic_wind_body(p));
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ if (!o1->v7.fb(o1))
+ {
+ cur_sc->pc = o->v2.i;
+ return(false);
+ }
}
- return(sc->F);
+ return(true);
}
+static bool opt_or_bb(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ if (o1->v7.fb(o1))
+ {
+ cur_sc->pc = o->v1.i;
+ return(true);
+ }
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o1->v7.fb(o1));
+}
-s7_pointer s7_dynamic_wind(s7_scheme *sc, s7_pointer init, s7_pointer body, s7_pointer finish)
+static bool opt_or_bb1(void *p)
{
- /* this is essentially s7_call with a dynamic-wind wrapper around "body" */
- s7_pointer p;
- declare_jump_info();
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ if (o->v8.fb(o))
+ {
+ cur_sc->pc = o->v4.i;
+ return(true);
+ }
+ cur_sc->pc += 2;
+ o1 = cur_sc->opts[cur_sc->pc];
+ return(o1->v7.fb(o1));
+}
- sc->temp1 = ((init == sc->F) ? finish : init);
- sc->temp2 = body;
+static bool opt_or_any_b(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ int i;
+ for (i = 0; i < o->v1.i; i++)
+ {
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ if (o1->v7.fb(o1))
+ {
+ cur_sc->pc = o->v2.i;
+ return(true);
+ }
+ }
+ return(false);
+}
- store_jump_info(sc);
- set_jump_info(sc, DYNAMIC_WIND_SET_JUMP);
- if (jump_loc != NO_JUMP)
+static bool opt_b_or_and(s7_scheme *sc, s7_pointer car_x, int len, int is_and)
+{
+ opt_info *opc;
+ opc = alloc_opo(sc, car_x);
+ if (len == 3)
{
- if (jump_loc != ERROR_JUMP)
- eval(sc, sc->op);
+ opt_info *o1;
+ o1 = sc->opts[sc->pc];
+ if ((bool_optimize_nw(sc, cdr(car_x))) &&
+ (bool_optimize_nw(sc, cddr(car_x))))
+ {
+ if ((o1->v7.fb == opt_b_dd_ss) ||
+ (o1->v7.fb == opt_b_ii_ss) ||
+ (o1->v7.fb == opt_b_pp_ss))
+ {
+ opc->v4.i = sc->pc - 1;
+ opc->v8.fb = o1->v7.fb;
+ opc->v7.fb = (is_and) ? opt_and_bb1 : opt_or_bb1;
+ opc->v1.p = o1->v1.p;
+ opc->v2.p = o1->v2.p;
+ opc->v3.p = o1->v3.p;
+ return(true);
+ }
+ opc->v7.fb = (is_and) ? opt_and_bb : opt_or_bb;
+ opc->v1.i = sc->pc - 1;
+ return(true);
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
}
else
{
- push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
- sc->args = sc->nil;
-
- new_cell(sc, p, T_DYNAMIC_WIND);
- dynamic_wind_in(p) = _NFre(init);
- dynamic_wind_body(p) = _NFre(body);
- dynamic_wind_out(p) = _NFre(finish);
- push_stack(sc, OP_DYNAMIC_WIND, sc->nil, p);
- if (init != sc->F)
- {
- dynamic_wind_state(p) = DWIND_INIT;
- sc->code = init;
- }
- else
+ s7_pointer p;
+ opc->v1.i = (len - 1);
+ for (p = cdr(car_x); is_pair(p); p = cdr(p))
+ if (!bool_optimize_nw(sc, p))
+ break;
+ if (is_null(p))
{
- dynamic_wind_state(p) = DWIND_BODY;
- sc->code = body;
+ opc->v7.fb = (is_and) ? opt_and_any_b : opt_or_any_b;
+ opc->v2.i = sc->pc - 1;
+ return(true);
}
- eval(sc, OP_APPLY);
}
- restore_jump_info(sc);
-
- if (is_multiple_value(sc->value))
- sc->value = splice_in_values(sc, multiple_value(sc->value));
- return(sc->value);
+ return(return_false(sc, car_x, __func__, __LINE__));
}
+static bool opt_b_and(s7_scheme *sc, s7_pointer car_x, int len) {return(opt_b_or_and(sc, car_x, len, true));}
+static bool opt_b_or(s7_scheme *sc, s7_pointer car_x, int len) {return(opt_b_or_and(sc, car_x, len, false));}
-static s7_pointer g_catch(s7_scheme *sc, s7_pointer args)
-{
- #define H_catch "(catch tag thunk handler) evaluates thunk; if an error occurs that matches the tag (#t matches all), the handler is called"
- #define Q_catch s7_make_circular_signature(sc, 2, 3, sc->values_symbol, sc->T, sc->is_procedure_symbol)
-
- s7_pointer p, proc, err;
-
- /* Guile sets up the catch before looking for arg errors:
- * (catch #t log (lambda args "hiho")) -> "hiho"
- * which is consistent in that (catch #t (lambda () (log))...) should probably be the same as (catch #t log ...)
- */
- proc = cadr(args);
- err = caddr(args);
- /* if (is_let(err)) check_method(sc, err, sc->catch_symbol, args); */ /* causes exit from s7! */
+/* ---------------------------------------- cell opts ---------------------------------------- */
- 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_handler(p) = err;
+static s7_pointer opt_p_c(void *p) {opt_info *o = (opt_info *)p; return(o->v1.p);}
+static s7_pointer opt_p_s(void *p) {opt_info *o = (opt_info *)p; return(slot_value(o->v1.p));}
- if (is_any_macro(err))
- push_stack(sc, OP_CATCH_2, args, p);
- else push_stack(sc, OP_CATCH, args, p); /* args ignored but maybe safer for GC? */
+static bool opt_cell_not_pair(s7_scheme *sc, s7_pointer car_x)
+{
+ s7_pointer p;
+ opt_info *opc;
+ if (!is_symbol(car_x))
+ {
+ opc = alloc_opo(sc, car_x);
+ opc->v1.p = car_x;
+ opc->v7.fp = opt_p_c;
+ return(true);
+ }
+ p = find_symbol(sc, car_x);
+ if (is_slot(p))
+ {
+ if (has_methods(slot_value(p)))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc = alloc_opo(sc, car_x);
+ opc->v1.p = p;
+ opc->v7.fp = opt_p_s;
+ return(true);
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
+}
- /* not sure about these error checks -- they can be omitted */
- if (!is_thunk(sc, proc))
- return(wrong_type_argument_with_type(sc, sc->catch_symbol, 2, proc, a_thunk_string));
+/* -------- p -------- */
+#define is_opt_safe(P) ((optimize_op(P) >= OP_SAFE_C_S) && ((optimize_op(P) < OP_UNKNOWN) || (optimize_op(P) > OP_UNKNOWN_AA)))
- if (!is_applicable(err))
- return(wrong_type_argument_with_type(sc, sc->catch_symbol, 3, err, something_applicable_string));
+#define cf_call(Sc, Car_x, S_func, Num) \
+ (((is_optimized(Car_x)) && (is_opt_safe(Car_x))) ? c_call(Car_x) : c_function_call(c_function_chooser(S_func)(Sc, S_func, Num, Car_x, false)))
- /* should we check here for (aritable? err 2)? -- right now:
- * (catch #t (lambda () 1) "hiho") -> 1
- * currently this is checked only if the error handler is called
- */
+static s7_pointer opt_p_f(void *p) {opt_info *o = (opt_info *)p; return(o->v1.p_f());}
+static s7_pointer opt_p_cf(void *p) {opt_info *o = (opt_info *)p; return(o->v1.cf(cur_sc, cur_sc->nil));}
- if (is_closure(proc)) /* not also lambda* here because we need to handle the arg defaults */
+static bool p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_p_t func;
+ func = s7_p_function(s_func);
+ if (func)
{
- sc->code = closure_body(proc);
- new_frame(sc, closure_let(proc), sc->envir);
- push_stack(sc, OP_BEGIN_UNCHECKED, sc->args, sc->code);
+ opc->v1.p_f = func;
+ opc->v7.fp = opt_p_f;
+ return(true);
}
- else push_stack(sc, OP_APPLY, sc->nil, proc);
+ if ((is_safe_procedure(s_func)) &&
+ (c_function_required_args(s_func) == 0))
+ {
+ opc->v1.cf = cf_call(sc, car_x, s_func, 0);
+ opc->v7.fp = opt_p_cf;
+ return(true);
+ }
+ return(false);
+}
- return(sc->F);
+/* -------- p_p -------- */
+static s7_pointer opt_p_p_c(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v2.p_p_f(o->v1.p));
}
-/* s7_catch(sc, tag, body, error): return(g_catch(sc, list(sc, 3, tag, body, error))) */
+static s7_pointer opt_p_p_s(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v2.p_p_f(slot_value(o->v1.p)));
+}
-/* error reporting info -- save filename and line number */
+static s7_pointer opt_p_p_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v2.p_p_f(o1->v7.fp(o1)));
+}
-#define remember_location(Line, File) (((File) << 20) | (Line))
-#define remembered_line_number(Line) ((Line) & 0xfffff)
-#define remembered_file_name(Line) ((((Line) >> 20) <= sc->file_names_top) ? sc->file_names[Line >> 20] : sc->F)
-/* this gives room for 4000 files each of 1000000 lines */
+static s7_pointer opt_p_p_f1(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v2.p_p_f(o->v3.p_p_f(slot_value(o->v1.p))));
+}
+static bool p_p_f_combinable(s7_scheme *sc, opt_info *opc)
+{
+ if ((sc->pc > 1) &&
+ (opc == sc->opts[sc->pc - 2]))
+ {
+ opt_info *o1;
+ o1 = sc->opts[sc->pc - 1];
+ if (o1->v7.fp == opt_p_p_s)
+ {
+ opc->v3.p_p_f = o1->v2.p_p_f;
+ opc->v1.p = o1->v1.p;
+ opc->v7.fp = opt_p_p_f1;
+ sc->pc--;
+ return(true);
+ }
+ }
+ return(false);
+}
-static int remember_file_name(s7_scheme *sc, const char *file)
+static s7_pointer opt_p_cf_f(void *p)
{
- int i;
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v2.cf(cur_sc, set_plist_1(cur_sc, o1->v7.fp(o1))));
+}
- for (i = 0; i <= sc->file_names_top; i++)
- if (safe_strcmp(file, string_value(sc->file_names[i])))
- return(i);
+static s7_pointer opt_p_cf_s(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v2.cf(cur_sc, set_plist_1(cur_sc, slot_value(o->v1.p))));
+}
- sc->file_names_top++;
- if (sc->file_names_top >= sc->file_names_size)
+static bool p_p_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_p_p_t ppf;
+ int start;
+ start = sc->pc;
+ ppf = s7_p_p_function(s_func);
+ if (ppf)
{
- int old_size = 0;
- if (sc->file_names_size == 0)
+ opc->v2.p_p_f = ppf;
+ if ((ppf == symbol_to_string_p) &&
+ (is_optimized(car_x)) &&
+ (c_call(car_x) == g_symbol_to_string_uncopied))
+ opc->v2.p_p_f = symbol_to_string_uncopied_p;
+
+ if (is_symbol(cadr(car_x)))
{
- sc->file_names_size = INITIAL_FILE_NAMES_SIZE;
- sc->file_names = (s7_pointer *)calloc(sc->file_names_size, sizeof(s7_pointer));
+ opc->v1.p = find_symbol(sc, cadr(car_x));
+ if ((!is_slot(opc->v1.p)) ||
+ (has_methods(slot_value(opc->v1.p))))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc->v7.fp = opt_p_p_s;
+ return(true);
+ }
+ if (!is_pair(cadr(car_x)))
+ {
+ opc->v1.p = cadr(car_x);
+ opc->v7.fp = opt_p_p_c;
+ return(true);
+ }
+ if (cell_optimize(sc, cdr(car_x)))
+ {
+ if (!p_p_f_combinable(sc, opc))
+ opc->v7.fp = opt_p_p_f;
+ return(true);
+ }
+ }
+ pc_fallback(sc, start);
+ if ((is_safe_procedure(s_func)) &&
+ (c_function_required_args(s_func) <= 1) &&
+ (c_function_all_args(s_func) >= 1))
+ {
+ opc->v2.cf = cf_call(sc, car_x, s_func, 1);
+ if (is_symbol(cadr(car_x)))
+ {
+ opc->v1.p = find_symbol(sc, cadr(car_x));
+ if ((is_slot(opc->v1.p)) &&
+ (!has_methods(slot_value(opc->v1.p))))
+ {
+ opc->v7.fp = opt_p_cf_s;
+ return(true);
+ }
}
else
{
- old_size = sc->file_names_size;
- sc->file_names_size *= 2;
- sc->file_names = (s7_pointer *)realloc(sc->file_names, sc->file_names_size * sizeof(s7_pointer));
+ if (cell_optimize(sc, cdr(car_x)))
+ {
+ opc->v7.fp = opt_p_cf_f;
+ return(true);
+ }
}
- for (i = old_size; i < sc->file_names_size; i++)
- sc->file_names[i] = sc->F;
}
- sc->file_names[sc->file_names_top] = s7_make_permanent_string(file);
-
- return(sc->file_names_top);
+ return(false);
}
-
-static s7_pointer init_owlet(s7_scheme *sc)
+/* -------- p_ii -------- */
+static s7_pointer opt_p_ii_ss(void *p)
{
- s7_pointer e;
- e = new_frame_in_env(sc, sc->rootlet);
- sc->temp3 = e;
- sc->error_type = make_slot_1(sc, e, make_symbol(sc, "error-type"), sc->F); /* the error type or tag ('division-by-zero) */
- sc->error_data = make_slot_1(sc, e, make_symbol(sc, "error-data"), sc->F); /* the message or information passed by the error function */
- sc->error_code = make_slot_1(sc, e, make_symbol(sc, "error-code"), sc->F); /* the code that s7 thinks triggered the error */
- sc->error_line = make_slot_1(sc, e, make_symbol(sc, "error-line"), sc->F); /* the line number of that code */
- sc->error_file = make_slot_1(sc, e, make_symbol(sc, "error-file"), sc->F); /* the file name of that code */
-#if WITH_HISTORY
- sc->error_history = make_slot_1(sc, e, make_symbol(sc, "error-history"), sc->F); /* buffer of previous evaluations */
-#endif
- return(e);
+ opt_info *o = (opt_info *)p;
+ return(o->v3.p_ii_f(integer(slot_value(o->v1.p)), integer(slot_value(o->v2.p))));
}
+static bool p_ii_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_p_ii_t ifunc;
+ ifunc = s7_p_ii_function(s_func);
+ if ((ifunc) &&
+ (is_symbol(cadr(car_x))) &&
+ (is_symbol(caddr(car_x))))
+ {
+ opc->v1.p = find_symbol(sc, cadr(car_x));
+ opc->v2.p = find_symbol(sc, caddr(car_x));
+ if ((is_slot(opc->v1.p)) &&
+ (is_opt_int(slot_value(opc->v1.p))) &&
+ (is_slot(opc->v2.p)) &&
+ (is_opt_int(slot_value(opc->v2.p))))
+ {
+ opc->v3.p_ii_f = ifunc;
+ opc->v7.fp = opt_p_ii_ss;
+ return(true);
+ }
+ }
+ return(false);
+}
-static s7_pointer g_owlet(s7_scheme *sc, s7_pointer args)
+/* -------- p_pi -------- */
+static s7_pointer opt_p_pi_ss(void *p)
{
-#if WITH_HISTORY
- #define H_owlet "(owlet) returns the environment at the point of the last error. \
-It has the additional local variables: error-type, error-data, error-code, error-line, error-file, and error-history."
-#else
- #define H_owlet "(owlet) returns the environment at the point of the last error. \
-It has the additional local variables: error-type, error-data, error-code, error-line, and error-file."
-#endif
- #define Q_owlet s7_make_signature(sc, 1, sc->is_let_symbol)
- /* if owlet is not copied, (define e (owlet)), e changes as owlet does!
- */
- s7_pointer e, x;
- unsigned int gc_loc;
+ opt_info *o = (opt_info *)p;
+ return(o->v3.p_pi_f(slot_value(o->v1.p), integer(slot_value(o->v2.p))));
+}
- e = let_copy(sc, sc->owlet);
- gc_loc = s7_gc_protect(sc, e);
+static s7_pointer opt_p_pi_sc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.p_pi_f(slot_value(o->v1.p), o->v2.i));
+}
- /* also make sure the pairs are copied: should be error-data, error-code, and possibly error-history */
- for (x = let_slots(e); is_slot(x); x = next_slot(x))
- if (is_pair(slot_value(x)))
- slot_set_value(x, protected_list_copy(sc, slot_value(x)));
+static s7_pointer opt_p_pi_sf(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.p_pi_f(slot_value(o->v1.p), o1->v7.fi(o1)));
+}
- s7_gc_unprotect_at(sc, gc_loc);
- return(e);
+static s7_pointer opt_p_pi_fc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.p_pi_f(o1->v7.fp(o1), o->v2.i));
}
-static s7_pointer c_owlet(s7_scheme *sc) {return(g_owlet(sc, sc->nil));}
-PF_0(owlet, c_owlet)
+static bool p_pi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_p_pi_t func;
+ func = s7_p_pi_function(s_func);
+ if (func)
+ {
+ s7_pointer obj = NULL, slot, sig, checker = NULL;
+ sig = s7_procedure_signature(sc, s_func);
+ if ((is_pair(sig)) &&
+ (is_pair(cdr(sig))) &&
+ (is_symbol(cadr(sig))))
+ checker = cadr(sig);
+
+ /* here we know cadr is a symbol */
+ slot = find_symbol(sc, cadr(car_x));
+ if ((!is_slot(slot)) ||
+ (has_methods(slot_value(slot))))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ if ((s7_is_vector(slot_value(slot))) &&
+ (vector_rank(slot_value(slot)) > 1))
+ return(return_false(sc, car_x, __func__, __LINE__));
-static s7_pointer active_catches(s7_scheme *sc)
-{
- int i;
- s7_pointer x, lst;
- lst = sc->nil;
- for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
- switch (stack_op(sc->stack, i))
- {
- case OP_CATCH_ALL:
- lst = cons(sc, sc->T, lst);
- break;
+ opc->v3.p_pi_f = func;
+ opc->v1.p = slot;
- case OP_CATCH_2:
- case OP_CATCH_1:
- case OP_CATCH:
- x = stack_code(sc->stack, i);
- lst = cons(sc, catch_tag(x), lst);
- break;
- }
- return(reverse_in_place_unchecked(sc, sc->nil, lst));
+ if ((s7_p_pi_direct_function(s_func)) &&
+ (checker))
+ {
+ obj = slot_value(opc->v1.p);
+ if ((is_string(obj)) ||
+ (is_pair(obj)) ||
+ (s7_is_vector(obj)))
+ {
+ if (((is_string(obj)) && (checker == sc->is_string_symbol)) ||
+ ((s7_is_vector(obj)) && (checker == sc->is_vector_symbol)) ||
+ ((is_pair(obj)) && (checker == sc->is_pair_symbol)))
+ opc->v3.p_pi_f = s7_p_pi_direct_function(s_func);
+ }
+ }
+
+ if (is_symbol(caddr(car_x)))
+ {
+ s7_pointer slot;
+ slot = find_symbol(sc, caddr(car_x));
+ if ((is_slot(slot)) &&
+ (is_opt_int(slot_value(slot))))
+ {
+ opc->v7.fp = opt_p_pi_ss;
+ opc->v2.p = slot;
+ if ((obj) &&
+ (is_step_end(slot)))
+ switch (type(obj))
+ {
+ case T_VECTOR:
+ if (denominator(slot_value(slot)) <= vector_length(obj))
+ opc->v3.p_pi_f = vector_ref_unchecked;
+ break;
+ case T_INT_VECTOR:
+ if (denominator(slot_value(slot)) <= vector_length(obj))
+ opc->v3.p_pi_f = int_vector_ref_unchecked_p;
+ break;
+ case T_FLOAT_VECTOR:
+ if (denominator(slot_value(slot)) <= vector_length(obj))
+ opc->v3.p_pi_f = float_vector_ref_unchecked_p;
+ break;
+ case T_STRING:
+ if (denominator(slot_value(slot)) <= string_length(obj))
+ opc->v3.p_pi_f = string_ref_unchecked;
+ break;
+ }
+ return(true);
+ }
+ }
+ else
+ {
+ if (is_integer(caddr(car_x)))
+ {
+ opc->v2.i = integer(caddr(car_x));
+ opc->v7.fp = opt_p_pi_sc;
+ return(true);
+ }
+ if (int_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fp = opt_p_pi_sf;
+ return(true);
+ }
+ }
+ }
+ return(false);
}
-static s7_pointer active_exits(s7_scheme *sc)
+static s7_pointer opt_p_pi_fco(void *p)
{
- /* (call-with-exit (lambda (exiter) (*s7* 'exits))) */
- int i;
- s7_pointer lst;
- lst = sc->nil;
- for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
- if (stack_op(sc->stack, i) == OP_DEACTIVATE_GOTO)
- {
- s7_pointer func, jump;
- func = stack_code(sc->stack, i); /* presumably this has the goto name */
- 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);
- else
- {
- if ((is_pair(func)) && (car(func) == sc->call_with_exit_symbol))
- lst = cons(sc, cons(sc, car(cadr(cadr(func))), jump), lst); /* (call-with-exit (lambda (three) ...)) */
- else lst = cons(sc, cons(sc, sc->unspecified, jump), lst);
- }
- sc->w = lst;
- }
- return(reverse_in_place_unchecked(sc, sc->nil, lst));
+ opt_info *o = (opt_info *)p;
+ return(o->v3.p_pi_f(o->v4.p_p_f(slot_value(o->v1.p)), o->v2.i));
}
-static s7_pointer stack_entries(s7_scheme *sc, s7_pointer stack, int top)
+static bool p_pi_fc_combinable(s7_scheme *sc, opt_info *opc)
{
- int i;
- s7_pointer lst;
- lst = sc->nil;
- for (i = top - 1; i >= 3; i -= 4)
+ if ((sc->pc > 1) &&
+ (opc == sc->opts[sc->pc - 2]))
{
- s7_pointer func, args, e;
- opcode_t op;
- func = stack_code(stack, i);
- args = stack_args(stack, i);
- e = stack_let(stack, i);
- op = stack_op(stack, i);
- if ((s7_is_valid(sc, func)) &&
- (s7_is_valid(sc, args)) &&
- (s7_is_valid(sc, e)) &&
- (op < OP_MAX_DEFINED))
+ opt_info *o1;
+ o1 = sc->opts[sc->pc - 1];
+ if (o1->v7.fp == opt_p_p_s)
{
-#if DEBUGGING
- if (op < OP_MAX_DEFINED_1)
- lst = cons(sc, list_4(sc, func, args, e, make_string_wrapper(sc, op_names[op])), lst);
- else lst = cons(sc, list_4(sc, func, args, e, make_integer(sc, op)), lst);
-#else
- lst = cons(sc, list_4(sc, func, args, e, make_integer(sc, op)), lst);
-#endif
- sc->w = lst;
+ opc->v4.p_p_f = o1->v2.p_p_f;
+ opc->v1.p = o1->v1.p;
+ opc->v7.fp = opt_p_pi_fco;
+ sc->pc--;
+ return(true);
}
}
- return(reverse_in_place_unchecked(sc, sc->nil, lst));
+ return(false);
}
+/* -------- p_pp -------- */
+static s7_pointer opt_p_pp_ss(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.p_pp_f(slot_value(o->v1.p), slot_value(o->v2.p)));
+}
-/* catch handlers */
-
-typedef bool (*catch_function)(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook);
-static catch_function catchers[OP_MAX_DEFINED + 1];
-
-static bool catch_all_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+static s7_pointer opt_p_pp_sc(void *p)
{
- s7_pointer catcher;
- catcher = stack_let(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);
- return(true);
+ opt_info *o = (opt_info *)p;
+ return(o->v3.p_pp_f(slot_value(o->v1.p), o->v2.p));
}
-static bool catch_2_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+static s7_pointer opt_p_pp_cs(void *p)
{
- /* this is the macro-error-handler case from g_catch
- * (let () (define-macro (m . args) (apply (car args) (cadr args))) (catch #t (lambda () (error abs -1)) m))
- */
- s7_pointer x;
- x = stack_code(sc->stack, i);
- if ((catch_tag(x) == sc->T) ||
- (catch_tag(x) == type) ||
- (type == sc->T))
- {
- int 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);
- sc->code = catch_handler(x);
+ opt_info *o = (opt_info *)p;
+ return(o->v3.p_pp_f(o->v2.p, slot_value(o->v1.p)));
+}
- set_car(sc->t2_1, type);
- set_car(sc->t2_2, info);
- sc->args = sc->t2_1; /* copied in op_apply? */
+static s7_pointer opt_p_pp_sf(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.p_pp_f(slot_value(o->v1.p), o1->v7.fp(o1)));
+}
- sc->op = OP_APPLY;
- return(true);
- }
- return(false);
+static s7_pointer opt_p_pp_fs(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.p_pp_f(o1->v7.fp(o1), slot_value(o->v1.p)));
}
-static bool catch_1_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+static s7_pointer opt_p_pp_fc(void *p)
{
- s7_pointer x;
- x = stack_code(sc->stack, i);
- if ((catch_tag(x) == sc->T) ||
- (catch_tag(x) == type) ||
- (type == sc->T))
- {
- unsigned int loc;
- opcode_t op;
- s7_pointer catcher, error_func, body;
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.p_pp_f(o1->v7.fp(o1), o->v2.p));
+}
- op = stack_op(sc->stack, i);
- sc->temp4 = stack_let(sc->stack, i); /* GC protect this, since we're moving the stack top below */
- catcher = x;
- loc = catch_goto_loc(catcher);
- sc->op_stack_now = (s7_pointer *)(sc->op_stack + catch_op_loc(catcher));
- sc->stack_end = (s7_pointer *)(sc->stack_start + loc);
- error_func = catch_handler(catcher);
+static s7_pointer opt_p_pp_cc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.p_pp_f(o->v1.p, o->v2.p));
+}
- /* very often the error handler just returns either a constant ('error or #f), or
- * the args passed to it, so there's no need to laboriously make a closure,
- * and apply it -- just set sc->value to the closure body (or the args) and
- * return.
- *
- * so first examine closure_body(error_func)
- * if it is a constant, or quoted symbol, return that,
- * if it is the args symbol, return (list type info)
- */
+static s7_pointer opt_p_pp_ff(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_pointer p1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ p1 = o1->v7.fp(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.p_pp_f(p1, o1->v7.fp(o1)));
+}
- /* if OP_CATCH_1, we deferred making the error handler until it is actually needed */
- if (op == OP_CATCH_1)
- body = cdr(error_func);
- else
- {
- if (is_closure(error_func))
- body = closure_body(error_func);
- else body = NULL;
+static bool p_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_p_pp_t func;
+ func = s7_p_pp_function(s_func);
+ if (func)
+ {
+ s7_pointer slot, sig, checker = NULL;
+
+ sig = s7_procedure_signature(sc, s_func);
+ if ((is_pair(sig)) &&
+ (is_pair(cdr(sig))) &&
+ (is_symbol(cadr(sig))))
+ checker = cadr(sig);
+
+ if (is_symbol(cadr(car_x)))
+ {
+ slot = find_symbol(sc, cadr(car_x));
+ if ((!is_slot(slot)) ||
+ (has_methods(slot_value(slot))))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ if ((s7_is_vector(slot_value(slot))) &&
+ (vector_rank(slot_value(slot)) > 1))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc->v1.p = slot;
}
-
- if ((body) && (is_null(cdr(body))))
+
+ opc->v3.p_pp_f = func;
+ if (is_symbol(cadr(car_x)))
{
- s7_pointer y = NULL;
- body = car(body);
- if (is_pair(body))
+ if ((s7_p_pp_direct_function(s_func)) &&
+ (checker))
{
- if (car(body) == sc->quote_symbol)
- y = cadr(body);
- else
- {
- if ((car(body) == sc->car_symbol) &&
- (is_pair(error_func)) &&
- (cadr(body) == car(error_func)))
- y = type;
- }
+ checker = s7_symbol_value(sc, checker);
+ if (s7_apply_function(sc, checker, set_plist_1(sc, slot_value(opc->v1.p))) == sc->T)
+ opc->v3.p_pp_f = s7_p_pp_direct_function(s_func);
}
- else
+ if (is_symbol(caddr(car_x)))
{
- if (is_symbol(body))
+ opc->v2.p = find_symbol(sc, caddr(car_x));
+ if ((is_slot(opc->v2.p)) &&
+ (!has_methods(slot_value(opc->v2.p))))
{
- if ((is_pair(error_func)) &&
- (body == car(error_func)))
- y = list_2(sc, type, info);
+ opc->v7.fp = opt_p_pp_ss;
+ return(true);
}
- else y = body;
+ return(return_false(sc, car_x, __func__, __LINE__));
}
- if (y)
+ if ((!is_pair(caddr(car_x))) ||
+ (is_proper_quote(sc, caddr(car_x))))
{
- if (loc > 4)
- pop_stack(sc);
- /* we're at OP_CATCH, normally we want to pop that away, but (handwaving...) if we're coming
- * from s7_eval (indirectly perhaps through s7_eval_c_string), we might push the OP_EVAL_DONE
- * to end that call, but it's pushed at the precatch stack end (far beyond the catch loc).
- * If we catch an error, catch unwinds to its starting point, and the pop_stack above
- * puts us at the bottom of the stack (i.e. stack_end == stack_start), OP_EVAL_DONE.
- * Now we return true, ending up back in eval, because the error handler jumped out of eval,
- * back to wherever we were in eval when we hit the error. eval jumps back to the start
- * of its loop, and pops the stack to see what to do next! So the (loc > 4) at least
- * protects against stack underflow, but ideally we'd know we came from OP_CATCH+s7_eval.
- * We can't do anything fancy here because we have to unwind the C stack as well as s7's stack.
- * s7_eval doesn't know anything about the catches on the stack. We can't look back for
- * OP_EVAL_DONE -- segfault in OP_BEGIN. Hmmmm. Perhaps catch should not unwind until the
- * end? But we want the error handler to run as a part of the calling expression, and
- * in any case the OP_EVAL_DONE is not useful (it marks the end of the no-error case).
- */
- sc->value = y;
- sc->temp4 = sc->nil;
+ opc->v2.p = (!is_pair(caddr(car_x))) ? caddr(car_x) : cadr(caddr(car_x));
+ opc->v7.fp = opt_p_pp_sc;
+ return(true);
+ }
+ if (cell_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fp = opt_p_pp_sf;
return(true);
}
}
- if (op == OP_CATCH_1)
+ else
{
- s7_pointer y = NULL;
- make_closure_without_capture(sc, y, car(error_func), cdr(error_func), sc->temp4);
- sc->code = y;
+ if ((!is_pair(cadr(car_x))) ||
+ (is_proper_quote(sc, cadr(car_x))))
+ {
+ opc->v1.p = (!is_pair(cadr(car_x))) ? cadr(car_x) : cadadr(car_x);
+ if ((!is_symbol(caddr(car_x))) &&
+ ((!is_pair(caddr(car_x))) ||
+ (is_proper_quote(sc, caddr(car_x)))))
+ {
+ opc->v2.p = (!is_pair(caddr(car_x))) ? caddr(car_x) : cadr(caddr(car_x));
+ opc->v7.fp = opt_p_pp_cc;
+ return(true);
+ }
+ if (is_symbol(caddr(car_x)))
+ {
+ opc->v2.p = opc->v1.p;
+ opc->v1.p = find_symbol(sc, caddr(car_x));
+ if ((is_slot(opc->v1.p)) &&
+ (!has_methods(slot_value(opc->v1.p))))
+ {
+ opc->v7.fp = opt_p_pp_cs;
+ return(true);
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ }
+ if (cell_optimize(sc, cdr(car_x)))
+ {
+ if (is_symbol(caddr(car_x)))
+ {
+ opc->v1.p = find_symbol(sc, caddr(car_x));
+ if ((is_slot(opc->v1.p)) &&
+ (!has_methods(slot_value(opc->v1.p))))
+ {
+ opc->v7.fp = opt_p_pp_fs;
+ return(true);
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ if ((!is_pair(caddr(car_x))) ||
+ (is_proper_quote(sc, caddr(car_x))))
+ {
+ if (is_t_integer(caddr(car_x)))
+ {
+ s7_p_pi_t ifunc;
+ ifunc = s7_p_pi_function(s_func);
+ if (ifunc)
+ {
+ opc->v2.i = integer(caddr(car_x));
+ opc->v3.p_pi_f = ifunc;
+ if (!p_pi_fc_combinable(sc, opc))
+ opc->v7.fp = opt_p_pi_fc;
+ return(true);
+ }
+ }
+ opc->v2.p = (!is_pair(caddr(car_x))) ? caddr(car_x) : cadr(caddr(car_x));
+ opc->v7.fp = opt_p_pp_fc;
+ return(true);
+ }
+ if (cell_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fp = opt_p_pp_ff;
+ return(true);
+ }
+ }
}
- else sc->code = error_func;
- sc->temp4 = sc->nil;
+ }
+ return(false);
+}
- /* if user (i.e. yers truly!) copies/pastes the preceding lambda () into the
- * error handler portion of the catch, he gets the inexplicable message:
- * ;(): too many arguments: (a1 ())
- * when this apply tries to call the handler. So, we need a special case
- * error check here!
- */
+/* -------- p_cf_pp -------- */
+static s7_pointer opt_p_cf_ff(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_pointer po1, po2;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ po1 = 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)));
+}
- if (!s7_is_aritable(sc, sc->code, 2))
- {
- s7_wrong_number_of_args_error(sc, "catch error handler should accept 2 args: ~S", sc->code);
- return(false);
- }
+static s7_pointer opt_p_cf_fs(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_pointer po1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ po1 = o1->v7.fp(o1);
+ return(o->v3.cf(cur_sc, set_plist_2(cur_sc, po1, slot_value(o->v1.p))));
+}
- /* since make_closure_with_let sets needs_copied_args and we're going to OP_APPLY,
- * we don't need a new list here.
- */
- set_car(sc->t2_1, type);
- set_car(sc->t2_2, info);
- sc->args = sc->t2_1;
- sc->op = OP_APPLY;
+static s7_pointer opt_p_cf_sf(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_pointer po1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ po1 = o1->v7.fp(o1);
+ return(o->v3.cf(cur_sc, set_plist_2(cur_sc, slot_value(o->v1.p), po1)));
+}
- /* 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,
- * so defer it until s7_call
- */
- return(true);
- }
- return(false);
+static s7_pointer opt_p_cf_sc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.cf(cur_sc, set_plist_2(cur_sc, slot_value(o->v1.p), o->v2.p)));
}
-static bool catch_dw_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+static s7_pointer opt_p_cf_ss(void *p)
{
- s7_pointer x;
- x = stack_code(sc->stack, i);
- if (dynamic_wind_state(x) == DWIND_BODY)
+ opt_info *o = (opt_info *)p;
+ return(o->v3.cf(cur_sc, set_plist_2(cur_sc, slot_value(o->v1.p), slot_value(o->v2.p))));
+}
+
+static bool p_cf_pp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ if ((is_safe_procedure(s_func)) &&
+ (c_function_required_args(s_func) <= 2) &&
+ (c_function_all_args(s_func) >= 2))
{
- dynamic_wind_state(x) = DWIND_FINISH; /* make sure an uncaught error in the exit thunk doesn't cause us to loop */
- if (dynamic_wind_out(x) != sc->F)
+ /* if optimized, we want to use the current c_call (to take advantage of fixups like substring_temp),
+ * but those same fixups are incorrect for this context if op_safe_c_c related.
+ */
+ opc->v3.cf = cf_call(sc, car_x, s_func, 2);
+ if (is_symbol(cadr(car_x)))
{
- push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
- sc->code = dynamic_wind_out(x);
- sc->args = sc->nil;
- eval(sc, OP_APPLY); /* I guess this means no call/cc out of the exit thunk in an error-catching context */
+ opc->v1.p = find_symbol(sc, cadr(car_x));
+ if ((is_slot(opc->v1.p)) &&
+ (!has_methods(slot_value(opc->v1.p))))
+ {
+ if (is_symbol(caddr(car_x)))
+ {
+ opc->v2.p = find_symbol(sc, caddr(car_x));
+ if ((is_slot(opc->v2.p)) &&
+ (!has_methods(slot_value(opc->v2.p))))
+ {
+ opc->v7.fp = opt_p_cf_ss;
+ return(true);
+ }
+ else return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ if (!is_pair(caddr(car_x)))
+ {
+ opc->v2.p = caddr(car_x);
+ opc->v7.fp = opt_p_cf_sc;
+ return(true);
+ }
+ if (cell_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fp = opt_p_cf_sf;
+ return(true);
+ }
+ }
+ else return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ if (cell_optimize(sc, cdr(car_x)))
+ {
+ if (is_symbol(caddr(car_x)))
+ {
+ opc->v1.p = find_symbol(sc, caddr(car_x));
+ if ((is_slot(opc->v1.p)) &&
+ (!has_methods(slot_value(opc->v1.p))))
+ {
+ opc->v7.fp = opt_p_cf_fs;
+ return(true);
+ }
+ else return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ if (cell_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fp = opt_p_cf_ff;
+ return(true);
+ }
}
}
return(false);
}
-static bool catch_out_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+
+/* -------- p_pip --------*/
+
+static s7_pointer opt_p_pip_ssf(void *p)
{
- s7_pointer x;
- x = stack_code(sc->stack, i); /* "code" = port that we opened */
- s7_close_output_port(sc, x);
- x = stack_args(sc->stack, i); /* "args" = port that we shadowed, if not #f */
- if (x != sc->F)
- sc->output_port = x;
- return(false);
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.p_pip_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o1->v7.fp(o1)));
+}
+
+static s7_pointer opt_p_pip_sss(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v4.p_pip_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), slot_value(o->v3.p)));
+}
+
+static s7_pointer opt_p_pip_ssc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.p_pip_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o->v4.p));
}
-static bool catch_in_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+static s7_pointer opt_p_pip_sff(void *p)
{
- s7_close_input_port(sc, stack_code(sc->stack, i)); /* "code" = port that we opened */
- sc->input_port = stack_args(sc->stack, i); /* "args" = port that we shadowed */
- return(false);
+ opt_info *o = (opt_info *)p;
+ opt_info *o1, *o2;
+ s7_int i1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ i1 = o1->v7.fi(o1);
+ o2 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.p_pip_f(slot_value(o->v1.p), i1, o2->v7.fp(o2)));
}
-static bool catch_read_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+static s7_pointer opt_p_pip_sso(void *p)
{
- pop_input_port(sc);
- return(false);
+ opt_info *o = (opt_info *)p;
+ return(o->v5.p_pip_f(slot_value(o->v1.p),
+ integer(slot_value(o->v2.p)),
+ o->v6.p_pi_f(slot_value(o->v3.p),
+ integer(slot_value(o->v4.p)))));
}
-static bool catch_eval_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+#if 0
+p_p_c: (o->v2.p_p_f(o->v1.p))
+p_p_f: (o->v2.p_p_f(o1->v7.fp(o1))
+p_cf_s: (o->v2.cf(cur_sc, set_plist_1(cur_sc, slot_value(o->v1.p))))
+p_cf_ss: (o->v3.cf(cur_sc, set_plist_2(cur_sc, slot_value(o->v1.p), slot_value(o->v2.p)))
+p_pi_sf: (o->v3.p_pi_f(slot_value(o->v1.p), o1->v7.fi(o1)))
+p_pi_ss: (o->v3.p_pi_f(slot_value(o->v1.p), integer(slot_value(o->v2.p))))
+i_to_p: s7_make_integer(cur_sc, o->v8.fi(o))
+i_i_s: (o->v2.i_i_f(integer(slot_value(o->v1.p)))
+p_pp_fc: (o->v3.p_pp_f(o1->v7.fp(o1), o->v2.p)
+
+pip_ssf:
+return(o->v3.p_pip_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o1->v7.fp(o1)));
+
+ /* p_pi_sf -> i_i_s (form)
+ * p_cf_s, p_cf_ss (hash)
+ * p_p_f -> i_to_p (ref), p_pp_fc -> p_pi_ss (ref)
+ * i_to_p (map), p_p_f -> i_to_p (map)
+ * [p_p_c], p_p_f -> p_p_c (sort)
+ */
+#endif
+
+static s7_pointer opt_p_pip_c(void *p)
{
- s7_close_input_port(sc, sc->input_port);
- pop_input_port(sc);
- return(false);
+ opt_info *o = (opt_info *)p;
+ return(o->v3.p_pip_f(slot_value(o->v1.p), integer(slot_value(o->v2.p)), o->v5.p_p_f(o->v4.p)));
}
-static bool catch_barrier_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+static bool p_pip_ssf_combinable(s7_scheme *sc, opt_info *opc)
{
- if (is_input_port(stack_args(sc->stack, i))) /* (eval-string "'(1 .)") */
+ if ((sc->pc > 1) &&
+ (opc == sc->opts[sc->pc - 2]))
{
- if (sc->input_port == stack_args(sc->stack, i))
- pop_input_port(sc);
- s7_close_input_port(sc, stack_args(sc->stack, i));
+ opt_info *o1;
+ o1 = sc->opts[sc->pc - 1];
+ if (o1->v7.fp == opt_p_pi_ss)
+ {
+ opc->v5.p_pip_f = opc->v3.p_pip_f;
+ opc->v6.p_pi_f = o1->v3.p_pi_f;
+ opc->v3.p = o1->v1.p;
+ opc->v4.p = o1->v2.p;
+ opc->v7.fp = opt_p_pip_sso;
+ sc->pc--;
+ return(true);
+ }
+ if (o1->v7.fp == opt_p_p_c)
+ {
+ opc->v5.p_p_f = o1->v2.p_p_f;
+ opc->v4.p = o1->v1.p;
+ sc->pc--;
+ opc->v7.fp = opt_p_pip_c;
+ return(true);
+ }
}
return(false);
}
-static bool catch_hook_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+static bool p_pip_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
{
- sc->error_hook = stack_code(sc->stack, i);
- /* apparently there was an error during *error-hook* evaluation, but Rick wants the hook re-established anyway */
- (*reset_hook) = true;
- /* avoid infinite loop -- don't try to (re-)evaluate (buggy) *error-hook*! */
- return(false);
-}
+ s7_p_pip_t func;
+ func = s7_p_pip_function(s_func);
+ if (func)
+ {
+ s7_pointer obj = NULL, slot, sig, checker = NULL;
-static bool catch_goto_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
-{
- call_exit_active(stack_args(sc->stack, i)) = false;
+ sig = s7_procedure_signature(sc, s_func);
+ if ((is_pair(sig)) &&
+ (is_pair(cdr(sig))) &&
+ (is_symbol(cadr(sig))))
+ checker = cadr(sig);
+
+ /* here we know cadr is a symbol */
+ slot = find_symbol(sc, cadr(car_x));
+ if ((!is_slot(slot)) ||
+ (has_methods(slot_value(slot))))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ if ((s7_is_vector(slot_value(slot))) &&
+ (vector_rank(slot_value(slot)) > 1))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc->v1.p = slot;
+
+ opc->v3.p_pip_f = func;
+ if ((s7_p_pip_direct_function(s_func)) &&
+ (checker))
+ {
+ obj = slot_value(opc->v1.p);
+ if (((is_string(obj)) && (checker == sc->is_string_symbol)) ||
+ ((s7_is_vector(obj)) && (checker == sc->is_vector_symbol)) ||
+ ((is_pair(obj)) && (checker == sc->is_pair_symbol)))
+ opc->v3.p_pip_f = s7_p_pip_direct_function(s_func);
+ }
+
+ if (is_symbol(caddr(car_x)))
+ {
+ s7_pointer slot;
+ slot = find_symbol(sc, caddr(car_x));
+ if ((is_slot(slot)) &&
+ (is_opt_int(slot_value(slot))))
+ {
+ opc->v2.p = slot;
+ if ((obj) &&
+ (is_step_end(slot)))
+ switch (type(obj))
+ {
+ case T_VECTOR:
+ if (denominator(slot_value(slot)) <= vector_length(obj))
+ opc->v3.p_pip_f = vector_set_unchecked;
+ break;
+ case T_INT_VECTOR:
+ if (denominator(slot_value(slot)) <= vector_length(obj))
+ opc->v3.p_pip_f = int_vector_set_unchecked_p;
+ break;
+ case T_FLOAT_VECTOR:
+ if (denominator(slot_value(slot)) <= vector_length(obj))
+ opc->v3.p_pip_f = float_vector_set_unchecked_p;
+ break;
+ case T_STRING:
+ if (denominator(slot_value(slot)) <= string_length(obj))
+ opc->v3.p_pip_f = string_set_unchecked;
+ break;
+ }
+
+ if (is_symbol(cadddr(car_x)))
+ {
+ s7_pointer val_slot;
+ val_slot = find_symbol(sc, cadddr(car_x));
+ if ((is_slot(val_slot)) &&
+ (!has_methods(val_slot)))
+ {
+ opc->v4.p_pip_f = opc->v3.p_pip_f;
+ opc->v3.p = val_slot;
+ opc->v7.fp = opt_p_pip_sss;
+ return(true);
+ }
+ }
+ else
+ {
+ if ((!is_pair(cadddr(car_x))) ||
+ (is_proper_quote(sc, cadddr(car_x))))
+ {
+ if (!is_pair(cadddr(car_x)))
+ opc->v4.p = cadddr(car_x);
+ else opc->v4.p = cadr(cadddr(car_x));
+ opc->v7.fp = opt_p_pip_ssc;
+ return(true);
+ }
+ }
+ if (cell_optimize(sc, cdddr(car_x)))
+ {
+ if (!p_pip_ssf_combinable(sc, opc))
+ opc->v7.fp = opt_p_pip_ssf;
+ return(true);
+ }
+ }
+ }
+ else
+ {
+ if ((int_optimize(sc, cddr(car_x))) &&
+ (cell_optimize(sc, cdddr(car_x))))
+ {
+ opc->v7.fp = opt_p_pip_sff;
+ return(true);
+ }
+ }
+ }
return(false);
}
-static void init_catchers(void)
+/* -------- p_ppi -------- */
+static s7_pointer opt_p_ppi_psf(void *p)
{
- int i;
- for (i = 0; i <= OP_MAX_DEFINED; i++) catchers[i] = NULL;
- catchers[OP_CATCH_ALL] = catch_all_function;
- catchers[OP_CATCH_2] = catch_2_function;
- catchers[OP_CATCH_1] = catch_1_function;
- catchers[OP_CATCH] = catch_1_function;
- catchers[OP_DYNAMIC_WIND] = catch_dw_function;
- catchers[OP_GET_OUTPUT_STRING_1] = catch_out_function;
- catchers[OP_UNWIND_OUTPUT] = catch_out_function;
- catchers[OP_UNWIND_INPUT] = catch_in_function;
- catchers[OP_READ_DONE] = catch_read_function; /* perhaps an error during (read) */
- catchers[OP_EVAL_STRING_1] = catch_eval_function; /* perhaps an error happened before we could push the OP_EVAL_STRING_2 */
- catchers[OP_EVAL_STRING_2] = catch_eval_function;
- catchers[OP_BARRIER] = catch_barrier_function;
- catchers[OP_DEACTIVATE_GOTO] = catch_goto_function;
- catchers[OP_ERROR_HOOK_QUIT] = catch_hook_function;
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.p_ppi_f(o->v2.p, slot_value(o->v1.p), o1->v7.fi(o1)));
}
-static s7_pointer g_throw(s7_scheme *sc, s7_pointer args)
+static bool p_ppi_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
{
- #define H_throw "(throw tag . info) is like (error ...) but it does not affect the owlet. \
-It looks for an existing catch with a matching tag, and jumps to it if found. Otherwise it raises an error."
- #define Q_throw pcl_t
-
- bool ignored_flag = false;
- int i;
- s7_pointer type, info;
-
- type = car(args);
- info = cdr(args);
- /* look for a catcher */
-
- for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
+ s7_p_ppi_t ifunc;
+ ifunc = s7_p_ppi_function(s_func);
+ if (ifunc)
{
- catch_function catcher;
- catcher = catchers[stack_op(sc->stack, i)];
- if ((catcher) &&
- (catcher(sc, i, type, info, &ignored_flag)))
+ int start;
+ start = sc->pc;
+ opc->v3.p_ppi_f = ifunc;
+ if ((s7_is_character(cadr(car_x))) &&
+ (is_symbol(caddr(car_x))) &&
+ (int_optimize(sc, cdddr(car_x))))
{
- if (sc->longjmp_ok) longjmp(sc->goto_start, THROW_JUMP);
- return(sc->value);
+ s7_pointer slot;
+ slot = find_symbol(sc, caddr(car_x));
+ if ((is_slot(slot)) &&
+ (!has_methods(slot_value(slot))))
+ {
+ opc->v2.p = cadr(car_x);
+ opc->v1.p = slot;
+ opc->v7.fp = opt_p_ppi_psf;
+ return(true);
+ }
}
+ pc_fallback(sc, start);
}
- if (is_let(car(args))) check_method(sc, car(args), sc->throw_symbol, args);
- return(s7_error(sc, make_symbol(sc, "uncaught-throw"),
- set_elist_3(sc, make_string_wrapper(sc, "no catch found for (throw ~W~{~^ ~S~~})"), type, info)));
+ return(false);
}
-
-static void s7_warn(s7_scheme *sc, int len, const char *ctrl, ...)
+/* -------- p_ppp -------- */
+static s7_pointer opt_p_ppp_ssf(void *p)
{
- va_list ap;
- char *str;
-
- str = (char *)malloc(len * sizeof(char));
- va_start(ap, ctrl);
- len = vsnprintf(str, len, ctrl, ap);
- va_end(ap);
-
- if (port_is_closed(sc->error_port))
- sc->error_port = sc->standard_error;
- s7_display(sc, make_string_uncopied_with_length(sc, str, len), sc->error_port);
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.p_ppp_f(slot_value(o->v1.p), slot_value(o->v2.p), o1->v7.fp(o1)));
}
-
-s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info)
+static s7_pointer opt_p_ppp_sfs(void *p)
{
- static int last_line = -1;
- bool reset_error_hook = false;
- s7_pointer cur_code;
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.p_ppp_f(slot_value(o->v1.p), o1->v7.fp(o1), slot_value(o->v2.p)));
+}
- /* type is a symbol normally, and info is compatible with format: (apply format #f info) --
- * car(info) is the control string, cdr(info) its args
- * type/range errors have cadr(info)=caller, caddr(info)=offending arg number
- * null info can mean symbol table is locked so make-symbol uses s7_error to get out
- *
- * set up (owlet), look for a catch that matches 'type', if found
- * call its error-handler, else if *error-hook* is bound, call it,
- * else send out the error info ourselves.
- */
- sc->no_values = 0;
- sc->format_depth = -1;
- sc->gc_off = false; /* this is in case we were triggered from the sort function -- clumsy! */
- s7_xf_clear(sc);
+static s7_pointer opt_p_ppp_scs(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.p_ppp_f(slot_value(o->v1.p), o->v4.p, slot_value(o->v2.p)));
+}
- slot_set_value(sc->error_type, type);
- slot_set_value(sc->error_data, info);
+static s7_pointer opt_p_ppp_sff(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1, *o2;
+ s7_pointer po1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ po1 = o1->v7.fp(o1);
+ o2 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.p_ppp_f(slot_value(o->v1.p), po1, o2->v7.fp(o2)));
+}
-#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 */
+static s7_pointer opt_p_ppp_sss(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v4.p_ppp_f(slot_value(o->v1.p), slot_value(o->v2.p), slot_value(o->v3.p)));
+}
- set_outlet(sc->owlet, sc->envir);
+static s7_pointer opt_p_ppp_ssc(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v3.p_ppp_f(slot_value(o->v1.p), slot_value(o->v2.p), o->v4.p));
+}
- cur_code = current_code(sc);
- slot_set_value(sc->error_code, cur_code);
-#if WITH_HISTORY
- slot_set_value(sc->error_history, sc->cur_code);
- if (sc->using_history1)
- sc->cur_code = sc->eval_history2;
- else sc->cur_code = sc->eval_history1;
- sc->using_history1 = (!sc->using_history1);
-#endif
+static s7_pointer opt_p_ppp_fff(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_pointer po1, po2;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ po1 = o1->v7.fp(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ po2 = o1->v7.fp(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o->v3.p_ppp_f(po1, po2, o1->v7.fp(o1)));
+}
- if ((is_pair(cur_code)) && /* can be () if unexpected close paren read error */
- (has_line_number(cur_code)))
+static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ s7_p_ppp_t func;
+ func = s7_p_ppp_function(s_func);
+ if (func)
{
- int line;
- line = (int)pair_line(cur_code); /* cast to int (from unsigned int) for last_line */
- if (line != last_line)
+ int start;
+ s7_pointer sig, checker = NULL;
+ sig = s7_procedure_signature(sc, s_func);
+ if ((is_pair(sig)) &&
+ (is_pair(cdr(sig))) &&
+ (is_symbol(cadr(sig))))
+ checker = cadr(sig);
+ start = sc->pc;
+
+ opc->v3.p_ppp_f = func;
+ if (is_symbol(cadr(car_x))) /* dealt with at the top -> p1 */
{
- last_line = line;
- if (line > 0)
+ s7_pointer slot;
+ slot = find_symbol(sc, cadr(car_x));
+ if ((!is_slot(slot)) ||
+ (has_methods(slot_value(slot))))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ if ((s7_is_vector(slot_value(slot))) &&
+ (vector_rank(slot_value(slot)) > 1))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc->v1.p = slot;
+
+ if ((s7_p_ppp_direct_function(s_func)) &&
+ (checker))
+ {
+ checker = s7_symbol_value(sc, checker);
+ 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)))
+ {
+ slot = find_symbol(sc, caddr(car_x));
+ if ((is_slot(slot)) &&
+ (!has_methods(slot_value(slot))))
+ {
+ opc->v2.p = slot;
+ if (is_symbol(cadddr(car_x)))
+ {
+ slot = find_symbol(sc, cadddr(car_x));
+ if ((is_slot(slot)) &&
+ (!has_methods(slot_value(slot))))
+ {
+ opc->v4.p_ppp_f = opc->v3.p_ppp_f;
+ opc->v3.p = slot;
+ opc->v7.fp = opt_p_ppp_sss;
+ return(true);
+ }
+ }
+ else
+ {
+ if ((!is_pair(cadddr(car_x))) ||
+ (car(cadddr(car_x)) == sc->quote_symbol))
+ {
+ if (!is_pair(cadddr(car_x)))
+ opc->v4.p = cadddr(car_x);
+ else opc->v4.p = cadr(cadddr(car_x));
+ opc->v7.fp = opt_p_ppp_ssc;
+ return(true);
+ }
+ }
+ if (cell_optimize(sc, cdddr(car_x)))
+ {
+ opc->v7.fp = opt_p_ppp_ssf;
+ return(true);
+ }
+ pc_fallback(sc, start);
+ }
+ }
+ if ((is_proper_quote(sc, caddr(car_x))) &&
+ (is_symbol(cadddr(car_x))))
{
- slot_set_value(sc->error_line, make_integer(sc, remembered_line_number(line)));
- slot_set_value(sc->error_file, remembered_file_name(line));
+ s7_pointer val_slot;
+ val_slot = find_symbol(sc, cadddr(car_x));
+ if ((is_slot(val_slot)) &&
+ (!has_methods(val_slot)))
+ {
+ opc->v4.p = cadr(caddr(car_x));
+ opc->v2.p = val_slot;
+ opc->v7.fp = opt_p_ppp_scs;
+ return(true);
+ }
}
- else
+ if (cell_optimize(sc, cddr(car_x)))
+ {
+ if (is_symbol(cadddr(car_x)))
+ {
+ s7_pointer val_slot;
+ val_slot = find_symbol(sc, cadddr(car_x));
+ if ((is_slot(val_slot)) &&
+ (!has_methods(val_slot)))
+ {
+ opc->v2.p = val_slot;
+ opc->v7.fp = opt_p_ppp_sfs;
+ return(true);
+ }
+ }
+ if (cell_optimize(sc, cdddr(car_x)))
+ {
+ opc->v7.fp = opt_p_ppp_sff;
+ return(true);
+ }
+ }
+ }
+ else
+ {
+ if ((cell_optimize(sc, cdr(car_x))) &&
+ (cell_optimize(sc, cddr(car_x))) &&
+ (cell_optimize(sc, cdddr(car_x))))
{
- slot_set_value(sc->error_line, sc->F);
- slot_set_value(sc->error_file, sc->F);
+ opc->v7.fp = opt_p_ppp_fff;
+ return(true);
}
}
+ pc_fallback(sc, start);
}
- else
+ return(false);
+}
+
+/* -------- p_cf_ppp -------- */
+static s7_pointer opt_p_cf_ppp(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_pointer po1, po2, po3;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ po1 = o1->v7.fp(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ po2 = 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)));
+}
+
+static bool p_cf_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
+{
+ int start;
+ start = sc->pc;
+ if ((is_safe_procedure(s_func)) &&
+ (c_function_required_args(s_func) <= 3) &&
+ (c_function_all_args(s_func) >= 3) &&
+ (cell_optimize(sc, cdr(car_x))) &&
+ (cell_optimize(sc, cddr(car_x))) &&
+ (cell_optimize(sc, cdddr(car_x))))
{
- slot_set_value(sc->error_line, sc->F);
- slot_set_value(sc->error_file, sc->F);
+ opc->v2.cf = cf_call(sc, car_x, s_func, 3);
+ opc->v7.fp = opt_p_cf_ppp;
+ return(true);
}
+ pc_fallback(sc, start);
+ return(false);
+}
- { /* look for a catcher */
- int 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)
- {
- catch_function catcher;
- catcher = catchers[stack_op(sc->stack, i)];
- /* fprintf(stderr, "catching %s %s\n", DISPLAY(type), DISPLAY(info)); */
- if ((catcher) &&
- (catcher(sc, i, type, info, &reset_error_hook)))
- {
- if (sc->longjmp_ok) longjmp(sc->goto_start, CATCH_JUMP);
- /* all the rest of the code expects s7_error to jump, not return,
- * so presumably if we get here, we're in trouble -- try to send out an error message
- */
- /* return(type); */
- /* fprintf(stderr, "falling through now\n"); */
- }
- }
- }
- /* error not caught */
- /* (set! *error-hook* (list (lambda (hook) (apply format #t (hook 'args))))) */
+/* -------- p_cf_any -------- */
+static s7_pointer opt_p_cf_any(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ s7_pointer arg;
+ int i, tx;
+ tx = next_tx(cur_sc);
+ cur_sc->t_temps[tx] = safe_list_if_possible(cur_sc, o->v1.i);
+ for (i = 0, arg = cur_sc->t_temps[tx]; i < o->v1.i; i++, arg = cdr(arg))
+ {
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ car(arg) = o1->v7.fp(o1);
+ }
+ arg = o->v2.cf(cur_sc, cur_sc->t_temps[tx]);
+ clear_list_in_use(cur_sc->t_temps[tx]);
+ cur_sc->current_safe_list = 0;
+ return(arg);
+}
- if ((!reset_error_hook) &&
- (is_procedure(sc->error_hook)) &&
- (hook_has_functions(sc->error_hook)))
+static bool p_cf_any_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int 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)))
{
- s7_pointer error_hook_func;
- /* (set! (hook-functions *error-hook*) (list (lambda (h) (format *stderr* "got error ~A~%" (h 'args))))) */
+ s7_pointer p;
+ opc->v1.i = (len - 1);
+ for (p = cdr(car_x); is_pair(p); p = cdr(p))
+ if (!cell_optimize(sc, p))
+ break;
+ if (is_null(p))
+ {
+ opc->v7.fp = opt_p_cf_any;
+ opc->v2.cf = cf_call(sc, car_x, s_func, len - 1);
+ return(true);
+ }
+ }
+ return(false);
+}
- error_hook_func = sc->error_hook;
- sc->error_hook = sc->F;
- /* if the *error-hook* functions trigger an error, we had better not have *error-hook* still set! */
+/* -------- cell_all_x -------- */
- push_stack(sc, OP_ERROR_HOOK_QUIT, sc->nil, error_hook_func); /* restore *error-hook* upon successful (or any!) evaluation */
- sc->args = list_2(sc, type, info);
- sc->code = error_hook_func;
+static s7_pointer opt_unwrap_cell(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ return(o->v2.all_f(cur_sc, car(o->v1.p)));
+}
- /* if we drop into the longjmp below, the hook functions are not called!
- * OP_ERROR_HOOK_QUIT performs the longjmp, so it should be safe to go to eval.
- */
- eval(sc, OP_APPLY);
+static bool cell_all_x_ok(s7_scheme *sc, s7_pointer expr, int start)
+{
+ s7_function opt;
+ opt = all_x_optimize(sc, expr);
+ if (opt)
+ {
+ opt_info *opc;
+ pc_fallback(sc, start + 1); /* ?? TODO: are int|float_all_x_ok because all previous checks clean up via pc_fallback? */
+ opc = sc->opts[start];
+ opc->v2.all_f = opt;
+ opc->v7.fp = opt_unwrap_cell;
+ opc->v1.p = expr;
+ return(true);
}
- else
+ return(false);
+}
+
+/* -------- p_implicit -------- */
+static bool funcall_optimize(s7_scheme *sc, s7_pointer car_x, s7_pointer s_func);
+
+static bool p_implicit(s7_scheme *sc, s7_pointer car_x, int len)
+{
+ s7_pointer s_slot;
+ s_slot = find_symbol(sc, car(car_x));
+
+ if (is_slot(s_slot))
{
- if (port_is_closed(sc->error_port))
- sc->error_port = sc->standard_error;
- /* if info is not a list, send object->string to current error port,
- * else assume car(info) is a format control string, and cdr(info) are its args
- *
- * if at all possible, get some indication of where we are!
- */
- if ((!s7_is_list(sc, info)) ||
- (!is_string(car(info))))
- format_to_port(sc, sc->error_port, "\n;~S ~S", set_plist_2(sc, type, info), NULL, false, 7);
- else
+ s7_pointer obj;
+ obj = slot_value(s_slot);
+
+ if ((is_closure(obj)) && /* need larger opts array if has_optlist removed */
+ (has_optlist(obj)))
{
- /* it's possible that the error string is just a string -- not intended for format */
- if ((type != sc->format_error_symbol) && /* avoid an infinite loop of format errors */
- (strchr(string_value(car(info)), '~')))
- {
- char *errstr;
- int len, str_len;
- len = string_length(car(info)) + 8;
- tmpbuf_malloc(errstr, len);
- str_len = snprintf(errstr, len, "\n;%s", string_value(car(info)));
- format_to_port(sc, sc->error_port, errstr, cdr(info), NULL, false, str_len);
- tmpbuf_free(errstr, len);
- }
- else format_to_port(sc, sc->error_port, "\n;~S ~S", set_plist_2(sc, type, info), NULL, false, 7);
+ /* fprintf(stderr, "%d opt: %s %s\n", __LINE__, DISPLAY(car_x), DISPLAY(obj)); */
+ return(funcall_optimize(sc, car_x, obj));
}
-
- /* now display location at end */
-
- if ((is_input_port(sc->input_port)) &&
- (port_file(sc->input_port) != stdin) &&
- (!port_is_closed(sc->input_port)))
+
+ if (is_sequence(obj))
{
- const char *filename = NULL;
- int line;
-
- filename = port_filename(sc->input_port);
- line = port_line_number(sc->input_port);
-
- if (filename)
- format_to_port(sc, sc->error_port, "\n; ~A[~D]", set_plist_2(sc, make_string_wrapper(sc, filename), make_integer(sc, line)), NULL, false, 10);
- else
+ opt_info *opc;
+ opc = alloc_opo(sc, car_x);
+ opc->v1.p = s_slot;
+ if (len == 2)
{
- if ((line > 0) &&
- (slot_value(sc->error_line) != sc->F))
- format_to_port(sc, sc->error_port, "\n; line ~D", set_plist_1(sc, make_integer(sc, line)), NULL, false, 11);
+ /* TODO: c-object implicit ref is direct exists (pi case) */
+ switch (type(obj))
+ {
+ case T_STRING: opc->v3.p_pi_f = string_ref_p_pi_direct; break;
+ case T_PAIR: opc->v3.p_pi_f = list_ref_p_pi_direct; break;
+ case T_HASH_TABLE: opc->v3.p_pp_f = hash_table_ref_p_pp_direct; break;
+ case T_LET: opc->v3.p_pp_f = let_ref_p_pp; break;
+
+ case T_VECTOR:
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ if (vector_rank(obj) != 1)
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc->v3.p_pi_f = vector_ref_p_pi_direct;
+ break;
+
+ case T_C_OBJECT:
+ if (c_object_direct_ref(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!
+ */
+
+ default:
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ if (is_symbol(cadr(car_x)))
+ {
+ s7_pointer slot;
+ slot = find_symbol(sc, cadr(car_x));
+ if (is_slot(slot))
+ {
+ opc->v2.p = slot;
+ if ((!is_hash_table(obj)) &&
+ (!is_let(obj)))
+ {
+ if (is_opt_int(slot_value(slot)))
+ {
+ opc->v7.fp = opt_p_pi_ss;
+ if ((is_string(obj)) &&
+ (is_step_end(opc->v2.p)) &&
+ (denominator(slot_value(opc->v2.p)) <= string_length(obj)))
+ opc->v3.p_pi_f = string_ref_unchecked;
+ else
+ {
+ if ((s7_is_vector(obj)) &&
+ (is_step_end(opc->v2.p)) &&
+ (denominator(slot_value(opc->v2.p)) <= vector_length(obj)))
+ opc->v3.p_pi_f = vector_ref_unchecked;
+ }
+ return(true);
+ }
+ else return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ opc->v7.fp = opt_p_pp_ss;
+ return(true);
+ }
+ }
else
{
- if (is_pair(sc->input_port_stack))
+ if ((!is_hash_table(obj)) &&
+ (!is_let(obj)))
{
- s7_pointer p;
- p = car(sc->input_port_stack);
- if ((is_input_port(p)) &&
- (port_file(p) != stdin) &&
- (!port_is_closed(p)))
+ if (is_integer(cadr(car_x)))
{
- filename = port_filename(p);
- line = port_line_number(p);
- if (filename)
- format_to_port(sc, sc->error_port, "\n; ~A[~D]",
- set_plist_2(sc, make_string_wrapper(sc, filename), make_integer(sc, line)), NULL, false, 10);
+ opc->v2.i = integer(cadr(car_x));
+ opc->v7.fp = opt_p_pi_sc;
+ return(true);
+ }
+ if (int_optimize(sc, cdr(car_x)))
+ {
+ opc->v7.fp = opt_p_pi_sf;
+ return(true);
}
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ if (cell_optimize(sc, cdr(car_x)))
+ {
+ opc->v7.fp = opt_p_pp_sf;
+ return(true);
}
}
- }
- }
- else
- {
- const char *call_name;
- call_name = sc->s7_call_name;
-
- /* sc->s7_call_name = NULL; */
- if (call_name)
+ } /* len==2 */
+ else
{
- sc->s7_call_name = NULL;
- if ((sc->s7_call_file) &&
- (sc->s7_call_line >= 0))
+ 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))
{
- format_to_port(sc, sc->error_port, "\n; ~A ~A[~D]",
- set_plist_3(sc,
- make_string_wrapper(sc, call_name),
- make_string_wrapper(sc, sc->s7_call_file),
- make_integer(sc, sc->s7_call_line)),
- NULL, false, 13);
+ 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);
}
}
- }
- s7_newline(sc, sc->error_port);
-
- if (is_string(slot_value(sc->error_file)))
- {
- format_to_port(sc, sc->error_port, "; ~S, line ~D",
- set_plist_2(sc, slot_value(sc->error_file), slot_value(sc->error_line)),
- NULL, false, 16);
- s7_newline(sc, sc->error_port);
- }
+ } /* obj is sequence */
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
+}
+
+/* -------- p_syntax -------- */
+/* -------- cell_quote -------- */
+static bool opt_cell_quote(s7_scheme *sc, s7_pointer car_x)
+{
+ opt_info *opc;
+ if (!is_null(cddr(car_x)))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc = alloc_opo(sc, car_x);
+ opc->v1.p = cadr(car_x);
+ opc->v7.fp = opt_p_c;
+ return(true);
+}
- /* look for __func__ in the error environment etc */
- if (sc->error_port != sc->F)
- {
- char *errstr;
- errstr = stacktrace_1(sc,
- s7_integer(car(sc->stacktrace_defaults)),
- s7_integer(cadr(sc->stacktrace_defaults)),
- s7_integer(caddr(sc->stacktrace_defaults)),
- s7_integer(cadddr(sc->stacktrace_defaults)),
- s7_boolean(sc, s7_list_ref(sc, sc->stacktrace_defaults, 4)));
- if (errstr)
- {
- port_write_string(sc->error_port)(sc, ";\n", 2, sc->error_port);
- port_write_string(sc->error_port)(sc, errstr, strlen(errstr), sc->error_port);
- free(errstr);
- port_write_character(sc->error_port)(sc, '\n', sc->error_port);
- }
- }
- else
+/* -------- cell_set -------- */
+static s7_pointer opt_arg_type(s7_scheme *sc, s7_pointer argp)
+{
+ s7_pointer arg;
+ arg = car(argp);
+ if (is_pair(arg))
+ {
+ if ((is_symbol(car(arg))) &&
+ ((is_global(car(arg))) ||
+ ((is_slot(global_slot(car(arg)))) &&
+ (find_symbol(sc, car(arg)) == global_slot(car(arg))))))
{
- if (is_pair(slot_value(sc->error_code)))
+ s7_pointer a_func;
+ a_func = slot_value(global_slot(car(arg)));
+ if (is_c_function(a_func))
{
- format_to_port(sc, sc->error_port, "; ~S", set_plist_1(sc, slot_value(sc->error_code)), NULL, false, 7);
- s7_newline(sc, sc->error_port);
+ s7_pointer sig;
+ sig = s7_procedure_signature(sc, a_func);
+ if (is_pair(sig))
+ {
+ if ((car(sig) == sc->is_integer_symbol) ||
+ ((is_pair(car(sig))) && (direct_memq(sc->is_integer_symbol, car(sig)))))
+ return(sc->is_integer_symbol);
+ if ((car(sig) == sc->is_float_symbol) ||
+ ((is_pair(car(sig))) && (direct_memq(sc->is_float_symbol, car(sig)))))
+ return(sc->is_float_symbol);
+ if ((car(sig) == sc->is_real_symbol) ||
+ (car(sig) == sc->is_number_symbol))
+ {
+ int start;
+ start = sc->pc;
+ if (int_optimize(sc, argp))
+ {
+ pc_fallback(sc, start);
+ return(sc->is_integer_symbol);
+ }
+ if (float_optimize(sc, argp))
+ {
+ pc_fallback(sc, start);
+ return(sc->is_float_symbol);
+ }
+ pc_fallback(sc, start);
+ }
+ return(car(sig)); /* we want the function's return type in this context */
+ }
}
}
-
- /* if (is_continuation(type))
- * go into repl here with access to continuation? Or expect *error-handler* to deal with it?
- */
- sc->value = type;
- /* stack_reset(sc); */
- sc->op = OP_ERROR_QUIT;
+ return(sc->T);
+ }
+ if (is_symbol(arg))
+ {
+ s7_pointer slot;
+ slot = find_symbol(sc, arg);
+ if ((!is_slot(slot)) ||
+ (has_methods(slot_value(slot))))
+ return(sc->T);
+ return(s7_type_of(slot_value(slot)));
}
+ return(s7_type_of(arg));
+}
- if (sc->longjmp_ok) longjmp(sc->goto_start, ERROR_JUMP);
- return(type);
+static s7_pointer opt_set_p_p_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_pointer x;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ x = o1->v7.fp(o1);
+ slot_set_value(o->v1.p, x);
+ return(x);
}
+static s7_pointer opt_set_p_i_s(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ s7_pointer val;
+ val = slot_value(o->v2.p);
+ if (is_mutable(val))
+ val = make_integer(cur_sc, integer(val));
+ slot_set_value(o->v1.p, val);
+ return(val);
+}
-static s7_pointer apply_error(s7_scheme *sc, s7_pointer obj, s7_pointer args)
+static s7_pointer opt_set_p_i_f(void *p)
{
- /* the operator type is needed here else the error message is confusing:
- * (apply '+ (list 1 2))) -> ;attempt to apply + to (1 2)?
- */
- static s7_pointer errstr = NULL;
- if (is_null(obj))
- return(s7_error(sc, sc->syntax_error_symbol, set_elist_2(sc, make_string_wrapper_with_length(sc, "attempt to apply nil to ~S?", 27), args)));
- if (!errstr)
- errstr = s7_make_permanent_string("attempt to apply ~A ~S to ~S?");
- return(s7_error(sc, sc->syntax_error_symbol, set_elist_4(sc, errstr, type_name_string(sc, obj), obj, args)));
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_pointer x;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ x = make_integer(cur_sc, o1->v7.fi(o1));
+ slot_set_value(o->v1.p, x);
+ return(x);
+}
+
+static s7_pointer opt_set_p_d_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_pointer x;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ x = make_real(cur_sc, o1->v7.fd(o1));
+ slot_set_value(o->v1.p, x);
+ return(x);
+}
+
+static s7_pointer opt_set_p_i_fo(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ s7_pointer x;
+ x = make_integer(cur_sc, o->v4.i_ii_f(integer(slot_value(o->v2.p)), integer(slot_value(o->v3.p))));
+ slot_set_value(o->v1.p, x);
+ return(x);
+}
+
+static s7_pointer opt_set_p_i_fo1(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ s7_pointer x;
+ s7_int i;
+ i = o->v4.i_ii_f(integer(slot_value(o->v2.p)), o->v3.i);
+ x = make_integer(cur_sc, i);
+ slot_set_value(o->v1.p, x);
+ return(x);
+}
+
+static bool set_p_i_f_combinable(s7_scheme *sc, opt_info *opc)
+{
+ if ((sc->pc > 1) &&
+ (opc == sc->opts[sc->pc - 2]))
+ {
+ opt_info *o1;
+ o1 = sc->opts[sc->pc - 1];
+ if (o1->v7.fi == opt_i_ii_ss)
+ {
+ opc->v4.i_ii_f = o1->v3.i_ii_f;
+ opc->v2.p = o1->v1.p;
+ opc->v3.p = o1->v2.p;
+ opc->v7.fp = opt_set_p_i_fo;
+ sc->pc--;
+ return(true);
+ }
+ if (o1->v7.fi == opt_i_ii_sc)
+ {
+ opc->v4.i_ii_f = o1->v3.i_ii_f;
+ opc->v2.p = o1->v1.p;
+ opc->v3.i = o1->v2.i;
+ opc->v7.fp = opt_set_p_i_fo1;
+ sc->pc--;
+ return(true);
+ }
+ }
+ return(false);
}
-
-static s7_pointer read_error_1(s7_scheme *sc, const char *errmsg, bool string_error)
+static bool is_some_number(s7_scheme *sc, s7_pointer tp)
{
- /* reader errors happen before the evaluator gets involved, so forms such as:
- * (catch #t (lambda () (car '( . ))) (lambda arg 'error))
- * do not catch the error if we simply signal an error when we encounter it.
- */
- char *msg;
- int len;
- s7_pointer pt;
+ return((tp == sc->is_integer_symbol) ||
+ (tp == sc->is_float_symbol) ||
+ (tp == sc->is_real_symbol) ||
+ (tp == sc->is_complex_symbol) ||
+ (tp == sc->is_number_symbol) ||
+ (tp == sc->is_rational_symbol));
+}
- /* fprintf(stderr, "read error: %s\n", errmsg); */
- pt = sc->input_port;
- if (!string_error)
+static bool opt_cell_set(s7_scheme *sc, s7_pointer car_x)
+{
+ opt_info *opc;
+ opc = alloc_opo(sc, car_x);
+ if (is_symbol(cadr(car_x)))
{
- /* make an heroic effort to find where we slid off the tracks */
-
- if (is_string_port(sc->input_port))
+ s7_pointer settee;
+ if ((is_immutable_symbol(cadr(car_x))) ||
+ (symbol_has_accessor(cadr(car_x))))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ settee = find_symbol(sc, cadr(car_x));
+ if ((is_slot(settee)) &&
+ (!is_syntax(slot_value(settee))))
{
- #define QUOTE_SIZE 40
- unsigned int i, j, start = 0, end, slen;
- char *recent_input = NULL;
+ /* type changes here can confuse the rest of the optimizer */
+ s7_pointer atype, stype;
+
+ opc->v1.p = settee;
+ stype = s7_type_of(slot_value(settee));
+
+ if (stype == sc->is_integer_symbol)
+ {
+ if (is_symbol(caddr(car_x)))
+ {
+ s7_pointer val_slot;
+ val_slot = find_symbol(sc, caddr(car_x));
+ if ((is_slot(val_slot)) &&
+ (is_opt_int(slot_value(val_slot))))
+ {
+ opc->v2.p = val_slot;
+ opc->v7.fp = opt_set_p_i_s;
+ return(true);
+ }
+ }
+ else
+ {
+ if (int_optimize(sc, cddr(car_x)))
+ {
+ if (!set_p_i_f_combinable(sc, opc))
+ opc->v7.fp = opt_set_p_i_f;
+ return(true);
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ }
+ if (stype == sc->is_float_symbol)
+ {
+ if (float_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fp = opt_set_p_d_f;
+ return(true);
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ atype = opt_arg_type(sc, cddr(car_x));
+
+ if ((is_some_number(sc, atype)) &&
+ (!is_some_number(sc, stype)))
+ return(return_false(sc, car_x, __func__, __LINE__));
+
+ if (cell_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fp = opt_set_p_p_f;
+ return(true);
+ }
+ }
+ }
+ else
+ {
+ if ((is_pair(cadr(car_x))) &&
+ (is_symbol(caadr(car_x))) &&
+ (is_pair(cdadr(car_x))) &&
+ (is_null(cddadr(car_x))))
+ {
+ s7_pointer s_slot;
+ s_slot = find_symbol(sc, caadr(car_x));
+ if (is_slot(s_slot))
+ {
+ s7_pointer obj;
+ opc->v1.p = s_slot;
+ obj = slot_value(s_slot);
+ if ((!has_methods(obj)) &&
+ (is_sequence(obj)))
+ {
+ s7_pointer index;
+ switch (type(obj))
+ {
+ case T_STRING:
+ opc->v3.p_pip_f = string_set_p_pip_direct;
+ break;
- /* we can run off the end in cases like (eval-string "(. . ,.)") or (eval-string " (@ . ,.)") */
- if (port_position(pt) >= port_data_size(pt))
- port_position(pt) = port_data_size(pt) - 1;
+ case T_VECTOR:
+ opc->v3.p_pip_f = vector_set_p_pip_direct;
+ break;
- /* start at current position and look back a few chars */
- for (i = port_position(pt), j = 0; (i > 0) && (j < QUOTE_SIZE); i--, j++)
- if ((port_data(pt)[i] == '\0') ||
- (port_data(pt)[i] == '\n') ||
- (port_data(pt)[i] == '\r'))
- break;
- start = i;
+ case T_FLOAT_VECTOR:
+ if (opt_float_vector_set(sc, opc, caadr(car_x), cdadr(car_x), cddr(car_x)))
+ {
+ opc->v8.fd = opc->v7.fd;
+ opc->v7.fp = d_to_p;
+ return(true);
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
+ break;
- /* start at current position and look ahead a few chars */
- for (i = port_position(pt), j = 0; (i < port_data_size(pt)) && (j < QUOTE_SIZE); i++, j++)
- if ((port_data(pt)[i] == '\0') ||
- (port_data(pt)[i] == '\n') ||
- (port_data(pt)[i] == '\r'))
- break;
+ case T_INT_VECTOR:
+ if (opt_int_vector_set(sc, opc, caadr(car_x), cdadr(car_x), cddr(car_x)))
+ {
+ opc->v8.fi = opc->v7.fi;
+ opc->v7.fp = i_to_p;
+ return(true);
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
+ break;
- end = i;
- slen = end - start;
- /* hopefully this is more or less the current line where the read error happened */
+ case T_PAIR:
+ opc->v3.p_pip_f = list_set_p_pip_direct;
+ break;
- if (slen > 0)
- {
- recent_input = (char *)calloc((slen + 9), sizeof(char));
- for (i = 0; i < (slen + 8); i++) recent_input[i] = '.';
- recent_input[3] = ' ';
- recent_input[slen + 4] = ' ';
- for (i = 0; i < slen; i++) recent_input[i + 4] = port_data(pt)[start + i];
- }
+ case T_HASH_TABLE:
+ opc->v3.p_ppp_f = hash_table_set_p_ppp_direct;
+ break;
- if ((port_line_number(pt) > 0) &&
- (port_filename(pt)))
- {
- len = safe_strlen(recent_input) + safe_strlen(errmsg) + port_filename_length(pt) + safe_strlen(sc->current_file) + 64;
- msg = (char *)malloc(len * sizeof(char));
- len = snprintf(msg, len, "%s: %s %s[%u], last top-level form at: %s[%d]",
- errmsg, (recent_input) ? recent_input : "", port_filename(pt), port_line_number(pt),
- sc->current_file, sc->current_line);
- }
- else
- {
- len = safe_strlen(recent_input) + safe_strlen(errmsg) + safe_strlen(sc->current_file) + 64;
- msg = (char *)malloc(len * sizeof(char));
+ case T_LET:
+ opc->v3.p_ppp_f = let_set_p_ppp;
+ break;
- if ((sc->current_file) &&
- (sc->current_line >= 0))
- len = snprintf(msg, len, "%s: %s, last top-level form at %s[%d]",
- errmsg, (recent_input) ? recent_input : "",
- sc->current_file, sc->current_line);
- else len = snprintf(msg, len, "%s: %s", errmsg, (recent_input) ? recent_input : "");
+ default:
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ index = cadadr(car_x);
+ if (is_symbol(index))
+ {
+ s7_pointer slot;
+ slot = find_symbol(sc, index);
+ if ((is_slot(slot)) &&
+ (!has_methods(slot_value(slot))))
+ {
+ opc->v2.p = slot;
+ if ((is_opt_int(slot_value(slot))) &&
+ (is_step_end(opc->v2.p)))
+ {
+ if ((is_string(obj)) &&
+ (denominator(slot_value(opc->v2.p)) <= string_length(obj)))
+ opc->v3.p_pip_f = string_set_unchecked;
+ else
+ {
+ if (s7_is_vector(obj))
+ {
+ if ((s7_is_vector(obj)) &&
+ (denominator(slot_value(opc->v2.p)) <= vector_length(obj)))
+ opc->v3.p_pip_f = vector_set_unchecked;
+ }
+ }
+ }
+ if (is_symbol(caddr(car_x)))
+ {
+ s7_pointer val_slot;
+ val_slot = find_symbol(sc, caddr(car_x));
+ if ((is_slot(val_slot)) &&
+ (!has_methods(val_slot)))
+ {
+ if ((is_string(obj)) ||
+ (s7_is_vector(obj)) ||
+ (is_pair(obj)))
+ {
+ opc->v4.p_pip_f = opc->v3.p_pip_f;
+ opc->v3.p = val_slot;
+ opc->v7.fp = opt_p_pip_sss;
+ }
+ else
+ {
+ opc->v4.p_ppp_f = opc->v3.p_ppp_f;
+ opc->v3.p = val_slot;
+ opc->v7.fp = opt_p_ppp_sss;
+ }
+ return(true);
+ }
+ }
+ else
+ {
+ if ((!is_pair(caddr(car_x))) ||
+ (is_proper_quote(sc, caddr(car_x))))
+ {
+ if (!is_pair(caddr(car_x)))
+ opc->v4.p = caddr(car_x);
+ else opc->v4.p = cadr(caddr(car_x));
+ if ((is_string(obj)) ||
+ (s7_is_vector(obj)) ||
+ (is_pair(obj)))
+ opc->v7.fp = opt_p_pip_ssc;
+ else opc->v7.fp = opt_p_ppp_ssc;
+ return(true);
+ }
+ }
+ if (cell_optimize(sc, cddr(car_x)))
+ {
+ if ((is_string(obj)) ||
+ (s7_is_vector(obj)) ||
+ (is_pair(obj)))
+ {
+ if (!p_pip_ssf_combinable(sc, opc))
+ opc->v7.fp = opt_p_pip_ssf;
+ }
+ else opc->v7.fp = opt_p_ppp_ssf;
+ return(true);
+ }
+ }
+ }
+ else
+ {
+ if ((is_string(obj)) ||
+ (is_pair(obj)) ||
+ (s7_is_vector(obj)))
+ {
+ if ((int_optimize(sc, cdadr(car_x))) &&
+ (cell_optimize(sc, cddr(car_x))))
+ {
+ opc->v7.fp = opt_p_pip_sff;
+ return(true);
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ if ((is_proper_quote(sc, cadadr(car_x))) &&
+ (is_symbol(caddr(car_x))))
+ {
+ s7_pointer val_slot;
+ val_slot = find_symbol(sc, caddr(car_x));
+ if ((is_slot(val_slot)) &&
+ (!has_methods(val_slot)))
+ {
+ opc->v4.p = cadr(cadadr(car_x));
+ opc->v2.p = val_slot;
+ opc->v7.fp = opt_p_ppp_scs;
+ return(true);
+ }
+ }
+ if (cell_optimize(sc, cdadr(car_x)))
+ {
+ if (is_symbol(caddr(car_x)))
+ {
+ s7_pointer val_slot;
+ val_slot = find_symbol(sc, caddr(car_x));
+ if ((is_slot(val_slot)) &&
+ (!has_methods(val_slot)))
+ {
+ opc->v2.p = val_slot;
+ opc->v7.fp = opt_p_ppp_sfs;
+ return(true);
+ }
+ }
+ if (cell_optimize(sc, cddr(car_x)))
+ {
+ opc->v7.fp = opt_p_ppp_sff;
+ return(true);
+ }
+ }
+ }
+ }
}
-
- if (recent_input) free(recent_input);
- return(s7_error(sc, sc->read_error_symbol, set_elist_1(sc, make_string_uncopied_with_length(sc, msg, len))));
}
}
+ return(return_false(sc, car_x, __func__, __LINE__));
+}
- if ((port_line_number(pt) > 0) &&
- (port_filename(pt)))
+/* -------- cell_begin -------- */
+static s7_pointer opt_begin_p(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ int i, len;
+ len = o->v1.i - 1;
+ for (i = 0; i < len; i++)
{
- len = safe_strlen(errmsg) + port_filename_length(pt) + safe_strlen(sc->current_file) + 128;
- msg = (char *)malloc(len * sizeof(char));
-
- if (string_error)
- len = snprintf(msg, len, "%s %s[%u],\n; possible culprit: \"%s...\"\n; last top-level form at %s[%d]",
- errmsg, port_filename(pt), port_line_number(pt),
- sc->strbuf, sc->current_file, sc->current_line);
- else len = snprintf(msg, len, "%s %s[%u], last top-level form at %s[%d]",
- errmsg, port_filename(pt), port_line_number(pt),
- sc->current_file, sc->current_line);
- return(s7_error(sc, sc->read_error_symbol, set_elist_1(sc, make_string_uncopied_with_length(sc, msg, len))));
+ o1 = cur_sc->opts[++cur_sc->pc];
+ o1->v7.fp(o1);
}
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o1->v7.fp(o1));
+}
- return(s7_error(sc, (string_error) ? sc->string_read_error_symbol : sc->read_error_symbol, set_elist_1(sc, make_string_wrapper(sc, (char *)errmsg))));
+static s7_pointer opt_begin_p_1(void *p)
+{
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ o1->v7.fp(o1);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o1->v7.fp(o1));
}
-static s7_pointer read_error(s7_scheme *sc, const char *errmsg)
+static bool opt_cell_begin(s7_scheme *sc, s7_pointer car_x, int len)
{
- return(read_error_1(sc, errmsg, false));
+ opt_info *opc;
+ s7_pointer p;
+ opc = alloc_opo(sc, car_x);
+ for (p = cdr(car_x); is_pair(p); p = cdr(p))
+ if (!cell_optimize(sc, p))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc->v1.i = len - 1;
+ opc->v7.fp = (len == 3) ? opt_begin_p_1 : opt_begin_p;
+ return(true);
+}
+
+/* -------- cell_when|unless -------- */
+static s7_pointer opt_when_p(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ if (o1->v7.fb(o1))
+ {
+ int i, len;
+ len = o->v1.i - 1;
+ for (i = 0; i < len; i++)
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ o1->v7.fp(o1);
+ }
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o1->v7.fp(o1));
+ }
+ cur_sc->pc = o->v3.i;
+ return(cur_sc->unspecified);
}
-static s7_pointer string_read_error(s7_scheme *sc, const char *errmsg)
+static s7_pointer opt_unless_p(void *p)
{
- return(read_error_1(sc, errmsg, true));
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ int i, len;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ if (o1->v7.fb(o1))
+ {
+ cur_sc->pc = o->v3.i;
+ return(cur_sc->unspecified);
+ }
+ len = o->v1.i - 1;
+ for (i = 0; i < len; i++)
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ o1->v7.fp(o1);
+ }
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o1->v7.fp(o1));
}
+static bool opt_cell_when(s7_scheme *sc, s7_pointer car_x, int len)
+{
+ s7_pointer p;
+ opt_info *opc;
+ opc = alloc_opo(sc, car_x);
+ if (!bool_optimize(sc, cdr(car_x)))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ for (p = cddr(car_x); is_pair(p); p = cdr(p))
+ if (!cell_optimize(sc, p))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc->v1.i = len - 2;
+ opc->v3.i = sc->pc - 1;
+ opc->v7.fp = ((car(car_x) == sc->when_symbol) ? opt_when_p : opt_unless_p);
+ return(true);
+}
-static s7_pointer g_error(s7_scheme *sc, s7_pointer args)
+/* -------- cell_cond -------- */
+static s7_pointer opt_cond(void *p)
{
- #define H_error "(error type ...) signals an error. The 'type' can be used with catch to trap \
-particular errors. If the error is not caught, s7 treats the second argument as a format control string, \
-and applies it to the rest of the arguments."
- #define Q_error pcl_t
+ opt_info *o = (opt_info *)p;
+ o->v2.p = cur_sc->unspecified;
+ while (cur_sc->pc < o->v1.i)
+ {
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ o1->v7.fp(o1);
+ }
+ return(o->v2.p);
+}
- if (is_not_null(args))
+static s7_pointer opt_cond_clause(void *p)
+{
+ /* top->p1 gets result, top->i1 is end index, o->v3.i is end of current clause, o->v1.i = body len */
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ if (o1->v7.fb(o1))
{
- if (is_string(car(args))) /* CL-style error? -- use tag = 'no-catch */
+ opt_info *top;
+ int i, len;
+ top = (opt_info *)(o->v5.obj);
+ len = o->v1.i - 1;
+ for (i = 0; i < len; i++)
{
- s7_error(sc, sc->no_catch_symbol, args); /* this can have trailing args (implicit format) */
- return(sc->unspecified);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ o1->v7.fp(o1);
}
- return(s7_error(sc, car(args), cdr(args)));
+ o1 = cur_sc->opts[++cur_sc->pc];
+ top->v2.p = o1->v7.fp(o1);
+ cur_sc->pc = top->v1.i;
+ return(top->v2.p);
}
- return(s7_error(sc, sc->nil, sc->nil));
+ cur_sc->pc = o->v3.i;
+ return(cur_sc->unspecified);
}
-
-static char *truncate_string(char *form, int len, use_write_t use_write, int *form_len)
+static s7_pointer opt_cond_2(void *p)
{
- unsigned char *f;
- f = (unsigned char *)form;
+ /* 2 branches, results 1 expr, else */
+ opt_info *o = (opt_info *)p;
+ opt_info *o1, *o2;
+ s7_pointer res;
+ cur_sc->pc += 2;
+ o2 = cur_sc->opts[cur_sc->pc]; /* this is the boolean expr of the first clause */
+ if (!o2->v7.fb(o2))
+ cur_sc->pc = o->v3.i; /* jump over first clause and #t */
+ o1 = cur_sc->opts[++cur_sc->pc];
+ res = o1->v7.fp(o1);
+ cur_sc->pc = o->v1.i; /* end of cond index */
+ return(res);
+}
- if (use_write != USE_DISPLAY)
- {
- /* I guess we need to protect the outer double quotes in this case */
- int i;
- for (i = len - 5; i >= (len / 2); i--)
- if (is_white_space((int)f[i]))
- {
- form[i] = '.';
- form[i + 1] = '.';
- form[i + 2] = '.';
- form[i + 3] = '"';
- form[i + 4] = '\0';
- (*form_len) = i + 4;
- return(form);
- }
- i = len - 5;
- if (i > 0)
+static bool opt_cell_cond(s7_scheme *sc, s7_pointer car_x)
+{
+ /* top->v2.p gets result, top->v1.i is end index, clause->v3.i is end of current clause,
+ * clause->v1.i = clause result len, clause->v5.obj = top
+ */
+ s7_pointer p, last_clause = NULL;
+ opt_info *top;
+ int branches = 0, max_blen = 0, start_pc;
+
+ top = alloc_opo(sc, car_x);
+ start_pc = sc->pc;
+ for (p = cdr(car_x); is_pair(p); p = cdr(p), branches++)
+ {
+ opt_info *opc;
+ s7_pointer clause, cp;
+ int blen;
+ clause = car(p);
+ if ((!is_pair(clause)) ||
+ (!is_pair(cdr(clause))) || /* leave the test->result case for later */
+ (cadr(clause) == sc->feed_to_symbol))
+ return(return_false(sc, clause, __func__, __LINE__));
+
+ last_clause = clause;
+ opc = alloc_opo(sc, car_x);
+ if ((car(clause) == sc->else_symbol) ||
+ (car(clause) == sc->T))
{
- form[i] = '.';
- form[i + 1] = '.';
- form[i + 2] = '.';
- form[i + 3] = '"';
- form[i + 4] = '\0';
+ opt_info *opb;
+ opb = alloc_opo(sc, clause);
+ opb->v7.fb = opt_b_t;
}
else
{
- if (len >= 2)
- {
- form[len - 1] = '"';
- form[len] = '\0';
- }
+ if (!bool_optimize(sc, clause))
+ return(return_false(sc, clause, __func__, __LINE__));
}
+ for (blen = 0, cp = cdr(clause); is_pair(cp); blen++, cp = cdr(cp))
+ if (!cell_optimize(sc, cp))
+ return(return_false(sc, cp, __func__, __LINE__));
+ opc->v1.i = blen;
+ if (max_blen < blen) max_blen = blen;
+ opc->v3.i = sc->pc - 1;
+ opc->v5.obj = (void *)top;
+ opc->v7.fp = opt_cond_clause;
}
- else
+ top->v1.i = sc->pc - 1;
+ top->v7.fp = opt_cond;
+ if (branches == 2)
{
- int i;
- for (i = len - 4; i >= (len / 2); i--)
- if (is_white_space((int)f[i]))
- {
- form[i] = '.';
- form[i + 1] = '.';
- form[i + 2] = '.';
- form[i + 3] = '\0';
- (*form_len) = i + 3;
- return(form);
- }
- i = len - 4;
- if (i >= 0)
+ if ((max_blen == 1) &&
+ ((car(last_clause) == sc->else_symbol) ||
+ (car(last_clause) == sc->T)))
{
- form[i] = '.';
- form[i + 1] = '.';
- form[i + 2] = '.';
- form[i + 3] = '\0';
+ opt_info *o1;
+ o1 = sc->opts[start_pc];
+ top->v3.i = o1->v3.i + 2;
+ top->v7.fp = opt_cond_2;
}
- else form[len] = '\0';
}
- return(form);
+ return(true);
}
+/* -------- cell_and|or -------- */
+static s7_pointer opt_and_pp(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ if (o1->v7.fp(o1) == cur_sc->F)
+ {
+ cur_sc->pc = o->v1.i;
+ return(cur_sc->F);
+ }
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o1->v7.fp(o1));
+}
-static char *object_to_truncated_string(s7_scheme *sc, s7_pointer p, int len)
+static s7_pointer opt_and_any_p(void *p)
{
- char *s;
- int s_len;
- s = s7_object_to_c_string(sc, p);
- s_len = safe_strlen(s);
- if (s_len > len)
- return(truncate_string(s, len, USE_DISPLAY, &s_len));
- return(s);
+ opt_info *o = (opt_info *)p;
+ int i;
+ s7_pointer val;
+ val = cur_sc->T; /* (and) -> #t */
+ for (i = 0; i < o->v1.i; i++)
+ {
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ val = o1->v7.fp(o1);
+ if (val == cur_sc->F)
+ {
+ cur_sc->pc = o->v2.i;
+ return(cur_sc->F);
+ }
+ }
+ return(val);
}
+static s7_pointer opt_or_pp(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_pointer val;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ val = o1->v7.fp(o1);
+ if (val != cur_sc->F)
+ {
+ cur_sc->pc = o->v1.i;
+ return(val);
+ }
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o1->v7.fp(o1));
+}
-static s7_pointer tree_descend(s7_scheme *sc, s7_pointer p, unsigned int line)
+static s7_pointer opt_or_any_p(void *p)
{
- s7_pointer tp;
- if (!is_pair(p)) return(NULL);
- if (has_line_number(p))
+ opt_info *o = (opt_info *)p;
+ int i;
+ s7_pointer val;
+ val = cur_sc->F; /* (or) -> #f */
+ for (i = 0; i < o->v1.i; i++)
{
- unsigned int x;
- x = (unsigned int)remembered_line_number(pair_line(p));
- if (x > 0)
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ val = o1->v7.fp(o1);
+ if (val != cur_sc->F)
{
- if (line == 0) /* first line number we encounter will be the current reader location (i.e. the end of the form) */
- line = x;
- else
- {
- if (x < line)
- return(p);
- }
+ cur_sc->pc = o->v2.i;
+ return(val);
}
}
- tp = tree_descend(sc, car(p), line);
- if (tp) return(tp);
- return(tree_descend(sc, cdr(p), line));
+ return(cur_sc->F);
}
-static char *current_input_string(s7_scheme *sc, s7_pointer pt)
+static bool opt_cell_and(s7_scheme *sc, s7_pointer car_x, int len)
{
- /* try to show the current input */
- if ((is_input_port(pt)) &&
- (!port_is_closed(pt)) &&
- (port_data(pt)) &&
- (port_position(pt) > 0))
+ opt_info *opc;
+ opc = alloc_opo(sc, car_x);
+ if (len == 3)
{
- const unsigned char *str;
- char *msg;
- int i, j, start;
- start = (int)port_position(pt) - 40;
- if (start < 0) start = 0;
- msg = (char *)malloc(64 * sizeof(char));
- str = (const unsigned char *)port_data(pt);
- for (i = start, j = 0; i < (int)port_position(pt); i++, j++)
- msg[j] = str[i];
- msg[j] = '\0';
- return(msg);
+ opt_info *wrapper;
+ int start;
+ opc->v7.fp = ((car(car_x) == sc->or_symbol) ? opt_or_pp : opt_and_pp);
+ wrapper = sc->opts[sc->pc];
+ start = sc->pc;
+ if (!cell_optimize(sc, cdr(car_x)))
+ {
+ pc_fallback(sc, start);
+ if (!bool_optimize_nw(sc, cdr(car_x)))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ wrapper->v8.fb = wrapper->v7.fb;
+ wrapper->v7.fp = b_to_p;
+ }
+ wrapper = sc->opts[sc->pc];
+ start = sc->pc;
+ if (!cell_optimize(sc, cddr(car_x)))
+ {
+ pc_fallback(sc, start);
+ if (!bool_optimize_nw(sc, cddr(car_x)))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ wrapper->v8.fb = wrapper->v7.fb;
+ wrapper->v7.fp = b_to_p;
+ }
+ opc->v1.i = sc->pc - 1;
+ return(true);
}
- return(NULL);
+ else
+ {
+ if (len > 0)
+ {
+ s7_pointer p;
+ opc->v1.i = (len - 1);
+ opc->v7.fp = ((car(car_x) == sc->or_symbol) ? opt_or_any_p : opt_and_any_p);
+ for (p = cdr(car_x); is_pair(p); p = cdr(p))
+ {
+ opt_info *wrapper;
+ int start;
+ wrapper = sc->opts[sc->pc];
+ start = sc->pc;
+ if (!cell_optimize(sc, p))
+ {
+ pc_fallback(sc, start);
+ if (!bool_optimize_nw(sc, p))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ wrapper->v8.fb = wrapper->v7.fb;
+ wrapper->v7.fp = b_to_p;
+ }
+ }
+ opc->v2.i = sc->pc - 1;
+ return(true);
+ }
+ }
+ return(false);
}
-
-static s7_pointer missing_close_paren_error(s7_scheme *sc)
+/* -------- cell_if -------- */
+static s7_pointer opt_if_bp(void *p)
{
- int len;
- char *msg, *syntax_msg = NULL;
- s7_pointer pt;
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ if (o1->v7.fb(o1))
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o1->v7.fp(o1));
+ }
+ cur_sc->pc = o->v1.i;
+ return(cur_sc->unspecified);
+}
- if ((unchecked_type(sc->envir) != T_LET) &&
- (sc->envir != sc->nil))
- sc->envir = sc->nil;
+static s7_pointer opt_if_bp_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ cur_sc->pc += 2;
+ o1 = cur_sc->opts[cur_sc->pc];
+ if (o->v2.b_p_f(o1->v7.fp(o1)))
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o1->v7.fp(o1));
+ }
+ cur_sc->pc = o->v1.i;
+ return(cur_sc->unspecified);
+}
- pt = sc->input_port;
+static s7_pointer opt_if_nbp(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ if (!o1->v7.fb(o1))
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o1->v7.fp(o1));
+ }
+ cur_sc->pc = o->v1.i;
+ return(cur_sc->unspecified);
+}
+/* also b_ii_sf (mac) */
- /* check *missing-close-paren-hook* */
- if (hook_has_functions(sc->missing_close_paren_hook))
+static s7_pointer opt_if_nbp_f(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ cur_sc->pc += 2;
+ o1 = cur_sc->opts[cur_sc->pc];
+ if (!(o->v2.b_p_f(o1->v7.fp(o1))))
{
- s7_pointer result;
- if ((port_line_number(pt) > 0) &&
- (port_filename(pt)))
- {
- slot_set_value(sc->error_line, make_integer(sc, port_line_number(pt)));
- slot_set_value(sc->error_file, make_string_wrapper(sc, port_filename(pt)));
- }
- result = s7_call(sc, sc->missing_close_paren_hook, sc->nil);
- if (result != sc->unspecified)
- return(g_throw(sc, list_1(sc, result)));
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o1->v7.fp(o1));
}
+ cur_sc->pc = o->v1.i;
+ return(cur_sc->unspecified);
+}
- if (is_pair(sc->args))
+static s7_pointer opt_if_nbp_s(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ if (!(o->v2.b_p_f(slot_value(o->v3.p))))
{
- s7_pointer p;
- p = tree_descend(sc, sc->args, 0);
- if ((p) && (is_pair(p)) &&
- (has_line_number(p)))
- {
- int msg_len, form_len;
- char *form;
- form = object_to_truncated_string(sc, p, 40);
- form_len = safe_strlen(form);
- msg_len = form_len + 128;
- syntax_msg = (char *)malloc(msg_len * sizeof(char));
- snprintf(syntax_msg, msg_len, "; current form awaiting a close paren starts around line %u: %s", remembered_line_number(pair_line(p)), form);
- free(form);
- }
+ opt_info *o1;
+ cur_sc->pc += 2;
+ o1 = cur_sc->opts[cur_sc->pc];
+ return(o1->v7.fp(o1));
}
+ cur_sc->pc = o->v1.i;
+ return(cur_sc->unspecified);
+}
- if ((port_line_number(pt) > 0) &&
- (port_filename(pt)))
+static s7_pointer opt_if_nbp_sc(void *p) /* b_pp_sc */
+{
+ opt_info *o = (opt_info *)p;
+ if (!(o->v3.b_pp_f(slot_value(o->v2.p), o->v4.p)))
{
- len = port_filename_length(pt) + safe_strlen(sc->current_file) + safe_strlen(syntax_msg) + 128;
- msg = (char *)malloc(len * sizeof(char));
- if (syntax_msg)
- {
- len = snprintf(msg, len, "missing close paren, %s[%u], last top-level form at %s[%d]\n%s",
- port_filename(pt), port_line_number(pt),
- sc->current_file, sc->current_line, syntax_msg);
- free(syntax_msg);
- }
- else len = snprintf(msg, len, "missing close paren, %s[%u], last top-level form at %s[%d]",
- port_filename(pt), port_line_number(pt),
- sc->current_file, sc->current_line);
- return(s7_error(sc, sc->read_error_symbol, set_elist_1(sc, make_string_uncopied_with_length(sc, msg, len))));
+ opt_info *o1;
+ cur_sc->pc += 2;
+ o1 = cur_sc->opts[cur_sc->pc];
+ return(o1->v7.fp(o1));
}
+ cur_sc->pc = o->v1.i;
+ return(cur_sc->unspecified);
+}
- if (syntax_msg)
+static s7_pointer opt_if_nbp_ss(void *p) /* b_ii_ss */
+{
+ opt_info *o = (opt_info *)p;
+ if (!(o->v3.b_ii_f(integer(slot_value(o->v2.p)), integer(slot_value(o->v4.p)))))
{
- len = safe_strlen(syntax_msg) + 128;
- msg = (char *)malloc(len * sizeof(char));
- len = snprintf(msg, len, "missing close paren\n%s\n", syntax_msg);
- free(syntax_msg);
- return(s7_error(sc, sc->read_error_symbol, set_elist_1(sc, make_string_uncopied_with_length(sc, msg, len))));
+ opt_info *o1;
+ cur_sc->pc += 2;
+ o1 = cur_sc->opts[cur_sc->pc];
+ return(o1->v7.fp(o1));
}
+ cur_sc->pc = o->v1.i;
+ return(cur_sc->unspecified);
+}
- {
- char *str;
- msg = (char *)malloc(128 * sizeof(char));
- str = current_input_string(sc, pt);
- len = snprintf(msg, 128, "missing close paren: %s", str);
- free(str);
- return(s7_error(sc, sc->read_error_symbol, set_elist_1(sc, make_string_uncopied_with_length(sc, msg, len))));
- }
+static s7_pointer opt_if_nbp_fs(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ cur_sc->pc += 2;
+ o1 = cur_sc->opts[cur_sc->pc];
+ if (!(o->v2.b_pi_f(o1->v7.fp(o1), integer(slot_value(o->v3.p))))) /* b_pi_fs */
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o1->v7.fp(o1));
+ }
+ cur_sc->pc = o->v1.i;
+ return(cur_sc->unspecified);
+}
- return(s7_error(sc, sc->read_error_symbol, set_elist_1(sc, make_string_wrapper(sc, "missing close paren"))));
+static s7_pointer opt_if_nbp_sf(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ cur_sc->pc += 2;
+ o1 = cur_sc->opts[cur_sc->pc];
+ if (!(o->v2.b_pp_f(slot_value(o->v3.p), o1->v7.fp(o1)))) /* b_pp_sf */
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o1->v7.fp(o1));
+ }
+ cur_sc->pc = o->v1.i;
+ return(cur_sc->unspecified);
}
+static s7_pointer opt_if_bpp(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ if (o1->v7.fb(o1))
+ {
+ s7_pointer val;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ val = o1->v7.fp(o1);
+ cur_sc->pc = o->v3.i;
+ return(val);
+ }
+ cur_sc->pc = o->v1.i;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ return(o1->v7.fp(o1));
+}
-static void improper_arglist_error(s7_scheme *sc)
+static bool opt_cell_if(s7_scheme *sc, s7_pointer car_x, int len)
{
- /* sc->code is the last (dotted) arg, sc->args is the arglist reversed not including sc->code
- * the original was `(,@(reverse args) . ,code) essentially
- */
- if (sc->args == sc->nil) /* (abs . 1) */
- s7_error(sc, sc->syntax_error_symbol, set_elist_1(sc, make_string_wrapper(sc, "function call is a dotted list?")));
- else s7_error(sc, sc->syntax_error_symbol,
- set_elist_2(sc, make_string_wrapper(sc, "improper list of arguments: ~S"),
- append_in_place(sc, sc->args = safe_reverse_in_place(sc, sc->args), sc->code)));
+ opt_info *opc;
+ opc = alloc_opo(sc, car_x);
+ if (len == 3)
+ {
+ opt_info *next;
+ next = sc->opts[sc->pc];
+ if ((is_pair(cadr(car_x))) &&
+ (caadr(car_x) == sc->not_symbol))
+ {
+ if ((bool_optimize(sc, cdadr(car_x))) &&
+ (cell_optimize(sc, cddr(car_x))))
+ {
+ opc->v7.fp = opt_if_nbp;
+ opc->v1.i = sc->pc - 1;
+ if (next->v7.fb == opt_b_p_f)
+ {
+ opc->v2.b_p_f = next->v2.b_p_f;
+ opc->v7.fp = opt_if_nbp_f;
+ }
+ if (next->v7.fb == opt_b_p_s)
+ {
+ opc->v2.b_p_f = next->v2.b_p_f;
+ opc->v3.p = next->v1.p;
+ opc->v7.fp = opt_if_nbp_s;
+ }
+ if (next->v7.fb == opt_b_pi_fs)
+ {
+ opc->v2.b_pi_f = next->v2.b_pi_f;
+ opc->v3.p = next->v1.p;
+ opc->v7.fp = opt_if_nbp_fs;
+ }
+ if (next->v7.fb == opt_b_pp_sf)
+ {
+ opc->v2.b_pp_f = next->v3.b_pp_f;
+ opc->v3.p = next->v1.p;
+ opc->v7.fp = opt_if_nbp_sf;
+ }
+ if (next->v7.fb == opt_b_pp_sc)
+ {
+ opc->v3.b_pp_f = next->v3.b_pp_f;
+ opc->v2.p = next->v1.p;
+ opc->v4.p = next->v2.p;
+ opc->v7.fp = opt_if_nbp_sc;
+ }
+ if (next->v7.fb == opt_b_ii_ss)
+ {
+ opc->v3.b_ii_f = next->v3.b_ii_f;
+ opc->v2.p = next->v1.p;
+ opc->v4.p = next->v2.p;
+ opc->v7.fp = opt_if_nbp_ss;
+ }
+ return(true);
+ }
+ }
+ else
+ {
+ if ((bool_optimize(sc, cdr(car_x))) &&
+ (cell_optimize(sc, cddr(car_x))))
+ {
+ opc->v7.fp = opt_if_bp;
+ opc->v1.i = sc->pc - 1;
+ if (next->v7.fb == opt_b_p_f)
+ {
+ opc->v2.b_p_f = next->v2.b_p_f;
+ opc->v7.fp = opt_if_bp_f;
+ }
+ return(true);
+ }
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ else
+ {
+ if (len == 4)
+ {
+ if ((bool_optimize(sc, cdr(car_x))) &&
+ (cell_optimize(sc, cddr(car_x))))
+ {
+ opc->v7.fp = opt_if_bpp;
+ opc->v1.i = sc->pc - 1;
+ if (cell_optimize(sc, cdddr(car_x)))
+ {
+ opc->v3.i = sc->pc - 1;
+ return(true);
+ }
+ }
+ }
+ }
+ return(false);
+}
+
+/* -------- cell_case -------- */
+static bool case_memv(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ s7_pointer z;
+ if (is_simple(x))
+ {
+ for (z = y; is_pair(z); z = cdr(z))
+ if (x == car(z))
+ return(true);
+ return(false);
+ }
+ for (z = y; is_pair(z); z = cdr(z))
+ if (s7_is_eqv(x, car(z))) return(true);
+ return(false);
}
-
-
-/* -------------------------------- leftovers -------------------------------- */
-
-
-void (*s7_begin_hook(s7_scheme *sc))(s7_scheme *sc, bool *val)
+static s7_pointer opt_case(void *p)
{
- return(sc->begin_hook);
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ o->v2.p = cur_sc->unspecified;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ o->v4.p = o1->v7.fp(o1);
+ while (cur_sc->pc < o->v1.i)
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ o1->v7.fp(o1);
+ }
+ return(o->v2.p);
}
-
-void s7_set_begin_hook(s7_scheme *sc, void (*hook)(s7_scheme *sc, bool *val))
+static s7_pointer opt_case_clause(void *p)
{
- sc->begin_hook = hook;
+ /* top->v2.p gets result, top->i1 is end index, top->v4.p is selector, o->v3.i is end of current clause, o->v1.i = body len */
+ opt_info *o = (opt_info *)p;
+ opt_info *top;
+ top = (opt_info *)(o->v5.obj);
+ if ((o->v2.p == cur_sc->else_symbol) ||
+ (case_memv(cur_sc, top->v4.p, o->v2.p)))
+ {
+ opt_info *o1;
+ int i, len;
+ len = o->v1.i - 1;
+ for (i = 0; i < len; i++)
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ o1->v7.fp(o1);
+ }
+ o1 = cur_sc->opts[++cur_sc->pc];
+ top->v2.p = o1->v7.fp(o1);
+ cur_sc->pc = top->v1.i;
+ return(top->v2.p);
+ }
+ cur_sc->pc = o->v3.i;
+ return(cur_sc->unspecified);
}
-
-static bool call_begin_hook(s7_scheme *sc)
+static bool opt_cell_case(s7_scheme *sc, s7_pointer car_x)
{
- bool result = false;
- /* originally begin_hook was bool (*hook)(s7_scheme *sc): the value was returned directly,
- * rather than going through a *bool arg (&result below). That works in gcc (Linux/OSX),
- * but does not work in MS Visual C++. In the latter, the compiler apparently completely
- * eliminates any local, returning (for example) a thread-relative stack-allocated value
- * directly, but then by the time we get here, that variable has vanished, and we get
- * garbage. We had to thwart the optimization by adding if ((flag) && (!flag)) fprintf(...);
- * So, in the new form (26-Jun-13), the value is passed directly into an s7 variable
- * that I hope can't be optimized out of existence.
+ /* top->v2.p gets result, top->v1.i is end index, clause->v3.i is end of current clause,
+ * clause->v1.i = clause result len, clause->v5.obj = top
*/
- opcode_t op;
- op = sc->op;
-
- push_stack(sc, OP_BARRIER, sc->args, sc->code);
- sc->begin_hook(sc, &result);
- if (result)
+ opt_info *top;
+ top = alloc_opo(sc, car_x);
+ if (cell_optimize(sc, cdr(car_x))) /* selector */
{
- /* set (owlet) in case we were interrupted and need to see why something was hung */
- slot_set_value(sc->error_type, sc->F);
- slot_set_value(sc->error_data, sc->value); /* was sc->F but we now clobber this below */
- slot_set_value(sc->error_code, current_code(sc));
- slot_set_value(sc->error_line, sc->F);
- slot_set_value(sc->error_file, sc->F);
-#if WITH_HISTORY
- slot_set_value(sc->error_history, sc->F);
-#endif
- set_outlet(sc->owlet, sc->envir);
-
- sc->value = s7_make_symbol(sc, "begin-hook-interrupt");
- /* otherwise the evaluator returns whatever random thing is in sc->value (normally #<closure>)
- * which makes debugging unnecessarily difficult.
- */
- s7_quit(sc); /* don't call gc here -- perhaps at restart somehow? */
+ s7_pointer p;
+ for (p = cddr(car_x); is_pair(p); p = cdr(p))
+ {
+ opt_info *opc;
+ s7_pointer clause, cp;
+ int blen;
+ clause = car(p);
+ if ((!is_pair(clause)) ||
+ ((!is_pair(car(clause))) && (car(clause) != sc->else_symbol)) ||
+ (!is_pair(cdr(clause))) ||
+ (cadr(clause) == sc->feed_to_symbol))
+ return(return_false(sc, clause, __func__, __LINE__));
+
+ opc = alloc_opo(sc, car_x);
+ if (car(clause) == sc->else_symbol)
+ {
+ if (!is_null(cdr(p)))
+ return(return_false(sc, clause, __func__, __LINE__));
+ opc->v2.p = sc->else_symbol;
+ }
+ else
+ {
+ if (!is_proper_list(sc, car(clause)))
+ return(return_false(sc, clause, __func__, __LINE__));
+ opc->v2.p = car(clause);
+ }
+
+ for (blen = 0, cp = cdr(clause); is_pair(cp); blen++, cp = cdr(cp))
+ if (!cell_optimize(sc, cp))
+ return(return_false(sc, cp, __func__, __LINE__));
+ if (!is_null(cp))
+ return(return_false(sc, cp, __func__, __LINE__));
+ opc->v1.i = blen;
+ opc->v3.i = sc->pc - 1;
+ opc->v5.obj = (void *)top;
+ opc->v7.fp = opt_case_clause;
+ }
+ if (!is_null(p))
+ return(return_false(sc, p, __func__, __LINE__));
+ top->v1.i = sc->pc - 1;
+ top->v7.fp = opt_case;
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 */
return(false);
}
-static s7_pointer apply_list_star(s7_scheme *sc, s7_pointer d)
+/* -------- cell_let_temporarily -------- */
+static s7_pointer opt_let_temporarily(void *p)
{
- s7_pointer p, q;
- /* we check this ahead of time: if (is_null(cdr(d))) return(car(d)); */
- p = cons(sc, car(d), cdr(d));
- q = p;
- while (is_not_null(cdr(cdr(p))))
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ int tx, i, len;
+ s7_pointer result;
+
+ tx = next_tx(cur_sc);
+ o1 = cur_sc->opts[++cur_sc->pc];
+
+ o->v4.p = slot_value(o->v1.p); /* save and protect old value */
+ cur_sc->t_temps[tx] = o->v4.p;
+ slot_set_value(o->v1.p, o1->v7.fp(o1)); /* set new value */
+
+ len = o->v2.i - 1;
+ for (i = 0; i < len; i++)
{
- d = cdr(d);
- set_cdr(p, cons(sc, car(d), cdr(d)));
- if (is_not_null(cdr(d)))
- p = cdr(p);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ o1->v7.fp(o1);
}
- set_cdr(p, car(cdr(p)));
- return(q);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ result = o1->v7.fp(o1);
+
+ slot_set_value(o->v1.p, o->v4.p); /* restore old */
+ return(result);
}
-static s7_pointer apply_list_error(s7_scheme *sc, s7_pointer lst)
+static bool opt_cell_let_temporarily(s7_scheme *sc, s7_pointer car_x, int len)
{
- return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "apply's last argument should be a proper list: ~S"), lst)));
+ if ((len > 2) &&
+ (is_pair(cadr(car_x))) &&
+ (is_pair(caadr(car_x))) &&
+ (is_null(cdadr(car_x))) && /* just one var for now */
+ (is_symbol(caaadr(car_x))) &&
+ (!is_immutable(caaadr(car_x))) &&
+ (!is_syntactic(caaadr(car_x))))
+ {
+ s7_pointer p;
+ opt_info *opc;
+ opc = alloc_opo(sc, car_x);
+ opc->v1.p = find_symbol(sc, caar(cadr(car_x)));
+ if (!is_slot(opc->v1.p))
+ return(return_false(sc, car_x, __func__, __LINE__));
+
+ if (!cell_optimize(sc, cdar(cadr(car_x))))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ for (p = cddr(car_x); is_pair(p); p = cdr(p))
+ if (!cell_optimize(sc, p))
+ return(return_false(sc, car_x, __func__, __LINE__));
+
+ opc->v2.i = len - 2;
+ opc->v7.fp = opt_let_temporarily;
+ return(true);
+ }
+ return(false);
}
-static s7_pointer g_apply(s7_scheme *sc, s7_pointer args)
+/* -------- cell_do -------- */
+static s7_pointer opt_do_any(void *p)
{
- #define H_apply "(apply func ...) applies func to the rest of the arguments"
- #define Q_apply s7_make_circular_signature(sc, 2, 3, sc->values_symbol, s7_make_signature(sc, 2, sc->is_procedure_symbol, sc->is_sequence_symbol), sc->T)
+ opt_info *o = (opt_info *)p; /* o->v2.p=frame, o->v1.i=body end index, o->v3.i=body length, o->v4.i(=return length, o->v5.i=end index */
+ opt_info *o1, *ostart;
+ int loop, i;
+ s7_pointer vp, old_e, result;
- /* can apply always be replaced with apply values?
- * (apply + '(1 2 3)) is the same as (+ (apply values '(1 2 3)))
- * not if apply* in disguise, I think:
- * (apply + 1 2 ()) -> 3
- * (apply + 1 2 (apply values ())) -> error
- */
- sc->code = car(args);
- if (is_null(cdr(args)))
- sc->args = sc->nil;
- else
+ old_e = cur_sc->envir;
+ cur_sc->envir = o->v2.p;
+
+ /* init */
+ for (vp = let_slots(o->v2.p); is_slot(vp); vp = next_slot(vp))
{
- if (is_safe_procedure(sc->code))
- {
- s7_pointer p, q;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ slot_set_value(vp, o1->v7.fp(o1));
+ }
- for (q = args, p = cdr(args); is_not_null(cdr(p)); q = p, p = cdr(p));
- /* the last arg is supposed to be a list, it will be spliced onto the end of the previous arg list (if any) below */
+ loop = ++cur_sc->pc;
+ ostart = cur_sc->opts[loop];
+ while (true)
+ {
+ /* end */
+ /* fprintf(stderr, "frame: %s\n", s7_object_to_c_string(cur_sc, o->v2.p)); */
+ if (ostart->v7.fb(ostart))
+ break;
- if (!is_proper_list(sc, car(p))) /* (apply + #f) etc */
- return(apply_list_error(sc, args));
- set_cdr(q, car(p));
- /* this would work: if (is_c_function(sc->code)) return(c_function_call(sc->code)(sc, cdr(args)));
- * but it omits the arg number check
- */
- push_stack(sc, OP_APPLY, cdr(args), sc->code);
- return(sc->nil);
- }
- else
+ /* body */
+ for (i = 0; i < o->v3.i; i++)
{
- /* here we have to copy the arg list */
- if (is_null(cddr(args)))
- sc->args = cadr(args);
- else sc->args = apply_list_star(sc, cdr(args));
-
- if (!is_proper_list(sc, sc->args)) /* (apply + #f) etc */
- return(apply_list_error(sc, args));
+ o1 = cur_sc->opts[++cur_sc->pc];
+ o1->v7.fp(o1);
}
+
+ /* step (let not let*) */
+ for (vp = let_slots(o->v2.p); is_slot(vp); vp = next_slot(vp))
+ if (has_stepper(vp))
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ slot_set_pending_value(vp, o1->v7.fp(o1));
+ /* fprintf(stderr, "step %s %s\n", s7_object_to_c_string(cur_sc, vp), s7_object_to_c_string(cur_sc, slot_pending_value(vp))); */
+ }
+ for (vp = let_slots(o->v2.p); is_slot(vp); vp = next_slot(vp))
+ if (has_stepper(vp))
+ slot_set_value(vp, slot_pending_value(vp));
+
+ cur_sc->pc = loop;
}
+ cur_sc->pc = o->v1.i;
- push_stack(sc, OP_APPLY, sc->args, sc->code);
- return(sc->nil);
+ /* result */
+ result = cur_sc->T;
+ for (i = 0; i < o->v4.i; i++)
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ result = o1->v7.fp(o1);
+ }
+ cur_sc->pc = o->v5.i;
+ cur_sc->envir = old_e;
+ return(result);
}
-s7_pointer s7_apply_function(s7_scheme *sc, s7_pointer fnc, s7_pointer args)
+static s7_pointer opt_do_no_vars(void *p)
{
-#if DEBUGGING
- {
- s7_pointer p;
- int argnum;
- _NFre(fnc);
- for (argnum = 0, p = _NFre(args); is_pair(p); argnum++, p = _NFre(cdr(p)))
- _NFre(car(p));
- }
-#endif
+ /* no vars, no return */
+ opt_info *o = (opt_info *)p; /* o->v2.p=frame, o->v1.i=body end index, o->v3.i=body length, o->v4.i=return length, o->v5.i=end index */
+ opt_info *ostart;
+ int loop, i;
+ s7_pointer old_e;
- if (is_c_function(fnc))
- return(c_function_call(fnc)(sc, args));
-
- push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
- sc->args = args;
- sc->code = fnc;
- eval(sc, OP_APPLY);
- /* we're limited in choices here -- the caller might be (say) car(sc->t1_1) = c_call(...) where the c_call
- * happens to fallback on a method -- we can't just push OP_APPLY and drop back into the evaluator normally.
- */
- return(sc->value);
+ old_e = cur_sc->envir;
+ cur_sc->envir = o->v2.p;
+ loop = ++cur_sc->pc;
+ ostart = cur_sc->opts[loop];
+ while (true)
+ {
+ if (ostart->v7.fb(ostart))
+ break;
+ for (i = 0; i < o->v3.i; i++)
+ {
+ opt_info *o1;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ o1->v7.fp(o1);
+ }
+ cur_sc->pc = loop;
+ }
+ cur_sc->pc = o->v5.i;
+ cur_sc->envir = old_e;
+ return(cur_sc->T);
}
-
-s7_pointer s7_eval(s7_scheme *sc, s7_pointer code, s7_pointer e)
+static s7_pointer opt_do_2(void *p)
{
- declare_jump_info();
-#if DEBUGGING
- _NFre(code);
-#endif
+ /* 1 var, no return */
+ opt_info *o = (opt_info *)p; /* o->v2.p=frame, o->v1.i=body end index, o->v3.i=body length, o->v4.i=return length, o->v5.i=end index */
+ opt_info *o1, *ostart;
+ int i, loop;
+ s7_pointer vp, old_e;
- store_jump_info(sc);
- set_jump_info(sc, EVAL_SET_JUMP);
- if (jump_loc != NO_JUMP)
- {
- if (jump_loc != ERROR_JUMP)
- eval(sc, sc->op);
- }
- else
+ old_e = cur_sc->envir;
+ cur_sc->envir = o->v2.p;
+
+ vp = let_slots(o->v2.p);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ slot_set_value(vp, o1->v7.fp(o1));
+
+ loop = ++cur_sc->pc;
+ ostart = cur_sc->opts[loop];
+ while (true)
{
- push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
- sc->code = code;
- if ((e != sc->rootlet) &&
- (is_let(e)))
- sc->envir = e;
- else sc->envir = sc->nil;
- eval(sc, OP_EVAL);
+ if (ostart->v7.fb(ostart))
+ break;
+ for (i = 0; i < o->v3.i; i++)
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ o1->v7.fp(o1);
+ }
+ o1 = cur_sc->opts[++cur_sc->pc];
+ slot_set_value(vp, o1->v7.fp(o1));
+ cur_sc->pc = loop;
}
- restore_jump_info(sc);
-
- if (is_multiple_value(sc->value))
- sc->value = splice_in_values(sc, multiple_value(sc->value));
- return(sc->value);
+ cur_sc->pc = o->v5.i;
+ cur_sc->envir = old_e;
+ return(cur_sc->T);
}
-
-static s7_pointer g_eval(s7_scheme *sc, s7_pointer args)
+static s7_pointer opt_dotimes_2(void *p)
{
- #define H_eval "(eval code (env (curlet))) evaluates code in the environment env. 'env' \
-defaults to the curlet; to evaluate something in the top-level environment instead, \
-pass (rootlet):\n\
-\n\
- (define x 32) \n\
- (let ((x 3))\n\
- (eval 'x (rootlet)))\n\
-\n\
- returns 32"
- #define Q_eval s7_make_signature(sc, 3, sc->values_symbol, sc->T, sc->is_let_symbol)
+ /* 1 var, no return */
+ opt_info *o = (opt_info *)p; /* o->v2.p=frame, o->v1.i=body end index, o->v3.i=body length, o->v4.i=return length, o->v5.i=end index, v6.i=end if int */
+ opt_info *o1;
+ int i, loop;
+ s7_int end;
+ s7_pointer vp, old_e;
- if (is_not_null(cdr(args)))
- {
- s7_pointer e;
- e = cadr(args);
- if (!is_let(e))
- return(wrong_type_argument_with_type(sc, sc->eval_symbol, 2, e, a_let_string));
- if (e == sc->rootlet)
- sc->envir = sc->nil;
- else sc->envir = e;
- }
- sc->code = car(args);
+ old_e = cur_sc->envir;
+ cur_sc->envir = o->v2.p;
- if (s7_stack_top(sc) < 12)
- push_stack(sc, OP_BARRIER, sc->nil, sc->nil);
- push_stack(sc, OP_EVAL, sc->args, sc->code);
+ vp = slot_value(dox_slot1(o->v2.p));
+ if (is_slot(dox_slot2_unchecked(o->v2.p)))
+ end = integer(slot_value(dox_slot2(o->v2.p)));
+ else end = o->v6.i;
- return(sc->nil);
-}
+ o1 = cur_sc->opts[++cur_sc->pc];
+ integer(vp) = integer(o1->v7.fp(o1));
+ loop = o->v4.i - 1;
+ while (integer(vp) < end)
+ {
+ cur_sc->pc = loop;
+ for (i = 0; i < o->v3.i; i++)
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ o1->v7.fp(o1);
+ }
+ integer(vp)++;
+ }
+ cur_sc->pc = o->v5.i;
+ cur_sc->envir = old_e;
+ return(cur_sc->T);
+}
-s7_pointer s7_call(s7_scheme *sc, s7_pointer func, s7_pointer args)
+static s7_pointer opt_do_simple(void *p)
{
- /* fprintf(stderr, "%s %s\n", DISPLAY(func), DISPLAY(args)); */
- declare_jump_info();
+ /* 1 var step by 1, 1 expr, no return */
+ opt_info *o = (opt_info *)p; /* o->v2.p=frame, o->v5.i=end index */
+ opt_info *o1, *ostart;
+ int loop;
+ s7_pointer vp, old_e;
- if (is_c_function(func))
- return(c_function_call(func)(sc, _NFre(args))); /* no check for wrong-number-of-args -- is that reasonable? */
+ old_e = cur_sc->envir;
+ cur_sc->envir = o->v2.p;
- sc->temp1 = _NFre(func); /* this is feeble GC protection */
- sc->temp2 = _NFre(args);
+ vp = let_slots(o->v2.p);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ slot_set_value(vp, o1->v7.fp(o1));
- store_jump_info(sc);
- set_jump_info(sc, S7_CALL_SET_JUMP);
- if (jump_loc != NO_JUMP)
+ loop = ++cur_sc->pc;
+ ostart = cur_sc->opts[loop];
+ while (true)
{
- if (jump_loc != ERROR_JUMP)
- eval(sc, sc->op);
+ if (ostart->v7.fb(ostart))
+ break;
- 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);
+ o1 = cur_sc->opts[++cur_sc->pc];
+ o1->v7.fp(o1);
+
+ o1 = cur_sc->opts[++cur_sc->pc];
+ slot_set_value(vp, o1->v7.fp(o1));
+ cur_sc->pc = loop;
}
- else
+ cur_sc->pc = o->v5.i;
+ cur_sc->envir = old_e;
+ return(cur_sc->T);
+}
+
+static s7_pointer opt_do_very_simple(void *p)
+{
+ /* like simple but step can be direct */
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_int end, loop;
+ s7_pointer vp, old_e;
+ s7_pointer (*f)(void *p);
+
+ old_e = cur_sc->envir;
+ cur_sc->envir = o->v2.p;
+
+ vp = slot_value(dox_slot1(o->v2.p));
+ if (is_slot(dox_slot2_unchecked(o->v2.p)))
+ end = integer(slot_value(dox_slot2(o->v2.p)));
+ else end = o->v3.i;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ integer(vp) = integer(o1->v7.fp(o1));
+
+ loop = o->v4.i;
+ cur_sc->pc = loop;
+ o1 = cur_sc->opts[loop]; /* the body */
+ f = o1->v7.fp;
+ while (integer(vp) < end)
{
-#if DEBUGGING
- {
- s7_pointer p;
- int argnum;
- /* incoming args may be non-s7 cells -- check now before they reach the GC */
- for (argnum = 0, p = _NFre(args); is_pair(p); argnum++, p = _NFre(cdr(p)))
- _NFre(car(p));
- }
-#endif
- push_stack(sc, OP_EVAL_DONE, sc->args, sc->code); /* this saves the current evaluation and will eventually finish this (possibly) nested call */
- sc->args = args;
- sc->code = func;
- /* besides a closure, "func" can also be an object (T_C_OBJECT) -- in Snd, a generator for example */
- eval(sc, OP_APPLY);
+ f(o1);
+ cur_sc->pc = loop;
+ integer(vp)++;
}
- restore_jump_info(sc);
-
- return(sc->value);
+ cur_sc->pc = o->v5.i;
+ cur_sc->envir = old_e;
+ return(cur_sc->T);
}
+static s7_pointer opt_do_prepackaged(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_int end;
+ s7_pointer vp, old_e;
-s7_pointer s7_call_with_location(s7_scheme *sc, s7_pointer func, s7_pointer args, const char *caller, const char *file, int line)
+ old_e = cur_sc->envir;
+ cur_sc->envir = o->v2.p;
+
+ vp = slot_value(dox_slot1(o->v2.p));
+ if (is_slot(dox_slot2_unchecked(o->v2.p)))
+ end = integer(slot_value(dox_slot2(o->v2.p)));
+ else end = o->v3.i;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ integer(vp) = integer(o1->v7.fp(o1));
+
+ o->v6.p = vp;
+ o->v1.i = end;
+ o->v8.fp(o);
+
+ cur_sc->pc = o->v5.i;
+ cur_sc->envir = old_e;
+ return(cur_sc->T);
+}
+
+static s7_pointer opt_do_dpnr(void *p)
{
- s7_pointer result;
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ int loop;
+ s7_pointer vp;
+ s7_int end;
+ s7_double (*f)(void *p);
- if (caller)
+ end = o->v1.i;
+ vp = o->v6.p;
+ loop = o->v4.i;
+ o1 = cur_sc->opts[loop]; /* the body */
+ f = o1->v8.fd;
+ while (integer(vp) < end)
{
- sc->s7_call_name = caller;
- sc->s7_call_file = file;
- sc->s7_call_line = line;
+ cur_sc->pc = loop;
+ f(o1);
+ integer(vp)++;
}
+ return(NULL);
+}
- result = s7_call(sc, func, args);
+static s7_pointer opt_do_ipnr(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ int loop;
+ s7_pointer vp;
+ s7_int end;
+ s7_int (*f)(void *p);
- if (caller)
+ end = o->v1.i;
+ vp = o->v6.p;
+ loop = o->v4.i;
+ o1 = cur_sc->opts[loop]; /* the body */
+ f = o1->v8.fi;
+ while (integer(vp) < end)
{
- sc->s7_call_name = NULL;
- sc->s7_call_file = NULL;
- sc->s7_call_line = -1;
+ cur_sc->pc = loop;
+ f(o1);
+ integer(vp)++;
}
- return(result);
+ return(NULL);
}
-
-static s7_pointer implicit_index(s7_scheme *sc, s7_pointer obj, s7_pointer indices)
+static s7_pointer opt_do_ifbp(void *p)
{
- /* (let ((lst '("12" "34"))) (lst 0 1)) -> #\2
- * (let ((lst (list #(1 2) #(3 4)))) (lst 0 1)) -> 2
- *
- * this can get tricky:
- * ((list (lambda (a) (+ a 1)) (lambda (b) (* b 2))) 1 2) -> 4
- * but what if func takes rest/optional args, etc?
- * ((list (lambda args (car args))) 0 "hi" 0)
- * should this return #\h or "hi"??
- * currently it is "hi" which is consistent with
- * ((lambda args (car args)) "hi" 0)
- * but...
- * ((lambda (arg) arg) "hi" 0)
- * is currently an error (too many arguments)
- * it should be (((lambda (arg) arg) "hi") 0) -> #\h
- *
- * this applies to non-homogeneous cases, so float|int-vectors don't get here
- */
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ int loop;
+ s7_pointer vp;
+ s7_int end;
+ bool (*f)(void *p);
- switch (type(obj))
+ end = o->v1.i;
+ vp = o->v6.p;
+ loop = o->v4.i + 1;
+ o1 = cur_sc->opts[loop];
+ f = o1->v7.fb;
+ while (integer(vp) < end)
{
- case T_VECTOR: /* (#(#(1 2) #(3 4)) 1 1) -> 4 */
- return(vector_ref_1(sc, obj, indices));
-
- case T_STRING: /* (#("12" "34") 0 1) -> #\2 */
- if (is_null(cdr(indices)))
+ if (f(o1))
{
- if (is_byte_vector(obj)) /* ((vector (byte-vector 1)) 0 0) */
- return(small_int((unsigned int)(character(string_ref_1(sc, obj, car(indices))))));
- return(string_ref_1(sc, obj, car(indices)));
+ opt_info *o2;
+ o2 = cur_sc->opts[++cur_sc->pc];
+ o2->v7.fp(o2);
}
- return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, obj, indices)));
-
- case T_PAIR: /* (#((1 2) (3 4)) 1 0) -> 3, (#((1 (2 3))) 0 1 0) -> 2 */
- obj = list_ref_1(sc, obj, car(indices));
- if (is_pair(cdr(indices)))
- return(implicit_index(sc, obj, cdr(indices)));
- return(obj);
-
- case T_HASH_TABLE: /* ((vector (hash-table '(a . 1) '(b . 2))) 0 'a) -> 1 */
- obj = s7_hash_table_ref(sc, obj, car(indices));
- if (is_pair(cdr(indices)))
- return(implicit_index(sc, obj, cdr(indices)));
- return(obj);
+ cur_sc->pc = loop;
+ integer(vp)++;
+ }
+ return(NULL);
+}
- case T_C_OBJECT:
- return((*(c_object_ref(obj)))(sc, obj, indices));
+static s7_pointer opt_do_setpif(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ int loop;
+ s7_pointer vp, val;
+ s7_int end;
- case T_LET:
- obj = s7_let_ref(sc, obj, car(indices));
- if (is_pair(cdr(indices)))
- return(implicit_index(sc, obj, cdr(indices)));
- return(obj);
+ end = o->v1.i;
+ vp = o->v6.p;
+ loop = o->v4.i;
+ o1 = cur_sc->opts[loop];
- default: /* (#(a b c) 0 1) -> error, but ((list (lambda (x) x)) 0 "hi") -> "hi" */
- return(g_apply(sc, list_2(sc, obj, indices)));
+ val = make_mutable_integer(cur_sc, integer(slot_value(o1->v1.p)));
+ slot_set_value(o1->v1.p, val);
+ while (integer(vp) < end)
+ {
+ integer(val) = o1->v4.i_ii_f(integer(slot_value(o1->v2.p)), o1->v3.i);
+ integer(vp)++;
}
+ return(NULL);
}
-/* -------------------------------- s7-version -------------------------------- */
-static s7_pointer g_s7_version(s7_scheme *sc, s7_pointer args)
+
+static bool stop_is_safe(s7_scheme *sc, s7_pointer stop, s7_pointer body)
{
- #define H_s7_version "(s7-version) returns some string describing the current s7"
- #define Q_s7_version pcl_s
- return(s7_make_string(sc, "s7 " S7_VERSION ", " S7_DATE));
+ /* this could be folded into the cell_optimize traveral */
+ s7_pointer p;
+ for (p = body; is_pair(p); p = cdr(p))
+ if ((is_pair(car(p))) &&
+ (caar(p) == sc->set_symbol) &&
+ (is_pair(cdar(p))) &&
+ (cadar(p) == stop))
+ return(!s7_tree_memq(sc, stop, cdr(p)));
+ return(true);
}
+static bool do_is_safe(s7_scheme *sc, s7_pointer body, s7_pointer steppers, s7_pointer var_list, bool *has_set);
-void s7_quit(s7_scheme *sc)
+static bool opt_cell_do(s7_scheme *sc, s7_pointer car_x, int len)
{
- sc->longjmp_ok = false;
+ /* TODO:
+ * step by 1/-1 to end opt built-in (mutable index)
+ * need to pass in the end point for unchecked use: var an int, (+ var 1), end of form (= var x) where we can find x -- set stepper and denominator
+ * this is a kludge -- find a better way!
+ * and no feed-to
+ * see OP_LET above -- get rid of local envir+slots! (longjmp if opts_size overflow also can't work with sc->envir change)
+ * or trap somehow?
+ */
+ opt_info *opc;
+ s7_pointer p, end, frame = NULL, old_e;
+ int var_len, body_len, step_len;
+
+ if (len < 3)
+ return(false);
+
+ if (!is_proper_list(sc, cadr(car_x)))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ var_len = safe_list_length(sc, cadr(car_x));
+ step_len = var_len;
+ body_len = len - 3;
+ end = caddr(car_x);
+ if (!is_pair(end))
+ return(return_false(sc, car_x, __func__, __LINE__));
+
+ old_e = sc->envir;
+ opc = alloc_opo(sc, car_x);
+
+ new_frame(sc, sc->envir, frame);
+ clear_symbol_list(sc);
+ for (p = cadr(car_x); is_pair(p); p = cdr(p))
+ {
+ s7_pointer var;
+ var = car(p);
+ if ((is_pair(var)) &&
+ (is_symbol(car(var))) &&
+ (is_pair(cdr(var))))
+ {
+ s7_pointer sym;
+ sym = car(var);
+ if ((is_immutable_symbol(sym)) ||
+ (symbol_has_accessor(sym)))
+ return(return_false(sc, car_x, __func__, __LINE__));
+
+ if (symbol_is_in_list(sc, sym))
+ eval_error(sc, "duplicate identifier in do: ~A", var);
+ add_symbol_to_list(sc, sym);
- pop_input_port(sc);
- stack_reset(sc);
- push_stack(sc, OP_EVAL_DONE, sc->nil, sc->nil);
+ if (cell_optimize(sc, cdr(var))) /* opt init in outer env */
+ {
+ s7_pointer slot;
+ add_slot(frame, sym, sc->F);
+ slot = let_slots(frame);
+ if (is_pair(cddr(var)))
+ {
+ set_has_stepper(slot);
+ if (!is_null(cdddr(var)))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ else
+ {
+ step_len--;
+ if (!is_null(cddr(var)))
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ if (is_symbol(cadr(var)))
+ slot_set_value(slot, slot_value(find_symbol(sc, cadr(var))));
+ else
+ {
+ if (!is_pair(cadr(var)))
+ slot_set_value(slot, cadr(var));
+ else
+ {
+ if (is_proper_quote(sc, cadr(var)))
+ slot_set_value(slot, cadadr(var));
+ else
+ {
+ s7_pointer sf;
+ sf = find_symbol_checked(sc, caadr(var));
+ if (is_c_function(sf))
+ {
+ s7_pointer sig;
+ sig = s7_procedure_signature(sc, sf);
+ if ((is_pair(sig)) &&
+ ((car(sig) == sc->is_integer_symbol) ||
+ ((is_pair(car(sig))) &&
+ (direct_memq(sc->is_integer_symbol, car(sig))))))
+ slot_set_value(slot, small_int(0));
+ }
+ }
+ }
+ }
+ }
+ else return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ else return(return_false(sc, car_x, __func__, __LINE__));
+ }
+
+ 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);
+
+ for (p = cadr(car_x); is_pair(p); p = cdr(p))
+ {
+ s7_pointer var;
+ var = car(p);
+ if (is_pair(cddr(var)))
+ {
+ s7_pointer init_type;
+ init_type = opt_arg_type(sc, cdr(var));
+ if (((init_type == sc->is_integer_symbol) ||
+ (init_type == sc->is_float_symbol)) &&
+ (opt_arg_type(sc, cddr(var)) != init_type))
+ {
+#if OPT_PRINT
+ fprintf(stderr, "init_type: %s, but opt_arg: %s\n", DISPLAY(init_type), DISPLAY(opt_arg_type(sc, cddr(var))));
+#endif
+ sc->stack_end -= 4; /* not pop_stack! */
+ sc->envir = old_e;
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ }
+ }
+
+ if (bool_optimize_nw(sc, end))
+ {
+ int i, body_index;
+ s7_pointer p, stop;
+ stop = car(end);
+ /* fprintf(stderr, "check %s\n", DISPLAY_80(car_x)); */
+ if ((is_pair(stop)) &&
+ ((car(stop) == sc->eq_symbol) || (car(stop) == sc->geq_symbol) || (car(stop) == sc->gt_symbol)) &&
+ (is_pair(cdr(stop))) &&
+ (is_symbol(cadr(stop))) &&
+ (is_pair(cddr(stop))) &&
+ (is_null(cdddr(stop))) &&
+ ((is_opt_int(caddr(stop))) || (is_symbol(caddr(stop)))))
+ {
+ s7_pointer stop_slot;
+ if (is_symbol(caddr(stop)))
+ {
+ stop_slot = find_symbol(sc, caddr(stop));
+ if ((!is_slot(stop_slot)) ||
+ (!is_opt_int(slot_value(stop_slot))))
+ stop_slot = NULL;
+ }
+ else stop_slot = sc->nil;
+ if (stop_slot)
+ {
+ s7_int lim;
+ bool set_stop = false;
+ s7_pointer slot;
+
+ if (is_slot(stop_slot))
+ lim = integer(slot_value(stop_slot));
+ else lim = integer(caddr(stop));
+ if (car(stop) == sc->gt_symbol) lim++;
+
+ for (p = cadr(car_x), slot = let_slots(frame); is_pair(p); p = cdr(p), slot = next_slot(slot))
+ {
+ /* TODO: put off this decision until it is needed (ref/set)
+ * another choice: go from init downto 0: init is lim
+ */
+ if (has_stepper(slot))
+ {
+ s7_pointer var, step;
+ var = car(p);
+ step = caddr(var);
+ /* fprintf(stderr, " var: %s, stop: %s, step %s\n", DISPLAY(let_slots(frame)), DISPLAY(stop), DISPLAY(step)); */
+ if ((is_opt_int(slot_value(slot))) &&
+ (is_pair(step)) &&
+ (car(var) == cadr(stop)) &&
+ (car(var) == cadr(step)) &&
+ ((car(stop) != sc->eq_symbol) || /* else > protects at least the top */
+ ((caddr(step) == small_int(1)) && (car(step) == sc->add_symbol))))
+ {
+ /* fprintf(stderr, " end: %s\n", DISPLAY(let_slots(frame))); */
+ if (slot_symbol(slot) == cadr(stop))
+ set_stop = true;
+ set_step_end(slot);
+ denominator(slot_value(slot)) = lim;
+ }
+ }
+ }
+
+ if (!set_stop)
+ {
+ s7_pointer slot;
+ slot = find_symbol(sc, cadr(stop));
+ if ((is_slot(slot)) &&
+ (is_opt_int(slot_value(slot))) &&
+ (stop_is_safe(sc, cadr(stop), cddr(car_x))))
+ {
+ /* fprintf(stderr, "%s: %s\n", DISPLAY(slot), DISPLAY(stop)); */
+ set_step_end(slot);
+ denominator(slot_value(slot)) = lim;
+ }
+ }
+ }
+ }
+
+ body_index = sc->pc;
+ for (i = 3, p = cdddr(car_x); i < len; i++, p = cdr(p))
+ {
+ opt_info *start;
+ start = sc->opts[sc->pc];
+ if (!cell_optimize(sc, p))
+ break;
+ if (start->v7.fp == d_to_p)
+ start->v7.fp = d_to_p_nr;
+ else
+ {
+ if (start->v7.fp == i_to_p)
+ start->v7.fp = i_to_p_nr;
+ }
+ }
+
+ if (!is_null(p))
+ {
+ sc->stack_end -= 4;
+ sc->envir = old_e;
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+
+ for (p = cadr(car_x); is_pair(p); p = cdr(p))
+ {
+ s7_pointer var;
+ var = car(p);
+ if ((is_pair(cddr(var))) &&
+ (!cell_optimize(sc, cddr(var))))
+ break;
+ }
+ if (is_null(p))
+ {
+ int rtn_len = 0;
+ opc->v1.i = sc->pc - 1;
+ if (!s7_is_list(sc, cdr(end)))
+ {
+ sc->stack_end -= 4;
+ sc->envir = old_e;
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ for (p = cdr(end); is_pair(p); p = cdr(p), rtn_len++)
+ if (!cell_optimize(sc, p))
+ break;
+ if (!is_null(p))
+ {
+ sc->stack_end -= 4;
+ sc->envir = old_e;
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ opc->v2.p = frame;
+ opc->v3.i = len - 3; /* body_len */
+ opc->v4.i = rtn_len;
+ opc->v5.i = sc->pc - 1;
+ sc->envir = old_e;
+
+ if ((var_len == 0) && (rtn_len == 0))
+ {
+ opc->v7.fp = opt_do_no_vars;
+ return(true);
+ }
+
+ if ((var_len == 1) && (step_len == 1) && (rtn_len == 0))
+ {
+ s7_pointer ind, ind_step, end, slot, var;
+ bool has_set = false;
+
+ opc->v7.fp = (body_len == 1) ? opt_do_simple : opt_do_2;
+
+ /* just a first stab at this
+ * set|let-set? if not caddr, hash-table|vector|list-set if not cadddr: old code checks !has_set for dotimes
+ * implicit set similar
+ * also (+ 1 ind) and (= end ind) and >= and body_len=any but still safe_stepper(s)
+ */
+ var = caadr(car_x);
+ ind = car(var);
+ ind_step = caddr(var);
+ end = car(caddr(car_x));
+ slot = let_slots(frame);
+
+ if ((is_pair(end)) && /* (= i len|100) */
+ (car(end) == sc->eq_symbol) &&
+ (cadr(end) == ind) &&
+ ((is_symbol(caddr(end))) || (is_t_integer(caddr(end)))) &&
+ (is_null(cdddr(end))) &&
+ (is_pair(ind_step)) && /* (+ i 1) */
+ (car(ind_step) == sc->add_symbol) &&
+ (cadr(ind_step) == ind) &&
+ (caddr(ind_step) == small_int(1)) &&
+ (is_null(cdddr(ind_step))) &&
+ (do_is_safe(sc, cdddr(car_x), sc->w = list_1(sc, ind), sc->nil, &has_set)))
+ {
+ dox_set_slot1(frame, slot);
+ dox_set_slot2_unchecked(frame, (is_symbol(caddr(end))) ? find_symbol(sc, caddr(end)) : sc->undefined);
+ slot_set_value(slot, make_mutable_integer(sc, integer(slot_value(slot))));
+ opc->v4.i = body_index;
+ if (body_len == 1)
+ {
+ opt_info *o1;
+ opc->v7.fp = opt_do_very_simple;
+ if (is_t_integer(caddr(end)))
+ opc->v3.i = integer(caddr(end));
+
+ o1 = sc->opts[body_index];
+ /* v2, v3, v4, v5 are in use */
+ if (o1->v7.fp == d_to_p_nr)
+ {
+ /* snd-test: (do ((k 0 (+ k 1))) ((= k N)) (float-vector-set! rl k (read-sample rd))) */
+ opc->v7.fp = opt_do_prepackaged;
+ opc->v8.fp = opt_do_dpnr;
+ }
+ else
+ {
+ if (o1->v7.fp == i_to_p_nr)
+ {
+ opc->v7.fp = opt_do_prepackaged;
+ opc->v8.fp = opt_do_ipnr;
+ }
+ else
+ {
+ if (o1->v7.fp == opt_if_bp)
+ {
+ opc->v7.fp = opt_do_prepackaged;
+ opc->v8.fp = opt_do_ifbp;
+ }
+ else
+ {
+ if (o1->v7.fp == opt_set_p_i_fo1)
+ {
+ opc->v7.fp = opt_do_prepackaged;
+ opc->v8.fp = opt_do_setpif;
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ opc->v7.fp = opt_dotimes_2;
+ if (is_t_integer(caddr(end)))
+ opc->v6.i = integer(caddr(end));
+ }
+ }
+ }
+ else opc->v7.fp = opt_do_any;
+ return(true);
+ }
+ }
+ /* fprintf(stderr, "bad: %s\n", DISPLAY_80(car_x)); */
+ sc->stack_end -= 4; /* not pop_stack! */
+ sc->envir = old_e;
+ return(false);
}
-/* -------------------------------- exit -------------------------------- */
-static s7_pointer g_emergency_exit(s7_scheme *sc, s7_pointer args)
+static bool p_syntax(s7_scheme *sc, s7_pointer car_x, int len)
{
- #define H_emergency_exit "(emergency-exit obj) exits s7 immediately"
- #define Q_emergency_exit pcl_t
-
- s7_pointer obj;
-#ifndef EXIT_SUCCESS
- #define EXIT_SUCCESS 0
- #define EXIT_FAILURE 1
-#endif
- if (is_null(args))
- _exit(EXIT_SUCCESS); /* r7rs spec says use _exit here */
- obj = car(args);
- if (obj == sc->F)
- _exit(EXIT_FAILURE);
- if ((obj == sc->T) || (!s7_is_integer(obj)))
- _exit(EXIT_SUCCESS);
- _exit((int)s7_integer(obj));
- return(sc->F);
+ opcode_t op;
+ s7_pointer func;
+ func = slot_value(global_slot(car(car_x)));
+ op = (opcode_t)syntax_opcode(func);
+ switch (op)
+ {
+ case OP_QUOTE:
+ if (is_pair(cdr(car_x)))
+ return(opt_cell_quote(sc, car_x));
+ break;
+
+ case OP_SET:
+ if (len == 3)
+ return(opt_cell_set(sc, car_x));
+ break;
+
+ case OP_BEGIN:
+ if (len > 1)
+ return(opt_cell_begin(sc, car_x, len));
+ break;
+
+ case OP_WHEN:
+ case OP_UNLESS:
+ if (len > 2)
+ return(opt_cell_when(sc, car_x, len));
+ break;
+
+ case OP_COND:
+ if (len > 1)
+ return(opt_cell_cond(sc, car_x));
+ break;
+
+ case OP_AND:
+ case OP_OR:
+ return(opt_cell_and(sc, car_x, len));
+
+ case OP_IF:
+ return(opt_cell_if(sc, car_x, len));
+
+ case OP_CASE:
+ if (len > 2)
+ return(opt_cell_case(sc, car_x));
+ break;
+
+ case OP_LET_TEMPORARILY:
+ return(opt_cell_let_temporarily(sc, car_x, len));
+
+ case OP_DO:
+ return(opt_cell_do(sc, car_x, len));
+
+ default:
+ break;
+ }
+ /* longjmp(sc->opt_exit, 1); */ /* what good could it do to back up? But we need to make sure sc->envir isn't clobbered (in op_do??) */
+ return(return_false(sc, car_x, __func__, __LINE__));
}
+
+/* -------------------------------------------------------------------------------- */
+static void start_opts(s7_scheme *sc)
+{
+ sc->pc = 0;
+}
-static s7_pointer g_exit(s7_scheme *sc, s7_pointer args)
+static void pc_fallback(s7_scheme *sc, int new_pc)
{
- #define H_exit "(exit obj) exits s7"
- #define Q_exit pcl_t
+ sc->pc = new_pc;
+}
- s7_quit(sc);
- return(g_emergency_exit(sc, args));
+static void free_optlist(s7_scheme *sc, s7_pointer p)
+{
+ if (optlist_addr(p) >= 0)
+ {
+ stofl[++stofl_loc] = optlist_addr(p);
+ optlist_addr(p) = -1;
+ }
+}
+
+static s7_pointer make_optlist(s7_scheme *sc)
+{
+ s7_pointer x;
+ int loc;
+ new_cell(sc, x, T_OPTLIST);
+ add_optlist(sc, x);
+ if (stofl_loc < 0)
+ {
+ if (!stofl)
+ {
+ int i;
+ stored_optlists_size = INITIAL_STORED_OPTLISTS_SIZE;
+ stored_optlists = (s7_pointer *)malloc(INITIAL_STORED_OPTLISTS_SIZE * sizeof(s7_pointer));
+ stofl = (int *)malloc(INITIAL_STORED_OPTLISTS_SIZE * sizeof(int));
+ stofl_loc = INITIAL_STORED_OPTLISTS_SIZE - 1;
+ for (i = 0; i < INITIAL_STORED_OPTLISTS_SIZE; i++)
+ stofl[i] = i;
+ }
+ else
+ {
+ unsigned int k, size, new_size;
+ size = stored_optlists_size;
+ new_size = 2 * size;
+ stored_optlists = (s7_pointer *)realloc(stored_optlists, new_size * sizeof(s7_pointer));
+ stored_optlists_size = new_size;
+ stofl = (int *)realloc(stofl, new_size * sizeof(int));
+ for (k = size; k < new_size; k++)
+ stofl[++stofl_loc] = (int)k;
+ }
+ }
+ loc = stofl[stofl_loc--];
+ optlist_addr(x) = loc;
+ stored_optlists[loc] = x;
+ return(x);
}
-#if DEBUGGING
-static s7_pointer g_abort(s7_scheme *sc, s7_pointer args) {abort();}
-#endif
+static s7_pointer opt_call(void *p)
+{
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_pointer fp, result, old_e;
+ int i;
+ s7_pointer x, env;
+ unsigned long long int id;
+
+ id = ++cur_sc->let_number;
+ env = o->v2.p;
+ let_id(env) = id;
+ x = let_slots(env);
+ /* arguments */
+ if (o->v1.i > 0)
+ {
+ s7_pointer sym;
+ if (o->v1.i == 1)
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ slot_set_value(x, o1->v7.fp(o1));
+ sym = slot_symbol(x);
+ symbol_set_local(sym, id, x);
+ }
+ else
+ {
+ int tx;
+ s7_pointer arg;
+ tx = next_tx(cur_sc);
+ cur_sc->t_temps[tx] = safe_list_if_possible(cur_sc, o->v1.i);
+
+ for (arg = cur_sc->t_temps[tx]; is_pair(arg); arg = cdr(arg))
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ car(arg) = o1->v7.fp(o1);
+ }
+ for (arg = cur_sc->t_temps[tx], fp = x; is_pair(arg); fp = next_slot(fp), arg = cdr(arg))
+ {
+ slot_set_value(fp, car(arg));
+ sym = slot_symbol(fp);
+ symbol_set_local(sym, id, fp);
+ }
+ clear_list_in_use(cur_sc->t_temps[tx]);
+ cur_sc->current_safe_list = 0;
+ }
+ }
+ old_e = cur_sc->envir;
+ cur_sc->envir = env;
+ cur_sc->pc = o->v4.i - 1; /* preincr below */
-static s7_function all_x_function[OPT_MAX_DEFINED];
-#define is_all_x_op(Op) (all_x_function[Op])
+ /* body */
+ for (i = 0; i < o->v3.i; i++)
+ {
+ o1 = cur_sc->opts[++cur_sc->pc];
+ o1->v7.fp(o1);
+ }
+ o1 = cur_sc->opts[++cur_sc->pc];
+ result = o1->v7.fp(o1);
-static bool is_all_x_safe(s7_scheme *sc, s7_pointer p)
-{
- return((!is_pair(p)) ||
- ((car(p) == sc->quote_symbol) && (is_pair(cdr(p)))) || /* (if #t (quote . -1)) */
- ((is_optimized(p)) && (is_all_x_op(optimize_op(p)))));
+ cur_sc->envir = old_e;
+ cur_sc->pc = o->v5.i;
+ return(result);
}
+static s7_pointer opt_call_no_env(void *p) {return(opt_call(p));}
-static int all_x_count(s7_pointer x)
+static s7_pointer opt_call_1_1(void *p)
{
- int count = 0;
- s7_pointer p;
- for (p = cdr(x); is_pair(p); p = cdr(p))
- if ((is_optimized(car(p))) &&
- (is_all_x_op(optimize_op(car(p)))))
- count++;
- return(count);
-}
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_pointer result, sym, x, env, old_e;
+ unsigned long long int id;
+ id = ++cur_sc->let_number;
+ env = o->v2.p;
+ let_id(env) = id;
+ x = let_slots(env);
-/* arg here is the full expression */
+ o1 = cur_sc->opts[++cur_sc->pc];
+ slot_set_value(x, o1->v7.fp(o1));
+ sym = slot_symbol(x);
+ symbol_set_local(sym, id, x);
-static s7_pointer all_x_else(s7_scheme *sc, s7_pointer arg) {return(sc->T);} /* used in cond_all_x */
-static s7_pointer all_x_c(s7_scheme *sc, s7_pointer arg) {return(arg);}
-static s7_pointer all_x_q(s7_scheme *sc, s7_pointer arg) {return(cadr(arg));}
-static s7_pointer all_x_s(s7_scheme *sc, s7_pointer arg) {return(find_symbol_checked(sc, arg));}
-static s7_pointer all_x_u(s7_scheme *sc, s7_pointer arg) {return(find_symbol_unchecked(sc, arg));}
-static s7_pointer all_x_k(s7_scheme *sc, s7_pointer arg) {return(arg);}
-static s7_pointer all_x_c_c(s7_scheme *sc, s7_pointer arg) {return(c_call(arg)(sc, cdr(arg)));}
+ old_e = cur_sc->envir;
+ cur_sc->envir = env;
+ cur_sc->pc = o->v4.i;
-static s7_pointer all_x_c_add1(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer x;
- x = find_symbol_unchecked(sc, cadr(arg));
- if (is_integer(x))
- return(make_integer(sc, integer(x) + 1));
- return(g_add_s1_1(sc, x, arg));
-}
+ o1 = cur_sc->opts[cur_sc->pc];
+ result = o1->v7.fp(o1);
-static s7_pointer all_x_c_addi(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer x;
- x = find_symbol_unchecked(sc, cadr(arg));
- if (is_integer(x))
- return(make_integer(sc, integer(x) + integer(caddr(arg))));
- return(g_add_2(sc, set_plist_2(sc, x, caddr(arg))));
+ cur_sc->envir = old_e;
+ cur_sc->pc = o->v5.i;
+ return(result);
}
-static s7_pointer all_x_c_char_eq(s7_scheme *sc, s7_pointer arg)
+static s7_pointer opt_call_1_1_no_env(void *p)
{
- s7_pointer c;
- c = find_symbol_unchecked(sc, cadr(arg));
- if (c == caddr(arg))
- return(sc->T);
- if (s7_is_character(c))
- return(sc->F);
- method_or_bust(sc, c, sc->char_eq_symbol, set_plist_2(sc, c, caddr(arg)), T_CHARACTER, 1);
-}
+ opt_info *o = (opt_info *)p;
+ opt_info *o1;
+ s7_pointer result, e, old_e;
-static s7_pointer all_x_c_q(s7_scheme *sc, s7_pointer arg)
-{
- set_car(sc->t1_1, cadr(cadr(arg)));
- return(c_call(arg)(sc, sc->t1_1));
-}
+ e = o->v2.p;
+ o1 = cur_sc->opts[++cur_sc->pc];
+ slot_set_value(let_slots(e), o1->v7.fp(o1));
-static s7_pointer all_x_c_s(s7_scheme *sc, s7_pointer arg)
-{
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(arg)));
- return(c_call(arg)(sc, sc->t1_1));
-}
+ old_e = cur_sc->envir;
+ cur_sc->envir = e;
+ cur_sc->pc = o->v4.i;
-static s7_pointer all_x_c_u(s7_scheme *sc, s7_pointer arg)
-{
- set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(arg)));
- return(c_call(arg)(sc, sc->t1_1));
-}
+ o1 = cur_sc->opts[cur_sc->pc];
+ result = o1->v7.fp(o1);
-static s7_pointer all_x_cdr_s(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer val;
- val = find_symbol_checked(sc, cadr(arg));
- return((is_pair(val)) ? cdr(val) : g_cdr(sc, set_plist_1(sc, val)));
+ cur_sc->envir = old_e;
+ cur_sc->pc = o->v5.i;
+ return(result);
}
-static s7_pointer all_x_cdr_u(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer val;
- val = find_symbol_unchecked(sc, cadr(arg));
- return((is_pair(val)) ? cdr(val) : g_cdr(sc, set_plist_1(sc, val)));
-}
+static s7_int opt_int_call(void *p) {return(integer(opt_call(p)));}
+static s7_double opt_float_call(void *p) {return(real(opt_call(p)));}
+static bool opt_bool_call(void *p) {return(opt_call(p) != cur_sc->F);}
+static s7_int opt_int_call_1_1(void *p) {return(integer(opt_call_1_1(p)));}
+static s7_double opt_float_call_1_1(void *p) {return(real(opt_call_1_1(p)));}
+static bool opt_bool_call_1_1(void *p) {return(opt_call_1_1(p) != cur_sc->F);}
-static s7_pointer all_x_car_s(s7_scheme *sc, s7_pointer arg)
+static bool funcall_optimize(s7_scheme *sc, s7_pointer car_x, s7_pointer s_func)
{
- s7_pointer val;
- val = find_symbol_checked(sc, cadr(arg));
- return((is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val)));
-}
+ if (sc->safety > CLM_OPTIMIZATION_SAFETY)
+ return(false);
-static s7_pointer all_x_null_s(s7_scheme *sc, s7_pointer arg)
-{
- return(make_boolean(sc, is_null(find_symbol_checked(sc, cadr(arg)))));
-}
+ if (!closure_no_opt(s_func))
+ {
+ opt_info *opc;
+ int i;
+ s7_pointer p;
-static s7_pointer all_x_c_sc(s7_scheme *sc, s7_pointer arg)
-{
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(arg)));
- set_car(sc->t2_2, caddr(arg));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ opc = alloc_opo(sc, car_x);
+ /* fprintf(stderr, "func: car_x: %s, opc: %p\n", DISPLAY(car_x), opc); */
-static s7_pointer all_x_c_uc(s7_scheme *sc, s7_pointer arg)
-{
- set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg)));
- set_car(sc->t2_2, caddr(arg));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ for (i = 0, p = cdr(car_x); is_pair(p); i++, p = cdr(p))
+ if (!cell_optimize(sc, p))
+ break;
+ if (is_pair(p))
+ {
+ if ((has_optlist(s_func)) &&
+ (optlist_len(closure_optlist(s_func)) == 0))
+ clear_has_optlist(s_func);
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
-static s7_pointer all_x_c_cs(s7_scheme *sc, s7_pointer arg)
-{
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(arg)));
- set_car(sc->t2_1, cadr(arg));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ opc->v1.i = i;
+ opc->v2.p = closure_let(s_func);
+ opc->v7.fp = opt_call;
+ sc->funcalls++;
+
+ if (has_optlist(s_func))
+ {
+ s7_pointer olst;
+ olst = closure_optlist(s_func);
+ if (optlist_num_args(olst) != opc->v1.i)
+ {
+ /* fprintf(stderr, "wrong argnum: %" LL_D " %d\n", opc->v1.i, optlist_num_args(olst)); */
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ opc->v3.i = optlist_num_exprs(olst);
+ opc->v4.i = optlist_pc(olst);
+ opc->v5.i = sc->pc - 1;
-static s7_pointer all_x_c_ss(s7_scheme *sc, s7_pointer arg)
-{
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(arg)));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(arg)));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ if ((optlist_num_exprs(olst) == 0) && /* omits final */
+ (optlist_num_args(olst) == 1))
+ opc->v7.fp = opt_call_1_1;
+ return(true);
+ }
+ else
+ {
+ if (setjmp(sc->opt_exit) == 0)
+ {
+ s7_pointer op;
+ int start, tx, body_len;
+
+ tx = next_tx(sc);
+ sc->t_temps[tx] = sc->envir;
+
+ start = sc->pc;
+ opc->v4.i = sc->pc;
+
+ body_len = s7_list_length(sc, closure_body(s_func));
+ if (body_len <= 0)
+ return(return_false(sc, car_x, __func__, __LINE__));
+ opc->v3.i = body_len - 1;
+
+ /* to handle recursive calls cleanly, we need the optlist setup right away */
+ op = make_optlist(sc);
+ closure_set_optlist_addr(s_func, optlist_addr(op)); /* optlist_addr set by make_optlist (needed here for GC protection) */
+ optlist_set_num_exprs(op, body_len - 1);
+ optlist_set_num_args(op, opc->v1.i);
+ set_has_optlist(s_func); /* we're optimistic! -- need to unset this if optimization fails */
+ optlist_set_len(op, 0);
+ optlist_set_pc(op, start); /* loaded at this position below */
+
+ sc->envir = closure_let(s_func);
+ for (p = closure_body(s_func); is_pair(p); p = cdr(p))
+ if (!cell_optimize(sc, p))
+ break;
-static s7_pointer all_x_c_uu(s7_scheme *sc, s7_pointer arg)
-{
- set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg)));
- set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(arg)));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ if (is_null(p))
+ {
+ optlist_set_len(op, sc->pc - start);
+ opc->v5.i = sc->pc - 1;
+ sc->envir = sc->t_temps[tx];
-static s7_pointer all_x_c_sss(s7_scheme *sc, s7_pointer arg)
-{
- set_car(sc->t3_1, find_symbol_checked(sc, cadr(arg)));
- set_car(sc->t3_2, find_symbol_checked(sc, caddr(arg)));
- set_car(sc->t3_3, find_symbol_checked(sc, cadddr(arg)));
- return(c_call(arg)(sc, sc->t3_1));
-}
+ if ((optlist_num_exprs(op) == 0) &&
+ (optlist_num_args(op) == 1))
+ opc->v7.fp = opt_call_1_1;
-static s7_pointer all_x_c_uuu(s7_scheme *sc, s7_pointer arg)
-{
- set_car(sc->t3_1, find_symbol_unchecked(sc, cadr(arg)));
- set_car(sc->t3_2, find_symbol_unchecked(sc, caddr(arg)));
- set_car(sc->t3_3, find_symbol_unchecked(sc, cadddr(arg)));
- return(c_call(arg)(sc, sc->t3_1));
+ clear_has_optlist(s_func);
+ sc->envir = sc->t_temps[tx];
+ return(true);
+ }
+ clear_has_optlist(s_func);
+ sc->envir = sc->t_temps[tx];
+ }
+ }
+ set_closure_no_opt(s_func);
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
}
-static s7_pointer all_x_c_scs(s7_scheme *sc, s7_pointer arg)
+static s7_pointer func_returns(s7_scheme *sc, s7_pointer func)
{
- set_car(sc->t3_1, find_symbol_checked(sc, cadr(arg)));
- set_car(sc->t3_3, find_symbol_checked(sc, cadddr(arg)));
- set_car(sc->t3_2, caddr(arg));
- return(c_call(arg)(sc, sc->t3_1));
+ s7_pointer body, last_expr;
+ int len;
+ body = closure_body(func);
+ len = s7_list_length(sc, body);
+ if (len <= 0) return(sc->F);
+ last_expr = s7_list_ref(sc, body, len - 1);
+ if (is_pair(last_expr))
+ {
+ s7_pointer rtnf;
+ rtnf = car(last_expr);
+ if (!is_symbol(rtnf)) return(sc->F);
+ rtnf = find_symbol_checked(sc, rtnf);
+ if (!is_c_function(rtnf)) return(sc->F);
+ rtnf = s7_procedure_signature(sc, rtnf);
+ if (!is_pair(rtnf)) return(sc->F);
+ return(car(rtnf));
+ }
+ return(s7_type_of(last_expr));
}
-static s7_pointer all_x_c_css(s7_scheme *sc, s7_pointer arg)
+static bool returns_float(s7_scheme *sc, s7_pointer func)
{
- set_car(sc->t3_2, find_symbol_checked(sc, caddr(arg)));
- set_car(sc->t3_3, find_symbol_checked(sc, cadddr(arg)));
- set_car(sc->t3_1, cadr(arg));
- return(c_call(arg)(sc, sc->t3_1));
+ s7_pointer sig;
+ sig = func_returns(sc, func);
+ return((sig) &&
+ ((sig == sc->is_float_symbol) ||
+ ((is_pair(sig)) && (direct_memq(sc->is_float_symbol, sig)))));
}
-static s7_pointer all_x_c_csc(s7_scheme *sc, s7_pointer arg)
+static bool returns_integer(s7_scheme *sc, s7_pointer func)
{
- set_car(sc->t3_2, find_symbol_checked(sc, caddr(arg)));
- set_car(sc->t3_1, cadr(arg));
- set_car(sc->t3_3, cadddr(arg));
- return(c_call(arg)(sc, sc->t3_1));
+ s7_pointer sig;
+ sig = func_returns(sc, func);
+ return((sig) &&
+ ((sig == sc->is_integer_symbol) ||
+ ((is_pair(sig)) && (direct_memq(sc->is_integer_symbol, sig)))));
}
-static s7_pointer all_x_c_ssc(s7_scheme *sc, s7_pointer arg)
+static bool returns_bool(s7_scheme *sc, s7_pointer func)
{
- set_car(sc->t3_1, find_symbol_checked(sc, cadr(arg)));
- set_car(sc->t3_2, find_symbol_checked(sc, caddr(arg)));
- set_car(sc->t3_3, cadddr(arg));
- return(c_call(arg)(sc, sc->t3_1));
+ s7_pointer sig;
+ sig = func_returns(sc, func);
+ return(sig == sc->is_boolean_symbol);
}
-static s7_pointer all_x_c_sq(s7_scheme *sc, s7_pointer arg)
+static bool float_optimize(s7_scheme *sc, s7_pointer expr)
{
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(arg)));
- set_car(sc->t2_2, cadr(caddr(arg)));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ s7_pointer car_x, head;
+ /* fprintf(stderr, "float_optimize %s safe: %d, pair: %d\n", DISPLAY_80(expr), sc->safety, pair_no_opt(expr)); */
+#if (WITH_GMP)
+ return(false);
+#endif
-static s7_pointer all_x_c_opcq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t1_1, c_call(largs)(sc, cdr(largs)));
- return(c_call(arg)(sc, sc->t1_1));
-}
+ car_x = car(expr);
+ if (!is_pair(car_x)) /* wrap constants/symbols */
+ return(opt_float_not_pair(sc, car_x));
-static s7_pointer all_x_c_s_opcq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = caddr(arg);
- set_car(sc->t2_2, c_call(largs)(sc, cdr(largs)));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(arg)));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ head = car(car_x);
+ if (is_symbol(head))
+ {
+ /* get func, check sig, check all args */
+ s7_pointer s_func;
+ int len;
-static s7_pointer all_x_c_c_opcq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = caddr(arg);
- set_car(sc->t2_2, c_call(largs)(sc, cdr(largs)));
- set_car(sc->t2_1, cadr(arg));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ len = s7_list_length(sc, car_x);
+ /* need to check int_opt here */
-static s7_pointer all_x_c_opcq_s(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t2_1, c_call(largs)(sc, cdr(largs)));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(arg)));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ if ((is_syntactic(head)) ||
+ (typesflag(car_x) == SYNTACTIC_PAIR))
+ return(d_syntax_ok(sc, car_x, len));
-static s7_pointer all_x_c_opcq_c(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t2_1, c_call(largs)(sc, cdr(largs)));
- set_car(sc->t2_2, caddr(arg));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ if ((is_global(head)) ||
+ ((is_slot(global_slot(head))) &&
+ (find_symbol(sc, head) == global_slot(head))))
+ s_func = slot_value(global_slot(head));
+ else return(d_implicit_ok(sc, car_x, len));
-static s7_pointer all_x_c_opcq_opcq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t2_1, c_call(largs)(sc, cdr(largs)));
- largs = caddr(arg);
- set_car(sc->t2_2, c_call(largs)(sc, cdr(largs)));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ if (is_c_function(s_func))
+ {
+ opt_info *opc;
+ opc = alloc_opo(sc, car_x);
+ switch (len)
+ {
+ case 1:
+ if (d_ok(sc, opc, s_func))
+ return(true);
+ break;
+
+ case 2: /* (f v) or (f d): (env e) or (abs x) */
+ if ((d_d_ok(sc, opc, s_func, car_x)) ||
+ (d_v_ok(sc, opc, s_func, car_x)) ||
+ (d_p_ok(sc, opc, s_func, car_x)))
+ return(true);
+ break;
+
+ case 3:
+ if ((d_dd_ok(sc, opc, s_func, car_x)) ||
+ (d_vd_ok(sc, opc, s_func, car_x)) ||
+ (d_pd_ok(sc, opc, s_func, car_x)) ||
+ (d_id_ok(sc, opc, s_func, car_x)) ||
+ (d_ip_ok(sc, opc, s_func, car_x)) ||
+ (d_pi_ok(sc, opc, s_func, car_x)))
+ return(true);
+ break;
+
+ case 4:
+ if ((d_ddd_ok(sc, opc, s_func, car_x)) ||
+ (d_pid_ok(sc, opc, s_func, car_x)) ||
+ (d_vid_ok(sc, opc, s_func, car_x)) ||
+ (d_vdd_ok(sc, opc, s_func, car_x)))
+ return(true);
+ break;
+
+ case 5:
+ if (d_dddd_ok(sc, opc, s_func, car_x))
+ return(true);
+ break;
+
+ default:
+ if (d_add_any_ok(sc, opc, car_x, len))
+ return(true);
+ break;
+ }
+
+ if (float_all_x_ok(sc, opc, s_func, expr))
+ return(true);
+ }
+ else
+ {
+ if (is_macro(s_func))
+ {
+ if (!pair_no_opt(expr))
+ return(float_optimize(sc, set_plist_1(sc, s7_macroexpand(sc, s_func, cdar(expr)))));
+ }
+ else
+ {
+ if ((!pair_no_opt(car_x)) &&
+ (is_closure(s_func)) &&
+ (is_safe_closure(s_func)) &&
+ (returns_float(sc, s_func)))
+ {
+ int start;
+ start = sc->pc;
+ if (funcall_optimize(sc, car_x, s_func))
+ {
+ sc->opts[start]->v7.fd = (sc->opts[start]->v7.fp == opt_call) ? opt_float_call : opt_float_call_1_1;
+ return(true);
+ }
+ set_pair_no_opt(car_x);
+ }
+ }
+ }
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
+}
-static s7_pointer all_x_c_opsq(s7_scheme *sc, s7_pointer arg)
+static bool int_optimize(s7_scheme *sc, s7_pointer expr)
{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(largs)));
- set_car(sc->t1_1, c_call(largs)(sc, sc->t1_1));
- return(c_call(arg)(sc, sc->t1_1));
-}
+ s7_pointer car_x, head;
+#if (WITH_GMP)
+ return(false);
+#endif
+ car_x = car(expr);
-static s7_pointer all_x_c_not_opsq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(largs)));
- if (c_call(largs)(sc, sc->t1_1) == sc->F)
- return(sc->T);
- return(sc->F);
-}
+ if (!is_pair(car_x)) /* wrap constants/symbols */
+ return(opt_int_not_pair(sc, car_x));
-static s7_pointer all_x_c_opuq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(largs)));
- set_car(sc->t1_1, c_call(largs)(sc, sc->t1_1));
- return(c_call(arg)(sc, sc->t1_1));
-}
+ head = car(car_x);
+ if (is_symbol(head))
+ {
+ s7_pointer s_func;
+ int len;
+ len = s7_list_length(sc, car_x);
-static s7_pointer all_x_c_not_opuq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(largs)));
- if (c_call(largs)(sc, sc->t1_1) == sc->F)
- return(sc->T);
- return(sc->F);
-}
+ if ((is_syntactic(head)) ||
+ (typesflag(car_x) == SYNTACTIC_PAIR))
+ return(i_syntax_ok(sc, car_x, len));
-static s7_pointer all_x_c_opssq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(largs)));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(largs)));
- set_car(sc->t1_1, c_call(largs)(sc, sc->t2_1));
- return(c_call(arg)(sc, sc->t1_1));
-}
+ if ((is_global(head)) ||
+ ((is_slot(global_slot(head))) &&
+ (find_symbol(sc, head) == global_slot(head))))
+ s_func = slot_value(global_slot(head));
+ else return(i_implicit_ok(sc, car_x, len));
+
+ if (is_c_function(s_func))
+ {
+ opt_info *opc;
+ opc = alloc_opo(sc, car_x);
+ switch (len)
+ {
+ case 2:
+ if (i_idp_ok(sc, opc, s_func, car_x))
+ return(true);
+ break;
-static s7_pointer all_x_c_opuuq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
- set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(largs)));
- set_car(sc->t1_1, c_call(largs)(sc, sc->t2_1));
- return(c_call(arg)(sc, sc->t1_1));
+ case 3:
+ if ((i_ii_ok(sc, opc, s_func, car_x)) ||
+ (i_pi_ok(sc, opc, s_func, car_x)))
+ return(true);
+ break;
+
+ case 4:
+ if ((i_iii_ok(sc, opc, s_func, car_x)) ||
+ (i_pii_ok(sc, opc, s_func, car_x)))
+ return(true);
+ break;
+
+ default:
+ if (((head == sc->add_symbol) ||
+ (head == sc->multiply_symbol)) &&
+ (i_add_any_ok(sc, opc, car_x)))
+ return(true);
+ break;
+ }
+
+ if (int_all_x_ok(sc, opc, s_func, expr))
+ return(true);
+ }
+ else
+ {
+ if (is_macro(s_func))
+ {
+ if (!pair_no_opt(expr))
+ return(int_optimize(sc, set_plist_1(sc, s7_macroexpand(sc, s_func, cdar(expr)))));
+ }
+ else
+ {
+ if ((!pair_no_opt(car_x)) &&
+ (is_closure(s_func)) &&
+ (is_safe_closure(s_func)) &&
+ (returns_integer(sc, s_func)))
+ {
+ int start;
+ start = sc->pc;
+ if (funcall_optimize(sc, car_x, s_func))
+ {
+ sc->opts[start]->v7.fi = (sc->opts[start]->v7.fp == opt_call) ? opt_int_call : opt_int_call_1_1;
+ return(true);
+ }
+ set_pair_no_opt(car_x);
+ }
+ }
+ }
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
}
-static s7_pointer all_x_c_opscq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(largs)));
- set_car(sc->t2_2, caddr(largs));
- set_car(sc->t1_1, c_call(largs)(sc, sc->t2_1));
- return(c_call(arg)(sc, sc->t1_1));
-}
-static s7_pointer all_x_c_opsqq(s7_scheme *sc, s7_pointer arg)
+static bool cell_optimize(s7_scheme *sc, s7_pointer expr)
{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(largs)));
- set_car(sc->t2_2, cadr(caddr(largs)));
- set_car(sc->t1_1, c_call(largs)(sc, sc->t2_1));
- return(c_call(arg)(sc, sc->t1_1));
-}
+ s7_pointer car_x, head;
+ /* cell_optimize should also try *-optimize(?? -- this is premature) and wrap the results if cell-opt doesn't work */
-static s7_pointer all_x_c_opssq_s(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(largs)));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(largs)));
- set_car(sc->t2_1, c_call(largs)(sc, sc->t2_1));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(arg)));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ /* fprintf(stderr, "cell_opt %d: %s\n", sc->pc, DISPLAY_80(expr)); */
-static s7_pointer all_x_c_opuuq_u(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
- set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(largs)));
- set_car(sc->t2_1, c_call(largs)(sc, sc->t2_1));
- set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(arg)));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ car_x = car(expr);
+ if (!is_pair(car_x)) /* wrap constants/symbols */
+ return(opt_cell_not_pair(sc, car_x));
-static s7_pointer all_x_c_opssq_c(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(largs)));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(largs)));
- set_car(sc->t2_1, c_call(largs)(sc, sc->t2_1));
- set_car(sc->t2_2, caddr(arg));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ head = car(car_x);
+ if (is_symbol(head))
+ {
+ s7_pointer s_func = NULL;
+ int len;
+ len = s7_list_length(sc, car_x);
-static s7_pointer all_x_c_opsq_s(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(largs)));
- set_car(sc->t2_1, c_call(largs)(sc, sc->t1_1));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(arg)));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ if ((is_syntactic(head)) ||
+ (typesflag(car_x) == SYNTACTIC_PAIR))
+ return(p_syntax(sc, car_x, len));
-static s7_pointer all_x_c_opuq_u(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(largs)));
- set_car(sc->t2_1, c_call(largs)(sc, sc->t1_1));
- set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(arg)));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ if ((is_global(head)) ||
+ ((is_slot(global_slot(head))) &&
+ (find_symbol(sc, head) == global_slot(head))))
+ s_func = slot_value(global_slot(head));
+ else return(p_implicit(sc, car_x, len));
-static s7_pointer all_x_c_opsq_c(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cadr(arg);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(largs)));
- set_car(sc->t2_1, c_call(largs)(sc, sc->t1_1));
- set_car(sc->t2_2, caddr(arg));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ if (is_c_function(s_func))
+ {
+ opt_info *opc;
+ s7_pointer sig;
+ int start;
+
+ start = sc->pc;
+ sig = s7_procedure_signature(sc, s_func);
+ opc = alloc_opo(sc, car_x);
+ switch (len)
+ {
+ case 1:
+ if (p_ok(sc, opc, s_func, car_x))
+ return(true);
+ break;
-static s7_pointer all_x_c_s_opssq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = caddr(arg);
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(largs)));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(largs)));
- set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(arg)));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ case 2:
+ if (p_p_ok(sc, opc, s_func, car_x))
+ return(true);
+ break;
+
+ case 3:
+ {
+ int pstart;
+ s7_i_ii_t ifunc;
+ pstart = sc->pc;
-static s7_pointer all_x_c_u_opuuq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = caddr(arg);
- set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
- set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(largs)));
- set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1));
- set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg)));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ if (is_symbol(cadr(car_x)))
+ {
+ if ((is_pair(sig)) &&
+ (is_pair(cdr(sig))) &&
+ (is_pair(cddr(sig))) &&
+ (caddr(sig) == sc->is_integer_symbol))
+ {
+ if (p_pi_ok(sc, opc, s_func, car_x))
+ return(true);
+ else
+ {
+ if ((car(sig) == sc->is_float_symbol) ||
+ (car(sig) == sc->is_real_symbol))
+ {
+ s7_d_pi_t f;
+ f = s7_d_pi_function(s_func);
+ if (f)
+ {
+ sc->pc--;
+ if (float_optimize(sc, expr))
+ {
+ opc->v8.fd = opc->v7.fd;
+ opc->v7.fp = d_to_p;
+ return(true);
+ }
+ }
+ }
+ }
+ }
+ pc_fallback(sc, pstart);
+ }
+
+ ifunc = s7_i_ii_function(s_func);
+ sc->pc--;
+ if ((ifunc) &&
+ (int_optimize(sc, expr)))
+ {
+ opc->v8.fi = opc->v7.fi;
+ opc->v7.fp = i_to_p;
+ return(true);
+ }
+ pc_fallback(sc, pstart);
+
+ if ((p_ii_ok(sc, opc, s_func, car_x)) ||
+ (p_pp_ok(sc, opc, s_func, car_x)))
+ return(true);
+
+ pc_fallback(sc, pstart);
+ if (p_cf_pp_ok(sc, opc, s_func, car_x))
+ return(true);
+ }
+ break;
+
+ case 4:
+ if (is_symbol(cadr(car_x)))
+ {
+ int pstart;
+ pstart = sc->pc;
+ if ((is_pair(sig)) &&
+ (is_pair(cdr(sig))) &&
+ (is_pair(cddr(sig))) &&
+ (caddr(sig) == sc->is_integer_symbol))
+ {
+ if (p_pip_ok(sc, opc, s_func, car_x))
+ return(true);
+ else
+ {
+ if (((car(sig) == sc->is_float_symbol) ||
+ (car(sig) == sc->is_real_symbol)) &&
+ (s7_d_pid_function(s_func)) &&
+ (d_pid_ok(sc, opc, s_func, car_x)))
+ {
+ opc->v8.fd = opc->v7.fd;
+ opc->v7.fp = d_to_p;
+ return(true);
+ }
+ else
+ {
+ sc->pc--;
+ if ((car(sig) == sc->is_integer_symbol) &&
+ (s7_i_pii_function(s_func)) &&
+ (i_pii_ok(sc, alloc_opo(sc, expr), s_func, car_x)))
+ {
+ opc->v8.fi = opc->v7.fi;
+ opc->v7.fp = i_to_p;
+ return(true);
+ }
+ }
+ }
+ }
+ pc_fallback(sc, pstart);
+ }
-static s7_pointer all_x_c_s_opsq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = caddr(arg);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(largs)));
- set_car(sc->t2_2, c_call(largs)(sc, sc->t1_1));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(arg)));
- return(c_call(arg)(sc, sc->t2_1));
+ if ((p_ppi_ok(sc, opc, s_func, car_x)) ||
+ (p_ppp_ok(sc, opc, s_func, car_x)) ||
+ (p_cf_ppp_ok(sc, opc, s_func, car_x)))
+ return(true);
+ break;
+
+ default:
+ if (p_cf_any_ok(sc, opc, s_func, car_x, len))
+ return(true);
+ break;
+ }
+
+ if (cell_all_x_ok(sc, expr, start))
+ return(true);
+ }
+ else
+ {
+ if (is_macro(s_func))
+ {
+ if (!pair_no_opt(expr))
+ {
+ if (cell_optimize(sc, set_plist_1(sc, s7_macroexpand(sc, s_func, cdar(expr)))))
+ return(true);
+ set_pair_no_opt(expr);
+ }
+ }
+ else
+ {
+ /* fprintf(stderr, "cell: %s: %d %d\n", DISPLAY_80(car_x), is_closure(s_func), is_safe_closure(s_func)); */
+ if ((!pair_no_opt(car_x)) &&
+ (is_closure(s_func)) &&
+ (is_safe_closure(s_func)))
+ return(funcall_optimize(sc, car_x, s_func));
+ set_pair_no_opt(car_x);
+ }
+ }
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
}
-static s7_pointer all_x_c_u_opuq(s7_scheme *sc, s7_pointer arg)
+static bool bool_optimize_nw(s7_scheme *sc, s7_pointer expr)
{
- s7_pointer largs;
- largs = caddr(arg);
- set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(largs)));
- set_car(sc->t2_2, c_call(largs)(sc, sc->t1_1));
- set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg)));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ s7_pointer car_x, head;
-static s7_pointer all_x_c_c_opsq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = caddr(arg);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(largs)));
- set_car(sc->t2_2, c_call(largs)(sc, sc->t1_1));
- set_car(sc->t2_1, cadr(arg));
- return(c_call(arg)(sc, sc->t2_1));
-}
+ /* fprintf(stderr, "bool_opt_nw: %d %s\n", sc->pc, DISPLAY_80(expr)); */
+ car_x = car(expr);
+ if (!is_pair(car_x)) /* wrap constants/symbols */
+ return(opt_bool_not_pair(sc, car_x));
-static s7_pointer all_x_c_opsq_opsq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cdr(arg);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(car(largs))));
- sc->temp3 = c_call(car(largs))(sc, sc->t1_1);
- largs = cadr(largs);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(largs)));
- set_car(sc->t2_2, c_call(largs)(sc, sc->t1_1));
- set_car(sc->t2_1, sc->temp3);
- sc->temp3 = sc->nil;
- return(c_call(arg)(sc, sc->t2_1));
-}
+ head = car(car_x);
+ if (is_symbol(head))
+ {
+ s7_pointer s_func;
+ int len;
+ len = s7_list_length(sc, car_x);
-static s7_pointer all_x_c_opuq_opuq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cdr(arg);
- set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(car(largs))));
- sc->temp3 = c_call(car(largs))(sc, sc->t1_1);
- largs = cadr(largs);
- set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(largs)));
- set_car(sc->t2_2, c_call(largs)(sc, sc->t1_1));
- set_car(sc->t2_1, sc->temp3);
- sc->temp3 = sc->nil;
- return(c_call(arg)(sc, sc->t2_1));
-}
+ if ((is_syntactic(head)) ||
+ (typesflag(car_x) == SYNTACTIC_PAIR))
+ {
+ if (head == sc->and_symbol)
+ return(opt_b_and(sc, car_x, len));
+ if (head == sc->or_symbol)
+ return(opt_b_or(sc, car_x, len));
+ return(return_false(sc, car_x, __func__, __LINE__));
+ }
+
+ if ((is_global(head)) ||
+ ((is_slot(global_slot(head))) &&
+ (find_symbol(sc, head) == global_slot(head))))
+ s_func = slot_value(global_slot(head));
+ else return(return_false(sc, car_x, __func__, __LINE__));
+
+ if (is_c_function(s_func))
+ {
+ switch (len)
+ {
+ case 2:
+ return(b_idp_ok(sc, s_func, car_x, opt_arg_type(sc, cdr(car_x))));
-static s7_pointer all_x_c_opssq_opssq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cdr(arg);
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(car(largs))));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(car(largs))));
- sc->temp3 = c_call(car(largs))(sc, sc->t2_1);
- largs = cadr(largs);
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(largs)));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(largs)));
- set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1));
- set_car(sc->t2_1, sc->temp3);
- sc->temp3 = sc->nil;
- return(c_call(arg)(sc, sc->t2_1));
-}
+ case 3:
+ {
+ s7_b_pp_t bpf;
+ bpf = s7_b_pp_function(s_func);
+ /* fprintf(stderr, "%s bpf: %s %p\n", DISPLAY_80(car_x), DISPLAY(s_func), bpf); */
+ if (bpf)
+ {
+ opt_info *opc;
+ s7_pointer sig1, sig2, arg1, arg2;
+ opc = alloc_opo(sc, car_x);
+
+ arg1 = cadr(car_x);
+ arg2 = caddr(car_x);
+ sig1 = opt_arg_type(sc, cdr(car_x));
+ sig2 = opt_arg_type(sc, cddr(car_x));
-static s7_pointer all_x_c_opuuq_opuuq(s7_scheme *sc, s7_pointer arg)
-{
- s7_pointer largs;
- largs = cdr(arg);
- set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(car(largs))));
- set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(car(largs))));
- sc->temp3 = c_call(car(largs))(sc, sc->t2_1);
- largs = cadr(largs);
- set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(largs)));
- set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(largs)));
- set_car(sc->t2_2, c_call(largs)(sc, sc->t2_1));
- set_car(sc->t2_1, sc->temp3);
- sc->temp3 = sc->nil;
- return(c_call(arg)(sc, sc->t2_1));
-}
+ /* fprintf(stderr, "%s sigs: %s %s\n", DISPLAY_80(car_x), DISPLAY(sig1), DISPLAY(sig2)); */
+ if (sig2 == sc->is_integer_symbol)
+ {
+ int cur_index;
+ cur_index = sc->pc;
-static s7_pointer all_x_c_op_opssq_q_c(s7_scheme *sc, s7_pointer code)
-{
- s7_pointer arg;
- arg = cadr(cadr(code));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(arg)));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(arg)));
- set_car(sc->t1_1, c_call(arg)(sc, sc->t2_1));
- set_car(sc->t2_1, c_call(cadr(code))(sc, sc->t1_1));
- set_car(sc->t2_2, caddr(code));
- return(c_call(code)(sc, sc->t2_1));
-}
+ if ((sig1 == sc->is_integer_symbol) &&
+ (b_ii_ok(sc, opc, s_func, car_x, arg1, arg2)))
+ return(true);
+ pc_fallback(sc, cur_index);
-static s7_pointer all_x_c_a(s7_scheme *sc, s7_pointer arg)
-{
- set_car(sc->t1_1, c_call(cdr(arg))(sc, cadr(arg)));
- return(c_call(arg)(sc, sc->t1_1));
-}
+ if ((is_symbol(arg2)) &&
+ (b_pi_ok(sc, opc, s_func, car_x, arg2)))
+ return(true);
+ pc_fallback(sc, cur_index);
+ }
-static s7_pointer all_x_c_ssa(s7_scheme *sc, s7_pointer arg)
-{
- sc->temp3 = c_call(cdddr(arg))(sc, cadddr(arg));
- set_car(sc->t3_1, find_symbol_checked(sc, cadr(arg)));
- set_car(sc->t3_2, find_symbol_checked(sc, caddr(arg)));
- set_car(sc->t3_3, sc->temp3);
- sc->temp3 = sc->nil;
- return(c_call(arg)(sc, sc->t3_1));
-}
+ if ((sig1 == sc->is_float_symbol) &&
+ (sig2 == sc->is_float_symbol) &&
+ (b_dd_ok(sc, opc, s_func, car_x, arg1, arg2)))
+ return(true);
-static s7_pointer all_x_c_sas(s7_scheme *sc, s7_pointer arg)
-{
- sc->temp3 = c_call(cddr(arg))(sc, caddr(arg));
- set_car(sc->t3_1, find_symbol_checked(sc, cadr(arg)));
- set_car(sc->t3_3, find_symbol_checked(sc, cadddr(arg)));
- set_car(sc->t3_2, sc->temp3);
- sc->temp3 = sc->nil;
- return(c_call(arg)(sc, sc->t3_1));
+ opc->v3.b_pp_f = bpf;
+ return(b_pp_ok(sc, opc, s_func, car_x, arg1, arg2));
+ }
+ }
+ break;
+
+ default:
+ break;
+ }
+ }
+ else
+ {
+ if (is_macro(s_func))
+ {
+#if 0
+ if (!pair_no_opt(expr))
+ {
+ return(bool_optimize(sc, set_plist_1(sc, s7_macroexpand(sc, s_func, cdar(expr)))));
+ }
+#endif
+ }
+#if 1
+ else
+ {
+ if ((!pair_no_opt(car_x)) &&
+ (is_closure(s_func)) &&
+ (is_safe_closure(s_func)) &&
+ (returns_bool(sc, s_func)))
+ {
+ int start;
+ start = sc->pc;
+ if (funcall_optimize(sc, car_x, s_func))
+ {
+#if OPT_PRINT
+ fprintf(stderr, "bool: %s\n", DISPLAY_80(car_x));
+#endif
+ sc->opts[start]->v7.fb = (sc->opts[start]->v7.fp == opt_call) ? opt_bool_call : opt_bool_call_1_1;
+ return(true);
+ }
+ set_pair_no_opt(car_x);
+ }
+ }
+#endif
+ }
+ }
+ return(return_false(sc, car_x, __func__, __LINE__));
}
-static s7_pointer all_x_c_sca(s7_scheme *sc, s7_pointer arg)
+static bool bool_optimize(s7_scheme *sc, s7_pointer expr)
{
- sc->temp3 = c_call(cdddr(arg))(sc, cadddr(arg));
- set_car(sc->t3_1, find_symbol_checked(sc, cadr(arg)));
- set_car(sc->t3_2, caddr(arg));
- set_car(sc->t3_3, sc->temp3);
- sc->temp3 = sc->nil;
- return(c_call(arg)(sc, sc->t3_1));
+ int start;
+ opt_info *wrapper;
+ start = sc->pc;
+ if (bool_optimize_nw(sc, expr))
+ return(true);
+ pc_fallback(sc, start);
+ wrapper = sc->opts[start];
+ if (cell_optimize(sc, expr))
+ {
+ if (wrapper->v8.fp) /* (when (+ i 1) ...) */
+ return(false);
+ wrapper->v8.fp = wrapper->v7.fp;
+ wrapper->v7.fb = p_to_b;
+ return(true);
+ }
+ return(false);
}
-static s7_pointer all_x_c_csa(s7_scheme *sc, s7_pointer arg)
+static s7_function s7_bool_optimize(s7_scheme *sc, s7_pointer expr)
{
- sc->temp3 = c_call(cdddr(arg))(sc, cadddr(arg));
- set_car(sc->t3_1, cadr(arg));
- set_car(sc->t3_2, find_symbol_checked(sc, caddr(arg)));
- set_car(sc->t3_3, sc->temp3);
- sc->temp3 = sc->nil;
- return(c_call(arg)(sc, sc->t3_1));
+#if WITH_GMP
+ return(NULL);
+#endif
+ if (sc->safety > CLM_OPTIMIZATION_SAFETY) return(NULL);
+#if OPT_PRINT
+ fprintf(stderr, "bool opt: %s\n", DISPLAY(expr));
+#endif
+ if (setjmp(sc->opt_exit) == 0)
+ {
+ start_opts(sc);
+ if (bool_optimize(sc, expr))
+ return(opt_bool_any);
+ return(all_x_optimize(sc, expr));
+ }
+ return(NULL);
}
-static s7_pointer all_x_c_cas(s7_scheme *sc, s7_pointer arg)
+s7_float_function s7_float_optimize(s7_scheme *sc, s7_pointer expr)
{
- sc->temp3 = c_call(cddr(arg))(sc, caddr(arg));
- set_car(sc->t3_1, cadr(arg));
- set_car(sc->t3_3, find_symbol_checked(sc, cadddr(arg)));
- set_car(sc->t3_2, sc->temp3);
- sc->temp3 = sc->nil;
- return(c_call(arg)(sc, sc->t3_1));
+#if WITH_GMP
+ return(NULL);
+#endif
+ if (sc->safety > CLM_OPTIMIZATION_SAFETY) return(NULL);
+#if OPT_PRINT
+ fprintf(stderr, "fl opt: %s\n", DISPLAY(expr));
+#endif
+ if (setjmp(sc->opt_exit) == 0)
+ {
+ start_opts(sc);
+ if (float_optimize(sc, expr))
+ return(opt_float_any);
+ }
+ return(NULL);
}
-static void all_x_function_init(void)
+s7_function s7_optimize_1(s7_scheme *sc, s7_pointer expr, bool nr)
{
- int i;
- for (i = 0; i < OPT_MAX_DEFINED; i++)
- all_x_function[i] = NULL;
-
- all_x_function[HOP_SAFE_C_C] = all_x_c_c;
- all_x_function[HOP_SAFE_C_Q] = all_x_c_q;
- all_x_function[HOP_SAFE_C_A] = all_x_c_a;
- all_x_function[HOP_SAFE_C_S] = all_x_c_s;
-
- all_x_function[HOP_SAFE_C_opCq] = all_x_c_opcq;
- all_x_function[HOP_SAFE_C_opSq] = all_x_c_opsq;
- all_x_function[HOP_SAFE_C_opSSq] = all_x_c_opssq;
- all_x_function[HOP_SAFE_C_opSCq] = all_x_c_opscq;
- all_x_function[HOP_SAFE_C_opSQq] = all_x_c_opsqq;
-
- all_x_function[HOP_SAFE_C_SC] = all_x_c_sc;
- all_x_function[HOP_SAFE_C_CS] = all_x_c_cs;
- all_x_function[HOP_SAFE_C_SQ] = all_x_c_sq;
- all_x_function[HOP_SAFE_C_SS] = all_x_c_ss;
-
- all_x_function[HOP_SAFE_C_opSq_S] = all_x_c_opsq_s;
- all_x_function[HOP_SAFE_C_opSq_C] = all_x_c_opsq_c;
- all_x_function[HOP_SAFE_C_S_opSq] = all_x_c_s_opsq;
- all_x_function[HOP_SAFE_C_S_opCq] = all_x_c_s_opcq;
- all_x_function[HOP_SAFE_C_opCq_S] = all_x_c_opcq_s;
- all_x_function[HOP_SAFE_C_opCq_C] = all_x_c_opcq_c;
- all_x_function[HOP_SAFE_C_C_opSq] = all_x_c_c_opsq;
- all_x_function[HOP_SAFE_C_C_opCq] = all_x_c_c_opcq;
- all_x_function[HOP_SAFE_C_opSSq_C] = all_x_c_opssq_c;
- all_x_function[HOP_SAFE_C_opSSq_S] = all_x_c_opssq_s;
- all_x_function[HOP_SAFE_C_S_opSSq] = all_x_c_s_opssq;
- all_x_function[HOP_SAFE_C_opSq_opSq] = all_x_c_opsq_opsq;
- all_x_function[HOP_SAFE_C_opCq_opCq] = all_x_c_opcq_opcq;
- all_x_function[HOP_SAFE_C_opSSq_opSSq] = all_x_c_opssq_opssq;
- all_x_function[HOP_SAFE_C_op_opSSq_q_C] = all_x_c_op_opssq_q_c;
+ int old_funcalls, old_unwraps;
+#if WITH_GMP
+ return(NULL);
+#endif
+ if ((sc->safety > CLM_OPTIMIZATION_SAFETY) || (pair_no_opt(expr)))
+ return(NULL);
+#if OPT_PRINT
+ fprintf(stderr, "opt: %s\n", DISPLAY(expr));
+#endif
- all_x_function[HOP_SAFE_C_CSA] = all_x_c_csa;
- all_x_function[HOP_SAFE_C_CAS] = all_x_c_cas;
- all_x_function[HOP_SAFE_C_SCA] = all_x_c_sca;
- all_x_function[HOP_SAFE_C_SAS] = all_x_c_sas;
- all_x_function[HOP_SAFE_C_SSA] = all_x_c_ssa;
- all_x_function[HOP_SAFE_C_SSC] = all_x_c_ssc;
- all_x_function[HOP_SAFE_C_SSS] = all_x_c_sss;
- all_x_function[HOP_SAFE_C_SCS] = all_x_c_scs;
- all_x_function[HOP_SAFE_C_CSS] = all_x_c_css;
- all_x_function[HOP_SAFE_C_CSC] = all_x_c_csc;
-}
+ old_funcalls = sc->funcalls;
+ old_unwraps = sc->unwraps;
-static s7_function all_x_eval(s7_scheme *sc, s7_pointer arg, s7_pointer e, safe_sym_t *checker)
-{
- /* fprintf(stderr, "all_x_eval: %s %s\n", DISPLAY(arg), DISPLAY(e)); */
- if (is_pair(arg))
+ if (setjmp(sc->opt_exit) == 0)
{
- if (is_optimized(arg))
+ s7_function f;
+ start_opts(sc);
+ if (!no_int_opt(expr))
{
- switch (optimize_op(arg))
+ if (int_optimize(sc, expr))
+ return((nr) ? opt_int_any_nr : opt_wrap_int);
+ pc_fallback(sc, 0);
+ set_no_int_opt(expr);
+ }
+ if (!no_bool_opt(expr))
+ {
+ if (float_optimize(sc, expr))
+ return((nr) ? opt_float_any_nr : opt_wrap_float);
+ pc_fallback(sc, 0);
+ set_no_bool_opt(expr);
+ }
+ if (!no_bool_opt(expr))
+ {
+ if (bool_optimize_nw(sc, expr))
+ return((nr) ? opt_bool_any_nr : opt_wrap_bool);
+ pc_fallback(sc, 0);
+ set_no_bool_opt(expr);
+ }
+ if (cell_optimize(sc, expr))
+ {
+ /* an experiment */
+ if ((sc->funcalls > old_funcalls) &&
+ (sc->unwraps == old_unwraps))
{
- case HOP_SAFE_C_C:
- if ((c_call(arg) == g_add_cs1) &&
- (checker(sc, cadr(arg), e)))
- return(all_x_c_add1);
- if ((c_call(arg) == g_add_si) &&
- (checker(sc, cadr(arg), e)))
- return(all_x_c_addi);
- if ((c_call(arg) == g_char_equal_s_ic) &&
- (checker(sc, cadr(arg), e)))
- return(all_x_c_char_eq);
- return(all_x_c_c);
-
- case HOP_SAFE_C_S:
- if (car(arg) == sc->cdr_symbol)
- {
- if (checker(sc, cadr(arg), e))
- return(all_x_cdr_u);
- return(all_x_cdr_s);
- }
- if (car(arg) == sc->car_symbol) return(all_x_car_s);
- if (car(arg) == sc->is_null_symbol) return(all_x_null_s);
- if (checker(sc, cadr(arg), e)) /* all we want here is assurance it's not going to be unbound */
- return(all_x_c_u);
- return(all_x_c_s);
-
- case HOP_SAFE_C_SS:
- if ((checker(sc, cadr(arg), e)) &&
- (checker(sc, caddr(arg), e)))
- return(all_x_c_uu);
- return(all_x_c_ss);
-
- case HOP_SAFE_C_SSS:
- if ((checker(sc, cadr(arg), e)) &&
- (checker(sc, caddr(arg), e)) &&
- (checker(sc, cadddr(arg), e)))
- return(all_x_c_uuu);
- return(all_x_c_sss);
-
- case HOP_SAFE_C_SC:
- if (checker(sc, cadr(arg), e))
- return(all_x_c_uc);
- return(all_x_c_sc);
-
- case HOP_SAFE_C_opSq:
- if (checker(sc, cadr(cadr(arg)), e))
+ int i;
+ for (i = 0; i < sc->pc; i++)
{
- if (car(arg) == sc->not_symbol)
- return(all_x_c_not_opuq);
- return(all_x_c_opuq);
+ opt_info *o;
+ o = sc->opts[i];
+ if ((o->v7.fp == opt_call) ||
+ (o->v7.fp == opt_call_1_1))
+ {
+ o->v7.fp = (o->v7.fp == opt_call) ? opt_call_no_env : opt_call_1_1_no_env;
+ let_id(o->v2.p) = ++sc->let_number;
+ }
}
- if (car(arg) == sc->not_symbol)
- return(all_x_c_not_opsq);
- return(all_x_c_opsq);
-
- case HOP_SAFE_C_opSq_opSq:
- if ((checker(sc, cadr(cadr(arg)), e)) &&
- (checker(sc, cadr(caddr(arg)), e)))
- return(all_x_c_opuq_opuq);
- return(all_x_c_opsq_opsq);
-
- case HOP_SAFE_C_opSSq_opSSq:
- if ((checker(sc, cadr(cadr(arg)), e)) &&
- (checker(sc, caddr(cadr(arg)), e)) &&
- (checker(sc, cadr(caddr(arg)), e)) &&
- (checker(sc, caddr(caddr(arg)), e)))
- return(all_x_c_opuuq_opuuq);
- return(all_x_c_opssq_opssq);
+ }
+ return((nr) ? opt_cell_any_nr : opt_wrap_cell);
+ }
+ pc_fallback(sc, 0);
+ f = all_x_optimize(sc, expr);
+ if (!f)
+ set_pair_no_opt(expr);
+ return(f);
+ }
+ return(NULL);
+}
- case HOP_SAFE_C_opSSq:
- if ((checker(sc, cadr(cadr(arg)), e)) &&
- (checker(sc, caddr(cadr(arg)), e)))
- return(all_x_c_opuuq);
- return(all_x_c_opssq);
+s7_function s7_optimize(s7_scheme *sc, s7_pointer expr) {return(s7_optimize_1(sc, expr, false));}
+s7_function s7_optimize_nr(s7_scheme *sc, s7_pointer expr) {return(s7_optimize_1(sc, expr, true));}
- case HOP_SAFE_C_opSSq_S:
- if ((checker(sc, cadr(cadr(arg)), e)) &&
- (checker(sc, caddr(cadr(arg)), e)) &&
- (checker(sc, caddr(arg), e)))
- return(all_x_c_opuuq_u);
- return(all_x_c_opssq_s);
+static s7_pointer g_optimize(s7_scheme *sc, s7_pointer args)
+{
+ s7_function f;
+ s7_pointer code;
+ code = car(args);
+ f = s7_optimize(sc, code);
+ if (f)
+ return(f(sc, car(code)));
+ return(sc->undefined);
+}
- case HOP_SAFE_C_S_opSq:
- if ((checker(sc, cadr(arg), e)) &&
- (checker(sc, cadr(caddr(arg)), e)))
- return(all_x_c_u_opuq);
- return(all_x_c_s_opsq);
+static s7_function s7_cell_optimize(s7_scheme *sc, s7_pointer expr, bool nr)
+{
+ /* fprintf(stderr, "s7_cell_optimize %s safe: %d, pair: %d\n", DISPLAY_80(expr), sc->safety, pair_no_opt(expr)); */
+#if WITH_GMP
+ return(NULL);
+#endif
+ if (sc->safety > CLM_OPTIMIZATION_SAFETY) return(NULL);
+ if (setjmp(sc->opt_exit) == 0)
+ {
+ start_opts(sc);
+ if (!cell_optimize(sc, expr))
+ return(all_x_optimize(sc, expr));
+ return((nr) ? opt_cell_any_nr : opt_wrap_cell);
+ }
+ return(NULL);
+}
- case HOP_SAFE_C_S_opSSq:
- if ((checker(sc, cadr(arg), e)) &&
- (checker(sc, cadr(caddr(arg)), e)) &&
- (checker(sc, caddr(caddr(arg)), e)))
- return(all_x_c_u_opuuq);
- return(all_x_c_s_opssq);
+/* caller: s7_float_optimize(sc, expr, env) to return a function that when called evaluates expr in env
+ * s7_float_optimize returns an s7_float_function (s7_double opt_float_any(s7_scheme *sc, s7_pointer expr) normally)
+ * s7_float_any evaluates the program stored in sc->opts by calling opts[0]->f(opts[0])
+ * each portion of expr resides in an opt_info struct, evalled by calling its "fd" function on itself
+ * fd chooses the basic form of the expr, calling one of the underlying functions in opts[n] such as opt_d_c
+ * finally that calls the actual function such as abs_d
+ */
- case HOP_SAFE_C_opSq_S:
- if ((checker(sc, cadr(cadr(arg)), e)) &&
- (checker(sc, caddr(arg), e)))
- return(all_x_c_opuq_u);
- return(all_x_c_opsq_s);
- default:
- /* if (!all_x_function[optimize_op(arg)]) fprintf(stderr, "%s: %s\n", opt_names[optimize_op(arg)], DISPLAY(arg)); */
- return(all_x_function[optimize_op(arg)]);
- }
- }
- if (car(arg) == sc->quote_symbol)
- return(all_x_q);
- return(NULL);
- }
- if (is_symbol(arg))
+/* -------------------------------------------------------------------------------- */
+static void clear_optimizer_fixups(s7_scheme *sc)
+{
+ hash_entry_t *p, *n;
+ for (p = sc->optimizer_fixups; p; p = n)
{
- if (is_keyword(arg))
- return(all_x_k);
- if (checker(sc, arg, e))
- return(all_x_u);
- return(all_x_s);
+ n = p->next;
+ p->next = hash_free_list;
+ hash_free_list = p;
}
- return(all_x_c);
+ sc->optimizer_fixups = NULL;
}
+static void add_optimizer_fixup(s7_scheme *sc, s7_pointer expr, unsigned int op)
+{
+ hash_entry_t *p;
+#if DEBUGGING
+ if (((op & 1) != 0) && (!all_x_function[op])) fprintf(stderr, "no all_x fixup for %s\n", opt_names[op]);
+#endif
+ p = make_hash_entry(expr, sc->nil, op);
+ p->next = sc->optimizer_fixups;
+ sc->optimizer_fixups = p;
+}
-static s7_function cond_all_x_eval(s7_scheme *sc, s7_pointer arg, s7_pointer e)
+static void handle_optimizer_fixups(s7_scheme *sc)
{
- if (arg == sc->else_object)
- return(all_x_else);
- return(all_x_eval(sc, arg, e, let_symbol_is_safe));
+ hash_entry_t *p;
+ for (p = sc->optimizer_fixups; p; p = p->next)
+ set_optimize_op(p->key, p->raw_hash);
+ clear_optimizer_fixups(sc);
}
@@ -48929,6 +53553,23 @@ static s7_pointer make_counter(s7_scheme *sc, s7_pointer iter)
return(x);
}
+static s7_pointer make_iterators(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ sc->temp3 = args;
+ sc->z = sc->nil; /* don't use sc->args here -- it needs GC protection until we get the iterators */
+ for (p = cdr(args); is_pair(p); p = cdr(p))
+ {
+ s7_pointer iter;
+ iter = car(p);
+ if (!is_iterator(car(p)))
+ iter = s7_make_iterator(sc, iter);
+ sc->z = cons(sc, iter, sc->z);
+ }
+ sc->temp3 = sc->nil;
+ return(safe_reverse_in_place(sc, sc->z));
+}
+
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. \
@@ -48937,38 +53578,27 @@ Each object can be a list, string, vector, hash-table, or any other sequence."
s7_pointer p, f;
int len;
- bool got_nil = false;
-
- /* fprintf(stderr, "for-each: %s\n", DISPLAY(args)); */
+ bool got_nil = false, arity_ok = false;
/* try the normal case first */
f = car(args); /* the function */
- p = cadr(args);
- if ((is_null(cddr(args))) &&
- (is_pair(p)) &&
- (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)))))
+ len = safe_list_length(sc, cdr(args));
+
+ if (is_closure(f)) /* not lambda* that might get confused about arg names */
{
- 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);
+ if ((len == 1) &&
+ (is_pair(closure_args(f))) &&
+ (is_null(cdr(closure_args(f)))))
+ arity_ok = true;
}
-
- if (!is_applicable(f))
- method_or_bust_with_type(sc, f, sc->for_each_symbol, args, something_applicable_string, 1);
-
- for (len = 0, p = cdr(args); is_not_null(p); p = cdr(p), len++)
+ else
{
- if ((!is_sequence(car(p))) && (!is_iterator(car(p))))
- return(simple_wrong_type_argument_with_type(sc, sc->for_each_symbol, car(p), a_sequence_string));
- if (is_null(car(p)))
- got_nil = true;
+ if (!is_applicable(f))
+ method_or_bust_with_type(sc, f, sc->for_each_symbol, args, something_applicable_string, 1);
}
- if (!s7_is_aritable(sc, f, len))
+ if ((!arity_ok) &&
+ (!s7_is_aritable(sc, f, len)))
{
static s7_pointer for_each_args_error = NULL;
if (!for_each_args_error)
@@ -48976,23 +53606,19 @@ 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))));
}
- if (got_nil) return(sc->unspecified);
-
- sc->temp3 = args;
- sc->z = sc->nil; /* don't use sc->args here -- it needs GC protection until we get the iterators */
- for (p = cdr(args); is_not_null(p); p = cdr(p))
+ for (p = cdr(args); is_pair(p); p = cdr(p))
{
- s7_pointer iter;
- iter = car(p);
- if (!is_iterator(car(p)))
- iter = s7_make_iterator(sc, iter);
- sc->z = cons(sc, iter, sc->z);
+ 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));
+ }
}
- sc->temp3 = sc->nil;
- sc->x = make_list(sc, len, sc->nil);
- sc->z = safe_reverse_in_place(sc, sc->z);
- sc->z = cons(sc, sc->z, sc->x);
+ if (got_nil) return(sc->unspecified);
/* if function is safe c func, do the for-each locally */
if ((is_safe_procedure(f)) &&
@@ -49000,8 +53626,11 @@ Each object can be a list, string, vector, hash-table, or any other sequence."
{
s7_function func;
s7_pointer iters;
+
func = c_function_call(f);
- push_stack(sc, OP_NO_OP, sc->args, sc->z); /* temporary GC protection */
+ 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 */
if (len == 1)
{
s7_pointer x, y;
@@ -49013,7 +53642,10 @@ Each object can be a list, string, vector, hash-table, or any other sequence."
set_car(y, s7_iterate(sc, x));
if (iterator_is_at_end(x))
{
- pop_stack(sc);
+ /* not pop_stack here since that can clobber sc->code et al, and if this for-each call is
+ * begin treated as safe, c_call(for-each) assumes everywhere that sc->code is left alone.
+ */
+ sc->stack_end -= 4;
return(sc->unspecified);
}
func(sc, y);
@@ -49029,8 +53661,7 @@ Each object can be a list, string, vector, hash-table, or any other sequence."
set_car(y, s7_iterate(sc, car(x)));
if (iterator_is_at_end(car(x)))
{
-
- pop_stack(sc);
+ sc->stack_end -= 4;
return(sc->unspecified);
}
}
@@ -49047,40 +53678,88 @@ Each object can be a list, string, vector, hash-table, or any other sequence."
s7_pointer body, expr;
body = closure_body(f);
expr = car(body);
- if ((is_null(cdr(body))) &&
- (is_optimized(expr)) &&
- (is_all_x_op(optimize_op(expr))))
+
+ if (!pair_no_opt(body))
{
s7_function func;
- s7_pointer slot, iter;
-
- iter = caar(sc->z);
- sc->z = sc->nil;
- push_stack(sc, OP_NO_OP, iter, f);
+ 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);
- func = all_x_eval(sc, expr, sc->envir, let_symbol_is_safe);
- if (func == all_x_c_c)
- {
- func = c_callee(expr);
- expr = cdr(expr);
- }
- while (true)
+
+ 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);
+
+ if (func)
{
- slot_set_value(slot, s7_iterate(sc, iter));
- if (iterator_is_at_end(iter))
+ if (is_pair(cadr(args)))
{
- pop_stack(sc);
+ s7_pointer x, y;
+ for (x = cadr(args), 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);
}
- func(sc, expr);
+ else
+ {
+ s7_pointer iter;
+ sc->z = cadr(args);
+ if (!is_iterator(sc->z))
+ sc->z = s7_make_iterator(sc, sc->z);
+ iter = sc->z;
+ push_stack(sc, OP_GC_PROTECT, iter, f);
+ sc->z = sc->nil;
+ while (true)
+ {
+ slot_set_value(slot, s7_iterate(sc, iter));
+ if (iterator_is_at_end(iter))
+ {
+ sc->stack_end -= 4;
+ return(sc->unspecified);
+ }
+ func(sc, expr);
+ }
+ }
+ }
+ set_pair_no_opt(body);
+ sc->envir = old_e;
+ }
+
+ if (is_null(cdr(body)))
+ {
+ p = cadr(args);
+ if (is_pair(p))
+ {
+ 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);
}
}
- push_stack(sc, OP_FOR_EACH_1, make_counter(sc, caar(sc->z)), f);
+
+ 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;
return(sc->unspecified);
}
- push_stack(sc, OP_FOR_EACH, sc->z, f);
+
+ 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);
}
@@ -49094,139 +53773,210 @@ static s7_pointer g_map(s7_scheme *sc, s7_pointer args)
a list of the results. Its arguments can be lists, vectors, strings, hash-tables, or any applicable objects."
#define Q_map s7_make_circular_signature(sc, 2, 3, sc->is_list_symbol, sc->is_procedure_symbol, sc->is_sequence_symbol)
+ static s7_pointer map_args_error = NULL;
s7_pointer p, f;
int len;
bool got_nil = false;
- f = car(args); /* the function */
- if (!is_applicable(f))
- method_or_bust_with_type(sc, f, sc->map_symbol, args, something_applicable_string, 1);
-
+ f = car(args); /* the function */
for (len = 0, p = cdr(args); is_not_null(p); p = cdr(p), len++)
{
- if ((!is_sequence(car(p))) && (!is_iterator(car(p))))
- return(simple_wrong_type_argument_with_type(sc, sc->map_symbol, car(p), a_sequence_string));
- if (is_null(car(p)))
- got_nil = true;
- }
-
- if ((!is_pair(f)) &&
- (!s7_is_aritable(sc, f, len)))
- {
- static s7_pointer map_args_error = NULL;
- if (!map_args_error)
- map_args_error = s7_make_permanent_string("map ~A: ~A args?");
- return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, map_args_error, f, small_int(len))));
- }
-
- if (got_nil) return(sc->nil);
-
- if ((f == slot_value(global_slot(sc->values_symbol))) &&
- (is_null(cddr(args))) &&
- (!has_methods(cadr(args))))
- {
- p = object_to_list(sc, cadr(args));
- if (p != cadr(args))
- return(p);
- }
-
- sc->temp3 = args;
- sc->z = sc->nil; /* don't use sc->args here -- it needs GC protection until we get the iterators */
- for (p = cdr(args); is_not_null(p); p = cdr(p))
- {
- s7_pointer iter;
- iter = car(p);
- if (!is_iterator(car(p)))
- iter = s7_make_iterator(sc, iter);
- sc->z = cons(sc, iter, sc->z);
+ if (!is_mappable(car(p)))
+ {
+ if (is_null(car(p)))
+ got_nil = true;
+ else return(simple_wrong_type_argument_with_type(sc, sc->map_symbol, car(p), a_sequence_string));
+ }
}
- sc->z = safe_reverse_in_place(sc, sc->z);
- sc->temp3 = sc->nil;
- /* if function is safe c func, do the map locally */
- if ((is_safe_procedure(f)) &&
- (is_c_function(f)))
+ switch (type(f))
{
- s7_function func;
- s7_pointer val, val1, old_args, iter_list;
-
- val1 = cons(sc, sc->z, make_list(sc, len, sc->nil));
- iter_list = sc->z;
- old_args = sc->args;
- func = c_function_call(f);
- push_stack(sc, OP_NO_OP, val1, val = cons(sc, sc->nil, sc->code)); /* temporary GC protection: need to protect val1, iter_list, val */
- sc->z = sc->nil;
-
- while (true)
+ case T_C_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ case T_C_FUNCTION_STAR:
+ if (((int)c_function_required_args(f) > len) ||
+ ((int)c_function_all_args(f) < len))
+ {
+ if (!map_args_error)
+ map_args_error = s7_make_permanent_string("map ~A: ~A args?");
+ return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, map_args_error, f, small_int(len))));
+ }
+
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_ANY_ARGS_FUNCTION:
+ /* if function is safe c func, do the map locally */
+ if (got_nil) return(sc->nil);
+ if (is_safe_procedure(f))
{
- s7_pointer x, y, z;
- for (x = iter_list, y = cdr(val1); is_pair(x); x = cdr(x), y = cdr(y))
+ s7_function func;
+ func = c_function_call(f);
+ if ((is_pair(cadr(args))) &&
+ (len == 1))
+ {
+ 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);
+ for (fast = cadr(args), slow = cadr(args); is_pair(fast); fast = cdr(fast), slow = cdr(slow))
+ {
+ s7_pointer z;
+ set_car(f_args, car(fast));
+ z = func(sc, f_args);
+ 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;
+ set_car(f_args, car(fast));
+ z = func(sc, f_args);
+ 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)));
+ }
+ else
{
- set_car(y, s7_iterate(sc, car(x)));
- if (iterator_is_at_end(car(x)))
+ s7_pointer val, val1, old_args, iter_list;
+ sc->z = make_iterators(sc, args);
+ val1 = cons(sc, sc->z, make_list(sc, len, sc->nil));
+ 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 */
+ sc->z = sc->nil;
+ while (true)
{
- pop_stack(sc);
- sc->args = old_args;
- return(safe_reverse_in_place(sc, car(val)));
+ s7_pointer x, y, z;
+ for (x = iter_list, y = cdr(val1); is_pair(x); x = cdr(x), y = cdr(y))
+ {
+ set_car(y, s7_iterate(sc, car(x)));
+ if (iterator_is_at_end(car(x)))
+ {
+ sc->stack_end -= 4;
+ sc->args = old_args;
+ return(safe_reverse_in_place(sc, car(val)));
+ }
+ }
+ z = func(sc, cdr(val1)); /* can this contain multiple-values? */
+ if (z != sc->no_value)
+ set_car(val, cons(sc, z, car(val)));
}
}
- z = func(sc, cdr(val1)); /* can this contain multiple-values? */
- if (z != sc->no_value)
- set_car(val, cons(sc, z, car(val)));
-
+ }
+ else /* not safe procedure */
+ {
/* to mimic map values handling elsewhere:
* ((lambda args (format *stderr* "~A~%" (map values args))) (values)): ()
* ((lambda args (format *stderr* "~A~%" (map values args))) (values #<unspecified>)): #<unspecified> etc
*/
- }
- }
-
- /* if closure call is straightforward, use OP_MAP_1 */
- if ((len == 1) &&
- (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);
- if ((is_null(cdr(body))) &&
- (is_optimized(expr)) &&
- (is_all_x_op(optimize_op(expr))))
- {
- s7_function func;
- s7_pointer slot, iter, val;
-
- iter = car(sc->z);
- push_stack(sc, OP_NO_OP, sc->args, val = cons(sc, sc->nil, cons(sc, f, iter))); /* second cons is GC protection */
- sc->envir = new_frame_in_env(sc, sc->envir);
- slot = make_slot_1(sc, sc->envir, car(closure_args(f)), sc->F);
- func = all_x_eval(sc, expr, sc->envir, let_symbol_is_safe);
- sc->z = sc->nil;
- if (func == all_x_c_c)
+ if ((f == slot_value(global_slot(sc->values_symbol))) &&
+ (len == 1) &&
+ (!has_methods(cadr(args)))) /* iterator should be ok here -- object_to_list can handle it */
{
- func = c_callee(expr);
- expr = cdr(expr);
+ p = object_to_list(sc, cadr(args));
+ if (p != cadr(args))
+ return(p);
}
- while (true)
+ }
+ break;
+
+ case T_CLOSURE:
+ {
+ int fargs;
+ fargs = closure_arity_to_int(sc, f);
+ /* if closure call is straightforward, use OP_MAP_1 */
+ if ((len == 1) &&
+ (fargs == 1) &&
+ (!is_immutable_symbol(car(closure_args(f)))))
{
- s7_pointer z;
- slot_set_value(slot, s7_iterate(sc, iter));
- if (iterator_is_at_end(iter))
+ s7_pointer body, expr;
+ 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)))
{
- pop_stack(sc);
- return(safe_reverse_in_place(sc, car(val)));
+ 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;
}
- z = func(sc, expr);
- if (z != sc->no_value)
- set_car(val, cons(sc, z, car(val)));
+
+ 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;
+ return(sc->nil);
+ }
+ if ((fargs > len) ||
+ ((fargs < len) &&
+ ((fargs >= 0) ||
+ (abs(fargs) > len))))
+ {
+ if (!map_args_error)
+ map_args_error = s7_make_permanent_string("map ~A: ~A args?");
+ return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, map_args_error, f, small_int(len))));
}
+ if (got_nil) return(sc->nil);
}
+ break;
- push_stack(sc, OP_MAP_1, make_counter(sc, car(sc->z)), f);
- sc->z = sc->nil;
- return(sc->nil);
+ default:
+ if (!is_applicable(f))
+ method_or_bust_with_type(sc, f, sc->map_symbol, args, something_applicable_string, 1);
+
+ if ((!is_pair(f)) &&
+ (!s7_is_aritable(sc, f, len)))
+ {
+ if (!map_args_error)
+ map_args_error = s7_make_permanent_string("map ~A: ~A args?");
+ return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, map_args_error, f, small_int(len))));
+ }
+ if (got_nil) return(sc->nil);
+ break;
}
+
+ sc->z = make_iterators(sc, args);
push_stack(sc, OP_MAP, make_counter(sc, sc->z), f);
sc->z = sc->nil;
return(sc->nil);
@@ -49286,16 +54036,28 @@ static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args)
return(args);
case OP_C_P_1:
+ case OP_SAFE_C_P_1:
+ case OP_NOT_P_1:
vector_element(sc->stack, top) = (s7_pointer)OP_C_P_2;
return(args);
case OP_SAFE_CLOSURE_P_1:
case OP_CLOSURE_P_1:
- vector_element(sc->stack, top) = (s7_pointer)OP_CLOSURE_P_2;
+ vector_element(sc->stack, top) = (s7_pointer)OP_CLOSURE_P_MV;
return(args);
-
- case OP_C_SP_1:
- vector_element(sc->stack, top) = (s7_pointer)OP_C_SP_2;
+
+ case OP_SAFE_CLOSURE_AP_1:
+ case OP_CLOSURE_AP_1:
+ vector_element(sc->stack, top) = (s7_pointer)OP_CLOSURE_AP_MV;
+ return(args);
+
+ case OP_SAFE_CLOSURE_PA_1:
+ 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:
@@ -49346,7 +54108,7 @@ static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args)
set_multiple_value(args);
eval_error_with_caller(sc, "~A: can't bind some variable to ~S", sc->let_symbol, args);
/* "some variable" is ugly, but the actual name is tricky to find at this point --
- * it's in main_stack_args, but finding the right one is a mess. It's isn't sc->code.
+ * it's in main_stack_args, but finding the right one is a mess. It isn't sc->code.
*/
case OP_LET_STAR1:
@@ -49429,13 +54191,16 @@ s7_pointer s7_values(s7_scheme *sc, s7_pointer args)
#define g_values s7_values
+static s7_pointer values_p(void) {return(cur_sc->no_value);}
+static s7_pointer values_p_p(s7_pointer p) {return(p);}
+
/* -------------------------------- quasiquote -------------------------------- */
-static s7_pointer g_qq_list(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_list_values(s7_scheme *sc, s7_pointer args)
{
- #define H_qq_list "(list-values ...) returns its arguments in a list (internal to quasiquote)"
- #define Q_qq_list s7_make_circular_signature(sc, 1, 2, sc->is_list_symbol, sc->T)
+ #define H_list_values "(list-values ...) returns its arguments in a list (internal to quasiquote)"
+ #define Q_list_values s7_make_circular_signature(sc, 1, 2, sc->is_list_symbol, sc->T)
s7_pointer x, y, px;
@@ -49502,6 +54267,7 @@ static s7_pointer g_apply_values(s7_scheme *sc, s7_pointer args)
return(g_values(sc, x));
}
+
/* (apply values ...) replaces (unquote_splicing ...)
*
* (define-macro (hi a) `(+ 1 ,a) == (list '+ 1 a)
@@ -49520,6 +54286,7 @@ static s7_pointer g_apply_values(s7_scheme *sc, s7_pointer args)
static bool is_simple_code(s7_scheme *sc, s7_pointer form)
{
+ /* TODO: perhaps tree_memq here? the cycle check below is inadequate, and the last check looks dumb */
s7_pointer tmp;
for (tmp = form; is_pair(tmp); tmp = cdr(tmp))
if (is_pair(car(tmp)))
@@ -49595,7 +54362,7 @@ and splices the resultant list into the outer list. `(1 ,(+ 1 1) ,@(list 3 4)) -
for (i = 0; i <= len; i++)
sc->w = cons(sc, sc->nil, sc->w);
- set_car(sc->w, sc->qq_list_function);
+ set_car(sc->w, sc->list_values_symbol);
if (!dotted)
{
@@ -49612,7 +54379,7 @@ and splices the resultant list into the outer list. `(1 ,(+ 1 1) ,@(list 3 4)) -
*/
set_car(bq, g_quasiquote_1(sc, car(orig)));
set_cdr(bq, sc->nil);
- sc->w = list_3(sc, sc->qq_append_function, sc->w, caddr(orig));
+ sc->w = list_3(sc, sc->append_symbol, sc->w, caddr(orig));
break;
}
else set_car(bq, g_quasiquote_1(sc, car(orig)));
@@ -49626,7 +54393,7 @@ and splices the resultant list into the outer list. `(1 ,(+ 1 1) ,@(list 3 4)) -
set_car(bq, g_quasiquote_1(sc, car(orig)));
set_car(bq, g_quasiquote_1(sc, car(orig)));
- sc->w = list_3(sc, sc->qq_append_function, sc->w, g_quasiquote_1(sc, cdr(orig)));
+ sc->w = list_3(sc, sc->append_symbol, sc->w, g_quasiquote_1(sc, cdr(orig)));
/* quasiquote might quote a symbol in cdr(orig), so it's not completely pointless */
}
@@ -49658,8 +54425,10 @@ static void back_up_stack(s7_scheme *sc)
top_op = stack_op(sc->stack, s7_stack_top(sc) - 1);
}
if ((top_op == OP_READ_VECTOR) ||
- (top_op == OP_READ_BYTE_VECTOR))
- {
+ (top_op == OP_READ_BYTE_VECTOR) ||
+ (top_op == OP_READ_INT_VECTOR) ||
+ (top_op == OP_READ_FLOAT_VECTOR))
+ {
pop_stack(sc);
top_op = stack_op(sc->stack, s7_stack_top(sc) - 1);
}
@@ -49683,6 +54452,18 @@ static token_t read_sharp(s7_scheme *sc, s7_pointer pt)
sc->w = small_int(1);
return(TOKEN_VECTOR);
+ case 'i':
+ if (read_sharp(sc, pt) == TOKEN_VECTOR)
+ return(TOKEN_INT_VECTOR);
+ backchar('i', pt);
+ break;
+
+ case 'r':
+ if (read_sharp(sc, pt) == TOKEN_VECTOR)
+ return(TOKEN_FLOAT_VECTOR);
+ backchar('r', pt);
+ break;
+
case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9':
{
/* here we can get an overflow: #1231231231231232131D()
@@ -50158,7 +54939,17 @@ 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);
+ push_stack_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);
+ sc->tok = TOKEN_LEFT_PAREN;
+ break;
+
+ case TOKEN_FLOAT_VECTOR:
+ push_stack_no_code(sc, OP_READ_FLOAT_VECTOR, sc->w);
sc->tok = TOKEN_LEFT_PAREN;
break;
@@ -50240,12 +55031,11 @@ static s7_pointer read_expression(s7_scheme *sc)
case TOKEN_DOUBLE_QUOTE:
sc->value = read_string_constant(sc, sc->input_port);
-
if (sc->value == sc->F) /* can happen if input code ends in the middle of a string */
return(string_read_error(sc, "end of input encountered while in a string"));
if (sc->value == sc->T)
return(read_error(sc, "unknown backslash usage -- perhaps you meant two backslashes?"));
-
+ if (sc->safety > IMMUTABLE_VECTOR_SAFETY) set_immutable(sc->value);
return(sc->value);
case TOKEN_SHARP_CONST:
@@ -50294,7 +55084,7 @@ static s7_pointer find_closure_let(s7_scheme *sc, s7_pointer cur_env)
{
s7_pointer e;
for (e = cur_env; is_let(e); e = outlet(e))
- if (is_function_env(e))
+ if (is_funclet(e))
return(e);
return(sc->nil);
}
@@ -50464,21 +55254,18 @@ static s7_pointer assign_syntax(s7_scheme *sc, const char *name, opcode_t op, s7
syn = alloc_pointer();
unheap(syn);
- set_type(syn, T_SYNTAX | T_SYNTACTIC | T_DONT_EVAL_ARGS);
+ set_type(syn, T_SYNTAX | T_SYNTACTIC | T_DONT_EVAL_ARGS | T_GLOBAL);
syntax_opcode(syn) = op;
syntax_set_symbol(syn, x);
syntax_min_args(syn) = integer(min_args);
syntax_max_args(syn) = ((max_args == max_arity) ? -1 : integer(max_args));
syntax_documentation(syn) = s7_make_permanent_string(doc);
- syntax_rp(syn) = NULL;
- syntax_ip(syn) = NULL;
- syntax_pp(syn) = NULL;
set_global_slot(x, permanent_slot(x, syn));
set_initial_slot(x, permanent_slot(x, syn));
- typeflag(x) = SYNTACTIC_TYPE;
+ typeflag(x) = SYNTACTIC_TYPE; /* symbol syntactic etc */
symbol_set_local(x, 0LL, sc->nil);
- symbol_syntax_op(x) = op;
+ symbol_set_ctr(x, 0;)
return(x);
}
@@ -50496,19 +55283,16 @@ static s7_pointer assign_internal_syntax(s7_scheme *sc, const char *name, opcode
set_type(x, T_SYMBOL);
symbol_set_name_cell(x, str);
symbol_set_local(x, 0LL, sc->nil);
- symbol_syntax_op(x) = op;
+ symbol_set_ctr(x, 0);
syn = alloc_pointer();
heap_location(syn) = heap_location(old_syn);
- set_type(syn, T_SYNTAX | T_SYNTACTIC | T_DONT_EVAL_ARGS);
+ set_type(syn, T_SYNTAX | T_SYNTACTIC | T_DONT_EVAL_ARGS | T_GLOBAL);
syntax_opcode(syn) = op;
syntax_set_symbol(syn, symbol);
syntax_min_args(syn) = syntax_min_args(old_syn);
syntax_max_args(syn) = syntax_max_args(old_syn);
syntax_documentation(syn) = syntax_documentation(old_syn);
- syntax_rp(syn) = syntax_rp(old_syn);
- syntax_ip(syn) = syntax_ip(old_syn);
- syntax_pp(syn) = syntax_pp(old_syn);
set_global_slot(x, permanent_slot(x, syn));
set_initial_slot(x, permanent_slot(x, syn));
@@ -50517,34 +55301,30 @@ static s7_pointer assign_internal_syntax(s7_scheme *sc, const char *name, opcode
}
-static s7_int c_pair_line_number(s7_scheme *sc, s7_pointer p)
+static s7_pointer g_pair_line_number(s7_scheme *sc, s7_pointer args)
{
+ s7_pointer p;
+ #define H_pair_line_number "(pair-line-number pair) returns the line number at which it read 'pair', or #f if no such number is available"
+ #define Q_pair_line_number s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_boolean_symbol), sc->is_pair_symbol)
+
+ p = car(args);
if (!is_pair(p))
- int_method_or_bust(sc, p, sc->pair_line_number_symbol, set_plist_1(sc, p), T_PAIR, 0);
+ method_or_bust_one_arg(sc, p, sc->pair_line_number_symbol, set_plist_1(sc, p), T_PAIR);
if (has_line_number(p))
{
unsigned int x;
x = pair_line(p);
- return(remembered_line_number(x));
+ return(make_integer(sc, remembered_line_number(x)));
}
- return(0);
+ return(sc->F); /* was 0 21-Mar-17 */
}
-static s7_pointer g_pair_line_number(s7_scheme *sc, s7_pointer args)
-{
- #define H_pair_line_number "(pair-line-number pair) returns the line number at which it read 'pair'"
- #define Q_pair_line_number s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_pair_symbol)
- return(make_integer(sc, c_pair_line_number(sc, car(args))));
-}
-
-PF_TO_IF(pair_line_number, c_pair_line_number)
-
static s7_pointer g_pair_filename(s7_scheme *sc, s7_pointer args)
{
#define H_pair_filename "(pair-filename pair) returns the name of the file containing 'pair'"
- #define Q_pair_filename s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_pair_symbol)
+ #define Q_pair_filename s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_boolean_symbol), sc->is_pair_symbol)
s7_pointer p;
p = car(args);
@@ -50563,227 +55343,39 @@ static s7_pointer g_pair_filename(s7_scheme *sc, s7_pointer args)
}
-static s7_pointer lambda_star_argument_set_value(s7_scheme *sc, s7_pointer sym, s7_pointer val)
-{
- s7_pointer x;
-
- for (x = let_slots(sc->envir) /* presumably the arglist */; is_slot(x); x = next_slot(x))
- if (slot_symbol(x) == sym)
- {
- /* x is our binding (symbol . value) */
- if (is_not_checked_slot(x))
- set_checked_slot(x); /* this is a special use of this bit, I think */
- else return(s7_error(sc, sc->wrong_type_arg_symbol,
- set_elist_4(sc, make_string_wrapper(sc, "~A: parameter set twice, ~S in ~S"), closure_name(sc, sc->code), sym, sc->args)));
- slot_set_value(x, val);
- return(val);
- }
- return(sc->no_value);
-}
-
-
-static s7_pointer lambda_star_set_args(s7_scheme *sc)
-{
- /* sc->code is a closure: ((args body) envir)
- * (define* (hi a (b 1)) (+ a b))
- * (procedure-source hi) -> (lambda* (a (b 1)) (+ a b))
- *
- * so rather than spinning through the args binding names to values in the
- * procedure's new environment (as in the usual closure case above),
- * we scan the current args, and match against the
- * template in the car of the closure, binding as we go.
- *
- * for each actual arg, if it's not a keyword that matches a member of the
- * template, bind it to its current (place-wise) arg, else bind it to
- * that arg. If it's :rest bind the next arg to the trailing args at this point.
- * All args can be accessed by their name as a keyword.
- *
- * all args are optional, any arg with no default value defaults to #f.
- * but the rest arg should default to ().
- * I later decided to add two warnings: if a parameter is set twice and if
- * an unknown keyword is seen in a keyword position and there is no rest arg.
- */
-
- bool allow_other_keys;
- s7_pointer lx, cx, zx;
-
- /* get the current args, re-setting args that have explicit values */
- cx = closure_args(sc->code);
- allow_other_keys = ((is_pair(cx)) && (allows_other_keys(cx)));
- lx = sc->args;
-
- zx = sc->nil;
- while ((is_pair(cx)) &&
- (is_pair(lx)))
- {
- if (car(cx) == sc->key_rest_symbol) /* the rest arg */
- {
- /* next arg is bound to trailing args from this point as a list */
- zx = sc->key_rest_symbol;
- cx = cdr(cx);
- lambda_star_argument_set_value(sc, car(cx), lx); /* default arg not allowed here (see check_lambda_star_args) */
- lx = cdr(lx);
- cx = cdr(cx);
- }
- else
- {
- /* mock-symbols introduce an ambiguity here; if the object's value is a keyword, is that
- * intended to be used as an argument name or value?
- */
- s7_pointer car_lx;
- car_lx = car(lx);
- if (has_methods(car_lx))
- car_lx = check_values(sc, car_lx, lx);
- if ((is_pair(cdr(lx))) &&
- (is_keyword(car_lx)))
- {
- /* char *name; */ /* found a keyword, check the lambda args via the corresponding symbol */
- s7_pointer sym;
- sym = keyword_symbol(car_lx);
-
- if (lambda_star_argument_set_value(sc, sym, car(cdr(lx))) == sc->no_value)
- {
- /* if default value is a key, go ahead and use this value.
- * (define* (f (a :b)) a) (f :c)
- * this has become much trickier than I anticipated...
- */
- if (allow_other_keys)
- {
- /* in CL: (defun hi (&key (a 1) &allow-other-keys) a) (hi :b :a :a 3) -> 3
- * in s7: (define* (hi (a 1) :allow-other-keys) a) (hi :b :a :a 3) -> 3
- */
- lx = cddr(lx);
- continue;
- }
- else
- {
- if ((is_pair(car(cx))) &&
- (is_keyword(cadar(cx))))
- {
- /* cx is the closure args list, not the copy of it in the curlet */
- s7_pointer x;
-
- x = find_symbol(sc, caar(cx));
- if (is_slot(x))
- {
- if (is_not_checked_slot(x))
- {
- set_checked_slot(x);
- slot_set_value(x, car(lx));
- }
- else
- {
- /* this case is not caught yet: ((lambda* (a b :allow-other-keys ) a) :b 1 :c :a :a ) */
- return(s7_error(sc, sc->wrong_type_arg_symbol,
- set_elist_4(sc, make_string_wrapper(sc, "~A: parameter set twice, ~S in ~S"),
- closure_name(sc, sc->code), lx, sc->args)));
- }
- }
- else
- {
- return(s7_error(sc, sc->wrong_type_arg_symbol,
- set_elist_4(sc, make_string_wrapper(sc, "~A: unknown key: ~S in ~S"),
- closure_name(sc, sc->code), lx, sc->args)));
- }
- /* (define* (f a (b :c)) b) (f :b 1 :d) */
- }
- else
- {
- return(s7_error(sc, sc->wrong_type_arg_symbol,
- set_elist_4(sc, make_string_wrapper(sc, "~A: unknown key: ~S in ~S"),
- closure_name(sc, sc->code), lx, sc->args)));
- }
- }
- }
- lx = cdr(lx);
- if (is_pair(lx)) lx = cdr(lx);
- }
- else /* not a key/value pair */
- {
- /* this is always a positional (i.e. direct) change, but the closure_args are in the
- * definition order whereas currently the environment slots are in reverse order.
- */
- if (is_pair(car(cx)))
- lambda_star_argument_set_value(sc, caar(cx), car(lx));
- else lambda_star_argument_set_value(sc, car(cx), car(lx));
-
- lx = cdr(lx);
- }
- cx = cdr(cx);
- }
- }
-
- /* (let () (define* (hi (a 1) :allow-other-keys) a) (hi :a 2 32)) */
- /* (let () (define* (f (a :b)) a) (list (f) (f 1) (f :c) (f :a :c) (f :a 1) (f))) */
-
- /* check for trailing args with no :rest arg */
- if (is_not_null(lx))
- {
- if ((is_not_null(cx)) ||
- (zx == sc->key_rest_symbol))
- {
- if (is_symbol(cx))
- make_slot_1(sc, sc->envir, cx, lx);
- }
- else
- {
- if (!allow_other_keys) /* ((lambda* (a) a) :a 1 2) */
- return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, closure_name(sc, sc->code), sc->args)));
- else
- {
- /* check trailing args for repeated keys or keys with no values or values with no keys */
- while (is_pair(lx))
- {
- if ((!is_keyword(car(lx))) || /* ((lambda* (a :allow-other-keys) a) :a 1 :b 2 3) */
- (!is_pair(cdr(lx)))) /* ((lambda* (a :allow-other-keys) a) :a 1 :b) */
- return(s7_error(sc, sc->wrong_type_arg_symbol,
- set_elist_3(sc, make_string_wrapper(sc, "~A: not a key/value pair: ~S"), closure_name(sc, sc->code), lx)));
- /* errors not caught?
- * ((lambda* (a :allow-other-keys) a) :a 1 :a 2)
- * ((lambda* (:allow-other-keys ) #f) :b :a :a :b)
- */
- lx = cddr(lx);
- }
- }
- }
- }
- return(sc->nil);
-}
-
-
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)
{
s7_pointer val;
- val = find_symbol_checked(sc, cadar(args));
- if (!is_pair(val)) /* (define (tst) (let ((a 123)) (pair? (car a)))) */
- return(g_is_pair(sc, list_1(sc, g_car(sc, set_plist_1(sc, val)))));
- return(make_boolean(sc, is_pair(car(val))));
+ val = find_symbol_unchecked(sc, cadar(args));
+ if (is_pair(val)) /* (define (tst) (let ((a 123)) (pair? (car a)))) */
+ return(make_boolean(sc, is_pair(car(val))));
+ 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)
{
s7_pointer val;
- val = find_symbol_checked(sc, cadar(args));
- if (!is_pair(val))
- return(g_is_pair(sc, list_1(sc, g_cdr(sc, set_plist_1(sc, val)))));
- return(make_boolean(sc, is_pair(cdr(val))));
+ val = find_symbol_unchecked(sc, cadar(args));
+ if (is_pair(val))
+ return(make_boolean(sc, is_pair(cdr(val))));
+ 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)
{
s7_pointer val;
- val = find_symbol_checked(sc, cadar(args));
+ val = find_symbol_unchecked(sc, cadar(args));
if ((is_pair(val)) &&
(is_pair(cdr(val))))
return(make_boolean(sc, is_pair(cadr(val))));
- return(g_is_pair(sc, list_1(sc, g_cadr(sc, set_plist_1(sc, val)))));
+ return(g_is_pair(sc, set_plist_1(sc, g_cadr(sc, set_plist_1(sc, val)))));
}
-static s7_pointer is_pair_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer is_pair_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
- if ((is_optimized(cadr(expr))) &&
- (optimize_op(cadr(expr)) == HOP_SAFE_C_S))
+ if (!ops) return(f);
+ if (is_h_safe_c_s(cadr(expr)))
{
s7_function g;
g = c_callee(cadr(expr));
@@ -50810,14 +55402,15 @@ static s7_pointer is_null_cdr;
static s7_pointer g_is_null_cdr(s7_scheme *sc, s7_pointer args)
{
s7_pointer val;
- val = find_symbol_checked(sc, cadar(args));
+ val = find_symbol_unchecked(sc, cadar(args));
if (!is_pair(val))
- return(g_is_null(sc, list_1(sc, g_cdr(sc, set_plist_1(sc, val)))));
+ return(g_is_null(sc, set_plist_1(sc, g_cdr(sc, set_plist_1(sc, val)))));
return(make_boolean(sc, is_null(cdr(val))));
}
-static s7_pointer is_null_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer is_null_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
+ if (!ops) return(f);
if (is_h_safe_c_s(cadr(expr)))
{
s7_function g;
@@ -50844,6 +55437,7 @@ static s7_pointer g_format_just_newline(s7_scheme *sc, s7_pointer args)
pt = car(args);
str = cadr(args);
+ if (is_null(pt)) pt = sc->output_port;
if (pt == sc->F)
return(s7_make_string_with_length(sc, string_value(str), string_length(str)));
@@ -50885,7 +55479,7 @@ 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, int args, s7_pointer expr)
+static s7_pointer format_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
s7_pointer port, str_arg;
port = cadr(expr);
@@ -50894,7 +55488,7 @@ static s7_pointer format_chooser(s7_scheme *sc, s7_pointer f, int args, s7_point
(!is_string(port)) &&
(is_string(str_arg)))
{
- if (args == 2)
+ if ((ops) && (args == 2))
{
int len;
char *orig;
@@ -50922,7 +55516,6 @@ static s7_pointer format_chooser(s7_scheme *sc, s7_pointer f, int args, s7_point
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);
@@ -50935,44 +55528,46 @@ static s7_pointer is_eq_car, is_eq_car_q, is_eq_caar_q;
static s7_pointer g_is_eq_car(s7_scheme *sc, s7_pointer args)
{
s7_pointer lst, val;
- lst = find_symbol_checked(sc, cadar(args));
- val = find_symbol_checked(sc, cadr(args));
- if (!is_pair(lst))
- return(g_is_eq(sc, set_plist_2(sc, g_car(sc, list_1(sc, lst)), val)));
- return(make_boolean(sc, car(lst) == val));
+ lst = find_symbol_unchecked(sc, cadar(args));
+ val = find_symbol_unchecked(sc, cadr(args));
+ if (is_pair(lst))
+ return(make_boolean(sc, car(lst) == val));
+ return(g_is_eq(sc, set_plist_2(sc, g_car(sc, set_plist_1(sc, lst)), val)));
}
static s7_pointer g_is_eq_car_q(s7_scheme *sc, s7_pointer args)
{
s7_pointer lst;
- lst = find_symbol_checked(sc, cadar(args));
- if (!is_pair(lst))
- return(g_is_eq(sc, set_plist_2(sc, g_car(sc, set_plist_1(sc, lst)), cadr(cadr(args)))));
- return(make_boolean(sc, car(lst) == cadr(cadr(args))));
+ lst = find_symbol_unchecked(sc, cadar(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))));
}
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_checked(sc, cadar(args));
+ lst = find_symbol_unchecked(sc, cadar(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)), cadr(cadr(args)))));
- return(make_boolean(sc, caar(lst) == cadr(cadr(args))));
+ 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)));
}
-static s7_pointer is_eq_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer is_eq_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
+ if (!ops) return(f);
if (is_h_safe_c_s(cadr(expr)))
{
- if ((is_symbol(caddr(expr))) &&
+ if (((optimize_op(expr) == HOP_SAFE_C_opSq_S) ||
+ ((is_h_safe_c_c(expr)) &&
+ (is_symbol(caddr(expr))))) &&
(c_callee(cadr(expr)) == g_car))
{
set_optimize_op(expr, HOP_SAFE_C_C);
return(is_eq_car);
}
- if ((is_pair(caddr(expr))) &&
- (caaddr(expr) == sc->quote_symbol))
+ if (is_proper_quote(sc, caddr(expr)))
{
if (c_callee(cadr(expr)) == g_car)
{
@@ -50992,7 +55587,7 @@ static s7_pointer is_eq_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointe
/* 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_list, not_is_number;
+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 g_not_is_pair(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_pair, sc->is_pair_symbol, args);}
@@ -51002,17 +55597,16 @@ static s7_pointer g_not_is_number(s7_scheme *sc, s7_pointer args) {check_boole
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_list(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, opt_is_list, sc->is_list_symbol, args);}
/* eq? does not check for methods */
static s7_pointer g_not_is_eq_sq(s7_scheme *sc, s7_pointer args)
{
- return(make_boolean(sc, find_symbol_checked(sc, cadr(car(args))) != cadr(caddr(car(args)))));
+ return(make_boolean(sc, find_symbol_unchecked(sc, cadar(args)) != opt_con2(args))); /* cadr(caddr(car(args))) */
}
static s7_pointer g_not_is_eq_ss(s7_scheme *sc, s7_pointer args)
{
- return(make_boolean(sc, find_symbol_checked(sc, cadr(car(args))) != find_symbol_checked(sc, caddr(car(args)))));
+ return(make_boolean(sc, find_symbol_unchecked(sc, cadar(args)) != find_symbol_unchecked(sc, opt_sym3(args)))); /* caddr(car(args)) */
}
/* here the method finder is in either car or cdr */
@@ -51020,9 +55614,9 @@ static s7_pointer not_is_pair_car;
static s7_pointer g_not_is_pair_car(s7_scheme *sc, s7_pointer args)
{
s7_pointer val;
- val = find_symbol_checked(sc, cadr(cadar(args)));
+ val = find_symbol_unchecked(sc, cadr(cadar(args)));
if (!is_pair(val))
- return(g_not(sc, list_1(sc, g_is_pair(sc, list_1(sc, g_car(sc, set_plist_1(sc, val)))))));
+ return(g_not(sc, set_plist_1(sc, g_is_pair(sc, set_plist_1(sc, g_car(sc, set_plist_1(sc, val)))))));
return(make_boolean(sc, !is_pair(car(val))));
}
@@ -51033,11 +55627,12 @@ static s7_pointer g_not_c_c(s7_scheme *sc, s7_pointer args)
return(make_boolean(sc, is_false(sc, c_call(car(args))(sc, cdar(args)))));
}
-static s7_pointer not_chooser(s7_scheme *sc, s7_pointer g, int args, s7_pointer expr)
+static s7_pointer not_chooser(s7_scheme *sc, s7_pointer g, int args, s7_pointer expr, bool ops)
{
+ if (!ops) return(g);
if (is_optimized(cadr(expr))) /* cadr(expr) might be a symbol, for example; is_optimized includes is_pair */
{
- if (optimize_op(cadr(expr)) == HOP_SAFE_C_S)
+ if (is_h_safe_c_s(cadr(expr)))
{
s7_function f;
f = c_callee(cadr(expr));
@@ -51057,16 +55652,10 @@ static s7_pointer not_chooser(s7_scheme *sc, s7_pointer g, int args, s7_pointer
set_optimize_op(expr, HOP_SAFE_C_C);
return(not_is_symbol);
}
- if (f == g_is_list)
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(not_is_list);
- }
/* 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??
* but user might have (#_number? e), so we can't change later and catch this.
*/
-
if ((f == g_is_number) || (f == g_is_complex))
{
set_optimize_op(expr, HOP_SAFE_C_C);
@@ -51093,19 +55682,19 @@ static s7_pointer not_chooser(s7_scheme *sc, s7_pointer g, int args, s7_pointer
(c_callee(cadr(expr)) == g_is_eq))
{
set_optimize_op(expr, HOP_SAFE_C_C);
+ set_opt_con2(cdr(expr), cadr(caddr(cadr(expr))));
return(not_is_eq_sq);
}
-
if (optimize_op(cadr(expr)) == HOP_SAFE_C_SS)
{
if (c_callee(cadr(expr)) == g_is_eq)
{
set_optimize_op(expr, HOP_SAFE_C_C);
+ set_opt_sym3(cdr(expr), caddr(cadr(expr)));
return(not_is_eq_ss);
}
}
-
- if (optimize_op(cadr(expr)) == HOP_SAFE_C_C)
+ 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)
@@ -51117,55 +55706,50 @@ static s7_pointer not_chooser(s7_scheme *sc, s7_pointer g, int args, s7_pointer
}
-static s7_pointer vector_ref_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer vector_ref_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
if (args == 2)
{
- s7_pointer arg1, arg2;
- arg1 = cadr(expr);
- arg2 = caddr(expr);
- if (is_symbol(arg1))
+ if (ops)
{
- if ((s7_is_integer(arg2)) &&
- (s7_integer(arg2) >= 0))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- switch (s7_integer(arg2)) /* (might be big int) */
- {
- case 0: return(vector_ref_ic_0);
- case 1: return(vector_ref_ic_1);
- case 2: return(vector_ref_ic_2);
- case 3: return(vector_ref_ic_3);
- default: return(vector_ref_ic);
- }
- }
-
- if (is_global(arg1))
+ s7_pointer arg1, arg2;
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+ if (is_symbol(arg1))
{
- if (is_symbol(arg2))
+ if (((optimize_op(expr) == HOP_SAFE_C_SC) ||
+ (is_h_safe_c_c(expr))) &&
+ (s7_is_integer(arg2)) &&
+ (s7_integer(arg2) >= 0))
{
set_optimize_op(expr, HOP_SAFE_C_C);
- if (is_immutable_symbol(arg1))
+ switch (s7_integer(arg2)) /* (might be big int) */
{
- s7_pointer vect;
- vect = slot_value(global_slot(arg1));
- if ((is_normal_vector(vect)) &&
- (vector_rank(vect) == 1))
- {
- set_opt_vector(cdr(expr), vect);
- return(constant_vector_ref_gs);
- }
+ case 0: return(vector_ref_ic_0);
+ case 1: return(vector_ref_ic_1);
+ case 2: return(vector_ref_ic_2);
+ case 3: return(vector_ref_ic_3);
+ default: return(vector_ref_ic);
}
- return(vector_ref_gs);
}
- }
-
- if ((is_pair(arg2)) &&
- (is_safely_optimized(arg2)) &&
- (c_callee(arg2) == g_add_cs1))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(vector_ref_add1);
+
+ 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))))
+ {
+ s7_pointer v;
+ v = slot_value(local_slot(arg1));
+ if ((is_normal_vector(v)) &&
+ (vector_rank(v) == 1))
+ return(vector_ref_2_direct);
+ }
}
}
/* vector_ref_sub1 was not worth the code, and few other easily optimized expressions happen here */
@@ -51175,48 +55759,28 @@ static s7_pointer vector_ref_chooser(s7_scheme *sc, s7_pointer f, int args, s7_p
}
-static s7_pointer vector_set_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer vector_set_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
if (args == 3)
{
- s7_pointer arg1, arg2, arg3;
-
- arg1 = cadr(expr);
- arg2 = caddr(expr);
- arg3 = cadddr(expr);
-
- if (is_symbol(arg1))
+ if (ops)
{
- if ((s7_is_integer(arg2)) &&
- (s7_integer(arg2) >= 0) &&
- (is_symbol(arg3)))
+ s7_pointer arg1, arg2, arg3;
+
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+ arg3 = cadddr(expr);
+
+ if (((optimize_op(expr) == HOP_SAFE_C_SCS) ||
+ ((is_h_safe_c_c(expr)) &&
+ (is_symbol(arg1)) &&
+ (is_symbol(arg3)))) &&
+ (s7_is_integer(arg2)) &&
+ (s7_integer(arg2) >= 0))
{
set_optimize_op(expr, HOP_SAFE_C_C);
return(vector_set_ic);
}
- if (is_symbol(arg2))
- {
- if ((is_pair(arg3)) &&
- (is_safely_optimized(arg3)))
- {
- if ((c_callee(arg3) == g_vector_ref_2) &&
- (arg1 == cadr(arg3)) &&
- (is_symbol(caddr(arg3))))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(vector_set_vref);
- }
- if (((c_callee(arg3) == g_add_2) || (c_callee(arg3) == g_subtract_2)) &&
- (is_symbol(caddr(arg3))) &&
- (is_optimized(cadr(arg3))) &&
- (c_callee(cadr(arg3)) == g_vector_ref_2) &&
- (cadr(cadr(arg3)) == arg1))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(vector_set_vector_ref);
- }
- }
- }
}
return(vector_set_3);
}
@@ -51224,7 +55788,7 @@ static s7_pointer vector_set_chooser(s7_scheme *sc, s7_pointer f, int args, s7_p
}
-static s7_pointer list_set_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer list_set_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
if ((args == 3) &&
(s7_is_integer(caddr(expr))) &&
@@ -51234,34 +55798,36 @@ static s7_pointer list_set_chooser(s7_scheme *sc, s7_pointer f, int args, s7_poi
return(f);
}
-
-static s7_pointer list_ref_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
-{
- if ((args == 2) &&
- (s7_is_integer(caddr(expr))) &&
- (s7_integer(caddr(expr)) >= 0) &&
- (s7_integer(caddr(expr)) < sc->max_list_length))
- return(list_ref_ic);
- return(f);
-}
-
-
-static s7_pointer hash_table_ref_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer hash_table_ref_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
- if (args == 2)
+ if (args == 2)
{
- if ((is_symbol(cadr(expr))) &&
- (is_symbol(caddr(expr))))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(hash_table_ref_ss);
- }
- if ((is_symbol(cadr(expr))) &&
- (is_h_safe_c_s(caddr(expr))) &&
- (c_callee(caddr(expr)) == g_car))
+ /* choosers are run even in non-hop non-safe-symbol contexts, so any that look for a symbol
+ * need some way to ensure it is safe before changing to (say) hash_table_ref_ss which
+ * assumes that (coming from op_safe_c_ss normally). But we get here more than once on
+ * the same expression somehow, so we have to recognize the initial case (h_safe_c_ss),
+ * then kludge up thge returning case (h_safe_c_c). Using is_slot(find_symbol()) is
+ * no good because in context we use the current walker's "e" env to see the symbol,
+ * no the running environment.
+ */
+ if (ops)
{
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(hash_table_ref_car);
+ if ((optimize_op(expr) == HOP_SAFE_C_SS) ||
+ ((is_h_safe_c_c(expr)) &&
+ (is_symbol(cadr(expr))) &&
+ (is_symbol(caddr(expr)))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(hash_table_ref_ss);
+ }
+ if (((optimize_op(expr) == HOP_SAFE_C_S_opSq) ||
+ ((is_h_safe_c_c(expr)) && (is_symbol(cadr(expr))))) &&
+ (is_h_safe_c_s(caddr(expr))) &&
+ (c_callee(caddr(expr)) == g_car))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(hash_table_ref_car);
+ }
}
return(hash_table_ref_2);
}
@@ -51270,10 +55836,13 @@ static s7_pointer hash_table_ref_chooser(s7_scheme *sc, s7_pointer f, int args,
#if (!WITH_GMP)
-static s7_pointer modulo_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer modulo_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
+ if (!ops) return(f);
if ((args == 2) &&
- (is_symbol(cadr(expr))) &&
+ ((optimize_op(expr) == HOP_SAFE_C_SC) ||
+ ((is_h_safe_c_c(expr)) &&
+ (is_symbol(cadr(expr))))) &&
(is_integer(caddr(expr))) &&
(integer(caddr(expr)) > 1))
{
@@ -51284,77 +55853,67 @@ static s7_pointer modulo_chooser(s7_scheme *sc, s7_pointer f, int args, s7_point
}
#endif
-static s7_pointer add_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer add_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
/* (+ s f) (+ (* s s) s) (+ s s) (+ s (* s s))
*/
#if (!WITH_GMP)
if (args == 2)
{
- s7_pointer arg1, arg2;
- arg1 = cadr(expr);
- arg2 = caddr(expr);
-
- if (arg1 == small_int(1))
- return(add_1s);
-
- if (arg2 == small_int(1))
+ if (ops)
{
- if (is_symbol(arg1))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(add_cs1);
- }
- return(add_s1);
- }
-#if HAVE_OVERFLOW_CHECKS
- if (s7_is_integer(arg2))
-#else
- if ((s7_is_integer(arg2)) &&
- (integer_length(integer(arg2)) < 31))
-#endif
- {
- if (is_symbol(arg1))
+ s7_pointer arg1, arg2;
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+
+ if (arg1 == small_int(1))
+ return(add_1s);
+
+ if (arg2 == small_int(1)) /* (+ ... 1) */
{
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(add_si);
+ if ((optimize_op(expr) == HOP_SAFE_C_SC) || /* (+ x 1) */
+ ((is_h_safe_c_c(expr)) && (is_symbol(arg1))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ if (is_local_symbol(cdr(expr)))
+ return(add_cl1);
+ /* fprintf(stderr, "%s\n", DISPLAY(expr)); */
+ return(add_cs1);
+ }
+ return(add_s1);
}
- }
-
- if ((is_t_real(arg2)) &&
- (is_symbol(arg1)))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(add_sf);
- }
-
- if (is_t_real(arg1))
- {
- if (is_symbol(arg2))
+ if (s7_is_integer(arg2))
{
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(add_fs);
+ if ((optimize_op(expr) == HOP_SAFE_C_SC) || /* (+ x 123) */
+ ((is_h_safe_c_c(expr)) && (is_symbol(arg1))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(add_si);
+ }
}
- if ((is_h_safe_c_c(arg2)) &&
- (c_callee(arg2) == g_multiply_sf))
+
+ if ((is_t_real(arg2)) &&
+ ((optimize_op(expr) == HOP_SAFE_C_SC) || /* (+ x 1.0) */
+ ((is_h_safe_c_c(expr)) && (is_symbol(arg1)))))
{
set_optimize_op(expr, HOP_SAFE_C_C);
- return(add_f_sf);
+ return(add_sf);
}
- }
- if ((is_optimized(arg1)) &&
- (is_optimized(arg2)))
- {
- if ((optimize_op(arg1) == HOP_SAFE_C_SS) &&
- (optimize_op(arg2) == HOP_SAFE_C_C) &&
- (c_callee(arg1) == g_multiply_2) &&
- (c_callee(arg2) == g_mul_1ss) &&
- (cadr(arg1) == caddr(cadr(arg2))))
+
+ if (is_t_real(arg1))
{
- set_optimize_op(expr, HOP_SAFE_C_C);
- set_opt_sym1(cdr(expr), caddr(arg1));
- set_opt_sym2(cdr(expr), caddr(arg2));
- return(add_ss_1ss);
+ if ((optimize_op(expr) == HOP_SAFE_C_CS) || /* (+ 1.0 x) */
+ ((is_h_safe_c_c(expr)) && (is_symbol(arg2))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(add_fs);
+ }
+ if ((is_h_safe_c_c(arg2)) &&
+ (c_callee(arg2) == g_multiply_sf))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(add_f_sf);
+ }
}
}
return(add_2);
@@ -51364,108 +55923,80 @@ static s7_pointer add_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer
}
-static s7_pointer multiply_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer multiply_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
#if (!WITH_GMP)
if (args == 2)
{
- s7_pointer arg1, arg2;
- arg1 = cadr(expr);
- arg2 = caddr(expr);
-
- if (is_symbol(arg1))
+ if (ops)
{
-#if HAVE_OVERFLOW_CHECKS
- if (s7_is_integer(arg2))
-#else
- if ((s7_is_integer(arg2)) &&
- (integer_length(integer(arg2)) < 31))
-#endif
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(multiply_si);
- }
- if (arg1 == arg2)
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(sqr_ss);
- }
- if (is_t_real(arg2))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(multiply_sf);
- }
- }
-
- if (is_symbol(arg2))
- {
-#if HAVE_OVERFLOW_CHECKS
- if (s7_is_integer(arg1))
-#else
- if ((s7_is_integer(arg1)) &&
- (integer_length(integer(arg1)) < 31))
-#endif
+ s7_pointer arg1, arg2;
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+
+ if (is_symbol(arg1))
{
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(multiply_is);
+ if ((optimize_op(expr) == HOP_SAFE_C_SC) ||
+ (is_h_safe_c_c(expr)))
+ {
+ if (s7_is_integer(arg2))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(multiply_si);
+ }
+ if (is_t_real(arg2))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(multiply_sf);
+ }
+ }
+ if ((arg1 == arg2) &&
+ ((optimize_op(expr) == HOP_SAFE_C_SS) || /* (* x c) */
+ (is_h_safe_c_c(expr))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(sqr_ss);
+ }
+
+ if ((is_h_safe_c_s(arg2)) &&
+ ((car(arg2) == sc->sin_symbol) || (car(arg2) == sc->cos_symbol)) &&
+ ((optimize_op(expr) == HOP_SAFE_C_S_opSq) ||
+ (is_h_safe_c_c(expr))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ clear_unsafe(expr);
+ if (car(arg2) == sc->sin_symbol)
+ return(mul_s_sin_s);
+ return(mul_s_cos_s);
+ }
}
- if (is_t_real(arg1))
+
+ if (is_symbol(arg2))
{
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(multiply_fs);
+ if ((optimize_op(expr) == HOP_SAFE_C_CS) ||
+ (is_h_safe_c_c(expr)))
+ {
+ if (s7_is_integer(arg1))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(multiply_is);
+ }
+ if (is_t_real(arg1))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(multiply_fs);
+ }
+ }
}
}
- if ((is_pair(arg1)) &&
- (is_symbol(arg2)) &&
- (car(arg1) == sc->subtract_symbol) &&
- (is_t_real(cadr(arg1))) &&
- (real(cadr(arg1)) == 1.0) &&
- (is_symbol(caddr(arg1))) &&
- (is_null(cdddr(arg1))))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(mul_1ss);
- }
-
- if ((is_symbol(arg1)) &&
- (is_optimized(arg2)) &&
- ((car(arg2) == sc->sin_symbol) || (car(arg2) == sc->cos_symbol)) &&
- (is_symbol(cadr(arg2))))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- clear_unsafe(expr);
- if (car(arg2) == sc->sin_symbol)
- return(mul_s_sin_s);
- return(mul_s_cos_s);
- }
-
return(multiply_2);
}
-
- if (args == 3)
- {
- s7_pointer arg1, arg2, arg3;
- arg1 = cadr(expr);
- arg2 = caddr(expr);
- arg3 = cadddr(expr);
-
- if ((is_t_real(arg1)) &&
- (is_symbol(arg2)) &&
- (is_pair(arg3)) &&
- (car(arg3) == sc->cos_symbol) &&
- (is_symbol(cadr(arg3))))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(multiply_cs_cos);
- }
- }
-
#endif
return(f);
}
-static s7_pointer subtract_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer subtract_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
#if (!WITH_GMP)
if (args == 1)
@@ -51473,71 +56004,58 @@ static s7_pointer subtract_chooser(s7_scheme *sc, s7_pointer f, int args, s7_poi
if (args == 2)
{
- s7_pointer arg1, arg2;
- arg1 = cadr(expr);
- arg2 = caddr(expr);
-
- if (arg2 == small_int(1))
- {
- if (is_symbol(arg1))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(subtract_cs1);
- }
- return(subtract_s1);
- }
-
- if (is_t_real(arg2))
+ if (ops)
{
- if (is_symbol(arg1))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(subtract_sf);
- }
- if ((is_pair(arg1)) &&
- (is_safely_optimized(arg1)))
+ s7_pointer arg1, arg2;
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+
+ if (arg2 == small_int(1))
{
- if (c_callee(arg1) == g_random_rc)
+ if ((optimize_op(expr) == HOP_SAFE_C_SC) || /* (- x 1) */
+ ((is_h_safe_c_c(expr)) && (is_symbol(arg1))))
{
set_optimize_op(expr, HOP_SAFE_C_C);
- return(sub_random_rc);
+ if (is_local_symbol(cdr(expr)))
+ return(subtract_cl1);
+ return(subtract_cs1);
}
+ return(subtract_s1);
}
- }
-
- if (is_t_real(arg1))
- {
- if (is_symbol(arg2))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(subtract_fs);
- }
- if ((is_h_safe_c_c(arg2)) &&
- (c_callee(arg2) == g_sqr_ss))
+
+ if (is_t_real(arg2))
{
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(subtract_f_sqr);
+ if ((optimize_op(expr) == HOP_SAFE_C_SC) || /* (- x 1.0) */
+ ((is_h_safe_c_c(expr)) && (is_symbol(arg1))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(subtract_sf);
+ }
}
- }
-
- if (s7_is_integer(arg2))
- {
- if (is_symbol(arg1))
+
+ if (is_t_real(arg1))
{
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(subtract_csn);
+ if ((optimize_op(expr) == HOP_SAFE_C_CS) || /* (- 1.0 x) */
+ ((is_h_safe_c_c(expr)) && (is_symbol(arg2))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(subtract_fs);
+ }
}
- if ((is_safely_optimized(arg1)) &&
- (c_callee(arg1) == g_random_ic))
+
+ if (s7_is_integer(arg2))
{
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(sub_random_ic);
+ if ((optimize_op(expr) == HOP_SAFE_C_SC) || /* (- x 123) */
+ ((is_h_safe_c_c(expr)) && (is_symbol(arg1))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(subtract_csn);
+ }
}
+
+ if (is_t_real(arg2))
+ return(subtract_2f);
}
-
- if (is_t_real(arg2))
- return(subtract_2f);
-
return(subtract_2);
}
#endif
@@ -51545,37 +56063,39 @@ static s7_pointer subtract_chooser(s7_scheme *sc, s7_pointer f, int args, s7_poi
}
-static s7_pointer divide_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer divide_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
#if (!WITH_GMP)
if (args == 1)
return(invert_1);
-
- if (args == 2)
+ if (ops)
{
- s7_pointer arg1;
- arg1 = cadr(expr);
- if ((is_t_real(arg1)) &&
- (real(arg1) == 1.0))
- return(divide_1r);
+ if (args == 2)
+ {
+ s7_pointer arg1;
+ arg1 = cadr(expr);
+ if ((is_t_real(arg1)) &&
+ (real(arg1) == 1.0))
+ return(divide_1r);
+ }
}
#endif
return(f);
}
#if (!WITH_GMP)
-static s7_pointer max_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer max_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
- if ((args == 2) &&
+ if ((!ops) && (args == 2) &&
(is_t_real(cadr(expr))) &&
(!is_NaN(real(cadr(expr)))))
return(max_f2);
return(f);
}
-static s7_pointer min_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer min_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
- if ((args == 2) &&
+ if ((!ops) && (args == 2) &&
(is_t_real(cadr(expr))) &&
(!is_NaN(real(cadr(expr)))))
return(min_f2);
@@ -51583,53 +56103,39 @@ static s7_pointer min_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer
}
-static s7_pointer is_zero_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
-{
- if ((args == 1) &&
- (is_safely_optimized(cadr(expr))) &&
- (optimize_op(cadr(expr)) == HOP_SAFE_C_C) &&
- (c_callee(cadr(expr)) == g_mod_si))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(mod_si_is_zero);
- }
- return(f);
-}
-
-
-static s7_pointer equal_chooser(s7_scheme *sc, s7_pointer ur_f, int args, s7_pointer expr)
+static s7_pointer equal_chooser(s7_scheme *sc, s7_pointer ur_f, int args, s7_pointer expr, bool ops)
{
if (args == 2)
{
- s7_pointer arg1, arg2;
- arg1 = cadr(expr);
- arg2 = caddr(expr);
-
- if (s7_is_integer(arg2))
+ if (ops)
{
- if (is_safely_optimized(arg1))
+ s7_pointer arg1, arg2;
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+
+ if (s7_is_integer(arg2))
{
- s7_function f;
- f = c_callee(arg1);
- if (f == g_length)
+ if (is_safely_optimized(arg1))
{
- if (optimize_op(arg1) == HOP_SAFE_C_S)
+ s7_function f;
+ f = c_callee(arg1);
+ if (f == g_length)
{
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(equal_length_ic);
+ if (is_h_safe_c_s(arg1))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(equal_length_ic);
+ }
}
}
- if ((f == g_mod_si) &&
- (integer(arg2) == 0))
+#if (!WITH_GMP)
+ if ((optimize_op(expr) == HOP_SAFE_C_SC) ||
+ ((is_h_safe_c_c(expr)) && (is_symbol(arg1))))
{
set_optimize_op(expr, HOP_SAFE_C_C);
- return(mod_si_is_zero);
+ return(equal_s_ic);
}
- }
- if (is_symbol(arg1))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(equal_s_ic);
+#endif
}
}
return(equal_2);
@@ -51637,30 +56143,33 @@ static s7_pointer equal_chooser(s7_scheme *sc, s7_pointer ur_f, int args, s7_poi
return(ur_f);
}
-static s7_pointer less_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer less_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
if (args == 2)
{
- s7_pointer arg2;
- arg2 = caddr(expr);
- if (is_integer(arg2))
+ if (ops)
{
- if (is_h_safe_c_s(cadr(expr)))
+ s7_pointer arg2;
+ arg2 = caddr(expr);
+ if (is_integer(arg2))
{
- s7_function f;
- f = c_callee(cadr(expr));
- if (f == g_length)
+ if (is_h_safe_c_s(cadr(expr)))
{
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(less_length_ic);
+ s7_function f;
+ f = c_callee(cadr(expr));
+ if (f == g_length)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(less_length_ic);
+ }
}
+ if (integer(arg2) == 0)
+ return(less_s0);
+
+ if ((integer(arg2) < s7_int32_max) &&
+ (integer(arg2) > s7_int32_min))
+ return(less_s_ic);
}
- if (integer(arg2) == 0)
- return(less_s0);
-
- if ((integer(arg2) < s7_int32_max) &&
- (integer(arg2) > s7_int32_min))
- return(less_s_ic);
}
return(less_2);
}
@@ -51668,71 +56177,67 @@ static s7_pointer less_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer
}
-static s7_pointer leq_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer leq_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
if (args == 2)
{
- s7_pointer arg2;
- arg2 = caddr(expr);
- if ((is_integer(arg2)) &&
- (integer(arg2) < s7_int32_max) &&
- (integer(arg2) > s7_int32_min))
- return(leq_s_ic);
+ if (ops)
+ {
+ s7_pointer arg2;
+ arg2 = caddr(expr);
+ if ((is_integer(arg2)) &&
+ (integer(arg2) < s7_int32_max) &&
+ (integer(arg2) > s7_int32_min))
+ return(leq_s_ic);
+ }
return(leq_2);
}
return(f);
}
-static s7_pointer greater_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer greater_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
if (args == 2)
{
- s7_pointer arg2;
- arg2 = caddr(expr);
-
- if ((is_integer(arg2)) &&
- (integer(arg2) < s7_int32_max) &&
- (integer(arg2) > s7_int32_min))
- return(greater_s_ic);
-
- if ((is_t_real(arg2)) &&
- (real(arg2) < s7_int32_max) &&
- (real(arg2) > s7_int32_min))
- return(greater_s_fc);
+ if (ops)
+ {
+ s7_pointer arg2;
+ arg2 = caddr(expr);
+
+ if ((is_integer(arg2)) &&
+ (integer(arg2) < s7_int32_max) &&
+ (integer(arg2) > s7_int32_min))
+ return(greater_s_ic);
+
+ if ((is_t_real(arg2)) &&
+ (real(arg2) < s7_int32_max) &&
+ (real(arg2) > s7_int32_min))
+ return(greater_s_fc);
+ }
return(greater_2);
}
return(f);
}
-static s7_pointer geq_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer geq_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
if (args == 2)
{
- s7_pointer arg2;
- arg2 = caddr(expr);
- if (is_integer(arg2))
+ if (ops)
{
- if (is_h_safe_c_s(cadr(expr)))
- {
- s7_function f;
- f = c_callee(cadr(expr));
- if (f == g_length)
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(geq_length_ic);
- }
- }
- if ((integer(arg2) < s7_int32_max) &&
+ s7_pointer arg2;
+ arg2 = caddr(expr);
+ if ((is_integer(arg2)) &&
+ (integer(arg2) < s7_int32_max) &&
(integer(arg2) > s7_int32_min))
return(geq_s_ic);
+ if ((is_t_real(arg2)) &&
+ (real(arg2) < s7_int32_max) &&
+ (real(arg2) > s7_int32_min))
+ return(geq_s_fc);
}
- if ((is_t_real(arg2)) &&
- (real(arg2) < s7_int32_max) &&
- (real(arg2) > s7_int32_min))
- return(geq_s_fc);
-
return(geq_2);
}
return(f);
@@ -51745,6 +56250,7 @@ static bool returns_char(s7_scheme *sc, s7_pointer arg)
/* also if arg is immutable symbol + value is char */
if (s7_is_character(arg)) return(true);
if ((is_h_optimized(arg)) &&
+ (is_safe_c_op(optimize_op(arg))) && /* make sure opt_cfunc has been set */
(is_c_function(opt_cfunc(arg))))
{
s7_pointer sig;
@@ -51756,45 +56262,42 @@ static bool returns_char(s7_scheme *sc, s7_pointer arg)
return(false);
}
-static s7_pointer char_equal_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer char_equal_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
if (args == 2)
{
- s7_pointer arg1, arg2;
- arg1 = cadr(expr);
- arg2 = caddr(expr);
- if ((returns_char(sc, arg1)) && (returns_char(sc, arg2)))
- return(simple_char_eq);
- if ((is_symbol(arg1)) &&
- (s7_is_character(arg2)))
+ if (ops)
{
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(char_equal_s_ic);
+ s7_pointer arg1, arg2;
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+ if ((returns_char(sc, arg1)) && (returns_char(sc, arg2)))
+ return(simple_char_eq);
+
+ if (((optimize_op(expr) == HOP_SAFE_C_SC) ||
+ ((is_h_safe_c_c(expr)) && (is_symbol(arg1)))) &&
+ (s7_is_character(arg2)))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(char_equal_s_ic);
+ }
}
return(char_equal_2);
}
return(f);
}
-static s7_pointer char_less_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer char_less_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
if (args == 2)
- {
- if (s7_is_character(caddr(expr)))
- return(char_less_s_ic);
- return(char_less_2);
- }
+ return(char_less_2);
return(f);
}
-static s7_pointer char_greater_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer char_greater_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
if (args == 2)
- {
- if (s7_is_character(caddr(expr)))
- return(char_greater_s_ic);
- return(char_greater_2);
- }
+ return(char_greater_2);
return(f);
}
@@ -51867,27 +56370,24 @@ static void check_for_substring_temp(s7_scheme *sc, s7_pointer expr)
}
}
-static s7_pointer char_position_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer char_position_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
+ if (!ops) return(f);
if (((args == 2) || (args == 3)) &&
(s7_is_character(cadr(expr))))
return(char_position_csi);
return(f);
}
-static s7_pointer string_equal_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer string_equal_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
check_for_substring_temp(sc, expr);
if (args == 2)
- {
- if (is_string(caddr(expr)))
- return(string_equal_s_ic);
- return(string_equal_2);
- }
+ return(string_equal_2);
return(f);
}
-static s7_pointer string_less_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer string_less_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
check_for_substring_temp(sc, expr);
if (args == 2)
@@ -51895,7 +56395,7 @@ static s7_pointer string_less_chooser(s7_scheme *sc, s7_pointer f, int args, s7_
return(f);
}
-static s7_pointer string_greater_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer string_greater_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
check_for_substring_temp(sc, expr);
if (args == 2)
@@ -51903,88 +56403,33 @@ static s7_pointer string_greater_chooser(s7_scheme *sc, s7_pointer f, int args,
return(f);
}
-static s7_pointer string_to_symbol_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer string_to_symbol_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
check_for_substring_temp(sc, expr);
return(f);
}
-static s7_pointer string_ref_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer string_ref_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
check_for_substring_temp(sc, expr);
return(f);
}
-static s7_pointer string_set_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer string_set_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
return(f);
}
-static s7_pointer string_append_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+static s7_pointer string_append_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops)
{
check_for_substring_temp(sc, expr);
return(f);
}
-static s7_pointer or_direct;
-static s7_pointer g_or_direct(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer p;
- for (p = args; is_pair(p); p = cdr(p))
- {
- s7_pointer x;
- x = car(p);
- if (is_symbol(x))
- x = find_symbol_checked(sc, x);
- if (is_true(sc, x))
- return(x);
- }
- return(sc->F);
-}
-
-
-static s7_pointer and_direct;
-static s7_pointer g_and_direct(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer p, x;
- x = sc->T;
- for (p = args; is_pair(p); p = cdr(p))
- {
- x = car(p);
- if (is_symbol(x))
- x = find_symbol_checked(sc, x);
- if (is_false(sc, x))
- return(x);
- }
- return(x);
-}
-
-
-static s7_pointer if_direct;
-static s7_pointer g_if_direct(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer p;
- p = car(args);
- if (is_symbol(p))
- p = find_symbol_checked(sc, p);
- if (is_true(sc, p))
- p = cadr(args);
- else
- {
- if (!is_null(cddr(args)))
- p = caddr(args);
- else return(sc->unspecified);
- }
- if (is_symbol(p))
- return(find_symbol_checked(sc, p));
- return(p);
-}
-
-
-static s7_pointer or_all_x, or_all_x_2, or_all_x_2s;
-static s7_pointer g_or_all_x(s7_scheme *sc, s7_pointer args)
+static s7_pointer or_n, or_2, or_3;
+static s7_pointer g_or_n(s7_scheme *sc, s7_pointer args)
{
s7_pointer p;
for (p = args; is_pair(p); p = cdr(p))
@@ -51997,7 +56442,7 @@ static s7_pointer g_or_all_x(s7_scheme *sc, s7_pointer args)
return(sc->F);
}
-static s7_pointer g_or_all_x_2(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_or_2(s7_scheme *sc, s7_pointer args)
{
s7_pointer p;
p = c_call(args)(sc, car(args));
@@ -52006,21 +56451,21 @@ static s7_pointer g_or_all_x_2(s7_scheme *sc, s7_pointer args)
return(c_call(p)(sc, car(p)));
}
-static s7_pointer g_or_all_x_2s(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_or_3(s7_scheme *sc, s7_pointer args)
{
s7_pointer p;
- p = car(args);
- set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(p)));
- p = c_call(p)(sc, sc->t1_1);
+ p = c_call(args)(sc, car(args));
if (p != sc->F) return(p);
- p = cadr(args);
- set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(p)));
- return(c_call(p)(sc, sc->t1_1));
+ p = cdr(args);
+ p = c_call(p)(sc, car(p));
+ if (p != sc->F) return(p);
+ p = cddr(args);
+ return(c_call(p)(sc, car(p)));
}
-static s7_pointer and_all_x, and_all_x_2;
-static s7_pointer g_and_all_x(s7_scheme *sc, s7_pointer args)
+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))
@@ -52032,18 +56477,38 @@ static s7_pointer g_and_all_x(s7_scheme *sc, s7_pointer args)
return(x);
}
-static s7_pointer g_and_all_x_2(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_and_2(s7_scheme *sc, s7_pointer args)
+{
+ if (c_call(args)(sc, car(args)) == sc->F)
+ return(sc->F);
+ return(c_call(cdr(args))(sc, cadr(args)));
+}
+
+static s7_pointer g_and_3(s7_scheme *sc, s7_pointer args)
{
s7_pointer p;
- p = c_call(args)(sc, car(args));
- if (p == sc->F) return(p);
+ if (c_call(args)(sc, car(args)) == sc->F)
+ return(sc->F);
p = cdr(args);
+ if (c_call(p)(sc, car(p)) == sc->F)
+ return(sc->F);
+ p = cdr(p);
return(c_call(p)(sc, car(p)));
}
+static s7_pointer g_and_sc(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ p = car(args);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(p)));
+ p = c_call(p)(sc, sc->t1_1);
+ if (p == sc->F) return(p);
+ p = cadr(args);
+ return(c_call(p)(sc, cdr(p)));
+}
-static s7_pointer if_all_x1;
-static s7_pointer g_if_all_x1(s7_scheme *sc, s7_pointer args)
+static s7_pointer if_x1;
+static s7_pointer g_if_x1(s7_scheme *sc, s7_pointer args)
{
s7_pointer p;
if (is_true(sc, c_call(args)(sc, car(args))))
@@ -52052,8 +56517,8 @@ static s7_pointer g_if_all_x1(s7_scheme *sc, s7_pointer args)
return(c_call(p)(sc, car(p)));
}
-static s7_pointer if_all_x2;
-static s7_pointer g_if_all_x2(s7_scheme *sc, s7_pointer args)
+static s7_pointer if_x2;
+static s7_pointer g_if_x2(s7_scheme *sc, s7_pointer args)
{
s7_pointer p;
if (is_true(sc, c_call(args)(sc, car(args))))
@@ -52063,18 +56528,18 @@ static s7_pointer g_if_all_x2(s7_scheme *sc, s7_pointer args)
}
-static s7_pointer if_all_not_x1;
-static s7_pointer g_if_all_not_x1(s7_scheme *sc, s7_pointer args)
+static s7_pointer if_not_x1;
+static s7_pointer g_if_not_x1(s7_scheme *sc, s7_pointer args)
{
s7_pointer p;
- if (is_false(sc, c_call(args)(sc, cadar(args))))
- p = cdr(args);
- else return(sc->unspecified);
+ if (is_true(sc, c_call(args)(sc, cadar(args))))
+ return(sc->unspecified);
+ p = cdr(args);
return(c_call(p)(sc, car(p)));
}
-static s7_pointer if_all_not_x2;
-static s7_pointer g_if_all_not_x2(s7_scheme *sc, s7_pointer args)
+static s7_pointer if_not_x2;
+static s7_pointer g_if_not_x2(s7_scheme *sc, s7_pointer args)
{
s7_pointer p;
if (is_false(sc, c_call(args)(sc, cadar(args))))
@@ -52083,30 +56548,26 @@ static s7_pointer g_if_all_not_x2(s7_scheme *sc, s7_pointer args)
return(c_call(p)(sc, car(p)));
}
-
-static s7_pointer if_all_x_qq;
-static s7_pointer g_if_all_x_qq(s7_scheme *sc, s7_pointer args)
+static s7_pointer if_x_qq;
+static s7_pointer g_if_x_qq(s7_scheme *sc, s7_pointer args)
{
if (is_true(sc, c_call(args)(sc, car(args))))
- return(cadr(cadr(args)));
+ return(cadadr(args));
return(cadr(caddr(args)));
}
-
-static s7_pointer if_all_x_qa;
-static s7_pointer g_if_all_x_qa(s7_scheme *sc, s7_pointer args)
+static s7_pointer if_x_qa;
+static s7_pointer g_if_x_qa(s7_scheme *sc, s7_pointer args)
{
if (is_true(sc, c_call(args)(sc, car(args))))
- return(cadr(cadr(args)));
+ return(cadadr(args));
return(c_call(cddr(args))(sc, caddr(args)));
}
-
-
static s7_pointer or_s_direct;
static s7_pointer g_or_s_direct(s7_scheme *sc, s7_pointer args)
{
s7_pointer p;
- set_car(sc->t1_1, find_symbol_checked(sc, cadar(args)));
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadar(args)));
for (p = args; is_pair(p); p = cdr(p))
{
s7_pointer x;
@@ -52122,7 +56583,7 @@ static s7_pointer and_s_direct;
static s7_pointer g_and_s_direct(s7_scheme *sc, s7_pointer args)
{
s7_pointer p, x = sc->T;
- set_car(sc->t1_1, find_symbol_checked(sc, cadar(args)));
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadar(args)));
for (p = args; is_pair(p); p = cdr(p))
{
x = c_call(car(p))(sc, sc->t1_1);
@@ -52133,23 +56594,6 @@ static s7_pointer g_and_s_direct(s7_scheme *sc, s7_pointer args)
}
-static s7_pointer if_s_direct;
-static s7_pointer g_if_s_direct(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer p;
- set_car(sc->t1_1, find_symbol_checked(sc, cadar(args)));
- if (is_true(sc, c_call(car(args))(sc, sc->t1_1)))
- p = cdr(args);
- else
- {
- p = cddr(args);
- if (is_null(p))
- return(sc->unspecified);
- }
- return(c_call(car(p))(sc, sc->t1_1));
-}
-
-
static s7_pointer make_function_with_class(s7_scheme *sc, s7_pointer cls, const char *name, s7_function f,
int required_args, int optional_args, bool rest_arg, const char *doc)
{
@@ -52160,7 +56604,8 @@ static s7_pointer make_function_with_class(s7_scheme *sc, s7_pointer cls, const
return(uf);
}
-static s7_pointer set_function_chooser(s7_scheme *sc, s7_pointer sym, s7_pointer (*chooser)(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr))
+
+static s7_pointer set_function_chooser(s7_scheme *sc, s7_pointer sym, s7_pointer (*chooser)(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr, bool ops))
{
s7_pointer f;
f = slot_value(global_slot(sym));
@@ -52175,350 +56620,6 @@ static void init_choosers(s7_scheme *sc)
{
s7_pointer f;
-#if (!WITH_GMP)
- s7_if_set_function(slot_value(global_slot(sc->modulo_symbol)), modulo_if);
- s7_rf_set_function(slot_value(global_slot(sc->modulo_symbol)), modulo_rf);
- s7_rf_set_function(slot_value(global_slot(sc->remainder_symbol)), remainder_rf);
- s7_if_set_function(slot_value(global_slot(sc->remainder_symbol)), remainder_if);
- s7_rf_set_function(slot_value(global_slot(sc->quotient_symbol)), quotient_rf);
- s7_if_set_function(slot_value(global_slot(sc->quotient_symbol)), quotient_if);
- s7_if_set_function(slot_value(global_slot(sc->numerator_symbol)), numerator_if);
- s7_if_set_function(slot_value(global_slot(sc->denominator_symbol)), denominator_if);
- s7_rf_set_function(slot_value(global_slot(sc->real_part_symbol)), real_part_rf);
- s7_rf_set_function(slot_value(global_slot(sc->imag_part_symbol)), imag_part_rf);
- s7_gf_set_function(slot_value(global_slot(sc->rationalize_symbol)), rationalize_pf);
-
- s7_if_set_function(slot_value(global_slot(sc->ceiling_symbol)), ceiling_if);
- s7_if_set_function(slot_value(global_slot(sc->truncate_symbol)), truncate_if);
- s7_if_set_function(slot_value(global_slot(sc->round_symbol)), round_if);
- s7_if_set_function(slot_value(global_slot(sc->floor_symbol)), floor_if);
- s7_if_set_function(slot_value(global_slot(sc->logior_symbol)), logior_if);
- s7_if_set_function(slot_value(global_slot(sc->logand_symbol)), logand_if);
- s7_if_set_function(slot_value(global_slot(sc->logxor_symbol)), logxor_if);
- s7_if_set_function(slot_value(global_slot(sc->lognot_symbol)), lognot_if);
- s7_if_set_function(slot_value(global_slot(sc->ash_symbol)), ash_if);
- s7_if_set_function(slot_value(global_slot(sc->gcd_symbol)), gcd_if);
- s7_if_set_function(slot_value(global_slot(sc->lcm_symbol)), lcm_if);
- s7_rf_set_function(slot_value(global_slot(sc->max_symbol)), max_rf);
- s7_if_set_function(slot_value(global_slot(sc->max_symbol)), max_if);
- s7_rf_set_function(slot_value(global_slot(sc->min_symbol)), min_rf);
- s7_if_set_function(slot_value(global_slot(sc->min_symbol)), min_if);
-
- s7_rf_set_function(slot_value(global_slot(sc->divide_symbol)), divide_rf);
- s7_if_set_function(slot_value(global_slot(sc->multiply_symbol)), multiply_if);
- s7_rf_set_function(slot_value(global_slot(sc->multiply_symbol)), multiply_rf);
- s7_rf_set_function(slot_value(global_slot(sc->add_symbol)), add_rf);
- s7_if_set_function(slot_value(global_slot(sc->add_symbol)), add_if);
- s7_rf_set_function(slot_value(global_slot(sc->subtract_symbol)), subtract_rf);
- s7_if_set_function(slot_value(global_slot(sc->subtract_symbol)), subtract_if);
-#if WITH_ADD_PF
- s7_gf_set_function(slot_value(global_slot(sc->multiply_symbol)), multiply_pf);
- s7_gf_set_function(slot_value(global_slot(sc->add_symbol)), add_pf);
- s7_gf_set_function(slot_value(global_slot(sc->subtract_symbol)), subtract_pf);
-#endif
-
- s7_rf_set_function(slot_value(global_slot(sc->sin_symbol)), sin_rf);
- s7_rf_set_function(slot_value(global_slot(sc->cos_symbol)), cos_rf);
- s7_rf_set_function(slot_value(global_slot(sc->tan_symbol)), tan_rf);
- s7_rf_set_function(slot_value(global_slot(sc->sinh_symbol)), sinh_rf);
- s7_rf_set_function(slot_value(global_slot(sc->cosh_symbol)), cosh_rf);
- s7_rf_set_function(slot_value(global_slot(sc->tanh_symbol)), tanh_rf);
- s7_rf_set_function(slot_value(global_slot(sc->atan_symbol)), atan_rf);
- s7_rf_set_function(slot_value(global_slot(sc->exp_symbol)), exp_rf);
-
- s7_gf_set_function(slot_value(global_slot(sc->asin_symbol)), asin_pf);
- s7_gf_set_function(slot_value(global_slot(sc->acos_symbol)), acos_pf);
- s7_gf_set_function(slot_value(global_slot(sc->asinh_symbol)), asinh_pf);
- s7_gf_set_function(slot_value(global_slot(sc->acosh_symbol)), acosh_pf);
- s7_gf_set_function(slot_value(global_slot(sc->atanh_symbol)), atanh_pf);
-
- s7_rf_set_function(slot_value(global_slot(sc->random_symbol)), random_rf);
- s7_if_set_function(slot_value(global_slot(sc->random_symbol)), random_if);
-
- s7_gf_set_function(slot_value(global_slot(sc->expt_symbol)), expt_pf);
- s7_gf_set_function(slot_value(global_slot(sc->number_to_string_symbol)), number_to_string_pf);
- s7_gf_set_function(slot_value(global_slot(sc->string_to_number_symbol)), string_to_number_pf);
-
- s7_rf_set_function(slot_value(global_slot(sc->abs_symbol)), fabs_rf);
- s7_if_set_function(slot_value(global_slot(sc->abs_symbol)), abs_if);
-#if (!WITH_PURE_S7)
- s7_gf_set_function(slot_value(global_slot(sc->make_rectangular_symbol)), make_complex_pf);
- s7_gf_set_function(slot_value(global_slot(sc->make_polar_symbol)), make_polar_pf);
-#endif
- s7_rf_set_function(slot_value(global_slot(sc->magnitude_symbol)), magnitude_rf);
- s7_if_set_function(slot_value(global_slot(sc->magnitude_symbol)), magnitude_if);
- s7_gf_set_function(slot_value(global_slot(sc->complex_symbol)), make_complex_pf); /* actually complex */
-
- s7_pf_set_function(slot_value(global_slot(sc->eq_symbol)), equal_pf);
- s7_pf_set_function(slot_value(global_slot(sc->lt_symbol)), less_pf);
- s7_pf_set_function(slot_value(global_slot(sc->leq_symbol)), leq_pf);
- s7_pf_set_function(slot_value(global_slot(sc->geq_symbol)), geq_pf);
- s7_pf_set_function(slot_value(global_slot(sc->gt_symbol)), gt_pf);
-#endif /* !gmp */
-
- s7_if_set_function(slot_value(global_slot(sc->pair_line_number_symbol)), pair_line_number_if);
- s7_if_set_function(slot_value(global_slot(sc->hash_table_entries_symbol)), hash_table_entries_if);
-#if (!WITH_PURE_S7)
-#if (!WITH_GMP)
- s7_if_set_function(slot_value(global_slot(sc->integer_length_symbol)), integer_length_if);
-#endif
- s7_if_set_function(slot_value(global_slot(sc->vector_length_symbol)), vector_length_if);
- s7_if_set_function(slot_value(global_slot(sc->string_length_symbol)), string_length_if);
-
- s7_pf_set_function(slot_value(global_slot(sc->string_fill_symbol)), string_fill_pf);
- s7_pf_set_function(slot_value(global_slot(sc->vector_fill_symbol)), vector_fill_pf);
-#endif
- s7_pf_set_function(slot_value(global_slot(sc->length_symbol)), length_pf);
- s7_pf_set_function(slot_value(global_slot(sc->fill_symbol)), fill_pf);
- s7_gf_set_function(slot_value(global_slot(sc->copy_symbol)), copy_pf);
- s7_gf_set_function(slot_value(global_slot(sc->reverse_symbol)), reverse_pf);
- s7_pf_set_function(slot_value(global_slot(sc->not_symbol)), not_pf);
-
- s7_if_set_function(slot_value(global_slot(sc->char_to_integer_symbol)), char_to_integer_if);
- s7_pf_set_function(slot_value(global_slot(sc->char_eq_symbol)), char_eq_pf);
- s7_pf_set_function(slot_value(global_slot(sc->char_gt_symbol)), char_gt_pf);
- s7_pf_set_function(slot_value(global_slot(sc->char_geq_symbol)), char_geq_pf);
- s7_pf_set_function(slot_value(global_slot(sc->char_lt_symbol)), char_lt_pf);
- s7_pf_set_function(slot_value(global_slot(sc->char_leq_symbol)), char_leq_pf);
-
- s7_pf_set_function(slot_value(global_slot(sc->string_eq_symbol)), string_eq_pf);
- s7_pf_set_function(slot_value(global_slot(sc->string_lt_symbol)), string_lt_pf);
- s7_pf_set_function(slot_value(global_slot(sc->string_leq_symbol)), string_leq_pf);
- s7_pf_set_function(slot_value(global_slot(sc->string_gt_symbol)), string_gt_pf);
- s7_pf_set_function(slot_value(global_slot(sc->string_geq_symbol)), string_geq_pf);
-
- s7_gf_set_function(slot_value(global_slot(sc->string_upcase_symbol)), string_upcase_pf);
- s7_gf_set_function(slot_value(global_slot(sc->string_downcase_symbol)), string_downcase_pf);
- s7_gf_set_function(slot_value(global_slot(sc->char_position_symbol)), char_position_pf);
- s7_gf_set_function(slot_value(global_slot(sc->string_position_symbol)), string_position_pf);
-
-#if (!WITH_PURE_S7)
- s7_pf_set_function(slot_value(global_slot(sc->char_ci_eq_symbol)), char_ci_eq_pf);
- s7_pf_set_function(slot_value(global_slot(sc->char_ci_gt_symbol)), char_ci_gt_pf);
- s7_pf_set_function(slot_value(global_slot(sc->char_ci_geq_symbol)), char_ci_geq_pf);
- s7_pf_set_function(slot_value(global_slot(sc->char_ci_lt_symbol)), char_ci_lt_pf);
- s7_pf_set_function(slot_value(global_slot(sc->char_ci_leq_symbol)), char_ci_leq_pf);
-
- s7_pf_set_function(slot_value(global_slot(sc->string_ci_eq_symbol)), string_ci_eq_pf);
- s7_pf_set_function(slot_value(global_slot(sc->string_ci_lt_symbol)), string_ci_lt_pf);
- s7_pf_set_function(slot_value(global_slot(sc->string_ci_leq_symbol)), string_ci_leq_pf);
- s7_pf_set_function(slot_value(global_slot(sc->string_ci_gt_symbol)), string_ci_gt_pf);
- s7_pf_set_function(slot_value(global_slot(sc->string_ci_geq_symbol)), string_ci_geq_pf);
-#endif
-
-#if (!WITH_GMP)
- s7_pf_set_function(slot_value(global_slot(sc->is_even_symbol)), is_even_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_odd_symbol)), is_odd_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_nan_symbol)), is_nan_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_infinite_symbol)), is_infinite_pf);
-#endif
- s7_pf_set_function(slot_value(global_slot(sc->is_zero_symbol)), is_zero_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_positive_symbol)), is_positive_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_negative_symbol)), is_negative_pf);
- s7_pf_set_function(slot_value(global_slot(sc->hash_table_ref_symbol)), hash_table_ref_pf);
- s7_pf_set_function(slot_value(global_slot(sc->hash_table_set_symbol)), hash_table_set_pf);
- s7_pf_set_function(slot_value(global_slot(sc->vector_ref_symbol)), vector_ref_pf);
- s7_pf_set_function(slot_value(global_slot(sc->vector_set_symbol)), vector_set_pf);
- s7_pf_set_function(slot_value(global_slot(sc->string_ref_symbol)), string_ref_pf);
- s7_pf_set_function(slot_value(global_slot(sc->string_set_symbol)), string_set_pf);
- s7_pf_set_function(slot_value(global_slot(sc->list_ref_symbol)), list_ref_pf);
- s7_pf_set_function(slot_value(global_slot(sc->list_set_symbol)), list_set_pf);
- s7_pf_set_function(slot_value(global_slot(sc->let_ref_symbol)), let_ref_pf);
- s7_pf_set_function(slot_value(global_slot(sc->let_set_symbol)), let_set_pf);
- s7_pf_set_function(slot_value(global_slot(sc->string_to_byte_vector_symbol)), string_to_byte_vector_pf);
-
- s7_rf_set_function(slot_value(global_slot(sc->float_vector_ref_symbol)), float_vector_ref_rf);
- s7_rf_set_function(slot_value(global_slot(sc->float_vector_set_symbol)), float_vector_set_rf);
-
- s7_if_set_function(slot_value(global_slot(sc->int_vector_ref_symbol)), int_vector_ref_if);
- s7_if_set_function(slot_value(global_slot(sc->int_vector_set_symbol)), int_vector_set_if);
-
- s7_pf_set_function(slot_value(global_slot(sc->caaaar_symbol)), caaaar_pf);
- s7_pf_set_function(slot_value(global_slot(sc->caaadr_symbol)), caaadr_pf);
- s7_pf_set_function(slot_value(global_slot(sc->caaar_symbol)), caaar_pf);
- s7_pf_set_function(slot_value(global_slot(sc->caadar_symbol)), caadar_pf);
- s7_pf_set_function(slot_value(global_slot(sc->caaddr_symbol)), caaddr_pf);
- s7_pf_set_function(slot_value(global_slot(sc->caadr_symbol)), caadr_pf);
- s7_pf_set_function(slot_value(global_slot(sc->caar_symbol)), caar_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cadaar_symbol)), cadaar_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cadadr_symbol)), cadadr_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cadar_symbol)), cadar_pf);
- s7_pf_set_function(slot_value(global_slot(sc->caddar_symbol)), caddar_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cadddr_symbol)), cadddr_pf);
- s7_pf_set_function(slot_value(global_slot(sc->caddr_symbol)), caddr_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cadr_symbol)), cadr_pf);
- s7_pf_set_function(slot_value(global_slot(sc->car_symbol)), car_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cdaaar_symbol)), cdaaar_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cdaadr_symbol)), cdaadr_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cdaar_symbol)), cdaar_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cdadar_symbol)), cdadar_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cdaddr_symbol)), cdaddr_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cdadr_symbol)), cdadr_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cdar_symbol)), cdar_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cddaar_symbol)), cddaar_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cddadr_symbol)), cddadr_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cddar_symbol)), cddar_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cdddar_symbol)), cdddar_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cddddr_symbol)), cddddr_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cdddr_symbol)), cdddr_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cddr_symbol)), cddr_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cdr_symbol)), cdr_pf);
-
- s7_pf_set_function(slot_value(global_slot(sc->set_car_symbol)), set_car_pf);
- s7_pf_set_function(slot_value(global_slot(sc->set_cdr_symbol)), set_cdr_pf);
- s7_pf_set_function(slot_value(global_slot(sc->list_tail_symbol)), list_tail_pf);
- s7_pf_set_function(slot_value(global_slot(sc->assoc_symbol)), assoc_pf);
- s7_pf_set_function(slot_value(global_slot(sc->member_symbol)), member_pf);
-
- s7_gf_set_function(slot_value(global_slot(sc->cons_symbol)), cons_pf);
- s7_gf_set_function(slot_value(global_slot(sc->list_symbol)), list_pf);
- s7_gf_set_function(slot_value(global_slot(sc->int_vector_symbol)), int_vector_pf);
- s7_gf_set_function(slot_value(global_slot(sc->float_vector_symbol)), float_vector_pf);
- s7_gf_set_function(slot_value(global_slot(sc->vector_symbol)), vector_pf);
- s7_gf_set_function(slot_value(global_slot(sc->c_pointer_symbol)), c_pointer_pf);
- s7_gf_set_function(slot_value(global_slot(sc->vector_dimensions_symbol)), vector_dimensions_pf);
- s7_gf_set_function(slot_value(global_slot(sc->make_shared_vector_symbol)), make_shared_vector_pf);
- s7_gf_set_function(slot_value(global_slot(sc->make_vector_symbol)), make_vector_pf);
- s7_gf_set_function(slot_value(global_slot(sc->make_float_vector_symbol)), make_float_vector_pf);
- s7_gf_set_function(slot_value(global_slot(sc->make_int_vector_symbol)), make_int_vector_pf);
- s7_gf_set_function(slot_value(global_slot(sc->make_list_symbol)), make_list_pf);
- s7_gf_set_function(slot_value(global_slot(sc->make_string_symbol)), make_string_pf);
-
- s7_pf_set_function(slot_value(global_slot(sc->memq_symbol)), memq_pf);
- s7_pf_set_function(slot_value(global_slot(sc->memv_symbol)), memv_pf);
- s7_pf_set_function(slot_value(global_slot(sc->assq_symbol)), assq_pf);
- s7_pf_set_function(slot_value(global_slot(sc->assv_symbol)), assv_pf);
-#if (!WITH_PURE_S7)
- s7_gf_set_function(slot_value(global_slot(sc->list_to_vector_symbol)), list_to_vector_pf);
- s7_gf_set_function(slot_value(global_slot(sc->vector_to_list_symbol)), vector_to_list_pf);
- s7_gf_set_function(slot_value(global_slot(sc->string_to_list_symbol)), string_to_list_pf);
- s7_gf_set_function(slot_value(global_slot(sc->let_to_list_symbol)), let_to_list_pf);
-#endif
- s7_gf_set_function(slot_value(global_slot(sc->random_state_to_list_symbol)), random_state_to_list_pf);
-
- s7_pf_set_function(slot_value(global_slot(sc->is_aritable_symbol)), is_aritable_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_boolean_symbol)), is_boolean_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_byte_vector_symbol)), is_byte_vector_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_char_symbol)), is_char_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_complex_symbol)), is_complex_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_constant_symbol)), is_constant_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_continuation_symbol)), is_continuation_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_c_pointer_symbol)), is_c_pointer_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_dilambda_symbol)), is_dilambda_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_eof_object_symbol)), is_eof_object_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_float_vector_symbol)), is_float_vector_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_gensym_symbol)), is_gensym_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_hash_table_symbol)), is_hash_table_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_input_port_symbol)), is_input_port_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_integer_symbol)), is_integer_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_int_vector_symbol)), is_int_vector_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_keyword_symbol)), is_keyword_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_let_symbol)), is_let_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_list_symbol)), is_list_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_macro_symbol)), is_macro_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_null_symbol)), is_null_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_number_symbol)), is_number_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_output_port_symbol)), is_output_port_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_pair_symbol)), is_pair_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_procedure_symbol)), is_procedure_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_provided_symbol)), is_provided_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_random_state_symbol)), is_random_state_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_rational_symbol)), is_rational_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_real_symbol)), is_real_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_string_symbol)), is_string_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_symbol_symbol)), is_symbol_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_vector_symbol)), is_vector_pf);
-
- s7_pf_set_function(slot_value(global_slot(sc->is_iterator_symbol)), is_iterator_pf);
- s7_pf_set_function(slot_value(global_slot(sc->iterator_is_at_end_symbol)), iterator_is_at_end_pf);
- s7_pf_set_function(slot_value(global_slot(sc->iterator_sequence_symbol)), iterator_sequence_pf);
- s7_pf_set_function(slot_value(global_slot(sc->iterate_symbol)), iterate_pf);
- s7_gf_set_function(slot_value(global_slot(sc->iterate_symbol)), iterate_gf);
- s7_gf_set_function(slot_value(global_slot(sc->make_iterator_symbol)), make_iterator_pf);
-#if (!WITH_GMP)
- s7_gf_set_function(slot_value(global_slot(sc->random_state_symbol)), random_state_pf);
-#endif
- s7_pf_set_function(slot_value(global_slot(sc->reverseb_symbol)), reverse_in_place_pf);
- s7_gf_set_function(slot_value(global_slot(sc->sort_symbol)), sort_pf);
- s7_pf_set_function(slot_value(global_slot(sc->provide_symbol)), provide_pf);
- s7_pf_set_function(slot_value(global_slot(sc->symbol_symbol)), symbol_pf);
- s7_pf_set_function(slot_value(global_slot(sc->string_to_symbol_symbol)), string_to_symbol_pf);
- s7_gf_set_function(slot_value(global_slot(sc->symbol_to_string_symbol)), symbol_to_string_pf);
- s7_pf_set_function(slot_value(global_slot(sc->string_to_keyword_symbol)), string_to_keyword_pf);
- s7_pf_set_function(slot_value(global_slot(sc->keyword_to_symbol_symbol)), keyword_to_symbol_pf);
- s7_pf_set_function(slot_value(global_slot(sc->symbol_to_keyword_symbol)), symbol_to_keyword_pf);
- s7_pf_set_function(slot_value(global_slot(sc->symbol_to_value_symbol)), symbol_to_value_pf);
- s7_gf_set_function(slot_value(global_slot(sc->gensym_symbol)), gensym_pf);
- s7_gf_set_function(slot_value(global_slot(sc->arity_symbol)), arity_pf);
-
- s7_pf_set_function(slot_value(global_slot(sc->is_openlet_symbol)), is_openlet_pf);
- s7_pf_set_function(slot_value(global_slot(sc->curlet_symbol)), curlet_pf);
- s7_pf_set_function(slot_value(global_slot(sc->owlet_symbol)), owlet_pf);
- s7_pf_set_function(slot_value(global_slot(sc->rootlet_symbol)), rootlet_pf);
- s7_pf_set_function(slot_value(global_slot(sc->outlet_symbol)), outlet_pf);
- s7_pf_set_function(slot_value(global_slot(sc->openlet_symbol)), openlet_pf);
- s7_pf_set_function(slot_value(global_slot(sc->coverlet_symbol)), coverlet_pf);
- s7_pf_set_function(slot_value(global_slot(sc->funclet_symbol)), funclet_pf);
- s7_pf_set_function(slot_value(global_slot(sc->cutlet_symbol)), cutlet_pf);
- s7_pf_set_function(slot_value(global_slot(sc->varlet_symbol)), varlet_pf);
- s7_pf_set_function(slot_value(global_slot(sc->unlet_symbol)), unlet_pf);
- s7_gf_set_function(slot_value(global_slot(sc->inlet_symbol)), inlet_pf);
-
- s7_pf_set_function(slot_value(global_slot(sc->gc_symbol)), gc_pf);
- s7_gf_set_function(slot_value(global_slot(sc->help_symbol)), help_pf);
- s7_gf_set_function(slot_value(global_slot(sc->procedure_source_symbol)), procedure_source_pf);
- s7_gf_set_function(slot_value(global_slot(sc->procedure_documentation_symbol)), procedure_documentation_pf);
- s7_gf_set_function(slot_value(global_slot(sc->procedure_signature_symbol)), procedure_signature_pf);
-
- s7_pf_set_function(slot_value(global_slot(sc->is_char_alphabetic_symbol)), is_char_alphabetic_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_char_lower_case_symbol)), is_char_lower_case_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_char_numeric_symbol)), is_char_numeric_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_char_upper_case_symbol)), is_char_upper_case_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_char_whitespace_symbol)), is_char_whitespace_pf);
- s7_pf_set_function(slot_value(global_slot(sc->char_upcase_symbol)), char_upcase_pf);
- s7_pf_set_function(slot_value(global_slot(sc->char_downcase_symbol)), char_downcase_pf);
- s7_pf_set_function(slot_value(global_slot(sc->integer_to_char_symbol)), integer_to_char_pf);
-
- s7_pf_set_function(slot_value(global_slot(sc->current_input_port_symbol)), current_input_port_pf);
- s7_pf_set_function(slot_value(global_slot(sc->current_output_port_symbol)), current_output_port_pf);
- s7_pf_set_function(slot_value(global_slot(sc->current_error_port_symbol)), current_error_port_pf);
- s7_pf_set_function(slot_value(global_slot(sc->close_input_port_symbol)), close_input_port_pf);
- s7_pf_set_function(slot_value(global_slot(sc->close_output_port_symbol)), close_output_port_pf);
- s7_pf_set_function(slot_value(global_slot(sc->flush_output_port_symbol)), flush_output_port_pf);
- s7_gf_set_function(slot_value(global_slot(sc->port_filename_symbol)), port_filename_pf);
- s7_gf_set_function(slot_value(global_slot(sc->port_line_number_symbol)), port_line_number_pf);
- s7_pf_set_function(slot_value(global_slot(sc->with_input_from_file_symbol)), with_input_from_file_pf);
- s7_pf_set_function(slot_value(global_slot(sc->with_input_from_string_symbol)), with_input_from_string_pf);
- s7_gf_set_function(slot_value(global_slot(sc->with_output_to_string_symbol)), with_output_to_string_pf);
- s7_pf_set_function(slot_value(global_slot(sc->with_output_to_file_symbol)), with_output_to_file_pf);
- s7_gf_set_function(slot_value(global_slot(sc->call_with_output_string_symbol)), call_with_output_string_pf);
- s7_pf_set_function(slot_value(global_slot(sc->call_with_output_file_symbol)), call_with_output_file_pf);
- s7_pf_set_function(slot_value(global_slot(sc->call_with_input_string_symbol)), call_with_input_string_pf);
- s7_pf_set_function(slot_value(global_slot(sc->call_with_input_file_symbol)), call_with_input_file_pf);
-
-#if WITH_SYSTEM_EXTRAS
- s7_gf_set_function(slot_value(global_slot(sc->directory_to_list_symbol)), directory_to_list_pf);
-#endif
- s7_if_set_function(slot_value(global_slot(sc->write_byte_symbol)), write_byte_if);
- s7_pf_set_function(slot_value(global_slot(sc->write_char_symbol)), write_char_pf);
- s7_pf_set_function(slot_value(global_slot(sc->read_byte_symbol)), read_byte_pf);
- s7_pf_set_function(slot_value(global_slot(sc->read_char_symbol)), read_char_pf);
- s7_pf_set_function(slot_value(global_slot(sc->peek_char_symbol)), peek_char_pf);
- s7_pf_set_function(slot_value(global_slot(sc->newline_symbol)), newline_pf);
- s7_pf_set_function(slot_value(global_slot(sc->write_symbol)), write_pf);
- s7_pf_set_function(slot_value(global_slot(sc->write_string_symbol)), write_string_pf);
- s7_gf_set_function(slot_value(global_slot(sc->read_string_symbol)), read_string_pf);
- s7_pf_set_function(slot_value(global_slot(sc->display_symbol)), display_pf);
- s7_gf_set_function(slot_value(global_slot(sc->read_symbol)), read_pf);
- s7_gf_set_function(slot_value(global_slot(sc->read_line_symbol)), read_line_pf);
- s7_gf_set_function(slot_value(global_slot(sc->object_to_string_symbol)), object_to_string_pf);
-
- s7_pf_set_function(slot_value(global_slot(sc->is_eq_symbol)), is_eq_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_eqv_symbol)), is_eqv_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_equal_symbol)), is_equal_pf);
- s7_pf_set_function(slot_value(global_slot(sc->is_morally_equal_symbol)), is_morally_equal_pf);
-
-
/* + */
f = set_function_chooser(sc, sc->add_symbol, add_chooser);
sc->add_class = c_function_class(f);
@@ -52527,10 +56628,10 @@ static void init_choosers(s7_scheme *sc)
add_1s = make_function_with_class(sc, f, "+", g_add_1s, 2, 0, false, "+ opt");
add_s1 = make_function_with_class(sc, f, "+", g_add_s1, 2, 0, false, "+ opt");
add_cs1 = make_function_with_class(sc, f, "+", g_add_cs1, 2, 0, false, "+ opt");
+ add_cl1 = make_function_with_class(sc, f, "+", g_add_cl1, 2, 0, false, "+ opt");
add_si = make_function_with_class(sc, f, "+", g_add_si, 2, 0, false, "+ opt");
add_sf = make_function_with_class(sc, f, "+", g_add_sf, 2, 0, false, "+ opt");
add_fs = make_function_with_class(sc, f, "+", g_add_fs, 2, 0, false, "+ opt");
- add_ss_1ss = make_function_with_class(sc, f, "+", g_add_ss_1ss, 2, 0, false, "+ opt");
add_f_sf = make_function_with_class(sc, f, "+", g_add_f_sf, 2, 0, false, "+ opt");
/* - */
@@ -52540,16 +56641,11 @@ static void init_choosers(s7_scheme *sc)
subtract_2 = make_function_with_class(sc, f, "-", g_subtract_2, 2, 0, false, "- opt");
subtract_s1 = make_function_with_class(sc, f, "-", g_subtract_s1, 2, 0, false, "- opt");
subtract_cs1 = make_function_with_class(sc, f, "-", g_subtract_cs1, 2, 0, false, "- opt");
+ subtract_cl1 = make_function_with_class(sc, f, "-", g_subtract_cl1, 2, 0, false, "- opt");
subtract_csn = make_function_with_class(sc, f, "-", g_subtract_csn, 2, 0, false, "- opt");
subtract_sf = make_function_with_class(sc, f, "-", g_subtract_sf, 2, 0, false, "- opt");
subtract_2f = make_function_with_class(sc, f, "-", g_subtract_2f, 2, 0, false, "- opt");
subtract_fs = make_function_with_class(sc, f, "-", g_subtract_fs, 2, 0, false, "- opt");
- subtract_f_sqr = make_function_with_class(sc, f, "-", g_subtract_f_sqr, 2, 0, false, "- opt");
-#if (!WITH_GMP)
- sub_random_ic = make_function_with_class(sc, f, "random", g_sub_random_ic, 2, 0, false, "- opt");
- sub_random_rc = make_function_with_class(sc, f, "random", g_sub_random_rc, 2, 0, false, "- opt");
-#endif
-
/* * */
f = set_function_chooser(sc, sc->multiply_symbol, multiply_chooser);
@@ -52562,8 +56658,6 @@ static void init_choosers(s7_scheme *sc)
multiply_sf = make_function_with_class(sc, f, "*", g_multiply_sf, 2, 0, false, "* opt");
sqr_ss = make_function_with_class(sc, f, "*", g_sqr_ss, 2, 0, false, "* opt");
- mul_1ss = make_function_with_class(sc, f, "*", g_mul_1ss, 2, 0, false, "* opt");
- multiply_cs_cos = make_function_with_class(sc, f, "*", g_multiply_cs_cos, 3, 0, false, "* opt");
mul_s_sin_s = make_function_with_class(sc, f, "*", g_mul_s_sin_s, 2, 0, false, "* opt");
mul_s_cos_s = make_function_with_class(sc, f, "*", g_mul_s_cos_s, 2, 0, false, "* opt");
#endif
@@ -52586,21 +56680,15 @@ static void init_choosers(s7_scheme *sc)
f = set_function_chooser(sc, sc->min_symbol, min_chooser);
min_f2 = make_function_with_class(sc, f, "min", g_min_f2, 2, 0, false, "min opt");
- /* zero? */
- set_function_chooser(sc, sc->is_zero_symbol, is_zero_chooser);
-
/* = */
f = set_function_chooser(sc, sc->eq_symbol, equal_chooser);
sc->equal_class = c_function_class(f);
-
equal_s_ic = make_function_with_class(sc, f, "=", g_equal_s_ic, 2, 0, false, "= opt");
equal_length_ic = make_function_with_class(sc, f, "=", g_equal_length_ic, 2, 0, false, "= opt");
equal_2 = make_function_with_class(sc, f, "=", g_equal_2, 2, 0, false, "= opt");
- mod_si_is_zero = make_function_with_class(sc, f, "=", g_mod_si_is_zero, 2, 0, false, "= opt");
/* < */
f = set_function_chooser(sc, sc->lt_symbol, less_chooser);
-
less_s_ic = make_function_with_class(sc, f, "<", g_less_s_ic, 2, 0, false, "< opt");
less_s0 = make_function_with_class(sc, f, "<", g_less_s0, 2, 0, false, "< opt");
less_2 = make_function_with_class(sc, f, "<", g_less_2, 2, 0, false, "< opt");
@@ -52611,7 +56699,6 @@ static void init_choosers(s7_scheme *sc)
greater_s_ic = make_function_with_class(sc, f, ">", g_greater_s_ic, 2, 0, false, "> opt");
greater_s_fc = make_function_with_class(sc, f, ">", g_greater_s_fc, 2, 0, false, "> opt");
greater_2 = make_function_with_class(sc, f, ">", g_greater_2, 2, 0, false, "> opt");
- greater_2_f = make_function_with_class(sc, f, ">", g_greater_2_f, 2, 0, false, "> opt");
/* <= */
f = set_function_chooser(sc, sc->leq_symbol, leq_chooser);
@@ -52623,25 +56710,13 @@ static void init_choosers(s7_scheme *sc)
geq_s_ic = make_function_with_class(sc, f, ">=", g_geq_s_ic, 2, 0, false, ">= opt");
geq_s_fc = make_function_with_class(sc, f, ">=", g_geq_s_fc, 2, 0, false, ">= opt");
geq_2 = make_function_with_class(sc, f, ">=", g_geq_2, 2, 0, false, ">= opt");
- geq_length_ic = make_function_with_class(sc, f, ">=", g_geq_length_ic, 2, 0, false, ">= opt");
/* random */
f = set_function_chooser(sc, sc->random_symbol, random_chooser);
- random_i = make_function_with_class(sc, f, "random", g_random_i, 1, 0, false, "random opt");
random_ic = make_function_with_class(sc, f, "random", g_random_ic, 1, 0, false, "random opt");
random_rc = make_function_with_class(sc, f, "random", g_random_rc, 1, 0, false, "random opt");
#endif
- /* list */
- f = set_function_chooser(sc, sc->list_symbol, list_chooser);
- list_0 = make_function_with_class(sc, f, "list", g_list_0, 0, 0, false, "list opt");
- list_1 = make_function_with_class(sc, f, "list", g_list_1, 1, 0, false, "list opt");
- list_2 = make_function_with_class(sc, f, "list", g_list_2, 2, 0, false, "list opt");
-
- /* aritable? */
- f = set_function_chooser(sc, sc->is_aritable_symbol, is_aritable_chooser);
- is_aritable_ic = make_function_with_class(sc, f, "aritable?", g_is_aritable_ic, 2, 0, false, "aritable? opt");
-
/* char=? */
f = set_function_chooser(sc, sc->char_eq_symbol, char_equal_chooser);
simple_char_eq = make_function_with_class(sc, f, "char=?", g_simple_char_eq, 2, 0, false, "char=? opt");
@@ -52650,12 +56725,10 @@ static void init_choosers(s7_scheme *sc)
/* char>? */
f = set_function_chooser(sc, sc->char_gt_symbol, char_greater_chooser);
- char_greater_s_ic = make_function_with_class(sc, f, "char>?", g_char_greater_s_ic, 2, 0, false, "char>? opt");
char_greater_2 = make_function_with_class(sc, f, "char>?", g_char_greater_2, 2, 0, false, "char>? opt");
/* char<? */
f = set_function_chooser(sc, sc->char_lt_symbol, char_less_chooser);
- char_less_s_ic = make_function_with_class(sc, f, "char<?", g_char_less_s_ic, 2, 0, false, "char<? opt");
char_less_2 = make_function_with_class(sc, f, "char<?", g_char_less_2, 2, 0, false, "char<? opt");
/* char-position */
@@ -52667,7 +56740,6 @@ static void init_choosers(s7_scheme *sc)
/* string=? */
f = set_function_chooser(sc, sc->string_eq_symbol, string_equal_chooser);
- string_equal_s_ic = make_function_with_class(sc, f, "string=?", g_string_equal_s_ic, 2, 0, false, "string=? opt");
string_equal_2 = make_function_with_class(sc, f, "string=?", g_string_equal_2, 2, 0, false, "string=? opt");
/* substring */
@@ -52710,20 +56782,13 @@ static void init_choosers(s7_scheme *sc)
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_gs = make_function_with_class(sc, f, "vector-ref", g_vector_ref_gs, 2, 0, false, "vector-ref opt");
- constant_vector_ref_gs = make_function_with_class(sc, f, "vector-ref", g_constant_vector_ref_gs, 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");
/* vector-set! */
f = set_function_chooser(sc, sc->vector_set_symbol, vector_set_chooser);
vector_set_ic = make_function_with_class(sc, f, "vector-set!", g_vector_set_ic, 3, 0, false, "vector-set! opt");
- vector_set_vref = make_function_with_class(sc, f, "vector-set!", g_vector_set_vref, 3, 0, false, "vector-set! opt");
- vector_set_vector_ref = make_function_with_class(sc, f, "vector-set!", g_vector_set_vector_ref, 3, 0, false, "vector-set! opt");
vector_set_3 = make_function_with_class(sc, f, "vector-set!", g_vector_set_3, 3, 0, false, "vector-set! opt");
- /* list-ref */
- f = set_function_chooser(sc, sc->list_ref_symbol, list_ref_chooser);
- list_ref_ic = make_function_with_class(sc, f, "list-ref", g_list_ref_ic, 2, 0, false, "list-ref opt");
-
/* list-set! */
f = set_function_chooser(sc, sc->list_set_symbol, list_set_chooser);
list_set_ic = make_function_with_class(sc, f, "list-set!", g_list_set_ic, 3, 0, false, "list-set! opt");
@@ -52744,7 +56809,6 @@ static void init_choosers(s7_scheme *sc)
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_list = make_function_with_class(sc, f, "not", g_not_is_list, 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");
@@ -52775,7 +56839,6 @@ static void init_choosers(s7_scheme *sc)
f = set_function_chooser(sc, sc->member_symbol, member_chooser);
member_ss = make_function_with_class(sc, f, "member", g_member_ss, 2, 0, false, "member opt");
member_sq = make_function_with_class(sc, f, "member", g_member_sq, 2, 0, false, "member opt");
- member_num_s = make_function_with_class(sc, f, "member", g_member_num_s, 2, 0, false, "member opt");
/* memq */
f = set_function_chooser(sc, sc->memq_symbol, memq_chooser);
@@ -52785,15 +56848,6 @@ static void init_choosers(s7_scheme *sc)
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");
- /* read-char */
- f = set_function_chooser(sc, sc->read_char_symbol, read_char_chooser);
- read_char_0 = make_function_with_class(sc, f, "read-char", g_read_char_0, 0, 0, false, "read-char opt");
- read_char_1 = make_function_with_class(sc, f, "read-char", g_read_char_1, 1, 0, false, "read-char opt");
-
- /* write-char */
- f = set_function_chooser(sc, sc->write_char_symbol, write_char_chooser);
- write_char_1 = make_function_with_class(sc, f, "write-char", g_write_char_1, 1, 0, false, "write-char opt");
-
/* read-line */
read_line_uncopied = s7_make_function(sc, "read-line", g_read_line_uncopied, 1, 1, false, "read-line opt");
s7_function_set_class(read_line_uncopied, slot_value(global_slot(sc->read_line_symbol)));
@@ -52803,68 +56857,47 @@ static void init_choosers(s7_scheme *sc)
/* eval-string */
set_function_chooser(sc, sc->eval_string_symbol, eval_string_chooser);
-
- /* or and if simple cases */
- or_direct = s7_make_function(sc, "or", g_or_direct, 0, 0, true, "or opt");
- and_direct = s7_make_function(sc, "and", g_and_direct, 0, 0, true, "and opt");
- if_direct = s7_make_function(sc, "if", g_if_direct, 2, 1, false, "if opt");
-
- or_all_x = s7_make_function(sc, "or", g_or_all_x, 0, 0, true, "or opt");
- or_all_x_2 = s7_make_function(sc, "or", g_or_all_x_2, 2, 0, false, "or opt");
- or_all_x_2s = s7_make_function(sc, "or", g_or_all_x_2s, 2, 0, false, "or opt");
- and_all_x = s7_make_function(sc, "and", g_and_all_x, 0, 0, true, "and opt");
- and_all_x_2 = s7_make_function(sc, "and", g_and_all_x_2, 2, 0, false, "and opt");
- if_all_x1 = s7_make_function(sc, "if", g_if_all_x1, 2, 0, false, "if opt");
- if_all_x2 = s7_make_function(sc, "if", g_if_all_x2, 3, 0, false, "if opt");
- if_all_not_x1 = s7_make_function(sc, "if", g_if_all_not_x1, 2, 0, false, "if opt");
- if_all_not_x2 = s7_make_function(sc, "if", g_if_all_not_x2, 3, 0, false, "if opt");
- if_all_x_qq = s7_make_function(sc, "if", g_if_all_x_qq, 3, 0, false, "if opt");
- if_all_x_qa = s7_make_function(sc, "if", g_if_all_x_qa, 3, 0, false, "if opt");
+
+ /* inlet */
+ f = set_function_chooser(sc, sc->inlet_symbol, inlet_chooser);
+ simple_inlet = make_function_with_class(sc, f, "inlet", g_simple_inlet, 0, 0, true, "inlet opt");
+
+ /* let-ref */
+ f = set_function_chooser(sc, sc->let_ref_symbol, let_ref_chooser);
+ lint_let_ref = make_function_with_class(sc, f, "let-ref", g_lint_let_ref, 2, 0, false, "let-ref opt");
+ local_lint_let_ref = make_function_with_class(sc, f, "let-ref", g_local_lint_let_ref, 2, 0, false, "let-ref opt");
+
+ /* let-set */
+ f = set_function_chooser(sc, sc->let_set_symbol, let_set_chooser);
+ lint_let_set = make_function_with_class(sc, f, "let-set!", g_lint_let_set, 3, 0, false, "let-set! opt");
+ local_lint_let_set = make_function_with_class(sc, f, "let-set!", g_local_lint_let_set, 3, 0, false, "let-set! opt");
+
+ or_n = s7_make_function(sc, "or", g_or_n, 0, 0, true, "or opt");
+ or_2 = s7_make_function(sc, "or", g_or_2, 2, 0, false, "or opt");
+ or_3 = s7_make_function(sc, "or", g_or_3, 3, 0, false, "or opt");
+ and_n = s7_make_function(sc, "and", g_and_n, 0, 0, true, "and opt");
+ and_2 = s7_make_function(sc, "and", g_and_2, 2, 0, false, "and opt");
+ and_3 = s7_make_function(sc, "and", g_and_3, 3, 0, false, "and opt");
+ and_sc = s7_make_function(sc, "and", g_and_sc, 2, 0, false, "and opt");
+ if_x1 = s7_make_function(sc, "if", g_if_x1, 2, 0, false, "if opt");
+ if_x2 = s7_make_function(sc, "if", g_if_x2, 3, 0, false, "if opt");
+ if_not_x1 = s7_make_function(sc, "if", g_if_not_x1, 2, 0, false, "if opt");
+ if_not_x2 = s7_make_function(sc, "if", g_if_not_x2, 3, 0, false, "if opt");
+ if_x_qq = s7_make_function(sc, "if", g_if_x_qq, 3, 0, false, "if opt");
+ if_x_qa = s7_make_function(sc, "if", g_if_x_qa, 3, 0, false, "if opt");
or_s_direct = s7_make_function(sc, "or", g_or_s_direct, 0, 0, true, "or opt");
and_s_direct = s7_make_function(sc, "and", g_and_s_direct, 0, 0, true, "and opt");
- if_s_direct = s7_make_function(sc, "if", g_if_s_direct, 2, 1, false, "if opt");
-}
-
-
-static s7_pointer collect_collisions(s7_scheme *sc, s7_pointer lst, s7_pointer e)
-{
- /* collect local variable names from let/do (pre-error-check) */
- s7_pointer p;
- sc->w = e;
- for (p = lst; is_pair(p); p = cdr(p))
- if ((is_pair(car(p))) &&
- (is_symbol(caar(p))))
- sc->w = cons(sc, add_sym_to_list(sc, caar(p)), sc->w);
- return(sc->w);
-}
-
-static s7_pointer collect_collisions_star(s7_scheme *sc, s7_pointer lst, s7_pointer e)
-{
- /* collect local variable names from lambda arglists (pre-error-check) */
- s7_pointer p;
- sc->w = e;
- for (p = lst; is_pair(p); p = cdr(p))
- {
- s7_pointer car_p;
- car_p = car(p);
- if (is_pair(car_p))
- car_p = car(car_p);
- if ((is_symbol(car_p)) &&
- (!is_keyword(car_p)))
- sc->w = cons(sc, add_sym_to_list(sc, car_p), sc->w);
- }
- return(sc->w);
}
-#define choose_c_function(Sc, Expr, Func, Args) set_c_function(Expr, c_function_chooser(Func)(Sc, Func, Args, Expr))
+#define choose_c_function(Sc, Expr, Func, Args) do {clear_overlay(Expr); set_c_function(Expr, c_function_chooser(Func)(Sc, Func, Args, Expr, true));} while (0)
-static bool optimize_thunk(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop)
+static opt_t optimize_thunk(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop)
{
- /* fprintf(stderr, "expr: %s, hop: %d\n", DISPLAY(expr), hop); */
if (is_immutable_symbol(car(expr)))
hop = 1;
+
if (is_closure(func))
{
if (is_null(closure_args(func))) /* no rest arg funny business */
@@ -52896,13 +56929,13 @@ static bool optimize_thunk(s7_scheme *sc, s7_pointer expr, s7_pointer func, int
else set_unsafe_optimize_op(expr, hop + OP_THUNK);
set_opt_lambda(expr, func);
}
- return(false); /* false because currently the C_PP stuff assumes safe procedure calls */
+ return(OPT_F); /* false (OPT_F) because currently the C_PP stuff assumes safe procedure calls */
}
if (is_c_function(func))
{
if (c_function_required_args(func) != 0)
- return(false);
+ return(OPT_F);
if ((is_safe_procedure(func)) ||
(c_function_call(func) == g_list) || /* (list) is safe */
@@ -52910,21 +56943,11 @@ static bool optimize_thunk(s7_scheme *sc, s7_pointer expr, s7_pointer func, int
{
set_safe_optimize_op(expr, hop + OP_SAFE_C_C);
choose_c_function(sc, expr, func, 0);
- return(true);
+ return(OPT_T);
}
- return(false);
+ return(OPT_F);
}
-
- if (is_closure_star(func))
- {
- if ((is_proper_list(sc, closure_args(func))) &&
- (has_simple_args(closure_body(func))))
- {
- set_unsafe_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_STAR : OP_CLOSURE_STAR));
- set_opt_lambda(expr, func);
- }
- }
- return(false);
+ return(OPT_F);
}
@@ -52940,24 +56963,30 @@ static int combine_ops(s7_scheme *sc, combine_op_t op1, s7_pointer e1, s7_pointe
case E_C_P:
switch (op2)
{
+ 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:
+ return(OP_SAFE_C_opSq);
case OP_SAFE_C_C: return(OP_SAFE_C_opCq); /* this includes the multi-arg C_C cases */
- case OP_SAFE_C_S: return(OP_SAFE_C_opSq);
case OP_SAFE_C_SS: return(OP_SAFE_C_opSSq);
case OP_SAFE_C_SQ: return(OP_SAFE_C_opSQq);
+ case OP_SAFE_C_QS: return(OP_SAFE_C_opQSq);
case OP_SAFE_C_SC: return(OP_SAFE_C_opSCq);
case OP_SAFE_C_CS: return(OP_SAFE_C_opCSq);
case OP_SAFE_C_opSq: return(OP_SAFE_C_op_opSq_q);
case OP_SAFE_C_S_opSq: return(OP_SAFE_C_op_S_opSq_q);
+ case OP_SAFE_C_opSq_S: return(OP_SAFE_C_op_opSq_S_q);
case OP_SAFE_C_A: return(OP_SAFE_C_opAq);
case OP_SAFE_C_AA: return(OP_SAFE_C_opAAq);
case OP_SAFE_C_AAA: return(OP_SAFE_C_opAAAq);
+ /* car_s opsq_opsq c_opsq s_opcq opcq_s opsq_c opcq_c, but they don't amount to anything in safe_c_a|z */
}
return(OP_SAFE_C_Z); /* this splits out to A in optimize_func_one_arg */
case E_C_SP:
switch (op2)
{
- case OP_SAFE_C_S:
+ 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:
set_opt_sym1(cdr(e1), cadr(e2));
return(OP_SAFE_C_S_opSq);
@@ -52988,6 +57017,9 @@ static int combine_ops(s7_scheme *sc, combine_op_t op1, s7_pointer e1, s7_pointe
case OP_SAFE_C_S_opSSq:
return(OP_SAFE_C_S_op_S_opSSqq);
+ case OP_SAFE_C_S_opSq:
+ return(OP_SAFE_C_S_op_S_opSqq);
+
case OP_SAFE_C_opSSq_opSSq:
return(OP_SAFE_C_S_op_opSSq_opSSqq);
@@ -53001,38 +57033,59 @@ static int combine_ops(s7_scheme *sc, combine_op_t op1, s7_pointer e1, s7_pointe
return(OP_SAFE_C_S_opAAq);
case OP_SAFE_C_CSA:
- case OP_SAFE_C_CAS:
case OP_SAFE_C_SCA:
case OP_SAFE_C_SAS:
case OP_SAFE_C_SSA:
case OP_SAFE_C_AAA:
return(OP_SAFE_C_S_opAAAq);
+ /* index h_safe_c_scs: 2210
+ * thash h_safe_c_s_opcq: 2222222
+ * tgen h_safe_c_opssq: 109130
+ * tall h_safe_c_opsq: 30429
+ * snd-test h_safe_c_s_op_s_opssqq: 835666
+ * bench h_safe_c_opssq: 4374
+ * lg h_safe_c_qs: 122728, h_safe_c_all_x: 1047308, h_safe_c_s_opscq: 144352,
+ * h_safe_c_all_x: 1081764, h_safe_c_opsq_c: 444588, h_safe_c_s_opcq: 792071
+ */
}
return(OP_SAFE_C_SZ);
case E_C_PS:
switch (op2)
{
- case OP_SAFE_C_C: return(OP_SAFE_C_opCq_S);
- case OP_SAFE_C_S: return(OP_SAFE_C_opSq_S);
- case OP_SAFE_C_CS: return(OP_SAFE_C_opCSq_S);
- case OP_SAFE_C_SC: return(OP_SAFE_C_opSCq_S);
- case OP_SAFE_C_SS: return(OP_SAFE_C_opSSq_S);
+ 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:
+ return(OP_SAFE_C_opSq_S);
+ case OP_SAFE_C_C: return(OP_SAFE_C_opCq_S);
+ case OP_SAFE_C_CS: return(OP_SAFE_C_opCSq_S);
+ case OP_SAFE_C_SC: return(OP_SAFE_C_opSCq_S);
+ case OP_SAFE_C_SS: return(OP_SAFE_C_opSSq_S);
case OP_SAFE_C_opSq: return(OP_SAFE_C_op_opSq_q_S);
case OP_SAFE_C_opSSq: return(OP_SAFE_C_op_opSSq_q_S);
+ /* tall h_safe_c_css: 31740 [also index]
+ * in lint, h_safe_c_sp: 778783, h_safe_c_qs: 133880, h_safe_c_opsq_opsq: 71292
+ * in bench h_safe_c_css: 166564, h_safe_c_opsq_s: 28204
+ * snd-test h_safe_c_aa: 145588
+ * thash h_safe_c_s_opssq: 1111111, h_safe_c_s_opcq: 4444444
+ * tgen h_safe_c_aa: 55780, h_safe_c_s_opsq: 26460
+ */
}
return(OP_SAFE_C_ZS);
case E_C_PC:
switch (op2)
{
+ 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:
+ return(OP_SAFE_C_opSq_C);
case OP_SAFE_C_C: return(OP_SAFE_C_opCq_C);
- case OP_SAFE_C_S: return(OP_SAFE_C_opSq_C);
case OP_SAFE_C_CS: return(OP_SAFE_C_opCSq_C);
case OP_SAFE_C_SS: return(OP_SAFE_C_opSSq_C);
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);
+ /* lint h_safe_c_opsq_s: 224666, h_safe_c_ssc: 188152
+ */
}
return(OP_SAFE_C_ZC);
@@ -53043,7 +57096,8 @@ static int combine_ops(s7_scheme *sc, combine_op_t op1, s7_pointer e1, s7_pointe
set_opt_pair1(cdr(e1), cdr(e2));
return(OP_SAFE_C_C_opCq);
- case OP_SAFE_C_S:
+ 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:
set_opt_sym1(cdr(e1), cadr(e2));
return(OP_SAFE_C_C_opSq);
@@ -53064,17 +57118,24 @@ static int combine_ops(s7_scheme *sc, combine_op_t op1, s7_pointer e1, s7_pointe
case OP_SAFE_C_S_opCq:
return(OP_SAFE_C_C_op_S_opCqq);
+ /* tall h_safe_c_sss: 26461
+ * lint h_safe_c_scc: 106206, h_safe_c_scc: 111182
+ */
}
return(OP_SAFE_C_CZ);
case E_C_PP:
switch (op2)
{
- case OP_SAFE_C_S:
- if (optimize_op_match(e1, OP_SAFE_C_S))
+
+ 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))
return(OP_SAFE_C_opSq_opSq);
if (optimize_op_match(e1, OP_SAFE_C_SS))
return(OP_SAFE_C_opSSq_opSq);
+ if (optimize_op_match(e1, OP_SAFE_C_C))
+ return(OP_SAFE_C_opCq_opSq);
break;
case OP_SAFE_C_C:
@@ -53082,6 +57143,8 @@ static int combine_ops(s7_scheme *sc, combine_op_t op1, s7_pointer e1, s7_pointe
return(OP_SAFE_C_opCq_opCq);
if (optimize_op_match(e1, OP_SAFE_C_SS))
return(OP_SAFE_C_opSSq_opCq);
+ if (optimize_op_match(e1, OP_SAFE_C_S))
+ return(OP_SAFE_C_opSq_opCq);
break;
case OP_SAFE_C_SC:
@@ -53094,9 +57157,11 @@ static int combine_ops(s7_scheme *sc, combine_op_t op1, s7_pointer e1, s7_pointe
return(OP_SAFE_C_opCq_opSSq);
if (optimize_op_match(e1, OP_SAFE_C_SS))
return(OP_SAFE_C_opSSq_opSSq);
- if (optimize_op_match(e1, OP_SAFE_C_S))
+ if (is_safe_c_s(e1))
return(OP_SAFE_C_opSq_opSSq);
break;
+ /* qs sq opcq opsq a */
+
}
return(OP_SAFE_C_ZZ);
@@ -53106,18 +57171,17 @@ static int combine_ops(s7_scheme *sc, combine_op_t op1, s7_pointer e1, s7_pointe
return(OP_NO_OP);
}
-
static void annotate_args(s7_scheme *sc, s7_pointer args, s7_pointer e)
{
s7_pointer p;
for (p = args; is_pair(p); p = cdr(p))
- set_c_call(p, all_x_eval(sc, car(p), e, (s7_is_list(sc, e)) ? pair_symbol_is_safe : let_symbol_is_safe));
+ set_x_call(p, all_x_eval(sc, p, e, (s7_is_list(sc, e)) ? pair_symbol_is_safe : let_symbol_is_safe));
}
static void annotate_arg(s7_scheme *sc, s7_pointer arg, s7_pointer e)
{
/* if sc->envir is sc->nil, we're at the top-level, but the global_slot check should suffice for that */
- set_c_call(arg, all_x_eval(sc, car(arg), e, (s7_is_list(sc, e)) ? pair_symbol_is_safe : let_symbol_is_safe));
+ set_x_call(arg, all_x_eval(sc, arg, e, (s7_is_list(sc, e)) ? pair_symbol_is_safe : let_symbol_is_safe));
}
@@ -53133,11 +57197,11 @@ static void opt_generator(s7_scheme *sc, s7_pointer func, s7_pointer expr, int h
(is_optimized(car(body))) &&
(optimize_op(car(body)) == HOP_SAFE_C_SQS) &&
(caadr(body) == sc->with_let_symbol) &&
- (is_symbol(cadr(cadr(body)))))
+ (is_symbol(cadadr(body))))
{
s7_pointer args;
args = closure_args(func);
- if ((cadr(cadr(body)) == car(args)) &&
+ if ((cadadr(body) == car(args)) &&
(is_pair(cdr(args))) &&
(is_pair(cadr(args))) &&
(cadddr(car(body)) == caadr(closure_args(func))))
@@ -53158,16 +57222,56 @@ static bool is_lambda(s7_scheme *sc, s7_pointer sym)
}
-static bool optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop, int pairs, int symbols, int quotes, int bad_pairs, s7_pointer e)
+static opt_t optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop, int pairs, int symbols, int quotes, int bad_pairs, s7_pointer e)
{
s7_pointer arg1;
/* very often, expr is already optimized */
+ /* fprintf(stderr, "opt 1: %s\n", DISPLAY_80(expr)); */
arg1 = cadr(expr);
- if ((pairs == 0) &&
+ if ((bad_pairs == 0) &&
(is_immutable_symbol(car(expr))))
hop = 1;
+ if ((symbols == 1) &&
+ (!is_keyword(arg1)) &&
+ (!pair_symbol_is_safe(sc, arg1, e)) &&
+ (!is_slot(find_symbol(sc, arg1))))
+ {
+ /* wrap the bad arg in a check symbol lookup */
+ if (s7_is_aritable(sc, func, 1))
+ {
+ set_x_call_direct(cdr(expr), all_x_unsafe_s); /* was set_c_call 21-May-17 */
+ set_arglist_length(expr, small_int(1));
+ if (is_c_function(func))
+ {
+ set_safe_optimize_op(expr, hop + ((is_safe_procedure(func)) ? OP_SAFE_C_A : OP_C_A));
+ clear_overlay(expr);
+ set_c_function(expr, func);
+ return(OPT_T);
+ }
+ if ((is_closure(func)) &&
+ (!arglist_has_rest(sc, closure_args(func))))
+ {
+ set_unsafely_optimized(expr);
+ /* fprintf(stderr, "%d: %s %d\n", __LINE__, DISPLAY(func), is_local_symbol(expr)); */
+ set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_A : OP_CLOSURE_A));
+ set_opt_lambda(expr, func);
+ return(OPT_F);
+ }
+ if ((is_closure_star(func)) &&
+ (has_simple_arg_defaults(closure_body(func))) &&
+ (closure_star_arity_to_int(sc, func) >= 1) &&
+ (!arglist_has_rest(sc, closure_args(func))))
+ {
+ set_unsafely_optimized(expr);
+ set_optimize_op(expr, ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_STAR_A : OP_CLOSURE_STAR_A));
+ set_opt_lambda(expr, func);
+ }
+ }
+ return(OPT_F);
+ }
+
if (((is_c_function(func)) &&
(c_function_required_args(func) <= 1) &&
(c_function_all_args(func) >= 1)) ||
@@ -53176,38 +57280,50 @@ static bool optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fun
{
bool func_is_safe;
func_is_safe = is_safe_procedure(func);
+
if (pairs == 0)
{
if (func_is_safe) /* safe c function */
{
- set_safe_optimize_op(expr, hop + ((symbols == 0) ? OP_SAFE_C_C : OP_SAFE_C_S));
- /* we can't simply check is_global here to forego symbol value lookup later because we aren't
- * tracking local vars, so the global bit may be on right now, but won't be when
- * this code is evaluated. But memq(sym, e) would catch such cases.
- * I think it has already been checked for func, so we only need to look for arg1.
- * But global symbols are rare, and I don't see a huge savings in the lookup time --
- * in callgrind it's about 7/lookup in both cases.
- */
+ set_safe_optimize_op(expr, hop + ((symbols == 0) ? OP_SAFE_C_C : ((is_local_symbol(cdr(expr))) ? OP_SAFE_C_L : OP_SAFE_C_S)));
choose_c_function(sc, expr, func, 1);
- return(true);
+
+ /* these are border-line useless -- lint uses cxr_s */
+ if (symbols == 1)
+ {
+ if (c_call(expr) == g_car)
+ add_optimizer_fixup(sc, expr, (unsigned int)(hop + OP_SAFE_CAR_S));
+ if (c_call(expr) == g_cdr)
+ add_optimizer_fixup(sc, expr, (unsigned int)(hop + OP_SAFE_CDR_S));
+ if (c_call(expr) == g_cadr)
+ add_optimizer_fixup(sc, expr, (unsigned int)(hop + OP_SAFE_CADR_S));
+ if (c_call(expr) == g_is_pair)
+ add_optimizer_fixup(sc, expr, (unsigned int)(hop + OP_SAFE_IS_PAIR_S));
+ if (c_call(expr) == g_is_null)
+ add_optimizer_fixup(sc, expr, (unsigned int)(hop + OP_SAFE_IS_NULL_S));
+ if (c_call(expr) == g_is_symbol)
+ add_optimizer_fixup(sc, expr, (unsigned int)(hop + OP_SAFE_IS_SYMBOL_S));
+ }
+ return(OPT_T);
}
else /* c function is not safe */
{
- set_unsafely_optimized(expr);
if (symbols == 0)
{
+ set_unsafely_optimized(expr);
set_optimize_op(expr, hop + OP_C_A);
annotate_arg(sc, cdr(expr), e);
set_arglist_length(expr, small_int(1));
}
else
{
+ set_unsafely_optimized(expr);
if (c_function_call(func) == g_read)
set_optimize_op(expr, hop + OP_READ_S);
else set_optimize_op(expr, hop + OP_C_S);
}
choose_c_function(sc, expr, func, 1);
- return(false);
+ return(OPT_F);
}
}
else /* pairs == 1 */
@@ -53237,7 +57353,7 @@ static bool optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fun
}
}
choose_c_function(sc, expr, func, 1);
- return(true);
+ return(OPT_T);
}
if (is_all_x_op(optimize_op(arg1)))
{
@@ -53245,24 +57361,24 @@ static bool optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fun
annotate_arg(sc, cdr(expr), e);
set_arglist_length(expr, small_int(1));
choose_c_function(sc, expr, func, 1);
- return(false);
+ return(OPT_F);
}
}
else /* bad_pairs == 1 */
{
if (quotes == 1)
{
- if (func_is_safe)
- {
- set_safe_optimize_op(expr, hop + OP_SAFE_C_Q);
- choose_c_function(sc, expr, func, 1);
- return(true);
- }
- set_unsafe_optimize_op(expr, hop + OP_C_A);
annotate_arg(sc, cdr(expr), e);
set_arglist_length(expr, small_int(1));
+ if (func_is_safe)
+ {
+ set_safe_optimize_op(expr, hop + OP_SAFE_C_A);
+ choose_c_function(sc, expr, func, 1);
+ return(OPT_T);
+ }
+ set_unsafe_optimize_op(expr, hop + OP_C_A);
choose_c_function(sc, expr, func, 1);
- return(false);
+ return(OPT_F);
}
else /* quotes == 0 */
{
@@ -53277,73 +57393,83 @@ static bool optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fun
{
if ((c_function_call(func) == g_call_with_exit) &&
(is_pair(cadr(lambda_expr))) &&
- (is_null(cdadr(lambda_expr))))
+ (is_null(cdadr(lambda_expr))) &&
+ (is_symbol(caadr(lambda_expr))))
{
set_unsafe_optimize_op(expr, hop + OP_CALL_WITH_EXIT);
choose_c_function(sc, expr, func, 1);
set_opt_pair2(expr, cdr(lambda_expr));
- return(false);
+ return(OPT_F);
}
}
+ set_unsafe_optimize_op(expr, hop + ((is_optimized(arg1)) ? OP_C_Z : OP_C_P));
+ choose_c_function(sc, expr, func, 1);
+ return(OPT_F);
+ }
+ else
+ {
+ set_unsafe_optimize_op(expr, hop + ((car(expr) == sc->not_symbol) ? OP_NOT_P : OP_SAFE_C_P));
+ choose_c_function(sc, expr, func, 1);
+ return(OPT_F);
}
- set_unsafe_optimize_op(expr, hop + ((is_h_optimized(arg1)) ? OP_C_Z : OP_C_P));
- choose_c_function(sc, expr, func, 1);
- return(false);
}
}
}
+
+ if (func_is_safe)
+ set_unsafe_optimize_op(expr, hop + ((is_optimized(arg1)) ? OP_SAFE_C_Z : ((car(expr) == sc->not_symbol) ? OP_NOT_P : OP_SAFE_C_P)));
+ else set_unsafe_optimize_op(expr, hop + ((is_optimized(arg1)) ? OP_C_Z : OP_C_P));
+ choose_c_function(sc, expr, func, 1);
+ return(OPT_F);
- if (!func_is_safe)
- {
- set_unsafe_optimize_op(expr, hop + ((is_h_optimized(arg1)) ? OP_C_Z : OP_C_P));
- choose_c_function(sc, expr, func, 1);
- return(false);
- }
- return(is_optimized(expr));
+ return((is_optimized(expr)) ? OPT_T : OPT_F);
}
if (is_closure(func))
{
- bool safe_case, global_case;
+ bool safe_case;
s7_pointer body;
if (closure_arity_to_int(sc, func) != 1)
- return(false);
+ return(OPT_F);
/* this is checking for dotted arglists: boolean=? for example. To optimize these calls, we need op_closure cases that
* bind the dotted name to the remaining args as a list. This does not happen enough to be worth the trouble.
*/
safe_case = is_safe_closure(func);
- global_case = is_global(car(expr));
body = closure_body(func);
+ if (is_immutable(func)) hop = 1;
if (pairs == 0)
{
- if (is_symbol(arg1))
+ if (symbols == 1)
{
if (safe_case)
{
- set_optimize_op(expr, hop + ((global_case) ? OP_SAFE_GLOSURE_S : OP_SAFE_CLOSURE_S));
+ set_optimize_op(expr, hop + OP_SAFE_CLOSURE_S);
if (is_null(cdr(body)))
{
- if ((global_case) &&
- (is_optimized(car(body))))
- set_optimize_op(expr, hop + OP_SAFE_GLOSURE_S_E);
+ s7_pointer bexpr;
+ bexpr = car(body);
+ if ((is_pair(bexpr)) &&
+ (is_h_safe_c_c(bexpr)))
+ set_optimize_op(expr, hop + OP_SAFE_CLOSURE_S_C);
else
{
- if ((is_pair(car(body))) &&
- (is_syntactic(caar(body))))
+ if ((!is_optimized(bexpr)) &&
+ (is_pair(bexpr)) &&
+ (is_syntactic(car(bexpr))))
{
set_optimize_op(expr, hop + OP_SAFE_CLOSURE_S_P);
- if (typesflag(car(body)) != SYNTACTIC_PAIR)
+ if (typesflag(bexpr) != SYNTACTIC_PAIR)
{
- pair_set_syntax_op(car(body), symbol_syntax_op(caar(body)));
- set_syntactic_pair(car(body));
+ pair_set_syntax_op(bexpr, symbol_syntax_op(car(bexpr)));
+ set_syntactic_pair(bexpr);
}
}
}
}
}
- else set_optimize_op(expr, hop + ((global_case) ? OP_GLOSURE_S : OP_CLOSURE_S));
+ else set_optimize_op(expr, hop + OP_CLOSURE_S);
set_opt_sym2(expr, arg1);
}
else
@@ -53353,7 +57479,8 @@ static bool optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fun
}
set_opt_lambda(expr, func);
set_unsafely_optimized(expr);
- return(false);
+ /* fprintf(stderr, "%s: %s\n", DISPLAY_80(expr), opt_names[optimize_op(expr)]); */
+ return(OPT_F);
}
else /* pairs == 1 */
{
@@ -53366,56 +57493,80 @@ static bool optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fun
annotate_arg(sc, cdr(expr), e);
set_arglist_length(expr, small_int(1));
if (safe_case)
- set_optimize_op(expr, hop + ((global_case) ? OP_SAFE_GLOSURE_A : OP_SAFE_CLOSURE_A));
- else set_optimize_op(expr, hop + ((global_case) ? OP_GLOSURE_A : OP_CLOSURE_A));
- set_opt_lambda(expr, func);
- return(false);
- }
- }
- else /* bad_pairs == 1 */
- {
- if (quotes == 1)
- {
- set_unsafe_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_Q : OP_CLOSURE_Q));
+ {
+ /* fprintf(stderr, "%d: %s %d\n", __LINE__, DISPLAY(car(expr)), is_local_symbol(expr)); */
+ set_optimize_op(expr, hop + OP_SAFE_CLOSURE_A);
+ if ((is_pair(car(body))) &&
+ (is_null(cdr(body))) &&
+ (is_h_safe_c_c(car(body))))
+ set_optimize_op(expr, hop + OP_SAFE_CLOSURE_A_C);
+ }
+ else
+ {
+ set_optimize_op(expr, hop + OP_CLOSURE_A);
+ if ((is_null(cdr(body))) &&
+ (is_pair(car(body))) &&
+ (is_syntactic(caar(body))))
+ {
+ set_optimize_op(expr, hop + OP_CLOSURE_A_P);
+ if (typesflag(car(body)) != SYNTACTIC_PAIR)
+ {
+ pair_set_syntax_op(car(body), symbol_syntax_op(caar(body)));
+ set_syntactic_pair(car(body));
+ }
+ }
+ }
set_opt_lambda(expr, func);
- return(false);
+ return(OPT_F);
}
}
- if ((quotes == 0) &&
- (global_case))
- {
- set_unsafe_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_GLOSURE_P : OP_GLOSURE_P));
- set_opt_lambda(expr, func);
- return(false);
- }
}
- if (pairs == (quotes + all_x_count(expr)))
+ if (all_x_count(sc, expr) == 1)
{
- set_unsafe_optimize_op(expr, hop + ((safe_case ? OP_SAFE_CLOSURE_A : OP_CLOSURE_A)));
+ /* fprintf(stderr, "%d: %s %d %d\n", __LINE__, DISPLAY(car(expr)), is_local_symbol(expr), safe_case); */
+ if ((safe_case) &&
+ (is_pair(car(body))) &&
+ (is_h_safe_c_c(car(body))))
+ set_optimize_op(expr, hop + OP_SAFE_CLOSURE_A_C);
+ else set_unsafe_optimize_op(expr, hop + ((safe_case ? OP_SAFE_CLOSURE_A : OP_CLOSURE_A)));
annotate_arg(sc, cdr(expr), e);
set_opt_lambda(expr, func);
set_arglist_length(expr, small_int(1));
- return(false);
+ return(OPT_F);
}
- return(is_optimized(expr));
+
+ set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_P : OP_CLOSURE_P));
+ set_opt_lambda(expr, func);
+ set_unsafely_optimized(expr);
+ /* return(OPT_F); */
+ return((is_optimized(expr)) ? OPT_T : OPT_F);
}
if (is_closure_star(func))
{
bool safe_case;
- if ((!has_simple_args(closure_body(func))) ||
+#if 0
+ fprintf(stderr, "%s: %d %d %d %d %d\n", DISPLAY(expr),
+ has_simple_arg_defaults(closure_body(func)),
+ is_null(closure_args(func)),
+ is_safe_closure(func),
+ arglist_has_rest(sc, closure_args(func)),
+ all_x_count(sc, expr));
+#endif
+ if ((!has_simple_arg_defaults(closure_body(func))) ||
(is_null(closure_args(func))))
- return(false);
+ return(OPT_F);
safe_case = is_safe_closure(func);
- if ((pairs == 0) &&
- (symbols == 1))
+ if (symbols == 1)
{
set_unsafely_optimized(expr);
+ annotate_arg(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(1));
if (safe_case)
{
- set_optimize_op(expr, hop + OP_SAFE_CLOSURE_STAR_S);
+ set_optimize_op(expr, hop + OP_SAFE_CLOSURE_STAR_A);
if (closure_star_arity_to_int(sc, func) == 2)
{
s7_pointer defarg2;
@@ -53425,46 +57576,45 @@ static bool optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fun
opt_generator(sc, func, expr, hop);
}
}
- else set_optimize_op(expr, hop + OP_CLOSURE_STAR_S);
+ else set_optimize_op(expr, hop + OP_CLOSURE_STAR_A);
set_opt_lambda(expr, func);
- set_opt_sym2(expr, arg1);
- return(false);
+ /* set_opt_sym2(expr, arg1); */
+ return(OPT_F);
}
if ((!arglist_has_rest(sc, closure_args(func))) &&
- (pairs == (quotes + all_x_count(expr))))
+ (all_x_count(sc, expr) == 1))
{
- set_unsafe_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X));
+ set_unsafe_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_STAR_A : OP_CLOSURE_STAR_A));
annotate_arg(sc, cdr(expr), e);
set_opt_lambda(expr, func);
set_arglist_length(expr, small_int(1));
- return(false);
+ return(OPT_F);
}
- return(is_optimized(expr));
+ return((is_optimized(expr)) ? OPT_T : OPT_F);
}
- if ((pairs == 0) &&
- (s7_is_vector(func)))
+ if ((s7_is_vector(func)) &&
+ (is_all_x_safe(sc, arg1)))
{
- set_safe_optimize_op(expr, hop + ((symbols == 1) ? OP_VECTOR_S : OP_VECTOR_C));
- set_opt_vector(expr, func);
- return(true);
+ set_unsafe_optimize_op(expr, hop + OP_VECTOR_A);
+ annotate_arg(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(1));
+ return(OPT_T);
}
/* unknown_* is set later */
- return(is_optimized(expr));
+ return((is_optimized(expr)) ? OPT_T : OPT_F);
}
-static bool rdirect_memq(s7_scheme *sc, s7_pointer symbol, s7_pointer symbols)
+static bool let_memq(s7_scheme *sc, s7_pointer symbol, s7_pointer symbols)
{
s7_pointer x;
+ /* fprintf(stderr, "%s in %s\n", DISPLAY(symbol), DISPLAY(symbols)); */
for (x = symbols; is_pair(x); x = cdr(x))
{
if (car(x) == symbol)
return(true);
- x = cdr(x);
- if (car(x) == symbol) /* car(nil)=unspec, cdr(unspec)=unspec! This only works for lists known to be undotted and non-circular */
- return(true);
}
return(false);
}
@@ -53474,8 +57624,12 @@ static s7_pointer find_uncomplicated_symbol(s7_scheme *sc, s7_pointer symbol, s7
s7_pointer x;
long long int id;
- if ((symbol_tag(symbol) == sc->syms_tag) &&
- (rdirect_memq(sc, symbol, e))) /* it's probably a local variable reference */
+ if ((symbol_is_in_list(sc, symbol)) &&
+ (let_memq(sc, symbol, e))) /* it's probably a local variable reference */
+ return(sc->nil);
+
+ if ((has_keyword(symbol)) &&
+ (symbol_is_in_list(sc, s7_make_keyword(sc, symbol_name(symbol)))))
return(sc->nil);
if (is_global(symbol))
@@ -53504,7 +57658,7 @@ static bool unsafe_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer arg1, s7_p
if (!arg3) return(true);
f = arg3;
if (!is_symbol(f)) return(false);
- f = find_uncomplicated_symbol(sc, f, e); /* form_is_safe -- how to catch local c-funcs here? */
+ f = find_uncomplicated_symbol(sc, f, e); /* how to catch local c-funcs here? */
if (is_slot(f))
{
f = slot_value(f);
@@ -53514,16 +57668,61 @@ static bool unsafe_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer arg1, s7_p
return(false);
}
-static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop, int pairs, int symbols, int quotes, int bad_pairs, s7_pointer e)
+static void check_lambda(s7_scheme *sc);
+
+static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop, int pairs, int symbols, int quotes, int bad_pairs, s7_pointer e)
{
s7_pointer arg1, arg2;
arg1 = cadr(expr);
arg2 = caddr(expr);
- if ((pairs == 0) &&
+ if ((bad_pairs == 0) &&
(is_immutable_symbol(car(expr))))
hop = 1;
+ if (((is_symbol(arg1)) &&
+ (!pair_symbol_is_safe(sc, arg1, e)) &&
+ (!is_slot(find_symbol(sc, arg1)))) ||
+ ((is_symbol(arg2)) &&
+ (!pair_symbol_is_safe(sc, arg2, e)) &&
+ (!is_slot(find_symbol(sc, arg2)))))
+ {
+ /* wrap bad args */
+ if ((is_all_x_safe(sc, arg1)) &&
+ (is_all_x_safe(sc, arg2)) &&
+ (s7_is_aritable(sc, func, 2)))
+ {
+ annotate_args(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(2));
+ if (is_c_function(func))
+ {
+ set_safe_optimize_op(expr, hop + ((is_safe_procedure(func)) ? OP_SAFE_C_AA : OP_C_AA));
+ set_c_function(expr, func);
+ return(OPT_T);
+ }
+ if ((is_closure(func)) &&
+ (!arglist_has_rest(sc, closure_args(func))))
+ {
+ set_unsafely_optimized(expr);
+ set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_AA : OP_CLOSURE_AA));
+ set_opt_lambda(expr, func);
+ return(OPT_F);
+ }
+ if ((is_closure_star(func)) &&
+ (has_simple_arg_defaults(closure_body(func))) &&
+ (!arglist_has_rest(sc, closure_args(func))))
+ {
+ set_unsafely_optimized(expr);
+ if (closure_star_arity_to_int(sc, func) == 2)
+ set_optimize_op(expr, ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_STAR_AA : OP_CLOSURE_STAR_AA));
+ else set_optimize_op(expr, ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X));
+ set_opt_lambda(expr, func);
+ }
+ }
+ return(OPT_F);
+ }
+ /* end of bad symbol wrappers */
+
if ((is_c_function(func) &&
(c_function_required_args(func) <= 2) &&
(c_function_all_args(func) >= 2)) ||
@@ -53536,22 +57735,20 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
func_is_safe = is_safe_procedure(func);
if (pairs == 0)
{
- if ((func_is_safe) ||
- ((is_possibly_safe(func)) &&
- (unsafe_is_safe(sc, func, arg1, arg2, NULL, e))))
+ if ((func_is_safe) || (is_maybe_safe(func)))
{
/* another case here: set-car! and set-cdr! are safe if symbols==1 and arg1 is the symbol (i.e. arg2 is a constant) */
if (symbols == 0)
set_optimize_op(expr, hop + OP_SAFE_C_C);
else
{
- if (symbols == 2)
- set_optimize_op(expr, hop + OP_SAFE_C_SS); /* these two symbols are almost never the same, (sqrt (+ (* x x) (* y y))) */
+ if (symbols == 2) /* these two symbols are almost never the same, (sqrt (+ (* x x) (* y y))) */
+ set_optimize_op(expr, hop + OP_SAFE_C_SS);
else set_optimize_op(expr, hop + ((is_symbol(arg1)) ? OP_SAFE_C_SC : OP_SAFE_C_CS));
}
set_optimized(expr);
choose_c_function(sc, expr, func, 2);
- return(true);
+ return(OPT_T);
}
set_unsafely_optimized(expr);
if (symbols == 2)
@@ -53559,7 +57756,7 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
if (c_function_call(func) == g_apply)
{
set_optimize_op(expr, hop + OP_APPLY_SS);
- set_opt_cfunc(expr, func);
+ set_opt_cfunc(expr, func); /* not quite set_c_function */
set_opt_sym2(expr, arg2);
}
else
@@ -53570,15 +57767,15 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
}
else
{
- set_optimize_op(expr, hop + OP_C_ALL_X);
+ set_optimize_op(expr, hop + OP_C_AA);
annotate_args(sc, cdr(expr), e);
set_arglist_length(expr, small_int(2));
choose_c_function(sc, expr, func, 2);
if (is_safe_procedure(opt_cfunc(expr)))
{
clear_unsafe(expr);
- set_optimized(expr);
/* symbols can be 0..2 here, no pairs */
+ set_optimized(expr);
if (symbols == 1)
{
if (is_symbol(arg1))
@@ -53591,19 +57788,17 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
set_optimize_op(expr, hop + OP_SAFE_C_SS);
else set_optimize_op(expr, hop + OP_SAFE_C_C);
}
- return(true);
+ return(OPT_T);
}
}
- return(false);
+ return(OPT_F);
}
/* pairs != 0 */
if ((bad_pairs == 0) &&
(pairs == 2))
{
- if ((func_is_safe) ||
- ((is_possibly_safe(func)) &&
- (unsafe_is_safe(sc, func, arg1, arg2, NULL, e))))
+ if ((func_is_safe) || (is_maybe_safe(func)))
{
int op;
op = combine_ops(sc, E_C_PP, arg1, arg2);
@@ -53650,16 +57845,14 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
}
}
choose_c_function(sc, expr, func, 2); /* this might change the op to safe_c_c, so it has to be last */
- return(true);
+ return(OPT_T);
}
}
if ((bad_pairs == 0) &&
(pairs == 1))
{
- if ((func_is_safe) ||
- ((is_possibly_safe(func)) &&
- (unsafe_is_safe(sc, func, arg1, arg2, NULL, e))))
+ if ((func_is_safe) || (is_maybe_safe(func)))
{
combine_op_t orig_op;
int op;
@@ -53681,10 +57874,20 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
if (!hop) clear_hop(arg2);
}
- set_safe_optimize_op(expr, hop + op);
+ if ((((op == OP_SAFE_C_SZ) || (op == OP_SAFE_C_CZ)) &&
+ (is_all_x_op(optimize_op(arg2)))) ||
+ (((op == OP_SAFE_C_ZS) || (op == OP_SAFE_C_ZC)) &&
+ (is_all_x_op(optimize_op(arg1)))))
+ {
+ set_safe_optimize_op(expr, hop + OP_SAFE_C_AA);
+ annotate_arg(sc, cdr(expr), e);
+ annotate_arg(sc, cddr(expr), e);
+ }
+ else set_safe_optimize_op(expr, hop + op);
choose_c_function(sc, expr, func, 2);
- return(true);
+ return(OPT_T);
}
+
if (symbols == 1)
{
if (is_symbol(arg1))
@@ -53694,14 +57897,14 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
set_unsafe_optimize_op(expr, hop + OP_C_S_opSq);
set_opt_sym1(cdr(expr), cadr(arg2));
choose_c_function(sc, expr, func, 2);
- return(false);
+ return(OPT_F);
}
if (optimize_op_match(arg2, OP_SAFE_C_C))
{
set_unsafe_optimize_op(expr, hop + OP_C_S_opCq);
set_opt_pair1(cdr(expr), cdr(arg2));
choose_c_function(sc, expr, func, 2);
- return(false);
+ return(OPT_F);
}
}
}
@@ -53709,9 +57912,7 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
if ((bad_pairs == 1) && (quotes == 1))
{
- if ((func_is_safe) ||
- ((is_possibly_safe(func)) &&
- (unsafe_is_safe(sc, func, arg1, arg2, NULL, e))))
+ if ((func_is_safe) || (is_maybe_safe(func)))
{
if (symbols == 1)
{
@@ -53720,20 +57921,19 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
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(true);
+ return(OPT_T);
}
else
{
if (pairs == 1)
{
- /* Q must be 1, symbols = 0, pairs = 1 (the quote), so this must be CQ or QC?
- */
+ /* Q must be 1, symbols = 0, pairs = 1 (the quote), so this must be CQ or QC? */
set_optimized(expr);
if (is_pair(arg1))
set_optimize_op(expr, hop + OP_SAFE_C_QC);
else set_optimize_op(expr, hop + OP_SAFE_C_CQ);
choose_c_function(sc, expr, func, 2);
- return(true);
+ return(OPT_T);
}
}
}
@@ -53741,44 +57941,40 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
{
if (pairs == 1)
{
- set_unsafe_optimize_op(expr, hop + OP_C_ALL_X);
+ set_unsafe_optimize_op(expr, hop + OP_C_AA);
annotate_args(sc, cdr(expr), e);
set_arglist_length(expr, small_int(2));
choose_c_function(sc, expr, func, 2);
- return(false);
+ return(OPT_F);
}
}
}
if (quotes == 2)
{
- if ((func_is_safe) ||
- ((is_possibly_safe(func)) &&
- (unsafe_is_safe(sc, func, arg1, arg2, NULL, e))))
+ if ((func_is_safe) || (is_maybe_safe(func)))
{
set_safe_optimize_op(expr, hop + OP_SAFE_C_QQ);
choose_c_function(sc, expr, func, 2);
- return(true);
+ return(OPT_T);
}
- set_unsafe_optimize_op(expr, hop + OP_C_ALL_X);
+ set_unsafe_optimize_op(expr, hop + OP_C_AA);
annotate_args(sc, cdr(expr), e);
set_arglist_length(expr, small_int(2));
choose_c_function(sc, expr, func, 2);
- return(false);
+ return(OPT_F);
}
if ((pairs == 1) &&
(quotes == 0) &&
- ((func_is_safe) ||
- ((is_possibly_safe(func)) &&
- (unsafe_is_safe(sc, func, arg1, arg2, NULL, e)))))
+ ((func_is_safe) || (is_maybe_safe(func))))
{
if (symbols == 1)
{
set_optimized(expr);
if (is_symbol(arg1))
{
- if ((bad_pairs == 0) || (is_h_optimized(arg2))) /* bad_pair && h_optimized happens a lot */
+ if ((bad_pairs == 0) || (is_optimized(arg2))) /* bad_pair && h_optimized happens a lot */
{
set_optimize_op(expr, hop + OP_SAFE_C_SZ);
choose_c_function(sc, expr, func, 2);
@@ -53786,20 +57982,20 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
* some like add_ss_1ss use opt1(cdr(...)) which is safe here I think because cadr is a symbol
* it's used in the choosers to detect e.g. temp funcs
*/
- return(true);
+ return(OPT_T);
}
set_unsafe(expr);
set_optimize_op(expr, hop + OP_SAFE_C_SP);
choose_c_function(sc, expr, func, 2);
- return(false);
+ return(OPT_F);
}
/* arg2 is a symbol */
- if ((bad_pairs == 0) || (is_h_optimized(arg1)))
+ if ((bad_pairs == 0) || (is_optimized(arg1)))
{
set_optimize_op(expr, hop + OP_SAFE_C_ZS);
choose_c_function(sc, expr, func, 2);
- return(true);
+ return(OPT_T);
}
/* unknowns get here: (* amp (amps 0))
* also list: (make-polywave pitch (list 1 0.93 2 0.07))
@@ -53808,50 +58004,48 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
set_unsafe(expr);
set_optimize_op(expr, hop + OP_SAFE_C_PS);
choose_c_function(sc, expr, func, 2);
- return(false);
+ return(OPT_F);
}
if (symbols == 0)
{
set_optimized(expr);
if (is_pair(arg1))
{
- if ((bad_pairs == 0) || (is_h_optimized(arg2)))
+ if ((bad_pairs == 0) || (is_optimized(arg2)))
{
set_optimize_op(expr, hop + OP_SAFE_C_ZC);
choose_c_function(sc, expr, func, 2);
- return(true);
+ return(OPT_T);
}
else
{
set_unsafe(expr);
set_optimize_op(expr, hop + OP_SAFE_C_PC);
choose_c_function(sc, expr, func, 2);
- return(false);
+ return(OPT_F);
}
}
else
{
- if ((bad_pairs == 0) || (is_h_optimized(arg1)))
+ if ((bad_pairs == 0) || (is_optimized(arg1)))
{
set_optimize_op(expr, hop + OP_SAFE_C_CZ);
choose_c_function(sc, expr, func, 2);
- return(true);
+ return(OPT_T);
}
else
{
set_unsafe(expr);
set_optimize_op(expr, hop + OP_SAFE_C_CP);
choose_c_function(sc, expr, func, 2);
- return(false);
+ return(OPT_F);
}
}
}
}
if ((pairs == 2) &&
- ((func_is_safe) ||
- ((is_possibly_safe(func)) &&
- (unsafe_is_safe(sc, func, arg1, arg2, NULL, e)))))
+ ((func_is_safe) || (is_maybe_safe(func))))
{
if ((bad_pairs == 1) &&
(is_safe_c_s(arg1)))
@@ -53861,13 +58055,17 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
*/
if (car(arg2) == sc->quote_symbol)
{
+ if (!is_pair(cdr(arg2)))
+ return(OPT_OOPS);
set_safe_optimize_op(expr, hop + OP_SAFE_C_opSq_Q);
+ set_opt_con1(cdr(expr), cadadr(expr));
+ set_opt_con2(cdr(expr), cadr(caddr(expr)));
choose_c_function(sc, expr, func, 2);
- return(true);
+ return(OPT_T);
}
set_unsafe_optimize_op(expr, hop + OP_SAFE_C_opSq_P);
choose_c_function(sc, expr, func, 2);
- return(false);
+ return(OPT_F);
}
else
{
@@ -53876,12 +58074,12 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
set_unsafely_optimized(expr);
if (is_all_x_safe(sc, arg1))
{
- set_optimize_op(expr, hop + ((is_h_optimized(arg2)) ? OP_SAFE_C_AZ : OP_SAFE_C_AP));
+ set_optimize_op(expr, hop + ((is_optimized(arg2)) ? OP_SAFE_C_AZ : OP_SAFE_C_AP));
annotate_arg(sc, cdr(expr), e);
}
else set_optimize_op(expr, hop + OP_SAFE_C_PP);
choose_c_function(sc, expr, func, 2);
- return(false);
+ return(OPT_F);
}
else
{
@@ -53889,10 +58087,10 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
{
if (car(arg1) == sc->quote_symbol)
set_optimize_op(expr, hop + OP_SAFE_C_QP);
- else set_optimize_op(expr, hop + OP_SAFE_C_PQ);
+ else set_optimize_op(expr, hop + ((is_optimized(arg1)) ? OP_SAFE_C_ZQ : OP_SAFE_C_PQ));
set_unsafely_optimized(expr);
choose_c_function(sc, expr, func, 2);
- return(false);
+ return(OPT_F);
}
}
}
@@ -53900,13 +58098,13 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
if (func_is_safe)
{
- if (pairs == (quotes + all_x_count(expr)))
+ if (all_x_count(sc, expr) == 2)
{
set_safe_optimize_op(expr, hop + OP_SAFE_C_AA);
annotate_args(sc, cdr(expr), e);
set_arglist_length(expr, small_int(2));
choose_c_function(sc, expr, func, 2);
- return(true);
+ return(OPT_T);
}
}
@@ -53914,19 +58112,55 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
(symbols == 1) &&
(quotes == 0) &&
(!func_is_safe) &&
- (is_symbol(arg1)))
+ /* (is_symbol(arg1)) */
+ ((!is_pair(arg1)) ||
+ ((is_optimized(arg1)) &&
+ (is_all_x_op(optimize_op(arg1))))))
{
- set_unsafe_optimize_op(expr, hop + ((is_h_optimized(arg2)) ? OP_C_SZ : OP_C_SP));
+ annotate_arg(sc, cdr(expr), e);
+ set_unsafe_optimize_op(expr, hop + OP_C_AP);
choose_c_function(sc, expr, func, 2);
- return(false);
+ return(OPT_F);
}
- return(is_optimized(expr));
+
+ if ((!func_is_safe) &&
+ ((!is_pair(arg2)) ||
+ ((is_optimized(arg2)) &&
+ (is_all_x_op(optimize_op(arg2))))))
+ {
+ if ((is_pair(arg1)) &&
+ (car(arg1) == sc->lambda_symbol))
+ {
+ s7_pointer code;
+ 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));
+ check_lambda(sc);
+ sc->code = code;
+ choose_c_function(sc, expr, func, 2);
+ return(OPT_F);
+ }
+
+ if ((!is_pair(arg1)) ||
+ ((is_optimized(arg1)) &&
+ (is_all_x_op(optimize_op(arg1)))))
+ {
+ set_unsafe_optimize_op(expr, hop + OP_C_AA);
+ annotate_args(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(2));
+ choose_c_function(sc, expr, func, 2);
+ return(OPT_F);
+ }
+ }
+ return((is_optimized(expr)) ? OPT_T : OPT_F);
}
if (is_closure(func))
{
if (closure_arity_to_int(sc, func) != 2)
- return(false);
+ return(OPT_F);
+ if (is_immutable(func)) hop = 1;
if ((pairs == 0) &&
(symbols >= 1))
@@ -53934,7 +58168,7 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
set_unsafely_optimized(expr);
if (symbols == 2)
{
- set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_SS : OP_CLOSURE_SS));
+ 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)));
set_opt_sym2(expr, arg2);
}
else
@@ -53951,11 +58185,11 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
}
}
set_opt_lambda(expr, func);
- return(false);
+ return(OPT_F);
}
-
+
if ((!arglist_has_rest(sc, closure_args(func))) &&
- (pairs == (quotes + all_x_count(expr))))
+ (all_x_count(sc, expr) == 2))
{
set_unsafely_optimized(expr);
if (is_safe_closure(func))
@@ -53968,73 +58202,127 @@ static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer fu
annotate_args(sc, cdr(expr), e);
set_opt_lambda(expr, func);
set_arglist_length(expr, small_int(2));
- return(false);
+ return(OPT_F);
+ }
+
+ if (is_all_x_safe(sc, arg1))
+ {
+ set_unsafely_optimized(expr);
+ annotate_arg(sc, cdr(expr), e);
+ set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_AP : OP_CLOSURE_AP));
+ set_opt_lambda(expr, func);
+ return(OPT_F);
}
- return(is_optimized(expr));
- }
- if (is_closure_star(func))
- {
- if (((!has_simple_args(closure_body(func))) ||
- (closure_star_arity_to_int(sc, func) < 2) ||
- (arglist_has_keyword(cdr(expr)))))
- return(false);
+ if ((is_pair(arg1)) &&
+ (car(arg1) == sc->lambda_symbol) &&
+ ((!is_pair(arg2)) ||
+ ((is_optimized(arg2)) &&
+ (is_all_x_op(optimize_op(arg2))))) &&
+ (is_null(cdr(closure_body(func)))))
+ {
+ s7_pointer code;
+ annotate_arg(sc, cddr(expr), e);
+ set_unsafe_optimize_op(expr, hop + OP_CLOSURE_FA);
+ code = sc->code;
+ sc->code = cdr(cadr(expr));
+ check_lambda(sc);
+ clear_safe_closure(cdr(sc->code)); /* otherwise we need to fixup the local let for the optimizer */
+ sc->code = code;
+ set_opt_lambda(expr, func);
+ return(OPT_F);
+ }
- if ((pairs == 0) &&
- (symbols >= 1) &&
- (is_symbol(arg1)))
+ if (is_all_x_safe(sc, arg2))
{
set_unsafely_optimized(expr);
- if (symbols == 2)
- {
- set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_STAR_SS : OP_CLOSURE_STAR_SX));
- set_opt_sym2(expr, arg2);
- }
- else
- {
- if (is_safe_closure(func))
- {
- set_optimize_op(expr, hop + OP_SAFE_CLOSURE_STAR_SC);
- set_opt_con2(expr, arg2);
- if (arg2 == real_zero)
- opt_generator(sc, func, expr, hop);
- }
- else set_optimize_op(expr, hop + OP_CLOSURE_STAR_SX);
- }
+ annotate_arg(sc, cddr(expr), e);
+ set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_PA : OP_CLOSURE_PA));
set_opt_lambda(expr, func);
- return(false);
+ return(OPT_F);
}
+ return((is_optimized(expr)) ? OPT_T : OPT_F);
+ }
+
+ if (is_closure_star(func))
+ {
+ if (!has_simple_arg_defaults(closure_body(func)))
+ return(OPT_F);
+
if ((!arglist_has_rest(sc, closure_args(func))) &&
- (pairs == (quotes + all_x_count(expr))))
+ (all_x_count(sc, expr) == 2))
{
set_unsafely_optimized(expr);
- if (is_safe_closure(func))
- {
- if ((is_symbol(arg1)) &&
- (closure_star_arity_to_int(sc, func) == 2))
- set_optimize_op(expr, hop + OP_SAFE_CLOSURE_STAR_SA);
- else set_optimize_op(expr, hop + OP_SAFE_CLOSURE_STAR_ALL_X);
- }
- else set_optimize_op(expr, hop + OP_CLOSURE_STAR_ALL_X);
+ if (closure_star_arity_to_int(sc, func) == 2)
+ set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_STAR_AA : OP_CLOSURE_STAR_AA));
+ else set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X));
annotate_args(sc, cdr(expr), e);
set_opt_lambda(expr, func);
set_arglist_length(expr, small_int(2));
- return(false);
+ return(OPT_F);
}
}
- return(is_optimized(expr));
+ return((is_optimized(expr)) ? OPT_T : OPT_F);
}
-static bool optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop, int pairs, int symbols, int quotes, int bad_pairs, s7_pointer e)
+static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop, int pairs, int symbols, int quotes, int bad_pairs, s7_pointer e)
{
s7_pointer arg1, arg2, arg3;
arg1 = cadr(expr);
arg2 = caddr(expr);
arg3 = cadddr(expr);
- if ((pairs == 0) &&
+
+ if (((is_symbol(arg1)) &&
+ (!pair_symbol_is_safe(sc, arg1, e)) &&
+ (!is_slot(find_symbol(sc, arg1)))) ||
+ ((is_symbol(arg2)) &&
+ (!pair_symbol_is_safe(sc, arg2, e)) &&
+ (!is_slot(find_symbol(sc, arg2)))) ||
+ ((is_symbol(arg3)) &&
+ (!pair_symbol_is_safe(sc, arg3, e)) &&
+ (!is_slot(find_symbol(sc, arg3)))))
+ {
+ /* wrap bad args */
+ if ((is_all_x_safe(sc, arg1)) &&
+ (is_all_x_safe(sc, arg2)) &&
+ (is_all_x_safe(sc, arg3)) &&
+ (s7_is_aritable(sc, func, 3)))
+ {
+ annotate_args(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(3));
+ if (is_c_function(func))
+ {
+ set_safe_optimize_op(expr, hop + ((is_safe_procedure(func)) ? OP_SAFE_C_AAA : OP_C_ALL_X));
+ set_c_function(expr, func);
+ return(OPT_T);
+ }
+ if ((is_closure(func)) &&
+ (closure_arity_to_int(sc, func) == 3) &&
+ (!arglist_has_rest(sc, closure_args(func))))
+ {
+ set_unsafely_optimized(expr);
+ set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_ALL_X : OP_CLOSURE_ALL_X));
+ set_opt_lambda(expr, func);
+ return(OPT_F);
+ }
+ if ((is_closure_star(func)) &&
+ (has_simple_arg_defaults(closure_body(func))) &&
+ (closure_star_arity_to_int(sc, func) >= 3) &&
+ (!arglist_has_rest(sc, closure_args(func))))
+ {
+ set_unsafely_optimized(expr);
+ set_optimize_op(expr, ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X));
+ set_opt_lambda(expr, func);
+ }
+ }
+ return(OPT_F);
+ }
+ /* end of bad symbol wrappers */
+
+ if ((bad_pairs == 0) &&
(is_immutable_symbol(car(expr))))
hop = 1;
@@ -54047,7 +58335,7 @@ static bool optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
(!is_keyword(arg2))))
{
if ((is_safe_procedure(func)) ||
- ((is_possibly_safe(func)) &&
+ ((is_maybe_safe(func)) &&
(unsafe_is_safe(sc, func, arg1, arg2, arg3, e))))
{
if (pairs == 0)
@@ -54124,11 +58412,11 @@ static bool optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
}
}
choose_c_function(sc, expr, func, 3);
- return(true);
+ return(OPT_T);
}
/* pairs != 0 */
- if (pairs == quotes + all_x_count(expr))
+ if (all_x_count(sc, expr) == 3)
{
set_optimized(expr);
if (quotes == 1)
@@ -54141,17 +58429,18 @@ static bool optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
set_opt_sym2(cdr(expr), arg3);
set_optimize_op(expr, hop + OP_SAFE_C_SQS);
choose_c_function(sc, expr, func, 3);
- return(true);
+ return(OPT_T);
}
if ((symbols == 1) &&
(is_symbol(arg3)) &&
- (is_pair(arg2)) &&
- (car(arg2) == sc->quote_symbol) &&
+ (is_proper_quote(sc, arg2)) &&
(is_safe_c_s(arg1)))
{
- set_safe_optimize_op(expr, hop + OP_SAFE_C_opSq_Q_S);
+ set_safe_optimize_op(expr, hop + OP_SAFE_C_opSq_QS);
+ set_opt_con1(cdr(expr), cadr(arg2));
+ set_opt_sym2(cdr(expr), arg3);
choose_c_function(sc, expr, func, 3);
- return(true);
+ return(OPT_T);
}
}
annotate_args(sc, cdr(expr), e);
@@ -54168,12 +58457,6 @@ static bool optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
set_optimize_op(expr, hop + OP_SAFE_C_CSA);
else set_optimize_op(expr, hop + OP_SAFE_C_SCA);
}
- else
- {
- if ((is_pair(arg2)) &&
- (is_symbol(arg3)))
- set_optimize_op(expr, hop + OP_SAFE_C_CAS);
- }
}
else
{
@@ -54182,7 +58465,7 @@ static bool optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
}
}
choose_c_function(sc, expr, func, 3);
- return(true);
+ return(OPT_T);
}
if (bad_pairs == 0)
@@ -54246,7 +58529,7 @@ static bool optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
set_optimized(expr);
choose_c_function(sc, expr, func, 3);
set_arglist_length(expr, small_int(3));
- return(true);
+ return(OPT_T);
}
/* aap is not better than ssp, sap also saves very little */
@@ -54255,14 +58538,14 @@ static bool optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
(symbols == 2) &&
(is_pair(arg3)))
{
- set_unsafe_optimize_op(expr, hop + ((is_h_optimized(arg3)) ? OP_SAFE_C_SSZ : OP_SAFE_C_SSP));
+ set_unsafe_optimize_op(expr, hop + ((is_optimized(arg3)) ? OP_SAFE_C_SSZ : OP_SAFE_C_SSP));
choose_c_function(sc, expr, func, 3);
- return(false);
+ return(OPT_F);
}
}
else /* func is not safe */
{
- if (pairs == quotes + all_x_count(expr))
+ if (all_x_count(sc, expr) == 3)
{
set_optimized(expr);
if ((symbols == 2) &&
@@ -54280,9 +58563,9 @@ static bool optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
if (optimize_op(expr) != HOP_SAFE_C_C) /* did chooser fix it up? */
{
set_unsafe(expr);
- return(false);
+ return(OPT_F);
}
- return(true);
+ return(OPT_T);
}
/* (define (hi) (catch #t (lambda () 1) (lambda args 2)))
@@ -54321,25 +58604,30 @@ static bool optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
set_opt_con2(expr, cadr(error_result));
else 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))))
+ set_optimize_op(expr, hop + OP_C_CATCH_ALL_Z);
+
}
else
{
set_optimize_op(expr, hop + OP_C_CATCH);
choose_c_function(sc, expr, func, 3);
}
- return(false);
+ return(OPT_F);
}
}
}
}
- return(is_optimized(expr));
+ return((is_optimized(expr)) ? OPT_T : OPT_F);
}
/* not c func */
if (is_closure(func))
{
if (closure_arity_to_int(sc, func) != 3)
- return(false);
+ return(OPT_F);
+ if (is_immutable(func)) hop = 1;
if ((symbols == 3) &&
(!is_safe_closure(func)))
@@ -54347,11 +58635,11 @@ static bool optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
set_unsafely_optimized(expr);
set_opt_lambda(expr, func);
set_arglist_length(expr, small_int(3));
- set_optimize_op(expr, hop + OP_CLOSURE_ALL_S);
- return(false);
+ set_optimize_op(expr, hop + ((is_null(cdr(closure_body(func)))) ? OP_CLOSURE_ALL_S_P : OP_CLOSURE_ALL_S));
+ return(OPT_F);
}
- if (pairs == quotes + all_x_count(expr))
+ if (all_x_count(sc, expr) == 3)
{
if (is_safe_closure(func))
{
@@ -54364,39 +58652,52 @@ static bool optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
annotate_args(sc, cdr(expr), e);
set_opt_lambda(expr, func);
set_arglist_length(expr, small_int(3));
- return(false);
+ return(OPT_F);
}
}
if (is_closure_star(func))
{
- if ((!has_simple_args(closure_body(func))) ||
+ if ((!has_simple_arg_defaults(closure_body(func))) ||
(closure_star_arity_to_int(sc, func) < 3) ||
- (arglist_has_keyword(cdr(expr))) ||
- (arglist_has_rest(sc, closure_args(func)))) /* is this redundant? */
- return(false);
+ (arglist_has_rest(sc, closure_args(func))))
+ return(OPT_F);
- if (pairs == quotes + all_x_count(expr))
+ if (all_x_count(sc, expr) == 3)
{
set_unsafe_optimize_op(expr, hop + ((is_safe_closure(func) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X)));
annotate_args(sc, cdr(expr), e);
set_opt_lambda(expr, func);
set_arglist_length(expr, small_int(3));
- return(false);
+ return(OPT_F);
}
}
- if (bad_pairs > quotes) return(false);
- return(is_optimized(expr));
+ if (bad_pairs > quotes) return(OPT_F);
+ return((is_optimized(expr)) ? OPT_T : OPT_F);
}
+static bool symbols_are_safe(s7_scheme *sc, s7_pointer args, s7_pointer e)
+{
+ s7_pointer p;
+ for (p = args; is_pair(p); p = cdr(p))
+ {
+ s7_pointer arg;
+ arg = car(p);
+ if ((is_symbol(arg)) &&
+ (!pair_symbol_is_safe(sc, arg, e)) &&
+ (!is_slot(find_symbol(sc, arg))))
+ return(false);
+ }
+ return(true);
+}
-static bool optimize_func_many_args(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop, int args, int pairs, int symbols, int quotes, int bad_pairs, s7_pointer e)
+static opt_t optimize_func_many_args(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop, int args, int pairs, int symbols, int quotes, int bad_pairs, s7_pointer e)
{
bool func_is_closure;
- if (bad_pairs > quotes) return(false);
- if ((pairs == 0) &&
+ if (bad_pairs > quotes) return(OPT_F);
+ if ((bad_pairs == 0) &&
(is_immutable_symbol(car(expr))))
hop = 1;
@@ -54412,20 +58713,29 @@ static bool optimize_func_many_args(s7_scheme *sc, s7_pointer expr, s7_pointer f
{
set_safe_optimize_op(expr, hop + OP_SAFE_C_C);
choose_c_function(sc, expr, func, args);
- return(true);
+ return(OPT_T);
}
if ((symbols == args) &&
(args < GC_TRIGGER_SIZE))
{
- set_safe_optimize_op(expr, hop + OP_SAFE_C_ALL_S);
+ if (symbols_are_safe(sc, cdr(expr), e))
+ set_safe_optimize_op(expr, hop + OP_SAFE_C_ALL_S);
+ else
+ {
+ set_optimized(expr);
+ if (args == 4)
+ set_optimize_op(expr, hop + OP_SAFE_C_AAAA);
+ else set_optimize_op(expr, hop + OP_SAFE_C_ALL_X);
+ annotate_args(sc, cdr(expr), e);
+ }
set_arglist_length(expr, make_permanent_integer(args));
choose_c_function(sc, expr, func, args);
- return(true);
+ return(OPT_T);
}
}
if ((args < GC_TRIGGER_SIZE) &&
- (pairs == (quotes + all_x_count(expr))))
+ (all_x_count(sc, expr) == args))
{
set_optimized(expr);
if (args == 4)
@@ -54434,29 +58744,30 @@ static bool optimize_func_many_args(s7_scheme *sc, s7_pointer expr, s7_pointer f
annotate_args(sc, cdr(expr), e);
set_arglist_length(expr, make_permanent_integer(args));
choose_c_function(sc, expr, func, args);
- return(true);
+ return(OPT_T);
}
}
else /* c_func is not safe */
{
if ((args < GC_TRIGGER_SIZE) &&
- (pairs == (quotes + all_x_count(expr))))
+ (all_x_count(sc, expr) == args))
{
set_unsafe_optimize_op(expr, hop + OP_C_ALL_X);
annotate_args(sc, cdr(expr), e);
set_arglist_length(expr, make_permanent_integer(args));
choose_c_function(sc, expr, func, args);
- return(false);
+ return(OPT_F);
}
}
- return(is_optimized(expr));
+ return((is_optimized(expr)) ? OPT_T : OPT_F);
}
func_is_closure = is_closure(func);
if (func_is_closure)
{
if (closure_arity_to_int(sc, func) != args)
- return(false);
+ return(OPT_F);
+ if (is_immutable(func)) hop = 1;
if ((pairs == 0) &&
((symbols == args) || (symbols == 0)) &&
@@ -54470,24 +58781,25 @@ static bool optimize_func_many_args(s7_scheme *sc, s7_pointer expr, s7_pointer f
set_opt_lambda(expr, func);
if ((!safe_case) &&
- (symbols == args))
- set_optimize_op(expr, hop + OP_CLOSURE_ALL_S);
- return(false);
+ (symbols == args) &&
+ (symbols_are_safe(sc, cdr(expr), e)))
+ set_optimize_op(expr, hop + ((is_null(cdr(closure_body(func)))) ? OP_CLOSURE_ALL_S_P : OP_CLOSURE_ALL_S));
+
+ return(OPT_F);
}
}
if ((is_closure_star(func)) &&
- ((!has_simple_args(closure_body(func))) ||
- (closure_star_arity_to_int(sc, func) < args) ||
- (arglist_has_keyword(cdr(expr)))))
- return(false);
+ ((!has_simple_arg_defaults(closure_body(func))) ||
+ (closure_star_arity_to_int(sc, func) < args)))
+ return(OPT_F);
if (args < GC_TRIGGER_SIZE)
{
if (((func_is_closure) ||
(is_closure_star(func))) &&
(!arglist_has_rest(sc, closure_args(func))) &&
- (pairs == (quotes + all_x_count(expr))))
+ (all_x_count(sc, expr) == args))
{
set_unsafely_optimized(expr);
if (func_is_closure)
@@ -54496,50 +58808,149 @@ static bool optimize_func_many_args(s7_scheme *sc, s7_pointer expr, s7_pointer f
annotate_args(sc, cdr(expr), e);
set_arglist_length(expr, make_permanent_integer(args));
set_opt_lambda(expr, func);
- return(false);
+ return(OPT_F);
}
}
- return(is_optimized(expr));
+ return((is_optimized(expr)) ? OPT_T : OPT_F);
}
+static opt_t optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_pointer e);
-static bool optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop, s7_pointer e)
+static opt_t optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop, s7_pointer e)
{
opcode_t op;
- s7_pointer p, orig_e, body;
-
+ s7_pointer p, body;
+ /* TODO: those not allowed need to be passed back and treated as unsafe symbols (find_uncomplicated_symbol etc) */
if (!is_pair(cdr(expr))) /* cddr(expr) might be null if, for example, (begin (let ...)) */
- return(false);
+ return(OPT_F);
op = (opcode_t)syntax_opcode(func);
sc->w = e;
- orig_e = e;
body = cdr(expr);
switch (op)
{
case OP_QUOTE:
case OP_MACROEXPAND:
- return(false);
+ return(OPT_F);
case OP_LET:
+ case OP_LETREC:
+ {
+ s7_pointer vars;
+ if (is_symbol(cadr(expr)))
+ {
+ if (!is_pair(cddr(expr))) /* (let name . x) */
+ return(OPT_F);
+ vars = caddr(expr);
+ body = cdddr(expr);
+ }
+ else
+ {
+ vars = cadr(expr);
+ body = cddr(expr);
+ if (is_null(vars))
+ e = cons(sc, sc->nil, e);
+ }
+ for (p = vars; is_pair(p); p = cdr(p))
+ {
+ s7_pointer var;
+ var = car(p);
+ if ((is_pair(var)) &&
+ (is_symbol(car(var))) &&
+ (is_pair(cdr(var))) &&
+ (is_pair(cadr(var))) &&
+ (!is_checked(cadr(var))) &&
+ (optimize_expression(sc, cadr(var), hop, e) == OPT_OOPS))
+ return(OPT_OOPS);
+ }
+ e = collect_variables(sc, vars, e);
+ if (is_symbol(cadr(expr)))
+ {
+ e = cons(sc, add_symbol_to_list(sc, cadr(expr)), e);
+ sc->w = e;
+ }
+ }
+ break;
+
case OP_LET_STAR:
- if (is_symbol(cadr(expr)))
- {
- e = collect_collisions(sc, caddr(expr), cons(sc, add_sym_to_list(sc, cadr(expr)), e));
- body = cdddr(expr);
- }
- else
- {
- e = collect_collisions(sc, cadr(expr), e);
- body = cddr(expr);
- }
+ case OP_LETREC_STAR:
+ {
+ s7_pointer vars;
+ if (is_symbol(cadr(expr)))
+ {
+ if (!is_pair(cddr(expr))) /* (let name . x) */
+ return(OPT_F);
+ vars = caddr(expr);
+ body = cdddr(expr);
+ }
+ else
+ {
+ vars = cadr(expr);
+ body = cddr(expr);
+ if (is_null(vars))
+ e = cons(sc, sc->nil, e);
+ }
+ for (p = vars; is_pair(p); p = cdr(p))
+ {
+ s7_pointer var;
+ var = car(p);
+ if ((is_pair(var)) &&
+ (is_symbol(car(var))) &&
+ (is_pair(cdr(var))))
+ {
+ if ((is_pair(cadr(var))) &&
+ (!is_checked(cadr(var))))
+ {
+ if (optimize_expression(sc, cadr(var), hop, e) == OPT_OOPS)
+ return(OPT_OOPS);
+ }
+ e = cons(sc, add_symbol_to_list(sc, car(var)), e);
+ sc->w = e;
+ }
+ }
+ if (is_symbol(cadr(expr)))
+ {
+ e = cons(sc, add_symbol_to_list(sc, cadr(expr)), e);
+ sc->w = e;
+ }
+ }
break;
- case OP_LETREC:
- case OP_LETREC_STAR:
- e = collect_collisions(sc, cadr(expr), e);
- body = cddr(expr);
+ case OP_DO:
+ {
+ s7_pointer vars;
+
+ vars = cadr(expr);
+ if (is_null(vars))
+ e = cons(sc, sc->nil, e);
+ body = cddr(expr);
+
+ for (p = vars; is_pair(p); p = cdr(p))
+ {
+ s7_pointer var;
+ var = car(p);
+ if ((is_pair(var)) &&
+ (is_pair(cdr(var))) &&
+ (is_pair(cadr(var))) &&
+ (!is_checked(cadr(var))) &&
+ (optimize_expression(sc, cadr(var), hop, e) == OPT_OOPS)) /* the init field -- locals are not defined yet */
+ return(OPT_OOPS);
+ }
+ e = collect_variables(sc, vars, e);
+ for (p = vars; is_pair(p); p = cdr(p))
+ {
+ s7_pointer var;
+ var = car(p);
+ if ((is_pair(var)) &&
+ (is_pair(cdr(var))) &&
+ (is_pair(cddr(var))) &&
+ (is_pair(caddr(var))) &&
+ (!is_checked(caddr(var))) &&
+ (optimize_expression(sc, caddr(var), hop, e) == OPT_OOPS)) /* the step field -- locals are defined */
+ return(OPT_OOPS);
+ }
+ }
break;
case OP_DEFINE_MACRO:
@@ -54550,55 +58961,83 @@ static bool optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, int
case OP_DEFINE_EXPANSION:
case OP_DEFINE:
case OP_DEFINE_STAR:
- if (is_pair(cadr(expr)))
- {
- s7_pointer name_args;
- name_args = cadr(expr);
- if (is_symbol(car(name_args)))
- {
- if (is_pair(e))
- set_cdr(e, cons(sc, add_sym_to_list(sc, car(name_args)), cdr(e))); /* export it */
- else e = cons(sc, add_sym_to_list(sc, car(name_args)), e);
- }
- if (is_symbol(cdr(name_args))) /* (define (f . a)...) */
- e = cons(sc, add_sym_to_list(sc, cdr(name_args)), e);
- else e = collect_collisions_star(sc, cdr(name_args), e);
- }
- else
- {
- if (is_symbol(cadr(expr)))
- {
- if (is_pair(e))
- set_cdr(e, cons(sc, add_sym_to_list(sc, cadr(expr)), cdr(e))); /* export it */
- else e = cons(sc, add_sym_to_list(sc, cadr(expr)), e);
- }
- }
- body = cddr(expr);
+ /* fprintf(stderr, " %s before: %s\n", DISPLAY(car(expr)), DISPLAY(e)); */
+ /* define adds a name to the incoming env (e), the added name is inserted into e after the first, so the caller
+ * can flush added symbols by maintaining its own pointer into the list if blockers set the car.
+ * the list is used both to see local symbols and to catch "complicated" functions (find_uncomplicated_symbol).
+ * In cases like (if expr (define...)) we can't tell at this level whether the define takes place, so
+ * its name should not be in "e", but it needs to be marked for find_uncomplicated_symbol in a way
+ * that can be distinguished from members of "e". So in that (rare) case, we use the associated keyword.
+ * Then find_uncomplicated_symbol can use has_keyword to tell if the keyword search is needed.
+ * An oddity: if we're not defining a function, the name is not defined in the body:
+ * (define x (+ x 1)) the inner x is not the x-being-defined.
+ */
+ {
+ s7_pointer name_args;
+ name_args = cadr(expr);
+ body = cddr(expr);
+ if (is_pair(name_args))
+ {
+ if (is_symbol(car(name_args)))
+ {
+ add_symbol_to_list(sc, car(name_args));
+ if (is_pair(e))
+ {
+ if (car(e) != sc->key_rest_symbol)
+ set_cdr(e, cons(sc, car(name_args), cdr(e))); /* export it */
+ else add_symbol_to_list(sc, s7_make_keyword(sc, symbol_name(car(name_args))));
+ }
+ else e = cons(sc, car(name_args), e);
+ }
+ e = collect_parameters(sc, cdr(name_args), e);
+ }
+ else
+ {
+ if (is_symbol(name_args))
+ {
+ /* actually if this is defining a function, the name should probably be included in the local env
+ * but that's next-to-impossible to guarantee unless it's (define x (lambda...)) of course.
+ */
+ sc->temp9 = e;
+ for (p = body; is_pair(p); p = cdr(p))
+ if ((is_pair(car(p))) &&
+ (!is_checked(car(p))) && /* ((typeflag & (0xff | T_CHECKED)) == T_PAIR) is not faster */
+ (optimize_expression(sc, car(p), hop, e) == OPT_OOPS))
+ return(OPT_OOPS);
+ sc->temp9 = sc->nil;
+
+ add_symbol_to_list(sc, name_args);
+ if (is_pair(e))
+ {
+ if (car(e) != sc->key_rest_symbol)
+ set_cdr(e, cons(sc, name_args, cdr(e))); /* export it */
+ else add_symbol_to_list(sc, s7_make_keyword(sc, symbol_name(name_args)));
+ }
+ else e = cons(sc, name_args, e);
+ return(OPT_F);
+ }
+ }
+ }
break;
case OP_LAMBDA:
case OP_LAMBDA_STAR:
- if (is_symbol(cadr(expr))) /* (lambda args ...) */
- e = cons(sc, add_sym_to_list(sc, cadr(expr)), e);
- else e = collect_collisions_star(sc, cadr(expr), e);
+ if (is_null(cadr(expr)))
+ e = cons(sc, sc->nil, e);
+ e = collect_parameters(sc, cadr(expr), e);
body = cddr(expr);
break;
case OP_SET:
- if (is_symbol(cadr(expr)))
- e = cons(sc, add_sym_to_list(sc, cadr(expr)), e);
- body = sc->nil;
- break;
-
- case OP_DO:
- e = collect_collisions(sc, cadr(expr), e);
- body = cddr(expr);
+ if ((is_pair(cadr(expr))) &&
+ (caadr(expr) == sc->outlet_symbol))
+ return(OPT_OOPS);
+ body = cddr(expr);
break;
case OP_WITH_LET:
- if (sc->safety != 0)
+ if (sc->safety > NO_SAFETY)
hop = 0;
- orig_e = sc->nil;
e = sc->nil;
/* we can't trust anything here, so hop ought to be off. For example,
* (define (hi)
@@ -54609,23 +59048,55 @@ static bool optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, int
*/
break;
+ case OP_CASE:
+ if ((is_pair(cadr(expr))) &&
+ (optimize_expression(sc, cadr(expr), hop, e) == OPT_OOPS))
+ return(OPT_OOPS);
+ for (p = cddr(expr); is_pair(p); p = cdr(p))
+ if ((is_pair(car(p))) &&
+ (is_pair(cdar(p))) &&
+ (optimize_expression(sc, cdar(p), hop, e) == OPT_OOPS))
+ return(OPT_OOPS);
+ return(OPT_F);
+ break;
+
+ case OP_COND: /* split opt is necessary: (cond (lambda (x) ...)) */
+ for (p = cdr(expr); is_pair(p); p = cdr(p))
+ if (is_pair(car(p)))
+ {
+ s7_pointer test, rest;
+ test = caar(p);
+ rest = cdar(p);
+ e = cons(sc, sc->key_rest_symbol, e);
+ if (((is_pair(test)) && (optimize_expression(sc, test, hop, e) == OPT_OOPS)) ||
+ ((is_pair(rest)) && (optimize_expression(sc, rest, hop, e) == OPT_OOPS)))
+ return(OPT_OOPS);
+ }
+ return(OPT_F);
+ break;
+
+ case OP_IF:
+ case OP_WHEN:
+ case OP_UNLESS:
+ case OP_OR:
+ case OP_AND:
+ e = cons(sc, sc->key_rest_symbol, e);
+ break;
+
default:
break;
}
- if (is_pair(e)) sc->w = e;
- /* fprintf(stderr, "%s -> e: %s\n", DISPLAY(expr), DISPLAY(e)); */
- {
- unsigned int gc_loc;
- gc_loc = s7_gc_protect(sc, e); /* perhaps use sc->temp9 here */
- for (p = cdr(expr); is_pair(p); p = cdr(p))
+ sc->temp9 = e;
+ for (p = body; is_pair(p); p = cdr(p))
+ if ((is_pair(car(p))) &&
+ (!is_checked(car(p))) && /* ((typeflag & (0xff | T_CHECKED)) == T_PAIR) is not faster */
+ (optimize_expression(sc, car(p), hop, e) == OPT_OOPS))
{
- if (p == body) orig_e = e;
- if ((is_pair(car(p))) && (!is_checked(car(p)))) /* ((typeflag & (0xff | T_CHECKED)) == T_PAIR) is not faster */
- optimize_expression(sc, car(p), hop, orig_e);
+ sc->temp9 = sc->nil;
+ return(OPT_OOPS);
}
- s7_gc_unprotect_at(sc, gc_loc);
- }
+ sc->temp9 = sc->nil;
if ((hop == 1) &&
(symbol_id(car(expr)) == 0))
@@ -54665,57 +59136,67 @@ static bool optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, int
if ((op == OP_IF) &&
((args < 2) || (args > 3))) /* syntax error */
- return(false);
-
- set_safe_optimize_op(expr, hop + OP_SAFE_C_C);
- if (pairs == 0)
- {
- if (op == OP_OR)
- set_c_function(expr, or_direct);
- else
- {
- if (op == OP_AND)
- set_c_function(expr, and_direct);
- else set_c_function(expr, if_direct);
- }
- return(true);
- }
+ return(OPT_F);
if ((pairs == args) &&
(c_s_is_ok))
{
if (op == OP_OR)
- set_c_function(expr, or_s_direct);
+ {
+ set_safe_optimize_op(expr, hop + OP_SAFE_C_C);
+ set_c_function(expr, or_s_direct);
+ }
else
{
if (op == OP_AND)
- set_c_function(expr, and_s_direct);
- else set_c_function(expr, if_s_direct);
+ {
+ set_safe_optimize_op(expr, hop + OP_SAFE_C_C);
+ set_c_function(expr, and_s_direct);
+ }
}
- return(true);
+ return(OPT_F);
}
+ set_safe_optimize_op(expr, hop + OP_SAFE_C_C);
+
for (p = cdr(expr); is_pair(p); p = cdr(p))
- set_c_call(p, all_x_eval(sc, car(p), e, pair_symbol_is_safe));
+ set_x_call(p, all_x_eval(sc, p, e, pair_symbol_is_safe));
if (op == OP_OR)
{
if (s7_list_length(sc, cdr(expr)) == 2)
{
- set_c_function(expr, or_all_x_2);
- if ((c_call(cdr(expr)) == all_x_c_u) &&
- (c_call(cddr(expr)) == all_x_c_u))
- set_c_function(expr, or_all_x_2s);
+ set_c_function(expr, or_2);
+ add_optimizer_fixup(sc, expr, (unsigned int)(hop + OP_SAFE_C_OR2));
+ }
+ else
+ {
+ if (s7_list_length(sc, cdr(expr)) == 3)
+ set_c_function(expr, or_3);
+ else set_c_function(expr, or_n);
}
- else set_c_function(expr, or_all_x);
}
else
{
if (op == OP_AND)
{
if (s7_list_length(sc, cdr(expr)) == 2)
- set_c_function(expr, and_all_x_2);
- else set_c_function(expr, and_all_x);
+ {
+ if ((c_call(cdr(expr)) == all_x_c_s) &&
+ (c_call(cddr(expr)) == all_x_c_c))
+ set_c_function(expr, and_sc);
+ else
+ {
+ set_c_function(expr, and_2);
+ add_optimizer_fixup(sc, expr, (unsigned int)(hop + OP_SAFE_C_AND2));
+ }
+ }
+ else
+ {
+ if (s7_list_length(sc, cdr(expr)) == 3)
+ set_c_function(expr, and_3);
+ else set_c_function(expr, and_n);
+ }
}
else
{
@@ -54727,43 +59208,45 @@ static bool optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, int
(is_pair(b2)))
{
if (c_call(b2) == all_x_q)
- set_c_function(expr, if_all_x_qq);
- else set_c_function(expr, if_all_x_qa);
+ set_c_function(expr, if_x_qq);
+ else set_c_function(expr, if_x_qa);
}
else
{
if ((is_pair(car(test))) &&
- (caar(test) == sc->not_symbol))
+ (caar(test) == sc->not_symbol) &&
+ (is_all_x_safe(sc, cadar(test))))
{
- set_c_call(test, all_x_eval(sc, cadar(test), e, pair_symbol_is_safe));
+ set_x_call(test, all_x_eval(sc, cdar(test), e, pair_symbol_is_safe));
if (is_null(b2))
- set_c_function(expr, if_all_not_x1);
- else set_c_function(expr, if_all_not_x2);
+ set_c_function(expr, if_not_x1);
+ else set_c_function(expr, if_not_x2);
}
else
{
if (is_null(b2))
- set_c_function(expr, if_all_x1);
- else set_c_function(expr, if_all_x2);
+ set_c_function(expr, if_x1);
+ else set_c_function(expr, if_x2);
}
}
}
}
- return(true);
+ return(OPT_T);
}
/* else we could check other if cases here (test is often all_x_safe)
*/
}
}
- return(false);
+ return(OPT_F);
}
-static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_pointer e)
+static opt_t optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_pointer e)
{
s7_pointer car_expr;
- /* fprintf(stderr, "opt %d %s %s\n", hop, DISPLAY(expr), DISPLAY(e)); */
- /* if (is_checked(expr)) return(true); */
+
+ /* fprintf(stderr, "opt-expr %d %s %s\n", hop, DISPLAY(expr), DISPLAY(e)); */
+ /* if (is_checked(expr)) return(OPT_T); */
set_checked(expr);
car_expr = car(expr);
@@ -54775,7 +59258,9 @@ static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_poin
return(optimize_syntax(sc, expr, _TSyn(slot_value(global_slot(car_expr))), hop, e));
if (car_expr == sc->quote_symbol)
- return(false);
+ return(OPT_F);
+ if (car_expr == sc->cutlet_symbol)
+ return(OPT_OOPS);
func = find_uncomplicated_symbol(sc, car_expr, e);
if (is_slot(func))
@@ -54786,17 +59271,18 @@ static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_poin
/* we miss implicit indexing here because at this time, the data are not set */
if ((is_procedure(func)) ||
- (is_c_function(func)) ||
+ /* (is_c_function(func)) || */
(is_safe_procedure(func))) /* built-in applicable objects like vectors */
{
int pairs = 0, symbols = 0, args = 0, bad_pairs = 0, quotes = 0, orig_hop;
s7_pointer p;
orig_hop = hop;
- if ((is_any_closure(func)) || /* can't depend on opt1 here because it might not be global, or might be redefined locally */
- ((!is_global(car_expr)) &&
- ((!is_slot(global_slot(car_expr))) ||
- (slot_value(global_slot(car_expr)) != func))))
+ if ((!is_immutable(car_expr)) && /* can't depend on opt1 here because it might not be global, or might be redefined locally */
+ ((is_any_closure(func)) ||
+ ((!is_global(car_expr)) &&
+ ((!is_slot(global_slot(car_expr))) ||
+ (slot_value(global_slot(car_expr)) != func)))))
{
/* (let () (define (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define (f2 a) (- a)) (f1 12))
* (let () (define (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define (f2 a) (- a 1)) (f1 12))
@@ -54811,7 +59297,6 @@ static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_poin
* even a global function might be redefined at any time, and previous uses of it in other functions
* need to reflect its new value.
* So, closures are always checked, but built-in functions are used as if never redefined until that redefinition.
- * costs: index 6/1380, t502: 2/12900, bench: 43/4134, snd-test: 22/37200
* Syntax handling is already impure in s7, so the special handling of built-in functions doesn't
* offend me much. Consider each a sort of reader macro until someone redefines it -- previous
* uses may not be affected because they might have been optimized away -- the result depends on the
@@ -54844,14 +59329,20 @@ static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_poin
pairs++;
if (!is_checked(car_p))
{
- if (!optimize_expression(sc, car_p, orig_hop, e))
+ opt_t res;
+ res = optimize_expression(sc, car_p, orig_hop, e);
+ if (res == OPT_F)
{
bad_pairs++;
- if ((car(car_p) == sc->quote_symbol) &&
- (is_pair(cdr(car_p))) &&
+ if ((is_proper_quote(sc, car_p)) &&
(is_null(cddr(car_p))))
quotes++;
}
+ else
+ {
+ if (res == OPT_OOPS)
+ return(OPT_OOPS);
+ }
}
else
{
@@ -54859,8 +59350,7 @@ static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_poin
(is_unsafe(car_p)))
{
bad_pairs++;
- if ((car(car_p) == sc->quote_symbol) &&
- (is_pair(cdr(car_p))) &&
+ if ((is_proper_quote(sc, car_p)) &&
(is_null(cddr(car_p))))
quotes++;
}
@@ -54879,13 +59369,13 @@ static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_poin
default: return(optimize_func_many_args(sc, expr, func, hop, args, pairs, symbols, quotes, bad_pairs, e));
}
}
- return(false);
+ return(OPT_F);
}
}
else
{
if ((sc->undefined_identifier_warnings) &&
- (func == sc->undefined) && /* car_expr is not in e or global */
+ (func == sc->undefined) && /* car_expr is not in e or global */
(symbol_tag(car_expr) == 0)) /* and we haven't looked it up earlier */
{
s7_pointer p;
@@ -54918,7 +59408,10 @@ static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_poin
if ((hop != 0) && (car(car_p) == sc->quote_symbol))
quotes++;
if (!is_checked(car_p))
- optimize_expression(sc, car_p, hop, e);
+ {
+ if (optimize_expression(sc, car_p, hop, e) == OPT_OOPS)
+ return(OPT_OOPS);
+ }
}
else
{
@@ -54926,19 +59419,21 @@ static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_poin
symbols++;
}
}
-
+
if ((is_null(p)) && /* (+ 1 . 2) */
(!is_optimized(expr)))
{
/* len=0 case is almost entirely arglists */
set_opt_con1(expr, sc->gc_nil);
+ clear_overlay(expr);
+
if (pairs == 0)
{
if (len == 0)
{
/* hoping to catch object application here, as in readers in Snd */
set_unsafe_optimize_op(expr, OP_UNKNOWN);
- return(false);
+ return(OPT_F);
}
if (len == 1)
@@ -54950,26 +59445,14 @@ static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_poin
* to save access to the caller, we'd need to pass it as an arg to optimize_expression
*/
}
- return(false);
+ return(OPT_F);
}
if (len == 2)
{
set_unsafely_optimized(expr);
- if (symbols == 2)
- set_optimize_op(expr, OP_UNKNOWN_GG);
- else
- {
- if (symbols == 0)
- set_optimize_op(expr, OP_UNKNOWN_GG);
- else
- {
- if (is_symbol(cadr(expr)))
- set_optimize_op(expr, OP_UNKNOWN_GG);
- else set_optimize_op(expr, OP_UNKNOWN_GG);
- }
- }
- return(false);
+ set_optimize_op(expr, OP_UNKNOWN_GG);
+ return(OPT_F);
}
if ((len >= 3) &&
@@ -54977,7 +59460,7 @@ static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_poin
{
set_unsafe_optimize_op(expr, OP_UNKNOWN_ALL_S);
set_arglist_length(expr, make_permanent_integer(len));
- return(false);
+ return(OPT_F);
}
}
else /* pairs != 0 */
@@ -54988,17 +59471,12 @@ static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_poin
{
if (len == 1)
{
- if (quotes == 1)
- {
- set_unsafe_optimize_op(expr, OP_UNKNOWN_A);
- return(false);
- }
-
if (is_all_x_safe(sc, arg1))
{
set_arglist_length(expr, small_int(1));
+ annotate_arg(sc, cdr(expr), e);
set_unsafe_optimize_op(expr, OP_UNKNOWN_A);
- return(false);
+ return(OPT_F);
}
}
else
@@ -55010,7 +59488,7 @@ static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_poin
{
set_arglist_length(expr, small_int(2));
set_unsafe_optimize_op(expr, OP_UNKNOWN_AA);
- return(false);
+ return(OPT_F);
}
}
}
@@ -55022,15 +59500,17 @@ static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_poin
{
set_arglist_length(expr, small_int(2));
set_unsafe_optimize_op(expr, OP_UNKNOWN_AA);
- return(false);
+ return(OPT_F);
}
- if ((pairs == (quotes + all_x_count(expr))) &&
+ if ((all_x_count(sc, expr) == len) &&
(len < GC_TRIGGER_SIZE))
{
set_unsafe_optimize_op(expr, (len == 1) ? OP_UNKNOWN_A : OP_UNKNOWN_ALL_X);
set_arglist_length(expr, make_permanent_integer(len));
- return(false);
+ if (len == 1)
+ annotate_arg(sc, cdr(expr), e);
+ return(OPT_F);
}
}
}
@@ -55041,54 +59521,383 @@ static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_poin
/* car(expr) is not a symbol, but there might be interesting stuff here */
/* (define (hi a) (case 1 ((1) (if (> a 2) a 2)))) */
s7_pointer p;
+
for (p = expr; is_pair(p); p = cdr(p))
{
if ((is_pair(car(p))) && (!is_checked(car(p))))
- optimize_expression(sc, car(p), hop, e);
+ if (optimize_expression(sc, car(p), hop, e) == OPT_OOPS)
+ return(OPT_OOPS);
+ }
+
+ if ((is_pair(cdr(expr))) &&
+ (is_null(cddr(expr))) &&
+ (is_pair(car_expr)) &&
+ (car(car_expr) == sc->if_symbol) &&
+ (is_pair(cdr(car_expr))) &&
+ (is_pair(cddr(car_expr))) &&
+ (is_symbol(caddr(car_expr))) &&
+ (is_pair(cdddr(car_expr))) &&
+ (is_symbol(cadddr(car_expr))) &&
+ ((!is_pair(cadr(car_expr))) || (is_all_x_safe(sc, cadr(car_expr)))) &&
+ ((!is_pair(cadr(expr))) || (is_all_x_safe(sc, cadr(expr)))))
+ {
+ s7_pointer ptrue;
+ ptrue = find_uncomplicated_symbol(sc, caddr(car_expr), e);
+ if (is_slot(ptrue))
+ {
+ ptrue = slot_value(ptrue);
+ if ((is_c_function(ptrue)) &&
+ (is_safe_procedure(ptrue)))
+ {
+ s7_pointer pfalse;
+ pfalse = find_uncomplicated_symbol(sc, cadddr(car_expr), e);
+ if (is_slot(pfalse))
+ {
+ pfalse = slot_value(pfalse);
+ if ((is_c_function(pfalse)) &&
+ (is_safe_procedure(pfalse)))
+ {
+ set_opt_con1(expr, ptrue);
+ set_opt_con2(expr, pfalse);
+ set_safe_optimize_op(expr, hop + OP_SAFE_IFA_SS_A);
+ annotate_arg(sc, cdr(car_expr), e);
+ annotate_arg(sc, cdr(expr), e);
+ return(OPT_T);
+ }
+ }
+ }
+ }
}
}
- return(false);
+ return(OPT_F);
}
-static s7_pointer optimize(s7_scheme *sc, s7_pointer code, int hop, s7_pointer e)
+static opt_t optimize(s7_scheme *sc, s7_pointer code, int hop, s7_pointer e)
{
s7_pointer x;
- if (sc->safety > 1) return(NULL);
- /* fprintf(stderr, "optimize %s %d %s\n", DISPLAY_80(code), hop, DISPLAY(e)); */
+ /* fprintf(stderr, "optimize: %s %s\n", DISPLAY_80(code), DISPLAY(e)); */
+ if (sc->safety > ALL_OPTIMIZATION_SAFETY) return(OPT_F);
for (x = code; (is_pair(x)) && (!is_checked(x)); x = cdr(x))
{
set_checked(x);
if ((is_pair(car(x))) && (!is_checked(car(x))))
- optimize_expression(sc, car(x), hop, e);
+ {
+ /* fprintf(stderr, " e in: %s\n", DISPLAY(e)); */
+ if (optimize_expression(sc, car(x), hop, e) == OPT_OOPS)
+ return(OPT_OOPS);
+ /* fprintf(stderr, " e out: %s\n", DISPLAY(e)); */
+ }
}
+ handle_optimizer_fixups(sc);
if ((!is_null(x)) &&
(!is_pair(x)))
- eval_error(sc, "stray dot in function body: ~S", code);
- return(NULL);
+ eval_error_no_return(sc, sc->syntax_error_symbol, "stray dot in function body: ~S", code);
+ return(OPT_F);
}
-#if WITH_GCC
- #define indirect_c_function_is_ok(Sc, X) ({s7_pointer _X_; _X_ = X; (((optimize_op(_X_) & 0x1) != 0) || (c_function_is_ok(Sc, _X_)));})
- #define indirect_cq_function_is_ok(Sc, X) ({s7_pointer _X_; _X_ = X; ((!is_optimized(_X_)) || ((optimize_op(_X_) & 0x1) != 0) || (c_function_is_ok(Sc, _X_)));})
-#else
- #define indirect_c_function_is_ok(Sc, X) (((optimize_op(X) & 0x1) != 0) || (c_function_is_ok(Sc, X)))
- #define indirect_cq_function_is_ok(Sc, X) ((!is_optimized(X)) || ((optimize_op(X) & 0x1) != 0) || (c_function_is_ok(Sc, X)))
+/* ---------------------------------------- error checks ---------------------------------------- */
+
+#define goto_START 0
+#define goto_BEGIN1 1
+#define fall_through 2
+#define goto_DO_END_CLAUSES 3
+#define goto_SAFE_DO_END_CLAUSES 4
+#define goto_OPT_EVAL 5
+#define goto_START_WITHOUT_POP_STACK 6
+#define goto_EVAL 7
+#define goto_APPLY 8
+#define goto_EVAL_ARGS 9
+#define goto_DO_UNCHECKED 10
+
+static s7_pointer check_lambda_args(s7_scheme *sc, s7_pointer args, int *arity)
+{
+ s7_pointer x;
+ int i;
+ /* fprintf(stderr, "check lambda args %s\n", DISPLAY(args)); */
+
+ if ((!is_pair(args)) && (!is_null(args)))
+ {
+ if (s7_is_constant(args)) /* (lambda :a ...) */
+ eval_error(sc, "lambda parameter '~S is a constant", args); /* not ~A here, (lambda #\null do) for example */
+
+ /* we currently accept (lambda i i . i) (lambda quote i) (lambda : : . #()) (lambda : 1 . "")
+ * at this level, but when the lambda form is evaluated, it will trigger an error.
+ */
+ if (is_symbol(args))
+ set_local(args);
+
+ if (arity) (*arity) = -1;
+ return(sc->F);
+ }
+
+ for (i = 0, x = args; is_pair(x); i++, x = cdr(x))
+ {
+ s7_pointer car_x;
+ car_x = car(x);
+ if (s7_is_constant(car_x)) /* (lambda (pi) pi), constant here means not a symbol */
+ {
+ if (is_pair(car_x)) /* (lambda ((:hi . "hi") . "hi") 1) */
+ eval_error(sc, "lambda parameter '~S is a pair (perhaps you want define* or lambda*?)", car_x);
+ eval_error(sc, "lambda parameter '~S is a constant", car_x);
+ }
+ if (symbol_is_in_arg_list(car_x, cdr(x))) /* (lambda (a a) ...) or (lambda (a . a) ...) */
+ eval_error(sc, "lambda parameter '~S is used twice in the parameter list", car_x);
+ set_local(car_x);
+ }
+ if (is_not_null(x))
+ {
+ if (s7_is_constant(x)) /* (lambda (a . 0.0) a) or (lambda (a . :b) a) */
+ eval_error(sc, "lambda :rest parameter '~S is a constant", x);
+ i = -i - 1;
+ }
+
+ if (arity) (*arity) = i;
+ return(sc->F);
+}
+
+
+static s7_pointer check_lambda_star_args(s7_scheme *sc, s7_pointer args, int *arity)
+{
+ s7_pointer top, v, w;
+ int i;
+
+ if (!s7_is_list(sc, args))
+ {
+ if (s7_is_constant(args)) /* (lambda* :a ...) */
+ eval_error(sc, "lambda* parameter '~S is a constant", args);
+ if (is_symbol(args))
+ set_local(args);
+ if (arity) (*arity) = -1;
+ return(args);
+ }
+
+ top = args;
+ v = args;
+ for (i = 0, w = args; is_pair(w); i++, v = w, w = cdr(w))
+ {
+ s7_pointer car_w;
+ car_w = car(w);
+ if (is_pair(car_w))
+ {
+ if (s7_is_constant(car(car_w))) /* (lambda* ((:a 1)) ...) */
+ eval_error(sc, "lambda* parameter '~A is a constant", car(car_w));
+ if (symbol_is_in_arg_list(caar(w), cdr(w))) /* (lambda* ((a 1) a) ...) */
+ eval_error(sc, "lambda* parameter '~A is used twice in the argument list", car(car_w));
+
+ if (!is_pair(cdr(car_w))) /* (lambda* ((a . 0.0)) a) */
+ {
+ if (is_null(cdr(car_w))) /* (lambda* ((a)) ...) */
+ eval_error(sc, "lambda* parameter default value missing? '~A", car_w);
+ eval_error(sc, "lambda* parameter is a dotted pair? '~A", car_w);
+ }
+ else
+ {
+ if ((is_pair(cadr(car_w))) && /* (lambda* ((a (quote . -1))) ...) */
+ (s7_list_length(sc, cadr(car_w)) < 0))
+ eval_error(sc, "lambda* parameter default value is improper? ~A", car_w);
+ }
+
+ if (is_not_null(cddr(car_w))) /* (lambda* ((a 0.0 'hi)) a) */
+ eval_error(sc, "lambda* parameter has multiple default values? '~A", car_w);
+
+ set_local(car(car_w));
+ }
+ else
+ {
+ if (car_w != sc->key_rest_symbol)
+ {
+ if (s7_is_constant(car_w))
+ {
+ if (car_w == sc->key_allow_other_keys_symbol)
+ {
+ if (is_not_null(cdr(w))) /* (lambda* (:allow-other-keys x) x) */
+ eval_error(sc, ":allow-other-keys should be the last parameter: ~A", args);
+ if (w == top)
+ eval_error(sc, ":allow-other-keys can't be the only parameter: ~A", args);
+ set_allow_other_keys(top);
+ set_cdr(v, sc->nil);
+ }
+ else /* (lambda* (pi) ...) */
+ eval_error(sc, "lambda* parameter '~A is a constant", car_w);
+ }
+ if (symbol_is_in_arg_list(car_w, cdr(w))) /* (lambda* (a a) ...) or (lambda* (a . a) ...) */
+ eval_error(sc, "lambda* parameter '~A is used twice in the argument list", car_w);
+
+ if (!is_keyword(car_w)) set_local(car_w);
+ }
+ else
+ {
+ if (!is_pair(cdr(w))) /* (lambda* (:rest) ...) */
+ eval_error(sc, "lambda* :rest parameter missing? ~A", w);
+ if (!is_symbol(cadr(w))) /* (lambda* (:rest (a 1)) ...) */
+ {
+ if (!is_pair(cadr(w))) /* (lambda* (:rest 1) ...) */
+ eval_error(sc, "lambda* :rest parameter is not a symbol? ~A", w);
+ eval_error(sc, "lambda* :rest parameter can't have a default value. ~A", w);
+ }
+ else
+ {
+ if (is_immutable_symbol(cadr(w)))
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't bind an immutable object: ~S"), w)));
+ }
+ set_local(cadr(w));
+ }
+ }
+ }
+ if (is_not_null(w))
+ {
+ if (s7_is_constant(w)) /* (lambda* (a . 0.0) a) or (lambda* (a . :b) a) */
+ eval_error(sc, "lambda* :rest parameter '~A is a constant", w);
+ if (is_symbol(w))
+ set_local(w);
+ i = -1;
+ }
+ if (arity) (*arity) = i;
+ return(top);
+}
+
+/* TODO: mark localized and check it
+ * 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?
+ */
+
+typedef enum {UNSAFE_BODY=0, SAFE_BODY=1, VERY_SAFE_BODY=2} body_t;
+static body_t min_body(body_t b1, body_t b2) {return((b1 < b2) ? b1 : b2);}
+
+typedef struct slist {s7_pointer sym; struct slist *next;} slist;
+static slist *syms_free_list = NULL;
+
+static int sym_allocs = 0;
+
+static slist *add_sym(s7_scheme *sc, s7_pointer symbol, slist *lst)
+{
+ slist *top;
+ if (syms_free_list)
+ {
+ top = syms_free_list;
+ syms_free_list = syms_free_list->next;
+ }
+ else
+ {
+ sym_allocs++;
+ top = (slist *)malloc(sizeof(slist));
+ }
+ top->sym = add_symbol_to_list(sc, symbol);
+ top->next = lst;
+ return(top);
+}
+
+static bool memq_sym(s7_scheme *sc, s7_pointer symbol, slist *top)
+{
+ slist *p;
+ if (symbol_is_in_list(sc, symbol))
+ {
+ for (p = top; p; p = p->next)
+ if (p->sym == symbol)
+ return(true);
+ }
+ return(false);
+}
+
+/* #define cancel_sym(Sc, Symbol, Top) cancel_sym_1(Sc, Symbol, Top, x, __LINE__) */
+/* static void cancel_sym_1(s7_scheme *sc, s7_pointer symbol, slist *top, s7_pointer x, int line) */
+static void cancel_sym(s7_scheme *sc, s7_pointer symbol, slist *top)
+{
+ slist *p;
+ if (symbol_is_in_list(sc, symbol))
+ {
+ 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;
+ }
+ }
+}
+
+static void free_syms(slist *top)
+{
+ if (top)
+ {
+ slist *p;
+ for (p = top; p->next; p = p->next);
+ p->next = syms_free_list;
+ syms_free_list = top;
+ }
+}
+
+#define WITH_SYMS_PRINT 0
+#if WITH_SYMS_PRINT
+static void display_syms(s7_scheme *sc, slist *top)
+{
+ if (top)
+ {
+ slist *p;
+ fprintf(stderr, "<slist:");
+ for (p = top; p; p = p->next)
+ fprintf(stderr, " %s", DISPLAY(p->sym));
+ fprintf(stderr, ">");
+ }
+ else fprintf(stderr, "<slist>");
+}
#endif
-static bool body_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer body, bool at_end);
+static slist *split_slist(slist *top, slist *main_args)
+{
+ slist *p;
+ if (top == main_args)
+ return(NULL);
+ for (p = top; p->next != main_args; p = p->next);
+ p->next = NULL;
+ return(top);
+}
+
-static bool form_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer x, bool at_end)
+static body_t body_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer body, slist *main_args, bool at_end);
+static void set_all_locals(s7_scheme *sc, s7_pointer tree, slist *args)
{
- /* called only from body_is_safe and itself */
- s7_pointer expr;
+ s7_pointer p;
+#if WITH_SYMS_PRINT
+ fprintf(stderr, "set_all_locals: %s: ", DISPLAY_80(tree));
+ display_syms(sc, args);
+ fprintf(stderr, "\n");
+#endif
+ for (p = tree; is_pair(p); p = cdr(p))
+ {
+ s7_pointer cp;
+ cp = car(p);
+ if (is_symbol(cp))
+ {
+ if ((memq_sym(sc, cp, args)) ||
+ ((is_immutable(cp)) && /* immutable (by itself) would work except for tricky cases like with-let (no local_slot!) */
+ (is_slot(local_slot(cp))) &&
+ ((is_number(slot_value(local_slot(cp)))) ||
+ (is_sequence(slot_value(local_slot(cp)))))))
+ {
+ /* fprintf(stderr, " set local %s\n", DISPLAY(p)); */
+ set_local_symbol(p);
+ }
+ }
+ else
+ {
+ if (is_pair(cp))
+ set_all_locals(sc, cp, args);
+ }
+ }
+}
+static body_t form_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer x, slist *main_args, bool at_end)
+{
+ s7_pointer expr;
+ body_t result = VERY_SAFE_BODY;
+ if (!is_pair(x)) return(result);
sc->cycle_counter++;
if ((!is_proper_list(sc, x)) ||
(sc->cycle_counter > 5000))
- return(false);
-
+ return(UNSAFE_BODY);
+
expr = car(x);
if (is_syntactic_symbol(expr))
{
@@ -55098,60 +59907,47 @@ static bool form_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer x, bool at_e
case OP_AND:
case OP_BEGIN:
case OP_WITH_BAFFLE:
- if (!body_is_safe(sc, func, cdr(x), at_end))
- return(false);
- break;
-
+ return(body_is_safe(sc, func, cdr(x), main_args, at_end));
+
case OP_MACROEXPAND:
- return(false);
-
+ return(UNSAFE_BODY);
+
case OP_QUOTE:
+ return(VERY_SAFE_BODY);
break;
-
- /* in the name binders, we first have to check that "func" actually is the same thing as the caller's func */
- case OP_LET:
- case OP_LET_STAR:
- if (is_symbol(cadr(x)))
- return(false);
-
- case OP_LETREC:
- case OP_LETREC_STAR:
+
+ case OP_IF:
+ if (!is_pair(cdr(x))) /* (if) ! */
+ return(UNSAFE_BODY);
if (is_pair(cadr(x)))
{
- s7_pointer vars;
- for (vars = cadr(x); is_pair(vars); vars = cdr(vars))
- {
- s7_pointer let_var;
-
- let_var = car(vars);
- if ((!is_pair(let_var)) ||
- (!is_pair(cdr(let_var))))
- return(false);
-
- if (car(let_var) == func)
- return(false); /* it's shadowed */
-
- if ((is_pair(cadr(let_var))) &&
- (!form_is_safe(sc, func, cadr(let_var), false)))
- return(false);
- }
+ result = form_is_safe(sc, func, cadr(x), main_args, false);
+ if (result == UNSAFE_BODY)
+ return(UNSAFE_BODY);
}
- if (!body_is_safe(sc, func, cddr(x), at_end))
- return(false);
- break;
-
- case OP_IF:
- if (!is_pair(cdr(x))) return(false); /* (if) ! */
- if (!((!is_pair(cadr(x))) || (form_is_safe(sc, func, cadr(x), false)))) return(false);
- if (!((!is_pair(caddr(x))) || (form_is_safe(sc, func, caddr(x), at_end)))) return(false);
- if (!((!is_pair(cdddr(x))) || (!is_pair(cadddr(x))) || (form_is_safe(sc, func, cadddr(x), at_end)))) return(false);
+ if (is_pair(caddr(x)))
+ {
+ result = min_body(result, form_is_safe(sc, func, caddr(x), main_args, at_end));
+ if (result == UNSAFE_BODY)
+ return(UNSAFE_BODY);
+ }
+ if ((is_pair(cdddr(x))) &&
+ (is_pair(cadddr(x))))
+ return(min_body(result, form_is_safe(sc, func, cadddr(x), main_args, at_end)));
+ return(result);
break;
-
+
case OP_WHEN:
case OP_UNLESS:
- if (!is_pair(cdr(x))) return(false); /* (when) */
- if (!((!is_pair(cadr(x))) || (form_is_safe(sc, func, cadr(x), false)))) return(false);
- if (!body_is_safe(sc, func, cddr(x), at_end)) return(false);
+ if (!is_pair(cdr(x))) /* (when) */
+ return(UNSAFE_BODY);
+ if (is_pair(cadr(x)))
+ {
+ result = form_is_safe(sc, func, cadr(x), main_args, false);
+ if (result == UNSAFE_BODY)
+ return(UNSAFE_BODY);
+ }
+ return(min_body(result, body_is_safe(sc, func, cddr(x), main_args, at_end)));
break;
case OP_COND:
@@ -55161,354 +59957,428 @@ static bool form_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer x, bool at_e
{
s7_pointer ex;
ex = car(p);
- if (is_pair(ex)) /* ?? */
+ if (!is_pair(ex))
+ return(UNSAFE_BODY);
+ if (is_pair(car(ex)))
{
- if ((is_pair(car(ex))) && (!form_is_safe(sc, func, car(ex), false)))
- return(false);
- if ((is_pair(cdr(ex))) && (!body_is_safe(sc, func, cdr(ex), at_end)))
- return(false);
+ result = min_body(result, form_is_safe(sc, func, car(ex), main_args, false));
+ if (result == UNSAFE_BODY)
+ return(UNSAFE_BODY);
}
- }
- if (is_not_null(p))
- return(false);
- }
- break;
-
- case OP_CASE:
- {
- s7_pointer p;
- if ((is_pair(cadr(x))) && (!form_is_safe(sc, func, cadr(x), false))) return(false);
- for (p = cddr(x); is_pair(p); p = cdr(p))
- if ((is_pair(car(p))) && (!body_is_safe(sc, func, cdar(p), at_end))) /* null cdar(p) ok here */
- return(false);
- }
- break;
-
- case OP_DO:
- /* (do (...) (...) ...) */
- if (!is_pair(cddr(x)))
- return(false);
- if (!body_is_safe(sc, func, cdddr(x), false))
- return(false);
- if (is_pair(cadr(x)))
- {
- s7_pointer vars;
- for (vars = cadr(x); is_pair(vars); vars = cdr(vars))
- {
- s7_pointer do_var;
- do_var = car(vars);
- if (!is_pair(do_var))
- return(false);
-
- if ((car(do_var) == func) ||
- (!is_pair(cdr(do_var)))) /* (do ((a . 1) (b . 2)) ...) */
- return(false);
-
- if ((is_pair(cadr(do_var))) &&
- (!form_is_safe(sc, func, cadr(do_var), false)))
- return(false);
-
- if ((is_pair(cddr(do_var))) &&
- (is_pair(caddr(do_var))) &&
- (!form_is_safe(sc, func, caddr(do_var), false)))
- return(false);
- }
- }
- if ((is_pair(caddr(x))) &&
- (!body_is_safe(sc, func, caddr(x), at_end)))
- return(false);
+ if (is_pair(cdr(ex)))
+ {
+ result = min_body(result, body_is_safe(sc, func, cdr(ex), main_args, at_end));
+ if (result == UNSAFE_BODY)
+ return(UNSAFE_BODY);
+ }
+ }
+ if (is_not_null(p))
+ return(UNSAFE_BODY);
+ return(result);
+ }
break;
-
+
+ case OP_CASE:
+ {
+ s7_pointer p;
+ if (is_pair(cadr(x)))
+ {
+ result = form_is_safe(sc, func, cadr(x), main_args, false);
+ if (result == UNSAFE_BODY)
+ return(UNSAFE_BODY);
+ }
+ for (p = cddr(x); is_pair(p); p = cdr(p))
+ {
+ if (!is_pair(car(p))) return(UNSAFE_BODY);
+ if (is_pair(cdar(p)))
+ {
+ result = min_body(result, body_is_safe(sc, func, cdar(p), main_args, at_end)); /* null cdar(p) ok here */
+ if (result == UNSAFE_BODY)
+ return(UNSAFE_BODY);
+ }
+ }
+ return(result);
+ }
+ break;
+
case OP_SET:
/* if we set func, we have to make sure we abandon the tail call scan:
* (let () (define (hi a) (let ((v (vector 1 2 3))) (set! hi v) (hi a))) (hi 1))
*/
- if (!is_pair(cdr(x))) return(false); /* (set!) ! */
+ if (!is_pair(cdr(x)))
+ return(UNSAFE_BODY); /* (set!) ! */
if (cadr(x) == func)
- return(false);
-
+ return(UNSAFE_BODY);
+
/* car(x) is set!, cadr(x) is settee or obj, caddr(x) is val */
- if (is_symbol(caddr(x)))
- return(false); /* ?? because it might be a local function that has captured local state? */
+ if (is_pair(caddr(x)))
+ {
+ result = form_is_safe(sc, func, caddr(x), main_args, false);
+ if (result == UNSAFE_BODY)
+ return(UNSAFE_BODY);
+ }
+ if (is_pair(cadr(x)))
+ return(min_body(result, form_is_safe(sc, func, cadr(x), main_args, false)));
+ return(result);
- if (((!is_pair(caddr(x))) || (form_is_safe(sc, func, caddr(x), false))) &&
- ((is_symbol(cadr(x))) ||
- ((is_pair(cadr(x))) && (form_is_safe(sc, func, cadr(x), false)))))
- return(true);
- return(false);
+ /* not OP_DEFINE even in simple cases (safe_closure assumes constant funclet) */
case OP_WITH_LET:
if (is_pair(cadr(x)))
- return(false);
+ return(UNSAFE_BODY);
+ return(min_body(body_is_safe(sc, sc->F, cddr(x), main_args, at_end), SAFE_BODY));
+ /* shadowing can happen in with-let -- symbols are global so local_slots are shadowable */
+ break;
- if (!body_is_safe(sc, sc->F, cddr(x), at_end))
- return(false);
+ case OP_LET_TEMPORARILY:
+ {
+ s7_pointer p;
+ if (!is_pair(cadr(x)))
+ return(UNSAFE_BODY);
+ for (p = cadr(x); is_pair(p); p = cdr(p))
+ {
+ if ((!is_pair(car(p))) ||
+ (!is_pair(cdar(p))))
+ return(UNSAFE_BODY);
+ result = min_body(result, form_is_safe(sc, sc->F, cadar(p), main_args, false));
+ if (result == UNSAFE_BODY)
+ return(UNSAFE_BODY);
+ }
+ return(min_body(result, body_is_safe(sc, sc->F, cddr(x), main_args, at_end)));
+ }
+
+ /* in the name binders, we first have to check that "func" actually is the same thing as the caller's func */
+ case OP_LET:
+ case OP_LET_STAR:
+ case OP_LETREC:
+ case OP_LETREC_STAR:
+ {
+ s7_pointer vars, body, let_name;
+ slist *top, *locals;
+ top = main_args;
+ vars = cadr(x);
+ body = cddr(x);
+ if (is_symbol(vars))
+ {
+ if (vars == func) /* named let shadows caller */
+ {
+ free_syms(split_slist(top, main_args));
+ return(UNSAFE_BODY);
+ }
+ let_name = vars;
+ vars = caddr(x);
+ body = cdddr(x);
+ }
+ else let_name = func;
+
+ for (; is_pair(vars); vars = cdr(vars))
+ {
+ s7_pointer let_var, var_name;
+
+ let_var = car(vars);
+ if ((!is_pair(let_var)) ||
+ (!is_pair(cdr(let_var))))
+ {
+ free_syms(split_slist(top, main_args));
+ return(UNSAFE_BODY);
+ }
+ var_name = car(let_var);
+ if ((!is_symbol(var_name)) ||
+ (var_name == let_name) || /* let var shadows caller */
+ (var_name == func))
+ {
+ free_syms(split_slist(top, main_args));
+ return(UNSAFE_BODY);
+ }
+
+ cancel_sym(sc, var_name, top);
+ top = add_sym(sc, var_name, top);
+
+ if (is_pair(cadr(let_var)))
+ {
+ result = min_body(result, form_is_safe(sc, let_name, cadr(let_var), top, false));
+ if (result == UNSAFE_BODY)
+ {
+ free_syms(split_slist(top, main_args));
+ return(UNSAFE_BODY);
+ }
+ }
+ }
+ result = min_body(result, body_is_safe(sc, let_name, body, top, at_end));
+ locals = split_slist(top, main_args);
+ if (locals)
+ {
+ /* fprintf(stderr, "form_is_safe %d %s: %d\n", __LINE__, DISPLAY_80(body), result); */
+ if (result == VERY_SAFE_BODY)
+ set_all_locals(sc, body, locals);
+ free_syms(locals);
+ }
+ return(result);
+ }
break;
- /* op_define and friends are not safe: (define (a) (define b 3)...) tries to put b in the current env,
+ case OP_DO: /* (do (...) (...) ...) */
+ {
+ slist *top, *locals;
+ top = main_args;
+ if (!is_pair(cddr(x)))
+ return(UNSAFE_BODY);
+ if (is_pair(cadr(x)))
+ {
+ s7_pointer vars;
+ for (vars = cadr(x); is_pair(vars); vars = cdr(vars))
+ {
+ s7_pointer do_var;
+ do_var = car(vars);
+ if ((!is_pair(do_var)) ||
+ (!is_pair(cdr(do_var))) || /* (do ((a . 1) (b . 2)) ...) */
+ (car(do_var) == func) ||
+ (!is_symbol(car(do_var))))
+ {
+ free_syms(split_slist(top, main_args));
+ return(UNSAFE_BODY);
+ }
+
+ cancel_sym(sc, car(do_var), top);
+ top = add_sym(sc, car(do_var), top);
+
+ result = min_body(result, form_is_safe(sc, func, cadr(do_var), top, false));
+ if (is_pair(cddr(do_var)))
+ result = min_body(result, form_is_safe(sc, func, caddr(do_var), top, false));
+ if (result == UNSAFE_BODY)
+ {
+ free_syms(split_slist(top, main_args));
+ return(UNSAFE_BODY);
+ }
+ }
+ }
+ if (is_pair(caddr(x)))
+ result = min_body(result, body_is_safe(sc, func, caddr(x), top, at_end));
+ result = min_body(result, body_is_safe(sc, func, cdddr(x), top, false));
+
+ locals = split_slist(top, main_args);
+ if (locals)
+ {
+ /* fprintf(stderr, "form_is_safe %d %s: %d\n", __LINE__, DISPLAY_80(x), result); */
+ if (result == VERY_SAFE_BODY)
+ {
+ s7_pointer vars;
+ for (vars = cadr(x); is_pair(vars); vars = cdr(vars))
+ {
+ s7_pointer do_var;
+ do_var = car(vars);
+ if (is_pair(cddr(do_var)))
+ set_all_locals(sc, caddr(do_var), locals);
+ }
+ set_all_locals(sc, cddr(x), locals);
+ }
+ free_syms(locals);
+ }
+
+ return(result);
+ }
+ break;
+
+ /* define and friends are not safe: (define (a) (define b 3)...) tries to put b in the current env,
* but in a safe func, that's a constant. See s7test L 1865 for an example.
*/
+ /* TODO: how to tell that the temp env can be freed? -- check results for func/macro/let?
+ * not captured? but how to catch that?
+ */
default:
/* try to catch weird cases like:
* (let () (define (hi1 a) (define (hi1 b) (+ b 1)) (hi1 a)) (hi1 1))
* (let () (define (hi1 a) (define (ho1 b) b) (define (hi1 b) (+ b 1)) (hi1 a)) (hi1 1))
*/
- return(false);
+ return(UNSAFE_BODY);
}
}
else /* car(x) is not syntactic ?? */
{
- if ((!is_optimized(x)) ||
- (is_unsafe(x)))
+ if (expr == func) /* try to catch tail call, expr is car(x) */
{
- if (expr == func) /* try to catch tail call */
+ s7_pointer p;
+ for (p = cdr(x); is_pair(p); p = cdr(p))
{
- s7_pointer p;
+ if (is_pair(car(p)))
+ {
+ if (caar(p) == func) /* func called as arg, so not tail call */
+ return(UNSAFE_BODY);
+ result = min_body(result, form_is_safe(sc, func, car(p), main_args, false));
+ if (result == UNSAFE_BODY)
+ return(UNSAFE_BODY);
+ }
+ else
+ {
+ if (car(p) == func)
+ return(UNSAFE_BODY);
+ }
+ }
+ if ((at_end) && (is_null(p))) /* tail call, so safe */
+ return(result);
+ return(UNSAFE_BODY);
+ }
+
+ if (is_symbol(expr)) /* expr=car(x) */
+ {
+ s7_pointer f, f_slot;
- for (p = cdr(x); is_pair(p); p = cdr(p))
- if ((is_pair(car(p))) &&
- (((!is_optimized(car(p))) && (caar(p) != sc->quote_symbol)) ||
- (is_unsafe(car(p))) ||
- (caar(p) == func))) /* func called as arg, so not tail call */
- return(false);
+ if (memq_sym(sc, expr, main_args)) /* it's defined locally (so don't use find_symbol) */
+ return(UNSAFE_BODY);
- if ((at_end) && (is_null(p))) /* tail call, so safe */
- return(true);
- return(false);
- }
+ f_slot = find_symbol(sc, expr);
+ if (!is_slot(f_slot))
+ return(UNSAFE_BODY);
+ f = slot_value(f_slot);
+ result = ((is_sequence(f)) || ((is_c_function(f)) && (is_safe_procedure(f)) && (is_global(expr)))) ? VERY_SAFE_BODY : SAFE_BODY;
- if (is_symbol(expr))
+ if (((is_c_function(f)) && (is_scope_safe_procedure(f))) ||
+ ((is_any_closure(f)) && (is_safe_closure(f))) ||
+ (is_sequence(f)))
{
- if (is_global(expr))
+ s7_pointer p;
+ for (p = cdr(x); is_pair(p); p = cdr(p))
{
- s7_pointer f;
- f = find_symbol_checked(sc, expr);
- if (((is_c_function(f)) &&
- ((is_safe_procedure(f)) ||
- ((is_possibly_safe(f)) &&
- (is_pair(cdr(x))) &&
- (is_pair(cddr(x))) &&
- (unsafe_is_safe(sc, f, cadr(x), caddr(x), (is_pair(cdddr(x))) ? cadddr(x) : NULL, sc->nil))))) ||
- ((is_closure(f)) &&
- (is_safe_closure(f))))
+ if ((is_pair(car(p))) &&
+ (caar(p) != sc->quote_symbol))
{
- s7_pointer p;
- for (p = cdr(x); is_pair(p); p = cdr(p))
- if ((is_pair(car(p))) &&
- ((!is_optimized(car(p))) ||
- (is_unsafe(car(p)))))
- {
- if ((caar(p) != func) ||
- (!is_null(cdr(p))))
- return(false);
- }
- if (!is_null(p))
- return(false);
+ if (caar(p) == func)
+ return(UNSAFE_BODY);
+ result = min_body(result, form_is_safe(sc, func, car(p), main_args, false));
+ if (result == UNSAFE_BODY)
+ return(UNSAFE_BODY);
}
- }
- else
- {
- s7_pointer f;
- f = find_symbol(sc, expr);
- if (is_slot(f))
+ else
{
- if ((is_syntax(slot_value(f))) || (is_any_macro(slot_value(f))))
- return(false);
- if ((is_closure(slot_value(f))) &&
- (is_safe_closure(slot_value(f))))
- {
- s7_pointer p;
- /* the calling function is safe, but what about its arguments? */
- for (p = cdr(x); is_pair(p); p = cdr(p))
- if ((is_pair(car(p))) &&
- (caar(p) == func)) /* this would be a recursive call on func that is not in tail-call position */
- return(false);
- return(true);
- }
+ if (car(p) == func)
+ return(UNSAFE_BODY);
}
}
+ if (!is_null(p))
+ return(UNSAFE_BODY);
+ return(result);
}
- return(false);
}
+ return(UNSAFE_BODY);
}
- return(true);
+ return(result);
}
-
-static bool body_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer body, bool at_end)
+static body_t body_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer body, slist *main_args, bool at_end)
{
- /* called in optimize_lambda and above */
s7_pointer p;
+ body_t result = VERY_SAFE_BODY;
for (p = body; is_pair(p); p = cdr(p))
- if ((is_pair(car(p))) &&
- (!form_is_safe(sc, func, car(p), (at_end) && (is_null(cdr(p))))))
- return(false);
- return(is_null(p));
-}
-
-
-
-/* ---------------------------------------- error checks ---------------------------------------- */
-
-#define goto_START 0
-#define goto_BEGIN1 1
-#define fall_through 2
-#define goto_DO_END_CLAUSES 3
-#define goto_SAFE_DO_END_CLAUSES 4
-#define goto_OPT_EVAL 5
-#define goto_START_WITHOUT_POP_STACK 6
-#define goto_EVAL 7
-#define goto_APPLY 8
-#define goto_EVAL_ARGS 9
-#define goto_DO_UNCHECKED 10
-
-static s7_pointer check_lambda_args(s7_scheme *sc, s7_pointer args, int *arity)
-{
- s7_pointer x;
- int i;
-
- if ((!is_pair(args)) && (!is_null(args)))
- {
- if (s7_is_constant(args)) /* (lambda :a ...) */
- eval_error(sc, "lambda parameter '~S is a constant", args); /* not ~A here, (lambda #\null do) for example */
-
- /* we currently accept (lambda i i . i) (lambda quote i) (lambda : : . #()) (lambda : 1 . "")
- * at this level, but when the lambda form is evaluated, it will trigger an error.
- */
- if (is_symbol(args))
- set_local(args);
-
- if (arity) (*arity) = -1;
- return(sc->F);
- }
-
- for (i = 0, x = args; is_pair(x); i++, x = cdr(x))
{
- s7_pointer car_x;
- car_x = car(x);
- if (s7_is_constant(car_x)) /* (lambda (pi) pi), constant here means not a symbol */
+ if (is_pair(car(p)))
{
- if (is_pair(car_x)) /* (lambda ((:hi . "hi") . "hi") 1) */
- eval_error(sc, "lambda parameter '~S is a pair (perhaps you want define* or lambda*?)", car_x);
- eval_error(sc, "lambda parameter '~S is a constant", car_x);
+ result = min_body(result, form_is_safe(sc, func, car(p), main_args, (at_end) && (is_null(cdr(p)))));
+ if (result == UNSAFE_BODY)
+ return(UNSAFE_BODY);
}
- if (symbol_is_in_arg_list(car_x, cdr(x))) /* (lambda (a a) ...) or (lambda (a . a) ...) */
- eval_error(sc, "lambda parameter '~S is used twice in the parameter list", car_x);
- set_local(car_x);
- }
- if (is_not_null(x))
- {
- if (s7_is_constant(x)) /* (lambda (a . 0.0) a) or (lambda (a . :b) a) */
- eval_error(sc, "lambda :rest parameter '~S is a constant", x);
- i = -i - 1;
}
-
- if (arity) (*arity) = i;
- return(sc->F);
+ if (!is_null(p))
+ return(UNSAFE_BODY);
+ return(result);
}
-static s7_pointer check_lambda_star_args(s7_scheme *sc, s7_pointer args, int *arity)
+static s7_pointer optimize_lambda(s7_scheme *sc, bool unstarred_lambda, s7_pointer func, s7_pointer args, s7_pointer body)
{
- s7_pointer top, v, w;
- int i;
+ int len;
- if (!s7_is_list(sc, args))
- {
- if (s7_is_constant(args)) /* (lambda* :a ...) */
- eval_error(sc, "lambda* parameter '~S is a constant", args);
- if (is_symbol(args))
- set_local(args);
- if (arity) (*arity) = -1;
- return(args);
- }
+ len = s7_list_length(sc, body);
+ if (len < 0) /* (define (hi) 1 . 2) */
+ eval_error_with_caller(sc, "~A: function body messed up, ~A", (unstarred_lambda) ? sc->lambda_symbol : sc->lambda_star_symbol, sc->code);
- top = args;
- v = args;
- for (i = 0, w = args; is_pair(w); i++, v = w, w = cdr(w))
+ if (len > 0) /* i.e. not circular */
{
- s7_pointer car_w;
- car_w = car(w);
- if (is_pair(car_w))
- {
- if (s7_is_constant(car(car_w))) /* (lambda* ((:a 1)) ...) */
- eval_error(sc, "lambda* parameter '~A is a constant", car(car_w));
- if (symbol_is_in_arg_list(caar(w), cdr(w))) /* (lambda* ((a 1) a) ...) */
- eval_error(sc, "lambda* parameter '~A is used twice in the argument list", car(car_w));
+ body_t result;
+ slist *sargs = NULL;
+ s7_pointer p;
- if (!is_pair(cdr(car_w))) /* (lambda* ((a . 0.0)) a) */
- {
- if (is_null(cdr(car_w))) /* (lambda* ((a)) ...) */
- eval_error(sc, "lambda* parameter default value missing? '~A", car_w);
- eval_error(sc, "lambda* parameter is a dotted pair? '~A", car_w);
- }
- else
- {
- if ((is_pair(cadr(car_w))) && /* (lambda* ((a (quote . -1))) ...) */
- (s7_list_length(sc, cadr(car_w)) < 0))
- eval_error(sc, "lambda* parameter default value is improper? ~A", car_w);
- }
+ clear_symbol_list(sc);
+ for (p = args; is_pair(p); p = cdr(p))
+ {
+ if (is_symbol(car(p)))
+ sargs = add_sym(sc, car(p), sargs);
+ else sargs = add_sym(sc, caar(p), sargs);
+ }
+ if (!is_null(p))
+ sargs = add_sym(sc, p, sargs);
+ result = body_is_safe(sc, func, body, sargs, true);
+ /* fprintf(stderr, "%s: %d\n", DISPLAY_80(func), result); */
+ if (result == VERY_SAFE_BODY)
+ {
+ if ((is_symbol(func)) &&
+ ((is_let(sc->envir)) || (symbol_id(func) == 0)))
+ sargs = add_sym(sc, func, sargs);
+ /* this is really tricky. If a function has been defined earlier locally, it has no global slot.
+ * If it is later defined globally, make_slot creates the global slot but does not touch the
+ * (possibly free) local slot (it can't because as s7test 24981 shows, both can be in play).
+ * If we than use the local_symbol mark set here to call (say) OP_LCLOSURE_A, it looks at
+ * the local_slot. If that is invalid (normally a free_cell), oops... So the code above,
+ * checks for a global function that has been previously defined locally.
+ */
+ set_all_locals(sc, body, sargs);
+ }
- if (is_not_null(cddr(car_w))) /* (lambda* ((a 0.0 'hi)) a) */
- eval_error(sc, "lambda* parameter has multiple default values? '~A", car_w);
+ free_syms(sargs);
+ sc->cycle_counter = 0;
+ clear_symbol_list(sc); /* tracks locals */
- set_local(car(car_w));
+ if (is_symbol(func)) /* func can be sc->gc_nil (see check_lambda and check_lambda_star) */
+ {
+ s7_pointer lst;
+ lst = cons(sc, add_symbol_to_list(sc, func), sc->nil);
+ sc->temp10 = lst;
+ if (optimize(sc, body, 1, collect_parameters(sc, args, lst)) == OPT_OOPS)
+ clear_all_optimizations(sc, body);
+ sc->temp10 = sc->nil;
+ free_cell(sc, lst);
+ }
+ else
+ {
+ /* fprintf(stderr, "%s[%d]: %s\n", __func__, __LINE__, DISPLAY(body)); */
+ if (optimize(sc, body, 1, collect_parameters(sc, args, sc->nil)) == OPT_OOPS)
+ clear_all_optimizations(sc, body);
}
- else
+
+ /* if the body is safe, we can optimize the calling sequence */
+ if (!arglist_has_rest(sc, args))
{
- if (car_w != sc->key_rest_symbol)
+ if (!unstarred_lambda)
{
- if (s7_is_constant(car_w))
+ s7_pointer p;
+ bool happy = true;
+ /* check default vals -- if none is an expression or symbol, set simple args */
+ for (p = args; is_pair(p); p = cdr(p))
{
- if (car_w == sc->key_allow_other_keys_symbol)
+ s7_pointer arg;
+ arg = car(p);
+ if ((is_pair(arg)) && /* has default value */
+ (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))))
{
- if (is_not_null(cdr(w))) /* (lambda* (:allow-other-keys x) x) */
- eval_error(sc, ":allow-other-keys should be the last parameter: ~A", args);
- if (w == top)
- eval_error(sc, ":allow-other-keys can't be the only parameter: ~A", args);
- set_allow_other_keys(top);
- set_cdr(v, sc->nil);
+ happy = false;
+ break;
}
- else /* (lambda* (pi) ...) */
- eval_error(sc, "lambda* parameter '~A is a constant", car_w);
- }
- if (symbol_is_in_arg_list(car_w, cdr(w))) /* (lambda* (a a) ...) or (lambda* (a . a) ...) */
- eval_error(sc, "lambda* parameter '~A is used twice in the argument list", car_w);
-
- if (!is_keyword(car_w)) set_local(car_w);
- }
- else
- {
- if (!is_pair(cdr(w))) /* (lambda* (:rest) ...) */
- eval_error(sc, "lambda* :rest parameter missing? ~A", w);
- if (!is_symbol(cadr(w))) /* (lambda* (:rest (a 1)) ...) */
- {
- if (!is_pair(cadr(w))) /* (lambda* (:rest 1) ...) */
- eval_error(sc, "lambda* :rest parameter is not a symbol? ~A", w);
- eval_error(sc, "lambda* :rest parameter can't have a default value. ~A", w);
- }
- else
- {
- if (is_immutable_symbol(cadr(w)))
- return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't bind an immutable object: ~S"), w)));
}
- set_local(cadr(w));
+ if (happy)
+ set_simple_arg_defaults(body);
}
+ if (result != UNSAFE_BODY)
+ set_safe_closure(body);
+ /* else fprintf(stderr, "unsafe: %s\n", DISPLAY(body)); */
+ /* this bit is set on the function itself in make_closure and friends */
}
+ /* else fprintf(stderr, "rest: %d %s\n", result, DISPLAY(body)); */
}
- if (is_not_null(w))
- {
- if (s7_is_constant(w)) /* (lambda* (a . 0.0) a) or (lambda* (a . :b) a) */
- eval_error(sc, "lambda* :rest parameter '~A is a constant", w);
- if (is_symbol(w))
- set_local(w);
- i = -1;
- }
- if (arity) (*arity) = i;
- return(top);
+ return(NULL);
}
-
static void check_lambda(s7_scheme *sc)
{
/* code is a lambda form minus the "lambda": ((a b) (+ a b)) */
@@ -55525,21 +60395,28 @@ static void check_lambda(s7_scheme *sc)
/* in many cases, this is a no-op -- we already checked at define */
check_lambda_args(sc, car(code), NULL);
- clear_syms_in_list(sc);
+ clear_symbol_list(sc); /* tracks locals to this function */
/* look for (define f (let (...) (lambda ...))) and treat as equivalent to (define (f ...)...)
* one problem the hop=0 fixes is that safe closures assume the old frame exists, so we need to check for define below
* I wonder about apply define...
*/
- if ((sc->safety == 0) &&
- ((main_stack_op(sc) == OP_DEFINE1) ||
- (((sc->stack_end - sc->stack_start) > 4) &&
- (((opcode_t)(sc->stack_end[-5])) == OP_DEFINE1) && /* surely if define is ok, so is define dilambda? 16-Apr-16 */
- (sc->op_stack_now > sc->op_stack) &&
- ((*(sc->op_stack_now - 1)) == (s7_pointer)slot_value(global_slot(sc->dilambda_symbol))))))
+ if ((main_stack_op(sc) == OP_DEFINE1) ||
+ (((sc->stack_end - sc->stack_start) > 4) &&
+ (((opcode_t)(sc->stack_end[-5])) == OP_DEFINE1) && /* surely if define is ok, so is define dilambda? 16-Apr-16 */
+ (sc->op_stack_now > sc->op_stack) &&
+ ((*(sc->op_stack_now - 1)) == (s7_pointer)slot_value(global_slot(sc->dilambda_symbol)))))
optimize_lambda(sc, true, sc->gc_nil, car(code), body); /* why was lambda the func? */
- else optimize(sc, body, 0, sc->nil);
-
+ else
+ {
+ /* fprintf(stderr, "%s[%d]: %s %s\n", __func__, __LINE__, DISPLAY_80(body), (sc->op_stack_now > sc->op_stack) ? DISPLAY(*(sc->op_stack_now - 1)) : "??"); */
+ if (optimize(sc, body, 0,
+ /* ((sc->op_stack_now > sc->op_stack) && (is_c_function((*(sc->op_stack_now - 1)))) && (is_scope_safe((*(sc->op_stack_now - 1))))) ? 1 : 0, */
+ /* this works except when someone resets outlet(curlet) after defining a local function! */
+ collect_parameters(sc, car(sc->code), sc->nil)) == OPT_OOPS)
+ clear_all_optimizations(sc, body);
+ }
+
if ((is_overlaid(code)) &&
(has_opt_back(code)))
pair_set_syntax_symbol(code, sc->lambda_unchecked_symbol);
@@ -55552,11 +60429,15 @@ static void check_lambda_star(s7_scheme *sc)
eval_error_no_return(sc, sc->syntax_error_symbol, "lambda*: no args or no body? ~A", sc->code);
set_car(sc->code, check_lambda_star_args(sc, car(sc->code), NULL));
- clear_syms_in_list(sc);
+ clear_symbol_list(sc);
- if ((sc->safety != 0) ||
+ if ((sc->safety > NO_SAFETY) ||
(main_stack_op(sc) != OP_DEFINE1))
- optimize(sc, cdr(sc->code), 0, sc->nil);
+ {
+ /* fprintf(stderr, "%s[%d]: %s\n", __func__, __LINE__, DISPLAY(cdr(sc->code))); */
+ if (optimize(sc, cdr(sc->code), 0, collect_parameters(sc, car(sc->code), sc->nil)) == OPT_OOPS)
+ clear_all_optimizations(sc, cdr(sc->code));
+ }
else optimize_lambda(sc, false, sc->gc_nil, car(sc->code), cdr(sc->code));
if ((is_overlaid(sc->code)) &&
@@ -55564,45 +60445,11 @@ static void check_lambda_star(s7_scheme *sc)
pair_set_syntax_symbol(sc->code, sc->lambda_star_unchecked_symbol);
}
-static s7_pointer check_when(s7_scheme *sc)
-{
- if (!is_pair(sc->code)) /* (when) or (when . 1) */
- 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);
-
- if ((is_overlaid(sc->code)) &&
- (has_opt_back(sc->code)))
- {
- pair_set_syntax_symbol(sc->code, sc->when_unchecked_symbol);
- if (is_symbol(car(sc->code)))
- pair_set_syntax_symbol(sc->code, sc->when_s_symbol);
- }
- return(sc->code);
-}
-
-
-static s7_pointer check_unless(s7_scheme *sc)
-{
- if (!is_pair(sc->code)) /* (unless) or (unless . 1) */
- 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);
-
- if ((is_overlaid(sc->code)) &&
- (has_opt_back(sc->code)))
- {
- pair_set_syntax_symbol(sc->code, sc->unless_unchecked_symbol);
- if (is_symbol(car(sc->code)))
- pair_set_syntax_symbol(sc->code, sc->unless_s_symbol);
- }
- return(sc->code);
-}
-
static s7_pointer check_case(s7_scheme *sc)
{
- bool keys_simple = true, have_else = false, has_feed_to = false, keys_single = true, bodies_simple = true;
+ bool keys_simple = true, has_feed_to = false, keys_single = true, bodies_simple = true;
+ int key_type = T_FREE;
s7_pointer x;
if (!is_pair(sc->code)) /* (case) or (case . 1) */
@@ -55611,51 +60458,60 @@ 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);
for (x = cdr(sc->code); is_not_null(x); x = cdr(x))
{
- s7_pointer y;
+ s7_pointer y, car_x;
if ((!is_pair(x)) || /* (case 1 ((2) 1) . 1) */
(!is_pair(car(x))))
eval_error(sc, "case clause ~A messed up", x);
+ car_x = car(x);
- if (!s7_is_list(sc, cdar(x))) /* (case 1 ((1))) */
- eval_error(sc, "case clause result messed up: ~A", car(x));
+ if (!s7_is_list(sc, cdr(car_x))) /* (case 1 ((1))) */
+ eval_error(sc, "case clause result messed up: ~A", car_x);
if ((bodies_simple) &&
- ((is_null(cdar(x))) || (!is_null(cddar(x)))))
+ ((is_null(cdr(car_x))) || (!is_null(cddr(car_x)))))
bodies_simple = false;
- y = caar(x);
+ y = car(car_x);
if (!is_pair(y))
{
- if ((y != sc->else_object) && (y != sc->else_symbol) && /* (case 1 (2 1)) */
+ if ((y != sc->else_symbol) && /* (case 1 (2 1)) */
((!is_symbol(y)) ||
- (s7_symbol_value(sc, y) != sc->else_object))) /* "proper list" below because: (case 1 (() 2) ... */
+ (s7_symbol_value(sc, y) != sc->else_symbol))) /* "proper list" below because: (case 1 (() 2) ... */
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);
- have_else = true;
+ if (is_pair(cddr(car_x)))
+ {
+ set_opt_else(sc->code, cdr(car_x));
+ /* fprintf(stderr, "else not simple\n"); */
+ bodies_simple = false;
+ }
+ 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));
+ }
}
else
{
- /* what about (case 1 ((1) #t) ((1) #f)) [this is ok by guile]
- * (case 1 ((1) #t) ())
- * (case 1 ((2 2 2) 1)): guile says #<unspecified>
- * but we do support: (let ((otherwise else)) (case 0 ((1) 2) (otherwise 3))) -> 3!
- * is that consistent?
- * (let ((else #f)) (case 0 ((1) 2) (else 3))) -> 3
- * (case 0 ((1) 2) (else (let ((else 3)) else))) -> 3
- * the selector (sc->value) is evaluated, but the search key is not
- * (case '2 ((2) 3) (else 1)) -> 3
- * (case '2 (('2) 3) (else 1)) -> 1
- * another approach: make else a value, not a symbol, like #<unspecified>, evaluates to itself
- * or set it to be immutable, but I guess I'll say "use #_else" for now.
- */
if (!is_simple(car(y)))
keys_simple = false;
if (!is_null(cdr(y)))
keys_single = false;
+ if (key_type == T_FREE)
+ key_type = type(car(y));
+ else
+ {
+ if (key_type != type(car(y)))
+ key_type = NUM_TYPES;
+ }
for (y = cdr(y); is_not_null(y); y = cdr(y))
{
@@ -55663,9 +60519,11 @@ static s7_pointer check_case(s7_scheme *sc)
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;
}
}
- y = car(x);
+ y = car_x;
if ((is_pair(cdr(y))) &&
(cadr(y) == sc->feed_to_symbol) &&
(s7_symbol_value(sc, sc->feed_to_symbol) == sc->undefined))
@@ -55681,66 +60539,93 @@ static s7_pointer check_case(s7_scheme *sc)
if ((is_overlaid(sc->code)) &&
(has_opt_back(sc->code)))
{
- for (x = cdr(sc->code); is_not_null(x); x = cdr(x))
+ if ((keys_single) &&
+ (bodies_simple))
{
- set_opt_key(x, caar(x));
- if ((is_pair(opt_key(x))) &&
- (is_pair(cdar(x))))
- set_opt_clause(x, cadar(x));
+ 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_key(x, car(opt_key(x)));
+ if (is_pair(cdar(x)))
+ set_opt_clause(x, cadar(x));
+ }
+ }
}
+ else
+ {
+ for (x = cdr(sc->code); is_not_null(x); x = cdr(x))
+ {
+ set_opt_key(x, caar(x));
+ if ((is_pair(opt_key(x))) &&
+ (is_pair(cdar(x))))
+ set_opt_clause(x, cadar(x));
+ }
+ }
+
pair_set_syntax_symbol(sc->code, sc->case_unchecked_symbol);
-
- if ((!has_feed_to) &&
- (keys_simple))
+ if ((has_feed_to) ||
+ (!bodies_simple) || /* x_x_g g=general keys or bodies */
+ (!keys_single))
{
- if (have_else) /* don't combine ifs ! */
+ if (!keys_simple) /* x_g_g (no int case here) */
{
- if (is_symbol(car(sc->code))) /* (case + ((-) 0) ((+) 2) (else 3)) */
- pair_set_syntax_symbol(sc->code, sc->case_simple_symbol); /* can include (else) case */
- /* perhaps if null result skip case_simple? no impact in timings */
-
- if ((keys_single) &&
- (is_pair(car(sc->code))) &&
- (is_pair(cdr(sc->code))) &&
- (is_pair(cddr(sc->code))) &&
- (is_null(cdddr(sc->code))) &&
- (is_null(cdr(caddr(sc->code)))))
- pair_set_syntax_symbol(sc->code, sc->case_else_symbol);
+ if (is_symbol(car(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->case_s_g_g_symbol);
+ else
+ {
+ if (is_all_x_safe(sc, car(sc->code)))
+ {
+ pair_set_syntax_symbol(sc->code, sc->case_a_g_g_symbol);
+ set_x_call(sc->code, all_x_eval(sc, sc->code, sc->envir, let_symbol_is_safe));
+ }
+ else pair_set_syntax_symbol(sc->code, sc->case_p_g_g_symbol);
+ }
}
- else
+ else /* x_e_g */
{
- if (keys_single)
+ if (is_symbol(car(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->case_s_e_g_symbol);
+ else
{
- if ((bodies_simple) && /* (case x ((a) 1)) */
- (is_symbol(car(sc->code))))
- pair_set_syntax_symbol(sc->code, sc->case_simplest_symbol);
- else
+ if (is_all_x_safe(sc, car(sc->code)))
{
- if ((is_optimized(car(sc->code))) && /* (case (string-ref s i) ((#\a) 1) ((#\i) 2)) */
- (optimize_op(car(sc->code)) == HOP_SAFE_C_SS))
- pair_set_syntax_symbol(sc->code, sc->case_simplest_ss_symbol);
+ pair_set_syntax_symbol(sc->code, sc->case_a_e_g_symbol);
+ set_x_call(sc->code, all_x_eval(sc, sc->code, sc->envir, let_symbol_is_safe));
}
- for (x = cdr(sc->code); is_not_null(x); x = cdr(x))
- set_opt_key(x, caaar(x));
+ else pair_set_syntax_symbol(sc->code, sc->case_p_e_g_symbol);
}
+ }
+ }
+ else /* x_x_s */
+ {
+ if (!keys_simple) /* x_g|i_s */
+ {
+ if (is_symbol(car(sc->code)))
+ pair_set_syntax_symbol(sc->code, (key_type == T_INTEGER) ? sc->case_s_i_s_symbol: sc->case_s_g_s_symbol);
else
{
- if (bodies_simple)
+ if (is_all_x_safe(sc, car(sc->code)))
{
- if (is_symbol(car(sc->code))) /* (case head ((and if cond when) arg1) ((or if2) (list 'not arg1))) */
- pair_set_syntax_symbol(sc->code, sc->case_simpler_1_symbol);
- else
- {
- if ((is_optimized(car(sc->code))) && /* (case (string-ref s i) ((#\a #\h) 1) ((#\i #\o) 2)) */
- (optimize_op(car(sc->code)) == HOP_SAFE_C_SS))
- pair_set_syntax_symbol(sc->code, sc->case_simpler_ss_symbol);
- }
+ pair_set_syntax_symbol(sc->code, (key_type == T_INTEGER) ? sc->case_a_i_s_symbol : sc->case_a_g_s_symbol);
+ set_x_call(sc->code, all_x_eval(sc, sc->code, sc->envir, let_symbol_is_safe));
}
- else
+ else pair_set_syntax_symbol(sc->code, (key_type == T_INTEGER) ? sc->case_p_i_s_symbol : sc->case_p_g_s_symbol);
+ }
+ }
+ else /* x_e_s */
+ {
+ if (is_symbol(car(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->case_s_e_s_symbol);
+ else
+ {
+ if (is_all_x_safe(sc, car(sc->code)))
{
- if (is_symbol(car(sc->code))) /* (case x ((lambda lambda*) (display "x") (+ 2 3)) ((case when) 3))) */
- pair_set_syntax_symbol(sc->code, sc->case_simpler_symbol);
+ pair_set_syntax_symbol(sc->code, sc->case_a_e_s_symbol);
+ set_x_call(sc->code, all_x_eval(sc, sc->code, sc->envir, let_symbol_is_safe));
}
+ else pair_set_syntax_symbol(sc->code, sc->case_p_e_s_symbol);
}
}
}
@@ -55755,23 +60640,22 @@ static s7_pointer check_let_one_var(s7_scheme *sc, s7_pointer start)
pair_set_syntax_symbol(sc->code, sc->let_one_symbol);
binding = car(start);
-
+ /* all-x-able body happens a few times, but to avoid the new frame we'd need to ensure it was safe etc */
if (is_pair(cadr(binding)))
{
if (is_h_optimized(cadr(binding)))
{
- if (is_null(cddr(sc->code))) /* one statement body */
+ if (is_null(cddr(sc->code))) /* one statement body */
{
- set_opt_sym2(cdr(sc->code), car(binding));
+ set_opt_sym2(cdr(sc->code), car(binding)); /* these don't collide -- cdr(code) and code */
set_opt_pair2(sc->code, cadr(binding));
pair_set_syntax_symbol(sc->code, sc->let_z_symbol);
if ((is_h_safe_c_s(cadr(binding))) &&
- (is_pair(cadr(sc->code)))) /* one body expr is a pair */
+ (is_pair(cadr(sc->code)))) /* one body expr is a pair */
{
pair_set_syntax_symbol(sc->code, sc->let_opsq_p_symbol);
- set_opt_sym2(sc->code, cadr(cadr(binding)));
-
+ set_opt_sym2(sc->code, cadadr(binding));
if ((!is_optimized(cadr(sc->code))) &&
(is_syntactic_symbol(caadr(sc->code))))
{
@@ -55781,20 +60665,39 @@ static s7_pointer check_let_one_var(s7_scheme *sc, s7_pointer start)
* pair_set_syntax_op(cadr(sc->code)) as below, the optimization bit is on, but the
* apparent optimize_op (op) is now safe_c_qq! So eval ejects it and it is handled by the
* explicit ("trailers") code.
+ * I think the optimize bit is now turned off by pair_set_syntax_op.
*/
pair_set_syntax_op(cadr(sc->code), symbol_syntax_op(caadr(sc->code)));
}
return(sc->code);
}
- }
+ if (optimize_op(cadr(binding)) == HOP_SAFE_C_SS)
+ {
+ set_opt_pair2(sc->code, cadr(binding));
+ pair_set_syntax_symbol(sc->code, sc->let_opssq_e_symbol);
+ if (c_call(cadr(binding)) == g_assq)
+ pair_set_syntax_symbol(sc->code, sc->let_opassq_e_symbol);
+ set_opt_sym3(sc->code, caddr(cadr(binding)));
+ return(sc->code);
+ }
+ if (is_all_x_safe(sc, cadr(binding)))
+ {
+ pair_set_syntax_symbol(sc->code, sc->let_a_symbol);
+ annotate_arg(sc, cdr(binding), sc->envir);
+ if (is_optimized(cadr(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->let_a_z_symbol);
+ return(sc->code);
+ }
+ }
+
if (is_h_safe_c_s(cadr(binding)))
{
- pair_set_syntax_symbol(sc->code, sc->let_opsq_symbol);
- set_opt_sym2(sc->code, cadr(cadr(binding)));
+ pair_set_syntax_symbol(sc->code, (caadr(binding) == sc->car_symbol) ? sc->let_car_symbol : sc->let_opsq_symbol);
+ set_opt_sym2(sc->code, cadadr(binding));
return(sc->code);
}
- /* opt1 here is opt_back */
+
set_opt_pair2(sc->code, cadr(binding));
if (optimize_op(cadr(binding)) == HOP_SAFE_C_SS)
{
@@ -55803,12 +60706,11 @@ static s7_pointer check_let_one_var(s7_scheme *sc, s7_pointer start)
}
else
{
- if (optimize_op(cadr(binding)) == HOP_SAFE_C_C)
+ if (is_h_safe_c_c(cadr(binding)))
{
set_opt_sym3(sc->code, car(binding));
pair_set_syntax_symbol(sc->code, sc->let_opcq_symbol);
}
- /* let_all_x here is slightly slower than fallback let_z */
}
}
}
@@ -55820,7 +60722,7 @@ static s7_pointer check_let_one_var(s7_scheme *sc, s7_pointer start)
if (is_symbol(p))
{
set_opt_sym2(sc->code, p);
- pair_set_syntax_symbol(sc->code, sc->let_s_symbol);
+ pair_set_syntax_symbol(sc->code, ((is_null(cddr(sc->code))) && (is_optimized(cadr(sc->code)))) ? sc->let_s_z_symbol : sc->let_s_symbol);
}
else
{
@@ -55879,6 +60781,8 @@ static s7_pointer check_let(s7_scheme *sc)
eval_error(sc, "let variable list is messed up: ~A", sc->code);
if (is_null(cddr(sc->code))) /* (let hi () ) */
eval_error(sc, "named let has no body: ~A", sc->code);
+ if (!is_pair(cddr(sc->code))) /* (let hi () . =>) */
+ eval_error(sc, "named let stray dot? ~A", sc->code);
if (is_immutable_symbol(car(sc->code)))
return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't bind an immutable object: ~S"), sc->code)));
set_local(car(sc->code));
@@ -55886,7 +60790,7 @@ static s7_pointer check_let(s7_scheme *sc)
}
else start = car(sc->code);
- clear_syms_in_list(sc);
+ clear_symbol_list(sc);
for (vars = 0, x = start; is_pair(x); vars++, x = cdr(x))
{
s7_pointer y, carx;
@@ -55915,9 +60819,9 @@ static s7_pointer check_let(s7_scheme *sc)
return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't bind an immutable object: ~S"), x)));
/* check for name collisions -- not sure this is required by Scheme */
- if (symbol_tag(y) == sc->syms_tag)
+ if (symbol_is_in_list(sc, y))
eval_error(sc, "duplicate identifier in let: ~A", y);
- add_sym_to_list(sc, y);
+ add_symbol_to_list(sc, y);
set_local(y);
}
@@ -55940,9 +60844,11 @@ static s7_pointer check_let(s7_scheme *sc)
else pair_set_syntax_symbol(sc->code, sc->named_let_symbol);
/* this is (let name ...) so the initial values need to be removed from the closure arg list */
- sc->args = sc->nil; /* sc->args is set to nil in named_let below */
+
+ sc->args = sc->nil;
for (ex = start; is_pair(ex); ex = cdr(ex))
sc->args = cons(sc, caar(ex), sc->args);
+
optimize_lambda(sc, true, car(sc->code), sc->args = safe_reverse_in_place(sc, sc->args), cddr(sc->code));
/* apparently these guys are almost never safe */
@@ -55969,25 +60875,20 @@ static s7_pointer check_let(s7_scheme *sc)
x = car(p);
if (is_pair(cadr(x)))
{
- if (car(cadr(x)) == sc->quote_symbol)
- op = sc->let_all_x_symbol;
+ if (is_h_safe_c_s(cadr(x)))
+ {
+ if ((op == sc->nil) || (op == sc->let_all_opsq_symbol))
+ op = sc->let_all_opsq_symbol;
+ else op = sc->let_all_x_symbol;
+ }
else
{
- if (is_h_safe_c_s(cadr(x)))
- {
- if ((op == sc->nil) || (op == sc->let_all_opsq_symbol))
- op = sc->let_all_opsq_symbol;
- else op = sc->let_all_x_symbol;
- }
+ if (is_all_x_safe(sc, cadr(x)))
+ op = sc->let_all_x_symbol;
else
{
- if (is_all_x_safe(sc, cadr(x)))
- op = sc->let_all_x_symbol;
- else
- {
- op = sc->let_unchecked_symbol;
- break;
- }
+ op = sc->let_unchecked_symbol;
+ break;
}
}
}
@@ -56016,7 +60917,8 @@ static s7_pointer check_let(s7_scheme *sc)
{
s7_pointer p;
for (p = start; is_pair(p); p = cdr(p))
- set_c_call(cdar(p), all_x_eval(sc, cadar(p), sc->envir, let_symbol_is_safe));
+ set_x_call(cdar(p), all_x_eval(sc, cdar(p), sc->envir, let_symbol_is_safe));
+ /* all-x-able body does not happen much */
}
}
return(sc->code);
@@ -56025,13 +60927,12 @@ static s7_pointer check_let(s7_scheme *sc)
static s7_pointer check_let_star(s7_scheme *sc)
{
- s7_pointer y;
+ s7_pointer vars;
bool named_let;
- if (!is_pair(sc->code)) /* (let* . 1) */
+ if (!is_pair(sc->code)) /* (let* . 1) */
eval_error(sc, "let* variable list is messed up: ~A", sc->code);
-
- if (!is_pair(cdr(sc->code))) /* (let*) */
+ if (!is_pair(cdr(sc->code))) /* (let*) */
eval_error(sc, "let* variable list is messed up: ~A", sc->code);
named_let = (is_symbol(car(sc->code)));
@@ -56042,62 +60943,52 @@ static s7_pointer check_let_star(s7_scheme *sc)
eval_error(sc, "let* variable list is messed up: ~A", sc->code);
if (is_null(cddr(sc->code))) /* (let* hi () ) */
eval_error(sc, "named let* has no body: ~A", sc->code);
+ if (!is_pair(cddr(sc->code))) /* (let* hi () . =>) */
+ eval_error(sc, "named let* stray dot? ~A", sc->code);
if (is_immutable_symbol(car(sc->code)))
return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't bind an immutable object: ~S"), sc->code)));
set_local(car(sc->code));
if ((!is_null(cadr(sc->code))) &&
- ((!is_pair(cadr(sc->code))) || /* (let* hi x ... ) */
- (!is_pair(caadr(sc->code))) || /* (let* hi (x) ...) */
- (!is_pair(cdaadr(sc->code))))) /* (let* hi ((x . 1)) ...) */
+ (!is_pair(cadr(sc->code)))) /* (let* hi x ... ) */
eval_error(sc, "named let* variable declaration value is missing: ~A", sc->code);
}
else
{
if ((!is_null(car(sc->code))) &&
- ((!is_pair(car(sc->code))) || /* (let* x ... ) */
- (!is_pair(caar(sc->code))) || /* (let* (x) ...) */
- (!is_pair(cdaar(sc->code))))) /* (let* ((x . 1)) ...) */
+ (!is_pair(car(sc->code)))) /* (let* x ... ) */
eval_error(sc, "let* variable declaration value is missing: ~A", sc->code);
}
- for (y = ((named_let) ? cadr(sc->code) : car(sc->code)); is_pair(y); y = cdr(y))
+ for (vars = ((named_let) ? cadr(sc->code) : car(sc->code)); is_pair(vars); vars = cdr(vars))
{
- s7_pointer x, z;
- x = car(y);
- if (!(is_symbol(car(x)))) /* (let* ((3 1)) 1) */
- eval_error(sc, "bad variable ~S in let*", x);
+ s7_pointer var_and_val, var;
+ var_and_val = car(vars);
- z = car(x);
- if (is_immutable_symbol(z))
- return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't bind an immutable object: ~S"), x)));
+ if (!is_pair(var_and_val)) /* (let* (3) ... */
+ eval_error(sc, "let* variable list is messed up? ~A", var_and_val);
- if (!is_pair(x)) /* (let* ((x)) ...) */
- eval_error(sc, "let* variable declaration, but no value?: ~A", x);
+ if (is_null(cdr(var_and_val))) /* (let* ((x)) ...) */
+ eval_error(sc, "let* variable declaration, but no value?: ~A", var_and_val);
- if (!(is_pair(cdr(x)))) /* (let* ((x . 1))...) */
- eval_error(sc, "let* variable declaration is not a proper list?: ~A", x);
+ if (!(is_pair(cdr(var_and_val)))) /* (let* ((x . 1))...) */
+ eval_error(sc, "let* variable declaration is not a proper list?: ~A", var_and_val);
- if (is_not_null(cddr(x))) /* (let* ((x 1 2 3)) ...) */
- eval_error(sc, "let* variable declaration has more than one value?: ~A", x);
+ if (!is_null(cddr(var_and_val))) /* (let* ((c 1 2)) ...) */
+ eval_error(sc, "let* variable declaration has more than one value?: ~A", var_and_val);
- x = cdr(y);
- if (is_pair(x))
- {
- if (!is_pair(car(x))) /* (let* ((x -1) 2) 3) */
- eval_error(sc, "let* variable/binding is ~S?", car(x));
+ var = car(var_and_val);
- if (!is_pair(cdar(x))) /* (let* ((a 1) (b . 2)) ...) */
- eval_error(sc, "let* variable list is messed up? ~A", x);
- }
- else
- {
- if (is_not_null(x)) /* (let* ((a 1) . b) a) */
- eval_error(sc, "let* var list improper?: ~A", x);
- }
+ if (!(is_symbol(var))) /* (let* ((3 1)) 1) */
+ eval_error(sc, "bad variable ~S in let*", var);
+
+ if (is_immutable_symbol(var)) /* (let* ((pi 3)) ...) */
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't bind an immutable object: ~S"), var_and_val)));
- /* currently (let* ((a 1) (a (+ a 1))) a) is 2, not an error! */
- set_local(z);
+ /* currently (let* ((a 1) (a (+ a 1))) a) is 2, not an error. */
+ set_local(var);
}
+ if (!is_null(vars))
+ eval_error(sc, "let* variable list is not a proper list?: ~A", vars);
if ((is_overlaid(sc->code)) &&
(has_opt_back(sc->code)))
@@ -56143,12 +61034,13 @@ static s7_pointer check_let_star(s7_scheme *sc)
pair_set_syntax_symbol(sc->code, op);
}
}
+
if ((pair_syntax_symbol(sc->code) == sc->let_all_x_symbol) ||
(pair_syntax_symbol(sc->code) == sc->let_star_all_x_symbol))
{
s7_pointer p;
for (p = car(sc->code); is_pair(p); p = cdr(p))
- set_c_call(cdar(p), all_x_eval(sc, cadar(p), sc->envir, let_symbol_is_safe));
+ set_x_call(cdar(p), all_x_eval(sc, cdar(p), sc->envir, let_symbol_is_safe));
}
}
return(sc->code);
@@ -56164,7 +61056,7 @@ static s7_pointer check_letrec(s7_scheme *sc, bool letrec)
(!s7_is_list(sc, car(sc->code)))) /* (letrec 1 ...) */
eval_error_with_caller(sc, "~A: variable list is messed up: ~A", caller, sc->code);
- clear_syms_in_list(sc);
+ clear_symbol_list(sc);
for (x = car(sc->code); is_not_null(x); x = cdr(x))
{
s7_pointer y, carx;
@@ -56192,9 +61084,9 @@ static s7_pointer check_letrec(s7_scheme *sc, bool letrec)
/* check for name collisions -- this is needed in letrec* else which of the two legit values
* does our "rec" refer to, so to speak.
*/
- if (symbol_tag(y) == sc->syms_tag)
+ if (symbol_is_in_list(sc, y))
eval_error_with_caller(sc, "~A: duplicate identifier: ~A", caller, y);
- add_sym_to_list(sc, y);
+ add_symbol_to_list(sc, y);
set_local(y);
}
@@ -56206,29 +61098,73 @@ static s7_pointer check_letrec(s7_scheme *sc, bool letrec)
}
-static s7_pointer check_quote(s7_scheme *sc)
+static s7_pointer check_let_temporarily(s7_scheme *sc)
{
- if (!is_pair(sc->code)) /* (quote . -1) */
+ s7_pointer x;
+
+ if ((!is_pair(sc->code)) || /* (let-temporarily . 1) */
+ (!s7_is_list(sc, car(sc->code)))) /* (let-temporarily 1 ...) */
+ eval_error(sc, "let-temporarily: variable list is messed up: ~A", sc->code);
+ /* cdr(sc->code) = body can be nil */
+
+ for (x = car(sc->code); is_not_null(x); x = cdr(x))
{
- if (is_null(sc->code))
- eval_error(sc, "quote: not enough arguments: ~A", sc->code);
- eval_error(sc, "quote: stray dot?: ~A", sc->code);
+ s7_pointer carx;
+ if (!is_pair(x)) /* (let-temporarily ((a 1) . 2) ...) */
+ eval_error(sc, "let-temporarily: improper list of variables? ~A", sc->code);
+
+ carx = car(x);
+ if (!is_pair(carx)) /* (let-temporarily (1 2) #t) */
+ eval_error(sc, "let-temporarily: bad variable ~S", carx);
+
+ if (is_symbol(car(carx)))
+ {
+ if (is_immutable_symbol(car(carx))) /* (let-temporarily ((pi 3)) ...) */
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't bind an immutable object: ~S"), x)));
+ if (is_syntactic(car(carx))) /* (let-temporarily ((if 3)) ...) */
+ return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't set! ~S"), car(carx))));
+ }
+
+ if (!is_pair(cdr(carx))) /* (let-temporarily ((x . 1))...) */
+ eval_error(sc, "let-temporarily: variable declaration value is messed up: ~S", carx);
+
+ if (is_not_null(cddr(carx))) /* (let-temporarily ((x 1 2 3)) ...) */
+ eval_error(sc, "let-temporarily: variable declaration has more than one value?: ~A", carx);
}
- if (is_not_null(cdr(sc->code))) /* (quote . (1 2)) or (quote 1 1) */
- eval_error(sc, "quote: too many arguments ~A", sc->code);
-#if 0
+
if ((is_overlaid(sc->code)) &&
(has_opt_back(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->let_temporarily_unchecked_symbol);
+
+ return(sc->code);
+}
+
+
+static s7_pointer check_quote(s7_scheme *sc, s7_pointer code)
+{
+ if (!is_pair(code)) /* (quote . -1) */
{
- pair_set_syntax_symbol(sc->code, sc->quote_unchecked_symbol);
+ if (is_null(code))
+ eval_error(sc, "quote: not enough arguments: ~A", code);
+ eval_error(sc, "quote: stray dot?: ~A", code);
+ }
+ if (is_not_null(cdr(code))) /* (quote . (1 2)) or (quote 1 1) */
+ eval_error(sc, "quote: too many arguments ~A", code);
+#if 0
+ /* the problem here is set-cdr! */
+ if ((is_overlaid(code)) &&
+ (has_opt_back(code)))
+ {
+ pair_set_syntax_symbol(code, sc->quote_unchecked_symbol);
}
#endif
- return(sc->code);
+ return(code);
}
static s7_pointer check_and(s7_scheme *sc)
{
+ /* this and check_or and check_if may not be called -- optimize_syntax can short-circuit it to return all_x* choices */
s7_pointer p;
bool all_pairs;
@@ -56250,13 +61186,23 @@ static s7_pointer check_and(s7_scheme *sc)
{
if (all_pairs)
{
+ bool any_nils = false, any_ps = false;
for (p = sc->code; is_pair(p); p = cdr(p))
- set_c_call(p, all_x_eval(sc, car(p), sc->envir, let_symbol_is_safe)); /* c_callee can be nil! */
+ {
+ s7_function callee;
+ callee = all_x_eval(sc, p, sc->envir, let_symbol_is_safe); /* c_callee can be nil! */
+ if (!callee)
+ any_nils = true;
+ set_x_call_checked(p, callee);
+ if (!is_optimized(car(p)))
+ any_ps = true;
+ /* fprintf(stderr, "%s: %p %d\n", DISPLAY_80(car(p)), callee, is_optimized(car(p))); */
+ }
if ((c_callee(sc->code)) &&
(is_pair(cdr(sc->code))) &&
(is_null(cddr(sc->code))))
- pair_set_syntax_symbol(sc->code, sc->and_p2_symbol);
- else pair_set_syntax_symbol(sc->code, sc->and_p_symbol);
+ pair_set_syntax_symbol(sc->code, (any_nils) ? ((any_ps) ? sc->and_ap_symbol : sc->and_az_symbol) : sc->and_safe_aa_symbol);
+ else pair_set_syntax_symbol(sc->code, (any_nils) ? sc->and_p_symbol : sc->and_safe_p_symbol);
}
else pair_set_syntax_symbol(sc->code, sc->and_unchecked_symbol);
}
@@ -56288,13 +61234,21 @@ static s7_pointer check_or(s7_scheme *sc)
if (all_pairs)
{
s7_pointer ep;
+ bool any_nils = false, any_ps = false;
for (ep = sc->code; is_pair(ep); ep = cdr(ep))
- set_c_call(ep, all_x_eval(sc, car(ep), sc->envir, let_symbol_is_safe));
+ {
+ s7_function callee;
+ callee = all_x_eval(sc, ep, sc->envir, let_symbol_is_safe);
+ if (!callee) any_nils = true;
+ set_x_call_checked(ep, callee);
+ if (!is_optimized(car(p)))
+ any_ps = true;
+ }
if ((c_callee(sc->code)) &&
(is_pair(cdr(sc->code))) &&
(is_null(cddr(sc->code))))
- pair_set_syntax_symbol(sc->code, sc->or_p2_symbol);
- else pair_set_syntax_symbol(sc->code, sc->or_p_symbol);
+ pair_set_syntax_symbol(sc->code, (any_nils) ? ((any_ps) ? sc->or_ap_symbol : sc->or_az_symbol) : sc->or_safe_aa_symbol);
+ else pair_set_syntax_symbol(sc->code, (any_nils) ? sc->or_p_symbol : sc->or_safe_p_symbol);
}
else pair_set_syntax_symbol(sc->code, sc->or_unchecked_symbol);
}
@@ -56302,6 +61256,156 @@ static s7_pointer check_or(s7_scheme *sc)
}
+#define choose_if_opt(Op, One, Reversed, Not) ((One) ? ((Reversed) ? Op ## _r_symbol : ((Not) ? Op ## _n_symbol : Op ## _p_symbol)) : ((Not) ? Op ## _n_n_symbol : Op ## _p_p_symbol))
+
+static void set_if_opts(s7_scheme *sc, bool one_branch, bool reversed)
+{
+ s7_pointer test;
+ bool not_case = false;
+ test = car(sc->code);
+ if ((!reversed) &&
+ (is_pair(test)) &&
+ (car(test) == sc->not_symbol))
+ {
+ if (!is_pair(cdr(test))) return;
+ not_case = true;
+ test = cadr(test);
+ }
+ if (is_pair(test))
+ {
+ if (is_h_optimized(test))
+ {
+ if (is_h_safe_c_c(test))
+ {
+ if (c_callee(test) == g_and_2)
+ {
+ 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));
+ 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));
+ return;
+ }
+ set_opt_pair2(sc->code, cdr(test));
+ pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_c, one_branch, reversed, not_case));
+ return;
+ }
+
+ 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
+ {
+ 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));
+ }
+ }
+ set_opt_sym2(sc->code, cadr(test));
+ return;
+ }
+
+ if (optimize_op(test) == HOP_SAFE_C_SQ)
+ {
+ pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_csq, one_branch, reversed, not_case));
+ set_opt_con2(sc->code, cadr(caddr(test)));
+ set_opt_sym3(sc->code, cadr(test));
+ return;
+ }
+ if (optimize_op(test) == HOP_SAFE_C_SS)
+ {
+ pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_css, one_branch, reversed, not_case));
+ set_opt_sym2(sc->code, caddr(test));
+ set_opt_sym3(sc->code, cadr(test));
+ return;
+ }
+ if ((optimize_op(test) == HOP_SAFE_C_SC) &&
+ (!is_local_symbol(cdr(test))))
+ {
+ pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_csc, one_branch, reversed, not_case));
+ set_opt_con2(sc->code, caddr(test));
+ set_opt_sym3(sc->code, cadr(test));
+ return;
+ }
+ if (optimize_op(test) == HOP_SAFE_C_S_opCq)
+ {
+ pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_s_opcq, one_branch, reversed, not_case));
+ set_opt_pair2(sc->code, caddr(test));
+ set_opt_sym3(sc->code, cadr(test));
+ return;
+ }
+ 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));
+ return;
+ }
+ if (is_all_x_safe(sc, test))
+ {
+ pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_a, one_branch, reversed, not_case));
+ if (not_case)
+ set_x_call(cdar(sc->code), all_x_eval(sc, cdar(sc->code), sc->envir, let_symbol_is_safe));
+ else set_x_call(sc->code, all_x_eval(sc, sc->code, sc->envir, let_symbol_is_safe));
+ }
+ else
+ {
+ pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_z, one_branch, reversed, not_case));
+ }
+ }
+ else
+ {
+ pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_p, one_branch, reversed, not_case));
+ if (is_syntactic_symbol(car(test)))
+ {
+ pair_set_syntax_op(test, symbol_syntax_op(car(test)));
+
+ if ((symbol_syntax_op(car(test)) == OP_AND) ||
+ (symbol_syntax_op(car(test)) == OP_OR))
+ {
+ opcode_t new_op;
+ s7_pointer old_code;
+ old_code = sc->code;
+ sc->code = cdr(test);
+ if (symbol_syntax_op(car(test)) == OP_AND) check_and(sc); else check_or(sc);
+ new_op = symbol_syntax_op(car(test));
+ sc->code = old_code;
+ if ((new_op == OP_AND_P) || (new_op == OP_AND_AP) || (new_op == OP_AND_AZ) ||
+ (new_op == OP_AND_SAFE_P) || (new_op == OP_AND_SAFE_AA))
+ pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_andp, one_branch, reversed, not_case));
+ else
+ {
+ if ((new_op == OP_OR_P) || (new_op == OP_OR_AP) || (new_op == OP_OR_AZ) ||
+ (new_op == OP_OR_SAFE_P) || (new_op == OP_OR_SAFE_AA))
+ pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_orp, one_branch, reversed, not_case));
+ }
+ }
+ }
+ }
+ }
+ else /* test is symbol or constant, but constant here is nutty */
+ {
+ if (is_safe_symbol(test))
+ pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_s, one_branch, reversed, not_case));
+ }
+}
+
+
+/* (cond <> (else <>)) only happens in old-fashioned code, so set_if_opts covers if/when/unless but not cond
+ * g_and_3 and g_or_3 are slightly slower here??
+ */
+
static s7_pointer check_if(s7_scheme *sc)
{
s7_pointer cdr_code;
@@ -56327,204 +61431,77 @@ static s7_pointer check_if(s7_scheme *sc)
if ((is_overlaid(sc->code)) &&
(has_opt_back(sc->code)))
{
- s7_pointer test;
- bool one_branch;
pair_set_syntax_symbol(sc->code, sc->if_unchecked_symbol);
+ set_if_opts(sc, is_null(cdr(cdr_code)), false);
+ }
+ return(sc->code);
+}
+
+
+static s7_pointer check_when(s7_scheme *sc)
+{
+ if (!is_pair(sc->code)) /* (when) or (when . 1) */
+ 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);
- one_branch = (is_null(cdr(cdr_code)));
- test = car(sc->code);
- if (is_pair(test))
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ {
+ pair_set_syntax_symbol(sc->code, sc->when_unchecked_symbol);
+ if (is_null(cddr(sc->code)))
+ set_if_opts(sc, true, false);
+ else
{
- if (is_h_optimized(test))
+ if (is_safe_symbol(car(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->when_s_symbol);
+ else
{
- if (optimize_op(test) == HOP_SAFE_C_C)
+ if (is_all_x_safe(sc, car(sc->code)))
{
- if (c_callee(test) == g_and_all_x_2)
- {
- pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_and2_p_symbol : sc->if_and2_p_p_symbol);
- set_opt_and_2_test(sc->code, cddr(test));
- }
- else pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_cc_p_symbol : sc->if_cc_p_p_symbol);
- set_opt_pair2(sc->code, cdr(test));
+ pair_set_syntax_symbol(sc->code, sc->when_a_symbol);
+ set_x_call(sc->code, all_x_eval(sc, sc->code, sc->envir, let_symbol_is_safe));
}
else
{
- if (is_h_safe_c_s(test))
- {
- /* these miss methods? */
- if (car(test) == sc->is_pair_symbol)
- pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_is_pair_p_symbol : sc->if_is_pair_p_p_symbol);
- else
- {
- if (car(test) == sc->is_symbol_symbol)
- pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_is_symbol_p_symbol : sc->if_is_symbol_p_p_symbol);
- else
- {
- if (car(test) == sc->not_symbol)
- pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_not_s_p_symbol : sc->if_not_s_p_p_symbol);
- else pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_cs_p_symbol : sc->if_cs_p_p_symbol);
- }
- }
- set_opt_sym2(sc->code, cadr(test));
- }
- else
- {
- if (optimize_op(test) == HOP_SAFE_C_SQ)
- {
- pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_csq_p_symbol : sc->if_csq_p_p_symbol);
- set_opt_con2(sc->code, cadr(caddr(test)));
- set_opt_sym3(sc->code, cadr(test));
- }
- else
- {
- if (optimize_op(test) == HOP_SAFE_C_SS)
- {
- pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_css_p_symbol : sc->if_css_p_p_symbol);
- set_opt_sym2(sc->code, caddr(test));
- set_opt_sym3(sc->code, cadr(test));
- }
- else
- {
- if (optimize_op(test) == HOP_SAFE_C_SC)
- {
- pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_csc_p_symbol : sc->if_csc_p_p_symbol);
- set_opt_con2(sc->code, caddr(test));
- set_opt_sym3(sc->code, cadr(test));
- }
- else
- {
- if (optimize_op(test) == HOP_SAFE_C_S_opCq)
- {
- pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_s_opcq_p_symbol : sc->if_s_opcq_p_p_symbol);
- set_opt_pair2(sc->code, caddr(test));
- set_opt_sym3(sc->code, cadr(test));
- }
- else
- {
- if (optimize_op(test) == HOP_SAFE_C_opSSq)
- {
- pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_opssq_p_symbol : sc->if_opssq_p_p_symbol);
- set_opt_pair2(sc->code, cadar(sc->code));
- set_opt_sym3(sc->code, caddr(opt_pair2(sc->code)));
- }
- else
- {
- if (is_all_x_safe(sc, test))
- {
- pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_a_p_symbol : sc->if_a_p_p_symbol);
- set_c_call(sc->code, all_x_eval(sc, test, sc->envir, let_symbol_is_safe));
- /* fprintf(stderr, "%s\n", DISPLAY(sc->code)); */
- }
- else
- {
- pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_z_p_symbol : sc->if_z_p_p_symbol);
- set_opt_con2(sc->code, cadr(sc->code));
- }
- }
- }
- }
- }
- }
- }
- }
- }
- else
- {
- pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_p_p_symbol : sc->if_p_p_p_symbol);
- if (is_syntactic_symbol(car(test)))
- {
- pair_set_syntax_op(test, symbol_syntax_op(car(test)));
-
- if ((symbol_syntax_op(car(test)) == OP_AND) ||
- (symbol_syntax_op(car(test)) == OP_OR))
- {
- opcode_t new_op;
- s7_pointer old_code;
- old_code = sc->code;
- sc->code = cdr(test);
- if (symbol_syntax_op(car(test)) == OP_AND) check_and(sc); else check_or(sc);
- new_op = symbol_syntax_op(car(test));
- sc->code = old_code;
- if ((new_op == OP_AND_P) || (new_op == OP_AND_P2))
- pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_andp_p_symbol : sc->if_andp_p_p_symbol);
- else
- {
- if ((new_op == OP_OR_P) || (new_op == OP_OR_P2))
- pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_orp_p_symbol : sc->if_orp_p_p_symbol);
- }
- }
+ if (is_pair(cdr(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->when_p_symbol);
}
}
}
- else /* test is symbol or constant, but constant here is nutty */
- {
- if (is_symbol(test))
- pair_set_syntax_symbol(sc->code, (one_branch) ? sc->if_s_p_symbol : sc->if_s_p_p_symbol);
- }
}
return(sc->code);
}
-static s7_pointer optimize_lambda(s7_scheme *sc, bool unstarred_lambda, s7_pointer func, s7_pointer args, s7_pointer body)
+static s7_pointer check_unless(s7_scheme *sc)
{
- int len;
- /* fprintf(stderr, "opt %s %s %s %d\n", DISPLAY(func), DISPLAY(args), DISPLAY(body), (is_symbol(func)) && (is_global(func))); */
-
- len = s7_list_length(sc, body);
- if (len < 0) /* (define (hi) 1 . 2) */
- eval_error_with_caller(sc, "~A: function body messed up, ~A", (unstarred_lambda) ? sc->lambda_symbol : sc->lambda_star_symbol, sc->code);
+ if (!is_pair(sc->code)) /* (unless) or (unless . 1) */
+ 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);
- if (len > 0) /* i.e. not circular */
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
{
- clear_syms_in_list(sc);
- if (is_symbol(func)) /* func can be sc->gc_nil (see check_lambda and check_lambda_star) */
- {
- s7_pointer lst;
- unsigned int gc_loc;
- lst = list_1(sc, add_sym_to_list(sc, func));
- gc_loc = s7_gc_protect(sc, lst); /* perhaps use sc->temp10 here */
- optimize(sc, body, 1, collect_collisions_star(sc, args, lst));
- s7_gc_unprotect_at(sc, gc_loc);
- }
- else optimize(sc, body, 1, collect_collisions_star(sc, args, sc->nil));
-
- /* if the body is safe, we can optimize the calling sequence */
- if ((is_proper_list(sc, args)) &&
- (!arglist_has_rest(sc, args)))
+ pair_set_syntax_symbol(sc->code, sc->unless_unchecked_symbol);
+ if (is_null(cddr(sc->code)))
+ set_if_opts(sc, true, true);
+ else
{
- if (!unstarred_lambda)
+ if (is_safe_symbol(car(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->unless_s_symbol);
+ else
{
- s7_pointer p;
- bool happy = true;
- /* check default vals -- if none is an expression or symbol, set simple args */
- for (p = args; is_pair(p); p = cdr(p))
+ if (is_all_x_safe(sc, car(sc->code)))
{
- s7_pointer arg;
- arg = car(p);
- if ((is_pair(arg)) && /* has default value */
- ((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))))
- {
- happy = false;
- break;
- }
+ pair_set_syntax_symbol(sc->code, sc->unless_a_symbol);
+ set_x_call(sc->code, all_x_eval(sc, sc->code, sc->envir, let_symbol_is_safe));
}
- if (happy)
- set_simple_args(body);
- }
- sc->cycle_counter = 0;
- if (((unstarred_lambda) || (has_simple_args(body))) &&
- (body_is_safe(sc, func, body, true)))
- {
- /* there is one problem with closure* here -- we can't trust anything that has fancy (non-constant) default argument values. */
- set_safe_closure(body);
- /* this bit is set on the function itself in make_closure and friends */
}
}
}
- return(NULL);
+ return(sc->code);
}
@@ -56554,7 +61531,7 @@ static s7_pointer check_define(s7_scheme *sc)
{
if (is_null(cdr(sc->code)))
eval_error_with_caller(sc, "~A: no value? ~A", caller, sc->code); /* (define var) */
- eval_error_with_caller(sc, "~A: bad form? ~A", caller, sc->code); /* (define var . 1) */
+ eval_error_with_caller(sc, "~A: stray dot? ~A", caller, sc->code); /* (define var . 1) */
}
if (!is_pair(car(sc->code)))
{
@@ -56570,17 +61547,23 @@ static s7_pointer check_define(s7_scheme *sc)
eval_error_with_caller(sc, "~A ~A: keywords are constants", caller, func);
if (is_syntactic(func)) /* (define and a) */
{
- if (sc->safety > 0)
+ if (sc->safety > NO_SAFETY)
s7_warn(sc, 128, "%s: syntactic keywords tend to behave badly if redefined", DISPLAY(func));
set_local(func);
}
-
if ((is_pair(cadr(sc->code))) && /* look for (define sym (lambda ...)) and treat it like (define (sym ...)...) */
((caadr(sc->code) == sc->lambda_symbol) ||
(caadr(sc->code) == sc->lambda_star_symbol)) &&
(symbol_id(caadr(sc->code)) == 0))
- /* not is_global here because that bit might not be set for initial symbols (why not? -- redef as method etc) */
- optimize_lambda(sc, caadr(sc->code) == sc->lambda_symbol, func, cadr(cadr(sc->code)), cddr(cadr(sc->code)));
+ {
+ /* not is_global here because that bit might not be set for initial symbols (why not? -- redef as method etc) */
+ if (!is_pair(cdadr(sc->code))) /* (define x (lambda . 1)) */
+ eval_error_with_caller(sc, "~A: stray dot? ~A", caller, sc->code);
+ if (caadr(sc->code) == sc->lambda_star_symbol)
+ check_lambda_star_args(sc, cadadr(sc->code), &arity);
+ else check_lambda_args(sc, cadadr(sc->code), &arity);
+ optimize_lambda(sc, caadr(sc->code) == sc->lambda_symbol, func, cadadr(sc->code), cddr(cadr(sc->code)));
+ }
}
else
{
@@ -56589,7 +61572,7 @@ static s7_pointer check_define(s7_scheme *sc)
eval_error_with_caller(sc, "~A: define a non-symbol? ~S", caller, func);
if (is_syntactic(func)) /* (define (and a) a) */
{
- if (sc->safety > 0)
+ if (sc->safety > NO_SAFETY)
s7_warn(sc, 128, "%s: syntactic keywords tend to behave badly if redefined", DISPLAY(func));
set_local(func);
}
@@ -56627,8 +61610,8 @@ static int define_unchecked_ex(s7_scheme *sc)
s7_pointer x;
unsigned int typ;
if (is_safe_closure(cdr(sc->code)))
- typ = T_CLOSURE_STAR | T_PROCEDURE | T_SAFE_CLOSURE;
- else typ = T_CLOSURE_STAR | T_PROCEDURE;
+ typ = T_CLOSURE_STAR | T_SAFE_CLOSURE;
+ else typ = T_CLOSURE_STAR;
new_cell(sc, x, typ);
closure_set_args(x, cdar(sc->code));
closure_set_body(x, cdr(sc->code));
@@ -56673,13 +61656,36 @@ static int define_unchecked_ex(s7_scheme *sc)
return(fall_through);
}
+static s7_pointer make_funclet(s7_scheme *sc, s7_pointer new_func, s7_pointer func_name, s7_pointer outer_env)
+{
+ s7_pointer new_env;
+ new_cell_no_check(sc, new_env, T_LET | T_FUNCLET);
+ let_id(new_env) = ++sc->let_number;
+ let_set_slots(new_env, sc->nil);
+ set_outlet(new_env, outer_env);
+ closure_set_let(new_func, new_env);
+ funclet_set_function(new_env, func_name); /* __func__ returns at least funclet_function */
+ if (is_safe_closure(new_func))
+ {
+ s7_pointer arg;
+ for (arg = closure_args(new_func); is_pair(arg); arg = cdr(arg))
+ {
+ if (is_pair(car(arg)))
+ make_slot_1(sc, new_env, caar(arg), sc->nil);
+ else make_slot_1(sc, new_env, car(arg), sc->nil);
+ }
+ let_set_slots(new_env, reverse_slots(sc, let_slots(new_env)));
+ }
+ return(new_env);
+}
+
static void define_funchecked(s7_scheme *sc)
{
- s7_pointer new_func, new_env, code;
+ s7_pointer new_func, code;
code = sc->code;
sc->value = caar(code);
-
- new_cell(sc, new_func, T_CLOSURE | T_PROCEDURE | T_COPY_ARGS);
+
+ new_cell(sc, new_func, T_CLOSURE | T_COPY_ARGS);
closure_set_args(new_func, cdar(code));
closure_set_body(new_func, cdr(code));
closure_set_setter(new_func, sc->F);
@@ -56688,185 +61694,19 @@ static void define_funchecked(s7_scheme *sc)
if (is_safe_closure(cdr(code)))
{
- s7_pointer arg;
set_safe_closure(new_func);
-
- new_cell_no_check(sc, new_env, T_LET | T_FUNCTION_ENV);
- let_id(new_env) = ++sc->let_number;
- let_set_slots(new_env, sc->nil);
- set_outlet(new_env, sc->envir);
- closure_set_let(new_func, new_env);
- funclet_set_function(new_env, sc->value);
-
- for (arg = closure_args(new_func); 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)));
+ make_funclet(sc, new_func, sc->value, sc->envir);
}
else closure_set_let(new_func, sc->envir);
/* unsafe closures created by other functions do not support __func__ */
-
- add_slot(sc->envir, sc->value, new_func);
+
+ if (is_let(sc->envir))
+ add_slot(sc->envir, sc->value, new_func);
set_local(sc->value);
sc->value = new_func;
}
-static int lambda_star_default(s7_scheme *sc)
-{
- while (true)
- {
- s7_pointer z;
- z = sc->args;
- if (is_slot(z))
- {
- if (slot_value(z) == sc->undefined)
- {
- if (is_closure_star(sc->code))
- {
- s7_pointer val;
- val = slot_expression(z);
- if (is_symbol(val))
- {
- slot_set_value(z, find_symbol_checked(sc, val));
- if (slot_value(z) == sc->undefined)
- {
- /* the current environment here contains the function parameters which
- * defaulted to #<undefined> earlier in apply_lambda_star,
- * so (define (f f) (define* (f (f f)) f) (f)) (f 0) looks for the
- * default f, finds itself currently undefined, and raises an error!
- * So, before claiming it is unbound, we need to check outlet as well.
- * But in the case above, the inner define* shadows the caller's
- * parameter before checking the default arg values, so the default f
- * refers to the define* -- I'm not sure this is a bug. It means
- * that (define* (f (a f)) a) returns f: (equal? f (f)) -> #t, so
- * any outer f needs an extra let and endless outlets:
- * (let ((f 3)) (let () (define* (f (a ((outlet (outlet (outlet (curlet)))) 'f))) a) (f))) -> 3
- * We want the shadowing once the define* is done, so the current mess is simplest.
- */
- slot_set_value(z, s7_symbol_local_value(sc, val, outlet(sc->envir)));
- if (slot_value(z) == sc->undefined)
- eval_error_no_return(sc, sc->syntax_error_symbol, "lambda* defaults: ~A is unbound", slot_symbol(z));
- /* but #f is default if no expr, so there's some inconsistency here */
- }
- }
- else
- {
- if (is_pair(val))
- {
- if (car(val) == sc->quote_symbol)
- {
- if ((!is_pair(cdr(val))) || /* (lambda* ((a (quote))) a) or (lambda* ((a (quote 1 1))) a) etc */
- (is_pair(cddr(val))))
- eval_error_no_return(sc, sc->syntax_error_symbol, "lambda* default: ~A is messed up", val);
- slot_set_value(z, cadr(val));
- }
- else
- {
- push_stack(sc, OP_LAMBDA_STAR_DEFAULT, sc->args, sc->code);
- sc->code = val;
- return(goto_EVAL);
- }
- }
- else slot_set_value(z, val);
- }
- }
- else slot_set_value(z, slot_expression(z));
- }
- sc->args = slot_pending_value(z);
- }
- else break;
- }
- return(fall_through);
-}
-
-#if 0
-static void unsafe_closure_2(s7_scheme *sc, s7_pointer arg1, s7_pointer arg2)
-{
- s7_pointer code, args;
- if (sc->stack_end >= sc->stack_resize_trigger) resize_stack(sc); /* not check_stack_size because it tries to return sc->F */
- code = opt_lambda(sc->code);
- args = closure_args(code);
- new_frame_with_two_slots(sc, closure_let(code), sc->envir, car(args), arg1, cadr(args), arg2);
- sc->code = closure_body(code);
-}
-#else
-#define unsafe_closure_2(Sc, Arg1, Arg2) \
-{ \
- s7_pointer Code, Args, A1, A2; A1 = Arg1; A2 = Arg2; \
- if (Sc->stack_end >= Sc->stack_resize_trigger) resize_stack(Sc); \
- Code = opt_lambda(Sc->code); \
- Args = closure_args(Code); \
- new_frame_with_two_slots(Sc, closure_let(Code), Sc->envir, car(Args), A1, cadr(Args), A2); \
- Sc->code = closure_body(Code); \
-}
-#endif
-
-static void unsafe_closure_star(s7_scheme *sc)
-{
- s7_pointer x, z, e;
- unsigned long long int id;
-
- new_frame(sc, closure_let(sc->code), sc->envir);
- e = sc->envir;
- id = let_id(e);
-
- for (x = closure_args(sc->code), z = sc->args; is_pair(x); x = cdr(x))
- {
- s7_pointer sym, args, val;
- if (is_pair(car(x)))
- sym = caar(x);
- else sym = car(x);
- val = car(z);
- args = cdr(z);
-
- set_type(z, T_SLOT);
- slot_set_symbol(z, sym);
- symbol_set_local(sym, id, z);
- slot_set_value(z, val);
- set_next_slot(z, let_slots(e));
- let_set_slots(e, z);
- z = args;
- }
- sc->code = closure_body(sc->code);
-}
-
-static void fill_closure_star(s7_scheme *sc, s7_pointer p)
-{
- for (; is_pair(p); p = cdr(p))
- {
- if (is_pair(car(p)))
- {
- s7_pointer defval;
- defval = cadar(p);
- if (is_pair(defval))
- sc->args = cons(sc, cadr(defval), sc->args);
- else sc->args = cons(sc, defval, sc->args);
- }
- else sc->args = cons(sc, sc->F, sc->args);
- }
- sc->args = safe_reverse_in_place(sc, sc->args);
- sc->code = opt_lambda(sc->code);
-}
-
-static void fill_safe_closure_star(s7_scheme *sc, s7_pointer x, s7_pointer p)
-{
- for (; is_pair(p); p = cdr(p), x = next_slot(x))
- {
- if (is_pair(car(p)))
- {
- s7_pointer defval;
- defval = cadar(p);
- if (is_pair(defval))
- slot_set_value(x, cadr(defval));
- else slot_set_value(x, defval);
- }
- 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));
-}
-
-
static s7_pointer check_define_macro(s7_scheme *sc, opcode_t op)
{
s7_pointer x, y, caller;
@@ -56891,7 +61731,7 @@ static s7_pointer check_define_macro(s7_scheme *sc, opcode_t op)
eval_error_with_caller(sc, "~A: ~S is not a symbol?", caller, x);
if (dont_eval_args(x)) /* (define-macro (quote a) quote) */
{
- if (sc->safety > 0)
+ if (sc->safety > NO_SAFETY)
s7_warn(sc, 128, "%s: syntactic keywords tend to behave badly if redefined", DISPLAY(x));
set_local(x);
}
@@ -56988,14 +61828,17 @@ static int expansion_ex(s7_scheme *sc)
if (!is_let(sc->envir)) sc->envir = sc->nil;
#endif
symbol = car(sc->value);
+
if ((symbol_id(symbol) == 0) ||
(sc->envir == sc->nil))
slot = global_slot(symbol);
else slot = find_symbol(sc, symbol);
+
if (is_slot(slot))
sc->code = slot_value(slot);
else sc->code = sc->undefined;
- if (!is_expansion(sc->code))
+
+ if ((!is_macro(sc->code)) || (!is_expansion(sc->code)))
clear_expansion(symbol);
else
{
@@ -57032,6 +61875,7 @@ static s7_pointer check_cond(s7_scheme *sc)
{
bool has_feed_to = false;
s7_pointer x;
+
if (!is_pair(sc->code)) /* (cond) or (cond . 1) */
eval_error(sc, "cond, but no body: ~A", sc->code);
@@ -57070,7 +61914,7 @@ static s7_pointer check_cond(s7_scheme *sc)
{
if (has_feed_to)
{
- pair_set_syntax_symbol(sc->code, sc->cond_unchecked_symbol);
+ pair_set_syntax_symbol(sc->code, (is_optimized(caar(sc->code))) ? sc->cond_unchecked_z_symbol : sc->cond_unchecked_symbol);
if (is_null(cdr(sc->code)))
{
s7_pointer expr, f;
@@ -57078,7 +61922,9 @@ static s7_pointer check_cond(s7_scheme *sc)
f = caddr(expr);
if ((is_pair(f)) &&
(car(f) == sc->lambda_symbol) &&
- (is_null(cdr(cddr(f)))))
+ (is_pair(cdr(f))) && /* not => (lambda) */
+ (is_pair(cddr(f))) &&
+ (is_null(cdddr(f))))
{
s7_pointer arg;
arg = cadr(f);
@@ -57088,48 +61934,98 @@ static s7_pointer check_cond(s7_scheme *sc)
{
/* (define (hi) (cond (#t => (lambda (s) s)))) */
set_opt_lambda2(sc->code, caddar(sc->code)); /* (lambda ...) above */
- pair_set_syntax_symbol(sc->code, sc->if_p_feed_symbol);
+ pair_set_syntax_symbol(sc->code, sc->cond_feed_symbol);
}
}
}
}
else
{
- s7_pointer p, sym = NULL;
- bool xopt = true, c_s_is_ok = true;
+ s7_pointer p;
+ bool xopt = true, eopt = true;
pair_set_syntax_symbol(sc->code, sc->cond_simple_symbol);
for (p = sc->code; xopt && (is_pair(p)); p = cdr(p))
+ xopt = is_all_x_safe(sc, caar(p)); /* caar=test */
+ if (xopt)
{
- xopt = is_all_x_safe(sc, caar(p));
- if ((c_s_is_ok) &&
- (caar(p) != sc->T) &&
- (caar(p) != sc->else_object))
- {
- if ((!is_pair(caar(p))) ||
- (!is_h_safe_c_s(caar(p))) ||
- ((sym) && (sym != cadaar(p))))
- c_s_is_ok = false;
- else sym = cadaar(p);
- }
+ int i;
+ pair_set_syntax_symbol(sc->code, sc->cond_all_x_symbol);
+ for (i = 0, p = sc->code; is_pair(p); i++, p = cdr(p))
+ set_x_call(car(p), all_x_eval(sc, car(p), (is_null(sc->envir)) ? sc->rootlet : sc->envir, let_symbol_is_safe));
+ if (i == 2)
+ pair_set_syntax_symbol(sc->code, sc->cond_all_x_2_symbol);
+
+ for (p = sc->code; eopt && (is_pair(p)); p = cdr(p))
+ eopt = ((!is_pair(cdar(p))) || ((!is_pair(cddar(p))) && ((!is_pair(cadar(p))) || (is_optimized(cadar(p))))));
+ if (eopt)
+ pair_set_syntax_symbol(sc->code, sc->cond_all_x_z_symbol);
}
- if (c_s_is_ok)
- pair_set_syntax_symbol(sc->code, sc->cond_s_symbol);
- else
+ }
+ }
+ return(sc->code);
+}
+
+static int feed_to(s7_scheme *sc)
+{
+ /* old form (pre 6-June-16): this causes a double evaluation:
+ * (let ((x 'y) (y 32)) (cond ((values x y) => list))) -> '(32 32)
+ * but it should be '(y 32)
+ * it's also extremely slow: make/eval a list?!
+ *
+ * if (is_multiple_value(sc->value))
+ * sc->code = cons(sc, cadr(sc->code), multiple_value(sc->value));
+ * else sc->code = list_2(sc, cadr(sc->code), list_2(sc, sc->quote_symbol, sc->value));
+ * goto EVAL;
+ */
+ if (is_multiple_value(sc->value)) /* (cond ((values 1 2) => +)) */
+ {
+ sc->args = multiple_value(sc->value);
+ clear_multiple_value(sc->args);
+ }
+ else
+ {
+ if (is_symbol(cadr(sc->code)))
+ {
+ s7_pointer func;
+ func = find_symbol_checked(sc, cadr(sc->code)); /* car is => */
+ if ((is_c_function(func)) &&
+ (is_safe_procedure(func)))
{
- if (xopt)
+ if (((int)c_function_required_args(func) <= 1) &&
+ ((int)c_function_all_args(func) >= 1))
{
- int i;
- pair_set_syntax_symbol(sc->code, sc->cond_all_x_symbol);
- for (i = 0, p = sc->code; is_pair(p); i++, p = cdr(p))
- set_c_call(car(p), cond_all_x_eval(sc, caar(p), (is_null(sc->envir)) ? sc->rootlet : sc->envir)); /* handle 'else' specially here */
- if (i == 2)
- pair_set_syntax_symbol(sc->code, sc->cond_all_x_2_symbol);
+ sc->value = c_function_call(func)(sc, set_plist_1(sc, sc->value));
+ return(goto_START);
}
}
+ sc->code = func;
+ sc->args = list_1(sc, sc->value);
+ return(goto_APPLY);
}
+ else sc->args = list_1(sc, sc->value);
+ }
+
+ /* need to evaluate the target function */
+ push_stack(sc, OP_COND1_1, sc->args, sc->code);
+ sc->code = cadr(sc->code);
+ return(goto_EVAL);
+}
+
+static void set_dilambda_opt(s7_scheme *sc, s7_pointer opt, s7_pointer expr)
+{
+ s7_pointer func;
+ func = find_symbol_checked(sc, car(expr));
+ if ((is_closure(func)) &&
+ (is_safe_closure(closure_setter(func))))
+ {
+ s7_pointer setter;
+ setter = closure_setter(func);
+ pair_set_syntax_symbol(sc->code, opt);
+ if ((!(is_let(closure_let(setter)))) ||
+ (!(is_funclet(closure_let(setter)))))
+ make_funclet(sc, setter, car(expr), closure_let(setter));
}
- return(sc->code);
}
@@ -57152,9 +62048,6 @@ static s7_pointer check_set(s7_scheme *sc)
/* cadr (the value) has not yet been evaluated */
- if (is_immutable(car(sc->code))) /* (set! pi 3) */
- eval_error(sc, "set!: can't alter immutable object: ~S", car(sc->code));
-
if (is_pair(car(sc->code)))
{
if (is_pair(caar(sc->code)))
@@ -57169,6 +62062,11 @@ static s7_pointer check_set(s7_scheme *sc)
{
if (!is_symbol(car(sc->code))) /* (set! 12345 1) */
eval_error(sc, "set! can't change ~S", car(sc->code));
+ else
+ {
+ if (is_immutable_symbol(car(sc->code))) /* (set! pi 3) */
+ eval_error(sc, "set!: can't alter immutable object: ~S", car(sc->code));
+ }
}
if ((is_overlaid(sc->code)) &&
@@ -57199,12 +62097,16 @@ static s7_pointer check_set(s7_scheme *sc)
{
/* (set! (f s) ...) */
if (!is_pair(value))
- pair_set_syntax_symbol(sc->code, sc->set_pair_symbol);
+ {
+ pair_set_syntax_symbol(sc->code, sc->set_pair_symbol);
+ if (is_symbol(car(inner)))
+ set_dilambda_opt(sc, sc->set_dilambda_symbol, inner);
+ }
else
{
pair_set_syntax_symbol(sc->code, sc->set_pair_p_symbol);
/* splice_in_values protects us here from values */
- if (is_h_optimized(value)) /* this excludes h_unknown_g etc */
+ if (is_optimized(value))
{
pair_set_syntax_symbol(sc->code, sc->set_pair_z_symbol);
if (is_all_x_safe(sc, value))
@@ -57215,9 +62117,12 @@ static s7_pointer check_set(s7_scheme *sc)
obj = find_symbol_checked(sc, car(inner));
if ((is_c_function(obj)) &&
(is_c_function(c_function_setter(obj))))
- {
- pair_set_syntax_symbol(sc->code, sc->set_pair_a_symbol);
- }
+ pair_set_syntax_symbol(sc->code, sc->set_pair_a_symbol);
+ }
+ else
+ {
+ if (is_symbol(car(inner)))
+ set_dilambda_opt(sc, sc->set_dilambda_z_symbol, inner);
}
}
}
@@ -57228,12 +62133,12 @@ static s7_pointer check_set(s7_scheme *sc)
(is_symbol(car(inner))) &&
((is_symbol(value)) || (is_all_x_safe(sc, value))))
{
- if (is_symbol(value))
+ if (is_safe_symbol(value))
pair_set_syntax_symbol(sc->code, sc->set_let_s_symbol);
else
{
pair_set_syntax_symbol(sc->code, sc->set_let_all_x_symbol);
- set_c_call(cdr(sc->code), all_x_eval(sc, value, sc->envir, let_symbol_is_safe));
+ set_x_call(cdr(sc->code), all_x_eval(sc, cdr(sc->code), sc->envir, let_symbol_is_safe));
}
}
else
@@ -57266,7 +62171,15 @@ static s7_pointer check_set(s7_scheme *sc)
(!is_syntactic(settee)))
{
if (is_symbol(value))
- pair_set_syntax_symbol(sc->code, sc->set_symbol_s_symbol);
+ {
+ if (is_local_symbol(cdr(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->set_symbol_l_symbol);
+ else
+ {
+ if (is_slot(find_symbol(sc, value)))
+ pair_set_syntax_symbol(sc->code, sc->set_symbol_s_symbol);
+ }
+ }
else
{
if (!is_pair(value))
@@ -57298,10 +62211,10 @@ static s7_pointer check_set(s7_scheme *sc)
}
else
{
- if (is_h_optimized(value))
+ if (is_optimized(value))
{
pair_set_syntax_symbol(sc->code, sc->set_symbol_z_symbol);
- if (optimize_op(value) == HOP_SAFE_C_C)
+ if (is_h_safe_c_c(value))
{
pair_set_syntax_symbol(sc->code, sc->set_symbol_opcq_symbol);
/* opt1 here points back? */
@@ -57376,9 +62289,8 @@ static s7_pointer check_set(s7_scheme *sc)
}
}
}
-
if ((is_h_optimized(value)) &&
- (!is_unsafe(value)) &&
+ (!is_unsafe(value)) && /* is_unsafe(value) can happen! */
(is_not_null(cdr(value)))) /* (set! x (y)) */
{
if (is_not_null(cddr(value)))
@@ -57387,12 +62299,14 @@ static s7_pointer check_set(s7_scheme *sc)
(cadr(value) == settee))
{
if ((opt_cfunc(value) == add_s1) ||
- (opt_cfunc(value) == add_cs1))
+ (opt_cfunc(value) == add_cs1) ||
+ (opt_cfunc(value) == add_cl1))
pair_set_syntax_symbol(sc->code, sc->increment_1_symbol);
else
{
if ((opt_cfunc(value) == subtract_s1) ||
- (opt_cfunc(value) == subtract_cs1))
+ (opt_cfunc(value) == subtract_cs1) ||
+ (opt_cfunc(value) == subtract_cl1))
pair_set_syntax_symbol(sc->code, sc->decrement_1_symbol);
}
}
@@ -57405,7 +62319,7 @@ static s7_pointer check_set(s7_scheme *sc)
else
{
if ((settee == caddr(value)) &&
- (is_symbol(cadr(value))) &&
+ (is_safe_symbol(cadr(value))) &&
(caadr(sc->code) == sc->cons_symbol))
{
pair_set_syntax_symbol(sc->code, sc->set_cons_symbol);
@@ -57426,7 +62340,7 @@ static s7_pointer check_set(s7_scheme *sc)
static bool set_pair_p_3(s7_scheme *sc, s7_pointer obj, s7_pointer arg, s7_pointer value)
{
- /* fprintf(stderr, "%s: %s %s\n", __func__, DISPLAY(arg), DISPLAY(value)); */
+ /* fprintf(stderr, "p_3: %s\n", DISPLAY(obj)); */
if (is_slot(obj))
obj = slot_value(obj);
else eval_error(sc, "no generalized set for ~A", caar(sc->code));
@@ -57742,7 +62656,7 @@ static int set_pair_ex(s7_scheme *sc)
s7_wrong_number_of_args_error(sc, "no index for vector-set!: ~S", sc->code);
if ((!is_null(cddr(settee))) &&
- (type(cx) == T_VECTOR))
+ (is_normal_vector(cx)))
{
push_stack(sc, OP_SET2, cddr(settee), cdr(sc->code));
sc->code = list_2(sc, car(settee), cadr(settee));
@@ -57999,8 +62913,7 @@ static int set_pair_ex(s7_scheme *sc)
}
key = cadr(settee);
- if ((is_pair(key)) &&
- (car(key) == sc->quote_symbol))
+ if (is_proper_quote(sc, key))
{
s7_pointer val;
key = cadr(key);
@@ -58036,6 +62949,9 @@ static int set_pair_ex(s7_scheme *sc)
/* perhaps it has a setter */
if (is_procedure(c_function_setter(cx)))
{
+ /* here the setter can be anything, so we need to check the needs_copied_args bit
+ * (set! ((dilambda / (let ((x 3)) (lambda (y) (+ x y))))) 3)!
+ */
/* sc->code = cons(sc, c_function_setter(cx), s7_append(sc, cdar(sc->code), cdr(sc->code))); */
if (is_pair(cdar(sc->code)))
{
@@ -58044,24 +62960,36 @@ static int set_pair_ex(s7_scheme *sc)
{
if (is_null(cddar(sc->code)))
{
- set_car(sc->t2_1, find_symbol_checked(sc, cadar(sc->code)));
- set_car(sc->t2_2, find_symbol_checked(sc, cadr(sc->code)));
- sc->args = sc->t2_1;
+ if (needs_copied_args(c_function_setter(cx)))
+ sc->args = list_2(sc, find_symbol_checked(sc, cadar(sc->code)), find_symbol_checked(sc, cadr(sc->code)));
+ else
+ {
+ set_car(sc->t2_1, find_symbol_checked(sc, cadar(sc->code)));
+ set_car(sc->t2_2, find_symbol_checked(sc, cadr(sc->code)));
+ sc->args = sc->t2_1;
+ }
sc->code = c_function_setter(cx);
return(goto_APPLY); /* check arg num etc */
}
if ((is_symbol(caddar(sc->code))) &&
(is_null(cdddar(sc->code))))
{
- set_car(sc->t3_1, find_symbol_checked(sc, cadar(sc->code)));
- set_car(sc->t3_2, find_symbol_checked(sc, caddar(sc->code)));
- set_car(sc->t3_3, find_symbol_checked(sc, cadr(sc->code)));
- sc->args = sc->t3_1;
+ if (needs_copied_args(c_function_setter(cx)))
+ sc->args = list_3(sc,
+ find_symbol_checked(sc, cadar(sc->code)),
+ find_symbol_checked(sc, caddar(sc->code)),
+ find_symbol_checked(sc, cadr(sc->code)));
+ else
+ {
+ set_car(sc->t3_1, find_symbol_checked(sc, cadar(sc->code)));
+ set_car(sc->t3_2, find_symbol_checked(sc, caddar(sc->code)));
+ set_car(sc->t3_3, find_symbol_checked(sc, cadr(sc->code)));
+ sc->args = sc->t3_1;
+ }
sc->code = c_function_setter(cx);
return(goto_APPLY); /* check arg num etc */
}
}
-
push_op_stack(sc, c_function_setter(cx));
push_stack(sc, OP_EVAL_ARGS1, sc->nil, s7_append(sc, cddar(sc->code), cdr(sc->code)));
sc->code = cadar(sc->code);
@@ -58071,10 +62999,15 @@ static int set_pair_ex(s7_scheme *sc)
if ((is_null(cddr(sc->code))) &&
(!is_pair(cadr(sc->code))))
{
- if (is_symbol(cadr(sc->code)))
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(sc->code)));
- else set_car(sc->t1_1, cadr(sc->code));
- sc->args = sc->t1_1;
+ if (needs_copied_args(c_function_setter(cx)))
+ sc->args = list_1(sc, (is_symbol(cadr(sc->code))) ? find_symbol_checked(sc, cadr(sc->code)) : cadr(sc->code));
+ else
+ {
+ if (is_symbol(cadr(sc->code)))
+ set_car(sc->t1_1, find_symbol_checked(sc, cadr(sc->code)));
+ else set_car(sc->t1_1, cadr(sc->code));
+ sc->args = sc->t1_1;
+ }
sc->code = c_function_setter(cx);
return(goto_APPLY); /* check arg num etc */
}
@@ -58182,10 +63115,8 @@ static int set_pair_ex(s7_scheme *sc)
return(goto_EVAL);
}
-static void activate_let(s7_scheme *sc)
+static void activate_let(s7_scheme *sc, s7_pointer e)
{
- s7_pointer e;
- e = sc->value;
if (!is_let(e)) /* (with-let . "hi") */
eval_error_no_return(sc, sc->wrong_type_arg_symbol, "with-let takes an environment argument: ~A", e);
if (e == sc->rootlet)
@@ -58214,16 +63145,19 @@ static bool tree_match(s7_pointer tree)
return((tree_match(car(tree))) || (tree_match(cdr(tree))));
return(false);
}
+#define DO_PRINT 0
static bool do_is_safe(s7_scheme *sc, s7_pointer body, s7_pointer steppers, s7_pointer var_list, bool *has_set)
{
/* here any (unsafe?) closure or jumping-op (call/cc) or shadowed variable is trouble */
s7_pointer p;
+ if (DO_PRINT) fprintf(stderr, "%s\n", DISPLAY_80(body));
for (p = body; is_pair(p); p = cdr(p))
{
s7_pointer expr;
expr = car(p);
+ if (DO_PRINT) fprintf(stderr, " %s\n", DISPLAY_80(expr));
if (is_pair(expr))
{
s7_pointer x;
@@ -58239,49 +63173,72 @@ static bool do_is_safe(s7_scheme *sc, s7_pointer body, s7_pointer steppers, s7_p
switch (op)
{
case OP_MACROEXPAND:
- return(false);
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
case OP_QUOTE:
break;
case OP_LET:
case OP_LET_STAR:
- if (is_symbol(cadr(expr)))
- return(false);
-
case OP_LETREC:
case OP_LETREC_STAR:
- case OP_DO:
- for (vars = cadr(expr); is_pair(vars); vars = cdr(vars))
- {
- s7_pointer var;
- var = caar(vars);
- if ((direct_memq(var, var_list)) ||
- (direct_memq(var, steppers)))
- return(false);
+ {
+ s7_pointer nv;
+ nv = var_list;
- var_list = cons(sc, var, var_list);
- sc->x = var_list;
- if ((is_pair(cdar(vars))) &&
- (!do_is_safe(sc, cdar(vars), steppers, var_list, has_set)))
- {
- sc->x = sc->nil;
- return(false);
- }
- sc->x = sc->nil;
- }
- if (op == OP_DO)
- {
- /* set_unsafe_do(cdr(expr)); */
- if (!do_is_safe(sc, (op == OP_DO) ? cdddr(expr) : cddr(expr), steppers, var_list, has_set))
- return(false);
- }
- else
- {
- if (!do_is_safe(sc, cddr(expr), steppers, var_list, has_set))
- return(false);
- }
- break;
+ if (!is_pair(cdr(expr)))
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
+ if (!s7_is_list(sc, cadr(expr)))
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
+
+ for (vars = cadr(expr); is_pair(vars); vars = cdr(vars))
+ {
+ s7_pointer var;
+ if (!is_pair(car(vars)))
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
+ var = caar(vars);
+ if (direct_memq(var, ((op == OP_LET) || (op == OP_LETREC)) ? nv : var_list))
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
+ nv = cons(sc, var, nv);
+ sc->x = nv;
+ }
+ sc->x = sc->nil;
+ if (!do_is_safe(sc, cddr(expr), steppers, nv, has_set))
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
+ break;
+ }
+
+ case OP_DO:
+ {
+ s7_pointer nv;
+ if (DO_PRINT) fprintf(stderr, "do loop\n");
+ nv = var_list;
+ for (vars = cadr(expr); is_pair(vars); vars = cdr(vars))
+ {
+ s7_pointer var;
+ if (!is_pair(car(vars)))
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
+ var = caar(vars);
+ if ((direct_memq(var, nv)) ||
+ (direct_memq(var, steppers)))
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
+
+ nv = cons(sc, var, nv);
+ sc->x = nv;
+ if ((is_pair(cdar(vars))) &&
+ (!do_is_safe(sc, cdar(vars), steppers, nv, has_set)))
+ {
+ sc->x = sc->nil;
+ {if (DO_PRINT) fprintf(stderr, "%d, step %s\n", __LINE__, DISPLAY_80(cdar(vars))); return(false);}
+ }
+ }
+ sc->x = sc->nil;
+ if ((!do_is_safe(sc, caddr(expr), steppers, nv, has_set)) ||
+ (!do_is_safe(sc, cdddr(expr), steppers, nv, has_set)))
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
+ if (DO_PRINT) fprintf(stderr, "do is ok\n");
+ break;
+ }
case OP_SET:
{
@@ -58292,13 +63249,13 @@ static bool do_is_safe(s7_scheme *sc, s7_pointer body, s7_pointer steppers, s7_p
s7_pointer setv;
if ((!is_pair(settee)) ||
(!is_symbol(car(settee))))
- return(false);
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
setv = find_symbol_unexamined(sc, car(settee));
if (!((setv) &&
((is_sequence(setv)) ||
((is_c_function(setv)) &&
(is_safe_procedure(c_function_setter(setv)))))))
- return(false);
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
(*has_set) = true;
}
else
@@ -58310,51 +63267,82 @@ static bool do_is_safe(s7_scheme *sc, s7_pointer body, s7_pointer steppers, s7_p
set_match_symbol(settee);
res = tree_match(caadr(sc->code)); /* (set! end ...) in some fashion */
clear_match_symbol(settee);
- if (res) return(false);
+ if (res) {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
}
if (!direct_memq(cadr(expr), var_list)) /* is some non-local variable being set? */
(*has_set) = true;
}
if (!do_is_safe(sc, cddr(expr), steppers, var_list, has_set))
- return(false);
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
if (!safe_stepper(sc, expr, steppers)) /* is step var's value used as the stored value by set!? */
- return(false);
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
}
break;
+ case OP_LET_TEMPORARILY:
+ {
+ s7_pointer lp;
+ if ((!is_pair(cdr(expr))) ||
+ (!is_pair(cadr(expr))) ||
+ (!is_pair(cddr(expr))))
+ return(false);
+ for (lp = cadr(expr); is_pair(lp); lp = cdr(lp))
+ if ((!is_pair(car(lp))) ||
+ (!is_pair(cdar(lp))) ||
+ (!do_is_safe(sc, cdar(lp), steppers, var_list, has_set)))
+ return(false);
+ if (!do_is_safe(sc, cddr(expr), steppers, var_list, has_set))
+ return(false);
+ break;
+ }
+
+ case OP_COND:
+ {
+ s7_pointer cp;
+ for (cp = cdr(expr); is_pair(cp); cp = cdr(cp))
+ if (!do_is_safe(sc, car(cp), steppers, var_list, has_set))
+ return(false);
+ break;
+ }
+
+ case OP_CASE:
+ {
+ s7_pointer cp;
+ if (!do_is_safe(sc, cadr(expr), steppers, var_list, has_set))
+ return(false);
+ for (cp = cddr(expr); is_pair(cp); cp = cdr(cp))
+ if (!do_is_safe(sc, cdar(cp), steppers, var_list, has_set))
+ return(false);
+ break;
+ }
+
case OP_IF:
case OP_WHEN:
case OP_UNLESS:
- case OP_COND:
- case OP_CASE:
case OP_AND:
case OP_OR:
case OP_BEGIN:
if (!do_is_safe(sc, cdr(expr), steppers, var_list, has_set))
- return(false);
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
break;
case OP_WITH_LET:
return(true);
default:
- return(false);
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
}
- }
+ } /* is_syntactic(x=car(expr)) */
else
{
+ /* is a macro, we'll eventually expand it (if *_optimize), but that requires a symbol lookup here and s7_macroexpand */
if ((!is_optimized(expr)) ||
- (is_unsafe(expr)) ||
(!do_is_safe(sc, cdr(expr), steppers, var_list, has_set)))
- /* this is unreasonably retrictive because optimize_expression returns "unsafe"
- * even when everything is safe -- it's merely saying it could not find a
- * special optimization case for the expression.
- */
- return(false);
+ {if (DO_PRINT) fprintf(stderr, "%d, opt: %d\n", __LINE__, is_optimized(expr)); return(false);}
else
{
- if (is_setter(x)) /* "setter" includes stuff like cons and vector -- x is a symbol */
+ if (is_setter(x)) /* "setter" includes stuff like cons and vector -- x is a symbol */
{
/* (hash-table-set! ht i 0) -- caddr is being saved, so this is not safe
* similarly (vector-set! v 0 i) etc
@@ -58370,20 +63358,21 @@ static bool do_is_safe(s7_scheme *sc, s7_pointer body, s7_pointer steppers, s7_p
(direct_memq(caddr(expr), steppers))) ||
((is_symbol(cadddr(expr))) &&
(direct_memq(cadddr(expr), steppers))) ||
- (is_pair(cadddr(expr))))
+ ((is_pair(cadddr(expr))) &&
+ (tree_set_memq_b_pp(steppers, cadddr(expr)))))
(*has_set) = true;
}
if (!do_is_safe(sc, cddr(expr), steppers, var_list, has_set))
- return(false);
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
if (!safe_stepper(sc, expr, steppers))
- return(false);
+ {if (DO_PRINT) fprintf(stderr, "%d\n", __LINE__); return(false);}
}
}
}
- }
+ } /* is_symbol(x=car(expr)) */
else
{
- return(false);
+ {if (DO_PRINT) fprintf(stderr, "%d, %s not a symbol\n", __LINE__, DISPLAY_80(x)); return(false);}
/* car(expr) ("x") is not a symbol: ((mus-data loc) chan) for example
* but that's actually safe since it's just in effect vector-ref
* there are several examples in dlocsig: ((group-speakers group) i) etc
@@ -58401,13 +63390,18 @@ static bool preserves_type(s7_scheme *sc, unsigned int x)
(x == sc->multiply_class));
}
-
+static bool is_simple_expression(s7_scheme *sc, s7_pointer x)
+{
+ return((!is_pair(x)) ||
+ ((is_optimized(x)) &&
+ (is_all_x_safe(sc, x)) &&
+ (car(x) != sc->quote_symbol)));
+}
+
static s7_pointer check_do(s7_scheme *sc)
{
s7_pointer x;
- /* fprintf(stderr, "check_do: %s\n", DISPLAY(sc->code)); */
-
if ((!is_pair(sc->code)) || /* (do . 1) */
((!is_pair(car(sc->code))) && /* (do 123) */
(is_not_null(car(sc->code))))) /* (do () ...) is ok */
@@ -58422,33 +63416,38 @@ static s7_pointer check_do(s7_scheme *sc)
if (is_pair(car(sc->code)))
{
+ clear_symbol_list(sc);
for (x = car(sc->code); is_pair(x); x = cdr(x))
{
- if (!(is_pair(car(x)))) /* (do (4) (= 3)) */
+ s7_pointer y;
+ y = car(x);
+ if (!(is_pair(y))) /* (do (4) (= 3)) */
eval_error(sc, "do: variable name missing? ~A", sc->code);
- if (!is_symbol(caar(x))) /* (do ((3 2)) ()) */
- eval_error(sc, "do step variable: ~S is not a symbol?", x);
+ if (!is_symbol(car(y))) /* (do ((3 2)) ()) */
+ eval_error(sc, "do step variable: ~S is not a symbol?", y);
- if (is_immutable_symbol(caar(x))) /* (do ((pi 3 (+ pi 1))) ((= pi 4)) pi) */
- eval_error(sc, "do step variable: ~S is immutable", x);
+ if (is_immutable_symbol(car(y))) /* (do ((pi 3 (+ pi 1))) ((= pi 4)) pi) */
+ eval_error(sc, "do step variable: ~S is immutable", y);
- if (is_pair(cdar(x)))
+ if (is_pair(cdr(y)))
{
- if ((!is_pair(cddar(x))) &&
- (is_not_null(cddar(x)))) /* (do ((i 0 . 1)) ...) */
- eval_error(sc, "do: step variable info is an improper list?: ~A", sc->code);
+ 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(cddar(x))) &&
- (is_not_null(cdr(cddar(x))))) /* (do ((i 0 1 (+ i 1))) ...) */
- eval_error(sc, "do: step variable info has extra stuff after the increment: ~A", sc->code);
+ 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);
}
else eval_error(sc, "do: step variable has no initial value: ~A", x);
- set_local(caar(x));
+ set_local(car(y));
- /* (do ((i)) ...) */
+ if (symbol_is_in_list(sc, car(y))) /* (do ((i 0 (+ i 1)) (i 2))...) */
+ eval_error(sc, "duplicate identifier in do: ~A", x);
+ add_symbol_to_list(sc, car(y));
}
- if (is_not_null(x)) /* (do ((i 0 i) . 1) ((= i 1))) */
+ if (is_not_null(x)) /* (do ((i 0 i) . 1) ((= i 1))) */
eval_error(sc, "do: list of variables is improper: ~A", sc->code);
}
@@ -58466,33 +63465,115 @@ static s7_pointer check_do(s7_scheme *sc)
if ((is_overlaid(sc->code)) &&
(has_opt_back(sc->code)))
{
- s7_pointer vars, end, body;
-
- vars = car(sc->code);
- end = cadr(sc->code);
- body = cddr(sc->code);
+ s7_pointer vars, end, body, p;
+ int nvars, nsteps = 0;
pair_set_syntax_symbol(sc->code, sc->do_unchecked_symbol);
- /* an extremely annoying kludge -- define in the body can clobber the step expressions set up below!
+ end = cadr(sc->code);
+ if (!is_pair(end)) /* () as end+result -- uncommon, normally not optimizable anyway -- use (#f) instead */
+ 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 allxable, give up */
+
+ vars = car(sc->code);
+ if (is_null(vars))
+ {
+ pair_set_syntax_symbol(sc->code, sc->do_no_vars_symbol);
+ return(sc->nil);
+ }
+
+ /* 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 very expensive, and no one ever actually does this, so I'll wait.
- * maybe insert this into the loop above
+ * 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))
return(sc->code);
+ /* TODO: set up init/step allx choices */
+ for (nvars = 0, p = vars; is_pair(p); nvars++, p = cdr(p))
+ if (is_pair(cddar(p)))
+ {
+ x = car(p);
+ nsteps++;
+ }
+ /* 1/1 2/2 1/n n/m. 0/n almost never (only make-index where currently cell_optimize has no chance) */
+#if 1
+ if ((nvars > 1) &&
+ (nsteps == 1))
+ {
+ /* temporary */
+ for (nvars = 0, p = vars; is_pair(p); nvars++, p = cdr(p))
+ {
+ s7_pointer v;
+ v = car(p);
+ if (is_simple_expression(sc, cadr(v)))
+ set_x_call(cdr(v), all_x_eval(sc, cdr(v), sc->envir, let_symbol_is_safe));
+ else return(sc->code);
+ }
+
+ if (!is_simple_expression(sc, caddr(x))) /* x is the stepper */
+ return(sc->code);
+ if (is_pair(caddr(x)))
+ {
+ set_x_call(cddr(x), all_x_eval(sc, cddr(x), sc->envir, let_symbol_is_safe));
+ if (c_callee(cddr(x)) == all_x_c_add1)
+ {
+ if ((c_callee(end) == all_x_c_ss) &&
+ (caar(end) == sc->eq_symbol) &&
+ (cadar(end) == car(x)))
+ {
+ bool has_set = false;
+ if ((is_null(cdr(body))) &&
+ (do_is_safe(sc, body, sc->w = list_1(sc, car(x)), sc->nil, &has_set)))
+ {
+ if (!has_set)
+ {
+ pair_set_syntax_symbol(sc->code, sc->dotimes_one_step_symbol); /* safe dotimes */
+ return(sc->nil);
+ }
+ }
+ }
+ }
+ }
+
+ /* 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 allx
+ * :set frame non-steppers, then stepper at front, goto CHECK
+ * _1: step, CHECK: check end, push, code=, go begin1
+ *
+ * then add op_do_1step_add1: like do_no_vars but frame setup is more complicated, and need
+ * all the safe-stepper mutable ints and so on
+ */
+
+ /* 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 */
+
/* (define (hi) (do ((i 0 (+ i 1))) ((= i 3)) (display i)) (newline)) */
/* (define (hi) (do ((i 1.5 (+ i 1))) ((= i 2.5)) (display i) (newline)))
* in OP_SAFE_DOTIMES, for example, if init value is not an integer, it goes to OP_SIMPLE_DO
* remaining optimizable cases: we can step by 1 and use = for end, and yet simple_do(_p) calls the functions
* geq happens as often as =, and -1 as step
* also cdr as step to is_null as end
- * also what about no do-var cases? (do () ...)
- *
* also do body is optimized expr: vector_set_3 via hop_safe_c_sss for example or (vset v i (vref w i))
*/
if ((is_pair(end)) && (is_pair(car(end))) &&
@@ -58501,104 +63582,101 @@ static s7_pointer check_do(s7_scheme *sc)
{
/* loop has one step variable, and normal-looking end test
*/
- vars = car(vars);
- if ((safe_list_length(sc, vars) == 3) &&
- ((!is_pair(cadr(vars))) ||
- (is_h_safe_c_c(cadr(vars)))))
+ s7_pointer v;
+ v = car(vars);
+ if ((safe_list_length(sc, v) == 3) &&
+ ((!is_pair(cadr(v))) ||
+ (is_h_safe_c_c(cadr(v)))))
{
s7_pointer step_expr;
- step_expr = caddr(vars);
+ step_expr = caddr(v);
if ((is_optimized(step_expr)) &&
- (((optimize_op(step_expr) == HOP_SAFE_C_SC) && (car(vars) == cadr(step_expr))) ||
- ((optimize_op(step_expr) == HOP_SAFE_C_C) && (car(vars) == cadr(step_expr)) &&
- ((opt_cfunc(step_expr) == add_cs1) || (opt_cfunc(step_expr) == subtract_cs1))) ||
- ((optimize_op(step_expr) == HOP_SAFE_C_CS) && (car(vars) == caddr(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)) &&
+ ((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)))))
{
/* step var is (var const|symbol (op var const)|(op const var))
*/
end = car(end);
if ((is_optimized(end)) &&
- (car(vars) == cadr(end)) &&
+ (car(v) == cadr(end)) &&
(cadr(end) != caddr(end)) &&
+#if (!WITH_GMP)
((opt_any1(end) == equal_s_ic) ||
(optimize_op(end) == HOP_SAFE_C_SS) ||
- (optimize_op(end) == HOP_SAFE_C_SC)))
+ (optimize_op(end) == HOP_SAFE_C_SC))
+#else
+ ((optimize_op(end) == HOP_SAFE_C_SS) ||
+ (optimize_op(end) == HOP_SAFE_C_SC))
+#endif
+ )
{
/* end var is (op var const|symbol) using same var as step
* so at least we can use SIMPLE_DO
*/
bool has_set = false, one_line;
- one_line = ((safe_list_length(sc, body) == 1) && (is_pair(car(body))));
+ one_line = ((is_null(cdr(body))) && (is_pair(car(body))));
- if (opt_cfunc(step_expr) == add_cs1)
+ if ((opt_cfunc(step_expr) == add_cs1) || (opt_cfunc(step_expr) == add_cl1))
{
set_c_function(step_expr, add_s1);
set_optimize_op(step_expr, HOP_SAFE_C_SC);
}
- if (opt_cfunc(step_expr) == subtract_cs1)
+ if ((opt_cfunc(step_expr) == subtract_cs1) || (opt_cfunc(step_expr) == subtract_cl1))
{
set_c_function(step_expr, subtract_s1);
set_optimize_op(step_expr, HOP_SAFE_C_SC);
}
+#if (!WITH_GMP)
if (opt_cfunc(end) == equal_s_ic)
{
set_c_function(end, equal_2);
set_optimize_op(end, HOP_SAFE_C_SC);
}
-
- if ((opt_cfunc(step_expr) == add_s1) &&
- (opt_cfunc(end) == equal_2) &&
- (s7_is_integer(caddr(step_expr))) &&
- (s7_integer(caddr(step_expr)) == 1))
- {
- pair_set_syntax_symbol(sc->code, sc->simple_do_a_symbol);
- if ((one_line) &&
- (is_optimized(car(body))))
- pair_set_syntax_symbol(sc->code, sc->simple_do_e_symbol);
- }
- else pair_set_syntax_symbol(sc->code, sc->simple_do_symbol);
+#endif
+ pair_set_syntax_symbol(sc->code, sc->simple_do_symbol); /* simple_do: 1 var easy step/end */
if ((one_line) &&
((!is_optimized(car(body))) || (op_no_hop(car(body)) != OP_SAFE_C_C)) &&
- (is_syntactic_symbol(caar(body))))
+ (is_syntactic_symbol(caar(body))) &&
+ (s7_is_integer(caddr(step_expr))) &&
+ (s7_integer(caddr(step_expr)) == 1) &&
+ (c_function_class(opt_cfunc(step_expr)) == sc->add_class) &&
+ /* we check above that (car(v) == cadr(step_expr))
+ * and that (car(v) == cadr(end))
+ */
+ ((c_function_class(opt_cfunc(end)) == sc->equal_class) ||
+ (opt_cfunc(end) == geq_2)))
{
pair_set_syntax_op(car(body), symbol_syntax_op(caar(body)));
- pair_set_syntax_symbol(sc->code, sc->simple_do_p_symbol);
set_opt_pair2(sc->code, caddr(caar(sc->code)));
-
- if ((s7_is_integer(caddr(step_expr))) &&
- (s7_integer(caddr(step_expr)) == 1) &&
- (c_function_class(opt_cfunc(step_expr)) == sc->add_class) &&
- /* we check above that (car(vars) == cadr(step_expr))
- * and that (car(vars) == cadr(end))
- */
- ((c_function_class(opt_cfunc(end)) == sc->equal_class) ||
- (opt_cfunc(end) == geq_2)))
- pair_set_syntax_symbol(sc->code, sc->dotimes_p_symbol);
+ pair_set_syntax_symbol(sc->code, sc->dotimes_p_symbol); /* dotimes_p: simple + syntax body + 1 expr */
+ /* 5 bench, -60 gen, 653 all, 1423 snd-test */
}
- if (do_is_safe(sc, body, sc->w = list_1(sc, car(vars)), sc->nil, &has_set))
+ /* now look for the very common dotimes case
+ */
+ if ((((s7_is_integer(caddr(step_expr))) &&
+ (s7_integer(caddr(step_expr)) == 1)) ||
+ ((s7_is_integer(cadr(step_expr))) &&
+ (s7_integer(cadr(step_expr)) == 1))) &&
+ (c_function_class(opt_cfunc(step_expr)) == sc->add_class) &&
+ ((c_function_class(opt_cfunc(end)) == sc->equal_class) ||
+ (opt_cfunc(end) == geq_2)))
{
- /* now look for the very common dotimes case
- */
- if ((((s7_is_integer(caddr(step_expr))) &&
- (s7_integer(caddr(step_expr)) == 1)) ||
- ((s7_is_integer(cadr(step_expr))) &&
- (s7_integer(cadr(step_expr)) == 1))) &&
- (c_function_class(opt_cfunc(step_expr)) == sc->add_class) &&
- ((c_function_class(opt_cfunc(end)) == sc->equal_class) ||
- (opt_cfunc(end) == geq_2))
- )
+ if (do_is_safe(sc, body, sc->w = list_1(sc, car(v)), sc->nil, &has_set))
{
/* we're stepping by +1 and going to =
* the final integer check has to wait until run time (symbol value dependent)
*/
- pair_set_syntax_symbol(sc->code, sc->safe_do_symbol);
+ pair_set_syntax_symbol(sc->code, sc->safe_do_symbol); /* safe_do: body is safe, step by 1 */
if ((!has_set) &&
(c_function_class(opt_cfunc(end)) == sc->equal_class))
- pair_set_syntax_symbol(sc->code, sc->safe_dotimes_symbol);
+ pair_set_syntax_symbol(sc->code, sc->safe_dotimes_symbol); /* safe_dotimes: end is = */
}
}
return(sc->nil);
@@ -58612,94 +63690,86 @@ static s7_pointer check_do(s7_scheme *sc)
/* (define (hi) (do ((i 0 (+ i 1))) ((= i 3)) (display i)) (newline))
* (define (hi) (do ((i 0 (+ i 1)) (j 1 (+ j 1))) ((= i 3)) (display j))(newline))
*/
- vars = car(sc->code);
- end = cadr(sc->code);
-
- /* check end expression first */
- if ((is_pair(car(end))) &&
- (caar(end) != sc->quote_symbol) &&
- (is_optimized(car(end))) &&
- (is_all_x_safe(sc, car(end))))
- set_c_call(cdr(sc->code), all_x_eval(sc, car(end), sc->envir, let_symbol_is_safe));
- else return(sc->code);
-
- /* vars can be nil (no steppers) */
- if (is_pair(vars))
+ for (p = vars; is_pair(p); p = cdr(p))
{
- s7_pointer p;
- for (p = vars; is_pair(p); p = cdr(p))
+ s7_pointer var;
+ var = car(p);
+
+ if ((!is_all_x_safe(sc, cadr(var))) ||
+ ((is_pair(cddr(var))) &&
+ (!is_all_x_safe(sc, caddr(var)))))
{
- s7_pointer var;
- var = car(p);
-
- if ((!is_all_x_safe(sc, cadr(var))) ||
- ((is_pair(cddr(var))) &&
- (!is_all_x_safe(sc, caddr(var)))))
+ s7_pointer q;
+#if 0
+ fprintf(stderr, "%s bad %s %s\n", DISPLAY(var),
+ (is_optimized(cadr(var))) ? opt_names[optimize_op(cadr(var))] : "?",
+ ((is_pair(cddr(var))) && (is_optimized(caddr(var)))) ? opt_names[optimize_op(caddr(var))] : "?");
+#endif
+ for (q = vars; q != p; q = cdr(q))
+ clear_match_symbol(caar(q));
+ return(sc->code);
+ }
+ set_match_symbol(car(var));
+ }
+ /* we want to use the pending_value slot for other purposes, so make sure
+ * the current val is not referred to in any trailing step exprs. The inits
+ * are ok because at init-time, the new frame is not connected.
+ * another tricky case: current var might be used in previous step expr(!)
+ * and worse, the loop env can be changed by a top-level define in the body,
+ * clobbering the step_expression accessors in dox_step!
+ */
+ for (p = vars; is_pair(p); p = cdr(p))
+ {
+ s7_pointer var, val;
+ var = car(p);
+ val = cddr(var);
+ if (is_pair(val))
+ {
+ var = car(var);
+ clear_match_symbol(var); /* ignore current var */
+ if (tree_match(car(val)))
{
s7_pointer q;
- for (q = vars; q != p; q = cdr(q))
+ for (q = vars; is_pair(q); q = cdr(q))
clear_match_symbol(caar(q));
return(sc->code);
}
- set_match_symbol(car(var));
- }
- /* we want to use the pending_value slot for other purposes, so make sure
- * the current val is not referred to in any trailing step exprs. The inits
- * are ok because at init-time, the new frame is not connected.
- * another tricky case: current var might be used in previous step expr(!)
- * and worse, the loop env can be changed by a top-level define in the body,
- * clobbering the step_expression accessors in dox_step!
- */
- for (p = vars; is_pair(p); p = cdr(p))
- {
- s7_pointer var, val;
- var = car(p);
- val = cddr(var);
- if (is_pair(val))
- {
- var = car(var);
- clear_match_symbol(var); /* ignore current var */
- if (tree_match(car(val)))
- {
- s7_pointer q;
- for (q = vars; is_pair(q); q = cdr(q))
- clear_match_symbol(caar(q));
- return(sc->code);
- }
- set_match_symbol(var);
- }
+ set_match_symbol(var);
}
- for (p = vars; is_pair(p); p = cdr(p))
- clear_match_symbol(caar(p));
}
-
+ for (p = vars; is_pair(p); p = cdr(p))
+ clear_match_symbol(caar(p));
+
/* end and steps look ok! */
- pair_set_syntax_symbol(sc->code, sc->dox_symbol);
- set_opt_pair2(sc->code, car(end)); /* end expr */
+ 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
* but that means the is_all_x_safe check above also needs to use the local env?
*/
- if (is_pair(vars))
+ for (p = vars; is_pair(p); p = cdr(p))
{
- s7_pointer p;
- for (p = vars; is_pair(p); p = cdr(p))
+ s7_pointer var;
+ var = car(p);
+ if (is_pair(cdr(var)))
+ set_x_call(cdr(var), all_x_eval(sc, cdr(var), sc->envir, let_symbol_is_safe)); /* init val */
+ if (is_pair(cddr(var)))
{
- s7_pointer var;
- var = car(p);
- if (is_pair(cdr(var)))
- set_c_call(cdr(var), all_x_eval(sc, cadr(var), sc->envir, let_symbol_is_safe)); /* init val */
- if (is_pair(cddr(var)))
- {
- s7_pointer step_expr;
- step_expr = caddr(var);
- set_c_call(cddr(var), all_x_eval(sc, step_expr, vars, do_symbol_is_safe)); /* sets opt2(cddr(var)), not opt1 */
- if ((is_pair(step_expr)) &&
- (car(step_expr) != sc->quote_symbol) && /* opt_cfunc(==opt1) might not be set in this case (sigh) */
- (preserves_type(sc, c_function_class(opt_cfunc(step_expr)))))
- set_safe_stepper(cddr(var));
- }
+ s7_pointer step_expr;
+ step_expr = caddr(var);
+ set_x_call(cddr(var), all_x_eval(sc, cddr(var), vars, do_symbol_is_safe)); /* sets opt2(cddr(var)), not opt1 */
+
+ if ((is_pair(step_expr)) &&
+ (car(step_expr) != sc->quote_symbol) && /* opt_cfunc(==opt1) might not be set in this case (sigh) */
+ ((preserves_type(sc, c_function_class(opt_cfunc(step_expr)))) || /* add etc */
+ (car(step_expr) == sc->cdr_symbol) ||
+ (car(step_expr) == sc->cddr_symbol) ||
+ ((is_pair(cadr(var))) &&
+ (is_pair(s7_procedure_signature(sc, c_function_base(opt_cfunc(step_expr))))) &&
+ (car(s7_procedure_signature(sc, c_function_base(opt_cfunc(step_expr)))) != sc->T) &&
+ (caadr(var) == car(step_expr)))))
+ /* i.e. accept char-position as init/step, but not iterate */
+ set_safe_stepper(cddr(var));
}
}
/* there are only a couple of cases in snd-test where a multi-statement do body is completely all-x-able */
@@ -58708,110 +63778,114 @@ static s7_pointer check_do(s7_scheme *sc)
return(sc->code);
}
-static bool dox_pf_ok(s7_scheme *sc, s7_pointer code, s7_pointer scc, s7_function endf, bool all_pairs)
+static s7_pointer make_do_frame(s7_scheme *sc)
{
- s7_pointer p, endp;
- int body_len, i;
- s7_pf_t pf;
+ long long int id;
+ s7_pointer frame, vars;
- endp = caadr(scc);
- body_len = s7_list_length(sc, code);
+ new_frame(sc, sc->envir, frame); /* new frame is not tied into the symbol lookup process yet */
+ sc->temp11 = frame;
+ id = let_id(frame);
- s7_xf_new(sc, sc->envir);
- for (i = 0, p = code; is_pair(p); i++, p = cdr(p))
- if ((!is_symbol(caar(p))) ||
- (!xf_opt(sc, car(p))))
- break;
+ for (vars = car(sc->code); is_pair(vars); vars = cdr(vars))
+ {
+ s7_pointer v, slot;
+ v = car(vars);
+ new_cell_no_check(sc, slot, T_SLOT);
+ slot_set_symbol(slot, car(v));
+ slot_set_value(slot, sc->F);
+ set_next_slot(slot, let_slots(frame)); /* GC protect it right away */
+ let_set_slots(frame, slot);
+ symbol_set_local(slot_symbol(slot), id, slot);
+ slot_set_value(slot, c_call(cdr(v))(sc, cadr(v)));
+ slot_set_expression(slot, cddr(v));
+ if (is_pair(cddr(v)))
+ dox_set_slot1(frame, slot);
+ }
+
+ sc->temp11 = sc->nil;
+ return(frame);
+}
- if ((is_null(p)) &&
- (pf = xf_opt(sc, endp)))
+static void update_steppers(s7_scheme *sc)
+{
+ /* TODO: probably need to use pending_expr here etc */
+ s7_pointer v;
+ for (v = let_slots(sc->envir); is_slot(v); v = next_slot(v))
{
- s7_pointer slots;
- s7_pointer *top;
+ s7_pointer step_expr;
+ step_expr = slot_expression(v);
+ if (!is_null(step_expr))
+ slot_set_value(v, c_call(step_expr)(sc, car(step_expr)));
+ }
+}
- slots = let_slots(sc->envir);
- top = sc->cur_rf->data;
-
- if ((all_pairs) && (body_len == 1))
- {
- s7_rf_t rf;
- rf = (s7_rf_t)(*top);
- top++;
- while (true)
+static bool has_safe_steppers(s7_scheme *sc, s7_pointer frame)
+{
+ s7_pointer slot;
+ for (slot = let_slots(frame); is_slot(slot); slot = next_slot(slot))
+ {
+ 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_t_integer(val)) /* a temporary kludge */
{
- s7_pointer slot;
- s7_pointer *temp;
- s7_pointer **rp;
-
- temp = top;
- rp = &temp;
- rf(sc, rp);
-
- for (slot = slots; is_slot(slot); slot = next_slot(slot))
- if (is_pair(slot_expression(slot)))
- slot_set_pending_value(slot, c_call(slot_expression(slot))(sc, car(slot_expression(slot))));
- for (slot = slots; is_slot(slot); slot = next_slot(slot))
- if (is_pair(slot_expression(slot)))
- slot_set_value(slot, slot_pending_value(slot));
-
- (*rp)++;
- if (is_true(sc, pf(sc, rp)))
- {
- s7_xf_free(sc);
- sc->code = cdadr(scc);
- return(true);
- }
+ sc->pc = 0;
+ if (int_optimize(sc, step_expr))
+ set_safe_stepper(slot);
+ else clear_safe_stepper(slot);
}
- }
- else
- {
- while (true)
+ else
{
- s7_pointer slot;
- s7_pointer *temp;
- s7_pointer **rp;
-
- temp = top;
- rp = &temp;
-
- for (i = 0; i < body_len; i++)
- {
- s7_rf_t rf;
- rf = (s7_rf_t)(**rp); (*rp)++;
- rf(sc, rp);
- }
-
- for (slot = slots; is_slot(slot); slot = next_slot(slot))
- if (is_pair(slot_expression(slot)))
- slot_set_pending_value(slot, c_call(slot_expression(slot))(sc, car(slot_expression(slot))));
- for (slot = slots; is_slot(slot); slot = next_slot(slot))
- if (is_pair(slot_expression(slot)))
- slot_set_value(slot, slot_pending_value(slot));
-
- (*rp)++;
- if (is_true(sc, pf(sc, rp)))
+ if (is_real(val)) /* a temporary kludge */
{
- s7_xf_free(sc);
- sc->code = cdadr(scc);
- return(true);
- }
+ sc->pc = 0;
+ if (float_optimize(sc, step_expr))
+ set_safe_stepper(slot);
+ else clear_safe_stepper(slot);
+ }
+ else set_safe_stepper(slot);
}
}
+ if (!is_safe_stepper(slot))
+ return(false);
}
- s7_xf_free(sc);
- return(false);
+ return(true);
}
+
static int dox_ex(s7_scheme *sc)
{
/* any number of steppers using dox exprs, end also dox, body and end result arbitrary.
* since all these exprs are local, we don't need to jump until the body
*/
long long int id;
- s7_pointer frame, vars, slot, code;
+ s7_pointer frame, vars, slot, code, end, endp;
s7_function endf;
- bool all_pairs = true;
-
+
+ /* fprintf(stderr, "dox_ex: %d %s\n", is_unsafe_do(sc->code), DISPLAY_80(sc->code)); */
+
+#if 0
+ /* teq tmac index tref tlet tcopy tauto tform tmap titer(much changed) tsort toss-up,
+ * lt(1) tall tgen(1.5) thash(much slower -- reader? yes--the let(*) -- set has type[char-position?] trouble), call(1)
+ * fft faster(1.5)
+ */
+ if (!pair_no_opt(sc->code))
+ {
+ endf = s7_optimize(sc, cons(sc, cons(sc, sc->do_symbol, sc->code), sc->nil));
+ if (endf)
+ {
+ sc->value = endf(sc, sc->code);
+ sc->code = sc->nil;
+ return(goto_SAFE_DO_END_CLAUSES);
+ }
+ set_pair_no_opt(sc->code);
+ }
+#endif
+
new_frame(sc, sc->envir, frame); /* new frame is not tied into the symbol lookup process yet */
sc->temp11 = frame;
for (vars = car(sc->code); is_pair(vars); vars = cdr(vars))
@@ -58827,28 +63901,13 @@ static int dox_ex(s7_scheme *sc)
else
{
if (is_symbol(expr))
- val = find_symbol_checked(sc, expr);
+ val = find_symbol_checked(sc, expr); /* symbol as init? */
else val = expr;
}
new_cell_no_check(sc, slot, T_SLOT);
slot_set_symbol(slot, caar(vars));
slot_set_value(slot, val);
- set_stepper(slot);
slot_set_expression(slot, cddar(vars));
-
- if (is_pair(slot_expression(slot)))
- {
- if (is_safe_stepper(slot_expression(slot)))
- {
- s7_pointer step_expr;
- step_expr = car(slot_expression(slot));
- if ((is_pair(cddr(step_expr))) &&
- (type(val) == type(caddr(step_expr))))
- set_safe_stepper(slot);
- }
- }
- else all_pairs = false;
-
set_next_slot(slot, let_slots(frame));
let_set_slots(frame, slot);
}
@@ -58859,24 +63918,22 @@ static int dox_ex(s7_scheme *sc)
for (slot = let_slots(frame); is_slot(slot); slot = next_slot(slot))
symbol_set_local(slot_symbol(slot), id, slot);
- if (is_true(sc, c_call(cdr(sc->code))(sc, opt_pair2(sc->code))))
+ end = cadr(sc->code);
+ endp = car(end);
+ endf = c_callee(end);
+ if (is_true(sc, sc->value = endf(sc, endp)))
{
/* if no end result exprs, we return nil, but others probably #<unspecified>
* (let ((x (do ((i 0 (+ i 1))) (#t)))) x) -> ()
*/
- sc->code = cdadr(sc->code);
+ sc->code = cdr(end);
return(goto_DO_END_CLAUSES);
}
code = cddr(sc->code);
- endf = c_callee(cdr(sc->code));
-
if (is_null(code)) /* no body? */
{
- s7_pointer endp, slots, scc;
- scc = sc->code;
- endp = opt_pair2(sc->code);
-
+ s7_pointer slots;
if (endf == all_x_c_c)
{
endf = c_callee(endp);
@@ -58884,14 +63941,6 @@ static int dox_ex(s7_scheme *sc)
}
slots = let_slots(sc->envir);
-
- if (!is_slot(slots))
- {
- while (!is_true(sc, endf(sc, endp)));
- sc->code = cdadr(scc);
- return(goto_DO_END_CLAUSES);
- }
-
if ((is_null(next_slot(slots))) && (is_pair(slot_expression(slots))))
{
s7_function f;
@@ -58908,9 +63957,9 @@ static int dox_ex(s7_scheme *sc)
while (true) /* thash titer */
{
slot_set_value(slots, f(sc, a));
- if (is_true(sc, endf(sc, endp)))
+ if (is_true(sc, sc->value = endf(sc, endp)))
{
- sc->code = cdadr(scc);
+ sc->code = cdr(end);
return(goto_DO_END_CLAUSES);
}
}
@@ -58923,20 +63972,130 @@ static int dox_ex(s7_scheme *sc)
for (slt = slots; is_slot(slt); slt = next_slot(slt))
if (is_pair(slot_expression(slt)))
slot_set_value(slt, c_call(slot_expression(slt))(sc, car(slot_expression(slt))));
- if (is_true(sc, endf(sc, endp)))
+ if (is_true(sc, sc->value = endf(sc, endp)))
{
- sc->code = cdadr(scc);
+ sc->code = cdr(end);
return(goto_DO_END_CLAUSES);
}
}
}
}
+ else /* there is a body */
+ {
+ if (!is_unsafe_do(sc->code))
+ {
+ s7_pointer slots;
+ slots = let_slots(sc->envir);
+ /* is let activated? also multiexpr body and other allx? */
+
+ if ((is_null(cdr(code))) &&
+ (is_pair(car(code))))
+ {
+ s7_pointer lcode;
+ s7_function body = NULL;
+ lcode = car(code);
+
+ if ((!pair_no_opt(code)) &&
+ (has_safe_steppers(sc, sc->envir)))
+ {
+ body = s7_optimize_nr(sc, code);
+ if (!body)
+ set_pair_no_opt(code);
+ }
+ if (!body)
+ {
+ if (is_all_x_safe(sc, lcode))
+ body = all_x_eval(sc, code, sc->envir, let_symbol_is_safe);
+ }
+ if (body)
+ {
+ while (true)
+ {
+ s7_pointer slot;
+ body(sc, lcode);
+ for (slot = slots; is_slot(slot); slot = next_slot(slot))
+ if (is_pair(slot_expression(slot)))
+ slot_set_value(slot, c_call(slot_expression(slot))(sc, car(slot_expression(slot))));
+ if (is_true(sc, sc->value = endf(sc, endp)))
+ {
+ sc->code = cdr(end);
+ return(goto_DO_END_CLAUSES);
+ }
+ }
+ }
+ }
+ else /* more than one expr */
+ {
+ s7_pointer p;
+ bool use_opts = false;
+ int body_len = 0;
+ p = code;
+
+ if ((!pair_no_opt(code)) &&
+ (has_safe_steppers(sc, sc->envir)))
+ {
+ if (setjmp(sc->opt_exit) == 0)
+ {
+ start_opts(sc);
+ for (; is_pair(p); p = cdr(p), body_len++)
+ if (!cell_optimize(sc, p))
+ {
+ set_pair_no_opt(code);
+ p = code;
+ break;
+ }
+ use_opts = is_null(p);
+ }
+ }
+
+ if (p == code)
+ {
+ for (; is_pair(p); p = cdr(p))
+ if (!is_all_x_safe(sc, car(p)))
+ break;
+ }
+
+ if (is_null(p))
+ {
+ int i;
+ if (!use_opts)
+ annotate_args(sc, code, sc->envir);
+
+ while (true)
+ {
+ s7_pointer slot;
+ if (use_opts)
+ {
+ sc->pc = 0;
+ for (i = 0; i < body_len; i++)
+ {
+ opt_info *o;
+ o = sc->opts[sc->pc];
+ o->v7.fp(o);
+ sc->pc++;
+ }
+ }
+ else
+ {
+ for (p = code; is_pair(p); p = cdr(p))
+ c_call(p)(sc, car(p));
+ }
+
+ for (slot = slots; is_slot(slot); slot = next_slot(slot))
+ if (is_pair(slot_expression(slot)))
+ slot_set_value(slot, c_call(slot_expression(slot))(sc, car(slot_expression(slot))));
+ if (is_true(sc, sc->value = endf(sc, endp)))
+ {
+ sc->code = cdr(end);
+ return(goto_DO_END_CLAUSES);
+ }
+ }
+ }
+ }
+ set_unsafe_do(sc->code);
+ }
+ }
- if ((!is_unsafe_do(sc->code)) &&
- (dox_pf_ok(sc, code, sc->code, endf, all_pairs)))
- return(goto_DO_END_CLAUSES);
-
- set_unsafe_do(sc->code);
if ((is_null(cdr(code))) && /* one expr */
(is_pair(car(code))))
{
@@ -58967,12 +64126,27 @@ static int simple_do_ex(s7_scheme *sc, s7_pointer code)
{
s7_pointer body, step_expr, step_var, ctr, end;
s7_function stepf, endf;
- s7_pf_t rf;
+ s7_function func;
+
+ /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY_80(opt_pair2(code))); */
body = car(opt_pair2(code));
if (!is_symbol(car(body)))
return(fall_through);
+ /* TODO: check_do for this */
+ if (!pair_no_opt(opt_pair2(code)))
+ {
+ func = s7_optimize_nr(sc, opt_pair2(code));
+ if (!func)
+ {
+ set_pair_no_opt(opt_pair2(code));
+ return(fall_through);
+ }
+ }
+ else return(fall_through);
+
+ /* func must be set */
step_expr = caddr(caar(code));
stepf = c_callee(step_expr);
endf = c_callee(caadr(code));
@@ -58981,200 +64155,267 @@ static int simple_do_ex(s7_scheme *sc, s7_pointer code)
step_var = caddr(step_expr);
#if (!WITH_GMP)
- set_stepper(ctr);
if (((stepf == g_subtract_s1) && (endf == g_less_s0)) ||
- ((stepf == g_add_s1) && (endf == g_equal_2))) /* add_s1 means (+ sym 1) */
+ ((stepf == g_add_s1) && (endf == g_equal_2)))
set_safe_stepper(ctr);
#endif
- s7_xf_new(sc, sc->envir);
- rf = xf_opt(sc, body);
- if (rf)
- {
- s7_pointer *top;
- /* fprintf(stderr, "ex: %s\n", DISPLAY(code)); */
- top = sc->cur_rf->data;
- top++;
-#if (!WITH_GMP)
- if ((stepf == g_add_s1) && (endf == g_equal_2))
+
+ if ((stepf == g_add_s1) &&
+ (is_integer(slot_value(ctr))) &&
+ (endf == g_equal_2) &&
+ (is_integer(slot_value(end))))
+ {
+ s7_int i, start, stop;
+ start = integer(slot_value(ctr));
+ stop = integer(slot_value(end));
+
+ if (func == opt_cell_any_nr)
{
- while (true)
+ opt_info *o;
+ s7_pointer (*fp)(void *o);
+ cur_sc = sc;
+ o = sc->opts[0];
+ fp = o->v7.fp;
+ for (i = start; i < stop; i++)
{
- s7_pointer *temp;
- temp = top;
- rf(sc, &temp);
- slot_set_value(ctr, c_add_s1(sc, slot_value(ctr)));
- if (is_true(sc, c_equal_2(sc, slot_value(ctr), slot_value(end))))
- {
- s7_xf_free(sc);
- sc->code = cdr(cadr(code));
- return(goto_DO_END_CLAUSES);
- }
+ slot_set_value(ctr, make_integer(sc, i));
+ sc->pc = 0;
+ fp(o);
}
}
-#endif
- while (true)
+ else
{
- s7_pointer *temp;
- temp = top;
- rf(sc, &temp);
-
- set_car(sc->t2_1, slot_value(ctr));
- set_car(sc->t2_2, step_var);
- slot_set_value(ctr, stepf(sc, sc->t2_1));
-
- set_car(sc->t2_1, slot_value(ctr));
- set_car(sc->t2_2, slot_value(end));
- if (is_true(sc, endf(sc, sc->t2_1)))
+ for (i = start; i < stop; i++)
{
- s7_xf_free(sc);
- sc->code = cdr(cadr(code));
- return(goto_DO_END_CLAUSES);
+ slot_set_value(ctr, make_integer(sc, i));
+ func(sc, body);
}
}
+
+ sc->value = sc->T;
+ sc->code = cdadr(code);
+ return(goto_DO_END_CLAUSES);
+ }
+
+ while (true)
+ {
+ func(sc, body);
+
+ set_car(sc->t2_1, slot_value(ctr));
+ set_car(sc->t2_2, step_var);
+ slot_set_value(ctr, stepf(sc, sc->t2_1));
+
+ set_car(sc->t2_1, slot_value(ctr));
+ set_car(sc->t2_2, slot_value(end));
+ if (is_true(sc, sc->value = endf(sc, sc->t2_1)))
+ {
+ sc->code = cdadr(code);
+ return(goto_DO_END_CLAUSES);
+ }
}
- s7_xf_free(sc);
return(fall_through);
}
-static bool pf_ok(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool safe_step)
+static bool opt_dotimes(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool safe_step)
{
- s7_pointer p;
- int body_len, i;
+ int i, body_len;
+ s7_int end;
+
+ if (sc->safety > CLM_OPTIMIZATION_SAFETY) return(false);
if (safe_step)
set_safe_stepper(sc->args);
else set_safe_stepper(dox_slot1(sc->envir));
body_len = s7_list_length(sc, code);
- s7_xf_new(sc, sc->envir);
- for (i = 0, p = code; is_pair(p); i++, p = cdr(p))
- if (!xf_opt(sc, car(p)))
- break;
+ /* fprintf(stderr, "opt_dotimes: %s %d %d %d\n", DISPLAY(code), safe_step, body_len, pair_no_opt(code)); */
- if (is_null(p))
+ /* I think safe_step means the stepper is completely unproblematic */
+ if (body_len == 1) /* && (safe_step)) */
{
- s7_pointer stepper;
- s7_pointer *top;
- s7_int end;
-
- stepper = slot_value(sc->args);
- end = denominator(stepper);
- top = sc->cur_rf->data;
+ s7_function func;
+
+ if (pair_no_opt(code)) return(false);
+ func = s7_optimize_nr(sc, code);
+ if (!func)
+ {
+ set_pair_no_opt(code);
+ return(false);
+ }
+
+ end = denominator(slot_value(sc->args));
if (safe_step)
{
- if (body_len == 1)
+ s7_pointer stepper;
+ slot_set_value(sc->args, stepper = make_mutable_integer(sc, integer(slot_value(sc->args))));
+ if ((func == opt_float_any_nr) ||
+ (func == opt_cell_any_nr))
{
- s7_int end4;
- s7_rf_t rf;
- rf = (s7_rf_t)(*top);
- top++;
- end4 = end - 4;
- for (; numerator(stepper) < end4; numerator(stepper)++)
+ opt_info *o;
+ cur_sc = sc;
+ o = sc->opts[0];
+ if (func == opt_float_any_nr)
{
- s7_pointer *rp;
- rp = top;
- rf(sc, &rp);
- numerator(stepper)++;
- rp = top;
- rf(sc, &rp);
- numerator(stepper)++;
- rp = top;
- rf(sc, &rp);
- numerator(stepper)++;
- rp = top;
- rf(sc, &rp);
+ s7_double (*fd)(void *o);
+ fd = o->v7.fd;
+ if ((fd == opt_d_id_sf) && /* by far the most common case in clm: (outa i ...) etc */
+ (is_slot(o->v1.p)) &&
+ (stepper == slot_value(o->v1.p)))
+ {
+ opt_info *o1;
+ s7_d_id_t f0;
+ f0 = o->v3.d_id_f;
+ o1 = sc->opts[1];
+ fd = o1->v7.fd;
+ for (; integer(stepper) < end; integer(stepper)++)
+ {
+ sc->pc = 1;
+ f0(integer(stepper), fd(o1));
+ }
+ }
+ else
+ {
+ for (; integer(stepper) < end; integer(stepper)++)
+ {
+ sc->pc = 0;
+ fd(o);
+ }
+ }
}
- for (; numerator(stepper) < end; numerator(stepper)++)
+ else
{
- s7_pointer *rp;
- rp = top;
- rf(sc, &rp);
+ s7_pointer (*fp)(void *o);
+ fp = o->v7.fp;
+ for (; integer(stepper) < end; integer(stepper)++)
+ {
+ sc->pc = 0;
+ fp(o);
+ }
}
}
else
{
- for (; numerator(stepper) < end; numerator(stepper)++)
- {
- s7_pointer *temp;
- s7_pointer **rp;
-
- temp = top;
- rp = &temp;
- for (i = 0; i < body_len; i++)
- {
- s7_rf_t rf;
- rf = (s7_rf_t)(**rp); (*rp)++;
- rf(sc, rp);
- }
- }
+ for (; integer(stepper) < end; integer(stepper)++)
+ func(sc, car(code));
}
}
else
{
- /* can't re-use the stepper value directly */
- s7_pointer step_slot, end_slot;
s7_int step;
-
+ s7_pointer step_slot, end_slot;
step_slot = dox_slot1(sc->envir);
end_slot = dox_slot2(sc->envir);
-
- if (body_len == 1)
+
+ if (func == opt_cell_any_nr)
{
- s7_rf_t rf;
- rf = (s7_rf_t)(*top);
- top++;
+ opt_info *o;
+ s7_pointer (*fp)(void *o);
+ cur_sc = sc;
+ o = sc->opts[0];
+ fp = o->v7.fp;
while (true)
{
- s7_pointer *rp;
- rp = top;
- rf(sc, &rp);
-
- step = s7_integer(slot_value(step_slot)) + 1;
- slot_set_value(step_slot, make_integer(sc, step));
- if (step == s7_integer(slot_value(end_slot))) break;
+ sc->pc = 0;
+ fp(o);
+ /* TODO: are these type checks needed now? -- could check setter+integer etc in cell_optimize */
+ if (!is_integer(slot_value(step_slot)))
+ {
+ slot_set_value(step_slot, g_add_1s(sc, set_plist_2(sc, small_int(1), slot_value(step_slot))));
+ if (is_true(sc, g_equal_2(sc, set_plist_2(sc, slot_value(step_slot), slot_value(end_slot))))) break;
+ }
+ else
+ {
+ step = s7_integer(slot_value(step_slot)) + 1;
+ slot_set_value(step_slot, make_integer(sc, step));
+ if (step == s7_integer(slot_value(end_slot))) break;
+ }
}
}
else
{
while (true)
{
- s7_pointer *temp;
- s7_pointer **rp;
-
- temp = top;
- rp = &temp;
- for (i = 0; i < body_len; i++)
+ func(sc, car(code));
+ if (!is_integer(slot_value(step_slot)))
{
- s7_rf_t rf;
- rf = (s7_rf_t)(**rp); (*rp)++;
- rf(sc, rp);
+ slot_set_value(step_slot, g_add_1s(sc, set_plist_2(sc, small_int(1), slot_value(step_slot))));
+ if (is_true(sc, g_equal_2(sc, set_plist_2(sc, slot_value(step_slot), slot_value(end_slot))))) break;
+ }
+ else
+ {
+ step = s7_integer(slot_value(step_slot)) + 1;
+ slot_set_value(step_slot, make_integer(sc, step));
+ if (step == s7_integer(slot_value(end_slot))) break;
}
-
- step = s7_integer(slot_value(step_slot)) + 1;
- slot_set_value(step_slot, make_integer(sc, step));
- if (step == s7_integer(slot_value(end_slot))) break;
}
}
}
- s7_xf_free(sc);
+ sc->value = sc->T;
sc->code = cdadr(scc);
return(true);
}
- s7_xf_free(sc);
- return(false);
+
+ if (setjmp(sc->opt_exit) == 0)
+ {
+ s7_pointer p;
+ start_opts(sc);
+ for (p = code; is_pair(p); p = cdr(p))
+ if (!float_optimize(sc, p))
+ return(false);
+ }
+ else return(false);
+ /* TODO: here and in opt_let, generalize the body exprs */
+
+ end = denominator(slot_value(sc->args));
+ if (safe_step)
+ {
+ s7_pointer stepper;
+ slot_set_value(sc->args, stepper = make_mutable_integer(sc, integer(slot_value(sc->args))));
+ for (; integer(stepper) < end; integer(stepper)++)
+ {
+ sc->pc = 0;
+ for (i = 0; i < body_len; i++)
+ {
+ sc->opts[sc->pc]->v7.fd(sc->opts[sc->pc]);
+ sc->pc++;
+ }
+ }
+ }
+ else
+ {
+ s7_pointer step_slot, end_slot;
+ step_slot = dox_slot1(sc->envir);
+ end_slot = dox_slot2(sc->envir);
+ while (true)
+ {
+ s7_int step;
+ sc->pc = 0;
+ for (i = 0; i < body_len; i++)
+ {
+ sc->opts[sc->pc]->v7.fd(sc->opts[sc->pc]);
+ sc->pc++;
+ }
+
+ step = s7_integer(slot_value(step_slot)) + 1;
+ slot_set_value(step_slot, make_integer(sc, step));
+ if (step == s7_integer(slot_value(end_slot))) break;
+ }
+ }
+ sc->value = sc->T;
+ sc->code = cdadr(scc);
+ return(true);
}
-static int let_pf_ok(s7_scheme *sc, s7_pointer step_slot, s7_pointer scc, bool safe_case)
+static int opt_let(s7_scheme *sc, s7_pointer step_slot, s7_pointer scc, bool safe_case)
{
s7_pointer let_body, p = NULL, let_vars, let_code;
bool let_star;
- int body_len;
- s7_rf_t varf = NULL;
s7_pointer old_e, stepper;
- int var_len;
+ int body_len, var_len;
- /* fprintf(stderr, "%lld %lld %s %d\n", numerator(step_slot), denominator(step_slot), DISPLAY(scc), safe_case); */
+ if (sc->safety > CLM_OPTIMIZATION_SAFETY) return(fall_through);
+ /* fprintf(stderr, "let_ok: %s\n", DISPLAY(scc)); */
let_code = caddr(scc);
let_body = cddr(let_code);
@@ -59186,181 +64427,98 @@ static int let_pf_ok(s7_scheme *sc, s7_pointer step_slot, s7_pointer scc, bool s
old_e = sc->envir;
sc->envir = new_frame_in_env(sc, sc->envir);
-
- s7_xf_new(sc, old_e);
- for (var_len = 0, p = let_vars; (is_pair(p)) && (is_pair(cadar(p))); var_len++, p = cdr(p))
- {
- s7_int var_loc;
- s7_pointer expr, fcar, car_ex;
- s7_rp_t varp;
-
- var_loc = s7_xf_store(sc, NULL);
- expr = cadar(p);
- car_ex = car(expr);
- /* fcar = find_symbol_checked(sc, car(expr)); */
-
- if (!is_symbol(car_ex)) break;
- fcar = find_symbol(sc, car_ex);
- if (!is_slot(fcar)) break;
- fcar = slot_value(fcar);
-
- varp = rf_function(fcar);
- if (!varp) break;
- varf = varp(sc, expr);
- if (!varf) break;
- s7_xf_store_at(sc, var_loc, (s7_pointer)varf);
- if (let_star)
- make_slot_1(sc, sc->envir, caar(p), s7_make_mutable_real(sc, 1.5));
- }
-
- if (is_null(p))
+
+ if (setjmp(sc->opt_exit) == 0)
{
- int i;
- s7_pf_t bodyf = NULL;
- if (!let_star)
- for (p = let_vars; is_pair(p); p = cdr(p))
- make_slot_1(sc, sc->envir, caar(p), s7_make_mutable_real(sc, 1.5));
-
- for (i = 0, p = let_body; is_pair(p); i++, p = cdr(p))
+ start_opts(sc);
+ for (var_len = 0, p = let_vars; (is_pair(p)) && (is_pair(cdar(p))); var_len++, p = cdr(p))
{
- bodyf = xf_opt(sc, car(p));
- if (!bodyf) break;
+ s7_pointer expr;
+ expr = cdar(p);
+ if (!float_optimize(sc, expr)) /* each of these needs to set the associated variable */
+ {
+ sc->envir = old_e;
+ return(fall_through);
+ }
+ if (let_star)
+ make_slot_1(sc, sc->envir, caar(p), s7_make_mutable_real(sc, 1.5));
}
-
- if (is_null(p))
+ }
+ else return(fall_through);
+
+ if (!let_star)
+ for (p = let_vars; is_pair(p); p = cdr(p))
+ make_slot_1(sc, sc->envir, caar(p), s7_make_mutable_real(sc, 1.5));
+
+ for (p = let_body; is_pair(p); p = cdr(p))
+ {
+ if (!float_optimize(sc, p))
{
- s7_pointer *top;
- s7_int end;
-
- if (safe_case)
- {
- end = denominator(stepper);
- top = sc->cur_rf->data;
-
- if ((var_len == 1) && (body_len == 1)) /* very common special case */
- {
- s7_pointer rl;
- s7_int end3;
- s7_pointer **rp;
- s7_pointer *temp;
-
- end3 = end - 3;
- rl = slot_value(let_slots(sc->envir));
- top++;
- for (; numerator(stepper) < end3; numerator(stepper)++)
- {
- temp = top;
- rp = &temp;
- set_real(rl, varf(sc, rp));
- (*rp)++;
- bodyf(sc, rp);
- numerator(stepper)++;
- temp = top;
- rp = &temp;
- set_real(rl, varf(sc, rp));
- (*rp)++;
- bodyf(sc, rp);
- numerator(stepper)++;
- temp = top;
- rp = &temp;
- set_real(rl, varf(sc, rp));
- (*rp)++;
- bodyf(sc, rp);
- }
- for (; numerator(stepper) < end; numerator(stepper)++)
- {
- temp = top;
- rp = &temp;
- set_real(rl, varf(sc, rp));
- (*rp)++;
- bodyf(sc, rp);
- }
- }
- else
- {
- let_set_slots(sc->envir, reverse_slots(sc, let_slots(sc->envir)));
- for (; numerator(stepper) < end; numerator(stepper)++)
- {
- s7_pointer **rp;
- s7_pointer *temp;
-
- temp = top;
- rp = &temp;
-
- for (p = let_slots(sc->envir); is_slot(p); p = next_slot(p))
- {
- s7_rf_t r1;
- r1 = (s7_rf_t)(**rp); (*rp)++;
- set_real(slot_value(p), r1(sc, rp));
- }
- for (i = 0; i < body_len; i++)
- {
- s7_pf_t pf;
- pf = (s7_pf_t)(**rp); (*rp)++;
- pf(sc, rp);
- }
- }
- }
+ sc->envir = old_e;
+ return(fall_through);
+ }
+ }
+
+ if (is_null(p))
+ {
+ s7_int k, end;
+
+ end = denominator(stepper);
+ let_set_slots(sc->envir, reverse_slots(sc, let_slots(sc->envir)));
+
+ if ((var_len == 1) && (body_len == 1))
+ {
+ s7_pointer ip, xp;
+ int pc2;
+ opt_info *first, *second;
+ s7_double (*f1)(void *p);
+ s7_double (*f2)(void *p);
+ xp = slot_value(let_slots(sc->envir));
+ ip = slot_value(step_slot);
+ first = sc->opts[0];
+ f1 = first->v7.fd;
+ integer(ip) = numerator(stepper);
+ sc->pc = 0;
+ set_real(xp, f1(first));
+ pc2 = ++sc->pc;
+ second = sc->opts[pc2];
+ f2 = second->v7.fd;
+ f2(second);
+ for (k = numerator(stepper) + 1; k < end; k++)
+ {
+ integer(ip) = k;
+ sc->pc = 0;
+ set_real(xp, f1(first));
+ sc->pc = pc2;
+ f2(second);
}
- else
+ }
+ else
+ {
+ for (k = numerator(stepper); k < end; k++)
{
- end = denominator(stepper);
- top = sc->cur_rf->data;
-
- if ((var_len == 1) && (body_len == 1)) /* very common special case */
+ int i;
+ integer(slot_value(step_slot)) = k;
+ sc->pc = 0;
+ for (p = let_slots(sc->envir); is_slot(p); p = next_slot(p))
{
- s7_pointer rl;
- s7_int k;
- rl = slot_value(let_slots(sc->envir));
- top++;
- for (k = numerator(stepper); k < end; k++)
- {
- s7_pointer **rp;
- s7_pointer *temp;
- slot_set_value(step_slot, make_integer(sc, k));
-
- temp = top;
- rp = &temp;
- set_real(rl, varf(sc, rp));
- (*rp)++;
- bodyf(sc, rp);
- }
+ set_real(slot_value(p), sc->opts[sc->pc]->v7.fd(sc->opts[sc->pc]));
+ sc->pc++;
}
- else
+ for (i = 0; i < body_len; i++)
{
- s7_int k;
- let_set_slots(sc->envir, reverse_slots(sc, let_slots(sc->envir)));
- for (k = numerator(stepper); k < end; k++)
- {
- s7_pointer **rp;
- s7_pointer *temp;
- slot_set_value(step_slot, make_integer(sc, k));
-
- temp = top;
- rp = &temp;
-
- for (p = let_slots(sc->envir); is_slot(p); p = next_slot(p))
- {
- s7_rf_t r1;
- r1 = (s7_rf_t)(**rp); (*rp)++;
- set_real(slot_value(p), r1(sc, rp));
- }
- for (i = 0; i < body_len; i++)
- {
- s7_pf_t pf;
- pf = (s7_pf_t)(**rp); (*rp)++;
- pf(sc, rp);
- }
- }
+ sc->opts[sc->pc]->v7.fd(sc->opts[sc->pc]);
+ sc->pc++;
}
+ /* fprintf(stderr, "%s\n", DISPLAY(sc->envir)); */
}
- s7_xf_free(sc);
- sc->code = cdr(cadr(scc));
- return(goto_SAFE_DO_END_CLAUSES);
}
+ sc->envir = old_e;
+ sc->value = sc->T;
+ sc->code = cdr(cadr(scc));
+ return(goto_SAFE_DO_END_CLAUSES);
}
sc->envir = old_e;
- s7_xf_free(sc);
return(fall_through);
}
@@ -59369,7 +64527,7 @@ static int safe_dotimes_ex(s7_scheme *sc)
{
s7_pointer init_val;
- /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY(sc->code)); */
+ /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY_80(sc->code)); */
init_val = cadr(caar(sc->code));
if (is_symbol(init_val))
@@ -59396,20 +64554,33 @@ static int safe_dotimes_ex(s7_scheme *sc)
sc->args = make_slot_1(sc, sc->envir, caaar(code), make_mutable_integer(sc, s7_integer(init_val)));
denominator(slot_value(sc->args)) = s7_integer(end_val);
- set_stepper(sc->args);
+ /* fprintf(stderr, "set %s end: %s\n", DISPLAY(sc->args), DISPLAY(sc->code)); */
+ set_step_end(sc->args); /* safe_dotimes step is by 1 */
/* (define (hi) (do ((i 1 (+ 1 i))) ((= i 1) i))) -- we need the frame even if the loop is not evaluated */
+
+ /* safe_dotimes: if null (or constant) body, set step=end and quit (here end is (= step lim) so nothing can happen)
+ * TODO: break out this case in check_do
+ * if 1-expr body look for syntactic case, if let(*) goto opt_let, else opt_dotimes
+ * if they are unhappy, got safe_dotimes_step_p
+ * TODO: another case for check_do
+ * else goto opt_dotimes then safe_dotimes_step_o
+ * if multi-line body, check opt_dotimes, then safe_dotimes_step
+ */
+
if ((is_null(sc->code)) ||
((!is_pair(car(sc->code))) &&
(is_null(cdr(sc->code)))))
{
numerator(slot_value(sc->args)) = s7_integer(end_val);
+ sc->value = sc->T;
sc->code = cdr(cadr(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));
return(goto_SAFE_DO_END_CLAUSES);
}
@@ -59428,12 +64599,12 @@ static int safe_dotimes_ex(s7_scheme *sc)
if ((symbol_syntax_op(car(sc->code)) == OP_LET) ||
(symbol_syntax_op(car(sc->code)) == OP_LET_STAR))
{
- if (let_pf_ok(sc, sc->args, code, true) == goto_SAFE_DO_END_CLAUSES)
+ if (opt_let(sc, sc->args, code, true) == goto_SAFE_DO_END_CLAUSES)
return(goto_SAFE_DO_END_CLAUSES);
}
else
{
- if (pf_ok(sc, cddr(code), code, true))
+ if (opt_dotimes(sc, cddr(code), code, true))
return(goto_SAFE_DO_END_CLAUSES);
}
set_unsafe_do(code);
@@ -59454,26 +64625,21 @@ static int safe_dotimes_ex(s7_scheme *sc)
else /* car not syntactic? */
{
if ((!is_unsafe_do(code)) &&
- (pf_ok(sc, cddr(code), code, true)))
+ (opt_dotimes(sc, cddr(code), code, true)))
return(goto_SAFE_DO_END_CLAUSES);
set_unsafe_do(code);
-#if DEBUGGING
- if (!is_optimized(sc->code)) fprintf(stderr, "%s[%d]: not opt: %s\n", __func__, __LINE__, DISPLAY(sc->code));
-#endif
- if (is_optimized(sc->code)) /* think this is not needed -- can we get here otherwise? */
- {
- push_stack(sc, OP_SAFE_DOTIMES_STEP_O, sc->args, code);
- return(goto_OPT_EVAL);
- }
+ /* matters in tcopy 50 */
+ push_stack(sc, OP_SAFE_DOTIMES_STEP_O, sc->args, code);
+ return(goto_OPT_EVAL);
}
/* impossible? but make sure in any case we're set up for begin */
sc->code = cddr(code);
}
-
+
/* multi-line body */
if ((!is_unsafe_do(code)) &&
- (pf_ok(sc, sc->code, code, true)))
+ (opt_dotimes(sc, sc->code, code, true)))
return(goto_SAFE_DO_END_CLAUSES);
set_unsafe_do(code);
@@ -59495,8 +64661,10 @@ static int safe_do_ex(s7_scheme *sc)
*/
s7_pointer end, init_val, end_val, code;
- /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY(sc->code)); */
+ /* inits, if not >= opt_dotimes else safe_do_step
+ */
+ /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY_80(sc->code)); */
code = sc->code;
init_val = cadaar(code);
@@ -59527,34 +64695,27 @@ static int safe_do_ex(s7_scheme *sc)
((s7_integer(init_val) > s7_integer(end_val)) &&
(opt_cfunc(car(cadr(code))) == geq_2)))
{
+ sc->value = sc->T;
sc->code = cdr(cadr(code));
return(goto_SAFE_DO_END_CLAUSES);
}
if (is_symbol(end))
- sc->args = find_symbol(sc, end);
- else sc->args = make_slot(sc, sc->dox_slot_symbol, end); /* here and elsewhere sc->args is used for GC protection */
- dox_set_slot2(sc->envir, sc->args);
-
+ dox_set_slot2(sc->envir, find_symbol(sc, end));
+ else dox_set_slot2(sc->envir, make_slot_1(sc, sc->envir, sc->dox_slot_symbol, end));
+ sc->args = dox_slot2(sc->envir); /* the various safe steps assume sc->args is the end slot */
+
+ /* fprintf(stderr, "%s %d %d\n", DISPLAY(sc->code), is_unsafe_do(sc->code), is_optimized(caadr(code))); */
if ((!is_unsafe_do(sc->code)) &&
((!is_optimized(caadr(code))) ||
(opt_cfunc(caadr(code)) != geq_2)))
{
- set_stepper(dox_slot1(sc->envir));
-
- if (pf_ok(sc, cddr(sc->code), sc->code, false))
+ if (opt_dotimes(sc, cddr(sc->code), sc->code, false))
return(goto_SAFE_DO_END_CLAUSES);
set_unsafe_do(sc->code);
}
sc->code = cddr(code);
- if (is_unsafe_do(sc->code)) /* we've seen this loop before and it's not optimizable */
- {
- set_opt_pair2(code, sc->code);
- push_stack(sc, OP_SAFE_DO_STEP, sc->args, code);
- return(goto_BEGIN1);
- }
-
set_unsafe_do(sc->code);
set_opt_pair2(code, sc->code);
push_stack(sc, OP_SAFE_DO_STEP, sc->args, code);
@@ -59563,10 +64724,10 @@ static int safe_do_ex(s7_scheme *sc)
static int dotimes_p_ex(s7_scheme *sc)
{
- s7_pointer init, end, code, init_val, end_val;
+ s7_pointer init, end, code, init_val, end_val, slot;
/* (do ... (set! args ...)) -- one line, syntactic */
- /* if (!is_unsafe_do(sc->code)) fprintf(stderr, "%s: %s\n", __func__, DISPLAY(sc->code)); */
+ /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY_80(sc->code)); */
code = sc->code;
init = cadaar(code);
@@ -59583,9 +64744,15 @@ static int dotimes_p_ex(s7_scheme *sc)
set_opt_pair2(code, caadr(code));
end = caddr(opt_pair2(code));
if (is_symbol(end))
- sc->args = find_symbol(sc, end);
- else sc->args = make_slot(sc, sc->dox_slot_symbol, end);
- end_val = slot_value(sc->args);
+ {
+ slot = find_symbol(sc, end);
+ end_val = slot_value(slot);
+ }
+ else
+ {
+ slot = make_slot(sc, sc->dox_slot_symbol, end);
+ end_val = end;
+ }
if ((!s7_is_integer(init_val)) || (!s7_is_integer(end_val)))
{
@@ -59595,11 +64762,15 @@ static int dotimes_p_ex(s7_scheme *sc)
sc->envir = new_frame_in_env(sc, sc->envir);
dox_set_slot1(sc->envir, make_slot_1(sc, sc->envir, caaar(code), init_val));
- dox_set_slot2(sc->envir, sc->args);
-
+ dox_set_slot2(sc->envir, slot);
+ if (!is_symbol(end))
+ {
+ next_slot(slot) = let_slots(sc->envir);
+ let_slots(sc->envir) = slot;
+ }
set_car(sc->t2_1, slot_value(dox_slot1(sc->envir)));
set_car(sc->t2_2, slot_value(dox_slot2(sc->envir)));
- if (is_true(sc, c_call(caadr(code))(sc, sc->t2_1)))
+ if (is_true(sc, sc->value = c_call(caadr(code))(sc, sc->t2_1)))
{
sc->code = cdadr(code);
return(goto_DO_END_CLAUSES);
@@ -59611,24 +64782,24 @@ static int dotimes_p_ex(s7_scheme *sc)
s7_pointer old_args, old_init, body;
body = caddr(code);
- old_args = sc->args;
+ old_args = sc->args;
old_init = slot_value(dox_slot1(sc->envir));
- sc->args = dox_slot1(sc->envir);
+ sc->args = dox_slot1(sc->envir); /* used in opt_dotimes */
slot_set_value(sc->args, make_mutable_integer(sc, integer(slot_value(dox_slot1(sc->envir)))));
denominator(slot_value(sc->args)) = integer(slot_value(dox_slot2(sc->envir)));
- set_stepper(sc->args);
+ set_step_end(sc->args); /* dotimes step is by 1 */
if (((typesflag(body) == SYNTACTIC_PAIR) ||
(typesflag(car(body)) == SYNTACTIC_TYPE)) &&
((symbol_syntax_op(car(body)) == OP_LET) ||
(symbol_syntax_op(car(body)) == OP_LET_STAR)))
{
- if (let_pf_ok(sc, sc->args, code, false) == goto_SAFE_DO_END_CLAUSES)
+ if (opt_let(sc, sc->args, code, false) == goto_SAFE_DO_END_CLAUSES)
return(goto_DO_END_CLAUSES);
}
else
{
- if (pf_ok(sc, cddr(code), code, false))
+ if (opt_dotimes(sc, cddr(code), code, false))
return(goto_DO_END_CLAUSES);
}
slot_set_value(sc->args, old_init);
@@ -59644,6 +64815,7 @@ static int dotimes_p_ex(s7_scheme *sc)
static int do_init_ex(s7_scheme *sc)
{
s7_pointer x, y, z;
+ /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY_80(sc->code)); */
while (true)
{
sc->args = cons(sc, sc->value, sc->args); /* code will be last element (first after reverse) */
@@ -59674,7 +64846,7 @@ static int do_init_ex(s7_scheme *sc)
/* sc->envir = new_frame_in_env(sc, sc->envir); */
/* sc->args was cons'd above, so it should be safe to reuse it as the new frame */
- sc->envir = old_frame_in_env(sc, z, sc->envir);
+ sc->envir = reuse_as_let(sc, z, sc->envir);
/* run through sc->code and sc->args adding '( caar(car(code)) . car(args) ) to sc->envir,
* also reuse the value cells as the new frame slots.
@@ -59683,14 +64855,10 @@ static int do_init_ex(s7_scheme *sc)
y = sc->args;
for (x = car(sc->code); is_not_null(y); x = cdr(x))
{
- s7_pointer sym, args, val;
+ s7_pointer sym, args;
sym = caar(x);
- val = car(y);
args = cdr(y);
-
- set_type(y, T_SLOT);
- slot_set_symbol(y, sym);
- slot_set_value(y, val);
+ reuse_as_slot(y, sym, unchecked_car(y));
set_next_slot(y, let_slots(sc->envir));
let_set_slots(sc->envir, y);
symbol_set_local(sym, let_id(sc->envir), y);
@@ -59698,9 +64866,8 @@ static int do_init_ex(s7_scheme *sc)
if (is_not_null(cddar(x))) /* else no incr expr, so ignore it henceforth */
{
s7_pointer p;
- p = cons(sc, caddar(x), val);
+ p = cons(sc, caddar(x), sc->gc_nil); /* this is where we store the new value */
set_opt_slot1(p, y);
- /* val is just a place-holder -- this is where we store the new value */
sc->value = cons_unchecked(sc, p, sc->value);
}
y = args;
@@ -59713,12 +64880,37 @@ static int do_init_ex(s7_scheme *sc)
*/
return(fall_through);
}
+/* -------------------------------------------------------------------------------- */
-#if (!WITH_GCC)
-#define closure_is_ok(Sc, Code, Type, Args) (find_symbol_unchecked(Sc, car(Code)) == opt_lambda_unchecked(Code))
-#define closure_star_is_ok(Sc, Code, Type, Args) (find_symbol_unchecked(Sc, car(Code)) == opt_lambda_unchecked(Code))
-#else
+static inline bool closure_is_ok_1(s7_scheme *sc, s7_pointer code, unsigned short type, int args)
+{
+ s7_pointer f;
+ f = find_symbol_unexamined(sc, car(code));
+ if ((f == opt_lambda_unchecked(code)) ||
+ ((f) &&
+ (typesflag(f) == type) &&
+ ((closure_arity(f) == args) || (closure_arity_to_int(sc, f) == args)) &&
+ (set_opt_lambda(code, f))))
+ return(true);
+ sc->last_function = f;
+ return(false);
+}
+
+static bool closure_star_is_ok_1(s7_scheme *sc, s7_pointer code, unsigned short type, int args)
+{
+ s7_pointer val;
+ val = find_symbol_unexamined(sc, car(code));
+ if ((val == opt_lambda_unchecked(code)) ||
+ ((val) &&
+ (typesflag(val) == (unsigned short)type) &&
+ ((closure_arity(val) >= args) ||
+ (closure_star_arity_to_int(sc, val) >= args)) &&
+ (set_opt_lambda(code, val))))
+ return(true);
+ sc->last_function = val;
+ return(false);
+}
/* it is almost never the case that we already have the value and can see it in the current environment directly,
* but once found, the value usually matches the current (opt_lambda(code))
@@ -59726,42 +64918,30 @@ static int do_init_ex(s7_scheme *sc)
* (_val_) is needed below because car(code) might be undefined (with-let can cause this confusion),
* and find_symbol_unchecked returns NULL in that case.
*/
-#if 1
-/* unlike the c_function_is_ok case, the macro form here is faster?? callgrind and time agree on this.
- * opt_lambda(_code_) here can (legitimately) be a free cell or almost anything.
- */
-#define closure_is_ok(Sc, Code, Type, Args) \
- ({ s7_pointer _code_, _val_; _code_ = Code; _val_ = find_symbol_unexamined(Sc, car(_code_)); \
- ((_val_ == opt_any1(_code_)) || \
- ((_val_) && (typesflag(_val_) == (unsigned short)Type) && \
- ((closure_arity(_val_) == Args) || (closure_arity_to_int(Sc, _val_) == Args)) && \
- (set_opt_lambda(_code_, _val_)))); })
-#else
-static bool closure_is_ok(s7_scheme *sc, s7_pointer code, unsigned short type, int args)
-{
- s7_pointer f;
- f = find_symbol_unexamined(sc, car(code));
- return ((f == opt_lambda_unchecked(code)) ||
- ((f) &&
- (typesflag(f) == type) &&
- ((closure_arity(f) == args) || (closure_arity_to_int(sc, f) == args)) &&
- (set_opt_lambda(code, f))));
-}
-#endif
-#define closure_star_is_ok(Sc, Code, Type, Args) \
- ({ s7_pointer _val_; _val_ = find_symbol_unexamined(Sc, car(Code)); \
- ((_val_ == opt_any1(Code)) || \
- ((_val_) && (typesflag(_val_) == (unsigned short)Type) && \
- ((closure_arity(_val_) >= Args) || (closure_star_arity_to_int(Sc, _val_) >= Args)) && \
- (set_opt_lambda(Code, _val_)))); })
+#define closure_is_ok(Sc, Code, Type, Args) \
+ (((symbol_ctr(car(Code)) == 1) && \
+ (unchecked_type(local_slot(car(Code))) == T_SLOT) && \
+ (slot_value(local_slot(car(Code))) == opt_lambda_unchecked(Code))) || \
+ (closure_is_ok_1(Sc, Code, Type, Args)))
+
+#define closure_is_equal(Sc, Code) \
+ (((symbol_ctr(car(Code)) == 1) && \
+ (unchecked_type(local_slot(car(Code))) == T_SLOT) && \
+ (slot_value(local_slot(car(Code))) == opt_lambda_unchecked(Code))) || \
+ ((sc->last_function = find_symbol_unexamined(Sc, car(Code))) == opt_lambda_unchecked(Code)))
+
+#define closure_star_is_ok(Sc, Code, Type, Args) \
+ (((symbol_ctr(car(Code)) == 1) && \
+ (unchecked_type(local_slot(car(Code))) == T_SLOT) && \
+ (slot_value(local_slot(car(Code))) == opt_lambda_unchecked(Code))) || \
+ (closure_star_is_ok_1(Sc, Code, Type, Args)))
-#endif
-#define MATCH_UNSAFE_CLOSURE (T_CLOSURE | T_PROCEDURE)
-#define MATCH_SAFE_CLOSURE (T_CLOSURE | T_PROCEDURE | T_SAFE_CLOSURE)
-#define MATCH_UNSAFE_CLOSURE_STAR (T_CLOSURE_STAR | T_PROCEDURE)
-#define MATCH_SAFE_CLOSURE_STAR (T_CLOSURE_STAR | T_PROCEDURE | T_SAFE_CLOSURE)
+#define MATCH_UNSAFE_CLOSURE (T_CLOSURE)
+#define MATCH_SAFE_CLOSURE (T_CLOSURE | T_SAFE_CLOSURE)
+#define MATCH_UNSAFE_CLOSURE_STAR (T_CLOSURE_STAR)
+#define MATCH_SAFE_CLOSURE_STAR (T_CLOSURE_STAR | T_SAFE_CLOSURE)
/* since T_HAS_METHODS is on if there might be methods, this can protect us from that case */
@@ -59779,28 +64959,24 @@ static int fixup_unknown_op(s7_scheme *sc, s7_pointer code, s7_pointer func, int
static int unknown_ex(s7_scheme *sc, s7_pointer f)
{
s7_pointer code;
+ int hop;
code = sc->code;
+ hop = (is_immutable_symbol(car(code))) ? 1 : 0;
+ /* fprintf(stderr, "%s: local: %d, hop: %d\n", DISPLAY(code), is_local_symbol(code), hop); */
+
switch (type(f))
{
- case T_C_OBJECT:
- if (s7_is_aritable(sc, f, 0))
- return(fixup_unknown_op(sc, code, f, OP_C_OBJECT));
- break;
-
- case T_GOTO:
- return(fixup_unknown_op(sc, code, f, OP_GOTO));
-
case T_CLOSURE:
if ((!has_methods(f)) &&
(is_null(closure_args(f))))
{
- int hop;
- hop = (is_immutable_symbol(car(code))) ? 1 : 0;
if (is_safe_closure(f))
{
+ int 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)))
{
@@ -59811,7 +64987,7 @@ static int unknown_ex(s7_scheme *sc, s7_pointer f)
if ((is_pair(car(body))) &&
(is_syntactic_symbol(caar(body))))
{
- set_optimize_op(code, hop + OP_SAFE_THUNK_P);
+ set_optimize_op(code, hop + outer_hop + OP_SAFE_THUNK_P);
if (typesflag(car(body)) != SYNTACTIC_PAIR)
{
pair_set_syntax_op(car(body), symbol_syntax_op(caar(body)));
@@ -59831,12 +65007,12 @@ static int unknown_ex(s7_scheme *sc, s7_pointer f)
*/
break;
- case T_CLOSURE_STAR:
- if ((!has_methods(f)) &&
- (has_simple_args(closure_body(f))))
- return(fixup_unknown_op(sc, code, f, ((is_immutable_symbol(car(code))) ? 1 : 0) + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR : OP_CLOSURE_STAR)));
- break;
-
+ case T_GOTO:
+ return(fixup_unknown_op(sc, code, f, hop + OP_GOTO));
+
+ case T_ITERATOR:
+ return(fixup_unknown_op(sc, code, f, hop + OP_ITERATE));
+
default:
break;
}
@@ -59851,32 +65027,45 @@ static int unknown_g_ex(s7_scheme *sc, s7_pointer f)
code = sc->code;
hop = (is_immutable_symbol(car(code))) ? 1 : 0;
+ /* fprintf(stderr, "unknown_g_ex: %s, local: %d, hop: %d\n", DISPLAY_80(sc->code), is_local_symbol(sc->code), hop); */
+
sym_case = is_symbol(cadr(code));
+ if ((sym_case) &&
+ (!is_slot(find_symbol(sc, cadr(code)))))
+ return(fall_through);
switch (type(f))
{
- case T_C_FUNCTION: case T_C_FUNCTION_STAR: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
- if (s7_is_aritable(sc, f, 1))
+ case T_C_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ case T_C_FUNCTION_STAR:
+ if ((c_function_required_args(f) > 1) ||
+ (c_function_all_args(f) == 0))
+ break;
+
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_ANY_ARGS_FUNCTION:
+ if (sym_case)
{
- if (sym_case)
+ if (is_safe_procedure(f))
+ set_optimize_op(code, hop + OP_SAFE_C_S);
+ else set_optimize_op(code, hop + OP_C_S);
+ set_c_function(code, f);
+ return(goto_OPT_EVAL);
+ }
+ else
+ {
+ if (is_safe_procedure(f))
{
- set_optimize_op(code, hop + ((is_safe_procedure(f)) ? OP_SAFE_C_S : OP_C_S));
+ set_optimize_op(code, hop + OP_SAFE_C_C);
set_c_function(code, f);
return(goto_OPT_EVAL);
}
- else
- {
- if (is_safe_procedure(f))
- {
- set_optimize_op(code, hop + OP_SAFE_C_C);
- set_c_function(code, f);
- return(goto_OPT_EVAL);
- }
- }
}
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))
{
@@ -59886,29 +65075,24 @@ static int unknown_g_ex(s7_scheme *sc, s7_pointer f)
if (is_safe_closure(f))
{
s7_pointer body;
- set_optimize_op(code, hop + ((is_global(car(code))) ? OP_SAFE_GLOSURE_S : OP_SAFE_CLOSURE_S));
+ int 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);
body = closure_body(f);
- if (is_null(cdr(body)))
+ if ((is_null(cdr(body))) &&
+ (!is_optimized(car(body))) && /* might be h_safe_c_c->if_x2 or whatever */
+ (is_pair(car(body))) &&
+ (is_syntactic_symbol(caar(body))))
{
- if ((is_optimized(car(body))) &&
- (is_global(car(code))))
- set_optimize_op(code, hop + OP_SAFE_GLOSURE_S_E);
- else
+ set_optimize_op(code, hop + outer_hop + OP_SAFE_CLOSURE_S_P);
+ if (typesflag(car(body)) != SYNTACTIC_PAIR)
{
- if ((is_pair(car(body))) &&
- (is_syntactic_symbol(caar(body))))
- {
- set_optimize_op(code, hop + OP_SAFE_CLOSURE_S_P);
- if (typesflag(car(body)) != SYNTACTIC_PAIR)
- {
- pair_set_syntax_op(car(body), symbol_syntax_op(caar(body)));
- set_syntactic_pair(car(body));
- }
- }
+ pair_set_syntax_op(car(body), symbol_syntax_op(caar(body)));
+ set_syntactic_pair(car(body));
}
}
}
- else set_optimize_op(code, hop + ((is_global(car(code))) ? OP_GLOSURE_S : OP_CLOSURE_S));
+ else set_optimize_op(code, hop + OP_CLOSURE_S);
}
else
{
@@ -59921,43 +65105,53 @@ static int unknown_g_ex(s7_scheme *sc, s7_pointer f)
break;
case T_CLOSURE_STAR:
- if ((sym_case) &&
- (!has_methods(f)) &&
- (has_simple_args(closure_body(f))) &&
- (!is_null(closure_args(f))))
+ if ((!has_methods(f)) &&
+ (has_simple_arg_defaults(closure_body(f))) &&
+ (closure_star_arity_to_int(sc, f) >= 1))
{
- set_opt_sym2(code, cadr(code));
- return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_S : OP_CLOSURE_STAR_S)));
+ annotate_arg(sc, cdr(code), sc->envir);
+ set_arglist_length(code, small_int(1));
+ return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_A : OP_CLOSURE_STAR_A)));
}
break;
+
+ case T_GOTO:
+ return(fixup_unknown_op(sc, code, f, hop + ((sym_case) ? OP_GOTO_S : OP_GOTO_C)));
case T_INT_VECTOR:
case T_FLOAT_VECTOR:
case T_VECTOR:
if ((sym_case) ||
(is_integer(cadr(code)))) /* (v 4/3) */
- return(fixup_unknown_op(sc, code, f, (sym_case) ? OP_VECTOR_S : OP_VECTOR_C));
+ {
+ annotate_arg(sc, cdr(code), sc->envir);
+ return(fixup_unknown_op(sc, code, f, hop + OP_VECTOR_A));
+ }
break;
case T_STRING:
- return(fixup_unknown_op(sc, code, f, (sym_case) ? OP_STRING_S : OP_STRING_C));
+ annotate_arg(sc, cdr(code), sc->envir);
+ return(fixup_unknown_op(sc, code, f, hop + OP_STRING_A));
case T_PAIR:
- return(fixup_unknown_op(sc, code, f, (sym_case) ? OP_PAIR_S : OP_PAIR_C));
+ annotate_arg(sc, cdr(code), sc->envir);
+ return(fixup_unknown_op(sc, code, f, hop + OP_PAIR_A));
case T_C_OBJECT:
if (s7_is_aritable(sc, f, 1))
- return(fixup_unknown_op(sc, code, f, (sym_case) ? OP_C_OBJECT_S : OP_C_OBJECT_C));
+ {
+ annotate_arg(sc, cdr(code), sc->envir);
+ return(fixup_unknown_op(sc, code, f, hop + OP_C_OBJECT_A));
+ }
break;
case T_LET:
- return(fixup_unknown_op(sc, code, f, (sym_case) ? OP_ENVIRONMENT_S : OP_ENVIRONMENT_C));
+ annotate_arg(sc, cdr(code), sc->envir);
+ return(fixup_unknown_op(sc, code, f, hop + OP_ENVIRONMENT_A));
case T_HASH_TABLE:
- return(fixup_unknown_op(sc, code, f, (sym_case) ? OP_HASH_TABLE_S : OP_HASH_TABLE_C));
-
- case T_GOTO:
- return(fixup_unknown_op(sc, code, f, (sym_case) ? OP_GOTO_S : OP_GOTO_C));
+ annotate_arg(sc, cdr(code), sc->envir);
+ return(fixup_unknown_op(sc, code, f, hop + OP_HASH_TABLE_A));
default:
break;
@@ -59967,266 +65161,296 @@ static int unknown_g_ex(s7_scheme *sc, s7_pointer f)
static int unknown_gg_ex(s7_scheme *sc, s7_pointer f)
{
- if (s7_is_aritable(sc, f, 2))
- {
- bool s1, s2;
- int hop;
- s7_pointer code;
+ bool s1, s2;
+ int hop;
+ s7_pointer code;
- code = sc->code;
- hop = (is_immutable_symbol(car(code))) ? 1 : 0;
- s1 = is_symbol(cadr(code));
- s2 = is_symbol(caddr(code));
+ code = sc->code;
+ hop = (is_immutable_symbol(car(code))) ? 1 : 0;
+ s1 = is_symbol(cadr(code));
+ s2 = is_symbol(caddr(code));
+
+ if ((s1) &&
+ (!is_slot(find_symbol(sc, cadr(code)))))
+ return(fall_through);
+ if ((s2) &&
+ (!is_slot(find_symbol(sc, caddr(code)))))
+ return(fall_through);
- switch (type(f))
+ switch (type(f))
+ {
+ case T_C_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ case T_C_FUNCTION_STAR:
+ if ((c_function_required_args(f) > 2) ||
+ (c_function_all_args(f) < 2))
+ break;
+
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_ANY_ARGS_FUNCTION:
+ if (is_safe_procedure(f))
{
- case T_CLOSURE:
- if (has_methods(f)) break;
- if (closure_arity_to_int(sc, f) == 2)
- {
- 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) ? OP_CLOSURE_SS : OP_CLOSURE_SC));
- }
- else
- {
- if (!s2) break;
- set_optimize_op(code, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_CS : OP_CLOSURE_CS));
- }
- if (s2) set_opt_sym2(code, caddr(code)); else set_opt_con2(code, caddr(code));
- set_opt_lambda(code, f);
- return(goto_OPT_EVAL);
- }
- break;
-
- case T_CLOSURE_STAR: /* the closure* opts assume args are not keywords, but we can check that! */
- if ((s1) &&
- (!has_methods(f)))
+ if (s1)
{
if (s2)
- {
- if ((!is_keyword(cadr(code))) &&
- (!is_keyword(caddr(code))) &&
- (has_simple_args(closure_body(f))) &&
- (closure_star_arity_to_int(sc, f) >= 2))
- {
- set_opt_sym2(code, caddr(code));
- return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_SS : OP_CLOSURE_STAR_SX)));
- }
- }
- else
- {
- set_opt_con2(code, caddr(code));
- if ((!is_keyword(cadr(code))) &&
- (has_simple_args(closure_body(f))) &&
- (closure_star_arity_to_int(sc, f) >= 2))
- return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_SC : OP_CLOSURE_STAR_SX)));
- }
+ set_optimize_op(code, hop + OP_SAFE_C_SS);
+ else set_optimize_op(code, hop + OP_SAFE_C_SC);
}
- break;
-
- case T_C_FUNCTION: case T_C_FUNCTION_STAR: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
- if (is_safe_procedure(f))
+ else set_optimize_op(code, hop + ((s2) ? OP_SAFE_C_CS : OP_SAFE_C_C));
+ }
+ else
+ {
+ set_optimize_op(code, hop + OP_C_ALL_X);
+ annotate_args(sc, cdr(code), sc->envir);
+ }
+ set_arglist_length(code, small_int(2));
+ set_c_function(code, f);
+ return(goto_OPT_EVAL);
+
+ case T_CLOSURE:
+ if (has_methods(f)) break;
+ if (closure_arity_to_int(sc, f) == 2)
+ {
+ if (s1)
{
- if (s1)
- set_optimize_op(code, hop + ((s2) ? OP_SAFE_C_SS : OP_SAFE_C_SC));
- else set_optimize_op(code, hop + ((s2) ? OP_SAFE_C_CS : OP_SAFE_C_C));
+ 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));
}
else
{
- set_optimize_op(code, hop + OP_C_ALL_X);
- annotate_args(sc, cdr(code), sc->envir);
+ if (!s2) break;
+ set_optimize_op(code, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_CS : OP_CLOSURE_CS));
}
- set_arglist_length(code, small_int(2));
- set_c_function(code, f);
+ if (s2) set_opt_sym2(code, caddr(code)); else set_opt_con2(code, caddr(code));
+ set_opt_lambda(code, f);
return(goto_OPT_EVAL);
-
- case T_INT_VECTOR:
- case T_FLOAT_VECTOR:
- case T_VECTOR:
- if ((is_integer(cadr(code))) && /* !s1 obviously) */
- (s7_integer(cadr(code)) >= 0) &&
- (is_integer(caddr(code))) &&
- (s7_integer(caddr(code)) >= 0))
- return(fixup_unknown_op(sc, code, f, OP_VECTOR_CC));
- break;
-
- default:
- break;
}
+ break;
+
+ case T_CLOSURE_STAR:
+ if ((!has_methods(f)) &&
+ (has_simple_arg_defaults(closure_body(f))) &&
+ (closure_star_arity_to_int(sc, f) >= 2))
+ {
+ annotate_args(sc, cdr(code), sc->envir);
+ set_arglist_length(code, small_int(2));
+ if (closure_star_arity_to_int(sc, f) == 2)
+ return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_AA : OP_CLOSURE_STAR_AA)));
+ return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X)));
+ }
+ break;
+
+ default:
+ break;
}
return(fall_through);
}
static int unknown_all_s_ex(s7_scheme *sc, s7_pointer f)
{
- s7_pointer code;
- int num_args;
+ s7_pointer code, arg;
+ int num_args, hop;
code = sc->code;
num_args = integer(arglist_length(code));
+ for (arg = cdr(code); is_pair(arg); arg = cdr(arg))
+ if (/* (!is_symbol(car(arg))) || */ /* can't happen?? */
+ (!is_slot(find_symbol(sc, car(arg)))))
+ return(fall_through);
- if (s7_is_aritable(sc, f, num_args))
- {
- int hop;
- hop = (is_immutable_symbol(car(code))) ? 1 : 0;
+ hop = (is_immutable_symbol(car(code))) ? 1 : 0;
- switch (type(f))
+ switch (type(f))
+ {
+ case T_C_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ case T_C_FUNCTION_STAR:
+ if (((int)c_function_required_args(f) > num_args) ||
+ ((int)c_function_all_args(f) < num_args))
+ break;
+
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_ANY_ARGS_FUNCTION:
+ if (is_safe_procedure(f))
{
- case T_CLOSURE:
- if ((!has_methods(f)) &&
- (closure_arity_to_int(sc, f) == num_args))
- {
- annotate_args(sc, cdr(code), sc->envir);
- return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_ALL_X : OP_CLOSURE_ALL_S)));
- }
- break;
-
- case T_C_FUNCTION: case T_C_FUNCTION_STAR: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
- if (is_safe_procedure(f))
- set_optimize_op(code, hop + OP_SAFE_C_ALL_S);
- else
+ if (num_args == 3)
{
- set_optimize_op(code, hop + OP_C_ALL_X);
- annotate_args(sc, cdr(code), sc->envir);
+ set_optimize_op(code, hop + OP_SAFE_C_SSS);
+ set_opt_sym1(cdr(code), caddr(code));
+ set_opt_sym2(cdr(code), cadddr(code));
}
- set_c_function(code, f);
- return(goto_OPT_EVAL);
-
- default:
- break;
+ else set_optimize_op(code, hop + OP_SAFE_C_ALL_S);
+ }
+ else
+ {
+ set_optimize_op(code, hop + OP_C_ALL_X);
+ annotate_args(sc, cdr(code), sc->envir);
+ }
+ set_c_function(code, f);
+ return(goto_OPT_EVAL);
+
+ case T_CLOSURE:
+ if ((!has_methods(f)) &&
+ (closure_arity_to_int(sc, f) == num_args))
+ {
+ annotate_args(sc, cdr(code), sc->envir);
+ return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_ALL_X :
+ ((is_null(cdr(closure_body(f)))) ? OP_CLOSURE_ALL_S_P :
+ OP_CLOSURE_ALL_S))));
+ }
+ break;
+
+ case T_CLOSURE_STAR:
+ if ((!has_methods(f)) &&
+ (has_simple_arg_defaults(closure_body(f))) &&
+ (closure_star_arity_to_int(sc, f) >= num_args))
+ {
+ annotate_args(sc, cdr(code), sc->envir);
+ return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X)));
}
+ break;
+
+ default:
+ break;
}
return(fall_through);
}
static int unknown_a_ex(s7_scheme *sc, s7_pointer f)
{
- if (s7_is_aritable(sc, f, 1))
- {
- s7_pointer code;
+ s7_pointer code;
+ int hop;
- code = sc->code;
- set_arglist_length(code, small_int(1));
- annotate_args(sc, cdr(code), sc->envir);
+ code = sc->code;
+ hop = (is_immutable_symbol(car(code))) ? 1 : 0;
+
+#if DEBUGGING
+ if (!has_all_x(cdr(code)))
+ fprintf(stderr, "unknown_a_ex missing _a support? %s\n", DISPLAY_80(code));
+#endif
+
+ switch (type(f))
+ {
+ case T_C_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ case T_C_FUNCTION_STAR:
+ if ((c_function_required_args(f) > 1) ||
+ (c_function_all_args(f) == 0))
+ break;
- switch (type(f))
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_ANY_ARGS_FUNCTION:
+ set_optimize_op(code, hop + ((is_safe_procedure(f)) ? OP_SAFE_C_A : OP_C_A));
+ set_c_function(code, f);
+ return(goto_OPT_EVAL);
+
+ case T_CLOSURE:
+ /* fprintf(stderr, "unknown_a_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))
{
- case T_INT_VECTOR:
- case T_FLOAT_VECTOR:
- case T_VECTOR:
- return(fixup_unknown_op(sc, code, f, OP_VECTOR_A));
-
- case T_C_FUNCTION: case T_C_FUNCTION_STAR: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
- if ((is_safe_procedure(f)) &&
- (is_optimized(cadr(code))))
+ if (is_safe_closure(f))
+ set_optimize_op(code, hop + (OP_SAFE_CLOSURE_A + ((is_local_symbol(code)) ? 2 : 0)));
+ else
{
- int op;
- op = combine_ops(sc, E_C_P, code, cadr(code));
- set_optimize_op(code, op);
- if ((op == OP_SAFE_C_Z) &&
- (is_all_x_op(optimize_op(cadr(code)))))
- set_optimize_op(code, OP_SAFE_C_A);
- set_c_function(code, f);
- return(goto_OPT_EVAL);
+ set_optimize_op(code, hop + OP_CLOSURE_A);
+ if (!is_global(car(code)))
+ {
+ s7_pointer body;
+ body = closure_body(f);
+ if ((is_null(cdr(body))) &&
+ (is_pair(car(body))) &&
+ (is_syntactic_symbol(caar(body))))
+ {
+ set_optimize_op(code, hop + OP_CLOSURE_A_P);
+ if (typesflag(car(body)) != SYNTACTIC_PAIR)
+ {
+ pair_set_syntax_op(car(body), symbol_syntax_op(caar(body)));
+ set_syntactic_pair(car(body));
+ }
+ }
+ }
}
-
- if ((is_pair(cadr(code))) &&
- (caadr(code) == sc->quote_symbol))
- set_optimize_op(code, (is_safe_procedure(f)) ? OP_SAFE_C_Q : OP_C_A);
- else set_optimize_op(code, (is_safe_procedure(f)) ? OP_SAFE_C_A : OP_C_A);
- set_c_function(code, f);
+ set_opt_lambda(code, f);
return(goto_OPT_EVAL);
-
- case T_CLOSURE:
- if ((!has_methods(f)) &&
- (closure_arity_to_int(sc, f) == 1))
- {
- if ((is_pair(cadr(code))) &&
- (caadr(code) == sc->quote_symbol))
- return(fixup_unknown_op(sc, code, f, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_Q : OP_CLOSURE_Q));
-
- if (is_safe_closure(f))
- set_optimize_op(code, (is_global(car(code))) ? OP_SAFE_GLOSURE_A : OP_SAFE_CLOSURE_A);
- else set_optimize_op(code, (is_global(car(code))) ? OP_GLOSURE_A : OP_CLOSURE_A);
- set_opt_lambda(code, f);
- return(goto_OPT_EVAL);
- }
- break;
-
- case T_CLOSURE_STAR:
- if ((!has_methods(f)) &&
- (has_simple_args(closure_body(f))) &&
- (closure_star_arity_to_int(sc, f) >= 1) &&
- (!arglist_has_keyword(cdr(code))))
- return(fixup_unknown_op(sc, code, f, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X));
- break;
-
- case T_STRING:
- return(fixup_unknown_op(sc, code, f, OP_STRING_A));
-
- case T_PAIR:
- return(fixup_unknown_op(sc, code, f, OP_PAIR_A));
-
- case T_C_OBJECT:
- return(fixup_unknown_op(sc, code, f, OP_C_OBJECT_A));
-
- case T_LET:
- return(fixup_unknown_op(sc, code, f, ((is_pair(cadr(code))) && (caadr(code) == sc->quote_symbol)) ? OP_ENVIRONMENT_Q : OP_ENVIRONMENT_A));
-
- case T_HASH_TABLE:
- return(fixup_unknown_op(sc, code, f, OP_HASH_TABLE_A));
-
- case T_GOTO:
- return(fixup_unknown_op(sc, code, f, OP_GOTO_A));
-
- default:
- break;
}
+ break;
+
+ case T_CLOSURE_STAR:
+ if ((!has_methods(f)) &&
+ (has_simple_arg_defaults(closure_body(f))) &&
+ (closure_star_arity_to_int(sc, f) >= 1))
+ return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_A : OP_CLOSURE_STAR_A)));
+ break;
+
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ return(fixup_unknown_op(sc, code, f, hop + OP_VECTOR_A));
+
+ case T_STRING: return(fixup_unknown_op(sc, code, f, hop + OP_STRING_A));
+ case T_PAIR: return(fixup_unknown_op(sc, code, f, hop + OP_PAIR_A));
+ case T_C_OBJECT: return(fixup_unknown_op(sc, code, f, hop + OP_C_OBJECT_A));
+ case T_LET: return(fixup_unknown_op(sc, code, f, hop + (((is_pair(cadr(code))) && (caadr(code) == sc->quote_symbol)) ? OP_ENVIRONMENT_Q : OP_ENVIRONMENT_A)));
+ case T_HASH_TABLE: return(fixup_unknown_op(sc, code, f, hop + OP_HASH_TABLE_A));
+ case T_GOTO: return(fixup_unknown_op(sc, code, f, hop + OP_GOTO_A));
+
+ default:
+ break;
}
return(fall_through);
}
static int unknown_aa_ex(s7_scheme *sc, s7_pointer f)
{
- if (s7_is_aritable(sc, f, 2))
+ s7_pointer code;
+ int hop;
+ /* fprintf(stderr, "unknown_aa: %d %s %s\n", type(f), DISPLAY(f), DISPLAY(sc->code)); */
+
+ code = sc->code;
+ hop = (is_immutable_symbol(car(code))) ? 1 : 0;
+ set_arglist_length(code, small_int(2));
+ annotate_args(sc, cdr(code), sc->envir);
+
+ switch (type(f))
{
- s7_pointer code;
+ case T_C_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ case T_C_FUNCTION_STAR:
+ if ((c_function_required_args(f) > 2) ||
+ (c_function_all_args(f) < 2))
+ break;
- code = sc->code;
- set_arglist_length(code, small_int(2));
- annotate_args(sc, cdr(code), sc->envir);
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_ANY_ARGS_FUNCTION:
+ set_optimize_op(code, hop + ((is_safe_procedure(f)) ? OP_SAFE_C_AA : OP_C_ALL_X));
+ set_c_function(code, f);
+ return(goto_OPT_EVAL);
- switch (type(f))
+ case T_CLOSURE:
+ if ((!has_methods(f)) &&
+ (closure_arity_to_int(sc, f) == 2))
{
- case T_CLOSURE:
- if ((!has_methods(f)) &&
- (closure_arity_to_int(sc, f) == 2))
- {
- set_optimize_op(code, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_AA : OP_CLOSURE_AA);
- set_opt_lambda(code, f);
- return(goto_OPT_EVAL);
- }
- break;
-
- case T_CLOSURE_STAR:
- if ((!has_methods(f)) &&
- (has_simple_args(closure_body(f))) &&
- (closure_star_arity_to_int(sc, f) >= 2) &&
- (!arglist_has_keyword(cdr(code))))
- return(fixup_unknown_op(sc, code, f, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X));
- break;
-
- case T_C_FUNCTION: case T_C_FUNCTION_STAR: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
- set_optimize_op(code, (is_safe_procedure(f)) ? OP_SAFE_C_AA : OP_C_ALL_X);
- set_c_function(code, f);
+ set_optimize_op(code, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_AA : OP_CLOSURE_AA));
+ set_opt_lambda(code, f);
return(goto_OPT_EVAL);
-
- default:
- break;
}
+ break;
+
+ case T_CLOSURE_STAR:
+ if ((!has_methods(f)) &&
+ (has_simple_arg_defaults(closure_body(f))))
+ {
+ set_arglist_length(code, small_int(2));
+ if (closure_star_arity_to_int(sc, f) == 2)
+ return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_AA : OP_CLOSURE_STAR_AA)));
+ return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X)));
+ }
+ break;
+
+ default:
+ break;
}
return(fall_through);
}
@@ -60234,53 +65458,74 @@ static int unknown_aa_ex(s7_scheme *sc, s7_pointer f)
static int unknown_all_x_ex(s7_scheme *sc, s7_pointer f)
{
s7_pointer code;
- int num_args;
+ int num_args, hop;
code = sc->code;
+ hop = (is_immutable_symbol(car(code))) ? 1 : 0;
num_args = integer(arglist_length(code));
- if (s7_is_aritable(sc, f, num_args))
- {
- switch (type(f))
+#if DEBUGGING && 0
+ {
+ s7_pointer p;
+ int i;
+ for (i = 1, p = cdr(code); is_pair(p); i++, p = cdr(p))
+ if (!has_all_x(p))
{
- case T_CLOSURE:
- if ((!has_methods(f)) &&
- (closure_arity_to_int(sc, f) == num_args))
- {
- annotate_args(sc, cdr(code), sc->envir);
- if (is_safe_closure(f))
- {
- if ((is_symbol(cadr(code))) &&
- (num_args == 3))
- set_optimize_op(code, OP_SAFE_CLOSURE_SAA);
- else set_optimize_op(code, OP_SAFE_CLOSURE_ALL_X);
- }
- else set_optimize_op(code, OP_CLOSURE_ALL_X);
- set_opt_lambda(code, f);
- return(goto_OPT_EVAL);
- }
- break;
+ 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:
+ case T_C_FUNCTION_STAR:
+ if (((int)c_function_required_args(f) > num_args) ||
+ ((int)c_function_all_args(f) < num_args))
+ break;
+
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_ANY_ARGS_FUNCTION:
+ if (is_safe_procedure(f))
+ set_optimize_op(code, hop + ((num_args == 3) ? OP_SAFE_C_AAA : OP_SAFE_C_ALL_X));
+ else set_optimize_op(code, hop + OP_C_ALL_X);
+ annotate_args(sc, cdr(code), sc->envir);
+ set_c_function(code, f);
+ return(goto_OPT_EVAL);
- case T_CLOSURE_STAR:
- if ((!has_methods(f)) &&
- (has_simple_args(closure_body(f))) &&
- (closure_star_arity_to_int(sc, f) >= num_args) &&
- (!arglist_has_keyword(cdr(code))))
+ case T_CLOSURE:
+ if ((!has_methods(f)) &&
+ (closure_arity_to_int(sc, f) == num_args))
+ {
+ annotate_args(sc, cdr(code), sc->envir);
+ if (is_safe_closure(f))
{
- annotate_args(sc, cdr(code), sc->envir);
- return(fixup_unknown_op(sc, code, f, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X));
+ if ((is_symbol(cadr(code))) &&
+ (num_args == 3))
+ set_optimize_op(code, hop + OP_SAFE_CLOSURE_SAA);
+ else set_optimize_op(code, hop + OP_SAFE_CLOSURE_ALL_X);
}
- break;
-
- case T_C_FUNCTION: case T_C_FUNCTION_STAR: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
- set_optimize_op(code, (is_safe_procedure(f)) ? OP_SAFE_C_ALL_X : OP_C_ALL_X);
- annotate_args(sc, cdr(code), sc->envir);
- set_c_function(code, f);
+ else set_optimize_op(code, hop + OP_CLOSURE_ALL_X);
+ set_opt_lambda(code, f);
return(goto_OPT_EVAL);
-
- default:
- break;
}
+ break;
+
+ case T_CLOSURE_STAR:
+ if ((!has_methods(f)) &&
+ (has_simple_arg_defaults(closure_body(f))) &&
+ (closure_star_arity_to_int(sc, f) >= num_args))
+ {
+ set_arglist_length(code, small_int(num_args));
+ annotate_args(sc, cdr(code), sc->envir);
+ return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X)));
+ }
+ break;
+
+ default:
+ break;
}
return(fall_through);
}
@@ -60360,7 +65605,7 @@ static int read_s_ex(s7_scheme *sc)
s7_pointer port, code;
code = sc->code;
- port = find_symbol_checked(sc, cadr(code));
+ port = find_symbol_unchecked(sc, cadr(code));
if (!is_input_port(port)) /* was also not stdin */
{
@@ -60385,15 +65630,9 @@ static int read_s_ex(s7_scheme *sc)
sc->tok = token(sc);
switch (sc->tok)
{
- case TOKEN_EOF:
- return(goto_START);
-
- case TOKEN_RIGHT_PAREN:
- read_error(sc, "unexpected close paren");
-
- case TOKEN_COMMA:
- read_error(sc, "unexpected comma");
-
+ case TOKEN_EOF: return(goto_START);
+ case TOKEN_RIGHT_PAREN: read_error(sc, "unexpected close paren");
+ case TOKEN_COMMA: read_error(sc, "unexpected comma");
default:
sc->value = read_expression(sc);
sc->current_line = port_line_number(sc->input_port); /* this info is used to track down missing close parens */
@@ -60427,68 +65666,25 @@ static void eval_string_1_ex(s7_scheme *sc)
sc->code = sc->value;
}
-static int string_c_ex(s7_scheme *sc)
-{
- s7_int index;
- s7_pointer s, code;
- code = sc->code;
-
- s = find_symbol_checked(sc, car(code));
- if ((!is_string(s)) ||
- (!is_integer(cadr(code))))
- return(fall_through);
-
- index = s7_integer(cadr(code));
- if ((index < string_length(s)) &&
- (index >= 0))
- {
- if (is_byte_vector(s))
- sc->value = small_int((unsigned char)string_value(s)[index]);
- else sc->value = s7_make_character(sc, ((unsigned char *)string_value(s))[index]);
- return(goto_START);
- }
- sc->value = string_ref_1(sc, s, cadr(code));
- return(goto_START);
-}
-
static int string_a_ex(s7_scheme *sc)
{
s7_int index;
s7_pointer s, x, code;
code = sc->code;
- s = find_symbol_checked(sc, car(code));
+ s = find_symbol_unchecked(sc, car(code));
x = c_call(cdr(code))(sc, cadr(code));
- if ((!is_string(s)) ||
- (!s7_is_integer(x)))
- return(fall_through);
-
- index = s7_integer(x);
- if ((index < string_length(s)) &&
- (index >= 0))
+ if (!is_string(s))
{
- if (is_byte_vector(s))
- sc->value = small_int((unsigned char)string_value(s)[index]);
- else sc->value = s7_make_character(sc, ((unsigned char *)string_value(s))[index]);
+ sc->last_function = s;
+ return(fall_through);
+ }
+ if (!s7_is_integer(x))
+ {
+ sc->value = string_ref_1(sc, s, cons(sc, x, sc->nil));
return(goto_START);
}
- sc->value = string_ref_1(sc, s, x);
- return(goto_START);
-}
-
-static int string_s_ex(s7_scheme *sc)
-{
- s7_int index;
- s7_pointer s, ind, code;
- code = sc->code;
-
- s = find_symbol_checked(sc, car(code));
- ind = find_symbol_checked(sc, cadr(code));
- if ((!is_string(s)) ||
- (!s7_is_integer(ind)))
- return(fall_through);
-
- index = s7_integer(ind);
+ index = s7_integer(x);
if ((index < string_length(s)) &&
(index >= 0))
{
@@ -60497,87 +65693,7 @@ static int string_s_ex(s7_scheme *sc)
else sc->value = s7_make_character(sc, ((unsigned char *)string_value(s))[index]);
return(goto_START);
}
- sc->value = string_ref_1(sc, s, ind);
- return(goto_START);
-}
-
-
-static int vector_c_ex(s7_scheme *sc)
-{
- /* this is the implicit indexing case (vector-ref is a normal safe op)
- * (define (hi) (let ((v (vector 1 2 3))) (v 0)))
- * this starts as unknown_g in optimize_expression -> vector_c
- * but it still reports itself as unsafe, so there are higher levels possible
- */
- s7_pointer v, code;
- code = sc->code;
-
- v = find_symbol_checked(sc, car(code));
- if ((!s7_is_vector(v)) ||
- (!s7_is_integer(cadr(code)))) /* (v 4/3) */
- return(fall_through);
-
- if (vector_rank(v) == 1)
- {
- s7_int index;
- index = s7_integer(cadr(code));
- if ((index < vector_length(v)) &&
- (index >= 0))
- {
- sc->value = vector_getter(v)(sc, v, index);
- return(goto_START);
- }
- }
- sc->value = vector_ref_1(sc, v, cdr(code));
- return(goto_START);
-}
-
-static int vector_cc_ex(s7_scheme *sc)
-{
- s7_pointer v, code;
-
- code = sc->code;
- v = find_symbol_checked(sc, car(code));
- if (!s7_is_vector(v)) /* we've checked that the args are non-negative ints */
- return(fall_through);
-
- if (vector_rank(v) == 2)
- {
- s7_int index;
- index = s7_integer(cadr(code)) * vector_offset(v, 0) + s7_integer(caddr(code));
- if (index < vector_length(v))
- {
- sc->value = vector_getter(v)(sc, v, index);
- return(goto_START);
- }
- }
- sc->value = vector_ref_1(sc, v, cdr(code));
- return(goto_START);
-}
-
-static int vector_s_ex(s7_scheme *sc)
-{
- s7_pointer v, ind, code;
-
- code = sc->code;
- v = find_symbol_checked(sc, car(code));
- ind = find_symbol_checked(sc, cadr(code));
- if ((!s7_is_vector(v)) ||
- (!s7_is_integer(ind)))
- return(fall_through);
-
- if (vector_rank(v) == 1)
- {
- s7_int index;
- index = s7_integer(ind);
- if ((index < vector_length(v)) &&
- (index >= 0))
- {
- sc->value = vector_getter(v)(sc, v, index);
- return(goto_START);
- }
- }
- sc->value = vector_ref_1(sc, v, cons(sc, ind, sc->nil));
+ sc->value = string_ref_1(sc, s, x);
return(goto_START);
}
@@ -60586,10 +65702,12 @@ static int vector_a_ex(s7_scheme *sc)
s7_pointer v, x, code;
code = sc->code;
- v = find_symbol_checked(sc, car(code));
+ v = find_symbol_unchecked(sc, car(code));
if (!s7_is_vector(v))
- return(fall_through);
-
+ {
+ sc->last_function = v;
+ return(fall_through);
+ }
x = c_call(cdr(code))(sc, cadr(code));
if (s7_is_integer(x))
{
@@ -60848,6 +65966,8 @@ static int apply_pair(s7_scheme *sc) /* -------- li
/* car of values can be anything, so conjure up a new expression, and apply again */
sc->x = multiple_value(sc->code); /* ((values + 1 2) 3) */
sc->code = car(sc->x);
+ if (!is_proper_list(sc, cdr(sc->x)))
+ s7_error(sc, sc->syntax_error_symbol, set_elist_2(sc, make_string_wrapper(sc, "values arglist is a dotted list: ~A"), sc->x));
sc->args = s7_append(sc, cdr(sc->x), sc->args);
sc->x = sc->nil;
return(goto_APPLY);
@@ -60888,17 +66008,15 @@ static void apply_iterator(s7_scheme *sc) /* -------- i
sc->value = s7_iterate(sc, sc->code);
}
-static void apply_lambda(s7_scheme *sc) /* -------- normal function (lambda), or macro -------- */
+static void apply_lambda(s7_scheme *sc) /* -------- normal function (lambda), or macro -------- */
{ /* load up the current args into the ((args) (lambda)) layout [via the current environment] */
- /* not often safe closure here, and very confusing if so to get identity macro args handled correctly */
s7_pointer x, z, e;
unsigned long long int id;
e = sc->envir;
id = let_id(e);
-
for (x = closure_args(sc->code), z = _TLst(sc->args); is_pair(x); x = cdr(x)) /* closure_args can be a symbol, for example */
{
- s7_pointer sym, args, val;
+ s7_pointer sym, args;
/* reuse the value cells as the new frame slots */
if (is_null(z))
@@ -60912,18 +66030,16 @@ static void apply_lambda(s7_scheme *sc) /* --------
* so fallback on current_code(sc) in this section.
* But that can be #f, and closure_name can be confusing in this context, so we need a better error message!
*/
-
+
sym = car(x);
- val = _NFre(car(z));
args = cdr(z);
- set_type(z, T_SLOT);
- slot_set_symbol(z, sym);
+ reuse_as_slot(z, sym, unchecked_car(z));
symbol_set_local(sym, id, z);
- slot_set_value(z, val);
set_next_slot(z, let_slots(e));
let_set_slots(e, z);
z = args;
}
+
if (is_null(x))
{
if (is_not_null(z))
@@ -60943,6 +66059,234 @@ static void apply_lambda(s7_scheme *sc) /* --------
sc->code = closure_body(sc->code);
}
+
+/* lambda* */
+static s7_pointer lambda_star_argument_set_value(s7_scheme *sc, s7_pointer sym, s7_pointer val)
+{
+ s7_pointer x;
+
+ for (x = let_slots(sc->envir) /* presumably the arglist */; is_slot(x); x = next_slot(x))
+ if (slot_symbol(x) == sym)
+ {
+ /* x is our binding (symbol . value) */
+ if (is_not_checked_slot(x))
+ set_checked_slot(x); /* this is a special use of this bit, I think */
+ else return(s7_error(sc, sc->wrong_type_arg_symbol,
+ set_elist_4(sc, make_string_wrapper(sc, "~A: parameter set twice, ~S in ~S"), closure_name(sc, sc->code), sym, sc->args)));
+ slot_set_value(x, val);
+ return(val);
+ }
+ return(sc->no_value);
+}
+
+
+static s7_pointer lambda_star_set_args(s7_scheme *sc)
+{
+ /* sc->code is a closure: (args body envir)
+ * (define* (hi a (b 1)) (+ a b))
+ * (procedure-source hi) -> (lambda* (a (b 1)) (+ a b))
+ *
+ * so rather than spinning through the args binding names to values in the
+ * procedure's new environment (as in the usual closure case above),
+ * we scan the current args, and match against the
+ * template in the car of the closure, binding as we go.
+ *
+ * for each actual arg, if it's not a keyword that matches a member of the
+ * template, bind it to its current (place-wise) arg, else bind it to
+ * that arg. If it's :rest bind the next arg to the trailing args at this point.
+ * All args can be accessed by their name as a keyword.
+ *
+ * all args are optional, any arg with no default value defaults to #f.
+ * but the rest arg should default to ().
+ * I later decided to add two warnings: if a parameter is set twice and if
+ * an unknown keyword is seen in a keyword position and there is no rest arg.
+ */
+
+ bool allow_other_keys;
+ s7_pointer lx, cx, zx, code, args;
+
+ /* get the current args, re-setting args that have explicit values */
+ code = sc->code;
+ args = sc->args;
+ cx = closure_args(code);
+ allow_other_keys = ((is_pair(cx)) && (allows_other_keys(cx)));
+ lx = sc->args;
+
+ zx = sc->nil;
+ while ((is_pair(cx)) &&
+ (is_pair(lx)))
+ {
+ if (car(cx) == sc->key_rest_symbol) /* the rest arg */
+ {
+ /* next arg is bound to trailing args from this point as a list */
+ zx = sc->key_rest_symbol;
+ cx = cdr(cx);
+ lambda_star_argument_set_value(sc, car(cx), lx); /* default arg not allowed here (see check_lambda_star_args) */
+ lx = cdr(lx);
+ cx = cdr(cx);
+ }
+ else
+ {
+ /* mock-symbols introduce an ambiguity here; if the mock symbol's value is a keyword, is that
+ * intended to be used as an argument name or value?
+ * this applies to any evaluated arg that returns a keyword.
+ * 22-May-17: decided to use the value (i.e. treat a keyword as a keyword)
+ */
+ s7_pointer car_lx;
+ car_lx = car(lx);
+ if (has_methods(car_lx))
+ car_lx = check_values(sc, car_lx, lx);
+ if (is_keyword(car_lx))
+ {
+ s7_pointer sym;
+ if (!is_pair(cdr(lx)))
+ return(s7_error(sc, sc->wrong_type_arg_symbol,
+ set_elist_4(sc, make_string_wrapper(sc, "~A: keyword argument's value is missing: ~S in ~S"),
+ closure_name(sc, code), lx, args)));
+ sym = keyword_symbol(car_lx);
+
+ if (lambda_star_argument_set_value(sc, sym, cadr(lx)) == sc->no_value)
+ {
+ /* if default value is a key, go ahead and use this value.
+ * (define* (f (a :b)) a) (f :c)
+ * this has become much trickier than I anticipated...
+ */
+ if (allow_other_keys)
+ {
+ /* in CL: (defun hi (&key (a 1) &allow-other-keys) a) (hi :b :a :a 3) -> 3
+ * in s7: (define* (hi (a 1) :allow-other-keys) a) (hi :b :a :a 3) -> 3
+ */
+ lx = cddr(lx);
+ continue;
+ }
+ else
+ {
+ return(s7_error(sc, sc->wrong_type_arg_symbol,
+ set_elist_4(sc, make_string_wrapper(sc, "~A: unknown key: ~S in ~S"),
+ closure_name(sc, code), lx, args)));
+ }
+ }
+ lx = cddr(lx);
+ }
+ else /* not a key/value pair */
+ {
+ /* this is always a positional (i.e. direct) change, but the closure_args are in the
+ * definition order whereas currently the environment slots are in reverse order.
+ */
+ if (is_pair(car(cx)))
+ lambda_star_argument_set_value(sc, caar(cx), car(lx));
+ else lambda_star_argument_set_value(sc, car(cx), car(lx));
+
+ lx = cdr(lx);
+ }
+ cx = cdr(cx);
+ }
+ }
+
+ /* (let () (define* (hi (a 1) :allow-other-keys) a) (hi :a 2 32)) */
+ /* (let () (define* (f (a :b)) a) (list (f) (f 1) (f :c) (f :a :c) (f :a 1) (f))) */
+
+ /* check for trailing args with no :rest arg */
+ if (is_not_null(lx))
+ {
+ if ((is_not_null(cx)) ||
+ (zx == sc->key_rest_symbol))
+ {
+ if (is_symbol(cx))
+ make_slot_1(sc, sc->envir, cx, lx);
+ }
+ else
+ {
+ if (!allow_other_keys) /* ((lambda* (a) a) :a 1 2) */
+ return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, closure_name(sc, code), args)));
+ else
+ {
+ /* check trailing args for repeated keys or keys with no values or values with no keys */
+ while (is_pair(lx))
+ {
+ if ((!is_keyword(car(lx))) || /* ((lambda* (a :allow-other-keys) a) :a 1 :b 2 3) */
+ (!is_pair(cdr(lx)))) /* ((lambda* (a :allow-other-keys) a) :a 1 :b) */
+ return(s7_error(sc, sc->wrong_type_arg_symbol,
+ set_elist_3(sc, make_string_wrapper(sc, "~A: not a key/value pair: ~S"), closure_name(sc, code), lx)));
+ /* errors not caught?
+ * ((lambda* (a :allow-other-keys) a) :a 1 :a 2)
+ * ((lambda* (:allow-other-keys ) #f) :b :a :a :b)
+ */
+ lx = cddr(lx);
+ }
+ }
+ }
+ }
+ return(sc->nil);
+}
+
+static int lambda_star_default(s7_scheme *sc)
+{
+ while (true)
+ {
+ s7_pointer z;
+ z = sc->args;
+ if (is_slot(z))
+ {
+ if (slot_value(z) == sc->undefined)
+ {
+ if (is_closure_star(sc->code))
+ {
+ s7_pointer val;
+ val = slot_expression(z);
+ if (is_symbol(val))
+ {
+ slot_set_value(z, find_symbol_checked(sc, val));
+ if (slot_value(z) == sc->undefined)
+ {
+ /* the current environment here contains the function parameters which
+ * defaulted to #<undefined> earlier in apply_lambda_star,
+ * so (define (f f) (define* (f (f f)) f) (f)) (f 0) looks for the
+ * default f, finds itself currently undefined, and raises an error!
+ * So, before claiming it is unbound, we need to check outlet as well.
+ * But in the case above, the inner define* shadows the caller's
+ * parameter before checking the default arg values, so the default f
+ * refers to the define* -- I'm not sure this is a bug. It means
+ * that (define* (f (a f)) a) returns f: (equal? f (f)) -> #t, so
+ * any outer f needs an extra let and endless outlets:
+ * (let ((f 3)) (let () (define* (f (a ((outlet (outlet (outlet (curlet)))) 'f))) a) (f))) -> 3
+ * We want the shadowing once the define* is done, so the current mess is simplest.
+ */
+ slot_set_value(z, s7_symbol_local_value(sc, val, outlet(sc->envir)));
+ if (slot_value(z) == sc->undefined)
+ eval_error_no_return(sc, sc->syntax_error_symbol, "lambda* defaults: ~A is unbound", slot_symbol(z));
+ }
+ }
+ else
+ {
+ if (is_pair(val))
+ {
+ if (car(val) == sc->quote_symbol)
+ {
+ if ((!is_pair(cdr(val))) || /* (lambda* ((a (quote))) a) or (lambda* ((a (quote 1 1))) a) etc */
+ (is_pair(cddr(val))))
+ eval_error_no_return(sc, sc->syntax_error_symbol, "lambda* default: ~A is messed up", val);
+ slot_set_value(z, cadr(val));
+ }
+ else
+ {
+ push_stack(sc, OP_LAMBDA_STAR_DEFAULT, sc->args, sc->code);
+ sc->code = val;
+ return(goto_EVAL);
+ }
+ }
+ else slot_set_value(z, val);
+ }
+ }
+ else slot_set_value(z, slot_expression(z));
+ }
+ sc->args = slot_pending_value(z);
+ }
+ else break;
+ }
+ return(fall_through);
+}
+
static int apply_lambda_star(s7_scheme *sc) /* -------- define* (lambda*) -------- */
{
/* to check for and fixup unset args from defaults, we need to traverse the slots in left-to-right order
@@ -60960,7 +66304,7 @@ static int apply_lambda_star(s7_scheme *sc) /* -------- defin
{
s7_pointer car_z;
car_z = car(z);
- if (is_pair(car_z)) /* arg has a default value of some sort */
+ if (is_pair(car_z)) /* arg has a default value */
{
s7_pointer val;
val = cadr(car_z);
@@ -61016,6 +66360,7 @@ static int apply_lambda_star(s7_scheme *sc) /* -------- defin
return(goto_BEGIN1);
}
+
static void apply_continuation(s7_scheme *sc) /* -------- continuation ("call/cc") -------- */
{
if (!call_with_current_continuation(sc))
@@ -61054,13 +66399,14 @@ static int define1_ex(s7_scheme *sc)
* we want to ignore the rebinding (not raise an error) if it is the existing value.
* This happens when we reload a file that calls define-constant.
*/
- if (is_immutable(sc->code)) /* (define pi 3) or (define (pi a) a) */
+ /* sc->code is a symbol at this point */
+ if (is_immutable_symbol(sc->code)) /* (define pi 3) or (define (pi a) a) */
{
s7_pointer x;
- if (!is_symbol(sc->code)) /* (define "pi" 3) ? */
- eval_error_no_return(sc, sc->syntax_error_symbol, "define: ~S is immutable", sc->code);
- x = global_slot(sc->code);
+ 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 */
@@ -61086,20 +66432,18 @@ static void define2_ex(s7_scheme *sc)
{
if ((is_any_closure(sc->value)) &&
((!(is_let(closure_let(sc->value)))) ||
- (!(is_function_env(closure_let(sc->value)))))) /* otherwise it's (define f2 f1) or something similar */
+ (!(is_funclet(closure_let(sc->value)))))) /* otherwise it's (define f2 f1) or something similar */
{
s7_pointer new_func, new_env;
new_func = sc->value;
-
- new_cell_no_check(sc, new_env, T_LET | T_FUNCTION_ENV);
- let_id(new_env) = ++sc->let_number;
- set_outlet(new_env, closure_let(new_func));
- closure_set_let(new_func, new_env);
- let_set_slots(new_env, sc->nil);
- funclet_set_function(new_env, sc->code);
-
- if (/* (!is_let(sc->envir)) && */
- (port_filename(sc->input_port)) &&
+ new_env = make_funclet(sc, new_func, sc->code, closure_let(new_func));
+ /* this should happen only if the closure* default values do not refer in any way to
+ * the enclosing environment (else we can accidentally shadow something that happens
+ * to share an argument name that is being used as a default value -- kinda dumb!).
+ * I think I'll check this before setting the safe_closure bit.
+ */
+
+ if ((port_filename(sc->input_port)) &&
(port_file(sc->input_port) != stdin))
{
/* unbound_variable will be called if __func__ is encountered, and will return this info as if __func__ had some meaning */
@@ -61112,23 +66456,6 @@ static void define2_ex(s7_scheme *sc)
let_set_line(new_env, 0);
}
- /* this should happen only if the closure* default values do not refer in any way to
- * the enclosing environment (else we can accidentally shadow something that happens
- * to share an argument name that is being used as a default value -- kinda dumb!).
- * I think I'll check this before setting the safe_closure bit.
- */
- if (is_safe_closure(new_func))
- {
- int i;
- s7_pointer arg;
- for (i = 0, arg = closure_args(new_func); is_pair(arg); i++, arg = cdr(arg))
- {
- if (is_pair(car(arg)))
- make_slot_1(sc, new_env, caar(arg), sc->nil);
- else make_slot_1(sc, new_env, car(arg), sc->nil);
- }
- let_set_slots(new_env, reverse_slots(sc, let_slots(new_env)));
- }
/* add the newly defined thing to the current environment */
if (is_let(sc->envir))
{
@@ -61153,74 +66480,85 @@ static void define2_ex(s7_scheme *sc)
/* ---------------------------------------- */
-static void clear_all_optimizations(s7_scheme *sc, s7_pointer p)
-{
- /* I believe that we would not have been optimized to begin with if the tree were circular,
- * and this tree is supposed to be a function call + args -- a circular list here is a bug.
- */
- if (is_pair(p))
- {
- if ((is_optimized(p)) &&
- ((optimize_op(p) & 1) == 0)) /* protect possibly shared code? Elsewhere we assume these aren't changed */
- {
- clear_optimized(p);
- clear_optimize_op(p);
- /* these apparently make no difference */
- set_opt_con1(p, sc->nil);
- set_opt_con2(p, sc->nil);
- }
- clear_all_optimizations(sc, cdr(p));
- clear_all_optimizations(sc, car(p));
- }
-}
-
-
-static bool a_is_ok(s7_scheme *sc, s7_pointer p)
-{
- /* "A" here need not be a function call or "p" a pair (all_x_c etc) */
- if (is_pair(p))
- {
- if ((is_optimized(p)) &&
- (!c_function_is_ok(sc, p)))
- return(false);
- if (car(p) != sc->quote_symbol)
- return((a_is_ok(sc, car(p))) &&
- (a_is_ok(sc, cdr(p))));
- }
- return(true);
-}
-
#define c_function_is_ok_cadr(Sc, P) ((c_function_is_ok(Sc, P)) && (c_function_is_ok(Sc, cadr(P))))
#define c_function_is_ok_caddr(Sc, P) ((c_function_is_ok(Sc, P)) && (c_function_is_ok(Sc, caddr(P))))
#define c_function_is_ok_cadr_caddr(Sc, P) ((c_function_is_ok(Sc, P)) && (c_function_is_ok(Sc, cadr(P))) && (c_function_is_ok(Sc, caddr(P))))
-#define a_is_ok_cadr(Sc, P) ((c_function_is_ok(Sc, P)) && (a_is_ok(Sc, cadr(P))))
-#define a_is_ok_caddr(Sc, P) ((c_function_is_ok(Sc, P)) && (a_is_ok(Sc, caddr(P))))
-#define a_is_ok_cadddr(Sc, P) ((c_function_is_ok(Sc, P)) && (a_is_ok(Sc, cadddr(P))))
+#if WITH_GCC
+ #define indirect_c_function_is_ok(Sc, X) ({s7_pointer _X_; _X_ = X; (((optimize_op(_X_) & 0x1) != 0) || (c_function_is_ok(Sc, _X_)));})
+ #define indirect_cq_function_is_ok(Sc, X) ({s7_pointer _X_; _X_ = X; ((!is_optimized(_X_)) || ((optimize_op(_X_) & 0x1) != 0) || (c_function_is_ok(Sc, _X_)));})
+#else
+ #define indirect_c_function_is_ok(Sc, X) (((optimize_op(X) & 0x1) != 0) || (c_function_is_ok(Sc, X)))
+ #define indirect_cq_function_is_ok(Sc, X) ((!is_optimized(X)) || ((optimize_op(X) & 0x1) != 0) || (c_function_is_ok(Sc, X)))
+#endif
#if WITH_PROFILE
+#define profile_location(p) p->file_and_line
+#define profile_set_location(p, N) p->file_and_line = N
+
static void profile(s7_scheme *sc, s7_pointer expr)
{
+ /* I tried using SIGPROF and a tick counter below (in addition to the line counter), but the added info
+ * did not seem very useful.
+ */
+ if ((sc->free_heap_top - sc->free_heap) < 32)
+ gc(sc);
+
if (is_null(sc->profile_info))
{
sc->profile_info = s7_make_hash_table(sc, 65536);
s7_gc_protect(sc, sc->profile_info);
}
if ((is_pair(expr)) &&
- (has_line_number(expr)))
+ (profile_location(expr) > 0))
{
s7_pointer val, key;
- key = s7_make_integer(sc, pair_line(expr));
+ key = s7_make_integer(sc, profile_location(expr)); /* file + line */
val = s7_hash_table_ref(sc, sc->profile_info, key);
if (val == sc->F)
- s7_hash_table_set(sc, sc->profile_info, key, cons(sc, make_mutable_integer(sc, 1), expr));
+ {
+ bool old_short_print;
+ 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)))));
+ sc->short_print = old_short_print;
+ }
+ /* can't save the actual expr here -- it can be stepped on */
else integer(car(val))++;
}
}
+
+static s7_pointer g_profile_line_number(s7_scheme *sc, s7_pointer args)
+{
+ #define H_profile_line_number "(profile-line-number obj) returns the line number at which the profiler read obj"
+ #define Q_profile_line_number s7_make_signature(sc, 2, sc->is_integer_symbol, sc->T)
+ return(make_integer(sc, remembered_line_number(integer(car(args)))));
+}
+
+static s7_pointer g_profile_filename(s7_scheme *sc, s7_pointer args)
+{
+ #define H_profile_filename "(profile-filename obj) returns the name of the file containing obj"
+ #define Q_profile_filename s7_make_signature(sc, 2, sc->is_string_symbol, sc->T)
+ return(remembered_file_name(integer(car(args))));
+}
#endif
+#define unsafe_closure_2(Sc, Arg1, Arg2) \
+{ \
+ s7_pointer Code, Args, A1, A2; A1 = Arg1; A2 = Arg2; \
+ check_stack_size(Sc); \
+ Code = opt_lambda(Sc->code); \
+ Args = closure_args(Code); \
+ new_frame_with_two_slots(Sc, closure_let(Code), Sc->envir, car(Args), A1, cadr(Args), A2); \
+ Sc->code = closure_body(Code); \
+}
+
/* -------------------------------- eval -------------------------------- */
@@ -61238,7 +66576,7 @@ static void profile(s7_scheme *sc, s7_pointer expr)
do { \
if ((Sc->free_heap_top <= Sc->free_heap_trigger) || (for_any_other_reason(sc, __LINE__))) {last_gc_line = __LINE__; last_gc_func = __func__; try_to_call_gc(Sc); if ((Sc->begin_hook) && (call_begin_hook(Sc))) return(Sc->F);} \
Obj = (*(--(Sc->free_heap_top))); \
- Obj->alloc_line = __LINE__; Obj->alloc_func = __func__; \
+ Obj->alloc_line = __LINE__; Obj->alloc_func = __func__; Obj->debugger_bits = 0; \
set_type(Obj, Type); \
} while (0)
#endif
@@ -61258,6 +66596,22 @@ static s7_pointer check_for_cyclic_code(s7_scheme *sc, s7_pointer code)
return(sc->F);
}
+#if WITH_PROFILE
+ 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)
{
@@ -61289,12 +66643,20 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
*/
START_WITHOUT_POP_STACK:
- /* fprintf(stderr, "%s (%d)\n", op_names[sc->op], (int)(sc->op)); */
+ /* fprintf(stderr, "%s (%d) %s\n", op_names[sc->op], (int)(sc->op), DISPLAY_80(sc->code)); */
+#if SHOW_DEBUG_HISTORY
+ add_debug_history((char *)op_names[sc->op]);
+#endif
+#if WITH_PROFILE
+ profile_at_start = sc->code;
+ profile(sc, sc->code);
+#endif
switch (sc->op)
{
case OP_NO_OP:
+ case OP_GC_PROTECT:
break;
-
+
case OP_READ_INTERNAL:
/* if we're loading a file, and in the file we evaluate something like:
* (let ()
@@ -61393,22 +66755,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->value = splice_in_values(sc, multiple_value(sc->value));
break;
-
- case OP_EVAL_STRING_2:
- s7_close_input_port(sc, sc->input_port);
- pop_input_port(sc);
-
- if (is_multiple_value(sc->value))
- sc->value = splice_in_values(sc, multiple_value(sc->value));
- break;
-
- case OP_EVAL_STRING_1:
- eval_string_1_ex(sc);
- goto EVAL;
-
-
+
/* -------------------- sort! (heapsort, done directly so that call/cc in the sort function will work correctly) -------------------- */
-
#define SORT_N integer(vector_element(sc->code, 0))
#define SORT_K integer(vector_element(sc->code, 1))
#define SORT_J integer(vector_element(sc->code, 2))
@@ -61428,7 +66776,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if ((n == k) || (k > ((s7_int)(n / 2)))) /* k == n == 0 is the first case */
goto START;
- if (sc->safety != 0)
+ if (sc->safety > NO_SAFETY)
{
SORT_CALLS++;
if (SORT_CALLS > SORT_STOP)
@@ -61497,7 +66845,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
case OP_SORT:
- /* coming in sc->args is sort args (data less?), sc->code = '(n k 0)
+ /* coming in sc->args is sort args (data less?), sc->code = #(n k 0 ...)
* here we call the inner loop until k <= 0 [the local k! -- this is tricky because scheme passes args by value]
*/
{
@@ -61534,14 +66882,17 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_SORT_PAIR_END: /* sc->value is the sort vector which needs to be copied into the original list */
sc->value = vector_into_list(sc->value, car(sc->args));
+ free_cell(sc, sc->args);
break;
case OP_SORT_VECTOR_END: /* sc->value is the sort (s7_pointer) vector which needs to be copied into the original (double/int) vector */
sc->value = vector_into_fi_vector(sc->value, car(sc->args));
+ free_cell(sc, sc->args);
break;
case OP_SORT_STRING_END:
sc->value = vector_into_string(sc->value, car(sc->args));
+ free_cell(sc, sc->args);
break;
/* batcher networks:
@@ -61565,7 +66916,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
* since each "<" op above goes to OP_APPLY, we have ca 5 labels, and ca 25-50 lines
*/
-
/* -------------------------------- MAP -------------------------------- */
case OP_MAP_GATHER_1:
if (sc->value != sc->no_value)
@@ -61586,6 +66936,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (iterator_is_at_end(p))
{
sc->value = safe_reverse_in_place(sc, counter_result(args));
+ /* an experiment */
+ free_cell(sc, sc->args);
+ sc->args = sc->nil;
goto START;
}
push_stack(sc, OP_MAP_GATHER_1, args, code);
@@ -61609,11 +66962,10 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
let_set_slots(counter_let(args), counter_slots(args));
sc->envir = old_frame_with_slot(sc, counter_let(args), x);
}
- sc->code = _TLst(closure_body(code));
+ sc->code = _TPair(closure_body(code));
goto BEGIN1;
}
-
case OP_MAP_GATHER:
if (sc->value != sc->no_value) /* (map (lambda (x) (values)) (list 1)) */
{
@@ -61635,7 +66987,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (iterator_is_at_end(car(y)))
{
sc->value = safe_reverse_in_place(sc, counter_result(sc->args));
- /* here and below it is not safe to pre-release sc->args (the counter) */
+ free_cell(sc, sc->args);
+ sc->args = sc->nil;
goto START;
}
sc->x = cons(sc, x, sc->x);
@@ -61663,6 +67016,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (iterator_is_at_end(car(y)))
{
sc->value = sc->unspecified;
+ free_cell(sc, sc->args);
+ sc->args = sc->nil;
goto START;
}
}
@@ -61673,7 +67028,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto APPLY;
}
-
/* for-each et al remake the local frame, but that's only needed if the local env is exported,
* and that can only happen through make-closure in various guises and curlet.
* owlet captures, but it would require a deliberate error to use it in this context.
@@ -61691,6 +67045,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (iterator_is_at_end(p))
{
sc->value = sc->unspecified;
+ free_cell(sc, counter);
+ sc->args = sc->nil;
goto START;
}
code = sc->code;
@@ -61707,7 +67063,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->envir = old_frame_with_slot(sc, counter_let(counter), arg);
}
push_stack(sc, OP_FOR_EACH_1, counter, code);
- sc->code = _TLst(closure_body(code));
+ sc->code = _TPair(closure_body(code));
goto BEGIN1;
}
@@ -61720,9 +67076,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (!is_pair(lst)) /* '(1 2 . 3) as arg? -- counter_list can be anything here */
{
sc->value = sc->unspecified;
+ free_cell(sc, c);
+ sc->args = sc->nil;
goto START;
}
- code = sc->code;
+ code = _TClo(sc->code);
arg = car(lst);
counter_set_list(c, cdr(lst));
if (sc->op == OP_FOR_EACH_3)
@@ -61731,6 +67089,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (counter_result(c) == counter_list(c))
{
sc->value = sc->unspecified;
+ free_cell(sc, c);
+ sc->args = sc->nil;
goto START;
}
push_stack(sc, OP_FOR_EACH_2, c, code);
@@ -61748,7 +67108,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
let_set_slots(counter_let(c), counter_slots(c));
sc->envir = old_frame_with_slot(sc, counter_let(c), arg);
}
- sc->code = _TLst(closure_body(code));
+ sc->code = _TPair(closure_body(code));
goto BEGIN1;
}
@@ -61833,6 +67193,152 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* -------------------------------- DO -------------------------------- */
+
+#define do_all_x_end(Code) \
+ do {s7_pointer End; End = Code; sc->value = c_call(End)(sc, car(End)); if (is_true(sc, sc->value)) {sc->code = cdr(End); goto DO_END_CLAUSES;}} while (0)
+
+ DO_NO_VARS:
+ case OP_DO_NO_VARS:
+ {
+ s7_pointer p;
+ int i;
+ sc->pc = 0;
+ for (i = 0, p = cddr(sc->code); is_pair(p); i++, p = cdr(p))
+ if (!cell_optimize(sc, p))
+ break;
+ if (is_null(p))
+ {
+ s7_pointer end;
+ end = cadr(sc->code);
+ sc->envir = new_frame_in_env(sc, sc->envir);
+ if (i == 1)
+ {
+ while (true)
+ {
+ do_all_x_end(end);
+ sc->pc = 0;
+ sc->opts[0]->v7.fp(sc->opts[0]);
+ }
+ }
+ else
+ {
+ if (i == 0) /* null body! */
+ {
+ s7_function endf;
+ s7_pointer endp;
+ endf = c_call(end);
+ endp = car(end);
+ while (!is_true(sc, sc->value = endf(sc, endp)));
+ sc->code = cdr(end);
+ goto DO_END_CLAUSES;
+ }
+ else
+ {
+ while (true)
+ {
+ int k;
+ do_all_x_end(end);
+ sc->pc = -1;
+ for (k = 0; k < i; k++)
+ {
+ opt_info *o;
+ o = sc->opts[++sc->pc];
+ o->v7.fp(o);
+ }
+ }
+ }
+ }
+ }
+ /* back out of do_no_vars */
+ pair_set_syntax_symbol(sc->code, sc->do_no_vars_no_opt_symbol);
+ /* fall through */
+ }
+
+ case OP_DO_NO_VARS_NO_OPT:
+ sc->envir = new_frame_in_env(sc, sc->envir);
+
+ 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);
+ goto BEGIN1;
+
+
+ DOTIMES_ONE_STEP:
+ case OP_DOTIMES_ONE_STEP:
+ {
+ s7_pointer end, stepper, end_slot;
+ s7_int lim = 0; /* make the compiler happy */
+
+ /* fprintf(stderr, "dotimes one step %s\n", DISPLAY(sc->code)); */
+
+ sc->envir = make_do_frame(sc);
+ /* fprintf(stderr, "frame: %s\n", DISPLAY(sc->envir)); */
+
+ end = cadr(sc->code);
+ do_all_x_end(end);
+
+ stepper = dox_slot1(sc->envir);
+ end_slot = find_symbol(sc, caddar(end)); /* can't trust local slot here (local_symbol?) */
+ if (is_t_integer(slot_value(end_slot)))
+ {
+ /* TODO: need to make sure step not set */
+ lim = integer(slot_value(end_slot));
+ denominator(slot_value(stepper)) = lim;
+ set_step_end(stepper);
+ }
+
+ if (s7_optimize_nr(sc, cddr(sc->code)))
+ {
+ s7_pointer step_expr;
+ step_expr = car(slot_expression(stepper));
+ /* fprintf(stderr, "slot: %s, end: %s %s\n", DISPLAY(stepper), DISPLAY(end), DISPLAY(slot_expression(stepper))); */
+
+ if ((is_slot(stepper)) &&
+ (c_callee(end) == all_x_c_ss) &&
+ (c_callee(car(end)) == g_equal_2) &&
+ (cadar(end) == slot_symbol(stepper)) &&
+ (is_t_integer(slot_value(stepper))) &&
+ /* (is_safe_stepper(stepper)) && */
+ (caar(end) = sc->add_symbol) &&
+ (cadar(end) == cadr(step_expr)) &&
+ (is_t_integer(caddr(step_expr))) &&
+ (integer(caddr(step_expr)) == 1) &&
+ (is_step_end(stepper)))
+ {
+ opt_info *o;
+ s7_pointer (*fp)(void *o);
+ s7_pointer val;
+ o = sc->opts[0];
+ fp = o->v7.fp;
+ val = make_mutable_integer(sc, integer(slot_value(stepper)));
+ slot_set_value(stepper, val);
+ for (; integer(val) < lim; integer(val)++)
+ {
+ sc->pc = 0;
+ fp(o);
+ }
+ sc->value = sc->T;
+ sc->code = cdr(end);
+ goto SAFE_DO_END_CLAUSES; /* no multiple-values here */
+ }
+
+ while (true)
+ {
+ sc->pc = 0;
+ sc->opts[0]->v7.fp(sc->opts[0]);
+ update_steppers(sc);
+ /* TODO: get the stepper and handle direct in more than just +1 (opt_let|dotimes) */
+ do_all_x_end(end);
+ }
+ }
+ }
+ push_stack_no_args(sc, OP_DOX_STEP, sc->code);
+ sc->code = _TPair(cddr(sc->code));
+ goto BEGIN1;
+
+
+ /* -------------------------------- */
SAFE_DOTIMES:
case OP_SAFE_DOTIMES:
{
@@ -61846,7 +67352,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto SIMPLE_DO;
}
-
case OP_SAFE_DOTIMES_STEP_P:
{
s7_pointer arg;
@@ -61854,6 +67359,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
numerator(arg)++;
if (numerator(arg) == denominator(arg))
{
+ sc->value = sc->T;
sc->code = cdr(cadr(sc->code));
goto DO_END_CLAUSES;
}
@@ -61864,7 +67370,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START_WITHOUT_POP_STACK;
}
-
case OP_SAFE_DOTIMES_STEP_O:
{
s7_pointer arg;
@@ -61872,37 +67377,15 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
numerator(arg)++;
if (numerator(arg) == denominator(arg))
{
+ sc->value = sc->T;
sc->code = cdr(cadr(sc->code));
goto DO_END_CLAUSES;
}
push_stack(sc, OP_SAFE_DOTIMES_STEP_O, sc->args, sc->code);
- sc->code = _TLst(opt_pair2(sc->code));
+ sc->code = _TPair(opt_pair2(sc->code));
goto OPT_EVAL;
}
-
-
- case OP_SAFE_DOTIMES_STEP_A:
- {
- s7_pointer arg;
- /* no calls?? */
- arg = slot_value(sc->args);
- set_car(sc->t2_1, arg);
- set_car(sc->t2_2, sc->value);
- c_call(opt_pair2(sc->code))(sc, sc->t2_1);
-
- numerator(arg)++;
- if (numerator(arg) == denominator(arg))
- {
- sc->code = cdr(cadr(sc->code));
- goto DO_END_CLAUSES;
- }
-
- push_stack(sc, OP_SAFE_DOTIMES_STEP_A, sc->args, sc->code);
- sc->code = _TLst(caddr(opt_pair2(sc->code)));
- goto OPT_EVAL;
- }
-
-
+
case OP_SAFE_DOTIMES_STEP:
{
s7_pointer arg;
@@ -61910,6 +67393,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
numerator(arg)++;
if (numerator(arg) == denominator(arg))
{
+ sc->value = sc->T;
sc->code = cdr(cadr(sc->code));
goto DO_END_CLAUSES;
}
@@ -61922,7 +67406,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto EVAL;
}
-
SAFE_DO:
case OP_SAFE_DO:
{
@@ -61934,7 +67417,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto BEGIN1;
}
-
case OP_SAFE_DO_STEP:
{
s7_int step, end;
@@ -61952,37 +67434,29 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
((step > end) &&
(opt_cfunc(caadr(code)) == geq_2)))
{
+ sc->value = sc->T;
sc->code = cdadr(code);
goto DO_END_CLAUSES;
}
push_stack(sc, OP_SAFE_DO_STEP, sc->args, code);
- sc->code = _TLst(opt_pair2(code));
+ sc->code = _TPair(opt_pair2(code));
goto BEGIN1;
}
-
- SIMPLE_DO_P:
- case OP_SIMPLE_DO_P:
- sc->op = OP_SIMPLE_DO_P;
- goto SIMPLE_DO;
-
- SIMPLE_DO_E:
- case OP_SIMPLE_DO_E:
- sc->op = OP_SIMPLE_DO_E;
- goto SIMPLE_DO;
-
- SIMPLE_DO_A:
- case OP_SIMPLE_DO_A:
- sc->op = OP_SIMPLE_DO_A;
-
SIMPLE_DO:
case OP_SIMPLE_DO:
{
/* body might not be safe in this case, but the step and end exprs are easy
- * "not safe" merely means we hit something that the optimizer can't specialize like (+ (* (abs (- ...))))
+ * "not safe" merely means we hit something that the optimizer can't specialize
+ */
+ /* simple_do: set up local env, check end (c_c?), goto simple_do_ex
+ * if latter gets s7_optimize, run locally, else goto simple_do_step.
+ * but is not 1 expr body, etc -- just goto simple_do_step,
+ * 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);
init = cadaar(code);
@@ -61997,35 +67471,23 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
dox_set_slot1(sc->envir, make_slot_1(sc, sc->envir, caaar(code), sc->value));
end = caddr(caadr(code));
if (is_symbol(end))
- sc->args = find_symbol(sc, end);
- else
- {
- s7_pointer slot;
- new_cell_no_check(sc, slot, T_SLOT);
- slot_set_symbol(slot, sc->dox_slot_symbol);
- slot_set_value(slot, end);
- sc->args = slot;
- }
- dox_set_slot2(sc->envir, sc->args);
+ dox_set_slot2(sc->envir, find_symbol(sc, end));
+ else dox_set_slot2(sc->envir, make_slot_1(sc, sc->envir, sc->dox_slot_symbol, end));
+
set_car(sc->t2_1, slot_value(dox_slot1(sc->envir)));
set_car(sc->t2_2, slot_value(dox_slot2(sc->envir)));
- if (is_true(sc, c_call(caadr(code))(sc, sc->t2_1)))
+ sc->value = c_call(caadr(code))(sc, sc->t2_1);
+ if (is_true(sc, sc->value))
{
sc->code = cdadr(code);
goto DO_END_CLAUSES;
}
- if (sc->op == OP_SIMPLE_DO_P)
- {
- push_stack(sc, OP_SIMPLE_DO_STEP_P, sc->args, code);
- sc->code = caddr(code);
- goto EVAL;
- }
-
set_opt_pair2(code, cddr(code));
- if ((is_null(cdr(opt_pair2(code)))) &&
- (is_pair(car(opt_pair2(code)))) &&
- (is_symbol(cadr(caddr(caar(code)))))) /* caar=(i 0 (+ i 1)), caddr=(+ i 1), so this is apparently checking that the stepf is reasonable? */
+ if ((is_null(cdr(opt_pair2(code)))) && /* one expr in body */
+ (is_pair(car(opt_pair2(code)))) && /* and it is a pair */
+ (is_symbol(cadr(caddr(caar(code))))) && /* caar=(i 0 (+ i 1)), caddr=(+ i 1), so this is apparently checking that the stepf is reasonable? */
+ (is_t_integer(caddr(caddr(caar(code))))))
{
int choice;
choice = simple_do_ex(sc, code);
@@ -62033,25 +67495,15 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (choice == goto_BEGIN1) goto BEGIN1;
if (choice == goto_DO_END_CLAUSES) goto DO_END_CLAUSES;
}
-
- if (sc->op == OP_SIMPLE_DO_E)
- push_stack(sc, OP_SIMPLE_DO_STEP_E, sc->args, code);
- else
- {
- if (sc->op == OP_SIMPLE_DO_A)
- push_stack(sc, OP_SIMPLE_DO_STEP_A, sc->args, code);
- else push_stack(sc, OP_SIMPLE_DO_STEP, sc->args, code);
- }
- sc->code = _TLst(opt_pair2(code));
+ /* fprintf(stderr, "%s\n", DISPLAY(code)); */
+ push_stack(sc, OP_SIMPLE_DO_STEP, sc->args, code);
+ sc->code = _TPair(opt_pair2(code));
goto BEGIN1;
}
-
- case OP_SIMPLE_DO_STEP_P:
case OP_SIMPLE_DO_STEP:
{
s7_pointer step, ctr, end, code;
-
ctr = dox_slot1(sc->envir);
end = dox_slot2(sc->envir);
code = sc->code;
@@ -62071,87 +67523,21 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
set_car(sc->t2_1, slot_value(ctr));
set_car(sc->t2_2, slot_value(end));
- if (is_true(sc, c_call(caadr(code))(sc, sc->t2_1)))
+ sc->value = c_call(caadr(code))(sc, sc->t2_1);
+ if (is_true(sc, sc->value))
{
sc->code = cdr(cadr(code));
goto DO_END_CLAUSES;
}
-
push_stack(sc, sc->op, sc->args, code);
- if (sc->op == OP_SIMPLE_DO_STEP_P)
- {
- code = caddr(code);
- set_current_code(sc, code);
- sc->op = (opcode_t)pair_syntax_op(code);
- sc->code = cdr(code);
- goto START_WITHOUT_POP_STACK;
- }
-
- sc->code = _TLst(opt_pair2(code));
- goto BEGIN1;
- }
-
- case OP_SIMPLE_DO_STEP_E:
- case OP_SIMPLE_DO_STEP_A:
- {
- /* (((i 0 (+ i 1))) ((= i 1000)) (set! mx (max mx (abs (f1 signal)))) (set! signal 0.0))
- * (((i 0 (+ i 1))) ((= i 20)) (outa i (sine-env e)))
- * we checked in check_do that the step expr is s+1
- */
- s7_pointer val, ctr, end, code;
- s7_int index;
-
- code = sc->code;
- ctr = dox_slot1(sc->envir);
- val = slot_value(ctr);
- end = slot_value(dox_slot2(sc->envir));
-
- if (is_integer(val))
- {
- slot_set_value(ctr, make_integer(sc, index = integer(val) + 1));
- if (is_integer(end))
- {
- if (index == integer(end))
- {
- sc->code = cdr(cadr(code));
- goto DO_END_CLAUSES;
- }
- }
- else
- {
- set_car(sc->t2_1, slot_value(ctr));
- set_car(sc->t2_2, end);
- if (is_true(sc, g_equal_2(sc, sc->t2_1)))
- {
- sc->code = cdr(cadr(code));
- goto DO_END_CLAUSES;
- }
- }
- }
- else
- {
- set_car(sc->t1_1, val); /* add_s1 ignores cadr(args) */
- slot_set_value(ctr, g_add_s1(sc, sc->t1_1));
- set_car(sc->t2_1, slot_value(ctr));
- set_car(sc->t2_2, end);
- if (is_true(sc, g_equal_2(sc, sc->t2_1)))
- {
- sc->code = cdr(cadr(code));
- goto DO_END_CLAUSES;
- }
- }
-
- push_stack(sc, sc->op, sc->args, code);
- if (sc->op == OP_SIMPLE_DO_STEP_E)
- {
- sc->code = _TLst(car(opt_pair2(code)));
- goto OPT_EVAL;
- }
- sc->code = _TLst(opt_pair2(code));
+#if DEBUGGING
+ if (sc->op != OP_SIMPLE_DO_STEP)
+ fprintf(stderr, "simple_do_step: %s\n", op_names[sc->op]);
+#endif
+ sc->code = _TPair(opt_pair2(code));
goto BEGIN1;
}
-
DOTIMES_P:
case OP_DOTIMES_P:
{
@@ -62182,6 +67568,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
((integer(now) > integer(end)) &&
(opt_cfunc(end_test) == geq_2)))
{
+ sc->value = sc->T;
sc->code = cdadr(code);
goto DO_END_CLAUSES;
}
@@ -62190,7 +67577,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
set_car(sc->t2_1, now);
set_car(sc->t2_2, end);
- if (is_true(sc, c_call(end_test)(sc, sc->t2_1)))
+ sc->value = c_call(end_test)(sc, sc->t2_1);
+ if (is_true(sc, sc->value))
{
sc->code = cdadr(code);
goto DO_END_CLAUSES;
@@ -62204,7 +67592,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* (define (hi) (let ((x 0.0) (y 1.0)) (do ((i y (+ i 1))) ((= i 6)) (do ((i i (+ i 1))) ((>= i 7)) (set! x (+ x i)))) x)) */
set_car(sc->t2_1, slot_value(ctr));
set_car(sc->t2_2, end);
- if (is_true(sc, c_call(end_test)(sc, sc->t2_1)))
+ sc->value = c_call(end_test)(sc, sc->t2_1);
+ if (is_true(sc, sc->value))
{
sc->code = cdadr(code);
goto DO_END_CLAUSES;
@@ -62218,50 +67607,53 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START_WITHOUT_POP_STACK;
}
-
DOX:
case OP_DOX:
{
int choice;
choice = dox_ex(sc);
if (choice == goto_DO_END_CLAUSES) goto DO_END_CLAUSES;
+ if (choice == goto_SAFE_DO_END_CLAUSES) goto SAFE_DO_END_CLAUSES;
if (choice == goto_START) goto START;
if (choice == goto_BEGIN1) goto BEGIN1;
if (choice == goto_START_WITHOUT_POP_STACK) goto START_WITHOUT_POP_STACK;
push_stack_no_args(sc, OP_DOX_STEP, sc->code);
- sc->code = _TLst(cddr(sc->code));
+ sc->code = _TPair(cddr(sc->code));
goto BEGIN1;
}
-
case OP_DOX_STEP:
{
- s7_pointer slot;
+ s7_pointer slot, end;
for (slot = let_slots(sc->envir); is_slot(slot); slot = next_slot(slot))
if (is_pair(slot_expression(slot)))
slot_set_value(slot, c_call(slot_expression(slot))(sc, car(slot_expression(slot))));
- if (is_true(sc, c_call(cdr(sc->code))(sc, opt_pair2(sc->code))))
+ end = cadr(sc->code);
+ sc->value = c_call(end)(sc, car(end));
+ if (is_true(sc, sc->value))
{
- sc->code = cdadr(sc->code);
+ sc->code = cdr(end);
goto DO_END_CLAUSES;
}
push_stack_no_args(sc, OP_DOX_STEP, sc->code);
- sc->code = _TLst(cddr(sc->code));
+ sc->code = _TPair(cddr(sc->code));
goto BEGIN1;
}
case OP_DOX_STEP_P:
{
- s7_pointer slot;
+ s7_pointer slot, end;
for (slot = let_slots(sc->envir); is_slot(slot); slot = next_slot(slot))
if (is_pair(slot_expression(slot)))
slot_set_value(slot, c_call(slot_expression(slot))(sc, car(slot_expression(slot))));
- if (is_true(sc, c_call(cdr(sc->code))(sc, opt_pair2(sc->code))))
+ end = cadr(sc->code);
+ sc->value = c_call(end)(sc, car(end));
+ if (is_true(sc, sc->value))
{
- sc->code = cdadr(sc->code);
+ sc->code = cdr(end);
goto DO_END_CLAUSES;
}
push_stack_no_args(sc, OP_DOX_STEP_P, sc->code);
@@ -62339,7 +67731,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
* I think not; the closure retains the current env chain, not the slots, so we need a new env.
*/
- sc->value = sc->nil;
+ /* sc->value = sc->nil; */
pop_stack_no_op(sc);
goto DO_END;
}
@@ -62351,13 +67743,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->code = DO_VAR_STEP_EXPR(car(sc->args));
goto EVAL;
-
case OP_DO_STEP2:
DO_VAR_SET_NEW_VALUE(sc->args, sc->value); /* save current value */
sc->args = cdr(sc->args); /* go to next step var */
goto DO_STEP1;
-
case OP_DO: /* sc->code is the stuff after "do" */
if (is_null(check_do(sc)))
{
@@ -62367,10 +67757,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (op == sc->safe_dotimes_symbol) goto SAFE_DOTIMES;
if (op == sc->dotimes_p_symbol) goto DOTIMES_P;
if (op == sc->safe_do_symbol) goto SAFE_DO;
- if (op == sc->simple_do_a_symbol) goto SIMPLE_DO_A;
- if (op == sc->simple_do_e_symbol) goto SIMPLE_DO_E;
- if (op == sc->simple_do_symbol) goto SIMPLE_DO;
- goto SIMPLE_DO_P;
+
+ 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;
}
DO_UNCHECKED:
@@ -62387,7 +67778,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->value = sc->code; /* protect it */
sc->code = car(sc->code); /* the vars */
-
case OP_DO_INIT:
if (do_init_ex(sc) == goto_EVAL)
goto EVAL;
@@ -62412,7 +67802,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
else
{
- /* (do ((...)) () ...) -- no endtest */
+ DO_END2:
if (is_pair(sc->code))
{
if (is_null(car(sc->args)))
@@ -62421,9 +67811,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto BEGIN1;
}
else
- {
- /* no body? */
- if (is_null(car(sc->args)))
+ {
+ if (is_null(car(sc->args))) /* no steppers */
goto DO_END;
goto DO_STEP;
}
@@ -62436,45 +67825,57 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* we're done -- deal with result exprs
* if there isn't an end test, there also isn't a result (they're in the same list)
*/
- sc->code = cddr(sc->args); /* result expr (a list -- implicit begin) */
+ sc->code = _TLst(cddr(sc->args)); /* result expr (a list -- implicit begin) */
free_cell(sc, sc->args);
sc->args = sc->nil;
if (is_null(sc->code))
{
- sc->value = sc->nil;
+ if (is_multiple_value(sc->value)) /* (define (f) (+ 1 (do ((i 2 (+ i 1))) ((values i (+ i 1)))))) -> 6 */
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+ /* similarly, if the result is a multiple value:
+ * (define (f) (+ 1 (do ((i 2 (+ i 1))) ((= i 3) (values i (+ i 1)))))) -> 8
+ */
goto START;
}
+ /* might be => here as in cond and case */
+ if ((car(sc->code) == sc->feed_to_symbol) &&
+ (s7_symbol_value(sc, sc->feed_to_symbol) == sc->undefined))
+ {
+ int res;
+ res = feed_to(sc);
+ if (res == goto_START) goto START;
+ if (res == goto_APPLY) goto APPLY;
+ goto EVAL;
+ }
+ goto BEGIN1;
}
- else
- {
- /* evaluate the body and step vars, etc */
- if (is_null(car(sc->args)))
- push_stack(sc, OP_DO_END, sc->args, sc->code);
- else push_stack(sc, OP_DO_STEP, sc->args, sc->code);
- /* sc->code is ready to go */
- }
- goto BEGIN1;
-
+ goto DO_END2;
SAFE_DO_END_CLAUSES:
- if (is_null(sc->code))
- {
- /* sc->args = sc->nil; */
- sc->envir = free_let(sc, sc->envir);
- sc->value = sc->nil;
- goto START;
- }
+ if (is_null(sc->code)) /* I don't think multiple values (as test result) can happen here -- all safe do loops involve counters by 1 to some integer end */
+ goto START;
goto DO_END_CODE;
DO_END_CLAUSES:
if (is_null(sc->code))
{
- sc->value = sc->nil;
+ if (is_multiple_value(sc->value))
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
goto START;
}
+
DO_END_CODE:
if (is_pair(cdr(sc->code)))
{
+ if ((car(sc->code) == sc->feed_to_symbol) &&
+ (s7_symbol_value(sc, sc->feed_to_symbol) == sc->undefined))
+ {
+ int res;
+ res = feed_to(sc);
+ if (res == goto_START) goto START;
+ if (res == goto_APPLY) goto APPLY;
+ goto EVAL;
+ }
push_stack_no_args(sc, OP_BEGIN1, cdr(sc->code));
sc->code = car(sc->code);
goto EVAL;
@@ -62490,9 +67891,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* -------------------------------- BEGIN -------------------------------- */
case OP_BEGIN:
- if (!is_proper_list(sc, sc->code)) /* proper list includes nil, I think */
+ if (!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)) &&
@@ -62500,7 +67901,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
pair_set_syntax_symbol(sc->code, sc->begin_unchecked_symbol);
case OP_BEGIN_UNCHECKED:
- /* if ((sc->begin_hook) && (call_begin_hook(sc))) return(sc->F); */
if (is_null(sc->code)) /* (begin) -> () */
{
sc->value = sc->nil;
@@ -62510,14 +67910,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_BEGIN1:
if ((sc->begin_hook) && (call_begin_hook(sc))) return(sc->F);
BEGIN1:
-#if DEBUGGING
- if (!s7_is_list(sc, sc->code))
- {
- fprintf(stderr, "at op_begin1, code: %s\n", DISPLAY(sc->code));
- abort();
- }
-#endif
- if (is_pair(cdr(sc->code))) /* sc->code can be nil here, but cdr(nil)->#<unspecified> */
+ if (is_pair(cdr(_TPair(sc->code))))
push_stack_no_args(sc, OP_BEGIN1, cdr(sc->code));
sc->code = car(sc->code);
/* goto EVAL; */
@@ -62528,188 +67921,256 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* main part of evaluation
* at this point, it's sc->code we care about; sc->args is not relevant.
*/
- /* fprintf(stderr, " eval: %s %d %d\n", DISPLAY_80(sc->code), (typesflag(sc->code) == SYNTACTIC_PAIR), (is_optimized(sc->code))); */
+ /* fprintf(stderr, " eval: %s\n", DISPLAY_80(sc->code)); */
if (typesflag(sc->code) == SYNTACTIC_PAIR) /* xor is not faster here */
{
#if WITH_PROFILE
- profile(sc, sc->code);
+ 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->code = cdr(sc->code);
- goto START_WITHOUT_POP_STACK; /* it is only slightly faster to use labels as values (computed gotos) here */
+ goto START_WITHOUT_POP_STACK;
}
+ OPT_EVAL_CHECKED:
if (is_optimized(sc->code))
{
s7_pointer code;
- /* fprintf(stderr, " %s\n", opt_names[optimize_op(sc->code)]); */
+ /* fprintf(stderr, " %s %s\n", opt_names[optimize_op(sc->code)], DISPLAY_80(sc->code)); */
OPT_EVAL:
+ /* fprintf(stderr, "opt_eval: %s %s\n", opt_names[optimize_op(sc->code)], DISPLAY_80(sc->code)); */
+
+#if SHOW_DEBUG_HISTORY
+ add_debug_history((char *)opt_names[optimize_op(sc->code)]);
+#endif
#if WITH_PROFILE
- profile(sc, sc->code);
+ if (sc->code != profile_at_start)
+ profile(sc, sc->code);
#endif
code = sc->code;
set_current_code(sc, code);
+ /* it is only slightly faster to use labels as values (computed gotos) here. The two big switch statements
+ * at START and below replaced by goto *table[optimize_op(code)] (etc) saves about 1/4 of the switch time
+ * (according to callgrind). Since this won't work in MS C++, I'd need 2 versions via macros.
+ * It would probably help to store the label (rather than jump through an array of labels), but
+ * that adds a lot of complexity in the optimizer.
+ * The switch time is only a small portion of the time spent in this function, so the overall
+ * savings is much less than 1% -- sometimes there is none at all (the rest of the code appears to
+ * be slower in the computed goto case -- some timing tests are actually slower with gotos). Also
+ * the lack of a default case means an error => segfault rather than printing some useless error message.
+ */
switch (optimize_op(code))
{
/* -------------------------------------------------------------------------------- */
case OP_SAFE_C_C:
- if (!c_function_is_ok(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break; /* break = fall into the "trailers" section where optimizations are cleared */
case HOP_SAFE_C_C:
sc->value = c_call(code)(sc, cdr(code)); /* this includes all safe calls where all args are constants */
goto START;
-
-
- case OP_SAFE_C_Q:
+
+ case OP_SAFE_C_AND2:
if (!c_function_is_ok(sc, code)) break;
-
- case HOP_SAFE_C_Q:
- set_car(sc->t1_1, cadr(cadr(code)));
- sc->value = c_call(code)(sc, sc->t1_1);
+ case HOP_SAFE_C_AND2:
+ code = cdr(code);
+ sc->value = c_call(code)(sc, car(code));
+ if (is_false(sc, sc->value))
+ goto START;
+ code = cdr(code);
+ sc->value = c_call(code)(sc, car(code));
goto START;
-
-
+
+ case OP_SAFE_C_OR2:
+ if (!c_function_is_ok(sc, code)) break;
+ case HOP_SAFE_C_OR2:
+ code = cdr(code);
+ sc->value = c_call(code)(sc, car(code));
+ if (is_true(sc, sc->value))
+ goto START;
+ code = cdr(code);
+ sc->value = c_call(code)(sc, car(code));
+ goto START;
+
case OP_SAFE_C_S:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_S:
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(code)));
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(code)));
sc->value = c_call(code)(sc, sc->t1_1);
goto START;
+ case OP_SAFE_C_L:
+ if (!c_function_is_ok(sc, code)) break;
+ case HOP_SAFE_C_L:
+ set_car(sc->t1_1, local_symbol_value(cadr(code)));
+ sc->value = c_call(code)(sc, sc->t1_1);
+ goto START;
- case OP_SAFE_C_SS:
+ case OP_SAFE_CAR_S:
+ if (!c_function_is_ok(sc, code)) break;
+ case HOP_SAFE_CAR_S:
+ {
+ s7_pointer val;
+ val = find_symbol_unchecked(sc, cadr(code));
+ sc->value = (is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val));
+ goto START;
+ }
+
+ case OP_SAFE_CDR_S:
if (!c_function_is_ok(sc, code)) break;
+ case HOP_SAFE_CDR_S:
+ {
+ s7_pointer val;
+ val = find_symbol_unchecked(sc, cadr(code));
+ sc->value = (is_pair(val)) ? cdr(val) : g_cdr(sc, set_plist_1(sc, val));
+ goto START;
+ }
+ case OP_SAFE_CADR_S:
+ if (!c_function_is_ok(sc, code)) break;
+ case HOP_SAFE_CADR_S:
+ {
+ s7_pointer val;
+ val = find_symbol_unchecked(sc, cadr(code));
+ sc->value = ((is_pair(val)) && (is_pair(cdr(val)))) ? cadr(val) : g_cadr(sc, set_plist_1(sc, val));
+ goto START;
+ }
+
+ case OP_SAFE_IS_PAIR_S:
+ if (!c_function_is_ok(sc, code)) break;
+ case HOP_SAFE_IS_PAIR_S:
+ {
+ s7_pointer val;
+ val = find_symbol_unchecked(sc, cadr(code));
+ eval_boolean_method(sc, is_pair, sc->is_pair_symbol, val);
+ goto START;
+ }
+
+ case OP_SAFE_IS_NULL_S:
+ if (!c_function_is_ok(sc, code)) break;
+ case HOP_SAFE_IS_NULL_S:
+ {
+ s7_pointer val;
+ val = find_symbol_unchecked(sc, cadr(code));
+ eval_boolean_method(sc, is_null, sc->is_null_symbol, val);
+ goto START;
+ }
+
+ case OP_SAFE_IS_SYMBOL_S:
+ if (!c_function_is_ok(sc, code)) break;
+ case HOP_SAFE_IS_SYMBOL_S:
+ {
+ s7_pointer val;
+ val = find_symbol_unchecked(sc, cadr(code));
+ eval_boolean_method(sc, is_symbol, sc->is_symbol_symbol, val);
+ goto START;
+ }
+
+ case OP_SAFE_C_SS:
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_SS:
{
s7_pointer val, args;
args = cdr(code);
- val = find_symbol_checked(sc, car(args));
- set_car(sc->t2_2, find_symbol_checked(sc, cadr(args)));
+ val = find_symbol_unchecked(sc, car(args));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, cadr(args)));
set_car(sc->t2_1, val);
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_ALL_S:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_ALL_S:
{
- int num_args;
s7_pointer args, p;
- num_args = integer(arglist_length(code));
- if ((num_args != 0) &&
- (num_args < NUM_SAFE_LISTS) &&
- (!list_is_in_use(sc->safe_lists[num_args])))
- {
- sc->args = sc->safe_lists[num_args];
- set_list_in_use(sc->args);
- }
- else sc->args = make_list(sc, num_args, sc->nil);
-
+ sc->args = safe_list_if_possible(sc, integer(arglist_length(code)));
for (args = cdr(code), p = sc->args; is_pair(args); args = cdr(args), p = cdr(p))
- set_car(p, find_symbol_checked(sc, car(args)));
+ set_car(p, find_symbol_unchecked(sc, car(args)));
clear_list_in_use(sc->args);
+ sc->current_safe_list = 0;
sc->value = c_call(code)(sc, sc->args);
goto START;
}
-
case OP_SAFE_C_SC:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_SC:
{
s7_pointer args;
args = cdr(code);
- set_car(sc->t2_1, find_symbol_checked(sc, car(args)));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, car(args)));
set_car(sc->t2_2, cadr(args));
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_CS:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_CS:
{
s7_pointer args;
args = cdr(code);
- set_car(sc->t2_2, find_symbol_checked(sc, cadr(args)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, cadr(args)));
set_car(sc->t2_1, car(args));
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
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_checked(sc, car(args)));
- set_car(sc->t2_2, cadr(cadr(args)));
+ 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;
}
-
case OP_SAFE_C_QS:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_QS:
{
s7_pointer args;
args = cdr(code);
- set_car(sc->t2_2, find_symbol_checked(sc, cadr(args)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, cadr(args)));
set_car(sc->t2_1, cadr(car(args)));
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_QQ:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_QQ:
{
s7_pointer args;
args = cdr(code);
set_car(sc->t2_1, cadr(car(args)));
- set_car(sc->t2_2, cadr(cadr(args)));
+ set_car(sc->t2_2, cadadr(args));
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_CQ:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_CQ:
{
s7_pointer args;
args = cdr(code);
set_car(sc->t2_1, car(args));
- set_car(sc->t2_2, cadr(cadr(args)));
+ set_car(sc->t2_2, cadadr(args));
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_QC:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_QC:
{
s7_pointer args;
@@ -62720,23 +68181,33 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_Z:
if (!c_function_is_ok(sc, code)) break;
- /* I think a_is_ok of cadr here and below is redundant -- they'll be checked when Z is
+ /* I think c_function_is_ok of cadr here and below is redundant -- they'll be checked when Z is
* because we cleared the hop bit after combine_ops.
*/
-
case HOP_SAFE_C_Z:
check_stack_size(sc);
push_stack(sc, OP_SAFE_C_P_1, sc->nil, code);
- sc->code = _TLst(cadr(code));
- goto OPT_EVAL;
+ 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);
+ 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);
+ sc->code = _TPair(cadr(code));
+ goto EVAL;
case OP_SAFE_C_CZ:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_CZ:
check_stack_size(sc);
/* it's possible in a case like this to overflow the stack -- s7test has a deeply
@@ -62746,43 +68217,35 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
* How to minimize the cost of this check?
*/
push_stack(sc, OP_SAFE_C_SZ_1, cadr(code), code);
- sc->code = _TLst(caddr(code));
- goto OPT_EVAL;
-
+ sc->code = _TPair(caddr(code));
+ goto OPT_EVAL_CHECKED;
case OP_SAFE_C_ZC:
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 */
- sc->code = _TLst(cadr(code));
- goto OPT_EVAL;
-
+ 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:
check_stack_size(sc);
- push_stack(sc, OP_SAFE_C_SZ_1, find_symbol_checked(sc, cadr(code)), code);
- sc->code = _TLst(caddr(code)); /* splitting out the all_x cases here and elsewhere saves nothing */
- goto OPT_EVAL;
-
+ push_stack(sc, OP_SAFE_C_SZ_1, 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;
case OP_SAFE_C_ZS:
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);
- sc->code = _TLst(cadr(code));
- goto OPT_EVAL;
-
+ sc->code = _TPair(cadr(code));
+ goto OPT_EVAL_CHECKED;
case OP_SAFE_C_opAq:
- if (!a_is_ok_cadr(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_opAq:
{
s7_pointer arg;
@@ -62793,72 +68256,66 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_opAAq:
- if (!a_is_ok_cadr(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_opAAq:
{
s7_pointer arg;
arg = cadr(code);
set_car(sc->a2_1, c_call(cdr(arg))(sc, cadr(arg)));
- set_car(sc->a2_2, c_call(cddr(arg))(sc, caddr(arg)));
+ overwrite_check(car(sc->a2_1),
+ set_car(sc->a2_2, c_call(cddr(arg))(sc, caddr(arg))));
set_car(sc->t1_1, c_call(arg)(sc, sc->a2_1));
sc->value = c_call(code)(sc, sc->t1_1);
goto START;
}
-
case OP_SAFE_C_opAAAq:
- if (!a_is_ok_cadr(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_opAAAq:
{
s7_pointer arg;
arg = cadr(code);
set_car(sc->a3_1, c_call(cdr(arg))(sc, cadr(arg)));
- set_car(sc->a3_2, c_call(cddr(arg))(sc, caddr(arg)));
- set_car(sc->a3_3, c_call(cdddr(arg))(sc, cadddr(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))));
set_car(sc->t1_1, c_call(arg)(sc, sc->a3_1));
sc->value = c_call(code)(sc, sc->t1_1);
goto START;
}
-
case OP_SAFE_C_S_opAq:
- if (!a_is_ok_caddr(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_S_opAq:
{
s7_pointer arg;
arg = caddr(code);
set_car(sc->a1_1, c_call(cdr(arg))(sc, cadr(arg)));
set_car(sc->t2_2, c_call(arg)(sc, sc->a1_1));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(code)));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(code)));
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_S_opAAq:
- if (!a_is_ok_caddr(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_S_opAAq:
{
s7_pointer arg;
arg = caddr(code);
set_car(sc->a2_1, c_call(cdr(arg))(sc, cadr(arg)));
- set_car(sc->a2_2, c_call(cddr(arg))(sc, caddr(arg)));
+ overwrite_check(car(sc->a2_1),
+ set_car(sc->a2_2, c_call(cddr(arg))(sc, caddr(arg))));
set_car(sc->t2_2, c_call(arg)(sc, sc->a2_1));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(code)));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(code)));
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_S_opAAAq:
- if (!a_is_ok_caddr(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_S_opAAAq:
{
s7_pointer arg, p;
@@ -62866,234 +68323,236 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
arg = cdr(p);
set_car(sc->a3_1, c_call(arg)(sc, car(arg)));
arg = cdr(arg);
- set_car(sc->a3_2, c_call(arg)(sc, car(arg)));
+ overwrite_check(car(sc->a3_1),
+ set_car(sc->a3_2, c_call(arg)(sc, car(arg))));
arg = cdr(arg);
- set_car(sc->a3_3, c_call(arg)(sc, car(arg)));
+ overwrite_check(car(sc->a3_2),
+ set_car(sc->a3_3, c_call(arg)(sc, car(arg))));
set_car(sc->t2_2, c_call(p)(sc, sc->a3_1));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(code)));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(code)));
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_S_opSZq:
- if (!a_is_ok_caddr(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_S_opSZq:
- push_stack(sc, OP_SAFE_C_SZ_SZ, find_symbol_checked(sc, cadr(caddr(code))), code);
- sc->code = _TLst(caddr(caddr(code)));
- goto OPT_EVAL;
-
+ push_stack(sc, OP_SAFE_C_SZ_SZ, find_symbol_unchecked(sc, cadr(caddr(code))), code);
+ sc->code = _TPair(caddr(caddr(code)));
+ goto OPT_EVAL_CHECKED;
case OP_SAFE_C_AZ:
- if (!a_is_ok(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_AZ:
- push_stack(sc, OP_SAFE_C_SZ_1, c_call(cdr(code))(sc, cadr(code)), code);
- sc->code = _TLst(caddr(code));
- goto OPT_EVAL;
- /* s: h_safe_c_s_op_s_opssqq: 204308 */
-
+ {
+ s7_pointer val;
+ val = c_call(cdr(code))(sc, cadr(code));
+ push_stack(sc, OP_SAFE_C_SZ_1, val, code);
+ sc->code = _TPair(caddr(code));
+ goto OPT_EVAL_CHECKED;
+ }
case OP_SAFE_C_ZA:
- if (!a_is_ok(sc, code)) break;
-
+ 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);
- sc->code = _TLst(cadr(code));
- goto OPT_EVAL;
-
+ sc->code = _TPair(cadr(code));
+ goto OPT_EVAL_CHECKED;
case OP_SAFE_C_ZZ:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_ZZ:
/* 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);
- sc->code = _TLst(cadr(code));
- goto OPT_EVAL;
-
+ sc->code = _TPair(cadr(code));
+ goto OPT_EVAL_CHECKED;
case OP_SAFE_C_opCq_Z:
- if (!a_is_ok(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_opCq_Z:
- push_stack(sc, OP_SAFE_C_ZZ_2, c_call(cadr(code))(sc, cdr(cadr(code))), code);
- sc->code = _TLst(caddr(code));
- goto OPT_EVAL;
-
+ {
+ s7_pointer val;
+ val = c_call(cadr(code))(sc, cdr(cadr(code)));
+ push_stack(sc, OP_SAFE_C_ZZ_2, val, code);
+ sc->code = _TPair(caddr(code));
+ goto OPT_EVAL_CHECKED;
+ }
case OP_SAFE_C_ZAA:
- if (!a_is_ok(sc, code)) break;
-
+ 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 = _TLst(cadr(code));
- goto OPT_EVAL;
-
+ sc->code = _TPair(cadr(code));
+ goto OPT_EVAL_CHECKED;
case OP_SAFE_C_AZA:
- if (!a_is_ok(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_AZA:
- push_stack(sc, OP_SAFE_C_AZA_1, c_call(cdr(code))(sc, cadr(code)), code);
- sc->code = _TLst(caddr(code));
- goto OPT_EVAL;
-
+ {
+ s7_pointer val;
+ val = c_call(cdr(code))(sc, cadr(code));
+ push_stack(sc, OP_SAFE_C_AZA_1, val, code);
+ sc->code = _TPair(caddr(code));
+ 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_checked(sc, cadr(code)), code);
- sc->code = _TLst(cadddr(code));
- goto OPT_EVAL;
-
+ 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 (!a_is_ok(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_AAZ:
- push_op_stack(sc, c_call(cdr(code))(sc, cadr(code)));
- push_stack(sc, OP_SAFE_C_AAZ_1, c_call(cddr(code))(sc, caddr(code)), code);
- sc->code = _TLst(cadddr(code));
- goto OPT_EVAL;
-
+ {
+ s7_pointer val, op_val;
+ op_val = c_call(cdr(code))(sc, cadr(code));
+ val = c_call(cddr(code))(sc, caddr(code));
+ push_op_stack(sc, op_val);
+ push_stack(sc, OP_SAFE_C_AAZ_1, val, code);
+ sc->code = _TPair(cadddr(code));
+ goto OPT_EVAL_CHECKED;
+ }
case OP_SAFE_C_ZZA:
- if (!a_is_ok(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_ZZA:
push_stack(sc, OP_SAFE_C_ZZA_1, sc->nil, code);
- sc->code = _TLst(cadr(code));
- goto OPT_EVAL;
-
+ sc->code = _TPair(cadr(code));
+ goto OPT_EVAL_CHECKED;
case OP_SAFE_C_ZAZ:
- if (!a_is_ok(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_ZAZ:
push_stack(sc, OP_SAFE_C_ZAZ_1, sc->nil, code);
- sc->code = _TLst(cadr(code));
- goto OPT_EVAL;
-
+ sc->code = _TPair(cadr(code));
+ goto OPT_EVAL_CHECKED;
case OP_SAFE_C_AZZ:
- if (!a_is_ok(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_AZZ:
- push_stack(sc, OP_SAFE_C_AZZ_1, c_call(cdr(code))(sc, cadr(code)), code);
- sc->code = _TLst(caddr(code));
- goto OPT_EVAL;
-
+ {
+ s7_pointer val;
+ val = c_call(cdr(code))(sc, cadr(code));
+ push_stack(sc, OP_SAFE_C_AZZ_1, val, code);
+ sc->code = _TPair(caddr(code));
+ goto OPT_EVAL_CHECKED;
+ }
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);
- sc->code = _TLst(cadr(code));
- goto OPT_EVAL;
-
-
+ sc->code = _TPair(cadr(code));
+ goto OPT_EVAL_CHECKED;
+
case OP_SAFE_C_A:
- if (!a_is_ok_cadr(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code))
+ {
+ s7_pointer new_func;
+ /* need unknown_all_x|s etc
+ * need to be sure all all_x unknowns are pre-annotated
+ */
+ if (unknown_a_ex(sc, new_func = find_symbol_checked(sc, car(code))) == goto_OPT_EVAL)
+ {
+ if (op_no_hop(sc->code) == OP_SAFE_C_A)
+ {
+ set_car(sc->a1_1, c_call(cdr(code))(sc, cadr(code)));
+ sc->value = c_call(code)(sc, sc->a1_1);
+ goto START;
+ }
+ goto OPT_EVAL;
+ }
+ break;
+ }
case HOP_SAFE_C_A:
set_car(sc->a1_1, c_call(cdr(code))(sc, cadr(code)));
sc->value = c_call(code)(sc, sc->a1_1);
goto START;
-
case OP_SAFE_C_AA:
- if (!a_is_ok(sc, code)) break;
-
+ 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)));
- set_car(sc->a2_2, c_call(cddr(code))(sc, caddr(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;
-
case OP_SAFE_C_AAA:
- if (!a_is_ok(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_AAA:
{
s7_pointer arg;
arg = cdr(code);
set_car(sc->a3_1, c_call(arg)(sc, car(arg)));
arg = cdr(arg);
- set_car(sc->a3_2, c_call(arg)(sc, car(arg)));
+ overwrite_check(car(sc->a3_1) ,
+ set_car(sc->a3_2, c_call(arg)(sc, car(arg))));
arg = cdr(arg);
- set_car(sc->a3_3, c_call(arg)(sc, car(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);
goto START;
}
-
case OP_SAFE_C_SSA:
- if (!a_is_ok_cadddr(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_SSA:
{
s7_pointer arg;
arg = cdr(code);
- set_car(sc->a3_1, find_symbol_checked(sc, car(arg)));
+ set_car(sc->a3_1, find_symbol_unchecked(sc, car(arg)));
arg = cdr(arg);
- set_car(sc->a3_2, find_symbol_checked(sc, car(arg)));
+ set_car(sc->a3_2, find_symbol_unchecked(sc, car(arg)));
arg = cdr(arg);
set_car(sc->a3_3, c_call(arg)(sc, car(arg)));
sc->value = c_call(code)(sc, sc->a3_1);
goto START;
}
-
case OP_SAFE_C_SAS:
- if (!a_is_ok_caddr(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_SAS:
{
s7_pointer arg;
arg = cdr(code);
- set_car(sc->a3_1, find_symbol_checked(sc, car(arg)));
+ set_car(sc->a3_1, find_symbol_unchecked(sc, car(arg)));
arg = cdr(arg);
set_car(sc->a3_2, c_call(arg)(sc, car(arg)));
arg = cdr(arg);
- set_car(sc->a3_3, find_symbol_checked(sc, car(arg)));
+ set_car(sc->a3_3, find_symbol_unchecked(sc, car(arg)));
sc->value = c_call(code)(sc, sc->a3_1);
goto START;
}
-
case OP_SAFE_C_CSA:
- if (!a_is_ok_cadddr(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_CSA:
{
s7_pointer arg;
arg = cdr(code);
set_car(sc->a3_1, car(arg));
arg = cdr(arg);
- set_car(sc->a3_2, find_symbol_checked(sc, car(arg)));
+ set_car(sc->a3_2, find_symbol_unchecked(sc, car(arg)));
arg = cdr(arg);
set_car(sc->a3_3, c_call(arg)(sc, car(arg)));
sc->value = c_call(code)(sc, sc->a3_1);
goto START;
}
-
case OP_SAFE_C_SCA:
- if (!a_is_ok_cadddr(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_SCA:
{
s7_pointer arg;
arg = cdr(code);
- set_car(sc->a3_1, find_symbol_checked(sc, car(arg)));
+ set_car(sc->a3_1, find_symbol_unchecked(sc, car(arg)));
arg = cdr(arg);
set_car(sc->a3_2, car(arg));
arg = cdr(arg);
@@ -63102,63 +68561,37 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
- case OP_SAFE_C_CAS:
- if (!a_is_ok_caddr(sc, code)) break;
-
- case HOP_SAFE_C_CAS:
- {
- s7_pointer arg;
- arg = cdr(code);
- set_car(sc->a3_1, car(arg));
- arg = cdr(arg);
- set_car(sc->a3_2, c_call(arg)(sc, car(arg)));
- set_car(sc->a3_3, find_symbol_checked(sc, cadr(arg)));
- sc->value = c_call(code)(sc, sc->a3_1);
- goto START;
- }
-
-
case OP_SAFE_C_AAAA:
- if (!a_is_ok(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_AAAA:
{
s7_pointer arg;
arg = cdr(code);
set_car(sc->a4_1, c_call(arg)(sc, car(arg)));
arg = cdr(arg);
- set_car(sc->a4_2, c_call(arg)(sc, car(arg)));
+ overwrite_check(car(sc->a4_1),
+ set_car(sc->a4_2, c_call(arg)(sc, car(arg))));
arg = cdr(arg);
- set_car(sc->a4_3, c_call(arg)(sc, car(arg)));
+ overwrite_check(car(sc->a4_2),
+ set_car(sc->a4_3, c_call(arg)(sc, car(arg))));
arg = cdr(arg);
- set_car(sc->a4_4, c_call(arg)(sc, car(arg)));
+ overwrite_check(car(sc->a4_3),
+ set_car(sc->a4_4, c_call(arg)(sc, car(arg))));
sc->value = c_call(code)(sc, sc->a4_1);
goto START;
}
-
case OP_SAFE_C_ALL_X:
- if (!a_is_ok(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_ALL_X:
{
- int num_args;
s7_pointer args, p;
- num_args = integer(arglist_length(code));
- if ((num_args != 0) &&
- (num_args < NUM_SAFE_LISTS) &&
- (!list_is_in_use(sc->safe_lists[num_args])))
- {
- sc->args = sc->safe_lists[num_args];
- set_list_in_use(sc->args);
- }
- else sc->args = make_list(sc, num_args, sc->nil);
-
+ sc->args = safe_list_if_possible(sc, integer(arglist_length(code)));
for (args = cdr(code), p = sc->args; is_pair(args); args = cdr(args), p = cdr(p))
set_car(p, c_call(args)(sc, car(args)));
clear_list_in_use(sc->args);
+ sc->current_safe_list = 0;
sc->value = c_call(code)(sc, sc->args);
/* we can't release a temp here:
@@ -63168,103 +68601,91 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_SQS:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_SQS:
{
/* (let-set! gen 'fm fm); many of these are handled in safe_closure_star_s0 */
s7_pointer val1, args;
args = cdr(code);
- val1 = find_symbol_checked(sc, car(args));
- set_car(sc->t3_3, find_symbol_checked(sc, opt_sym2(args)));
+ val1 = find_symbol_unchecked(sc, car(args));
+ set_car(sc->t3_3, find_symbol_unchecked(sc, opt_sym2(args)));
set_car(sc->t3_2, opt_con1(args));
set_car(sc->t3_1, val1);
sc->value = c_call(code)(sc, sc->t3_1);
goto START;
}
-
case OP_SAFE_C_SCS:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_SCS:
{
/* (define (hi) (let ((x 32) (lst '(0 1))) (list-set! lst 0 x) x)) */
s7_pointer val1, args;
args = cdr(code);
- val1 = find_symbol_checked(sc, car(args));
- set_car(sc->t3_3, find_symbol_checked(sc, opt_sym2(args)));
+ val1 = find_symbol_unchecked(sc, car(args));
+ set_car(sc->t3_3, find_symbol_unchecked(sc, opt_sym2(args)));
set_car(sc->t3_2, opt_con1(args));
set_car(sc->t3_1, val1);
sc->value = c_call(code)(sc, sc->t3_1);
goto START;
}
-
case OP_SAFE_C_SSC:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_SSC:
{
/* (define (hi) (let ((v #(0 1 2)) (i 0)) (vector-set! v i 1) v)) */
s7_pointer val1, args;
args = cdr(code);
- val1 = find_symbol_checked(sc, car(args));
- set_car(sc->t3_2, find_symbol_checked(sc, opt_sym1(args)));
+ val1 = find_symbol_unchecked(sc, car(args));
+ set_car(sc->t3_2, find_symbol_unchecked(sc, opt_sym1(args)));
set_car(sc->t3_3, opt_con2(args));
set_car(sc->t3_1, val1);
sc->value = c_call(code)(sc, sc->t3_1);
goto START;
}
-
case OP_SAFE_C_SCC:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_SCC:
{
/* (make-env E :length 100) */
s7_pointer args;
args = cdr(code);
- set_car(sc->t3_1, find_symbol_checked(sc, car(args)));
+ set_car(sc->t3_1, find_symbol_unchecked(sc, car(args)));
set_car(sc->t3_2, opt_con1(args));
set_car(sc->t3_3, opt_con2(args));
sc->value = c_call(code)(sc, sc->t3_1);
goto START;
}
-
case OP_SAFE_C_CSC:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_CSC:
{
s7_pointer args;
args = cdr(code);
- set_car(sc->t3_2, find_symbol_checked(sc, opt_sym1(args)));
+ set_car(sc->t3_2, find_symbol_unchecked(sc, opt_sym1(args)));
set_car(sc->t3_1, car(args));
set_car(sc->t3_3, opt_con2(args));
sc->value = c_call(code)(sc, sc->t3_1);
goto START;
}
-
case OP_SAFE_C_CSS:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_CSS:
{
s7_pointer val1, args;
args = cdr(code);
- val1 = find_symbol_checked(sc, opt_sym2(args));
- set_car(sc->t3_2, find_symbol_checked(sc, opt_sym1(args)));
+ val1 = find_symbol_unchecked(sc, opt_sym2(args));
+ set_car(sc->t3_2, find_symbol_unchecked(sc, opt_sym1(args)));
set_car(sc->t3_3, val1);
set_car(sc->t3_1, car(args));
sc->value = c_call(code)(sc, sc->t3_1);
@@ -63273,228 +68694,240 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_SAFE_C_SSS:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_SSS:
{
s7_pointer val1, val2, args;
args = cdr(code);
- val1 = find_symbol_checked(sc, car(args));
- val2 = find_symbol_checked(sc, opt_sym1(args));
- set_car(sc->t3_3, find_symbol_checked(sc, opt_sym2(args)));
+ val1 = find_symbol_unchecked(sc, car(args));
+ val2 = find_symbol_unchecked(sc, opt_sym1(args));
+ set_car(sc->t3_3, find_symbol_unchecked(sc, opt_sym2(args)));
set_car(sc->t3_1, val1);
set_car(sc->t3_2, val2);
sc->value = c_call(code)(sc, sc->t3_1);
goto START;
}
-
case OP_SAFE_C_opCq:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opCq:
- set_car(sc->t1_1, c_call(car(cdr(code)))(sc, cdar(cdr(code)))); /* OP_SAFE_C_C can involve any number of ops */
+ set_car(sc->t1_1, c_call(cadr(code))(sc, cdadr(code))); /* OP_SAFE_C_C can involve any number of ops */
sc->value = c_call(code)(sc, sc->t1_1);
goto START;
-
case OP_SAFE_C_opSq:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opSq:
{
s7_pointer args;
args = cadr(code);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(args)));
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(args)));
set_car(sc->t1_1, c_call(args)(sc, sc->t1_1));
sc->value = c_call(code)(sc, sc->t1_1);
goto START;
}
case OP_SAFE_C_op_opSq_q:
- if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, cadr(cadr(code))))) break;
-
+ if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, cadadr(code)))) break;
case HOP_SAFE_C_op_opSq_q:
{
s7_pointer outer, args;
outer = cadr(code);
args = cadr(outer);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(args)));
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(args)));
set_car(sc->t1_1, c_call(args)(sc, sc->t1_1));
set_car(sc->t1_1, c_call(outer)(sc, sc->t1_1));
sc->value = c_call(code)(sc, sc->t1_1);
goto START;
}
+ /* op_op_opSq_q_q and op_opSq_q_op_opSq_q got almost no hits */
case OP_SAFE_C_op_S_opSq_q:
if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, caddr(cadr(code))))) break;
-
case HOP_SAFE_C_op_S_opSq_q:
{
/* (exp (* r (cos x))) */
s7_pointer outer, args;
outer = cadr(code);
args = caddr(outer);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(args)));
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(args)));
set_car(sc->t2_2, c_call(args)(sc, sc->t1_1));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(outer)));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(outer)));
set_car(sc->t1_1, c_call(outer)(sc, sc->t2_1));
sc->value = c_call(code)(sc, sc->t1_1);
goto START;
}
+ case OP_SAFE_C_op_opSq_S_q:
+ if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, cadadr(code)))) break;
+ case HOP_SAFE_C_op_opSq_S_q:
+ {
+ /* (exp (* (cos x) r)) */
+ s7_pointer outer, args;
+ outer = cadr(code);
+ args = cadr(outer);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(args)));
+ set_car(sc->t2_1, c_call(args)(sc, sc->t1_1));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(outer)));
+ set_car(sc->t1_1, c_call(outer)(sc, sc->t2_1));
+ sc->value = c_call(code)(sc, sc->t1_1);
+ goto START;
+ }
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 */
sc->code = cadr(code);
goto EVAL;
-
case OP_SAFE_C_PC:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_PC:
push_stack(sc, OP_EVAL_ARGS_P_4, caddr(code), code);
sc->code = cadr(code);
goto EVAL;
-
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 */
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);
+ sc->code = cadr(code);
+ goto OPT_EVAL_CHECKED;
case OP_SAFE_C_SP:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_SP:
- push_stack(sc, OP_EVAL_ARGS_P_2, find_symbol_checked(sc, cadr(code)), code);
+ check_stack_size(sc);
+ push_stack(sc, OP_EVAL_ARGS_P_2, find_symbol_unchecked(sc, cadr(code)), code);
sc->code = caddr(code);
goto EVAL;
-
case OP_SAFE_C_AP:
- if ((!c_function_is_ok(sc, code)) || (!a_is_ok(sc, cadr(code)))) break;
-
+ if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code)))) break;
case HOP_SAFE_C_AP:
- push_stack(sc, OP_EVAL_ARGS_P_2, c_call(cdr(code))(sc, cadr(code)), code);
- sc->code = caddr(code);
- goto EVAL;
-
+ {
+ s7_pointer val;
+ check_stack_size(sc);
+ val = c_call(cdr(code))(sc, cadr(code));
+ push_stack(sc, OP_EVAL_ARGS_P_2, val, code);
+ sc->code = caddr(code);
+ goto EVAL;
+ }
case OP_SAFE_C_CP:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_CP:
+ check_stack_size(sc);
push_stack(sc, OP_EVAL_ARGS_P_2, cadr(code), code);
sc->code = caddr(code);
goto EVAL;
-
case OP_SAFE_C_QP:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_SAFE_C_QP:
- push_stack(sc, OP_EVAL_ARGS_P_2, cadr(cadr(code)), code);
+ check_stack_size(sc);
+ push_stack(sc, OP_EVAL_ARGS_P_2, cadadr(code), code);
sc->code = caddr(code);
goto EVAL;
-
case OP_SAFE_C_PP:
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);
sc->code = cadr(code);
goto EVAL;
-
case OP_SAFE_C_SSP:
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 OP_SAFE_C_opSSq:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opSSq:
{
s7_pointer args, val1;
args = cadr(code);
- val1 = find_symbol_checked(sc, cadr(args));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(args)));
+ val1 = find_symbol_unchecked(sc, cadr(args));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(args)));
set_car(sc->t2_1, val1);
set_car(sc->t1_1, c_call(args)(sc, sc->t2_1));
sc->value = c_call(code)(sc, sc->t1_1);
goto START;
}
-
case OP_SAFE_C_opSCq:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opSCq:
{
s7_pointer args;
args = cadr(code);
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(args)));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(args)));
set_car(sc->t2_2, caddr(args));
set_car(sc->t1_1, c_call(args)(sc, sc->t2_1));
sc->value = c_call(code)(sc, sc->t1_1);
goto START;
}
-
case OP_SAFE_C_opCSq:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opCSq:
{
s7_pointer args;
args = cadr(code);
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(args)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(args)));
set_car(sc->t2_1, cadr(args));
set_car(sc->t1_1, c_call(args)(sc, sc->t2_1));
sc->value = c_call(code)(sc, sc->t1_1);
goto START;
}
-
case OP_SAFE_C_opSQq:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opSQq:
{
s7_pointer args;
args = cadr(code);
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(args)));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(args)));
set_car(sc->t2_2, cadr(caddr(args)));
set_car(sc->t1_1, c_call(args)(sc, sc->t2_1));
sc->value = c_call(code)(sc, sc->t1_1);
goto START;
}
+ case OP_SAFE_C_opQSq:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+ case HOP_SAFE_C_opQSq:
+ {
+ s7_pointer args;
+ args = cadr(code);
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(args)));
+ set_car(sc->t2_1, cadadr(args));
+ set_car(sc->t1_1, c_call(args)(sc, sc->t2_1));
+ sc->value = c_call(code)(sc, sc->t1_1);
+ goto START;
+ }
case OP_SAFE_C_S_opSq:
if (!c_function_is_ok_caddr(sc, code)) break;
-
case HOP_SAFE_C_S_opSq:
{
s7_pointer args, val;
args = cdr(code);
- val = find_symbol_checked(sc, car(args));
- set_car(sc->t1_1, find_symbol_checked(sc, opt_sym1(args)));
+ val = find_symbol_unchecked(sc, car(args));
+ set_car(sc->t1_1, find_symbol_unchecked(sc, opt_sym1(args)));
set_car(sc->t2_2, c_call(cadr(args))(sc, sc->t1_1));
set_car(sc->t2_1, val);
sc->value = c_call(code)(sc, sc->t2_1);
@@ -63503,37 +68936,32 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_SAFE_C_S_opCq:
if (!c_function_is_ok_caddr(sc, code))break;
-
case HOP_SAFE_C_S_opCq:
{
s7_pointer args, val;
args = cdr(code);
- val = find_symbol_checked(sc, car(args));
+ val = find_symbol_unchecked(sc, car(args));
set_car(sc->t2_2, c_call(cadr(args))(sc, opt_pair1(args))); /* any number of constants here */
set_car(sc->t2_1, val);
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_C_opSq:
if (!c_function_is_ok_caddr(sc, code)) break;
-
case HOP_SAFE_C_C_opSq:
{
s7_pointer args;
args = cdr(code);
- set_car(sc->t1_1, find_symbol_checked(sc, opt_sym1(args)));
+ set_car(sc->t1_1, find_symbol_unchecked(sc, opt_sym1(args)));
set_car(sc->t2_2, c_call(cadr(args))(sc, sc->t1_1));
set_car(sc->t2_1, car(args));
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_C_opCq:
if (!c_function_is_ok_caddr(sc, code)) break;
-
case HOP_SAFE_C_C_opCq:
{
s7_pointer args;
@@ -63544,15 +68972,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_C_opCSq:
if (!c_function_is_ok_caddr(sc, code)) break;
-
case HOP_SAFE_C_C_opCSq:
{
s7_pointer args;
args = cdr(code);
- set_car(sc->t2_2, find_symbol_checked(sc, opt_sym2(args)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, opt_sym2(args)));
set_car(sc->t2_1, opt_con1(args));
set_car(sc->t2_2, c_call(cadr(args))(sc, sc->t2_1));
set_car(sc->t2_1, car(args));
@@ -63560,16 +68986,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_C_opSSq:
if (!c_function_is_ok_caddr(sc, code)) break;
-
case HOP_SAFE_C_C_opSSq:
{
s7_pointer args, val;
args = cdr(code);
- val = find_symbol_checked(sc, opt_sym1(args));
- set_car(sc->t2_2, find_symbol_checked(sc, opt_sym2(args)));
+ val = find_symbol_unchecked(sc, opt_sym1(args));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, opt_sym2(args)));
set_car(sc->t2_1, val);
set_car(sc->t2_2, c_call(cadr(args))(sc, sc->t2_1));
set_car(sc->t2_1, car(args));
@@ -63577,15 +69001,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_opCSq_C:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opCSq_C:
{
s7_pointer args;
args = cdr(code);
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(car(args))));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(car(args))));
set_car(sc->t2_1, cadr(car(args)));
set_car(sc->t2_1, c_call(car(args))(sc, sc->t2_1));
set_car(sc->t2_2, cadr(args));
@@ -63593,16 +69015,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_opSSq_C:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opSSq_C:
{
s7_pointer args, val;
args = cdr(code);
- val = find_symbol_checked(sc, cadr(car(args)));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(car(args))));
+ val = find_symbol_unchecked(sc, cadr(car(args)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(car(args))));
set_car(sc->t2_1, val);
set_car(sc->t2_1, c_call(car(args))(sc, sc->t2_1));
set_car(sc->t2_2, cadr(args));
@@ -63610,17 +69030,15 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_opSSq_S:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opSSq_S:
{
s7_pointer args, val, val1;
args = cdr(code);
- val = find_symbol_checked(sc, cadr(car(args)));
- val1 = find_symbol_checked(sc, cadr(args));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(car(args))));
+ val = find_symbol_unchecked(sc, cadr(car(args)));
+ val1 = find_symbol_unchecked(sc, cadr(args));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(car(args))));
set_car(sc->t2_1, val);
set_car(sc->t2_1, c_call(car(args))(sc, sc->t2_1));
set_car(sc->t2_2, val1);
@@ -63628,17 +69046,15 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_op_opSSq_q_C:
- if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, cadr(cadr(code))))) break;
-
+ if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, cadadr(code)))) break;
case HOP_SAFE_C_op_opSSq_q_C:
{
/* code: (> (magnitude (- old new)) 0.001) */
s7_pointer arg;
- arg = cadr(cadr(code));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(arg)));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(arg)));
+ arg = cadadr(code);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(arg)));
set_car(sc->t1_1, c_call(arg)(sc, sc->t2_1));
set_car(sc->t2_1, c_call(cadr(code))(sc, sc->t1_1));
set_car(sc->t2_2, caddr(code));
@@ -63646,33 +69062,29 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_op_opSSq_q_S:
- if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, cadr(cadr(code))))) break;
-
+ if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, cadadr(code)))) break;
case HOP_SAFE_C_op_opSSq_q_S:
{
/* code: (> (magnitude (- old new)) s) */
s7_pointer arg;
- arg = cadr(cadr(code));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(arg)));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(arg)));
+ arg = cadadr(code);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(arg)));
set_car(sc->t1_1, c_call(arg)(sc, sc->t2_1));
set_car(sc->t2_1, c_call(cadr(code))(sc, sc->t1_1));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(code)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(code)));
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_op_opSq_q_C:
- if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, cadr(cadr(code))))) break;
-
+ if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, cadadr(code)))) break;
case HOP_SAFE_C_op_opSq_q_C:
{
s7_pointer arg;
- arg = cadr(cadr(code));
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(arg)));
+ arg = cadadr(code);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(arg)));
set_car(sc->t1_1, c_call(arg)(sc, sc->t1_1));
set_car(sc->t2_1, c_call(cadr(code))(sc, sc->t1_1));
set_car(sc->t2_2, caddr(code));
@@ -63680,26 +69092,22 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_op_opSq_q_S:
- if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, cadr(cadr(code))))) break;
-
+ if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, cadadr(code)))) break;
case HOP_SAFE_C_op_opSq_q_S:
{
s7_pointer arg;
- arg = cadr(cadr(code));
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(arg)));
+ arg = cadadr(code);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(arg)));
set_car(sc->t1_1, c_call(arg)(sc, sc->t1_1));
set_car(sc->t2_1, c_call(cadr(code))(sc, sc->t1_1));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(code)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(code)));
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_S_op_opSSq_Sq:
if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, caddr(code))) || (!c_function_is_ok(sc, cadr(caddr(code))))) break;
-
case HOP_SAFE_C_S_op_opSSq_Sq:
{
/* (let () (define (hi a b c d) (+ a (* (- b c) d))) (define (ho) (hi 1 2 3 4)) (ho))
@@ -63711,78 +69119,92 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
s7_pointer args, val, val1;
args = caddr(code); /* (* (- b c) d) */
val1 = cadr(args);
- val = find_symbol_checked(sc, cadr(val1)); /* b */
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(val1))); /* c */
+ val = find_symbol_unchecked(sc, cadr(val1)); /* b */
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(val1))); /* c */
set_car(sc->t2_1, val);
- val = find_symbol_checked(sc, caddr(args)); /* d */
+ val = find_symbol_unchecked(sc, caddr(args)); /* d */
set_car(sc->t2_1, c_call(val1)(sc, sc->t2_1)); /* (- b c) */
set_car(sc->t2_2, val);
set_car(sc->t2_2, c_call(args)(sc, sc->t2_1)); /* (* ...) */
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(code))); /* a */
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(code))); /* a */
sc->value = c_call(code)(sc, sc->t2_1); /* (+ ...) */
goto START;
}
+ case OP_SAFE_C_S_op_S_opSqq:
+ if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, caddr(code))) || (!c_function_is_ok(sc, caddr(caddr(code))))) break;
+ case HOP_SAFE_C_S_op_S_opSqq:
+ {
+ /* (let () (define (hi a c d) (+ a (* d (- c)))) (define (ho) (hi 1 3 4)) (ho)) */
+ s7_pointer args, val, val1;
+ args = caddr(code);
+ val1 = caddr(args);
+ val = find_symbol_unchecked(sc, cadr(args));
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(val1)));
+ set_car(sc->t2_2, c_call(val1)(sc, sc->t1_1));
+ set_car(sc->t2_1, val);
+ set_car(sc->t2_2, c_call(args)(sc, sc->t2_1));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(code)));
+ sc->value = c_call(code)(sc, sc->t2_1);
+ goto START;
+ }
case OP_SAFE_C_S_op_S_opSSqq:
if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, caddr(code))) || (!c_function_is_ok(sc, caddr(caddr(code))))) break;
-
case HOP_SAFE_C_S_op_S_opSSqq:
{
/* (let () (define (hi a b c d) (+ a (* d (- b c)))) (define (ho) (hi 1 2 3 4)) (ho)) */
s7_pointer args, val, val1;
args = caddr(code); /* (* d (- b c)) */
val1 = caddr(args);
- val = find_symbol_checked(sc, cadr(val1)); /* b */
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(val1))); /* c */
+ val = find_symbol_unchecked(sc, cadr(val1)); /* b */
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(val1))); /* c */
set_car(sc->t2_1, val);
- val = find_symbol_checked(sc, cadr(args)); /* d */
+ val = find_symbol_unchecked(sc, cadr(args)); /* d */
set_car(sc->t2_2, c_call(val1)(sc, sc->t2_1)); /* (- b c) */
set_car(sc->t2_1, val);
set_car(sc->t2_2, c_call(args)(sc, sc->t2_1)); /* (* ...) */
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(code))); /* a */
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(code))); /* a */
sc->value = c_call(code)(sc, sc->t2_1); /* (+ ...) */
goto START;
}
-
case OP_SAFE_C_S_op_opSSq_opSSqq:
- if (!a_is_ok(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_S_op_opSSq_opSSqq:
{
/* (* s (f3 (f1 a b) (f2 c d))) */
- s7_pointer args, f1, op1, op2;
+ s7_pointer args, op1, op2;
+ int tx;
+ tx = next_tx(sc);
args = caddr(code);
op1 = cadr(args);
op2 = caddr(args);
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(op1)));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(op1)));
- f1 = c_call(op1)(sc, sc->t2_1);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(op1)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(op1)));
+ sc->t_temps[tx] = c_call(op1)(sc, sc->t2_1);
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(op2)));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(op2)));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(op2)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(op2)));
set_car(sc->t2_2, c_call(op2)(sc, sc->t2_1));
- set_car(sc->t2_1, f1);
+ set_car(sc->t2_1, sc->t_temps[tx]);
set_car(sc->t2_2, c_call(args)(sc, sc->t2_1));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(code)));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(code)));
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_opSCq_S:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opSCq_S:
{
s7_pointer args, val1;
args = cdr(code);
- val1 = find_symbol_checked(sc, cadr(args));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(car(args))));
+ val1 = find_symbol_unchecked(sc, cadr(args));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(car(args))));
set_car(sc->t2_2, caddr(car(args)));
set_car(sc->t2_1, c_call(car(args))(sc, sc->t2_1));
set_car(sc->t2_2, val1);
@@ -63790,15 +69212,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_opSCq_C:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opSCq_C:
{
s7_pointer args;
args = cdr(code);
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(car(args))));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(car(args))));
set_car(sc->t2_2, caddr(car(args)));
set_car(sc->t2_1, c_call(car(args))(sc, sc->t2_1));
set_car(sc->t2_2, cadr(args));
@@ -63806,16 +69226,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_opCSq_S:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opCSq_S:
{
s7_pointer args, val1;
args = cdr(code);
- val1 = find_symbol_checked(sc, cadr(args));
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(car(args))));
+ val1 = find_symbol_unchecked(sc, cadr(args));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(car(args))));
set_car(sc->t2_1, cadr(car(args)));
set_car(sc->t2_1, c_call(car(args))(sc, sc->t2_1));
set_car(sc->t2_2, val1);
@@ -63823,16 +69241,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_S_opSCq:
if (!c_function_is_ok_caddr(sc, code)) break;
-
case HOP_SAFE_C_S_opSCq:
{
s7_pointer val1, args;
args = cdr(code);
- val1 = find_symbol_checked(sc, car(args));
- set_car(sc->t2_1, find_symbol_checked(sc, opt_sym1(args)));
+ val1 = find_symbol_unchecked(sc, car(args));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, opt_sym1(args)));
set_car(sc->t2_2, opt_con2(args));
set_car(sc->t2_2, c_call(cadr(args))(sc, sc->t2_1));
set_car(sc->t2_1, val1);
@@ -63840,15 +69256,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_C_opSCq:
if (!c_function_is_ok_caddr(sc, code)) break;
-
case HOP_SAFE_C_C_opSCq:
{
s7_pointer args;
args = cdr(code);
- set_car(sc->t2_1, find_symbol_checked(sc, opt_sym1(args)));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, opt_sym1(args)));
set_car(sc->t2_2, opt_con2(args));
set_car(sc->t2_2, c_call(cadr(args))(sc, sc->t2_1));
set_car(sc->t2_1, car(args));
@@ -63856,18 +69270,16 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_S_opSSq:
if (!c_function_is_ok_caddr(sc, code)) break;
-
case HOP_SAFE_C_S_opSSq:
{
/* (* a (- b c)) */
s7_pointer val1, val2, args;
args = cdr(code);
- val1 = find_symbol_checked(sc, car(args));
- val2 = find_symbol_checked(sc, opt_sym1(args));
- set_car(sc->t2_2, find_symbol_checked(sc, opt_sym2(args)));
+ val1 = find_symbol_unchecked(sc, car(args));
+ val2 = find_symbol_unchecked(sc, opt_sym1(args));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, opt_sym2(args)));
set_car(sc->t2_1, val2);
set_car(sc->t2_2, c_call(cadr(args))(sc, sc->t2_1));
set_car(sc->t2_1, val1);
@@ -63875,106 +69287,95 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_S_opCSq:
if (!c_function_is_ok_caddr(sc, code)) break;
-
case HOP_SAFE_C_S_opCSq:
{
/* (* a (- 1 b)) or (logand a (ash 1 b)) */
s7_pointer val1, args;
args = cdr(code);
- val1 = find_symbol_checked(sc, car(args)); /* a */
- set_car(sc->t2_2, find_symbol_checked(sc, opt_sym2(args))); /* b */
- set_car(sc->t2_1, opt_con1(args)); /* 1 */
- set_car(sc->t2_2, c_call(cadr(args))(sc, sc->t2_1)); /* (- 1 b) */
+ val1 = find_symbol_unchecked(sc, car(args)); /* a */
+ set_car(sc->t2_2, find_symbol_unchecked(sc, opt_sym2(args))); /* b */
+ set_car(sc->t2_1, opt_con1(args)); /* 1 */
+ set_car(sc->t2_2, c_call(cadr(args))(sc, sc->t2_1)); /* (- 1 b) */
set_car(sc->t2_1, val1);
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_opSq_S:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opSq_S:
{
s7_pointer args;
+ int tx;
+ tx = next_tx(sc);
args = cdr(code);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(car(args))));
- sc->temp3 = c_call(car(args))(sc, sc->t1_1);
- set_car(sc->t2_2, find_symbol_checked(sc, cadr(args)));
- set_car(sc->t2_1, sc->temp3);
- sc->temp3 = sc->nil;
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(car(args))));
+ sc->t_temps[tx] = c_call(car(args))(sc, sc->t1_1);
+ set_car(sc->t2_2, find_symbol_unchecked(sc, cadr(args)));
+ set_car(sc->t2_1, sc->t_temps[tx]);
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_opSq_P:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opSq_P:
{
- s7_pointer args;
+ s7_pointer args, val;
args = cadr(code);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(args)));
- push_stack(sc, OP_SAFE_C_opSq_P_1, c_call(args)(sc, sc->t1_1), sc->code);
+ 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);
sc->code = caddr(code);
goto EVAL;
}
-
case OP_SAFE_C_opSq_Q:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opSq_Q:
{
s7_pointer arg1; /* (let-ref (cdr v) 'x) */
arg1 = cadr(code);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(arg1)));
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(arg1)));
set_car(sc->t2_1, c_call(arg1)(sc, sc->t1_1));
- set_car(sc->t2_2, cadr(caddr(code)));
+ set_car(sc->t2_2, opt_con2(cdr(code))); /* cadr(caddr(code)) */
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
- case OP_SAFE_C_opSq_Q_S:
+ case OP_SAFE_C_opSq_QS:
if (!c_function_is_ok_cadr(sc, code)) break;
-
- case HOP_SAFE_C_opSq_Q_S:
+ case HOP_SAFE_C_opSq_QS:
{
s7_pointer arg1, arg3; /* (let-set! (cdr v) 'x y) */
arg1 = cadr(code);
- arg3 = find_symbol_checked(sc, cadddr(code));
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(arg1)));
+ arg3 = find_symbol_unchecked(sc, opt_sym2(cdr(code))); /* cadddr(code) */
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(arg1)));
set_car(sc->t3_1, c_call(arg1)(sc, sc->t1_1));
- set_car(sc->t3_2, cadr(caddr(code)));
+ set_car(sc->t3_2, opt_con1(cdr(code))); /* cadr(caddr(code)) */
set_car(sc->t3_3, arg3);
sc->value = c_call(code)(sc, sc->t3_1);
goto START;
}
-
case OP_SAFE_C_opCq_S:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opCq_S:
{
s7_pointer args, val;
args = cdr(code);
- val = find_symbol_checked(sc, cadr(args));
+ val = find_symbol_unchecked(sc, cadr(args));
set_car(sc->t2_1, c_call(car(args))(sc, cdr(car(args))));
set_car(sc->t2_2, val);
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_opCq_C:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opCq_C:
{
s7_pointer args;
@@ -63985,25 +69386,21 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
-
case OP_SAFE_C_opSq_C:
if (!c_function_is_ok_cadr(sc, code)) break;
-
case HOP_SAFE_C_opSq_C:
{
s7_pointer args;
args = cdr(code);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(car(args))));
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(car(args))));
set_car(sc->t2_1, c_call(car(args))(sc, sc->t1_1));
set_car(sc->t2_2, cadr(args));
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_C_op_S_opCqq:
- if (!a_is_ok(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_C_op_S_opCqq:
{
/* (define (hi a) (< 1.0 (+ a (* a 2)))) */
@@ -64012,315 +69409,363 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
arg1 = cadr(args); /* op_S_opCqq */
arg2 = caddr(arg1); /* opCq */
set_car(sc->t2_2, c_call(arg2)(sc, cdr(arg2)));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(arg1)));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg1)));
set_car(sc->t2_2, c_call(arg1)(sc, sc->t2_1));
set_car(sc->t2_1, car(args));
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_opSq_opSq:
if (!c_function_is_ok_cadr_caddr(sc, code)) break;
-
case HOP_SAFE_C_opSq_opSq:
{
s7_pointer args;
+ int tx;
+ tx = next_tx(sc);
args = cdr(code);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(car(args))));
- sc->temp3 = c_call(car(args))(sc, sc->t1_1);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(car(args))));
+ sc->t_temps[tx] = c_call(car(args))(sc, sc->t1_1);
args = cadr(args);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(args)));
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(args)));
set_car(sc->t2_2, c_call(args)(sc, sc->t1_1));
- set_car(sc->t2_1, sc->temp3);
- sc->temp3 = sc->nil;
+ set_car(sc->t2_1, sc->t_temps[tx]);
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_opCq_opCq:
if (!c_function_is_ok_cadr_caddr(sc, code)) break;
-
case HOP_SAFE_C_opCq_opCq:
{
- s7_pointer args, val1;
+ s7_pointer args;
+ int tx;
+ tx = next_tx(sc);
args = cdr(code);
- val1 = c_call(car(args))(sc, cdr(car(args)));
+ 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! */
- set_car(sc->t2_1, val1);
+ set_car(sc->t2_1, sc->t_temps[tx]);
+ sc->value = c_call(code)(sc, sc->t2_1);
+ goto START;
+ }
+
+ case OP_SAFE_C_opSq_opCq:
+ if (!c_function_is_ok_cadr_caddr(sc, code)) break;
+ case HOP_SAFE_C_opSq_opCq:
+ {
+ s7_pointer args;
+ int tx;
+ tx = next_tx(sc);
+ args = cdr(code);
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(car(args))));
+ sc->t_temps[tx] = c_call(car(args))(sc, sc->t1_1);
+ args = cadr(args);
+ set_car(sc->t2_2, c_call(args)(sc, cdr(args)));
+ set_car(sc->t2_1, sc->t_temps[tx]);
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
+ case OP_SAFE_C_opCq_opSq:
+ if (!c_function_is_ok_cadr_caddr(sc, code)) break;
+ case HOP_SAFE_C_opCq_opSq:
+ {
+ s7_pointer args;
+ int tx;
+ tx = next_tx(sc);
+ args = cdr(code);
+ sc->t_temps[tx] = c_call(car(args))(sc, cdr(car(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]);
+ sc->value = c_call(code)(sc, sc->t2_1);
+ goto START;
+ }
case OP_SAFE_C_opCq_opSSq:
if (!c_function_is_ok_cadr_caddr(sc, code)) break;
-
case HOP_SAFE_C_opCq_opSSq:
{
- s7_pointer args, val;
+ s7_pointer args;
+ int tx;
+ tx = next_tx(sc);
/* code: (/ (+ bn 1) (+ bn an)) */
args = cdr(code);
- val = c_call(car(args))(sc, cdr(car(args)));
+ sc->t_temps[tx] = c_call(car(args))(sc, cdr(car(args)));
args = cdr(args);
- set_car(sc->t2_1, find_symbol_checked(sc, cadar(args)));
- set_car(sc->t2_2, find_symbol_checked(sc, caddar(args)));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadar(args)));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddar(args)));
set_car(sc->t2_2, c_call(car(args))(sc, sc->t2_1));
- set_car(sc->t2_1, val);
+ set_car(sc->t2_1, sc->t_temps[tx]);
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_opSCq_opSCq:
if (!c_function_is_ok_cadr_caddr(sc, code)) break;
-
case HOP_SAFE_C_opSCq_opSCq:
{
s7_pointer args, val2;
+ int tx;
+ tx = next_tx(sc);
args = cdr(code);
- val2 = find_symbol_checked(sc, cadr(cadr(args)));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(car(args))));
+ val2 = find_symbol_unchecked(sc, cadadr(args));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(car(args))));
set_car(sc->t2_2, caddr(car(args)));
- sc->temp3 = c_call(car(args))(sc, sc->t2_1);
+ sc->t_temps[tx] = c_call(car(args))(sc, sc->t2_1);
set_car(sc->t2_1, val2);
set_car(sc->t2_2, caddr(cadr(args)));
set_car(sc->t2_2, c_call(cadr(args))(sc, sc->t2_1));
- set_car(sc->t2_1, sc->temp3);
- sc->temp3 = sc->nil;
+ set_car(sc->t2_1, sc->t_temps[tx]);
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_opSSq_opSSq:
if (!c_function_is_ok_cadr_caddr(sc, code)) break;
-
case HOP_SAFE_C_opSSq_opSSq:
{
s7_pointer args, val3, val4;
+ int tx;
+ tx = next_tx(sc);
args = cdr(code);
- val3 = find_symbol_checked(sc, caddr(car(args)));
- val4 = find_symbol_checked(sc, caddr(cadr(args)));
+ val3 = find_symbol_unchecked(sc, caddr(car(args)));
+ val4 = find_symbol_unchecked(sc, caddr(cadr(args)));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(car(args))));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(car(args))));
set_car(sc->t2_2, val3);
- sc->temp3 = c_call(car(args))(sc, sc->t2_1);
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(cadr(args))));
+ sc->t_temps[tx] = c_call(car(args))(sc, sc->t2_1);
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadadr(args)));
set_car(sc->t2_2, val4);
set_car(sc->t2_2, c_call(cadr(args))(sc, sc->t2_1));
- set_car(sc->t2_1, sc->temp3);
- sc->temp3 = sc->nil;
+ set_car(sc->t2_1, sc->t_temps[tx]);
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_opSSq_opSq:
if (!c_function_is_ok_cadr_caddr(sc, code)) break;
-
case HOP_SAFE_C_opSSq_opSq:
{
s7_pointer args, val3;
+ int tx;
+ tx = next_tx(sc);
args = cdr(code);
- val3 = find_symbol_checked(sc, caddr(car(args)));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(car(args))));
+ val3 = find_symbol_unchecked(sc, caddr(car(args)));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(car(args))));
set_car(sc->t2_2, val3);
- val3 = c_call(car(args))(sc, sc->t2_1);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(cadr(args))));
+ sc->t_temps[tx] = c_call(car(args))(sc, sc->t2_1);
+ 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, val3);
+ set_car(sc->t2_1, sc->t_temps[tx]);
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_opSq_opSSq:
if (!c_function_is_ok_cadr_caddr(sc, code)) break;
-
case HOP_SAFE_C_opSq_opSSq:
{
- s7_pointer args, val3;
+ s7_pointer args;
+ int tx;
+ tx = next_tx(sc);
args = cdr(code);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(car(args))));
- val3 = c_call(car(args))(sc, sc->t1_1);
- set_car(sc->t2_2, find_symbol_checked(sc, caddr(cadr(args))));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(cadr(args))));
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(car(args))));
+ sc->t_temps[tx] = c_call(car(args))(sc, sc->t1_1);
+ set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(cadr(args))));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadadr(args)));
set_car(sc->t2_2, c_call(cadr(args))(sc, sc->t2_1));
- set_car(sc->t2_1, val3);
+ set_car(sc->t2_1, sc->t_temps[tx]);
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
-
case OP_SAFE_C_opSSq_opCq:
if (!c_function_is_ok_cadr_caddr(sc, code)) break;
-
case HOP_SAFE_C_opSSq_opCq:
{
s7_pointer arg1, arg2, val3;
+ int tx;
+ tx = next_tx(sc);
arg1 = cadr(code);
arg2 = caddr(code);
- val3 = find_symbol_checked(sc, caddr(arg1));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(arg1)));
+ val3 = find_symbol_unchecked(sc, caddr(arg1));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg1)));
set_car(sc->t2_2, val3);
- val3 = c_call(arg1)(sc, sc->t2_1);
+ sc->t_temps[tx] = c_call(arg1)(sc, sc->t2_1);
set_car(sc->t2_2, c_call(arg2)(sc, cdr(arg2)));
- set_car(sc->t2_1, val3);
+ set_car(sc->t2_1, sc->t_temps[tx]);
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
}
+ case OP_SAFE_IFA_SS_A: /* ((if a s s) a) I think */
+ case HOP_SAFE_IFA_SS_A:
+ {
+ s7_function f;
+ f = c_function_call((is_true(sc, c_call(cdar(code))(sc, cadar(code)))) ? opt_con1(code) : opt_con2(code));
+ sc->value = f(sc, set_plist_1(sc, c_call(cdr(code))(sc, cadr(code))));
+ goto START;
+ }
+
/* -------------------------------------------------------------------------------- */
case OP_C_S:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_C_S:
- sc->args = list_1(sc, find_symbol_checked(sc, cadr(code)));
+ sc->args = list_1(sc, find_symbol_unchecked(sc, cadr(code)));
sc->value = c_call(code)(sc, sc->args);
goto START;
-
case OP_READ_S:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_READ_S:
read_s_ex(sc);
goto START;
-
case OP_C_A:
- if (!a_is_ok_cadr(sc, code)) break;
-
+ if (!c_function_is_ok(sc, code))
+ {
+ s7_pointer new_func;
+ if (unknown_a_ex(sc, new_func = find_symbol_checked(sc, car(code))) == goto_OPT_EVAL)
+ {
+ if (op_no_hop(sc->code) == OP_C_A)
+ {
+ sc->args = list_1(sc, c_call(cdr(code))(sc, cadr(code)));
+ sc->value = c_call(code)(sc, sc->args);
+ goto START;
+ }
+ goto OPT_EVAL;
+ }
+ break;
+ }
case HOP_C_A:
sc->args = list_1(sc, c_call(cdr(code))(sc, cadr(code)));
sc->value = c_call(code)(sc, sc->args);
goto START;
-
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);
- sc->code = _TLst(cadr(code));
- goto OPT_EVAL;
-
+ 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);
- sc->code = _TLst(cadr(code));
+ sc->code = _TPair(cadr(code));
goto EVAL;
-
case OP_C_SS:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_C_SS:
- sc->args = list_2(sc, find_symbol_checked(sc, cadr(code)), find_symbol_checked(sc, caddr(code)));
+ sc->args = list_2(sc, find_symbol_unchecked(sc, cadr(code)), find_symbol_unchecked(sc, caddr(code)));
sc->value = c_call(code)(sc, sc->args);
goto START;
-
- case OP_C_SZ:
+ case OP_C_AP:
if (!c_function_is_ok(sc, code)) break;
-
- case HOP_C_SZ:
- push_stack(sc, OP_C_SP_1, find_symbol_checked(sc, cadr(code)), code);
- sc->code = _TLst(caddr(code));
- goto OPT_EVAL;
-
-
- case OP_C_SP:
+ case HOP_C_AP:
+ {
+ s7_pointer val;
+ /* op_c_ap_1 sends us to apply which calls check_stack_size I think */
+ val = c_call(cdr(code))(sc, cadr(code));
+ push_stack(sc, OP_C_AP_1, val, code);
+ sc->code = caddr(code);
+ goto EVAL;
+ }
+
+ case OP_C_FA:
if (!c_function_is_ok(sc, code)) break;
-
- case HOP_C_SP:
- push_stack(sc, OP_C_SP_1, find_symbol_checked(sc, cadr(code)), code);
- sc->code = caddr(code);
- goto EVAL;
-
+ 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->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_AA:
+ if (!c_function_is_ok(sc, code)) break;
+ case HOP_C_AA:
+ sc->code = c_call(cdr(code))(sc, cadr(code));
+ sc->value = c_call(cddr(code))(sc, caddr(code));
+ sc->args = list_2(sc, sc->code, sc->value);
+ sc->value = c_call(code)(sc, sc->args);
+ goto START;
case OP_APPLY_SS:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_APPLY_SS:
- sc->code = find_symbol_checked(sc, cadr(code)); /* global search here was slower */
- sc->args = find_symbol_checked(sc, opt_sym2(code));
+ sc->code = find_symbol_unchecked(sc, cadr(code)); /* global search here was slower */
+ sc->args = find_symbol_unchecked(sc, opt_sym2(code));
if (!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);
goto APPLY;
-
case OP_C_S_opSq:
if ((!c_function_is_ok(sc, code)) || (!indirect_c_function_is_ok(sc, caddr(code)))) break;
-
case HOP_C_S_opSq:
{
s7_pointer args, val;
args = cdr(code);
- val = find_symbol_checked(sc, car(args));
- set_car(sc->t1_1, find_symbol_checked(sc, opt_sym1(args)));
+ val = find_symbol_unchecked(sc, car(args));
+ set_car(sc->t1_1, find_symbol_unchecked(sc, opt_sym1(args)));
sc->args = list_2(sc, val, c_call(cadr(args))(sc, sc->t1_1));
sc->value = c_call(code)(sc, sc->args);
goto START;
}
-
case OP_C_S_opCq:
if ((!c_function_is_ok(sc, code)) || (!indirect_c_function_is_ok(sc, caddr(code)))) break;
-
case HOP_C_S_opCq:
{
s7_pointer args, val;
+ int tx;
+ tx = next_tx(sc);
args = cdr(code);
- sc->temp3 = find_symbol_checked(sc, car(args));
+ sc->t_temps[tx] = find_symbol_unchecked(sc, car(args));
val = c_call(cadr(args))(sc, opt_pair1(args));
- sc->args = list_2(sc, sc->temp3, val);
- sc->temp3 = sc->nil;
+ sc->args = list_2(sc, sc->t_temps[tx], val);
sc->value = c_call(code)(sc, sc->args);
goto START;
}
-
case OP_C_SCS:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_C_SCS:
{
s7_pointer a1, a2;
a1 = cdr(code);
a2 = cdr(a1);
- sc->args = list_3(sc, find_symbol_checked(sc, car(a1)), car(a2), find_symbol_checked(sc, cadr(a2))); /* was unchecked? */
+ sc->args = list_3(sc, find_symbol_unchecked(sc, car(a1)), car(a2), find_symbol_unchecked(sc, cadr(a2)));
sc->value = c_call(code)(sc, sc->args);
goto START;
}
-
case OP_C_ALL_X:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_C_ALL_X:
{ /* (set-cdr! lst ()) */
- s7_pointer args, p;
- sc->args = make_list(sc, integer(arglist_length(code)), sc->nil);
- for (args = cdr(code), p = sc->args; is_pair(args); args = cdr(args), p = cdr(p))
+ s7_pointer args, p, new_args;
+ new_args = make_list(sc, integer(arglist_length(code)), sc->nil);
+ sc->args = new_args;
+ /* GC protect? all_x stuff below can clobber sc->args:
+ * (catch #f (vector-ref #(1 2) 0 1.0+1.0i) (vector-ref #(1 2) 0 1.0+1.0i))
+ */
+ for (args = cdr(code), p = new_args; is_pair(args); args = cdr(args), p = cdr(p))
set_car(p, c_call(args)(sc, car(args)));
- sc->value = c_call(code)(sc, sc->args);
+ sc->value = c_call(code)(sc, new_args);
goto START;
}
-
case OP_CALL_WITH_EXIT:
if (!c_function_is_ok(sc, code)) break;
- check_lambda_args(sc, cadr(cadr(code)), NULL);
-
+ check_lambda_args(sc, cadadr(code), NULL);
case HOP_CALL_WITH_EXIT:
{
s7_pointer go, args;
@@ -64328,14 +69773,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
go = make_goto(sc);
push_stack(sc, OP_DEACTIVATE_GOTO, go, code); /* code arg is ignored, but perhaps this is safer in GC? */
new_frame_with_slot(sc, sc->envir, sc->envir, caar(args), go);
- sc->code = _TLst(cdr(args));
+ sc->code = _TPair(cdr(args));
goto BEGIN1;
}
case OP_C_CATCH:
if (!c_function_is_ok(sc, code)) break;
check_lambda_args(sc, cadr(cadddr(code)), NULL);
-
case HOP_C_CATCH:
{
/* (catch #t (lambda () (set! ("hi") #\a)) (lambda args args))
@@ -64366,36 +69810,53 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
push_stack(sc, OP_CATCH_1, code, p); /* code ignored here, except by GC */
new_frame(sc, sc->envir, sc->envir);
- sc->code = _TLst(cddar(args));
+ sc->code = _TPair(cddar(args));
goto BEGIN1;
}
-
case OP_C_CATCH_ALL:
if (!c_function_is_ok(sc, code)) break;
-
case HOP_C_CATCH_ALL:
{
/* (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 unsigned ints, so this fits in the new frame's dox1/2 fields.
+ * the locs are unsigned ints, 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);
- sc->code = _TLst(opt_pair1(cdr(code))); /* the body of the first lambda */
- goto BEGIN1; /* removed one_liner check here -- rare */
+ sc->code = _TPair(opt_pair1(cdr(code))); /* the body of the first lambda */
+ goto BEGIN1;
+ }
+
+ case OP_C_CATCH_ALL_Z:
+ if (!c_function_is_ok(sc, code)) break;
+ case HOP_C_CATCH_ALL_Z:
+ {
+ s7_pointer p;
+ 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);
+ sc->code = _TPair(car(opt_pair1(cdr(code))));
+ goto OPT_EVAL_CHECKED;
}
/* -------------------------------------------------------------------------------- */
case OP_THUNK:
- if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 0)) {set_optimize_op(code, OP_UNKNOWN); goto OPT_EVAL;}
-
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 0)) {if (unknown_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_THUNK:
check_stack_size(sc);
/* this recursion check is consistent with the other unsafe closure calls, but we're probably in big trouble:
@@ -64408,229 +69869,226 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
* out, and peculiar things start to happen. (Also, is_h_optimized would need to be smarter).
*/
new_frame(sc, closure_let(opt_lambda(code)), sc->envir);
- sc->code = _TLst(closure_body(opt_lambda(code)));
+ sc->code = _TPair(closure_body(opt_lambda(code)));
goto BEGIN1;
-
case OP_SAFE_THUNK:
- if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 0)) {set_optimize_op(code, OP_UNKNOWN); goto OPT_EVAL;}
-
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 0)) {if (unknown_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_SAFE_THUNK: /* no frame needed */
/* (let ((x 1)) (let () (define (f) x) (let ((x 0)) (define (g) (set! x 32) (f)) (g)))) */
sc->envir = closure_let(opt_lambda(code));
- sc->code = _TLst(closure_body(opt_lambda(code)));
+ sc->code = _TPair(closure_body(opt_lambda(code)));
goto BEGIN1;
-
case OP_SAFE_THUNK_E:
- if (find_symbol_unexamined(sc, car(code)) != opt_any1(code)) {set_optimize_op(code, OP_UNKNOWN); goto OPT_EVAL;}
-
+ if (!closure_is_equal(sc, code)) {if (unknown_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_SAFE_THUNK_E:
sc->envir = closure_let(opt_lambda(code));
- sc->code = _TLst(car(closure_body(opt_lambda(code))));
+ sc->code = _TPair(car(closure_body(opt_lambda(code))));
goto OPT_EVAL;
-
case OP_SAFE_THUNK_P:
- if (find_symbol_unexamined(sc, car(code)) != opt_any1(code)) {set_optimize_op(code, OP_UNKNOWN); goto OPT_EVAL;}
-
+ if (!closure_is_equal(sc, code)) {if (unknown_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
+ goto SAFE_LTHUNK_P;
+ case OP_SAFE_LTHUNK_P:
+ set_opt_lambda(code, local_symbol_value(car(code)));
+ SAFE_LTHUNK_P:
case HOP_SAFE_THUNK_P:
+ 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->code = cdr(sc->code);
goto START_WITHOUT_POP_STACK;
-
case OP_SAFE_CLOSURE_S:
- if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 1)) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
-
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_SAFE_CLOSURE_S:
/* since a tail call is safe, we can't change the current env's let_id until
* after we do the lookup -- it might be the current func's arg, and we're
* about to call the same func.
*/
- sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, opt_sym2(code)));
- sc->code = _TLst(closure_body(opt_lambda(code)));
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), find_symbol_unchecked(sc, opt_sym2(code)));
+ sc->code = _TPair(closure_body(opt_lambda(code)));
goto BEGIN1;
+ case OP_SAFE_LCLOSURE_L:
+ set_opt_lambda(code, local_symbol_value(car(code)));
+ case HOP_SAFE_LCLOSURE_L:
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), local_symbol_value(opt_sym2(code)));
+ sc->code = _TPair(closure_body(opt_lambda(code)));
+ goto BEGIN1;
+ case OP_SAFE_CLOSURE_S_C:
+ /* here and below the closure has to be the original -- matches are no good */
+ if (!closure_is_equal(sc, code)) {if (unknown_g_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
+ case HOP_SAFE_CLOSURE_S_C:
+ 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->value = c_call(sc->code)(sc, cdr(sc->code));
+ goto START;
+
case OP_SAFE_CLOSURE_S_P:
- if (find_symbol_unexamined(sc, car(code)) != opt_any1(code)) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
-
+ if (!closure_is_equal(sc, code)) {if (unknown_g_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_SAFE_CLOSURE_S_P:
- sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, opt_sym2(code)));
+ 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->code = cdr(sc->code);
+ goto START_WITHOUT_POP_STACK;
+
+ case OP_SAFE_LCLOSURE_L_P:
+ set_opt_lambda(code, local_symbol_value(car(code)));
+ 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->code = cdr(sc->code);
goto START_WITHOUT_POP_STACK;
-
- case OP_SAFE_GLOSURE_S:
- if ((symbol_id(car(code)) != 0) ||(opt_any1(code) != slot_value(global_slot(car(code)))))
- {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
-
- case HOP_SAFE_GLOSURE_S:
- sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, opt_sym2(code)));
- sc->code = _TLst(closure_body(opt_lambda(code)));
- goto BEGIN1;
-
-
- case OP_SAFE_GLOSURE_S_E:
- if ((symbol_id(car(code)) != 0) || (opt_any1(code) != slot_value(global_slot(car(code)))))
- {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
-
- case HOP_SAFE_GLOSURE_S_E:
- sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, opt_sym2(code)));
- sc->code = _TLst(car(closure_body(opt_lambda(code))));
- goto OPT_EVAL;
-
-
case OP_SAFE_CLOSURE_C:
- if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 1)) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
-
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_SAFE_CLOSURE_C:
sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), cadr(code));
- sc->code = _TLst(closure_body(opt_lambda(code)));
- goto BEGIN1;
-
-
- case OP_SAFE_CLOSURE_Q:
- if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 1)) {set_optimize_op(code, OP_UNKNOWN_A); goto OPT_EVAL;}
-
- case HOP_SAFE_CLOSURE_Q:
- sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), cadr(cadr(code)));
- sc->code = _TLst(closure_body(opt_lambda(code)));
+ sc->code = _TPair(closure_body(opt_lambda(code)));
goto BEGIN1;
-
- case OP_SAFE_GLOSURE_P:
- if ((symbol_id(car(code)) != 0) || (opt_any1(code) != slot_value(global_slot(car(code))))) break;
-
- case HOP_SAFE_GLOSURE_P:
- push_stack(sc, OP_SAFE_CLOSURE_P_1, sc->nil, code);
+ case OP_SAFE_CLOSURE_P:
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 1))
+ {
+ if ((has_all_x(cdr(code))) &&
+ (unknown_a_ex(sc, sc->last_function) == goto_OPT_EVAL))
+ goto OPT_EVAL;
+ break;
+ }
+ case HOP_SAFE_CLOSURE_P:
+ push_stack(sc, OP_SAFE_CLOSURE_P_1, sc->args, sc->code);
sc->code = cadr(code);
goto EVAL;
-
-
+
case OP_SAFE_CLOSURE_A:
- if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 1)) {set_optimize_op(code, OP_UNKNOWN_A); goto OPT_EVAL;}
- if (!indirect_c_function_is_ok(sc, cadr(code))) break;
-
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 1)) {if (unknown_a_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_SAFE_CLOSURE_A:
sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), c_call(cdr(code))(sc, cadr(code)));
- sc->code = _TLst(closure_body(opt_lambda(code)));
+ sc->code = _TPair(closure_body(opt_lambda(code)));
goto BEGIN1;
-
-
- case OP_SAFE_GLOSURE_A:
- if ((symbol_id(car(code)) != 0) || (opt_any1(code) != slot_value(global_slot(car(code)))))
- {set_optimize_op(code, OP_UNKNOWN_A); goto OPT_EVAL;}
- if (!indirect_c_function_is_ok(sc, cadr(code))) break;
-
- case HOP_SAFE_GLOSURE_A:
+
+ case OP_SAFE_LCLOSURE_A:
+ set_opt_lambda(code, slot_value(local_slot(car(code))));
+ case HOP_SAFE_LCLOSURE_A:
sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), c_call(cdr(code))(sc, cadr(code)));
- sc->code = _TLst(closure_body(opt_lambda(code)));
+ sc->code = _TPair(closure_body(opt_lambda(code)));
goto BEGIN1;
-
-
+
+ case OP_SAFE_CLOSURE_A_C:
+ if (!closure_is_equal(sc, code)) {if (unknown_a_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
+ case HOP_SAFE_CLOSURE_A_C:
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), c_call(cdr(code))(sc, cadr(code)));
+ sc->code = car(closure_body(opt_lambda(code)));
+ sc->value = c_call(sc->code)(sc, cdr(sc->code));
+ goto START;
+
+ case OP_SAFE_CLOSURE_AP:
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 2)) break;
+ case HOP_SAFE_CLOSURE_AP:
+ {
+ s7_pointer val;
+ val = c_call(cdr(code))(sc, cadr(code));
+ push_stack(sc, OP_SAFE_CLOSURE_AP_1, val, sc->code);
+ sc->code = caddr(code);
+ goto EVAL;
+ }
+
+ case OP_SAFE_CLOSURE_PA:
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 2)) break;
+ case HOP_SAFE_CLOSURE_PA:
+ {
+ s7_pointer val;
+ val = c_call(cddr(code))(sc, caddr(code));
+ push_stack(sc, OP_SAFE_CLOSURE_PA_1, val, sc->code);
+ sc->code = cadr(code);
+ goto EVAL;
+ }
+
case OP_SAFE_CLOSURE_SS:
- if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
-
+ 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:
sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)),
- find_symbol_checked(sc, cadr(code)),
- find_symbol_checked(sc, opt_sym2(code)));
- sc->code = _TLst(closure_body(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;
-
case OP_SAFE_CLOSURE_SC:
- if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
-
+ 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_SC:
- sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, cadr(code)), opt_con2(code));
- sc->code = _TLst(closure_body(opt_lambda(code)));
+ sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)), find_symbol_unchecked(sc, cadr(code)), opt_con2(code));
+ sc->code = _TPair(closure_body(opt_lambda(code)));
goto BEGIN1;
-
case OP_SAFE_CLOSURE_CS:
- if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
-
+ 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_CS:
- sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)), cadr(code), find_symbol_checked(sc, opt_sym2(code)));
- sc->code = _TLst(closure_body(opt_lambda(code)));
+ sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)), cadr(code), find_symbol_unchecked(sc, opt_sym2(code)));
+ sc->code = _TPair(closure_body(opt_lambda(code)));
goto BEGIN1;
-
case OP_SAFE_CLOSURE_SA:
- if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_AA); goto OPT_EVAL;}
-
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 2)) {if (unknown_aa_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_SAFE_CLOSURE_SA:
{
s7_pointer args;
args = cddr(code);
args = c_call(args)(sc, car(args));
- sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, cadr(code)), args);
- sc->code = _TLst(closure_body(opt_lambda(code)));
+ sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)), find_symbol_unchecked(sc, cadr(code)), args);
+ sc->code = _TPair(closure_body(opt_lambda(code)));
goto BEGIN1;
}
-
-
+
case OP_SAFE_CLOSURE_AA:
- if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_AA); goto OPT_EVAL;}
-
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 2)) {if (unknown_aa_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_SAFE_CLOSURE_AA:
{
- s7_pointer args, y, z;
+ s7_pointer args, z;
+ int tx;
+ tx = next_tx(sc);
args = cdr(code);
- y = c_call(args)(sc, car(args));
+ sc->t_temps[tx] = c_call(args)(sc, car(args));
args = cdr(args);
z = c_call(args)(sc, car(args));
- sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)), y, z);
- sc->code = _TLst(closure_body(opt_lambda(code)));
+ sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)), sc->t_temps[tx], z);
+ sc->code = _TPair(closure_body(opt_lambda(code)));
goto BEGIN1;
}
-
case OP_SAFE_CLOSURE_SAA:
if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 3)) break;
-
case HOP_SAFE_CLOSURE_SAA:
{
- s7_pointer args, y, z;
+ s7_pointer args, z;
+ int tx;
+ tx = next_tx(sc);
args = cddr(code);
- y = c_call(args)(sc, car(args));
+ sc->t_temps[tx] = c_call(args)(sc, car(args));
args = cdr(args);
z = c_call(args)(sc, car(args));
- sc->envir = old_frame_with_three_slots(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, cadr(code)), y, z);
- sc->code = _TLst(closure_body(opt_lambda(code)));
+ sc->envir = old_frame_with_three_slots(sc, closure_let(opt_lambda(code)), find_symbol_unchecked(sc, cadr(code)), sc->t_temps[tx], z);
+ sc->code = _TPair(closure_body(opt_lambda(code)));
goto BEGIN1;
}
-
case OP_SAFE_CLOSURE_ALL_X:
if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, integer(arglist_length(code)))) break;
-
case HOP_SAFE_CLOSURE_ALL_X:
{
s7_pointer args, p, env, x, z;
- int num_args;
unsigned long long int id;
-
- num_args = integer(arglist_length(code));
- if ((num_args != 0) &&
- (num_args < NUM_SAFE_LISTS) &&
- (!list_is_in_use(sc->safe_lists[num_args])))
- {
- sc->args = sc->safe_lists[num_args];
- set_list_in_use(sc->args);
- }
- else sc->args = make_list(sc, num_args, sc->nil);
-
+
+ sc->args = safe_list_if_possible(sc, integer(arglist_length(code)));
for (args = cdr(code), p = sc->args; is_pair(args); args = cdr(args), p = cdr(p))
set_car(p, c_call(args)(sc, car(args)));
clear_list_in_use(sc->args);
+ sc->current_safe_list = 0;
sc->code = opt_lambda(code);
id = ++sc->let_number;
@@ -64662,116 +70120,86 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* -------------------------------------------------------------------------------- */
- case OP_SAFE_CLOSURE_STAR_SS:
- if (!closure_star_is_ok(sc, code, MATCH_SAFE_CLOSURE_STAR, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
-
- case HOP_SAFE_CLOSURE_STAR_SS:
- {
- s7_pointer x, val1, val2;
- /* the finders have to operate in the current environment, so we can't change sc->envir until later */
- val1 = find_symbol_checked(sc, cadr(code));
- val2 = find_symbol_checked(sc, opt_sym2(code)); /* caddr */
- sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), val1);
-
- x = next_slot(let_slots(closure_let(opt_lambda(code))));
- slot_set_value(x, val2);
- symbol_set_local(slot_symbol(x), let_id(sc->envir), x);
- fill_safe_closure_star(sc, next_slot(x), cddr(closure_args(opt_lambda(code))));
- goto BEGIN1;
- }
-
-
- case OP_SAFE_CLOSURE_STAR_SC:
- if (!closure_star_is_ok(sc, code, MATCH_SAFE_CLOSURE_STAR, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
-
- case HOP_SAFE_CLOSURE_STAR_SC:
+ case OP_SAFE_CLOSURE_STAR_A:
+ if (!closure_star_is_ok(sc, code, MATCH_SAFE_CLOSURE_STAR, 1)) {if (unknown_a_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
+ case HOP_SAFE_CLOSURE_STAR_A:
{
- s7_pointer x;
- sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, cadr(code)));
-
+ s7_pointer p, x, val;
+ val = c_call(cdr(code))(sc, cadr(code));
+ if (is_keyword(val))
+ s7_error(sc, sc->wrong_type_arg_symbol,
+ set_elist_4(sc, make_string_wrapper(sc, "~A: keyword argument's value is missing: ~S in ~S"),
+ closure_name(sc, opt_lambda(code)), val, sc->args));
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), val);
+ /* that sets the first arg to the passed symbol value; now set default values, if any */
+
+ /* fill_safe_closure_star(sc, next_slot(let_slots(closure_let(opt_lambda(code)))), cdr(closure_args(opt_lambda(code)))); */
+ p = cdr(closure_args(opt_lambda(code)));
x = next_slot(let_slots(closure_let(opt_lambda(code))));
- slot_set_value(x, caddr(code));
- symbol_set_local(slot_symbol(x), let_id(sc->envir), x);
- fill_safe_closure_star(sc, next_slot(x), cddr(closure_args(opt_lambda(code))));
+ for (; is_pair(p); p = cdr(p), x = next_slot(x))
+ {
+ if (is_pair(car(p)))
+ {
+ s7_pointer defval;
+ defval = cadar(p);
+ if (is_pair(defval))
+ slot_set_value(x, cadr(defval));
+ else slot_set_value(x, defval);
+ }
+ 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));
goto BEGIN1;
}
-
- case OP_SAFE_CLOSURE_STAR_SA:
+ case OP_SAFE_CLOSURE_STAR_AA:
if (!closure_star_is_ok(sc, code, MATCH_SAFE_CLOSURE_STAR, 2)) break;
-
- case HOP_SAFE_CLOSURE_STAR_SA:
+ case HOP_SAFE_CLOSURE_STAR_AA:
{
- s7_pointer arg;
- /* the second arg needs to be evaluated before we set sc->envir.
- * we checked at optimize time that this closure takes only 2 args.
- */
- arg = cddr(code);
- arg = c_call(arg)(sc, car(arg));
- sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, cadr(code)), arg);
-
- sc->code = _TLst(closure_body(opt_lambda(code)));
- goto BEGIN1;
- }
-
-
- case OP_SAFE_CLOSURE_STAR_ALL_X:
- if (!closure_star_is_ok(sc, code, MATCH_SAFE_CLOSURE_STAR, integer(arglist_length(code)))) break;
-
- case HOP_SAFE_CLOSURE_STAR_ALL_X:
- {
- s7_pointer args, p, orig_args, e;
- /* (let () (define* (hi (a 1)) (+ a 1)) (define (ho) (hi (* 2 3))) (ho))
- * (do ((i 0 (+ i 1))) ((= i 11)) (envelope-interp (/ i 21) '(0 0 100 1)))
- */
- e = closure_let(opt_lambda(code));
- for (args = cdr(code), p = let_slots(e), orig_args = closure_args(opt_lambda(code));
- is_pair(args);
- args = cdr(args), orig_args = cdr(orig_args), p = next_slot(p))
- slot_set_pending_value(p, c_call(args)(sc, car(args)));
-
- /* we're out of caller's args, so fill rest of environment slots from the defaults */
- for (; is_slot(p); p = next_slot(p), orig_args = cdr(orig_args))
+ /* here closure_arity == 2 and we have 2 args, so no need to worry about trailing defaults */
+ s7_pointer arg1, arg2, clet, cargs;
+ clet = closure_let(opt_lambda(code));
+ cargs = closure_args(opt_lambda(code));
+ arg1 = c_call(cdr(code))(sc, cadr(code));
+ arg2 = c_call(cddr(code))(sc, caddr(code));
+
+ if (is_keyword(arg1))
{
- s7_pointer defval;
- if (is_pair(car(orig_args)))
+ if (keyword_symbol(arg1) == slot_symbol(let_slots(clet)))
{
- defval = cadar(orig_args);
- if (is_pair(defval))
- slot_set_pending_value(p, cadr(defval));
- else slot_set_pending_value(p, defval);
+ arg1 = arg2;
+ arg2 = cadr(cargs);
+ if (is_pair(arg2)) arg2 = cadr(arg2); else arg2 = sc->F;
+ }
+ else
+ {
+ if (keyword_symbol(arg1) == slot_symbol(next_slot(let_slots(clet))))
+ {
+ arg1 = car(cargs);
+ if (is_pair(arg1)) arg1 = cadr(arg1); else arg1 = sc->F;
+ }
+ else
+ s7_error(sc, sc->wrong_type_arg_symbol,
+ set_elist_4(sc, make_string_wrapper(sc, "~A: unknown keyword argument: ~S in ~S"),
+ closure_name(sc, opt_lambda(code)), arg1, code));
}
- else slot_set_pending_value(p, sc->F);
}
-
- /* we have to put off the actual environment update in case this is a tail recursive call */
- let_id(e) = ++sc->let_number;
- for (p = let_slots(e); is_slot(p); p = next_slot(p))
+ else
{
- slot_set_value(p, slot_pending_value(p));
- symbol_set_local(slot_symbol(p), let_id(e), p);
+ if (is_keyword(arg2))
+ s7_error(sc, sc->wrong_type_arg_symbol,
+ set_elist_4(sc, make_string_wrapper(sc, "~A: keyword argument's value is missing: ~S in ~S"),
+ closure_name(sc, opt_lambda(code)), arg2, code));
}
-
- sc->envir = e;
- sc->code = _TLst(closure_body(opt_lambda(code)));
+ sc->envir = old_frame_with_two_slots(sc, clet, arg1, arg2);
+ sc->code = _TPair(closure_body(opt_lambda(code)));
goto BEGIN1;
}
-
- case OP_SAFE_CLOSURE_STAR:
- if (!closure_star_is_ok(sc, code, MATCH_SAFE_CLOSURE_STAR, 0)) {set_optimize_op(code, OP_UNKNOWN); goto OPT_EVAL;}
-
- case HOP_SAFE_CLOSURE_STAR:
- /* (let () (define* (hi (a 100)) (random a)) (define (ho) (hi)) (ho)) */
- sc->envir = closure_let(opt_lambda(code));
- let_id(sc->envir) = ++sc->let_number;
- fill_safe_closure_star(sc, let_slots(closure_let(opt_lambda(code))), closure_args(opt_lambda(code)));
- goto BEGIN1;
-
-
case OP_SAFE_CLOSURE_STAR_S0:
- if (find_symbol_unexamined(sc, car(code)) != opt_any1(code)) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
-
+ /* an old (probably now unnecessary) kludge to speed up generators.scm */
+ if (!closure_is_equal(sc, code)) {if (unknown_g_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_SAFE_CLOSURE_STAR_S0:
/* here we know we have (let-set! arg1 'name arg2) (with-env arg1 ...) as the safe closure body.
* since no errors can come from the first, there's no need for the procedure env.
@@ -64779,7 +70207,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
*/
{
s7_pointer e;
- e = find_symbol_checked(sc, cadr(code)); /* S of S0 above */
+ e = find_symbol_unchecked(sc, cadr(code)); /* S of S0 above */
if (e == sc->rootlet)
sc->envir = sc->nil;
else
@@ -64802,43 +70230,47 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
slot_set_value(local_slot(opt_sym1(cdr(code))), real_zero); /* "arg2" above */
}
- sc->code = _TLst(opt_pair2(cdr(code)));
+ sc->code = _TPair(opt_pair2(cdr(code)));
goto BEGIN1;
}
+ case OP_SAFE_CLOSURE_STAR_ALL_X:
+ if (!closure_star_is_ok(sc, code, MATCH_SAFE_CLOSURE_STAR, integer(arglist_length(code)))) break;
+ 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))
+ set_car(p, c_call(old_args)(sc, car(old_args)));
+ sc->w = sc->nil;
+ sc->code = opt_lambda(code);
+ check_stack_size(sc);
+ sc->envir = new_frame_in_env(sc, closure_let(sc->code));
+ /* sc->envir = closure_let(sc->code); */
+ if (apply_lambda_star(sc) == goto_EVAL) goto EVAL;
+ goto BEGIN1;
+ }
- case OP_SAFE_CLOSURE_STAR_S:
- if (!closure_star_is_ok(sc, code, MATCH_SAFE_CLOSURE_STAR, 1)) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
-
- case HOP_SAFE_CLOSURE_STAR_S:
- sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, opt_sym2(code)));
- /* that sets the first arg to the passed symbol value; now set default values, if any */
- fill_safe_closure_star(sc, next_slot(let_slots(closure_let(opt_lambda(code)))), cdr(closure_args(opt_lambda(code))));
- goto BEGIN1;
-
-
+
/* -------------------------------------------------------------------------------- */
case OP_GOTO:
set_opt_goto(code, find_symbol_checked(sc, car(code)));
- if (!is_goto(opt_goto(code))) {set_optimize_op(code, OP_UNKNOWN); goto OPT_EVAL;}
-
+ if (!is_goto(opt_goto(code))) {if (unknown_ex(sc, opt_goto(code)) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_GOTO:
sc->args = sc->nil;
sc->code = opt_goto(code);
call_with_exit(sc);
goto START;
-
case OP_GOTO_C:
/* call-with-exit repeat use internally is very rare, so let's just look it up */
set_opt_goto(code, find_symbol_checked(sc, car(code)));
- if (!is_goto(opt_goto(code)))
- {
- set_optimize_op(code, OP_UNKNOWN_G);
- goto OPT_EVAL;
- }
-
+ if (!is_goto(opt_goto(code))) {if (unknown_g_ex(sc, opt_goto(code)) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_GOTO_C:
/* (return #t) -- recognized via OP_UNKNOWN_G, opt_goto(code) is the function [parallels OP_CLOSURE_C] */
sc->args = cdr(code);
@@ -64846,23 +70278,19 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
call_with_exit(sc);
goto START;
-
case OP_GOTO_S:
- set_opt_goto(code, find_symbol_checked(sc, car(code)));
- if (!is_goto(opt_goto(code))) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
-
+ set_opt_goto(code, find_symbol_unchecked(sc, car(code)));
+ if (!is_goto(opt_goto(code))) {if (unknown_g_ex(sc, opt_goto(code)) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_GOTO_S:
- sc->args = list_1(sc, find_symbol_checked(sc, cadr(code)));
+ sc->args = list_1(sc, find_symbol_unchecked(sc, cadr(code)));
/* I think this needs listification because call_with_exit might call dynamic unwinders etc. */
sc->code = opt_goto(code);
call_with_exit(sc);
goto START;
-
case OP_GOTO_A:
set_opt_goto(code, find_symbol_checked(sc, car(code)));
- if (!is_goto(opt_goto(code))) {set_optimize_op(code, OP_UNKNOWN_A); goto OPT_EVAL;}
-
+ if (!is_goto(opt_goto(code))) {if (unknown_a_ex(sc, opt_goto(code)) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_GOTO_A:
sc->args = list_1(sc, c_call(cdr(code))(sc, cadr(code)));
sc->code = opt_goto(code);
@@ -64870,131 +70298,145 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
/* for T_CONTINUATION, set sc->args to list_1(sc, ...) as in goto (and code?), then call_with_current_continuation */
-
case OP_CLOSURE_C:
- if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 1)) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
-
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_CLOSURE_C:
check_stack_size(sc);
code = opt_lambda(code);
new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), cadr(sc->code));
- sc->code = _TLst(closure_body(code));
- goto BEGIN1;
-
-
- case OP_CLOSURE_Q:
- if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 1)) {set_optimize_op(code, OP_UNKNOWN_A); goto OPT_EVAL;}
-
- case HOP_CLOSURE_Q:
- check_stack_size(sc);
- code = opt_lambda(code);
- new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), cadr(cadr(sc->code)));
- sc->code = _TLst(closure_body(code));
+ sc->code = _TPair(closure_body(code));
goto BEGIN1;
-
+
+ case OP_CLOSURE_P:
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
+ case HOP_CLOSURE_P:
+ push_stack(sc, OP_CLOSURE_P_1, sc->args, sc->code);
+ sc->code = cadr(code);
+ goto EVAL;
case OP_CLOSURE_A:
- if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 1)) {set_optimize_op(code, OP_UNKNOWN_A); goto OPT_EVAL;}
- if (!indirect_c_function_is_ok(sc, cadr(code))) break;
-
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 1)) {if (unknown_a_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_CLOSURE_A:
sc->value = c_call(cdr(code))(sc, cadr(code));
check_stack_size(sc);
code = opt_lambda(code);
new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), sc->value);
- sc->code = _TLst(closure_body(code));
+ sc->code = _TPair(closure_body(code));
goto BEGIN1;
-
- case OP_GLOSURE_A:
- if ((symbol_id(car(code)) != 0) || (opt_lambda_unchecked(code) != slot_value(global_slot(car(code)))))
- {set_optimize_op(code, OP_UNKNOWN_A); goto OPT_EVAL;}
- if (!indirect_c_function_is_ok(sc, cadr(code))) break;
-
- case HOP_GLOSURE_A:
+ case OP_CLOSURE_A_P:
+ if (!closure_is_equal(sc, code)) {if (unknown_a_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
+ case HOP_CLOSURE_A_P:
sc->value = c_call(cdr(code))(sc, cadr(code));
check_stack_size(sc);
code = opt_lambda(code);
new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), sc->value);
- sc->code = _TLst(closure_body(code));
- goto BEGIN1;
-
-
- case OP_GLOSURE_P:
- if ((symbol_id(car(code)) != 0) || (opt_lambda_unchecked(code) != slot_value(global_slot(car(code))))) break;
-
- case HOP_GLOSURE_P:
- push_stack(sc, OP_CLOSURE_P_1, sc->nil, code);
- sc->code = cadr(code);
- goto EVAL;
-
-
- case OP_GLOSURE_S:
- if ((symbol_id(car(code)) != 0) || (opt_any1(code) != slot_value(global_slot(car(code)))))
- {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
-
- case HOP_GLOSURE_S:
- sc->value = find_symbol_checked(sc, opt_sym2(code));
- check_stack_size(sc);
- code = opt_lambda(code);
- new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), sc->value);
- sc->code = _TLst(closure_body(code));
- goto BEGIN1;
-
+ code = car(closure_body(code));
+ sc->op = (opcode_t)pair_syntax_op(code);
+ sc->code = cdr(code);
+ goto START_WITHOUT_POP_STACK;
case OP_CLOSURE_S:
- if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 1)) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
-
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 1)) {if (unknown_g_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_CLOSURE_S:
- sc->value = find_symbol_checked(sc, opt_sym2(code));
+ sc->value = find_symbol_unchecked(sc, opt_sym2(code));
check_stack_size(sc);
code = opt_lambda(code);
new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), sc->value);
- sc->code = _TLst(closure_body(code));
+ sc->code = _TPair(closure_body(code));
goto BEGIN1;
-
case OP_CLOSURE_SS:
- if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
-
- case HOP_CLOSURE_SS: /* only called if one of these symbols has an accessor */
- unsafe_closure_2(sc, find_symbol_checked(sc, cadr(code)), find_symbol_checked(sc, opt_sym2(code)));
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
+ case HOP_CLOSURE_SS:
+ unsafe_closure_2(sc, find_symbol_unchecked(sc, cadr(code)), find_symbol_unchecked(sc, opt_sym2(code)));
goto BEGIN1;
-
+
+ case OP_CLOSURE_SS_P:
+ if (!closure_is_equal(sc, code)) {if (unknown_gg_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
+ case HOP_CLOSURE_SS_P:
+ {
+ s7_pointer func, args;
+ check_stack_size(sc);
+ func = opt_lambda(sc->code);
+ args = closure_args(func);
+ new_frame_with_two_slots(sc, closure_let(func), sc->envir,
+ 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;
+ }
case OP_CLOSURE_SC:
- if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
-
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_CLOSURE_SC:
- unsafe_closure_2(sc, find_symbol_checked(sc, cadr(code)), opt_con2(code));
+ unsafe_closure_2(sc, find_symbol_unchecked(sc, cadr(code)), opt_con2(code));
goto BEGIN1;
-
case OP_CLOSURE_CS:
- if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
-
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_CLOSURE_CS:
- unsafe_closure_2(sc, cadr(code), find_symbol_checked(sc, opt_sym2(code)));
+ unsafe_closure_2(sc, cadr(code), find_symbol_unchecked(sc, opt_sym2(code)));
goto BEGIN1;
-
case OP_CLOSURE_AA:
- if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_AA); goto OPT_EVAL;}
- if ((is_optimized(cadr(code))) && (!indirect_c_function_is_ok(sc, cadr(code)))) break;
- if ((is_optimized(caddr(code))) && (!indirect_c_function_is_ok(sc, caddr(code)))) break;
-
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 2)) {if (unknown_aa_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
case HOP_CLOSURE_AA:
{
s7_pointer args;
+ int tx;
+ tx = next_tx(sc);
args = cdr(code);
- sc->temp2 = c_call(args)(sc, car(args));
- unsafe_closure_2(sc, sc->temp2, c_call(cdr(args))(sc, cadr(args)));
+ sc->t_temps[tx] = c_call(args)(sc, car(args));
+ unsafe_closure_2(sc, sc->t_temps[tx], c_call(cdr(args))(sc, cadr(args)));
goto BEGIN1;
}
-
-
+
+ case OP_CLOSURE_AP:
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 2)) break;
+ case HOP_CLOSURE_AP:
+ {
+ s7_pointer val;
+ val = c_call(cdr(code))(sc, cadr(code)); /* don't use this as a push_stack argument */
+ push_stack(sc, OP_CLOSURE_AP_1, val, code);
+ sc->code = caddr(code);
+ goto EVAL;
+ }
+
+ case OP_CLOSURE_PA:
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 2)) break;
+ case HOP_CLOSURE_PA:
+ {
+ s7_pointer val;
+ val = c_call(cddr(code))(sc, caddr(code)); /* don't use this as a push_stack argument */
+ push_stack(sc, OP_CLOSURE_PA_1, val, code);
+ sc->code = cadr(code);
+ goto EVAL;
+ }
+
+ case OP_CLOSURE_FA:
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 2)) break;
+ case HOP_CLOSURE_FA:
+ {
+ s7_pointer farg, larg, aarg, func, func_args;
+ farg = cdr(cadr(code));
+ aarg = c_call(cddr(code))(sc, caddr(code));
+ make_closure_with_let(sc, larg, car(farg), cdr(farg), sc->envir); /* arg func */
+ check_stack_size(sc);
+ func = opt_lambda(sc->code); /* outer func */
+ func_args = closure_args(func);
+ new_frame_with_two_slots(sc, closure_let(func), sc->envir, car(func_args), larg, cadr(func_args), aarg);
+ sc->code = car(closure_body(func));
+ goto EVAL;
+ }
+
case OP_CLOSURE_ALL_S:
- if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, integer(arglist_length(code)))) {set_optimize_op(code, OP_UNKNOWN_ALL_S); goto OPT_EVAL;}
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, integer(arglist_length(code))))
+ {
+ if (unknown_all_s_ex(sc, sc->last_function) == goto_OPT_EVAL)
+ goto OPT_EVAL;
+ break;
+ }
case HOP_CLOSURE_ALL_S:
{
@@ -65008,18 +70450,38 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
new_frame(sc, closure_let(func), e);
sc->z = e;
for (p = closure_args(func), args = cdr(code); is_pair(p); p = cdr(p), args = cdr(args))
- add_slot(e, car(p), find_symbol_checked(sc, car(args)));
+ add_slot(e, car(p), find_symbol_unchecked(sc, car(args)));
sc->envir = e;
sc->z = sc->nil;
- sc->code = _TLst(closure_body(func));
+ sc->code = _TPair(closure_body(func));
goto BEGIN1;
}
+ case OP_CLOSURE_ALL_S_P:
+ if (!closure_is_equal(sc, code)) {if (unknown_all_s_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
+ case HOP_CLOSURE_ALL_S_P:
+ {
+ s7_pointer args, p, func, e;
+ check_stack_size(sc);
+ func = opt_lambda(code);
+ new_frame(sc, closure_let(func), e);
+ sc->z = e;
+ for (p = closure_args(func), args = cdr(code); is_pair(p); p = cdr(p), args = cdr(args))
+ add_slot(e, car(p), find_symbol_unchecked(sc, car(args)));
+ sc->envir = e;
+ sc->z = sc->nil;
+ sc->code = car(closure_body(func));
+ goto EVAL;
+ }
case OP_CLOSURE_ALL_X:
check_stack_size(sc);
- if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, integer(arglist_length(code)))) {set_optimize_op(code, OP_UNKNOWN_ALL_X); goto OPT_EVAL;}
-
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, integer(arglist_length(code))))
+ {
+ if (unknown_all_x_ex(sc, sc->last_function) == goto_OPT_EVAL)
+ goto OPT_EVAL;
+ break;
+ }
case HOP_CLOSURE_ALL_X:
{
s7_pointer args, p, func, e;
@@ -65034,103 +70496,93 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
sc->envir = e;
sc->z = sc->nil;
- sc->code = _TLst(closure_body(func));
+ sc->code = _TPair(closure_body(func));
goto BEGIN1;
}
/* -------------------------------------------------------------------------------- */
- case OP_CLOSURE_STAR_ALL_X:
- if (!closure_star_is_ok(sc, code, MATCH_UNSAFE_CLOSURE_STAR, integer(arglist_length(code))))
- {
- set_optimize_op(code, OP_UNKNOWN_ALL_X);
- goto OPT_EVAL;
- }
-
- case HOP_CLOSURE_STAR_ALL_X:
+ case OP_CLOSURE_STAR_A:
+ if (!closure_star_is_ok(sc, code, MATCH_UNSAFE_CLOSURE_STAR, 1)) {if (unknown_a_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
+ case HOP_CLOSURE_STAR_A:
{
- /* here also, all the args are simple */
- /* (let () (define* (hi (a 1)) (list a)) (define (ho) (hi (* 2 3))) (ho))
- */
- s7_pointer args, p, func, new_args;
-
- func = opt_lambda(code);
- sc->args = make_list(sc, closure_star_arity_to_int(sc, func), sc->nil);
- new_args = sc->args;
-
- for (p = closure_args(func), args = cdr(code); is_pair(args); p = cdr(p), args = cdr(args), new_args = cdr(new_args))
- set_car(new_args, c_call(args)(sc, car(args)));
-
- for (; is_pair(p); p = cdr(p), new_args = cdr(new_args))
+ s7_pointer val, p;
+ val = c_call(cdr(code))(sc, cadr(code));
+ if (is_keyword(val))
+ s7_error(sc, sc->wrong_type_arg_symbol,
+ set_elist_4(sc, make_string_wrapper(sc, "~A: keyword argument's value is missing: ~S in ~S"),
+ closure_name(sc, opt_lambda(code)), val, code));
+ sc->args = list_1(sc, val);
+
+ /* fill_closure_star(sc, cdr(closure_args(opt_lambda(code)))); */
+ p = cdr(closure_args(opt_lambda(code)));
+ for (; is_pair(p); p = cdr(p))
{
- s7_pointer defval;
if (is_pair(car(p)))
{
+ s7_pointer defval;
defval = cadar(p);
if (is_pair(defval))
- set_car(new_args, cadr(defval));
- else set_car(new_args, defval);
+ sc->args = cons(sc, cadr(defval), sc->args);
+ else sc->args = cons(sc, defval, sc->args);
}
- else set_car(new_args, sc->F);
+ else sc->args = cons(sc, sc->F, sc->args);
}
- sc->code = opt_lambda(code);
- unsafe_closure_star(sc);
+ sc->args = safe_reverse_in_place(sc, sc->args);
+ sc->code = opt_lambda(sc->code);
+
+ /* unsafe_closure_star(sc) */
+ {
+ s7_pointer x, z, e;
+ unsigned long long int id;
+
+ new_frame(sc, closure_let(sc->code), sc->envir);
+ e = sc->envir;
+ id = let_id(e);
+
+ for (x = closure_args(sc->code), z = sc->args; is_pair(x); x = cdr(x))
+ {
+ s7_pointer sym, args;
+ if (is_pair(car(x)))
+ sym = caar(x);
+ else sym = car(x);
+ args = cdr(z);
+ reuse_as_slot(z, sym, unchecked_car(z));
+ symbol_set_local(sym, id, z);
+ set_next_slot(z, let_slots(e));
+ let_set_slots(e, z);
+ z = args;
+ }
+ sc->code = closure_body(sc->code);
+ }
goto BEGIN1;
}
-
-
- case OP_CLOSURE_STAR_SX:
- if (!closure_star_is_ok(sc, code, MATCH_UNSAFE_CLOSURE_STAR, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
-
- case HOP_CLOSURE_STAR_SX:
+
+ case OP_CLOSURE_STAR_AA:
+ /* in the AA case closure_arity==2 and args=2 so we could simplify the all_x cases below */
+ case OP_CLOSURE_STAR_ALL_X:
+ if (!closure_star_is_ok(sc, code, MATCH_UNSAFE_CLOSURE_STAR, integer(arglist_length(code))))
+ {
+ if (unknown_all_x_ex(sc, sc->last_function) == goto_OPT_EVAL)
+ goto OPT_EVAL;
+ break;
+ }
+ case HOP_CLOSURE_STAR_AA:
+ case HOP_CLOSURE_STAR_ALL_X:
{
- s7_pointer val1, val2, args;
- args = cddr(closure_args(opt_lambda(code)));
- val1 = find_symbol_checked(sc, cadr(code));
- val2 = caddr(code);
- if (is_symbol(val2))
- val2 = find_symbol_checked(sc, val2);
- if (is_null(args))
- {
- set_car(sc->t2_1, val1);
- set_car(sc->t2_2, val2);
- code = opt_lambda(sc->code);
- args = closure_args(code);
- new_frame_with_two_slots(sc, closure_let(code), sc->envir,
- (is_pair(car(args))) ? caar(args) : car(args), car(sc->t2_1),
- (is_pair(cadr(args))) ? caadr(args) : cadr(args), car(sc->t2_2));
- sc->code = closure_body(code);
- }
- else
- {
- sc->args = list_2(sc, val2, val1);
- fill_closure_star(sc, args);
- unsafe_closure_star(sc);
- }
+ s7_pointer p, old_args;
+ 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))
+ set_car(p, c_call(old_args)(sc, car(old_args)));
+ sc->w = sc->nil;
+ sc->code = opt_lambda(code);
+ check_stack_size(sc);
+ sc->envir = new_frame_in_env(sc, closure_let(sc->code));
+ if (apply_lambda_star(sc) == goto_EVAL) goto EVAL;
goto BEGIN1;
}
- case OP_CLOSURE_STAR:
- if (!closure_star_is_ok(sc, code, MATCH_UNSAFE_CLOSURE_STAR, 0)) {set_optimize_op(code, OP_UNKNOWN); goto OPT_EVAL;}
-
- case HOP_CLOSURE_STAR:
- /* (let () (define* (hi (a 1)) (list a)) (define (ho) (hi)) (ho)) */
- sc->args = sc->nil;
- fill_closure_star(sc, closure_args(opt_lambda(code)));
- unsafe_closure_star(sc);
- goto BEGIN1;
-
-
- case OP_CLOSURE_STAR_S:
- if (!closure_star_is_ok(sc, code, MATCH_UNSAFE_CLOSURE_STAR, 1)) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
-
- case HOP_CLOSURE_STAR_S:
- sc->args = list_1(sc, find_symbol_checked(sc, opt_sym2(code)));
- fill_closure_star(sc, cdr(closure_args(opt_lambda(code))));
- unsafe_closure_star(sc);
- goto BEGIN1;
-
-
/* -------------------------------------------------------------------------------- */
case OP_UNKNOWN:
case HOP_UNKNOWN:
@@ -65176,211 +70628,107 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* -------------------------------------------------------------------------------- */
- case OP_VECTOR_C:
- case HOP_VECTOR_C:
- if (vector_c_ex(sc) == goto_START) goto START;
- break;
-
- case OP_VECTOR_CC:
- case HOP_VECTOR_CC:
- if (vector_cc_ex(sc) == goto_START) goto START;
- break;
-
case OP_VECTOR_A:
- if (!indirect_cq_function_is_ok(sc, cadr(code))) break;
case HOP_VECTOR_A:
if (vector_a_ex(sc) == goto_START) goto START;
+ if (unknown_a_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL;
break;
- case OP_VECTOR_S:
- case HOP_VECTOR_S:
- if (vector_s_ex(sc) == goto_START) goto START;
- break;
-
-
- case OP_STRING_C:
- case HOP_STRING_C:
- if (string_c_ex(sc) == goto_START) goto START;
- break;
-
case OP_STRING_A:
- if (!indirect_cq_function_is_ok(sc, cadr(code))) break;
case HOP_STRING_A:
if (string_a_ex(sc) == goto_START) goto START;
+ if (unknown_a_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL;
break;
- case OP_STRING_S:
- case HOP_STRING_S:
- if (string_s_ex(sc) == goto_START) goto START;
- break;
-
-
- case OP_HASH_TABLE_C:
- case HOP_HASH_TABLE_C:
- {
- s7_pointer s;
- s = find_symbol_checked(sc, car(code));
- if (!is_hash_table(s)) break;
- sc->value = s7_hash_table_ref(sc, s, cadr(code));
- goto START;
- }
-
-
- case OP_HASH_TABLE_S:
- case HOP_HASH_TABLE_S:
- {
- s7_pointer s;
- s = find_symbol_checked(sc, car(code));
- if (!is_hash_table(s)) break;
- sc->value = s7_hash_table_ref(sc, s, find_symbol_checked(sc, cadr(code)));
- goto START;
- }
-
-
case OP_HASH_TABLE_A:
- if (!indirect_cq_function_is_ok(sc, cadr(code))) break;
case HOP_HASH_TABLE_A:
{
s7_pointer s;
- s = find_symbol_checked(sc, car(code));
- if (!is_hash_table(s)) break;
+ s = find_symbol_unchecked(sc, car(code));
+ if (!is_hash_table(s))
+ {
+ if (unknown_a_ex(sc, s) == goto_OPT_EVAL) goto OPT_EVAL;
+ break;
+ }
sc->value = s7_hash_table_ref(sc, s, c_call(cdr(code))(sc, cadr(code)));
goto START;
}
-
- case OP_ENVIRONMENT_C:
- case HOP_ENVIRONMENT_C:
- {
- s7_pointer s;
- s = find_symbol_checked(sc, car(code));
- if (!is_let(s)) break;
- sc->value = s7_let_ref(sc, s, cadr(code));
- goto START;
- }
-
-
- case OP_ENVIRONMENT_S:
- case HOP_ENVIRONMENT_S:
+ case OP_ITERATE:
+ case HOP_ITERATE:
{
s7_pointer s;
- s = find_symbol_checked(sc, car(code));
- if (!is_let(s)) break;
- sc->value = s7_let_ref(sc, s, find_symbol_checked(sc, cadr(code)));
+ s = find_symbol_unchecked(sc, car(code));
+ if (!is_iterator(s))
+ {
+ if (unknown_ex(sc, s) == goto_OPT_EVAL) goto OPT_EVAL;
+ break;
+ }
+ sc->value = (iterator_next(s))(sc, s);
goto START;
}
-
case OP_ENVIRONMENT_Q:
case HOP_ENVIRONMENT_Q:
{
- s7_pointer s, sym;
- s = find_symbol_checked(sc, car(code));
- if (!is_let(s)) break;
- sym = cadr(cadr(code));
- if (is_symbol(sym))
- sc->value = let_ref_1(sc, s, sym);
- else return(wrong_type_argument_with_type(sc, sc->let_ref_symbol, 2, sym, a_symbol_string)); /* (e '(1)) */
+ s7_pointer s;
+ s = find_symbol_unchecked(sc, car(code));
+ if (!is_let(s))
+ {
+ if (has_all_x(cdr(code)))
+ {
+ if (unknown_a_ex(sc, s) == goto_OPT_EVAL) goto OPT_EVAL;
+ }
+ break;
+ }
+ sc->value = g_let_ref(sc, set_qlist_2(sc, s, cadadr(code)));
goto START;
}
-
case OP_ENVIRONMENT_A:
- if (!indirect_cq_function_is_ok(sc, cadr(code))) break;
case HOP_ENVIRONMENT_A:
{
- s7_pointer s, sym;
- s = find_symbol_checked(sc, car(code));
- if (!is_let(s)) break;
- sym = c_call(cdr(code))(sc, cadr(code));
- if (is_symbol(sym))
- sc->value = let_ref_1(sc, s, sym);
- else return(wrong_type_argument_with_type(sc, sc->let_ref_symbol, 2, sym, a_symbol_string)); /* (e expr) where expr->#f */
- goto START;
- }
-
-
- case OP_PAIR_C:
- case HOP_PAIR_C:
- {
s7_pointer s;
- s = find_symbol_checked(sc, car(code));
- if (!is_pair(s)) break; /* this used to check is_integer(cadr(code)) but surely an error is correct if s is a pair? */
- sc->value = list_ref_1(sc, s, cadr(code));
+ s = find_symbol_unchecked(sc, car(code));
+ if (!is_let(s))
+ {
+ if (unknown_a_ex(sc, s) == goto_OPT_EVAL) goto OPT_EVAL;
+ break;
+ }
+ sc->value = g_let_ref(sc, set_qlist_2(sc, s, c_call(cdr(code))(sc, cadr(code))));
goto START;
}
-
case OP_PAIR_A:
- if (!indirect_cq_function_is_ok(sc, cadr(code))) break;
case HOP_PAIR_A:
{
s7_pointer s, x;
- s = find_symbol_checked(sc, car(code));
- if (!is_pair(s)) break;
+ s = find_symbol_unchecked(sc, car(code));
+ if (!is_pair(s))
+ {
+ if (unknown_a_ex(sc, s) == goto_OPT_EVAL) goto OPT_EVAL;
+ break;
+ }
x = c_call(cdr(code))(sc, cadr(code));
sc->value = list_ref_1(sc, s, x);
goto START;
}
-
- case OP_PAIR_S:
- case HOP_PAIR_S:
- {
- s7_pointer s, ind;
- s = find_symbol_checked(sc, car(code));
- if (!is_pair(s)) break;
- ind = find_symbol_checked(sc, cadr(code));
- sc->value = list_ref_1(sc, s, ind);
- goto START;
- }
-
-
- case OP_C_OBJECT:
- case HOP_C_OBJECT:
- {
- s7_pointer c;
- c = find_symbol_checked(sc, car(code));
- if (!is_c_object(c)) break;
- sc->value = (*(c_object_ref(c)))(sc, c, sc->nil);
- goto START;
- }
-
-
- case OP_C_OBJECT_C:
- case HOP_C_OBJECT_C:
- {
- s7_pointer c;
- c = find_symbol_checked(sc, car(code));
- if (!is_c_object(c)) break;
- sc->value = (*(c_object_ref(c)))(sc, c, cdr(code));
- goto START;
- }
-
-
case OP_C_OBJECT_A:
- if (!indirect_cq_function_is_ok(sc, cadr(code))) break;
case HOP_C_OBJECT_A:
{
s7_pointer c;
- c = find_symbol_checked(sc, car(code));
- if (!is_c_object(c)) break;
+ c = find_symbol_unchecked(sc, car(code));
+ if (!is_c_object(c))
+ {
+ if (unknown_a_ex(sc, c) == goto_OPT_EVAL) goto OPT_EVAL;
+ break;
+ }
set_car(sc->t1_1, c_call(cdr(code))(sc, cadr(code)));
sc->value = (*(c_object_ref(c)))(sc, c, sc->t1_1);
goto START;
}
- case OP_C_OBJECT_S:
- case HOP_C_OBJECT_S:
- {
- s7_pointer c;
- c = find_symbol_checked(sc, car(code));
- if (!is_c_object(c)) break;
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(code)));
- sc->value = (*(c_object_ref(c)))(sc, c, sc->t1_1);
- goto START;
- }
-
default:
fprintf(stderr, "bad op in opt_eval: op %u, is_opt: %d, %s\n", optimize_op(code), is_optimized(code), DISPLAY_80(code));
break;
@@ -65390,14 +70738,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* there is a problem with this -- if the caller still insists on goto OPT_EVAL, for example,
* we get here over and over. (let ((x (list (car y))))...) where list is redefined away.
*/
-#if DEBUGGING
- /* we hit this in zauto (cdr-constants ...) h_vector_s|c (there is no difference here between hop_ and op_)
- */
- if ((is_h_optimized(sc->code)) &&
- (optimize_op(sc->code) != HOP_VECTOR_C) &&
- (optimize_op(sc->code) != HOP_VECTOR_S))
- fprintf(stderr, "%s[%d]: clearing %s in %s\n", __func__, __LINE__, opt_names[optimize_op(sc->code)], DISPLAY(sc->code));
-#endif
clear_all_optimizations(sc, code);
/* and fall into the normal evaluator */
}
@@ -65409,9 +70749,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (is_pair(code))
{
-
#if WITH_PROFILE
- profile(sc, code);
+ if (sc->code != profile_at_start)
+ profile(sc, code);
#endif
set_current_code(sc, code);
carc = car(code);
@@ -65420,7 +70760,7 @@ 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(car(code));
+ sc->op = (opcode_t)symbol_syntax_op(carc);
pair_set_syntax_op(code, sc->op);
sc->code = cdr(code);
goto START_WITHOUT_POP_STACK;
@@ -65452,7 +70792,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
*/
{
if ((car(carc) == sc->quote_symbol) && /* ('and #f) */
- ((!is_pair(cdr(carc))) || /* ((quote . #\h) (2 . #\i)) ! */
+ ((!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));
@@ -65545,7 +70885,6 @@ 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] */
{
@@ -65560,7 +70899,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto APPLY;
}
-
/* 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
@@ -65571,30 +70909,28 @@ 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_2_MV:
sc->args = cons(sc, sc->args, sc->value);
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_checked(sc, cadr(sc->code)));
- set_car(sc->t3_2, find_symbol_checked(sc, caddr(sc->code)));
+ 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_checked(sc, cadr(sc->code)), cons(sc, find_symbol_checked(sc, caddr(sc->code)), sc->value));
+ 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_checked(sc, caddr(sc->code)));
+ 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
* and the first arg's evaluation might change the value of the second arg.
*/
@@ -65607,11 +70943,10 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
* (define (hi a) (log (values 1 2) a))
*/
sc->w = sc->value;
- sc->args = cons(sc, find_symbol_checked(sc, caddr(sc->code)), sc->w);
+ sc->args = cons(sc, find_symbol_unchecked(sc, caddr(sc->code)), sc->w);
sc->code = c_function_base(opt_cfunc(sc->code));
goto APPLY;
-
case OP_EVAL_ARGS_P_4:
set_car(sc->t2_1, sc->value);
set_car(sc->t2_2, sc->args);
@@ -65623,21 +70958,18 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
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_SAFE_C_SZ_SZ:
/* S_opSZq actually, in (nominal second, only actual) SZ, S=args, Z=value,
* SZ from the SP combiner for SZ
@@ -65645,31 +70977,27 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
set_car(sc->t2_1, sc->args);
set_car(sc->t2_2, sc->value);
set_car(sc->t2_2, c_call(caddr(sc->code))(sc, sc->t2_1));
- set_car(sc->t2_1, find_symbol_checked(sc, cadr(sc->code)));
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(sc->code)));
sc->value = c_call(sc->code)(sc, sc->t2_1);
break;
-
case OP_SAFE_C_ZA_1:
set_car(sc->t2_2, c_call(cddr(sc->code))(sc, caddr(sc->code)));
set_car(sc->t2_1, sc->value);
sc->value = c_call(sc->code)(sc, sc->t2_1);
break;
-
case OP_SAFE_C_ZZ_1:
push_stack(sc, OP_SAFE_C_ZZ_2, sc->value, sc->code);
- sc->code = _TLst(caddr(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)));
@@ -65677,7 +71005,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
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)));
set_car(sc->t3_2, sc->value);
@@ -65685,15 +71012,13 @@ 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_checked(sc, caddr(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_SAFE_C_AAZ_1:
set_car(sc->t3_1, pop_op_stack(sc));
set_car(sc->t3_2, sc->args);
@@ -65701,13 +71026,11 @@ 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_ZZA_1:
push_op_stack(sc, sc->value);
push_stack(sc, OP_SAFE_C_ZZA_2, sc->args, sc->code);
- sc->code = _TLst(caddr(sc->code));
- goto OPT_EVAL;
-
+ sc->code = _TPair(caddr(sc->code));
+ goto OPT_EVAL_CHECKED;
case OP_SAFE_C_ZZA_2:
set_car(sc->a3_1, pop_op_stack(sc));
@@ -65716,13 +71039,15 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->value = c_call(sc->code)(sc, sc->a3_1);
break;
-
case OP_SAFE_C_ZAZ_1:
- push_op_stack(sc, sc->value);
- push_stack(sc, OP_SAFE_C_ZAZ_2, c_call(cddr(sc->code))(sc, caddr(sc->code)), sc->code);
- sc->code = _TLst(cadddr(sc->code));
- goto OPT_EVAL;
-
+ {
+ 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);
+ 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));
@@ -65731,13 +71056,11 @@ 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_AZZ_1:
push_op_stack(sc, sc->value);
push_stack(sc, OP_SAFE_C_AZZ_2, sc->args, sc->code);
- sc->code = _TLst(cadddr(sc->code));
- goto OPT_EVAL;
-
+ sc->code = _TPair(cadddr(sc->code));
+ goto OPT_EVAL_CHECKED;
case OP_SAFE_C_AZZ_2:
set_car(sc->t3_1, sc->args);
@@ -65746,19 +71069,16 @@ 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_ZZZ_1:
push_stack(sc, OP_SAFE_C_ZZZ_2, sc->value, sc->code);
- sc->code = _TLst(caddr(sc->code));
- goto OPT_EVAL;
-
+ sc->code = _TPair(caddr(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 = _TLst(cadddr(sc->code));
- goto OPT_EVAL;
-
+ sc->code = _TPair(cadddr(sc->code));
+ goto OPT_EVAL_CHECKED;
case OP_SAFE_C_ZZZ_3:
set_car(sc->t3_1, sc->args);
@@ -65766,7 +71086,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
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 */
@@ -65797,7 +71116,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
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!)
*/
@@ -65819,7 +71137,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto APPLY;
}
-
case OP_EVAL_ARGS4:
/* sc->code is a pair, and either cdr(sc->code) is not null or car(sc->code) is a pair
*
@@ -65835,7 +71152,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto EVAL_ARGS_PAIR;
}
-
case OP_EVAL_ARGS1:
{
s7_pointer x;
@@ -65845,7 +71161,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->args = x;
}
-
EVAL_ARGS:
/* first time, value = op, args = nil, code is args */
if (is_pair(sc->code)) /* evaluate current arg -- must check for pair here, not sc->nil (improper list as args) */
@@ -65901,7 +71216,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
if (sc->stack_end >= sc->stack_resize_trigger)
check_for_cyclic_code(sc, sc->code);
-
push_stack(sc, OP_EVAL_ARGS5, sc->args, sc->value);
sc->code = car_code;
goto EVAL;
@@ -65979,7 +71293,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
* the array-index overhead is the same as the current switch statement's, but there was also the boolean+jump overhead,
* and the function-local overhead currently otherwise 0 (I assume because the compiler can simply plug it in here).
*/
+
APPLY:
+ case OP_APPLY:
/* fprintf(stderr, "apply %s to %s\n", DISPLAY(sc->code), DISPLAY(sc->args)); */
switch (type(sc->code))
{
@@ -66005,24 +71321,20 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
case T_MACRO:
- if (is_expansion(sc->code))
- push_stack(sc, OP_EXPANSION, sc->nil, sc->nil);
- else push_stack(sc, OP_EVAL_MACRO, sc->nil, sc->nil);
+ /* this is not from the reader, so treat expansions here as normal macros */
+ push_stack(sc, OP_EVAL_MACRO, sc->nil, sc->nil);
new_frame(sc, closure_let(sc->code), sc->envir);
- apply_lambda(sc);
- goto BEGIN1;
+ goto APPLY_LAMBDA;
case T_BACRO:
push_stack(sc, OP_EVAL_MACRO, sc->nil, sc->nil);
new_frame(sc, sc->envir, sc->envir); /* like let* -- we'll be adding macro args, so might as well sequester things here */
- apply_lambda(sc);
- goto BEGIN1;
+ goto APPLY_LAMBDA;
case T_CLOSURE:
check_stack_size(sc);
new_frame(sc, closure_let(sc->code), sc->envir);
- apply_lambda(sc);
- goto BEGIN1;
+ goto APPLY_LAMBDA;
case T_MACRO_STAR:
push_stack(sc, OP_EVAL_MACRO, sc->nil, sc->nil);
@@ -66045,25 +71357,21 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
default:
return(apply_error(sc, sc->code, sc->args));
}
-
-
- case OP_APPLY: /* apply 'code' to 'args' */
- if (needs_copied_args(sc->code))
- sc->args = _TLst(copy_list(sc, sc->args));
- goto APPLY;
- /* (let ((lst '((1 2)))) (define (identity x) x) (cons (apply identity lst) lst)) */
-
-
+
+ APPLY_LAMBDA:
+ case OP_APPLY_LAMBDA:
+ apply_lambda(sc);
+ goto BEGIN1;
+
case OP_LAMBDA_STAR_DEFAULT:
/* sc->args is the current closure arg list position, sc->value is the default expression's value */
slot_set_value(sc->args, sc->value);
sc->args = slot_pending_value(sc->args);
if (lambda_star_default(sc) == goto_EVAL) goto EVAL;
pop_stack_no_op(sc);
- sc->code = _TLst(closure_body(sc->code));
+ sc->code = _TPair(closure_body(sc->code));
goto BEGIN1;
-
case OP_MACROEXPAND_1:
sc->args = _TLst(cdar(sc->code));
sc->code = sc->value;
@@ -66099,13 +71407,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
case T_MACRO:
new_frame(sc, closure_let(sc->code), sc->envir);
- apply_lambda(sc);
- goto BEGIN1;
+ goto APPLY_LAMBDA;
case T_BACRO:
new_frame(sc, sc->envir, sc->envir);
- apply_lambda(sc);
- goto BEGIN1;
+ goto APPLY_LAMBDA;
case T_MACRO_STAR:
new_frame(sc, closure_let(sc->code), sc->envir);
@@ -66123,19 +71429,17 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
eval_error(sc, "macroexpand argument is not a macro call: ~A", sc->args);
-
case OP_QUOTE:
case OP_QUOTE_UNCHECKED:
/* I think a quoted list in another list can be applied to a function, come here and
* be changed to unchecked, set-cdr! or something clobbers the argument so we get
- * here on the next time around with the equivalent of (quote . 0) so unchecked
- * quote needs more thought.
+ * here on the next time around with the equivalent of (quote . 0) if unchecked
+ * so set-cdr! of constant -- if marked immutable, we could catch this case and clear.
*/
- check_quote(sc);
+ check_quote(sc, sc->code);
sc->value = car(sc->code);
break;
-
case OP_DEFINE_FUNCHECKED:
define_funchecked(sc);
break;
@@ -66178,9 +71482,20 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
define2_ex(sc);
break;
+
+ case OP_EVAL_STRING_2:
+ s7_close_input_port(sc, sc->input_port);
+ pop_input_port(sc);
+ if (is_multiple_value(sc->value))
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+ break;
- /* -------------------------------- SET! -------------------------------- */
+ case OP_EVAL_STRING_1:
+ eval_string_1_ex(sc);
+ goto EVAL;
+
+ /* -------------------------------- SET! -------------------------------- */
case OP_SET_PAIR_P:
/* ([set!] (car a) (cadr a)) */
/* here the pair can't generate multiple values, or if it does, it's an error (caught below)
@@ -66194,19 +71509,17 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->code = cadr(sc->code);
goto EVAL;
-
case OP_SET_PAIR_Z:
push_stack_no_args(sc, OP_SET_PAIR_P_1, sc->code);
- sc->code = _TLst(cadr(sc->code));
- goto OPT_EVAL;
-
+ sc->code = _TPair(cadr(sc->code));
+ goto OPT_EVAL_CHECKED;
case OP_SET_PAIR_A:
{
s7_pointer obj, val;
obj = find_symbol_checked(sc, caar(sc->code));
- val = c_call(cdr(sc->code))(sc, cadr(sc->code)); /* this call can step on sc->Tx_x */
- set_car(sc->t2_1, cadar(sc->code)); /* might be a constant: (set! (mus-sound-srate "oboe.snd") 12345) */
+ val = c_call(cdr(sc->code))(sc, cadr(sc->code)); /* this call can step on sc->tx_x */
+ set_car(sc->t2_1, cadar(sc->code)); /* might be a constant: (set! (mus-sound-srate "oboe.snd") 12345) */
if (is_symbol(car(sc->t2_1)))
set_car(sc->t2_1, find_symbol_checked(sc, cadar(sc->code)));
set_car(sc->t2_2, val);
@@ -66218,7 +71531,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
push_stack_no_args(sc, OP_SET_PAIR_C_P_1, sc->code);
sc->code = cadr(sc->code);
goto EVAL;
-
case OP_SET_PAIR_C_P_1: /* code: ((name (+ i 1)) ...) for example, so cadar is the c_c expr and its args are cdr(cadar) */
sc->temp8 = sc->value;
@@ -66226,7 +71538,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto APPLY;
break;
-
case OP_SET_PAIR_C: /* ([set!] (name (+ len 1)) #\r) */
{
s7_pointer value;
@@ -66238,19 +71549,16 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
break;
-
case OP_SET_LET_S: /* (set! (*s7* 'print-length) i) */
- if (set_pair_p_3(sc, find_symbol(sc, caar(sc->code)), cadr(cadar(sc->code)), find_symbol_checked(sc, cadr(sc->code))))
+ if (set_pair_p_3(sc, find_symbol(sc, caar(sc->code)), cadr(cadar(sc->code)), find_symbol_unchecked(sc, cadr(sc->code))))
goto APPLY;
break;
-
case OP_SET_LET_ALL_X: /* (set! (hook 'result) 123) or (set! (H 'c) 32) */
if (set_pair_p_3(sc, find_symbol(sc, caar(sc->code)), cadr(cadar(sc->code)), c_call(cdr(sc->code))(sc, cadr(sc->code))))
goto APPLY;
break;
-
case OP_SET_PAIR_ZA: /* unknown setter pair, but value is easy */
sc->value = c_call(cdr(sc->code))(sc, cadr(sc->code));
/* fall through */
@@ -66276,6 +71584,71 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
break;
+ case OP_SET_DILAMBDA_Z:
+ push_stack_no_args(sc, OP_SET_DILAMBDA_Z_1, sc->code);
+ sc->code = _TPair(cadr(sc->code));
+ goto OPT_EVAL_CHECKED;
+
+ case OP_SET_DILAMBDA_Z_1:
+ {
+ s7_pointer obj, func, arg, value;
+ value = sc->value;
+
+ arg = cadar(sc->code);
+ if (is_symbol(arg))
+ arg = find_symbol_checked(sc, arg);
+ else
+ {
+ if (is_pair(arg))
+ arg = cadr(arg); /* can only be (quote ...) in this case */
+ }
+ obj = find_symbol(sc, caar(sc->code));
+ func = slot_value(obj);
+ if ((is_closure(func)) &&
+ (is_safe_closure(closure_setter(func))))
+ {
+ sc->code = closure_setter(func);
+ sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), arg, value);
+ sc->code = _TPair(closure_body(sc->code));
+ goto BEGIN1;
+ }
+ /* fallback on set-pair */
+ if (set_pair_p_3(sc, obj, arg, value))
+ goto APPLY;
+ }
+ break;
+
+ case OP_SET_DILAMBDA:
+ {
+ /* ([set!] (dilambda-setter g) s) */
+ s7_pointer obj, func, arg, value;
+ value = cadr(sc->code);
+ if (is_symbol(value))
+ value = find_symbol_checked(sc, value);
+
+ arg = cadar(sc->code);
+ if (is_symbol(arg))
+ arg = find_symbol_checked(sc, arg);
+ else
+ {
+ if (is_pair(arg))
+ arg = cadr(arg); /* can only be (quote ...) in this case */
+ }
+ obj = find_symbol(sc, caar(sc->code));
+ func = slot_value(obj);
+ if ((is_closure(func)) &&
+ (is_safe_closure(closure_setter(func))))
+ {
+ sc->code = closure_setter(func);
+ sc->envir = old_frame_with_two_slots(sc, closure_let(sc->code), arg, value);
+ sc->code = _TPair(closure_body(sc->code));
+ goto BEGIN1;
+ }
+ /* fallback on set-pair */
+ if (set_pair_p_3(sc, obj, arg, value))
+ goto APPLY;
+ }
+ break;
case OP_SET_PAIR:
{
@@ -66300,7 +71673,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto APPLY;
}
break;
-
/* this is (set! (getter) val) where getter is a global c_function (a built-in pws) and val is not a pair */
case OP_SET_PWS: /* (set! (mus-clipping) #f) */
@@ -66315,7 +71687,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
decrement_1_ex(sc);
break;
- #define SET_CASE(Op, Code) \
+ #define SET_CASE(Op, Code) \
case Op: \
{ \
s7_pointer lx; \
@@ -66328,42 +71700,43 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
SET_CASE(OP_SET_SYMBOL_C, slot_set_value(lx, cadr(sc->code)))
- SET_CASE(OP_SET_SYMBOL_Q, slot_set_value(lx, cadr(cadr(sc->code))))
+ SET_CASE(OP_SET_SYMBOL_Q, slot_set_value(lx, cadadr(sc->code)))
SET_CASE(OP_SET_SYMBOL_A, slot_set_value(lx, c_call(cdr(sc->code))(sc, cadr(sc->code))))
- SET_CASE(OP_SET_SYMBOL_S, slot_set_value(lx, find_symbol_checked(sc, cadr(sc->code))))
+ SET_CASE(OP_SET_SYMBOL_L, slot_set_value(lx, local_symbol_value(cadr(sc->code))))
+ SET_CASE(OP_SET_SYMBOL_S, slot_set_value(lx, find_symbol_unchecked(sc, cadr(sc->code))))
- SET_CASE(OP_SET_CONS, slot_set_value(lx, cons(sc, find_symbol_checked(sc, opt_sym2(sc->code)), slot_value(lx)))) /* ([set!] bindings (cons v bindings)) */
+ SET_CASE(OP_SET_CONS, slot_set_value(lx, cons(sc, find_symbol_unchecked(sc, opt_sym2(sc->code)), slot_value(lx)))) /* ([set!] bindings (cons v bindings)) */
SET_CASE(OP_SET_SYMBOL_opCq, slot_set_value(lx, c_call(cadr(sc->code))(sc, opt_pair2(sc->code))))
/* here we know the symbols do not have accessors, at least at optimization time */
SET_CASE(OP_SET_SYMBOL_opSq,
do { \
- set_car(sc->t1_1, find_symbol_checked(sc, opt_sym2(sc->code))); \
+ set_car(sc->t1_1, find_symbol_unchecked(sc, opt_sym2(sc->code))); \
slot_set_value(lx, c_call(cadr(sc->code))(sc, sc->t1_1)); \
} while (0))
SET_CASE(OP_SET_SYMBOL_opSSq,
do { \
- set_car(sc->t2_1, find_symbol_checked(sc, car(opt_pair2(sc->code)))); \
- set_car(sc->t2_2, find_symbol_checked(sc, cadr(opt_pair2(sc->code)))); \
+ set_car(sc->t2_1, find_symbol_unchecked(sc, car(opt_pair2(sc->code)))); \
+ set_car(sc->t2_2, find_symbol_unchecked(sc, cadr(opt_pair2(sc->code)))); \
slot_set_value(lx, c_call(cadr(sc->code))(sc, sc->t2_1)); \
} while (0))
SET_CASE(OP_SET_SYMBOL_opSSSq,
do { \
- set_car(sc->t3_1, find_symbol_checked(sc, car(opt_pair2(sc->code)))); \
- set_car(sc->t3_2, find_symbol_checked(sc, opt_sym1(opt_pair2(sc->code)))); \
- set_car(sc->t3_3, find_symbol_checked(sc, opt_sym2(opt_pair2(sc->code)))); \
+ set_car(sc->t3_1, find_symbol_unchecked(sc, car(opt_pair2(sc->code)))); \
+ set_car(sc->t3_2, find_symbol_unchecked(sc, opt_sym1(opt_pair2(sc->code)))); \
+ set_car(sc->t3_3, find_symbol_unchecked(sc, opt_sym2(opt_pair2(sc->code)))); \
slot_set_value(lx, c_call(cadr(sc->code))(sc, sc->t3_1)); \
} while (0))
SET_CASE(OP_INCREMENT_SS, /* ([set!] x (+ x i)) */
do { \
set_car(sc->t2_1, slot_value(lx)); \
- set_car(sc->t2_2, find_symbol_checked(sc, cadr(opt_pair2(sc->code)))); \
+ set_car(sc->t2_2, find_symbol_unchecked(sc, cadr(opt_pair2(sc->code)))); \
slot_set_value(lx, c_call(cadr(sc->code))(sc, sc->t2_1)); \
} while (0))
@@ -66371,8 +71744,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
do { \
s7_pointer x1; s7_pointer x2; s7_pointer x3; \
x1 = slot_value(lx); \
- x2 = find_symbol_checked(sc, opt_sym1(opt_pair2(sc->code))); \
- x3 = find_symbol_checked(sc, opt_sym2(opt_pair2(sc->code))); \
+ x2 = find_symbol_unchecked(sc, opt_sym1(opt_pair2(sc->code))); \
+ x3 = find_symbol_unchecked(sc, opt_sym2(opt_pair2(sc->code))); \
if ((is_t_real(x1)) && (is_t_real(x2)) && (is_t_real(x3))) \
slot_set_value(lx, make_real(sc, real(x1) + real(x2) + real(x3))); \
else { \
@@ -66400,7 +71773,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
slot_set_value(lx, c_call(cadr(sc->code))(sc, sc->a3_1)); \
} while (0))
-
case OP_SET_SAFE:
{
s7_pointer lx;
@@ -66416,13 +71788,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->code = cadr(sc->code);
goto EVAL;
-
case OP_SET_SYMBOL_Z:
/* ([set!] sum (+ sum n)) */
push_stack_no_args(sc, OP_SET_SAFE, car(sc->code));
- sc->code = _TLst(cadr(sc->code));
- goto OPT_EVAL;
-
+ sc->code = _TPair(cadr(sc->code));
+ goto OPT_EVAL_CHECKED;
case OP_INCREMENT_SZ:
{
@@ -66431,8 +71801,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (is_slot(sym))
{
push_stack(sc, OP_INCREMENT_SZ_1, sym, sc->code);
- sc->code = _TLst(opt_pair2(sc->code)); /* caddr(cadr(sc->code)); */
- goto OPT_EVAL;
+ sc->code = _TPair(opt_pair2(sc->code)); /* caddr(cadr(sc->code)); */
+ goto OPT_EVAL_CHECKED;
}
eval_type_error(sc, "set! ~A: unbound variable", sc->code);
}
@@ -66444,7 +71814,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
slot_set_value(sc->args, sc->value);
break;
-
case OP_SET2:
if (is_pair(sc->value))
{
@@ -66500,7 +71869,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
/* fall through */
-
case OP_SET: /* entry for set! */
check_set(sc);
@@ -66533,7 +71901,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->code = car(sc->code);
}
-
case OP_SET1:
{
s7_pointer lx;
@@ -66577,46 +71944,77 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_SET_WITH_ACCESSOR:
if (sc->value == sc->error_symbol) /* backwards compatibility... */
- return(s7_error(sc, sc->error_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't set ~S"), sc->args)));
+ return(s7_error(sc, sc->error_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't set ~S"), sc->code)));
slot_set_value(sc->code, sc->value);
break;
case OP_SET_WITH_LET_1:
- /* here sc->value is the new value for the settee, args has the (as yet unevaluated) let and settee-expression. */
- /* fprintf(stderr, "with_let_1: %s %s %s\n", DISPLAY(sc->value), DISPLAY(sc->code), DISPLAY(sc->args)); */
- if (is_symbol(car(sc->args)))
- {
- s7_pointer p;
- p = list_2(sc, cadr(sc->args), sc->value);
- sc->value = find_symbol_checked(sc, car(sc->args));
- sc->args = p;
- /* fall through */
- }
- else
- {
- sc->code = car(sc->args);
- sc->args = list_2(sc, cadr(sc->args), sc->value);
- push_stack(sc, OP_SET_WITH_LET_2, sc->args, sc->code);
- goto EVAL;
- }
+ {
+ s7_pointer e, b, x;
+ /* from the T_SYNTAX branch of set_pair_ex: (set! (with-let e b) x) as in let-temporarily
+ * here sc->value is the new value for the settee = x, args has the (as yet unevaluated) let and settee-expression.
+ * 'b above can be a pair = generalized set in the 'e environment.
+ */
+ if (!is_pair(sc->args)) /* (set! (with-let) ...) */
+ eval_error(sc, "set! (with-let)? ~A", sc->cur_code);
+ if (!is_pair(cdr(sc->args))) /* (set! (with-let e) ...) */
+ eval_error(sc, "set! (with-let ...) has no symbol to set? ~A", sc->cur_code);
+ e = car(sc->args);
+ b = cadr(sc->args);
+ x = sc->value;
+ if (is_symbol(e))
+ {
+ if (is_symbol(b))
+ {
+ e = find_symbol_checked(sc, e); /* the let */
+ if (!is_let(e))
+ return(wrong_type_argument_with_type(sc, sc->let_set_symbol, 1, e, a_let_string));
+ sc->value = let_set_1(sc, e, b, x);
+ goto START;
+ }
+ sc->value = find_symbol_checked(sc, e);
+ sc->code = list_2(sc, b, ((is_symbol(x)) || (is_pair(x))) ? set_plist_2(sc, sc->quote_symbol, x) : x);
+ goto SET_WITH_LET;
+ }
+ else
+ {
+ sc->code = e; /* 'e above, an expression we need to evaluate */
+ sc->args = list_2(sc, b, x); /* can't reuse sc->args here via set-car! etc */
+ push_stack(sc, OP_SET_WITH_LET_2, sc->args, sc->code);
+ goto EVAL;
+ }
+ }
case OP_SET_WITH_LET_2:
- /* fprintf(stderr, "with_let_2: value: %s, code: %s, args: %s\n", DISPLAY(sc->value), DISPLAY(sc->code), DISPLAY(sc->args)); */
- if (is_symbol(car(sc->args)))
+ {
+ s7_pointer b, x;
+ /* here sc->value = let = 'e, args = '(b x) where 'b might be a pair */
+ if (!is_let(sc->value))
+ return(wrong_type_argument_with_type(sc, sc->let_set_symbol, 1, sc->value, a_let_string));
+ b = car(sc->args);
+ x = cadr(sc->args);
+ if (is_symbol(b)) /* b is a symbol -- everything else is ready so call let-set! */
+ {
+ sc->value = let_set_1(sc, sc->value, b, x);
+ goto START;
+ }
+ if ((is_symbol(x)) || (is_pair(x)))
+ sc->code = list_2(sc, b, ((is_symbol(x)) || (is_pair(x))) ? set_plist_2(sc, sc->quote_symbol, x) : x);
+ else sc->code = sc->args;
+ }
+
+ SET_WITH_LET:
+ activate_let(sc, sc->value); /* this activates sc->value, so the set! will happen in that environment */
+ if (is_pair(car(sc->code)))
{
- let_set_1(sc, sc->value, car(sc->args), cadr(sc->args));
- sc->value = cadr(sc->args);
- goto START;
+ int choice;
+ choice = set_pair_ex(sc);
+ if (choice == goto_EVAL) goto EVAL;
+ if (choice == goto_START) goto START;
+ if (choice == goto_APPLY) goto APPLY;
+ goto EVAL_ARGS;
}
-
- /* avoid double evaluation */
- if ((is_symbol(cadr(sc->args))) ||
- (is_pair(cadr(sc->args))))
- sc->code = cons(sc, sc->set_symbol, list_2(sc, car(sc->args), list_2(sc, sc->quote_symbol, cadr(sc->args))));
- else sc->code = cons(sc, sc->set_symbol, sc->args);
- activate_let(sc); /* this activates sc->value, so the set! will happen in that environment */
- goto EVAL;
-
+ return(s7_error(sc, sc->error_symbol, set_elist_2(sc, make_string_wrapper(sc, "can't set ~S"), sc->args)));
/* -------------------------------- IF -------------------------------- */
@@ -66631,7 +72029,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 car(sc->nil) = sc->unspecified */
+ else sc->code = cadr(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))
@@ -66639,119 +72037,155 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
else sc->value = sc->code;
break;
-
- #define IF_CASE(Op, Code) \
+ /* adding if*_z and if*_z_z made no difference */
+ #define IF_CASE(Op, Code, Not_Code) \
case Op ## _P: Code {sc->code = cadr(sc->code); goto EVAL;} else {sc->value = sc->unspecified; goto START;} \
- case Op ## _P_P: Code {sc->code = cadr(sc->code); goto EVAL;} else {sc->code = caddr(sc->code); goto EVAL;}
+ case Op ## _R: Code {sc->value = sc->unspecified; goto START;} else {sc->code = cadr(sc->code); goto EVAL;} \
+ case Op ## _P_P: Code {sc->code = cadr(sc->code); goto EVAL;} else {sc->code = caddr(sc->code); goto EVAL;} \
+ case Op ## _N: Not_Code {sc->code = cadr(sc->code); goto EVAL;} else {sc->value = sc->unspecified; goto START;} \
+ case Op ## _N_N: Not_Code {sc->code = cadr(sc->code); goto EVAL;} else {sc->code = caddr(sc->code); goto EVAL;}
- IF_CASE(OP_IF_S, if (is_true(sc, find_symbol_checked(sc, car(sc->code)))))
-
- IF_CASE(OP_IF_NOT_S, if (is_false(sc, find_symbol_checked(sc, opt_sym2(sc->code)))))
-
- IF_CASE(OP_IF_A, if (is_true(sc, c_call(sc->code)(sc, car(sc->code)))))
-
- IF_CASE(OP_IF_CC, if (is_true(sc, c_call(car(sc->code))(sc, opt_pair2(sc->code)))))
+ IF_CASE(OP_IF_S,
+ if (is_true(sc, find_symbol_unchecked(sc, car(sc->code)))),
+ if (is_false(sc, find_symbol_unchecked(sc, cadar(sc->code)))))
- IF_CASE(OP_IF_IS_PAIR, if (is_pair(find_symbol_checked(sc, opt_sym2(sc->code)))))
+ IF_CASE(OP_IF_A,
+ if (is_true(sc, c_call(sc->code)(sc, car(sc->code)))),
+ if (is_false(sc, c_call(cdar(sc->code))(sc, cadar(sc->code)))))
+
+ 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_SYMBOL, if (is_symbol(find_symbol_checked(sc, opt_sym2(sc->code)))))
-
- IF_CASE(OP_IF_CS, set_car(sc->t1_1, find_symbol_checked(sc, opt_sym2(sc->code))); \
- if (is_true(sc, c_call(car(sc->code))(sc, sc->t1_1))))
+ 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_CSQ, set_car(sc->t2_1, find_symbol_checked(sc, opt_sym3(sc->code))); \
- set_car(sc->t2_2, opt_con2(sc->code)); \
- if (is_true(sc, c_call(car(sc->code))(sc, sc->t2_1))))
+ 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_CSS, set_car(sc->t2_1, find_symbol_checked(sc, opt_sym3(sc->code))); \
- set_car(sc->t2_2, find_symbol_checked(sc, opt_sym2(sc->code)));
- if (is_true(sc, c_call(car(sc->code))(sc, sc->t2_1))))
+ 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))),
+ set_car(sc->t1_1, find_symbol_unchecked(sc, opt_sym2(sc->code))); if (is_false(sc, c_call(cadar(sc->code))(sc, sc->t1_1))))
- IF_CASE(OP_IF_CSC, set_car(sc->t2_1, find_symbol_checked(sc, opt_sym3(sc->code))); \
- set_car(sc->t2_2, opt_con2(sc->code)); \
- if (is_true(sc, c_call(car(sc->code))(sc, sc->t2_1))))
+ IF_CASE(OP_IF_CSQ,
+ set_car(sc->t2_1, find_symbol_unchecked(sc, opt_sym3(sc->code))); \
+ set_car(sc->t2_2, opt_con2(sc->code)); \
+ if (is_true(sc, c_call(car(sc->code))(sc, sc->t2_1))),
+ set_car(sc->t2_1, find_symbol_unchecked(sc, opt_sym3(sc->code))); \
+ set_car(sc->t2_2, opt_con2(sc->code)); \
+ if (is_false(sc, c_call(cadar(sc->code))(sc, sc->t2_1))))
- IF_CASE(OP_IF_S_opCq, set_car(sc->t2_2, c_call(opt_pair2(sc->code))(sc, cdr(opt_pair2(sc->code)))); \
- set_car(sc->t2_1, find_symbol_checked(sc, opt_sym3(sc->code))); \
- if (is_true(sc, c_call(car(sc->code))(sc, sc->t2_1))))
-
- IF_CASE(OP_IF_opSSq, {s7_pointer args; s7_pointer val1; \
- args = opt_pair2(sc->code); \
- val1 = find_symbol_checked(sc, cadr(args)); \
- set_car(sc->t2_2, find_symbol_checked(sc, opt_sym3(sc->code))); \
- set_car(sc->t2_1, val1); \
- set_car(sc->t1_1, c_call(args)(sc, sc->t2_1));} \
- if (is_true(sc, c_call(car(sc->code))(sc, sc->t1_1))))
+ IF_CASE(OP_IF_CSS,
+ set_car(sc->t2_1, find_symbol_unchecked(sc, opt_sym3(sc->code))); \
+ set_car(sc->t2_2, find_symbol_unchecked(sc, opt_sym2(sc->code)));
+ if (is_true(sc, c_call(car(sc->code))(sc, sc->t2_1))),
+ set_car(sc->t2_1, find_symbol_unchecked(sc, opt_sym3(sc->code))); \
+ set_car(sc->t2_2, find_symbol_unchecked(sc, opt_sym2(sc->code)));
+ if (is_false(sc, c_call(cadar(sc->code))(sc, sc->t2_1))))
- 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)))))))
+ IF_CASE(OP_IF_CSC,
+ set_car(sc->t2_1, find_symbol_unchecked(sc, opt_sym3(sc->code))); \
+ set_car(sc->t2_2, opt_con2(sc->code)); \
+ if (is_true(sc, c_call(car(sc->code))(sc, sc->t2_1))),
+ set_car(sc->t2_1, find_symbol_unchecked(sc, opt_sym3(sc->code))); \
+ set_car(sc->t2_2, opt_con2(sc->code)); \
+ if (is_false(sc, c_call(cadar(sc->code))(sc, sc->t2_1))))
+ IF_CASE(OP_IF_S_opCq,
+ set_car(sc->t2_2, c_call(opt_pair2(sc->code))(sc, cdr(opt_pair2(sc->code)))); \
+ set_car(sc->t2_1, find_symbol_unchecked(sc, opt_sym3(sc->code))); \
+ if (is_true(sc, c_call(car(sc->code))(sc, sc->t2_1))),
+ set_car(sc->t2_2, c_call(opt_pair2(sc->code))(sc, cdr(opt_pair2(sc->code)))); \
+ set_car(sc->t2_1, find_symbol_unchecked(sc, opt_sym3(sc->code))); \
+ if (is_false(sc, c_call(cadar(sc->code))(sc, sc->t2_1))))
+
+ IF_CASE(OP_IF_opSq,
+ set_car(sc->t1_1, find_symbol_unchecked(sc, opt_sym3(sc->code))); \
+ set_car(sc->t1_1, c_call(opt_pair2(sc->code))(sc, sc->t1_1)); \
+ if (is_true(sc, c_call(car(sc->code))(sc, sc->t1_1))),
+ set_car(sc->t1_1, find_symbol_unchecked(sc, opt_sym3(sc->code))); \
+ set_car(sc->t1_1, c_call(opt_pair2(sc->code))(sc, sc->t1_1)); \
+ if (is_false(sc, c_call(cadar(sc->code))(sc, sc->t1_1))))
- case OP_IF_P_P:
- push_stack_no_args(sc, OP_IF_PP, cadr(sc->code));
- sc->code = car(sc->code);
- goto EVAL;
+ 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)))))),
+ 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)))))))
+
+ 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)))))),
+ 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)))))))
+
+ 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;
+ case OP_IF_P_R: push_stack_no_args(sc, OP_IF_PR, cadr(sc->code)); sc->code = car(sc->code); goto EVAL;
+ case OP_IF_P_P_P: push_stack_no_args(sc, OP_IF_PPP, cdr(sc->code)); sc->code = car(sc->code); goto EVAL;
+ case OP_IF_P_N_N: push_stack_no_args(sc, OP_IF_PRR, cdr(sc->code)); sc->code = cadar(sc->code); goto EVAL;
- case OP_IF_P_P_P:
- push_stack_no_args(sc, OP_IF_PPP, cdr(sc->code));
- sc->code = car(sc->code);
- goto EVAL;
-
-
- case OP_IF_Z_P:
- push_stack_no_args(sc, OP_IF_PP, opt_con2(sc->code));
- sc->code = _TLst(car(sc->code));
- goto OPT_EVAL;
-
- case OP_IF_Z_P_P:
- push_stack_no_args(sc, OP_IF_PPP, cdr(sc->code));
- sc->code = _TLst(car(sc->code));
- goto OPT_EVAL;
+ case OP_IF_Z_P: push_stack_no_args(sc, OP_IF_PP, cadr(sc->code)); sc->code = _TPair(car(sc->code)); goto OPT_EVAL;
+ case OP_IF_Z_N: push_stack_no_args(sc, OP_IF_PR, cadr(sc->code)); sc->code = cadar(sc->code); goto OPT_EVAL;
+ case OP_IF_Z_R: push_stack_no_args(sc, OP_IF_PR, cadr(sc->code)); sc->code = _TPair(car(sc->code)); goto OPT_EVAL;
+ case OP_IF_Z_P_P: push_stack_no_args(sc, OP_IF_PPP, cdr(sc->code)); sc->code = _TPair(car(sc->code)); goto OPT_EVAL;
+ case OP_IF_Z_N_N: push_stack_no_args(sc, OP_IF_PRR, cdr(sc->code)); sc->code = cadar(sc->code); goto OPT_EVAL;
+ case OP_IF_ANDP_P: push_stack_no_args(sc, OP_IF_PP, cadr(sc->code)); sc->code = cdar(sc->code); goto AND_P;
+ case OP_IF_ANDP_N: push_stack_no_args(sc, OP_IF_PR, cadr(sc->code)); sc->code = cdadar(sc->code); goto AND_P;
+ case OP_IF_ANDP_R: push_stack_no_args(sc, OP_IF_PR, cadr(sc->code)); sc->code = cdar(sc->code); goto AND_P;
+ case OP_IF_ANDP_P_P: push_stack_no_args(sc, OP_IF_PPP, cdr(sc->code)); sc->code = cdar(sc->code); goto AND_P;
+ case OP_IF_ANDP_N_N: push_stack_no_args(sc, OP_IF_PRR, cdr(sc->code)); sc->code = cdadar(sc->code); goto AND_P;
- case OP_IF_ANDP_P:
- push_stack_no_args(sc, OP_IF_PP, cadr(sc->code));
- sc->code = cdar(sc->code);
- goto AND_P;
-
- case OP_IF_ANDP_P_P:
- push_stack_no_args(sc, OP_IF_PPP, cdr(sc->code));
- sc->code = cdar(sc->code);
- goto AND_P;
-
-
- case OP_IF_ORP_P:
- push_stack_no_args(sc, OP_IF_PP, cadr(sc->code));
- sc->code = cdar(sc->code);
- goto OR_P;
-
- case OP_IF_ORP_P_P:
- push_stack_no_args(sc, OP_IF_PPP, cdr(sc->code));
- sc->code = cdar(sc->code);
- goto OR_P;
-
+ case OP_IF_ORP_P: push_stack_no_args(sc, OP_IF_PP, cadr(sc->code)); sc->code = cdar(sc->code); goto OR_P;
+ case OP_IF_ORP_N: push_stack_no_args(sc, OP_IF_PR, cadr(sc->code)); sc->code = cdadar(sc->code); goto OR_P;
+ case OP_IF_ORP_R: push_stack_no_args(sc, OP_IF_PR, cadr(sc->code)); sc->code = cdar(sc->code); goto OR_P;
+ case OP_IF_ORP_P_P: push_stack_no_args(sc, OP_IF_PPP, cdr(sc->code)); sc->code = cdar(sc->code); goto OR_P;
+ case OP_IF_ORP_N_N: push_stack_no_args(sc, OP_IF_PRR, cdr(sc->code)); sc->code = cdadar(sc->code); goto OR_P;
+ case OP_IF_PP:
+ if (is_true(sc, sc->value))
+ goto EVAL;
+ sc->value = sc->unspecified;
+ break;
+
case OP_IF_PPP:
if (is_true(sc, sc->value))
sc->code = car(sc->code);
else sc->code = cadr(sc->code);
goto EVAL;
-
- case OP_IF_PP:
- if (is_true(sc, sc->value))
+ case OP_IF_PR:
+ if (is_false(sc, sc->value))
goto EVAL;
sc->value = sc->unspecified;
break;
+
+ case OP_IF_PRR:
+ if (is_false(sc, sc->value))
+ sc->code = car(sc->code);
+ else sc->code = cadr(sc->code);
+ goto EVAL;
+ case OP_WHEN_PP:
+ if (is_true(sc, sc->value))
+ goto BEGIN1;
+ sc->value = sc->unspecified;
+ break;
- case OP_IF_P_FEED:
- /* actually cond right now: (cond (expr => p)) where p is (lambda (s) ...) -- see check_cond */
- push_stack_no_args(sc, OP_IF_P_FEED_1, sc->code);
+ case OP_COND_FEED:
+ /* (cond (expr => p)) where p is (lambda (s) ...) -- see check_cond */
+ push_stack_no_args(sc, OP_COND_FEED_1, sc->code);
sc->code = caar(sc->code);
goto EVAL;
- case OP_IF_P_FEED_1:
+ case OP_COND_FEED_1:
if (is_true(sc, sc->value))
{
if (is_multiple_value(sc->value))
@@ -66763,10 +72197,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
goto EVAL;
}
- sc->value = sc->nil; /* since it's actually cond -- perhaps push as sc->args above */
+ sc->value = sc->unspecified; /* it's cond -- perhaps push as sc->args above; this was nil until 21-Feb-17! */
break;
-
case OP_WHEN:
check_when(sc);
@@ -66776,20 +72209,34 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto EVAL;
case OP_WHEN1:
- if (is_true(sc, sc->value)) goto BEGIN1;
+ if (is_true(sc, sc->value))
+ goto BEGIN1;
sc->value = sc->unspecified;
break;
case OP_WHEN_S:
- if (is_true(sc, find_symbol_checked(sc, car(sc->code))))
+ if (is_true(sc, find_symbol_unchecked(sc, car(sc->code))))
{
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
}
sc->value = sc->unspecified;
break;
-
+ case OP_WHEN_A:
+ if (is_true(sc, c_call(sc->code)(sc, car(sc->code))))
+ {
+ sc->code = _TPair(cdr(sc->code));
+ goto BEGIN1;
+ }
+ sc->value = sc->unspecified;
+ break;
+
+ case OP_WHEN_P:
+ push_stack_no_args(sc, OP_WHEN_PP, cdr(sc->code));
+ sc->code = car(sc->code);
+ goto EVAL;
+
case OP_UNLESS:
check_unless(sc);
@@ -66799,25 +72246,59 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto EVAL;
case OP_UNLESS1:
- if (is_false(sc, sc->value)) goto BEGIN1;
+ if (is_false(sc, sc->value))
+ goto BEGIN1;
sc->value = sc->unspecified;
break;
case OP_UNLESS_S:
- if (is_false(sc, find_symbol_checked(sc, car(sc->code))))
+ if (is_false(sc, find_symbol_unchecked(sc, car(sc->code))))
{
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
}
sc->value = sc->unspecified;
break;
+ case OP_UNLESS_A:
+ if (is_false(sc, c_call(sc->code)(sc, car(sc->code))))
+ {
+ sc->code = _TPair(cdr(sc->code));
+ goto BEGIN1;
+ }
+ sc->value = sc->unspecified;
+ break;
case OP_SAFE_C_P_1:
set_car(sc->t1_1, sc->value);
sc->value = c_call(sc->code)(sc, sc->t1_1);
break;
+ case OP_NOT_P_1:
+ sc->value = ((sc->value == sc->F) ? sc->T : sc->F);
+ break;
+
+ case OP_SAFE_CLOSURE_P_1:
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(sc->code)), sc->value);
+ sc->code = _TPair(closure_body(opt_lambda(sc->code)));
+ goto BEGIN1;
+
+ case OP_SAFE_CLOSURE_AP_1:
+ sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(sc->code)), sc->args, sc->value);
+ sc->code = _TPair(closure_body(opt_lambda(sc->code)));
+ goto BEGIN1;
+
+ case OP_SAFE_CLOSURE_PA_1:
+ sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(sc->code)), sc->value, sc->args);
+ sc->code = _TPair(closure_body(opt_lambda(sc->code)));
+ goto BEGIN1;
+
+ case OP_CLOSURE_P_1:
+ check_stack_size(sc);
+ sc->code = opt_lambda(sc->code);
+ new_frame_with_slot(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value);
+ sc->code = _TPair(closure_body(sc->code));
+ goto BEGIN1;
case OP_SAFE_C_PP_1:
/* unless multiple values from last call (first arg), sc->args == sc->nil because we pushed that.
@@ -66882,7 +72363,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->code = c_function_base(opt_cfunc(sc->code));
goto APPLY;
-
case OP_C_P_1:
sc->value = c_call(sc->code)(sc, list_1(sc, sc->value));
break;
@@ -66893,73 +72373,101 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->args = copy_list(sc, sc->value);
goto APPLY;
-
- case OP_SAFE_CLOSURE_P_1:
- sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(sc->code)), sc->value);
- sc->code = _TLst(closure_body(opt_lambda(sc->code)));
+ case OP_CLOSURE_AP_1:
+ /* sc->value is presumably the "P" argument value, "S" 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,
+ car(closure_args(sc->code)), sc->args, cadr(closure_args(sc->code)), sc->value);
+ sc->code = _TPair(closure_body(sc->code));
goto BEGIN1;
- case OP_CLOSURE_P_1:
- /* sc->value is presumably the argument value */
+ case OP_CLOSURE_AP_MV: /* here we got multiple values */
+ sc->code = opt_lambda(sc->code);
+ sc->args = cons(sc, sc->args, copy_list(sc, sc->value));
+ goto APPLY;
+
+ case OP_CLOSURE_PA_1:
check_stack_size(sc);
sc->code = opt_lambda(sc->code);
- new_frame_with_slot(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value);
- sc->code = _TLst(closure_body(sc->code));
+ new_frame_with_two_slots(sc, closure_let(sc->code), sc->envir,
+ car(closure_args(sc->code)), sc->value, cadr(closure_args(sc->code)), sc->args);
+ sc->code = _TPair(closure_body(sc->code));
goto BEGIN1;
- case OP_CLOSURE_P_2:
- /* here we got multiple values */
+ case OP_CLOSURE_PA_MV:
sc->code = opt_lambda(sc->code);
- sc->args = copy_list(sc, sc->value);
+ sc->args = s7_append(sc, copy_list(sc, sc->value), cons(sc, sc->args, sc->nil));
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;
- case OP_C_SP_1:
+ case OP_C_AP_1:
sc->value = c_call(sc->code)(sc, list_2(sc, sc->args, sc->value));
break;
- case OP_C_SP_2:
- /* op_c_sp_1 -> mv case: (map + (values '(1 2 3) #(1 2 3))) */
+ 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);
- sc->code = _TLst(cdr(sc->code)); /* ignore the () */
+ sc->code = _TPair(cdr(sc->code)); /* ignore the () */
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 = _TLst(cddr(sc->code));
+ sc->code = _TPair(cddr(sc->code));
goto BEGIN1;
-
case OP_LET_C:
- /* one var, init is constant, incoming sc->code is '(((var val))...)! */
- new_frame_with_slot(sc, sc->envir, sc->envir, opt_sym3(sc->code), opt_con2(sc->code));
- sc->code = _TLst(cdr(sc->code));
- goto BEGIN1;
+ {
+ /* one var, init is constant, incoming sc->code is '(((var val))...)!
+ * somehow we can get here from make-hook (let ((result #<unspecified>))...) with opt_sym3 and opt_con2 unset??
+ * opt_sym3 can be clobbered by a subsequent opt_back apparently??
+ */
+ s7_pointer binding;
+ binding = _TPair(caar(sc->code));
+ new_frame_with_slot(sc, sc->envir, sc->envir, car(binding), cadr(binding));
+ sc->code = _TPair(cdr(sc->code));
+ goto BEGIN1;
+ }
case OP_LET_S:
+ {
/* one var, init is symbol, incoming sc->code is '(((var sym))...) */
- sc->value = find_symbol_checked(sc, opt_sym2(sc->code));
- new_frame_with_slot(sc, sc->envir, sc->envir, opt_sym3(sc->code), sc->value);
- sc->code = _TLst(cdr(sc->code));
- goto BEGIN1;
+ s7_pointer binding;
+ binding = _TPair(caar(sc->code));
+ sc->value = find_symbol_checked(sc, cadr(binding));
+ new_frame_with_slot(sc, sc->envir, sc->envir, car(binding), sc->value);
+ sc->code = _TPair(cdr(sc->code));
+ goto BEGIN1;
+ }
+ case OP_LET_S_Z:
+ {
+ s7_pointer binding;
+ binding = _TPair(caar(sc->code));
+ sc->value = find_symbol_checked(sc, cadr(binding));
+ new_frame_with_slot(sc, sc->envir, sc->envir, car(binding), sc->value);
+ sc->code = _TPair(cadr(sc->code));
+ goto OPT_EVAL_CHECKED;
+ }
case OP_LET_opSq:
{
s7_pointer binding;
binding = _TPair(caar(sc->code));
- set_car(sc->t1_1, find_symbol_checked(sc, opt_sym2(sc->code)));
+ 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));
@@ -66967,69 +72475,107 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto EVAL;
}
+ case OP_LET_CAR:
+ {
+ s7_pointer binding, val;
+ binding = _TPair(caar(sc->code));
+ 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));
+ sc->code = cadr(sc->code);
+ goto EVAL;
+ }
case OP_LET_opSq_P:
{
s7_pointer binding;
binding = _TPair(caar(sc->code));
- set_car(sc->t1_1, find_symbol_checked(sc, opt_sym2(sc->code)));
+ 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);
sc->code = cadr(sc->code);
goto EVAL;
}
-
- case OP_LET_opCq: /* one var, init is safe_c_c */
-#if DEBUGGING
- {
- s7_pointer old_code, old_env; /* trying to define lots of Snd function safe -- they crash here if they aren't actually safe */
- old_code = sc->code; /* so, add a bandage while I track them down... */
- old_env = sc->envir;
- sc->value = c_call(opt_pair2(sc->code))(sc, cdr(opt_pair2(sc->code)));
- if ((sc->code != old_code) ||
- (sc->envir != old_env))
- fprintf(stderr, "something changed: %s -> %s, %s -> %s\n",
- DISPLAY(old_code), DISPLAY(sc->code),
- DISPLAY(old_env), DISPLAY(sc->envir));
- new_frame_with_slot(sc, sc->envir, sc->envir, opt_sym3(old_code), sc->value);
- sc->code = _TLst(cdr(old_code));
- goto BEGIN1;
- }
-#else
+ case OP_LET_opCq: /* one var, init is safe_c_c */
sc->value = c_call(opt_pair2(sc->code))(sc, cdr(opt_pair2(sc->code)));
new_frame_with_slot(sc, sc->envir, sc->envir, opt_sym3(sc->code), sc->value);
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
-#endif
-
- case OP_LET_opSSq: /* one var, init is safe_c_ss */
+ case OP_LET_opSSq: /* one var, init is safe_c_ss */
{
s7_pointer largs, in_val;
- largs = _TPair(opt_pair2(sc->code)); /* cadr(caar(sc->code)); */
- in_val = find_symbol_checked(sc, cadr(largs));
- set_car(sc->t2_2, find_symbol_checked(sc, opt_sym3(sc->code))); /* caddr(largs)); */
+ largs = _TPair(opt_pair2(sc->code)); /* cadr(caar(sc->code)); */
+ in_val = find_symbol_unchecked(sc, cadr(largs));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, opt_sym3(sc->code))); /* caddr(largs)); */
set_car(sc->t2_1, in_val);
sc->value = c_call(largs)(sc, sc->t2_1);
new_frame_with_slot(sc, sc->envir, sc->envir, caaar(sc->code), sc->value);
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
}
+
+ case OP_LET_opSSq_E:
+ {
+ s7_pointer largs, in_val;
+ largs = _TPair(opt_pair2(sc->code)); /* cadr(caar(sc->code)); */
+ in_val = find_symbol_unchecked(sc, cadr(largs));
+ set_car(sc->t2_2, find_symbol_unchecked(sc, opt_sym3(sc->code))); /* caddr(largs)); */
+ set_car(sc->t2_1, in_val);
+ sc->value = c_call(largs)(sc, sc->t2_1);
+ new_frame_with_slot(sc, sc->envir, sc->envir, caaar(sc->code), sc->value);
+ sc->code = cadr(sc->code);
+ goto EVAL;
+ }
+ case OP_LET_opaSSq_E:
+ {
+ s7_pointer in_val, lst;
+ in_val = find_symbol_unchecked(sc, cadr(opt_pair2(sc->code)));
+ lst = find_symbol_unchecked(sc, opt_sym3(sc->code));
+ if (is_pair(lst))
+ sc->value = s7_assq(sc, in_val, lst);
+ else
+ {
+ if (is_null(lst))
+ sc->value = sc->F;
+ else sc->value = g_assq(sc, set_plist_2(sc, in_val, lst));
+ }
+ new_frame_with_slot(sc, sc->envir, sc->envir, caaar(sc->code), sc->value);
+ sc->code = cadr(sc->code);
+ goto EVAL;
+ }
case OP_LET_Z:
push_stack(sc, OP_LET_Z_1, opt_sym2(cdr(sc->code)), cadr(sc->code));
- sc->code = _TLst(opt_pair2(sc->code));
+ sc->code = _TPair(opt_pair2(sc->code));
goto OPT_EVAL;
case OP_LET_Z_1:
new_frame_with_slot(sc, sc->envir, sc->envir, sc->args, sc->value);
goto EVAL;
+ case OP_LET_A:
+ {
+ s7_pointer binding;
+ binding = caar(sc->code);
+ new_frame_with_slot(sc, sc->envir, sc->envir, car(binding), c_call(cdr(binding))(sc, cadr(binding)));
+ sc->code = cadr(sc->code);
+ goto EVAL;
+ }
+
+ case OP_LET_A_Z:
+ {
+ s7_pointer binding;
+ binding = caar(sc->code);
+ new_frame_with_slot(sc, sc->envir, sc->envir, car(binding), c_call(cdr(binding))(sc, cadr(binding)));
+ sc->code = cadr(sc->code);
+ goto OPT_EVAL_CHECKED;
+ }
- case OP_LET_ONE:
- /* one var */
+ case OP_LET_ONE: /* one var */
{
s7_pointer p;
p = caar(sc->code);
@@ -67042,7 +72588,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
if (is_symbol(sc->value))
sc->value = find_symbol_checked(sc, sc->value);
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
sc->args = car(p);
/* drop through */
}
@@ -67051,18 +72597,16 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
new_frame_with_slot(sc, sc->envir, sc->envir, sc->args, sc->value);
goto BEGIN1;
-
case OP_LET_ALL_C:
{
s7_pointer p;
new_frame(sc, sc->envir, sc->envir);
for (p = car(sc->code); is_pair(p); p = cdr(p))
add_slot(sc->envir, caar(p), cadar(p));
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
}
-
case OP_LET_ALL_S:
/* n vars, all inits are symbols. We need to GC-protect the new frame-list as it is being
* created without tying the new frame into sc->envir until the end.
@@ -67075,11 +72619,10 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
add_slot(frame, caar(p), find_symbol_checked(sc, cadar(p)));
sc->let_number++;
sc->envir = frame;
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
}
-
case OP_LET_ALL_opSq:
{
s7_pointer p, frame;
@@ -67089,12 +72632,12 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
s7_pointer cp;
cp = cadar(p);
- set_car(sc->t1_1, find_symbol_checked(sc, cadr(cp)));
+ set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(cp)));
add_slot(frame, caar(p), c_call(cp)(sc, sc->t1_1));
}
sc->let_number++;
sc->envir = frame;
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
}
@@ -67102,6 +72645,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
* on every call here, but the savings in GC+allocation+setup is less than the cost in
* marking the saved stuff past its actual life! (If the code is removed from the heap,
* the frame has to be saved on the permanent_objects list).
+ * But if all lookups are local, no frame/slots are needed.
*/
case OP_LET_ALL_X:
{
@@ -67117,18 +72661,16 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
sc->let_number++;
sc->envir = frame;
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
}
-
case OP_NAMED_LET:
sc->args = sc->nil;
sc->value = sc->code;
sc->code = cadr(sc->code);
goto LET1;
-
case OP_LET_UNCHECKED:
/* not named, but has vars */
{
@@ -67141,7 +72683,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto LET1A;
}
-
case OP_LET:
/* sc->code is everything after the let: (let ((a 1)) a) so sc->code is (((a 1)) a) */
/* car can be either a list or a symbol ("named let") */
@@ -67161,13 +72702,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
sc->x = make_closure(sc, sc->nil, cddr(sc->code), T_CLOSURE); /* 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_function_env(closure_let(sc->x));
+ 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 = _TLst(cddr(sc->code));
+ sc->code = _TPair(cddr(sc->code));
sc->x = sc->nil;
}
- else sc->code = _TLst(cdr(sc->code));
+ else sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
}
}
@@ -67211,7 +72752,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->code = car(x); /* restore the original form */
y = cdr(x); /* use sc->args as the new frame */
sc->y = y;
- sc->envir = old_frame_in_env(sc, x, sc->envir);
+ sc->envir = reuse_as_let(sc, x, sc->envir);
{
bool named_let;
@@ -67220,6 +72761,10 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
/* we need to check the current environment for ridiculous cases like
* (let hiho ((hiho 4)) hiho) -- I guess hiho is 4
+ * it's possible to package the entire named-let in all_x_* (see rc-a-s7.c), but
+ * it's complicated code, and gains about 1/4 total compute time. The overhead
+ * is in eval -- goto BEGIN1, all the eval switches, etc -- probably 500 of the 700
+ * can be regained directly.
*/
s7_pointer let_name;
let_name = car(sc->code);
@@ -67230,10 +72775,10 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
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);
- sc->w = sc->nil;
if (is_safe_closure(sc->x))
{
s7_pointer arg, new_env;
+ /* fprintf(stderr, "%s is safe\n", DISPLAY_80(sc->x)); */
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))
@@ -67241,29 +72786,27 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
let_set_slots(new_env, reverse_slots(sc, let_slots(new_env)));
}
make_slot_1(sc, sc->envir, let_name, sc->x);
- sc->x = sc->nil;
+ /* sc->x = sc->nil; */
sc->envir = new_frame_in_env(sc, sc->envir);
for (x = cadr(sc->code); is_not_null(y); x = cdr(x))
{
- s7_pointer sym, args, val;
+ s7_pointer sym, args;
/* reuse the value cells as the new frame slots */
sym = caar(x);
if (sym == let_name) let_name = sc->nil;
- val = car(y);
args = cdr(y);
-
- set_type(y, T_SLOT);
- slot_set_symbol(y, sym);
- slot_set_value(y, val);
+ reuse_as_slot(y, sym, unchecked_car(y)); /* y=slot, sym=symbol, car(y)=value */
set_next_slot(y, let_slots(sc->envir));
let_set_slots(sc->envir, y);
symbol_set_local(sym, let_id(sc->envir), y);
-
y = args;
}
- sc->code = _TLst(cddr(sc->code));
+
+ sc->code = _TPair(cddr(sc->code));
+ sc->w = sc->nil;
+ sc->x = sc->nil;
}
else
{
@@ -67275,23 +72818,19 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
for (x = car(sc->code); is_not_null(y); x = cdr(x))
{
- s7_pointer sym, args, val;
+ s7_pointer sym, args;
/* reuse the value cells as the new frame slots */
sym = caar(x);
- val = car(y);
args = cdr(y);
-
- set_type(y, T_SLOT);
- slot_set_symbol(y, sym);
+ reuse_as_slot(y, sym, unchecked_car(y));
symbol_set_local(sym, id, y);
- slot_set_value(y, val);
set_next_slot(y, let_slots(e));
let_set_slots(e, y);
y = args;
}
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
}
}
sc->y = sc->nil;
@@ -67300,7 +72839,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* -------------------------------- LET* -------------------------------- */
-
case OP_LET_STAR_ALL_X:
{
s7_pointer p;
@@ -67311,23 +72849,20 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
arg = c_call(arg)(sc, car(arg));
new_frame_with_slot(sc, sc->envir, sc->envir, caar(p), arg);
}
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
}
-
case OP_NAMED_LET_STAR:
push_stack(sc, OP_LET_STAR1, sc->code, cadr(sc->code));
sc->code = opt_con2(sc->code);
goto EVAL;
-
case OP_LET_STAR2:
push_stack(sc, OP_LET_STAR1, sc->code, car(sc->code));
sc->code = opt_con2(sc->code);
goto EVAL;
-
case OP_LET_STAR:
check_let_star(sc);
@@ -67340,7 +72875,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (is_null(car(sc->value)))
{
sc->envir = new_frame_in_env(sc, sc->envir);
- sc->code = _TLst(cdr(sc->value));
+ sc->code = _TPair(cdr(sc->value));
make_slot_1(sc, sc->envir, cx, make_closure(sc, sc->nil, sc->code, T_CLOSURE_STAR));
goto BEGIN1;
}
@@ -67350,7 +72885,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (is_null(car(sc->code)))
{
sc->envir = new_frame_in_env(sc, sc->envir);
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
}
}
@@ -67369,14 +72904,15 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
goto EVAL;
-
case OP_LET_STAR1: /* let* -- calculate parameters */
/* we can't skip (or reuse) this new frame -- we have to imitate a nested let, otherwise
* (let ((f1 (lambda (arg) (+ arg 1))))
* (let* ((x 32)
* (f1 (lambda (arg) (f1 (+ x arg)))))
* (f1 1)))
- * will hang. (much later -- this worries me... Could we defer making the slot?)
+ * will hang.
+ * To get around this requires find_symbol or s7_tree_memq in check_let_star,
+ * both (much) more expensive than making a useless frame!.
*/
while (true)
{
@@ -67407,12 +72943,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
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);
}
- else sc->code = _TLst(cdr(sc->code));
+ else sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
/* -------------------------------- LETREC -------------------------------- */
-
case OP_LETREC:
check_letrec(sc, true);
@@ -67447,10 +72982,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->code = slot_expression(sc->args);
goto EVAL;
}
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
-
case OP_LETREC1:
slot_set_pending_value(sc->args, sc->value);
sc->args = next_slot(sc->args);
@@ -67466,13 +73000,12 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
for (slot = let_slots(sc->envir); is_slot(slot); slot = next_slot(slot))
if (is_checked_slot(slot))
slot_set_value(slot, slot_pending_value(slot));
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
}
/* -------------------------------- LETREC* -------------------------------- */
-
case OP_LETREC_STAR:
check_letrec(sc, false);
@@ -67507,10 +73040,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->code = slot_expression(sc->args);
goto EVAL;
}
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
-
case OP_LETREC_STAR1:
{
s7_pointer slot;
@@ -67525,11 +73057,108 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
else
{
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
}
}
+
+
+ /* -------------------------------- LET-TEMPORARILY -------------------------------- */
+ case OP_LET_TEMPORARILY:
+ check_let_temporarily(sc);
+ case OP_LET_TEMP_UNCHECKED:
+ push_stack(sc, OP_GC_PROTECT, sc->args = list_4(sc, car(sc->code), sc->nil, sc->nil, sc->nil), sc->code);
+ /* sc->args: varlist, settees, old_values, new_values */
+ goto LET_TEMP_INIT1;
+
+ case OP_LET_TEMP_INIT1:
+ caddr(sc->args) = cons(sc, sc->value, caddr(sc->args));
+
+ LET_TEMP_INIT1:
+ while (is_pair(car(sc->args)))
+ {
+ /* eval car, add result to old-vals list, if any vars undefined, error */
+ s7_pointer binding, settee, new_value;
+ binding = caar(sc->args);
+ settee = car(binding);
+ new_value = cadr(binding);
+ cadr(sc->args) = cons(sc, settee, cadr(sc->args));
+ cadddr(sc->args) = cons(sc, new_value, cadddr(sc->args));
+ car(sc->args) = cdar(sc->args);
+ if (is_symbol(settee))
+ caddr(sc->args) = cons(sc, find_symbol_checked(sc, settee), caddr(sc->args));
+ else
+ {
+ if (is_pair(settee))
+ {
+ push_stack(sc, OP_LET_TEMP_INIT1, sc->args, sc->code);
+ sc->code = settee;
+ goto EVAL;
+ }
+ else caddr(sc->args) = cons(sc, new_value, caddr(sc->args));
+ }
+ }
+ car(sc->args) = cadr(sc->args);
+
+ case OP_LET_TEMP_INIT2:
+ /* now eval set car new-val, cadr=settees, cadddr= new_values */
+ while (is_pair(car(sc->args)))
+ {
+ s7_pointer settee, new_value;
+ settee = car(car(sc->args));
+ new_value = car(cadddr(sc->args));
+ cadddr(sc->args) = cdr(cadddr(sc->args));
+ car(sc->args) = cdr(car(sc->args));
+ if ((!is_symbol(settee)) ||
+ (symbol_has_accessor(settee)) ||
+ (is_pair(new_value)))
+ {
+ push_stack(sc, OP_LET_TEMP_INIT2, sc->args, sc->code);
+ sc->code = list_3(sc, sc->set_symbol, settee, new_value);
+ goto EVAL;
+ }
+ if (is_symbol(new_value))
+ new_value = find_symbol_checked(sc, new_value);
+ slot_set_value(find_symbol(sc, settee), new_value);
+ }
+
+ car(sc->args) = cadr(sc->args);
+ pop_stack(sc);
+ push_stack(sc, OP_LET_TEMP_DONE, sc->args, sc->code);
+ sc->code = cdr(sc->code);
+ if (is_pair(sc->code))
+ goto BEGIN1;
+ else sc->value = sc->nil; /* so (let-temporarily (<vars)) -> () like begin I guess */
+
+ case OP_LET_TEMP_DONE:
+ push_stack(sc, OP_GC_PROTECT, sc->args, sc->value);
+
+ case OP_LET_TEMP_DONE1:
+ 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));
+ if ((!is_symbol(settee)) ||
+ (symbol_has_accessor(settee)))
+ {
+ push_stack(sc, OP_LET_TEMP_DONE1, sc->args, sc->code);
+ if ((is_pair(old_value)) || (is_symbol(old_value)))
+ sc->code = list_3(sc, sc->set_symbol, settee, list_2(sc, sc->quote_symbol, old_value));
+ else sc->code = list_3(sc, sc->set_symbol, settee, old_value);
+ goto EVAL;
+ }
+ slot_set_value(find_symbol(sc, settee), old_value);
+ }
+ pop_stack(sc);
+ sc->value = sc->code;
+ if (is_multiple_value(sc->value))
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+ break;
+
/* -------------------------------- COND -------------------------------- */
case OP_COND:
@@ -67540,10 +73169,15 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->code = caar(sc->code);
goto EVAL;
+ case OP_COND_UNCHECKED_Z:
+ push_stack(sc, OP_COND1, sc->nil, sc->code);
+ sc->code = caar(sc->code);
+ goto OPT_EVAL_CHECKED;
case OP_COND1:
if (is_true(sc, sc->value))
{
+ COND1:
sc->code = cdar(sc->code);
if (is_null(sc->code))
{
@@ -67558,37 +73192,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if ((car(sc->code) == sc->feed_to_symbol) &&
(s7_symbol_value(sc, sc->feed_to_symbol) == sc->undefined))
{
- /* old form (pre 6-June-16): this causes a double evaluation:
- * (let ((x 'y) (y 32)) (cond ((values x y) => list))) -> '(32 32)
- * but it should be '(y 32)
- * it's also extremely slow: make/eval a list?!
- *
- * if (is_multiple_value(sc->value))
- * sc->code = cons(sc, cadr(sc->code), multiple_value(sc->value));
- * else sc->code = list_2(sc, cadr(sc->code), list_2(sc, sc->quote_symbol, sc->value));
- * goto EVAL;
- */
- if (is_multiple_value(sc->value)) /* (cond ((values 1 2) => +)) */
- {
- sc->args = multiple_value(sc->value);
- clear_multiple_value(sc->args);
- }
- else sc->args = list_1(sc, sc->value);
- if (is_symbol(cadr(sc->code)))
- {
- sc->code = find_symbol_checked(sc, cadr(sc->code)); /* car is => */
- if (needs_copied_args(sc->code))
- sc->args = copy_list(sc, sc->args);
- goto APPLY;
- }
- else
- {
- /* need to evaluate the target function */
- push_stack(sc, OP_COND1_1, sc->args, sc->code);
- sc->code = cadr(sc->code);
- sc->args = sc->nil;
- goto EVAL;
- }
+ int res;
+ res = feed_to(sc);
+ if (res == goto_START) goto START;
+ if (res == goto_APPLY) goto APPLY;
+ goto EVAL;
}
goto BEGIN1;
}
@@ -67603,80 +73211,66 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
*/
goto START;
}
-
+
+ if ((caar(sc->code) == sc->else_symbol) &&
+ (symbol_id(sc->else_symbol) == 0))
+ {
+ sc->value = sc->else_symbol;
+ goto COND1;
+ }
+
push_stack_no_args(sc, OP_COND1, sc->code);
sc->code = caar(sc->code);
goto EVAL;
case OP_COND1_1:
sc->code = sc->value;
- if (needs_copied_args(sc->code))
- sc->args = copy_list(sc, sc->args);
goto APPLY;
- case OP_COND_SIMPLE:
- push_stack_no_args(sc, OP_COND1_SIMPLE, sc->code);
- sc->code = caar(sc->code);
- goto EVAL;
-
+ COND_SIMPLE:
+ case OP_COND_SIMPLE: /* no => */
+ sc->value = caar(sc->code);
+ if (is_pair(sc->value))
+ {
+ push_stack_no_args(sc, OP_COND1_SIMPLE, sc->code);
+ sc->code = sc->value;
+ goto EVAL;
+ }
+ if ((is_symbol(sc->value)) &&
+ ((sc->value != sc->else_symbol) || (symbol_id(sc->else_symbol) != 0)))
+ sc->value = find_symbol_checked(sc, sc->value);
case OP_COND1_SIMPLE:
- while (true)
+ if (is_true(sc, sc->value))
{
- if (is_true(sc, sc->value))
- {
- sc->code = _TLst(cdar(sc->code));
- if (is_null(sc->code))
- {
- if (is_multiple_value(sc->value))
- sc->value = splice_in_values(sc, multiple_value(sc->value));
- goto START;
- }
- goto BEGIN1;
- }
-
- sc->code = cdr(sc->code);
+ sc->code = _TLst(cdar(sc->code));
if (is_null(sc->code))
{
- sc->value = sc->unspecified;
+ if (is_multiple_value(sc->value))
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
goto START;
}
- if (is_pair(caar(sc->code)))
- {
- push_stack_no_args(sc, OP_COND1_SIMPLE, sc->code);
- sc->code = caar(sc->code);
- goto EVAL;
- }
- sc->value = caar(sc->code);
- if (is_symbol(sc->value))
- sc->value = find_symbol_checked(sc, sc->value);
+ goto BEGIN1;
}
+ sc->code = cdr(sc->code);
+ if (is_null(sc->code))
+ {
+ sc->value = sc->unspecified;
+ goto START;
+ }
+ goto COND_SIMPLE;
-
- case OP_COND_S:
+ case OP_COND_ALL_X:
{
- s7_pointer val = NULL, p;
- if (is_pair(caar(sc->code)))
- val = find_symbol_checked(sc, cadaar(sc->code));
+ s7_pointer p;
for (p = sc->code; is_pair(p); p = cdr(p))
{
- s7_pointer ap;
- ap = caar(p);
- if (is_pair(ap))
- {
- set_car(sc->t1_1, val);
- sc->value = c_call(ap)(sc, sc->t1_1);
- }
- else sc->value = sc->T;
+ sc->value = c_call(car(p))(sc, caar(p));
if (is_true(sc, sc->value))
{
sc->code = _TLst(cdar(p));
if (is_null(sc->code))
- {
- if (is_multiple_value(sc->value))
- sc->value = splice_in_values(sc, multiple_value(sc->value));
- goto START;
- }
+ goto START;
goto BEGIN1;
}
}
@@ -67701,15 +73295,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
sc->code = _TLst(cdar(p));
if (is_null(sc->code))
- {
- if (is_multiple_value(sc->value))
- sc->value = splice_in_values(sc, multiple_value(sc->value));
- goto START;
- }
+ goto START;
goto BEGIN1;
}
- case OP_COND_ALL_X:
+ case OP_COND_ALL_X_Z:
{
s7_pointer p;
for (p = sc->code; is_pair(p); p = cdr(p))
@@ -67719,12 +73309,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
sc->code = _TLst(cdar(p));
if (is_null(sc->code))
- {
- if (is_multiple_value(sc->value))
- sc->value = splice_in_values(sc, multiple_value(sc->value));
- goto START;
- }
- goto BEGIN1;
+ goto START;
+ sc->code = car(sc->code);
+ goto OPT_EVAL_CHECKED;
}
}
sc->value = sc->unspecified;
@@ -67774,7 +73361,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto EVAL;
}
-
case OP_AND_P1:
if ((is_false(sc, sc->value)) ||
(is_null(sc->code)))
@@ -67801,7 +73387,17 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto EVAL;
}
- case OP_AND_P2:
+ AND_SAFE_P: /* all branches all_x_safe */
+ case OP_AND_SAFE_P:
+ sc->value = c_call(sc->code)(sc, car(sc->code));
+ if (is_false(sc, sc->value))
+ goto START;
+ sc->code = cdr(sc->code);
+ if (is_null(sc->code))
+ goto START;
+ goto AND_SAFE_P;
+
+ 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))
@@ -67809,6 +73405,21 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
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;
+ sc->code = cadr(sc->code);
+ goto OPT_EVAL_CHECKED;
+
+ case OP_AND_SAFE_AA:
+ /* we know both c_callee's are set */
+ sc->value = c_call(sc->code)(sc, car(sc->code));
+ if (is_false(sc, sc->value))
+ goto START;
+ sc->value = c_call(cdr(sc->code))(sc, cadr(sc->code));
+ goto START;
+
/* -------------------------------- OR -------------------------------- */
case OP_OR:
@@ -67846,7 +73457,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->code = car(sc->code);
goto EVAL;
-
case OP_OR_P1:
if ((is_true(sc, sc->value)) ||
(is_null(sc->code)))
@@ -67873,7 +73483,17 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto EVAL;
}
- case OP_OR_P2:
+ OR_SAFE_P:
+ case OP_OR_SAFE_P:
+ sc->value = c_call(sc->code)(sc, car(sc->code));
+ if (is_true(sc, sc->value))
+ goto START;
+ sc->code = cdr(sc->code);
+ if (is_null(sc->code))
+ goto START;
+ goto OR_SAFE_P;
+
+ case OP_OR_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_true(sc, sc->value))
@@ -67881,6 +73501,21 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->code = cadr(sc->code);
goto EVAL;
+ case OP_OR_AZ:
+ /* 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_true(sc, sc->value))
+ goto START;
+ sc->code = cadr(sc->code);
+ goto OPT_EVAL_CHECKED;
+
+ case OP_OR_SAFE_AA:
+ sc->value = c_call(sc->code)(sc, car(sc->code));
+ if (is_true(sc, sc->value))
+ goto START;
+ sc->value = c_call(cdr(sc->code))(sc, cadr(sc->code));
+ goto START;
+
/* by going direct without a push_stack on the last one we get tail calls,
* but if the last arg (also in "and" above) is "values", there is a slight
* inconsistency: the values are returned and spliced into the caller if trailing, but
@@ -67899,7 +73534,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* -------------------------------- macro evaluation -------------------------------- */
-
case OP_EVAL_MACRO: /* after (scheme-side) macroexpansion, evaluate the resulting expression */
/*
* (define-macro (hi a) `(+ ,a 1))
@@ -67925,7 +73559,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
else sc->code = sc->value;
goto EVAL;
-
case OP_EVAL_MACRO_MV:
if (is_null(sc->code)) /* end of values list */
{
@@ -67936,8 +73569,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->code = car(sc->code);
goto EVAL;
-
case OP_EXPANSION:
+ /* fprintf(stderr, "expansion: %s\n", DISPLAY(sc->value)); */
/* after the expander has finished, if a list was returned, we need to add some annotations.
* if the expander returned (values), the list-in-progress vanishes! (This mimics map and *#readers*).
*/
@@ -67950,7 +73583,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
break;
-
case OP_DEFINE_MACRO_WITH_ACCESSOR:
if (sc->value == sc->error_symbol) /* backwards compatibility... */
return(s7_error(sc, sc->error_symbol, set_elist_3(sc, make_string_wrapper(sc, "can't define-macro ~S to ~S"), car(sc->args), cadr(sc->args))));
@@ -67962,7 +73594,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->value = make_macro(sc);
break;
-
case OP_DEFINE_BACRO:
case OP_DEFINE_BACRO_STAR:
case OP_DEFINE_EXPANSION:
@@ -67985,15 +73616,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->value = make_macro(sc);
break;
-
case OP_LAMBDA:
check_lambda(sc);
- case OP_LAMBDA_UNCHECKED:
- make_closure_with_let(sc, sc->value, car(sc->code), cdr(sc->code), sc->envir);
+ 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 */
break;
-
case OP_LAMBDA_STAR:
check_lambda_star(sc);
@@ -68003,7 +73632,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* -------------------------------- CASE -------------------------------- */
-
case OP_CASE: /* case, car(sc->code) is the selector */
check_case(sc);
@@ -68016,20 +73644,21 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (is_symbol(carc))
sc->value = find_symbol_checked(sc, carc);
else sc->value = carc;
- sc->code = cdr(sc->code);
/* fall through */
}
else
{
- push_stack_no_args(sc, OP_CASE1, cdr(sc->code));
+ push_stack_no_args(sc, OP_CASE_G_G, sc->code);
sc->code = carc;
goto EVAL;
}
}
- case OP_CASE1:
+ CASE_G_G:
+ case OP_CASE_G_G:
{
s7_pointer x, y;
+ sc->code = cdr(sc->code);
if (is_simple(sc->value))
{
for (x = sc->code; is_pair(x); x = cdr(x))
@@ -68068,8 +73697,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if ((car(sc->code) == sc->feed_to_symbol) &&
(s7_symbol_value(sc, sc->feed_to_symbol) == sc->undefined))
{
- sc->code = list_2(sc, cadr(sc->code), list_2(sc, sc->quote_symbol, sc->value));
+ int res;
+ res = feed_to(sc);
+ if (res == goto_START) goto START;
+ if (res == goto_APPLY) goto APPLY;
goto EVAL;
+
+ /* sc->code = list_2(sc, cadr(sc->code), list_2(sc, sc->quote_symbol, sc->value)); */
}
goto BEGIN1;
}
@@ -68079,169 +73713,208 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
break;
+ /* selector A, key type: E=eq (symbol/char), I=integer, G=any, S=single keys and single bodies */
+ case OP_CASE_A_E_S:
+ sc->value = c_call(sc->code)(sc, car(sc->code));
+ goto CASE_E_S;
+
+ case OP_CASE_A_I_S:
+ sc->value = c_call(sc->code)(sc, car(sc->code));
+ goto CASE_I_S;
+
+ case OP_CASE_A_E_G:
+ sc->value = c_call(sc->code)(sc, car(sc->code));
+ goto CASE_E_G;
- case OP_CASE_ELSE:
- push_stack_no_args(sc, OP_CASE_ELSE_1, cadr(sc->code));
+ case OP_CASE_A_G_G:
+ sc->value = c_call(sc->code)(sc, car(sc->code));
+ goto CASE_G_G;
+
+ case OP_CASE_S_G_S:
+ sc->value = find_symbol_checked(sc, car(sc->code));
+ goto CASE_G_S;
+
+ case OP_CASE_S_G_G:
+ sc->value = find_symbol_checked(sc, car(sc->code));
+ goto CASE_G_G;
+
+ /* selector = any */
+ case OP_CASE_P_E_S:
+ push_stack_no_args(sc, OP_CASE_E_S, sc->code);
sc->code = car(sc->code);
goto EVAL;
- case OP_CASE_ELSE_1:
- /* sc->code here is of the form ((#<undefined>) ...) */
- if (sc->value == caar(sc->code))
- {
- sc->code = _TLst(cdr(sc->code));
- goto BEGIN1;
- }
- goto START;
+ case OP_CASE_P_I_S:
+ push_stack_no_args(sc, OP_CASE_I_S, sc->code);
+ sc->code = car(sc->code);
+ goto EVAL;
-
- case OP_CASE_SIMPLE:
- /* assume symbol as selector, all keys are simple, and no => */
- {
- s7_pointer x, y, selector;
- selector = find_symbol_checked(sc, car(sc->code));
- for (x = cdr(sc->code); is_pair(x); x = cdr(x))
- {
- y = opt_key(x);
- if (!is_pair(y)) /* else? */
- {
- sc->code = _TLst(cdar(x));
- if (is_null(sc->code))
- {
- sc->value = selector;
- goto START;
- }
- goto BEGIN1;
- }
- do {
- if (car(y) == selector)
- {
- sc->code = _TLst(cdar(x));
- if (is_null(sc->code))
- {
- sc->value = selector;
- goto START;
- }
- goto BEGIN1;
- }
- y = cdr(y);
- } while (is_pair(y));
- }
- sc->value = sc->unspecified;
- }
- break;
-
- case OP_CASE_SIMPLER:
- /* assume symbol as selector, all keys are simple, and no => and no else */
+ case OP_CASE_P_G_S:
+ push_stack_no_args(sc, OP_CASE_G_S, sc->code);
+ sc->code = car(sc->code);
+ goto EVAL;
+
+ case OP_CASE_P_E_G:
+ push_stack_no_args(sc, OP_CASE_E_G, sc->code);
+ sc->code = car(sc->code);
+ goto EVAL;
+
+ case OP_CASE_P_G_G:
+ push_stack_no_args(sc, OP_CASE_G_G, sc->code);
+ sc->code = car(sc->code);
+ goto EVAL;
+
+ case OP_CASE_S_E_S:
+ sc->value = find_symbol_checked(sc, car(sc->code));
+ /* goto CASE_E_S; */
+
+ CASE_E_S:
+ case OP_CASE_E_S:
{
- s7_pointer x, y, selector;
- selector = find_symbol_checked(sc, car(sc->code));
- for (x = cdr(sc->code); is_pair(x); x = cdr(x))
+ s7_pointer x, selector;
+ selector = sc->value;
+ if (is_simple(selector))
{
- y = opt_key(x);
- do {
- if (car(y) == selector)
+ for (x = cdr(sc->code); is_pair(x); x = cdr(x))
+ if (opt_key(x) == selector)
{
- sc->code = _TLst(cdar(x));
- if (is_null(sc->code))
- {
- sc->value = selector;
- goto START;
- }
- goto BEGIN1;
+ sc->code = opt_clause(x);
+ goto EVAL;
}
- y = cdr(y);
- } while (is_pair(y));
}
- sc->value = sc->unspecified;
+ sc->code = opt_else(sc->code);
+ goto EVAL;
}
break;
-
- case OP_CASE_SIMPLER_1:
- /* assume symbol as selector, all keys are simple, and no => and no else, bodies are 1 liners */
+
+ case OP_CASE_S_I_S:
+ sc->value = find_symbol_checked(sc, car(sc->code));
+ /* goto CASE_I_S; */
+
+ CASE_I_S:
+ case OP_CASE_I_S:
{
- s7_pointer x, y, selector;
- selector = find_symbol_checked(sc, car(sc->code));
- for (x = cdr(sc->code); is_pair(x); x = cdr(x))
+ s7_pointer x, selector, else_clause;
+ selector = sc->value;
+ else_clause = opt_else(sc->code);
+ if (else_clause != sc->unspecified)
{
- y = opt_key(x);
- do {
- if (car(y) == selector)
- {
- sc->code = opt_clause(x); /* cadar(x) can't be nil */
- goto EVAL;
- }
- y = cdr(y);
- } while (is_pair(y));
+ if (is_integer(selector))
+ {
+ s7_int val;
+ val = integer(selector);
+ for (x = cdr(sc->code); is_pair(x); x = cdr(x))
+ {
+ if (is_integer(opt_key(x)))
+ {
+ if (integer(opt_key(x)) == val)
+ {
+ sc->code = opt_clause(x);
+ goto EVAL;
+ }
+ }
+ else break;
+ }
+ }
+ sc->code = else_clause;
+ goto EVAL;
}
- sc->value = sc->unspecified;
- }
- break;
-
- case OP_CASE_SIMPLER_SS:
- /* assume hop_safe_ss as selector, all keys are simple, and no => and no else, bodies are 1 liners */
- {
- s7_pointer x, y, selector, args;
- args = cdar(sc->code);
- x = find_symbol_checked(sc, car(args));
- set_car(sc->t2_2, find_symbol_checked(sc, cadr(args)));
- set_car(sc->t2_1, x);
- selector = c_call(car(sc->code))(sc, sc->t2_1);
- for (x = cdr(sc->code); is_pair(x); x = cdr(x))
+ else
{
- y = opt_key(x);
- do {
- if (car(y) == selector)
- {
- sc->code = opt_clause(x); /* cadar(x) can't be nil */
- goto EVAL;
- }
- y = cdr(y);
- } while (is_pair(y));
+ if (is_integer(selector))
+ {
+ s7_int val;
+ val = integer(selector);
+ for (x = cdr(sc->code); is_pair(x); x = cdr(x))
+ {
+ if (integer(opt_key(x)) == val)
+ {
+ sc->code = opt_clause(x);
+ goto EVAL;
+ }
+ }
+ }
+ sc->value = sc->unspecified;
}
- sc->value = sc->unspecified;
}
break;
-
- case OP_CASE_SIMPLEST_SS:
+
+ case OP_CASE_A_G_S:
+ sc->value = c_call(sc->code)(sc, car(sc->code));
+ /* goto CASE_G_S; */
+
+ CASE_G_S:
+ case OP_CASE_G_S:
{
- s7_pointer x, selector, args;
- args = cdar(sc->code);
- x = find_symbol_checked(sc, car(args));
- set_car(sc->t2_2, find_symbol_checked(sc, cadr(args)));
- set_car(sc->t2_1, x);
- selector = c_call(car(sc->code))(sc, sc->t2_1);
+ s7_pointer x, selector;
+ selector = sc->value;
for (x = cdr(sc->code); is_pair(x); x = cdr(x))
- if (opt_key(x) == selector)
+ if (s7_is_eqv(opt_key(x), selector))
{
- sc->code = _TLst(cdar(x));
- if (is_null(sc->code))
- {
- sc->value = selector;
- goto START;
- }
- goto BEGIN1;
+ sc->code = opt_clause(x);
+ goto EVAL;
}
- sc->value = sc->unspecified;
+ sc->code = opt_else(sc->code);
+ goto EVAL;
}
break;
-
- case OP_CASE_SIMPLEST:
- /* assume symbol as selector, all keys are simple and singletons, and no => and no else, bodies are 1 liners */
+
+ case OP_CASE_S_E_G:
+ sc->value = find_symbol_checked(sc, car(sc->code));
+ /* goto CASE_E_G; */
+
+ CASE_E_G:
+ case OP_CASE_E_G:
{
- s7_pointer x, selector;
- selector = find_symbol_checked(sc, car(sc->code));
- for (x = cdr(sc->code); is_pair(x); x = cdr(x))
- if (opt_key(x) == selector)
- {
- sc->code = opt_clause(x); /* cadar(x) can't be nil */
- goto EVAL;
- }
+ s7_pointer x, y, selector;
+ selector = sc->value;
+ if (is_simple(selector))
+ {
+ for (x = cdr(sc->code); is_pair(x); x = cdr(x))
+ {
+ y = opt_key(x);
+ if (!is_pair(y))
+ goto ELSE_CASE_1;
+ do {
+ if (car(y) == selector)
+ goto ELSE_CASE_1;
+ y = cdr(y);
+ } while (is_pair(y));
+ }
+ }
+ else
+ {
+ sc->code = opt_else(sc->code);
+ if (is_pair(sc->code))
+ goto ELSE_CASE_2;
+ goto START;
+ }
+ /* x is the entire matching clause, (case 2 ((2) 3)), x: (((2) 3)) */
+ ELSE_CASE_1:
+ if (is_not_null(x))
+ {
+ sc->code = _TLst(cdar(x));
+ if (is_null(sc->code)) /* sc->value is already the selector */
+ goto START;
+
+ ELSE_CASE_2:
+ /* check for => */
+ if ((car(sc->code) == sc->feed_to_symbol) &&
+ (s7_symbol_value(sc, sc->feed_to_symbol) == sc->undefined))
+ {
+ int res;
+ res = feed_to(sc);
+ if (res == goto_START) goto START;
+ if (res == goto_APPLY) goto APPLY;
+ goto EVAL;
+ /* sc->code = list_2(sc, cadr(sc->code), list_2(sc, sc->quote_symbol, sc->value)); */
+ }
+ goto BEGIN1;
+ }
sc->value = sc->unspecified;
}
break;
-
-
+
case OP_ERROR_QUIT:
if (sc->stack_end <= sc->stack_start)
stack_reset(sc); /* sets stack_end to stack_start, then pushes op_barrier and op_eval_done */
@@ -68266,7 +73939,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
#endif
return(sc->value); /* not executed I hope */
-
case OP_EVAL_DONE:
/* this is the "time to quit" operator */
return(sc->F);
@@ -68283,12 +73955,10 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
call_exit_active(sc->args) = false; /* as we leave the call-with-exit body, deactivate the exiter */
break;
-
case OP_GET_OUTPUT_STRING: /* from get-output-string -- return a new string */
sc->value = s7_make_string_with_length(sc, (const char *)port_data(sc->code), port_position(sc->code));
break;
-
case OP_GET_OUTPUT_STRING_1: /* from call-with-output-string and with-output-to-string -- return the port string directly */
if ((!is_output_port(sc->code)) ||
(port_is_closed(sc->code)))
@@ -68351,11 +74021,10 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
symbol_set_local(sym, sc->let_number, p);
}
}
- sc->code = _TLst(cdr(sc->code));
+ sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
}
-
case OP_WITH_LET:
check_with_let(sc);
@@ -68386,10 +74055,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
case OP_WITH_LET1:
- activate_let(sc);
+ activate_let(sc, sc->value);
goto BEGIN1;
-
case OP_WITH_BAFFLE:
if (!is_proper_list(sc, sc->code))
eval_error(sc, "with-baffle: unexpected dot? ~A", sc->code);
@@ -68411,7 +74079,6 @@ 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
*/
@@ -68426,6 +74093,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
set_car(x, sc->value);
set_cdr(x, sc->args);
sc->args = x;
+#if WITH_PROFILE
+ profile_set_location(x, remember_location(port_line_number(sc->input_port), port_file_number(sc->input_port)));
+#endif
}
case OP_READ_NEXT: /* this is 75% of the token calls, so expanding it saves lots of time */
@@ -68465,6 +74135,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
set_car(x, sc->value);
set_cdr(x, sc->nil);
sc->args = x;
+#if WITH_PROFILE
+ profile_set_location(x, remember_location(port_line_number(sc->input_port), port_file_number(sc->input_port)));
+#endif
c = port_read_white_space(pt)(sc, pt);
goto READ_C;
}
@@ -68480,6 +74153,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
set_car(x, sc->value);
set_cdr(x, sc->nil);
sc->args = x;
+#if WITH_PROFILE
+ profile_set_location(x, remember_location(port_line_number(sc->input_port), port_file_number(sc->input_port)));
+#endif
c = port_read_white_space(pt)(sc, pt);
goto READ_C;
}
@@ -68531,6 +74207,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
return(string_read_error(sc, "end of input encountered while in a string"));
if (sc->value == sc->T)
return(read_error(sc, "unknown backslash usage -- perhaps you meant two backslashes?"));
+ if (sc->safety > IMMUTABLE_VECTOR_SAFETY) set_immutable(sc->value);
goto READ_LIST;
case '`':
@@ -68538,13 +74215,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
push_stack_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; /* read_unquote */
+ goto START;
case ',':
sc->tok = read_comma(sc, pt); /* at_mark or comma */
push_stack_no_code(sc, OP_READ_LIST, sc->args);
sc->value = read_expression(sc);
- goto START; /* read_unquote */
+ goto START;
case '#':
sc->tok = read_sharp(sc, pt);
@@ -68574,7 +74251,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if ((is_expansion(car(sc->value))) &&
(expansion_ex(sc) == goto_APPLY))
- goto APPLY;
+ {
+ push_stack(sc, OP_EXPANSION, sc->nil, sc->nil);
+ new_frame(sc, closure_let(sc->code), sc->envir);
+ goto APPLY_LAMBDA;
+ }
if (is_pair(cdr(sc->value)))
{
set_opt_back(sc->value);
@@ -68611,6 +74292,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
return(string_read_error(sc, "end of input encountered while in a string"));
if (sc->value == sc->T)
return(read_error(sc, "unknown backslash usage -- perhaps you meant two backslashes?"));
+ if (sc->safety > IMMUTABLE_VECTOR_SAFETY) set_immutable(sc->value);
goto READ_LIST;
case TOKEN_DOT:
@@ -68629,7 +74311,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
break;
-
case OP_READ_DOT:
if (token(sc) != TOKEN_RIGHT_PAREN)
{
@@ -68654,16 +74335,17 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
break;
-
case OP_READ_QUOTE:
/* can't check for sc->value = sc->nil here because we want ''() to be different from '() */
+ if ((sc->safety > IMMUTABLE_VECTOR_SAFETY) &&
+ ((is_pair(sc->value)) || (s7_is_vector(sc->value)) || (is_string(sc->value))))
+ set_immutable(sc->value);
sc->value = list_2(sc, sc->quote_symbol, sc->value);
set_opt_back(sc->value);
set_overlay(cdr(sc->value));
if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
break;
-
case OP_READ_QUASIQUOTE:
/* this was pushed when the backquote was seen, then eventually we popped back to it */
sc->value = g_quasiquote_1(sc, sc->value);
@@ -68675,25 +74357,53 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
break;
-
case OP_READ_VECTOR:
if (!is_proper_list(sc, 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 */
sc->value = g_vector(sc, sc->value);
else sc->value = g_multivector(sc, s7_integer(sc->args), sc->value);
+ /* here and below all of the sc->value list can be freed, but my tests showed no speed up even in large cases */
+ free_vlist(sc, sc->v);
+ if (sc->safety > IMMUTABLE_VECTOR_SAFETY) set_immutable(sc->value);
if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
break;
-
-
+
+ case OP_READ_INT_VECTOR:
+ if (!is_proper_list(sc, 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 */
+ sc->value = g_int_vector(sc, sc->value);
+ else sc->value = g_int_multivector(sc, s7_integer(sc->args), sc->value);
+ free_vlist(sc, sc->v);
+ if (sc->safety > IMMUTABLE_VECTOR_SAFETY) set_immutable(sc->value);
+ if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
+ break;
+
+ case OP_READ_FLOAT_VECTOR:
+ if (!is_proper_list(sc, 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 */
+ sc->value = g_float_vector(sc, sc->value);
+ else sc->value = g_float_multivector(sc, s7_integer(sc->args), sc->value);
+ free_vlist(sc, sc->v);
+ if (sc->safety > IMMUTABLE_VECTOR_SAFETY) set_immutable(sc->value);
+ if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
+ break;
+
case OP_READ_BYTE_VECTOR:
- if (!is_proper_list(sc, sc->value)) /* #u8(1 . 2) */
+ if (!is_proper_list(sc, 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);
+ free_vlist(sc, sc->v);
+ if (sc->safety > IMMUTABLE_VECTOR_SAFETY) set_immutable(sc->value);
if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
break;
-
case OP_READ_UNQUOTE:
/* here if sc->value is a constant, the unquote is pointless (should we complain?) */
if ((is_pair(sc->value)) ||
@@ -68702,21 +74412,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
break;
-
case OP_READ_APPLY_VALUES:
- if (is_symbol(sc->value))
- {
- s7_pointer lst;
- lst = list_2(sc, sc->qq_apply_values_function, sc->value);
- set_unsafe_optimize_op(lst, HOP_C_S);
- set_c_function(lst, sc->qq_apply_values_function);
- sc->value = list_2(sc, sc->unquote_symbol, lst);
- }
- else sc->value = list_2(sc, sc->unquote_symbol, list_2(sc, sc->qq_apply_values_function, sc->value));
+ sc->value = list_2(sc, sc->unquote_symbol, list_2(sc, sc->apply_values_symbol, sc->value));
if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
break;
-
default:
fprintf(stderr, "unknown operator: " INT_FORMAT " in %s\n", sc->op, DISPLAY(current_code(sc)));
#if DEBUGGING
@@ -68747,7 +74447,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
do { \
if ((Sc->free_heap_top <= Sc->free_heap_trigger) || (for_any_other_reason(sc, __LINE__))) {last_gc_line = __LINE__; last_gc_func = __func__; try_to_call_gc(Sc);} \
Obj = (*(--(Sc->free_heap_top))); \
- Obj->alloc_line = __LINE__; Obj->alloc_func = __func__; \
+ Obj->alloc_line = __LINE__; Obj->alloc_func = __func__; Obj->debugger_bits = 0; \
set_type(Obj, Type); \
} while (0)
#endif
@@ -69313,12 +75013,12 @@ static s7_int big_integer_to_s7_int(mpz_t n)
if (mpz_fits_slong_p(n))
return(mpz_get_si(n));
- if ((hidden_sc->safety > 0) &&
+ if ((cur_sc->safety > NO_SAFETY) &&
(sizeof(s7_int) == sizeof(long int)))
{
char *str;
str = mpz_get_str(NULL, 10, n);
- s7_warn(hidden_sc, 256, "can't convert %s to s7_int\n", str);
+ s7_warn(cur_sc, 256, "can't convert %s to s7_int\n", str);
free(str);
}
@@ -70409,7 +76109,7 @@ static s7_pointer big_abs(s7_scheme *sc, s7_pointer args)
return(x);
default:
- method_or_bust(sc, p, sc->abs_symbol, args, T_REAL, 0);
+ method_or_bust_one_arg(sc, p, sc->abs_symbol, args, T_REAL);
}
}
@@ -70423,7 +76123,7 @@ static s7_pointer big_magnitude(s7_scheme *sc, s7_pointer args)
p = car(args);
if (!s7_is_number(p))
- method_or_bust_with_type(sc, p, sc->magnitude_symbol, args, a_number_string, 0);
+ method_or_bust_with_type_one_arg(sc, p, sc->magnitude_symbol, args, a_number_string);
if (is_t_big_complex(p))
{
@@ -70502,7 +76202,7 @@ static s7_pointer big_angle(s7_scheme *sc, s7_pointer args)
}
default:
- method_or_bust_with_type(sc, p, sc->angle_symbol, args, a_number_string, 0);
+ method_or_bust_with_type_one_arg(sc, p, sc->angle_symbol, args, a_number_string);
}
}
@@ -70759,7 +76459,7 @@ static s7_pointer big_sqrt(s7_scheme *sc, s7_pointer args)
p = car(args);
if (!s7_is_number(p))
- method_or_bust_with_type(sc, p, sc->sqrt_symbol, args, a_number_string, 0);
+ method_or_bust_with_type_one_arg(sc, p, sc->sqrt_symbol, args, a_number_string);
p = to_big(sc, p);
/* if big integer, try to return int if perfect square */
@@ -70880,7 +76580,7 @@ static s7_pointer big_trig(s7_scheme *sc, s7_pointer args,
/* I think here we should always promote to bignum (otherwise, for example, (exp 800) -> inf)
*/
if (!s7_is_number(p))
- method_or_bust_with_type(sc, p, sym, args, a_number_string, 0);
+ method_or_bust_with_type_one_arg(sc, p, sym, args, a_number_string);
if (s7_is_real(p))
{
mpfr_t n;
@@ -71278,7 +76978,7 @@ static s7_pointer big_asinh(s7_scheme *sc, s7_pointer args)
p = car(args);
if (!s7_is_number(p))
- method_or_bust_with_type(sc, p, sc->asinh_symbol, args, a_number_string, 0);
+ method_or_bust_with_type_one_arg(sc, p, sc->asinh_symbol, args, a_number_string);
if (s7_is_real(p))
{
@@ -71315,7 +77015,7 @@ static s7_pointer big_acosh(s7_scheme *sc, s7_pointer args)
p = car(args);
if (!s7_is_number(p))
- method_or_bust_with_type(sc, p, sc->acosh_symbol, args, a_number_string, 0);
+ method_or_bust_with_type_one_arg(sc, p, sc->acosh_symbol, args, a_number_string);
p = promote_number(sc, T_BIG_COMPLEX, p);
mpc_init(n);
@@ -71340,7 +77040,7 @@ static s7_pointer big_atanh(s7_scheme *sc, s7_pointer args)
p = car(args);
if (!s7_is_number(p))
- method_or_bust_with_type(sc, p, sc->atanh_symbol, args, a_number_string, 0);
+ method_or_bust_with_type_one_arg(sc, p, sc->atanh_symbol, args, a_number_string);
if (s7_is_real(p))
{
@@ -71383,7 +77083,7 @@ static s7_pointer big_atan(s7_scheme *sc, s7_pointer args)
p0 = car(args);
if (!s7_is_number(p0))
- method_or_bust_with_type(sc, p0, sc->atan_symbol, args, a_number_string, 0);
+ method_or_bust_with_type_one_arg(sc, p0, sc->atan_symbol, args, a_number_string);
if (is_not_null(cdr(args)))
{
@@ -71431,7 +77131,7 @@ static s7_pointer big_acos(s7_scheme *sc, s7_pointer args)
p = car(args);
if (!s7_is_number(p))
- method_or_bust_with_type(sc, p, sc->acos_symbol, args, a_number_string, 0);
+ method_or_bust_with_type_one_arg(sc, p, sc->acos_symbol, args, a_number_string);
if (s7_is_real(p))
{
@@ -71474,7 +77174,7 @@ static s7_pointer big_asin(s7_scheme *sc, s7_pointer args)
p = car(args);
if (!s7_is_number(p))
- method_or_bust_with_type(sc, p, sc->asin_symbol, args, a_number_string, 0);
+ method_or_bust_with_type_one_arg(sc, p, sc->asin_symbol, args, a_number_string);
if (s7_is_real(p))
{
@@ -71962,7 +77662,7 @@ static s7_pointer big_exact_to_inexact(s7_scheme *sc, s7_pointer args)
p = car(args);
if (!s7_is_number(p)) /* apparently (exact->inexact 1+i) is not an error */
- method_or_bust_with_type(sc, p, sc->exact_to_inexact_symbol, args, a_number_string, 0);
+ method_or_bust_with_type_one_arg(sc, p, sc->exact_to_inexact_symbol, args, a_number_string);
if (!s7_is_rational(p))
return(p);
@@ -71983,7 +77683,7 @@ static s7_pointer big_inexact_to_exact(s7_scheme *sc, s7_pointer args)
return(p);
if (!s7_is_real(p))
- method_or_bust(sc, p, sc->inexact_to_exact_symbol, args, T_REAL, 0);
+ method_or_bust_one_arg(sc, p, sc->inexact_to_exact_symbol, args, T_REAL);
return(big_rationalize(sc, args));
}
#endif
@@ -71998,7 +77698,7 @@ static s7_pointer big_convert_to_int(s7_scheme *sc, s7_pointer args, s7_pointer
p = car(args);
if (!s7_is_real(p))
- method_or_bust(sc, p, sym, args, T_REAL, 0);
+ method_or_bust_one_arg(sc, p, sym, args, T_REAL);
if (s7_is_integer(p))
return(p);
@@ -72065,7 +77765,7 @@ static s7_pointer big_round(s7_scheme *sc, s7_pointer args)
p = car(args);
if (!s7_is_real(p))
- method_or_bust(sc, p, sc->round_symbol, args, T_REAL, 0);
+ method_or_bust_one_arg(sc, p, sc->round_symbol, args, T_REAL);
if (s7_is_integer(p))
return(p);
@@ -72823,7 +78523,7 @@ Pass this as the second argument to 'random' to get a repeatable random number s
s7_pointer r, seed;
seed = car(args);
if (!s7_is_integer(seed))
- method_or_bust(sc, seed, sc->random_state_symbol, args, T_INTEGER, 0);
+ method_or_bust_one_arg(sc, seed, sc->random_state_symbol, args, T_INTEGER);
if (type(seed) != T_BIG_INTEGER)
seed = promote_number(sc, T_BIG_INTEGER, seed);
@@ -73034,7 +78734,6 @@ static void init_s7_let(s7_scheme *sc)
sc->stack_top_symbol = s7_make_symbol(sc, "stack-top");
sc->stack_size_symbol = s7_make_symbol(sc, "stack-size");
sc->stacktrace_defaults_symbol = s7_make_symbol(sc, "stacktrace-defaults");
- sc->symbol_table_is_locked_symbol = s7_make_symbol(sc, "symbol-table-locked?");
sc->heap_size_symbol = s7_make_symbol(sc, "heap-size");
sc->free_heap_size_symbol = s7_make_symbol(sc, "free-heap-size");
sc->gc_freed_symbol = s7_make_symbol(sc, "gc-freed");
@@ -73051,7 +78750,6 @@ static void init_s7_let(s7_scheme *sc)
sc->c_objects_symbol = s7_make_symbol(sc, "c-objects");
sc->file_names_symbol = s7_make_symbol(sc, "file-names");
- sc->symbol_table_symbol = s7_make_symbol(sc, "symbol-table");
sc->rootlet_size_symbol = s7_make_symbol(sc, "rootlet-size");
sc->c_types_symbol = s7_make_symbol(sc, "c-types");
sc->safety_symbol = s7_make_symbol(sc, "safety");
@@ -73076,6 +78774,7 @@ static void init_s7_let(s7_scheme *sc)
sc->bignum_precision_symbol = s7_make_symbol(sc, "bignum-precision");
sc->memory_usage_symbol = s7_make_symbol(sc, "memory-usage");
sc->float_format_precision_symbol = s7_make_symbol(sc, "float-format-precision");
+ sc->history_symbol = s7_make_symbol(sc, "history");
sc->history_size_symbol = s7_make_symbol(sc, "history-size");
sc->profile_info_symbol = s7_make_symbol(sc, "profile-info");
sc->autoloading_symbol = s7_make_symbol(sc, "autoloading?");
@@ -73097,10 +78796,10 @@ static s7_pointer describe_memory_usage(s7_scheme *sc)
#ifdef __linux__
struct rusage info;
getrusage(RUSAGE_SELF, &info);
- fprintf(stderr, "process size: %lld\n", (s7_int)(info.ru_maxrss * 1024));
+ fprintf(stderr, "process size: %" LL_D "\n", (s7_int)(info.ru_maxrss * 1024));
#endif
- fprintf(stderr, "heap: %u (%lld bytes)", sc->heap_size, (s7_int)(sc->heap_size * (sizeof(s7_pointer) + sizeof(s7_cell))));
+ fprintf(stderr, "heap: %u (%" LL_D " bytes)", sc->heap_size, (s7_int)(sc->heap_size * (sizeof(s7_pointer) + sizeof(s7_cell))));
{
unsigned int k;
int ts[NUM_TYPES];
@@ -73114,21 +78813,23 @@ static s7_pointer describe_memory_usage(s7_scheme *sc)
}
fprintf(stderr, "\n");
}
- fprintf(stderr, "permanent cells: %d (%lld bytes)\n", permanent_cells, (s7_int)(permanent_cells * sizeof(s7_cell)));
+ fprintf(stderr, "permanent cells: %d (%" LL_D " bytes)\n", permanent_cells, (s7_int)(permanent_cells * sizeof(s7_cell)));
for (i = 0; i < vector_length(sc->symbol_table); i++)
for (x = vector_element(sc->symbol_table, i); is_not_null(x); x = cdr(x))
syms++;
- fprintf(stderr, "symbol table: %d (%d symbols, %lld bytes)\n", SYMBOL_TABLE_SIZE, syms,
+ fprintf(stderr, "symbol table: %d (%d symbols, %" LL_D " bytes)\n", SYMBOL_TABLE_SIZE, syms,
(s7_int)(SYMBOL_TABLE_SIZE * sizeof(s7_pointer) + syms * 3 * sizeof(s7_cell)));
- fprintf(stderr, "stack: %u (%lld bytes)\n", sc->stack_size, (s7_int)(sc->stack_size * sizeof(s7_pointer)));
+ fprintf(stderr, "stack: %u (%" LL_D " 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)));
len = 0;
for (i = 0; i < (int)(sc->strings_loc); i++)
len += string_length(sc->strings[i]);
- fprintf(stderr, "strings: %u, %d bytes\n", sc->strings_loc, len); /* also doc strings, permanent strings, etc */
+ for (i = 0; i < (int)(sc->strings1_loc); i++)
+ len += string_length(sc->strings1[i]);
+ fprintf(stderr, "strings: %u, %d bytes\n", sc->strings_loc + sc->strings1_loc, len); /* also doc strings, permanent strings, etc */
{
int hs;
@@ -73139,15 +78840,21 @@ static s7_pointer describe_memory_usage(s7_scheme *sc)
for (i = 0; i < (int)(sc->hash_tables_loc); i++)
len += (hash_table_mask(sc->hash_tables[i]) + 1);
- fprintf(stderr, "hash tables: %d (%d %d), ", (int)(sc->hash_tables_loc), len, hs);
+ fprintf(stderr, "hash tables: %d (entries in use: %d, free: %d), ", (int)(sc->hash_tables_loc), len, hs);
}
{
int fs;
+ unsigned int cc_stacks;
port_t *p;
for (fs = 0, p = sc->port_heap; p; p = (port_t *)(p->next), fs++);
- fprintf(stderr, "vectors: %u, input: %u, output: %u, free port: %d\ncontinuations: %u, c_objects: %u, gensyms: %u, setters: %u\n",
- sc->vectors_loc, sc->input_ports_loc, sc->output_ports_loc, fs, sc->continuations_loc, sc->c_objects_loc, sc->gensyms_loc, sc->setters_loc);
+ for (i = 0, cc_stacks = 0; i < (int)sc->continuations_loc; i++)
+ if (is_continuation(sc->continuations[i]))
+ cc_stacks += continuation_stack_size(sc->continuations[i]);
+ fprintf(stderr, "vectors: %u, input: %u, output: %u, free port: %d\ncontinuations: %u (total stack: %u), c_objects: %u, gensyms: %u, setters: %u, optlists: %u\n",
+ sc->vectors_loc, sc->input_ports_loc, sc->output_ports_loc, fs,
+ sc->continuations_loc, cc_stacks,
+ sc->c_objects_loc, sc->gensyms_loc, sc->setters_loc, sc->optlists_loc);
}
return(sc->F);
}
@@ -73172,8 +78879,6 @@ static s7_pointer g_s7_let_ref_fallback(s7_scheme *sc, s7_pointer args)
if (sym == sc->stacktrace_defaults_symbol) /* stacktrace-defaults (used to be *stacktrace*) */
return(sc->stacktrace_defaults);
- if (sym == sc->symbol_table_is_locked_symbol) /* symbol-table-locked? */
- return(make_boolean(sc, sc->symbol_table_is_locked));
if (sym == sc->symbol_table_symbol) /* symbol-table (the raw vector) */
return(sc->symbol_table);
if (sym == sc->rootlet_size_symbol) /* rootlet-size */
@@ -73209,6 +78914,8 @@ static s7_pointer g_s7_let_ref_fallback(s7_scheme *sc, s7_pointer args)
if (sym == sc->default_random_state_symbol) /* default-random-state */
return(sc->default_rng);
+ if (sym == sc->history_symbol) /* history (eval history circular buffer) */
+ return(sc->cur_code);
if (sym == sc->history_size_symbol) /* history-size (eval history circular buffer size) */
return(s7_make_integer(sc, sc->history_size));
if (sym == sc->profile_info_symbol) /* profile-info -- profiling data hash-table */
@@ -73287,68 +78994,75 @@ static s7_pointer g_s7_let_set_fallback(s7_scheme *sc, s7_pointer args)
(sym == sc->max_vector_dimensions_symbol) ||
(sym == sc->max_list_length_symbol) ||
(sym == sc->history_size_symbol) ||
- (sym == sc->max_string_length_symbol))
+ (sym == sc->max_string_length_symbol) ||
+ (sym == sc->default_hash_table_length_symbol) ||
+ (sym == sc->float_format_precision_symbol) ||
+ (sym == sc->bignum_precision_symbol) ||
+ (sym == sc->initial_string_port_length_symbol))
{
- if (s7_is_integer(val))
+ s7_int iv;
+
+ if (!s7_is_integer(val))
+ return(simple_wrong_type_argument(sc, sym, val, T_INTEGER));
+
+ iv = s7_integer(val); /* might be bignum if gmp */
+
+ if ((iv < 0) || /* only print-length and float-format-precision can be 0, none can be negative */
+ ((iv == 0) &&
+ ((sym != sc->print_length_symbol) &&
+ (sym != sc->float_format_precision_symbol))))
+ return(simple_out_of_range(sc, sym, val, make_string_wrapper(sc, "should be a positive integer")));
+
+ if (sym == sc->print_length_symbol) {sc->print_length = iv; return(val);}
+ if (sym == sc->default_hash_table_length_symbol) {sc->default_hash_table_length = iv; return(val);}
+ if (sym == sc->max_vector_length_symbol) {sc->max_vector_length = iv; return(val);}
+ if (sym == sc->max_vector_dimensions_symbol) {sc->max_vector_dimensions = iv; return(val);}
+ if (sym == sc->max_list_length_symbol) {sc->max_list_length = iv; return(val);}
+ if (sym == sc->max_string_length_symbol) {sc->max_string_length = iv; return(val);}
+ if (sym == sc->float_format_precision_symbol) {float_format_precision = iv; return(val);}
+ if (sym == sc->initial_string_port_length_symbol) {sc->initial_string_port_length = iv; return(val);}
+ if (sym == sc->history_size_symbol)
{
- s7_int iv;
- iv = s7_integer(val); /* might be bignum if gmp */
- if (iv < 0)
- return(simple_out_of_range(sc, sym, val, make_string_wrapper(sc, "should be a positive integer")));
- if (sym == sc->print_length_symbol)
- sc->print_length = iv;
- else
- {
- if (sym == sc->max_vector_length_symbol)
- sc->max_vector_length = iv;
- else
- {
- if (sym == sc->max_vector_dimensions_symbol)
- sc->max_vector_dimensions = iv;
- else
- {
- if (sym == sc->history_size_symbol)
- {
#if WITH_HISTORY
- s7_pointer p1, p2;
- if (iv > sc->true_history_size)
- {
- /* splice in the new cells, reattach the circles */
- s7_pointer next1, next2;
- next1 = cdr(sc->eval_history1);
- next2 = cdr(sc->eval_history2);
- set_cdr(sc->eval_history1, permanent_list(sc, iv - sc->true_history_size));
- set_cdr(sc->eval_history2, permanent_list(sc, iv - sc->true_history_size));
- for (p1 = sc->eval_history1, p2 = sc->eval_history2; is_pair(cdr(p1)); p1 = cdr(p1), p2 = cdr(p2));
- set_cdr(p1, next1);
- set_cdr(p2, next2);
- sc->true_history_size = iv;
- }
- sc->history_size = iv;
- /* clear out both bufffers to avoid GC confusion */
- for (p1 = sc->eval_history1, p2 = sc->eval_history2; ; p2 = cdr(p2))
- {
- set_car(p1, sc->nil);
- set_car(p2, sc->nil);
- p1 = cdr(p1);
- if (p1 == sc->eval_history1) break;
- }
+ s7_pointer p1, p2;
+ if (iv > sc->true_history_size)
+ {
+ /* splice in the new cells, reattach the circles */
+ s7_pointer next1, next2;
+ next1 = cdr(sc->eval_history1);
+ next2 = cdr(sc->eval_history2);
+ set_cdr(sc->eval_history1, permanent_list(sc, iv - sc->true_history_size));
+ set_cdr(sc->eval_history2, permanent_list(sc, iv - sc->true_history_size));
+ for (p1 = sc->eval_history1, p2 = sc->eval_history2; is_pair(cdr(p1)); p1 = cdr(p1), p2 = cdr(p2));
+ set_cdr(p1, next1);
+ set_cdr(p2, next2);
+ sc->true_history_size = iv;
+ }
+ sc->history_size = iv;
+ /* clear out both bufffers to avoid GC confusion */
+ for (p1 = sc->eval_history1, p2 = sc->eval_history2; ; p2 = cdr(p2))
+ {
+ set_car(p1, sc->nil);
+ set_car(p2, sc->nil);
+ p1 = cdr(p1);
+ if (p1 == sc->eval_history1) break;
+ }
#else
- sc->history_size = iv;
+ sc->history_size = iv;
#endif
- }
- else
- {
- if (sym == sc->max_list_length_symbol)
- sc->max_list_length = iv;
- else sc->max_string_length = iv;
- }
- }
- }
- }
return(val);
}
- return(simple_wrong_type_argument(sc, sym, val, T_INTEGER));
+ if (sym == sc->bignum_precision_symbol)
+ {
+ if (s7_is_integer(val))
+ {
+ sc->bignum_precision = s7_integer(val);
+#if WITH_GMP
+ set_bignum_precision(sc, sc->bignum_precision);
+#endif
+ }
+ }
+ return(val);
}
if (sym == sc->gc_stats_symbol)
@@ -73358,12 +79072,6 @@ static s7_pointer g_s7_let_set_fallback(s7_scheme *sc, s7_pointer args)
return(simple_wrong_type_argument(sc, sym, val, T_BOOLEAN));
}
- if (sym == sc->symbol_table_is_locked_symbol)
- {
- if (s7_is_boolean(val)) {sc->symbol_table_is_locked = (val == sc->T); return(val);}
- return(simple_wrong_type_argument(sc, sym, val, T_BOOLEAN));
- }
-
if (sym == sc->max_stack_size_symbol)
{
if (s7_is_integer(val))
@@ -73398,18 +79106,6 @@ static s7_pointer g_s7_let_set_fallback(s7_scheme *sc, s7_pointer args)
return(simple_wrong_type_argument(sc, sym, val, T_BOOLEAN));
}
- if (sym == sc->default_hash_table_length_symbol)
- {
- if (s7_is_integer(val)) {sc->default_hash_table_length = s7_integer(val); return(val);}
- return(simple_wrong_type_argument(sc, sym, val, T_INTEGER));
- }
-
- if (sym == sc->initial_string_port_length_symbol)
- {
- if (s7_is_integer(val)) {sc->initial_string_port_length = s7_integer(val); return(val);}
- return(simple_wrong_type_argument(sc, sym, val, T_INTEGER));
- }
-
if (sym == sc->morally_equal_float_epsilon_symbol)
{
if (s7_is_real(val)) {sc->morally_equal_float_epsilon = s7_real(val); return(val);}
@@ -73422,12 +79118,6 @@ static s7_pointer g_s7_let_set_fallback(s7_scheme *sc, s7_pointer args)
return(simple_wrong_type_argument(sc, sym, val, T_REAL));
}
- if (sym == sc->float_format_precision_symbol)
- {
- if (s7_is_integer(val)) {float_format_precision = s7_integer(val); return(val);}
- return(simple_wrong_type_argument(sc, sym, val, T_INTEGER));
- }
-
if (sym == sc->default_rationalize_error_symbol)
{
if (s7_is_real(val)) {sc->default_rationalize_error = real_to_double(sc, val, "set! default-rationalize-error"); return(val);}
@@ -73461,25 +79151,12 @@ static s7_pointer g_s7_let_set_fallback(s7_scheme *sc, s7_pointer args)
return(wrong_type_argument_with_type(sc, sym, 3, caddr(val), make_string_wrapper(sc, "an integer (line length)")));
if (!is_integer(cadddr(val)))
return(wrong_type_argument_with_type(sc, sym, 4, cadddr(val), make_string_wrapper(sc, "an integer (comment position)")));
- if (!s7_is_boolean(s7_list_ref(sc,val, 4)))
+ if (!s7_is_boolean(s7_list_ref(sc, val, 4)))
return(wrong_type_argument_with_type(sc, sym, 5, s7_list_ref(sc, val, 4), make_string_wrapper(sc, "a boolean (treat-data-as-comment)")));
sc->stacktrace_defaults = copy_list(sc, val);
return(val);
}
- if (sym == sc->bignum_precision_symbol)
- {
- if (s7_is_integer(val))
- {
- sc->bignum_precision = s7_integer(val);
-#if WITH_GMP
- set_bignum_precision(sc, sc->bignum_precision);
-#endif
- return(val);
- }
- return(simple_wrong_type_argument(sc, sym, val, T_INTEGER));
- }
-
if ((sym == sc->cpu_time_symbol) ||
(sym == sc->heap_size_symbol) || (sym == sc->free_heap_size_symbol) ||
(sym == sc->gc_freed_symbol) || (sym == sc->gc_protected_objects_symbol) ||
@@ -73491,6 +79168,7 @@ static s7_pointer g_s7_let_set_fallback(s7_scheme *sc, s7_pointer args)
return(sc->undefined);
}
+
/* some procedure-signature support functions */
static s7_pointer g_is_float(s7_scheme *sc, s7_pointer args)
@@ -73499,9 +79177,12 @@ static s7_pointer g_is_float(s7_scheme *sc, s7_pointer args)
#define Q_is_float pl_bt
s7_pointer p;
p = car(args);
- return(make_boolean(sc, ((is_real(p)) && (!is_rational(p)))));
+ return(make_boolean(sc, is_float(p)));
}
+static bool is_float_b(s7_pointer p) {return(is_float(p));}
+
+
static s7_pointer g_is_proper_list(s7_scheme *sc, s7_pointer args)
{
#define H_is_proper_list "(proper-list? x) returns #t is x is a list that is neither circular nor dotted."
@@ -73511,8 +79192,10 @@ static s7_pointer g_is_proper_list(s7_scheme *sc, s7_pointer args)
return(make_boolean(sc, is_proper_list(sc, p)));
}
+static bool is_proper_list_b(s7_pointer p) {return(is_proper_list(cur_sc, p));}
-#ifndef _MSC_VER
+
+#if (!MS_WINDOWS)
/* gdb stacktrace decoding */
static bool is_decodable(s7_scheme *sc, s7_pointer p)
@@ -73524,7 +79207,7 @@ static bool is_decodable(s7_scheme *sc, s7_pointer p)
if ((void *)p == (void *)sc) return(false);
/* check basic constants */
- if ((p == sc->nil) || (p == sc->T) || (p == sc->F) || (p == sc->eof_object) || (p == sc->else_object) || (p == sc->rootlet) ||
+ if ((p == sc->nil) || (p == sc->T) || (p == sc->F) || (p == sc->eof_object) || (p == sc->else_symbol) || (p == sc->rootlet) ||
(p == sc->undefined) || (p == sc->unspecified) || (p == sc->no_value) || (p == sc->gc_nil) ||
(p == sc->t1_1) || (p == sc->t2_1) || (p == sc->t3_1) || (p == sc->a1_1) || (p == sc->a2_1) || (p == sc->a3_1) || (p == sc->a4_1))
return(true);
@@ -73565,7 +79248,7 @@ char *s7_decode_bt(void)
bool in_quotes = false;
unsigned char *bt;
s7_scheme *sc;
- sc = hidden_sc;
+ sc = cur_sc;
fseek(fp, 0, SEEK_END);
size = ftell(fp);
@@ -73659,7 +79342,7 @@ s7_scheme *s7_init(void)
s7_pointer sym;
static bool already_inited = false;
-#ifndef _MSC_VER
+#if (!MS_WINDOWS)
setlocale(LC_NUMERIC, "C"); /* use decimal point in floats */
#endif
@@ -73668,13 +79351,10 @@ s7_scheme *s7_init(void)
init_types();
init_ctables();
init_mark_functions();
+ init_display_functions();
init_equals();
init_hash_maps();
init_pows();
-#if (!WITH_GMP)
- init_add_ops();
- init_multiply_ops();
-#endif
init_uppers();
all_x_function_init();
init_catchers();
@@ -73685,20 +79365,25 @@ s7_scheme *s7_init(void)
else float_format_g = "%.*g"; /* float and double */
}
+#if DEBUGGING && SHOW_DEBUG_HISTORY
+ for (i = 0; i < DEBUG_HISTORY_SIZE; i++)
+ debug_history[i] = NULL;
+ debug_history_loc = 0;
+#endif
sc = (s7_scheme *)calloc(1, sizeof(s7_scheme)); /* malloc is not recommended here */
- hidden_sc = sc; /* for gdb/debugging */
+ cur_sc = sc; /* for gdb/debugging */
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);
+ init_string_free_lists(sc);
sc->longjmp_ok = false;
sc->setjmp_loc = NO_SET_JUMP;
- sc->symbol_table_is_locked = false;
if (sizeof(s7_int) == 4)
sc->max_vector_length = (1 << 24);
else sc->max_vector_length = (1LL << 32);
- sc->max_string_length = 1073741824;
+ sc->max_string_length = 1073741824; /* 1 << 30 */
sc->max_list_length = 1073741824;
sc->max_vector_dimensions = 512;
@@ -73717,22 +79402,17 @@ s7_scheme *s7_init(void)
sc->read_line_buf = NULL;
sc->read_line_buf_size = 0;
- sc->cur_rf = NULL;
- sc->rf_free_list = NULL;
- sc->rf_stack = NULL;
-
sc->nil = make_unique_object("()", T_NIL);
- sc->gc_nil = make_unique_object("#<nil>", T_UNIQUE);
+ sc->gc_nil = make_unique_object("#<nil>", T_NIL); /* ?? perhaps a unique type for this? */
sc->T = make_unique_object("#t", T_BOOLEAN);
sc->F = make_unique_object("#f", T_BOOLEAN);
- sc->eof_object = make_unique_object("#<eof>", T_UNIQUE);
- sc->undefined = make_unique_object("#<undefined>", T_UNIQUE);
- sc->else_object = make_unique_object("else", T_UNIQUE);
- /* "else" is added to the rootlet below -- can't do it here because the symbol table and environment don't exist yet. */
+ sc->eof_object = make_unique_object("#<eof>", T_EOF_OBJECT);
+ sc->undefined = make_unique_object("#<undefined>", T_UNDEFINED);
sc->unspecified = make_unique_object("#<unspecified>", T_UNSPECIFIED);
sc->no_value = make_unique_object("#<unspecified>", T_UNSPECIFIED);
- set_car(sc->nil, set_cdr(sc->nil, sc->unspecified));
+ unique_car(sc->nil) = sc->unspecified;
+ unique_cdr(sc->nil) = sc->unspecified;
/* this is mixing two different s7_cell structs, cons and envr, but luckily
* envr has two initial s7_pointer fields, equivalent to car and cdr, so
* let_id which is the same as opt1 is unaffected. To get the names
@@ -73771,9 +79451,10 @@ s7_scheme *s7_init(void)
sc->a3_2 = sc->a4_3;
sc->a3_3 = sc->a4_4;
- sc->safe_lists = (s7_pointer *)calloc(NUM_SAFE_LISTS, sizeof(s7_pointer));
+ /* sc->safe_lists = (s7_pointer *)calloc(NUM_SAFE_LISTS, sizeof(s7_pointer)); */
for (i = 1; i < NUM_SAFE_LISTS; i++)
- sc->safe_lists[i] = permanent_list(sc, i);
+ sc->safe_lists[i] = sc->nil; /* permanent_list(sc, i); */
+ sc->current_safe_list = 0;
sc->input_port_stack = sc->nil;
sc->code = sc->nil;
@@ -73810,6 +79491,9 @@ s7_scheme *s7_init(void)
sc->temp9 = sc->nil;
sc->temp10 = sc->nil;
sc->temp11 = sc->nil;
+ /* sc->t_temps = (s7_pointer *)malloc(T_TEMPS_SIZE * sizeof(s7_pointer)); */
+ for (i = 0; i < T_TEMPS_SIZE; i++) sc->t_temps[i] = sc->nil;
+ sc->t_temp_ctr = 0;
sc->begin_hook = NULL;
sc->autoload_table = sc->nil;
@@ -73898,6 +79582,23 @@ s7_scheme *s7_init(void)
string_value(p) = (char *)malloc(INITIAL_TMP_STR_SIZE * sizeof(char));
string_temp_true_length(p) = INITIAL_TMP_STR_SIZE;
}
+
+ sc->opts[0] = (opt_info *)calloc(1, sizeof(opt_info));
+ for (i = 1; i < OPTS_SIZE; i++)
+ sc->opts[i] = (opt_info *)calloc(1, sizeof(opt_info));
+ sc->funcalls = 0;
+ sc->unwraps = 0;
+
+#if WITH_MULTITHREAD_CHECKS
+ sc->lock_count = 0;
+ {
+ pthread_mutexattr_t attr;
+ pthread_mutexattr_init(&attr);
+ pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);
+ pthread_mutex_init(&sc->lock, &attr);
+ }
+#endif
+
sc->typnam = NULL;
sc->typnam_len = 0;
sc->help_arglist = NULL;
@@ -73919,7 +79620,7 @@ s7_scheme *s7_init(void)
sc->s7_call_line = 0;
sc->s7_call_file = NULL;
sc->s7_call_name = NULL;
- sc->safety = 0;
+ sc->safety = NO_SAFETY;
sc->print_length = 8;
sc->history_size = DEFAULT_HISTORY_SIZE;
sc->true_history_size = DEFAULT_HISTORY_SIZE;
@@ -73933,6 +79634,7 @@ s7_scheme *s7_init(void)
sc->plist_1 = permanent_list(sc, 1);
sc->plist_2 = permanent_list(sc, 2);
sc->plist_3 = permanent_list(sc, 3);
+ sc->qlist_2 = permanent_list(sc, 2);
sc->elist_1 = permanent_list(sc, 1);
sc->elist_2 = permanent_list(sc, 2);
sc->elist_3 = permanent_list(sc, 3);
@@ -73944,7 +79646,7 @@ s7_scheme *s7_init(void)
sc->dox_slot_symbol = s7_make_symbol(sc, "(dox_slot)");
sc->rootlet = s7_make_vector(sc, ROOTLET_SIZE);
- set_type(sc->rootlet, T_LET);
+ set_type(sc->rootlet, T_LET | T_SAFE_PROCEDURE);
sc->rootlet_entries = 0;
for (i = 0; i < ROOTLET_SIZE; i++)
vector_element(sc->rootlet, i) = sc->nil;
@@ -74075,6 +79777,7 @@ s7_scheme *s7_init(void)
#define with_baffle_help "(with-baffle ...) evaluates its body in a context that is safe from outside interference."
#define macroexpand_help "(macroexpand macro-call) returns the result of the expansion phase of evaluating the macro call."
#define with_let_help "(with-let env ...) evaluates its body in the environment env."
+ #define let_temporarily_help "(let-temporarily ((var value)...) . body) sets each var to its new value, evals body, then returns each var to its original value."
sc->quote_symbol = assign_syntax(sc, "quote", OP_QUOTE, small_int(1), small_int(1), quote_help);
sc->if_symbol = assign_syntax(sc, "if", OP_IF, small_int(2), small_int(3), if_help);
@@ -74104,19 +79807,9 @@ s7_scheme *s7_init(void)
sc->with_baffle_symbol = assign_syntax(sc, "with-baffle", OP_WITH_BAFFLE, small_int(1), max_arity, with_baffle_help);
sc->macroexpand_symbol = assign_syntax(sc, "macroexpand", OP_MACROEXPAND, small_int(1), small_int(1), macroexpand_help);
sc->with_let_symbol = assign_syntax(sc, "with-let", OP_WITH_LET, small_int(1), max_arity, with_let_help);
+ sc->let_temporarily_symbol = assign_syntax(sc, "let-temporarily", OP_LET_TEMPORARILY, small_int(2), max_arity, let_temporarily_help);
set_immutable(sc->with_let_symbol);
-#if WITH_OPTIMIZATION
- syntax_rp(slot_value(global_slot(sc->set_symbol))) = set_rf;
- syntax_ip(slot_value(global_slot(sc->set_symbol))) = set_if;
- syntax_pp(slot_value(global_slot(sc->set_symbol))) = set_pf;
- syntax_rp(slot_value(global_slot(sc->if_symbol))) = if_rf;
- syntax_pp(slot_value(global_slot(sc->if_symbol))) = if_pf;
- syntax_pp(slot_value(global_slot(sc->or_symbol))) = or_pf;
- syntax_pp(slot_value(global_slot(sc->and_symbol))) = and_pf;
- syntax_pp(slot_value(global_slot(sc->quote_symbol))) = quote_pf;
-#endif
-
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->with_baffle_unchecked_symbol = assign_internal_syntax(sc, "with-baffle", OP_WITH_BAFFLE_UNCHECKED);
@@ -74127,16 +79820,22 @@ s7_scheme *s7_init(void)
sc->let_no_vars_symbol = assign_internal_syntax(sc, "let", OP_LET_NO_VARS);
sc->let_c_symbol = assign_internal_syntax(sc, "let", OP_LET_C);
sc->let_s_symbol = assign_internal_syntax(sc, "let", OP_LET_S);
+ sc->let_s_z_symbol = assign_internal_syntax(sc, "let", OP_LET_S_Z);
sc->let_all_c_symbol = assign_internal_syntax(sc, "let", OP_LET_ALL_C);
sc->let_all_s_symbol = assign_internal_syntax(sc, "let", OP_LET_ALL_S);
sc->let_all_x_symbol = assign_internal_syntax(sc, "let", OP_LET_ALL_X);
sc->let_star_all_x_symbol = assign_internal_syntax(sc, "let*", OP_LET_STAR_ALL_X);
sc->let_opcq_symbol = assign_internal_syntax(sc, "let", OP_LET_opCq);
sc->let_opssq_symbol = assign_internal_syntax(sc, "let", OP_LET_opSSq);
+ sc->let_opssq_e_symbol = assign_internal_syntax(sc, "let", OP_LET_opSSq_E);
+ sc->let_opassq_e_symbol = assign_internal_syntax(sc, "let", OP_LET_opaSSq_E);
+ sc->let_car_symbol = assign_internal_syntax(sc, "let", OP_LET_CAR);
sc->let_opsq_symbol = assign_internal_syntax(sc, "let", OP_LET_opSq);
sc->let_opsq_p_symbol = assign_internal_syntax(sc, "let", OP_LET_opSq_P);
sc->let_one_symbol = assign_internal_syntax(sc, "let", OP_LET_ONE);
sc->let_z_symbol = assign_internal_syntax(sc, "let", OP_LET_Z);
+ sc->let_a_symbol = assign_internal_syntax(sc, "let", OP_LET_A);
+ sc->let_a_z_symbol = assign_internal_syntax(sc, "let", OP_LET_A_Z);
sc->let_all_opsq_symbol = assign_internal_syntax(sc, "let", OP_LET_ALL_opSq);
sc->named_let_no_vars_symbol = assign_internal_syntax(sc, "let", OP_NAMED_LET_NO_VARS);
sc->named_let_symbol = assign_internal_syntax(sc, "let", OP_NAMED_LET);
@@ -74144,17 +79843,20 @@ s7_scheme *s7_init(void)
sc->let_star2_symbol = assign_internal_syntax(sc, "let*", OP_LET_STAR2);
sc->with_let_unchecked_symbol = assign_internal_syntax(sc, "with-let", OP_WITH_LET_UNCHECKED);
sc->with_let_s_symbol = assign_internal_syntax(sc, "with-let", OP_WITH_LET_S);
+ sc->let_temporarily_unchecked_symbol = assign_internal_syntax(sc, "let-temporarily", OP_LET_TEMP_UNCHECKED);
sc->case_unchecked_symbol = assign_internal_syntax(sc, "case", OP_CASE_UNCHECKED);
- sc->case_simple_symbol = assign_internal_syntax(sc, "case", OP_CASE_SIMPLE);
- sc->case_simpler_symbol = assign_internal_syntax(sc, "case", OP_CASE_SIMPLER);
- sc->case_simpler_1_symbol = assign_internal_syntax(sc, "case", OP_CASE_SIMPLER_1);
- sc->case_simpler_ss_symbol = assign_internal_syntax(sc, "case", OP_CASE_SIMPLER_SS);
- sc->case_simplest_symbol = assign_internal_syntax(sc, "case", OP_CASE_SIMPLEST);
- sc->case_simplest_ss_symbol = assign_internal_syntax(sc, "case", OP_CASE_SIMPLEST_SS);
- sc->case_else_symbol = assign_internal_syntax(sc, "case", OP_CASE_ELSE);
sc->cond_unchecked_symbol = assign_internal_syntax(sc, "cond", OP_COND_UNCHECKED);
- sc->cond_simple_symbol = assign_internal_syntax(sc, "cond", OP_COND_SIMPLE);
+
sc->do_unchecked_symbol = assign_internal_syntax(sc, "do", OP_DO_UNCHECKED);
+ sc->dotimes_p_symbol = assign_internal_syntax(sc, "do", OP_DOTIMES_P);
+ sc->simple_do_symbol = assign_internal_syntax(sc, "do", OP_SIMPLE_DO);
+ sc->safe_dotimes_symbol = assign_internal_syntax(sc, "do", OP_SAFE_DOTIMES);
+ sc->safe_do_symbol = assign_internal_syntax(sc, "do", OP_SAFE_DO);
+ sc->dox_symbol = assign_internal_syntax(sc, "do", OP_DOX);
+ sc->do_no_vars_symbol = assign_internal_syntax(sc, "do", OP_DO_NO_VARS);
+ sc->do_no_vars_no_opt_symbol = assign_internal_syntax(sc, "do", OP_DO_NO_VARS_NO_OPT);
+ sc->dotimes_one_step_symbol = assign_internal_syntax(sc, "do", OP_DOTIMES_ONE_STEP);
+
sc->lambda_unchecked_symbol = assign_internal_syntax(sc, "lambda", OP_LAMBDA_UNCHECKED);
sc->lambda_star_unchecked_symbol = assign_internal_syntax(sc, "lambda*", OP_LAMBDA_STAR_UNCHECKED);
sc->define_unchecked_symbol = assign_internal_syntax(sc, "define", OP_DEFINE_UNCHECKED);
@@ -74163,6 +79865,7 @@ s7_scheme *s7_init(void)
sc->define_constant_unchecked_symbol = assign_internal_syntax(sc, "define-constant", OP_DEFINE_CONSTANT_UNCHECKED);
sc->set_unchecked_symbol = assign_internal_syntax(sc, "set!", OP_SET_UNCHECKED);
sc->set_symbol_c_symbol = assign_internal_syntax(sc, "set!", OP_SET_SYMBOL_C);
+ sc->set_symbol_l_symbol = assign_internal_syntax(sc, "set!", OP_SET_SYMBOL_L);
sc->set_symbol_s_symbol = assign_internal_syntax(sc, "set!", OP_SET_SYMBOL_S);
sc->set_symbol_q_symbol = assign_internal_syntax(sc, "set!", OP_SET_SYMBOL_Q);
sc->set_symbol_opsq_symbol = assign_internal_syntax(sc, "set!", OP_SET_SYMBOL_opSq);
@@ -74175,6 +79878,8 @@ s7_scheme *s7_init(void)
sc->set_normal_symbol = assign_internal_syntax(sc, "set!", OP_SET_NORMAL);
sc->set_pws_symbol = assign_internal_syntax(sc, "set!", OP_SET_PWS);
sc->set_pair_symbol = assign_internal_syntax(sc, "set!", OP_SET_PAIR);
+ sc->set_dilambda_symbol = assign_internal_syntax(sc, "set!", OP_SET_DILAMBDA);
+ sc->set_dilambda_z_symbol = assign_internal_syntax(sc, "set!", OP_SET_DILAMBDA_Z);
sc->set_pair_p_symbol = assign_internal_syntax(sc, "set!", OP_SET_PAIR_P);
sc->set_pair_z_symbol = assign_internal_syntax(sc, "set!", OP_SET_PAIR_Z);
sc->set_pair_a_symbol = assign_internal_syntax(sc, "set!", OP_SET_PAIR_A);
@@ -74193,62 +79898,69 @@ s7_scheme *s7_init(void)
sc->set_cons_symbol = assign_internal_syntax(sc, "set!", OP_SET_CONS);
sc->and_unchecked_symbol = assign_internal_syntax(sc, "and", OP_AND_UNCHECKED);
sc->and_p_symbol = assign_internal_syntax(sc, "and", OP_AND_P);
- sc->and_p2_symbol = assign_internal_syntax(sc, "and", OP_AND_P2);
+ sc->and_ap_symbol = assign_internal_syntax(sc, "and", OP_AND_AP);
+ sc->and_az_symbol = assign_internal_syntax(sc, "and", OP_AND_AZ);
+ sc->and_safe_p_symbol = assign_internal_syntax(sc, "and", OP_AND_SAFE_P);
+ sc->and_safe_aa_symbol = assign_internal_syntax(sc, "and", OP_AND_SAFE_AA);
sc->or_unchecked_symbol = assign_internal_syntax(sc, "or", OP_OR_UNCHECKED);
sc->or_p_symbol = assign_internal_syntax(sc, "or", OP_OR_P);
- sc->or_p2_symbol = assign_internal_syntax(sc, "or", OP_OR_P2);
+ sc->or_ap_symbol = assign_internal_syntax(sc, "or", OP_OR_AP);
+ sc->or_az_symbol = assign_internal_syntax(sc, "or", OP_OR_AZ);
+ sc->or_safe_p_symbol = assign_internal_syntax(sc, "or", OP_OR_SAFE_P);
+ sc->or_safe_aa_symbol = assign_internal_syntax(sc, "or", OP_OR_SAFE_AA);
sc->if_unchecked_symbol = assign_internal_syntax(sc, "if", OP_IF_UNCHECKED);
- sc->if_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_P_P);
- sc->if_p_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_P_P_P);
- sc->if_andp_p_symbol = assign_internal_syntax(sc, "if", OP_IF_ANDP_P);
- sc->if_andp_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_ANDP_P_P);
- sc->if_orp_p_symbol = assign_internal_syntax(sc, "if", OP_IF_ORP_P);
- sc->if_orp_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_ORP_P_P);
- sc->if_s_p_symbol = assign_internal_syntax(sc, "if", OP_IF_S_P);
- sc->if_s_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_S_P_P);
- sc->if_p_feed_symbol = assign_internal_syntax(sc, "cond", OP_IF_P_FEED);
+ sc->cond_unchecked_z_symbol = assign_internal_syntax(sc, "cond", OP_COND_UNCHECKED_Z);
+ sc->cond_simple_symbol = assign_internal_syntax(sc, "cond", OP_COND_SIMPLE);
+ sc->cond_feed_symbol = assign_internal_syntax(sc, "cond", OP_COND_FEED);
+ sc->cond_all_x_z_symbol = assign_internal_syntax(sc, "cond", OP_COND_ALL_X_Z);
sc->cond_all_x_symbol = assign_internal_syntax(sc, "cond", OP_COND_ALL_X);
sc->cond_all_x_2_symbol = assign_internal_syntax(sc, "cond", OP_COND_ALL_X_2);
- sc->cond_s_symbol = assign_internal_syntax(sc, "cond", OP_COND_S);
- sc->if_z_p_symbol = assign_internal_syntax(sc, "if", OP_IF_Z_P);
- sc->if_z_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_Z_P_P);
- sc->if_a_p_symbol = assign_internal_syntax(sc, "if", OP_IF_A_P);
- sc->if_a_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_A_P_P);
- sc->if_cc_p_symbol = assign_internal_syntax(sc, "if", OP_IF_CC_P);
- sc->if_cc_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_CC_P_P);
- sc->if_cs_p_symbol = assign_internal_syntax(sc, "if", OP_IF_CS_P);
- sc->if_cs_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_CS_P_P);
- sc->if_csq_p_symbol = assign_internal_syntax(sc, "if", OP_IF_CSQ_P);
- sc->if_csq_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_CSQ_P_P);
- sc->if_css_p_symbol = assign_internal_syntax(sc, "if", OP_IF_CSS_P);
- sc->if_css_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_CSS_P_P);
- sc->if_csc_p_symbol = assign_internal_syntax(sc, "if", OP_IF_CSC_P);
- sc->if_csc_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_CSC_P_P);
- sc->if_s_opcq_p_symbol = assign_internal_syntax(sc, "if", OP_IF_S_opCq_P);
- sc->if_s_opcq_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_S_opCq_P_P);
- sc->if_opssq_p_symbol = assign_internal_syntax(sc, "if", OP_IF_opSSq_P);
- sc->if_opssq_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_opSSq_P_P);
- sc->if_is_pair_p_symbol = assign_internal_syntax(sc, "if", OP_IF_IS_PAIR_P);
- sc->if_is_pair_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_IS_PAIR_P_P);
- sc->if_is_symbol_p_symbol = assign_internal_syntax(sc, "if", OP_IF_IS_SYMBOL_P);
- sc->if_is_symbol_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_IS_SYMBOL_P_P);
- sc->if_not_s_p_symbol = assign_internal_syntax(sc, "if", OP_IF_NOT_S_P);
- sc->if_not_s_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_NOT_S_P_P);
- sc->if_and2_p_symbol = assign_internal_syntax(sc, "if", OP_IF_AND2_P);
- sc->if_and2_p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_AND2_P_P);
+
+ #define assign_if(Sym, Op) \
+ sc->if_ ## Sym ## _p_symbol = assign_internal_syntax(sc, "if", OP_IF_ ## Op ## _P); \
+ sc->if_ ## Sym ## _p_p_symbol = assign_internal_syntax(sc, "if", OP_IF_ ## Op ## _P_P); \
+ sc->if_ ## Sym ## _n_symbol = assign_internal_syntax(sc, "if", OP_IF_ ## Op ## _N); \
+ sc->if_ ## Sym ## _n_n_symbol = assign_internal_syntax(sc, "if", OP_IF_ ## Op ## _N_N); \
+ sc->if_ ## Sym ## _r_symbol = assign_internal_syntax(sc, "if", OP_IF_ ## Op ## _R);
+
+ assign_if(p, P)
+ assign_if(andp, ANDP)
+ assign_if(orp, ORP)
+ assign_if(and2, AND2)
+ assign_if(or2, OR2)
+ assign_if(z, Z)
+ assign_if(s, S)
+ assign_if(a, A)
+ assign_if(c, C)
+ assign_if(cs, CS)
+ assign_if(csq, CSQ)
+ assign_if(css, CSS)
+ 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)
+ /* CLL and CLC happen a few times, but make no difference */
+
+ #define assign_case(Sym, Op) \
+ sc->case_ ## Sym ## _e_s_symbol = assign_internal_syntax(sc, "case", OP_CASE_ ## Op ## _E_S); \
+ sc->case_ ## Sym ## _i_s_symbol = assign_internal_syntax(sc, "case", OP_CASE_ ## Op ## _I_S); \
+ sc->case_ ## Sym ## _g_s_symbol = assign_internal_syntax(sc, "case", OP_CASE_ ## Op ## _G_S); \
+ sc->case_ ## Sym ## _e_g_symbol = assign_internal_syntax(sc, "case", OP_CASE_ ## Op ## _E_G); \
+ sc->case_ ## Sym ## _g_g_symbol = assign_internal_syntax(sc, "case", OP_CASE_ ## Op ## _G_G);
+ assign_case(a, A)
+ assign_case(s, S)
+ assign_case(p, P)
+
sc->when_s_symbol = assign_internal_syntax(sc, "when", OP_WHEN_S);
+ sc->when_a_symbol = assign_internal_syntax(sc, "when", OP_WHEN_A);
+ sc->when_p_symbol = assign_internal_syntax(sc, "when", OP_WHEN_P);
sc->unless_s_symbol = assign_internal_syntax(sc, "unless", OP_UNLESS_S);
+ sc->unless_a_symbol = assign_internal_syntax(sc, "unless", OP_UNLESS_A);
sc->when_unchecked_symbol = assign_internal_syntax(sc, "when", OP_WHEN_UNCHECKED);
sc->unless_unchecked_symbol = assign_internal_syntax(sc, "unless", OP_UNLESS_UNCHECKED);
- sc->dotimes_p_symbol = assign_internal_syntax(sc, "do", OP_DOTIMES_P);
- sc->simple_do_symbol = assign_internal_syntax(sc, "do", OP_SIMPLE_DO);
- sc->simple_do_p_symbol = assign_internal_syntax(sc, "do", OP_SIMPLE_DO_P);
- sc->simple_do_a_symbol = assign_internal_syntax(sc, "do", OP_SIMPLE_DO_A);
- sc->simple_do_e_symbol = assign_internal_syntax(sc, "do", OP_SIMPLE_DO_E);
- sc->safe_dotimes_symbol = assign_internal_syntax(sc, "do", OP_SAFE_DOTIMES);
- sc->safe_do_symbol = assign_internal_syntax(sc, "do", OP_SAFE_DO);
- sc->dox_symbol = assign_internal_syntax(sc, "do", OP_DOX);
sc->documentation_symbol = make_symbol(sc, "documentation");
sc->signature_symbol = make_symbol(sc, "signature");
@@ -74277,6 +79989,7 @@ s7_scheme *s7_init(void)
sc->out_of_range_symbol = make_symbol(sc, "out-of-range");
sc->no_catch_symbol = make_symbol(sc, "no-catch");
sc->io_error_symbol = make_symbol(sc, "io-error");
+ sc->missing_method_symbol = make_symbol(sc, "missing-method");
sc->invalid_escape_function_symbol = make_symbol(sc, "invalid-escape-function");
sc->baffled_symbol = make_symbol(sc, "baffled!");
@@ -74286,11 +79999,14 @@ s7_scheme *s7_init(void)
sc->value_symbol = s7_make_symbol(sc, "value");
sc->type_symbol = s7_make_symbol(sc, "type");
+ sc->else_symbol = s7_make_symbol(sc, "else");
+ s7_make_slot(sc, sc->nil, sc->else_symbol, sc->else_symbol);
+ sc->__func___symbol = s7_make_symbol(sc, "__func__");
- sc->__func___symbol = make_symbol(sc, "__func__");
- s7_make_slot(sc, sc->nil, sc->else_symbol = make_symbol(sc, "else"), sc->else_object);
sc->owlet = init_owlet(sc);
+ sc->err_wrap1 = make_permanent_string_wrapper();
+ sc->err_wrap2 = make_permanent_string_wrapper();
sc->wrong_type_arg_info = permanent_list(sc, 6);
set_car(sc->wrong_type_arg_info, s7_make_permanent_string("~A argument ~D, ~S, is ~A but should be ~A"));
@@ -74307,6 +80023,7 @@ s7_scheme *s7_init(void)
sc->not_enough_arguments_string = s7_make_permanent_string("~A: not enough arguments: ~A");
sc->division_by_zero_error_string = s7_make_permanent_string("~A: division by zero, ~S");
sc->division_by_zero_symbol = make_symbol(sc, "division-by-zero");
+ sc->missing_method_string = s7_make_permanent_string("missing ~S method in ~S");
if (!already_inited)
init_car_a_list();
@@ -74331,6 +80048,7 @@ s7_scheme *s7_init(void)
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_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);
@@ -74366,10 +80084,10 @@ s7_scheme *s7_init(void)
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);
- /* do we need 'syntax? */
/* these are for signatures */
sc->is_unspecified_symbol = s7_make_symbol(sc, "unspecified?");
+ sc->is_undefined_symbol = s7_make_symbol(sc, "undefined?");
sc->is_integer_or_real_at_end_symbol = s7_make_symbol(sc, "integer:real?");
sc->is_integer_or_any_at_end_symbol = s7_make_symbol(sc, "integer:any?");
@@ -74395,7 +80113,7 @@ s7_scheme *s7_init(void)
sc->values_symbol = make_symbol(sc, "values");
sc->gensym_symbol = defun("gensym", gensym, 0, 1, false);
- defun("symbol-table", symbol_table, 0, 0, false);
+ sc->symbol_table_symbol = defun("symbol-table", symbol_table, 0, 0, false);
sc->symbol_to_string_symbol = defun("symbol->string", symbol_to_string, 1, 0, false);
sc->string_to_symbol_symbol = defun("string->symbol", string_to_symbol, 1, 0, false);
sc->symbol_symbol = defun("symbol", symbol, 1, 0, true);
@@ -74441,7 +80159,10 @@ s7_scheme *s7_init(void)
sc->port_filename_symbol = defun("port-filename", port_filename, 0, 1, false);
sc->pair_line_number_symbol = defun("pair-line-number", pair_line_number, 1, 0, false);
sc->pair_filename_symbol = defun("pair-filename", pair_filename, 1, 0, false);
-
+#if WITH_PROFILE
+ defun("profile-line-number", profile_line_number, 1, 0, false);
+ defun("profile-filename", profile_filename, 1, 0, false);
+#endif
sc->is_port_closed_symbol = defun("port-closed?", is_port_closed, 1, 0, false);
sc->current_input_port_symbol = defun("current-input-port", current_input_port, 0, 0, false);
@@ -74461,7 +80182,7 @@ s7_scheme *s7_init(void)
sc->open_input_file_symbol = defun("open-input-file", open_input_file, 1, 1, false);
sc->open_output_file_symbol = defun("open-output-file", open_output_file, 1, 1, false);
sc->open_input_string_symbol = defun("open-input-string", open_input_string, 1, 0, false);
- defun("open-output-string", open_output_string, 0, 0, false);
+ sc->open_output_string_symbol = defun("open-output-string", open_output_string, 0, 0, false);
sc->get_output_string_symbol = defun("get-output-string", get_output_string, 1, 1, false);
sc->newline_symbol = defun("newline", newline, 0, 1, false);
@@ -74479,7 +80200,11 @@ s7_scheme *s7_init(void)
/* read can't be safe because it messes with the stack, expecting to be all by itself in the call sequence
* (not embedded in OP_SAFE_C_opSq for example) -- that is, it pushes OP_READ_INTERNAL, then returns
* expecting goto START, which would be nonsense if arg=c_call(read) -> c_call(arg).
- * a safe procedure leaves its argument list alone and does not push anything on the stack
+ * a safe procedure leaves its argument list alone, does not push anything on the stack,
+ * and leaves sc->code|args unscathed (c_call assumes that is the case). The stack part can
+ * be hidden: if a c_function calls s7_apply_function (lambda passed as arg as in some clm gens)
+ * then is called with args that use all_x*, and the lambda func does the same, the two calls
+ * can step on each other.
*/
sc->call_with_input_string_symbol = unsafe_defun("call-with-input-string", call_with_input_string, 2, 0, false);
@@ -74498,7 +80223,7 @@ s7_scheme *s7_init(void)
sc->delete_file_symbol = defun("delete-file", delete_file, 1, 0, false);
sc->getenv_symbol = defun("getenv", getenv, 1, 0, false);
sc->system_symbol = defun("system", system, 1, 1, false);
-#ifndef _MSC_VER
+#if (!MS_WINDOWS)
sc->directory_to_list_symbol = defun("directory->list", directory_to_list, 1, 0, false);
sc->file_mtime_symbol = defun("file-mtime", file_mtime, 1, 0, false);
#endif
@@ -74637,7 +80362,7 @@ s7_scheme *s7_init(void)
sc->string_append_symbol = defun("string-append", string_append, 0, 0, true);
sc->substring_symbol = defun("substring", substring, 2, 1, false);
sc->string_symbol = defun("string", string, 0, 0, true);
- sc->object_to_string_symbol = defun("object->string", object_to_string, 1, 1, false);
+ sc->object_to_string_symbol = defun("object->string", object_to_string, 1, 2, false);
sc->format_symbol = defun("format", format, 1, 0, true);
/* this was unsafe, but was that due to the (ill-advised) use of temp_call_2 in the arg lists? */
sc->object_to_let_symbol = defun("object->let", object_to_let, 1, 0, false);
@@ -74679,11 +80404,9 @@ s7_scheme *s7_init(void)
sc->assq_symbol = defun("assq", assq, 2, 0, false);
sc->assv_symbol = defun("assv", assv, 2, 0, false);
sc->assoc_symbol = unsafe_defun("assoc", assoc, 2, 1, false);
- set_is_possibly_safe(slot_value(global_slot(sc->assoc_symbol)));
sc->memq_symbol = defun("memq", memq, 2, 0, false);
sc->memv_symbol = defun("memv", memv, 2, 0, false);
sc->member_symbol = unsafe_defun("member", member, 2, 1, false);
- set_is_possibly_safe(slot_value(global_slot(sc->member_symbol)));
sc->list_symbol = defun("list", list, 0, 0, true);
sc->list_ref_symbol = defun("list-ref", list_ref, 2, 0, true);
@@ -74742,7 +80465,7 @@ s7_scheme *s7_init(void)
sc->hash_table_set_symbol = defun("hash-table-set!", hash_table_set, 3, 0, false);
sc->hash_table_entries_symbol = defun("hash-table-entries", hash_table_entries, 1, 0, false);
- defun("cyclic-sequences", cyclic_sequences, 1, 0, false);
+ sc->cyclic_sequences_symbol = defun("cyclic-sequences", cyclic_sequences, 1, 0, false);
sc->call_cc_symbol = unsafe_defun("call/cc", call_cc, 1, 0, false);
sc->call_with_current_continuation_symbol = unsafe_defun("call-with-current-continuation", call_cc, 1, 0, false);
sc->call_with_exit_symbol = unsafe_defun("call-with-exit", call_with_exit, 1, 0, false);
@@ -74753,7 +80476,7 @@ s7_scheme *s7_init(void)
sc->eval_string_symbol = unsafe_defun("eval-string", eval_string, 1, 1, false);
sc->apply_symbol = unsafe_defun("apply", apply, 1, 0, true);
sc->apply_function = slot_value(global_slot(sc->apply_symbol));
- set_type(sc->apply_function, type(sc->apply_function) | T_COPY_ARGS | T_PROCEDURE);
+ set_type(sc->apply_function, type(sc->apply_function) | T_COPY_ARGS);
/* (let ((x '((1 2) 3 4))) (catch #t (lambda () (apply apply apply x)) (lambda args 'error)) x) should not mess up x! */
sc->for_each_symbol = unsafe_defun("for-each", for_each, 2, 0, true);
@@ -74766,20 +80489,12 @@ s7_scheme *s7_init(void)
/* it's faster to leave error/throw unsafe than to set needs_copied_args and use s7_define_safe_function because copy_list overwhelms any other savings */
sc->stacktrace_symbol = defun("stacktrace", stacktrace, 0, 5, false);
- { /* these are primarily for quasiquote */
- s7_pointer sym;
+ sc->apply_values_symbol = unsafe_defun("apply-values", apply_values, 0, 0, true);
+ set_immutable(sc->apply_values_symbol);
+ sc->apply_values_function = slot_value(global_slot(sc->apply_values_symbol));
- sym = unsafe_defun("apply-values", apply_values, 0, 0, true);
- set_immutable(sym);
- sc->qq_apply_values_function = slot_value(global_slot(sym));
-
- sc->qq_append_function = slot_value(global_slot(sc->append_symbol));
-
- sym = unsafe_defun("list-values", qq_list, 0, 0, true);
- set_immutable(sym);
- sc->qq_list_function = slot_value(global_slot(sym));
- set_type(sc->qq_list_function, T_C_RST_ARGS_FUNCTION | T_PROCEDURE | T_COPY_ARGS);
- }
+ sc->list_values_symbol = unsafe_defun("list-values", list_values, 0, 0, true); /* see comment above */
+ set_immutable(sc->list_values_symbol);
sc->procedure_documentation_symbol = defun("procedure-documentation", procedure_documentation, 1, 0, false);
sc->procedure_signature_symbol = defun("procedure-signature", procedure_signature, 1, 0, false);
@@ -74797,21 +80512,49 @@ s7_scheme *s7_init(void)
sc->is_eqv_symbol = defun("eqv?", is_eqv, 2, 0, false);
sc->is_equal_symbol = defun("equal?", is_equal, 2, 0, false);
sc->is_morally_equal_symbol = defun("morally-equal?", is_morally_equal, 2, 0, false);
+ sc->type_of_symbol = defun("type-of", type_of, 1, 0, false);
sc->gc_symbol = defun("gc", gc, 0, 1, false);
- defun("s7-version", s7_version, 0, 0, false);
+ sc->s7_version_symbol = defun("s7-version", s7_version, 0, 0, false);
defun("emergency-exit", emergency_exit, 0, 1, false);
- defun("exit", exit, 0, 1, false);
+ sc->exit_symbol = defun("exit", exit, 0, 1, false);
#if DEBUGGING
s7_define_function(sc, "abort", g_abort, 0, 0, true, "drop into gdb I hope");
#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");
sc->object_set_function = slot_value(global_slot(sym));
-
- s7_define_safe_function(sc, "tree-leaves", g_tree_leaves, 1, 0, false, "an experiment");
- s7_define_safe_function(sc, "tree-memq", g_tree_memq, 2, 0, false, "an experiment");
+ set_scope_safe(slot_value(global_slot(sc->call_with_input_string_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->call_with_input_file_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->call_with_output_string_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->call_with_output_file_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->with_input_from_string_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->with_input_from_file_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->with_output_to_string_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->with_output_to_file_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->set_cdr_symbol)));
+ set_maybe_safe(slot_value(global_slot(sc->assoc_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->assoc_symbol)));
+ set_maybe_safe(slot_value(global_slot(sc->member_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->member_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->sort_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->call_with_exit_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->for_each_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->map_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->dynamic_wind_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->catch_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->throw_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->error_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->apply_values_symbol)));
+ set_scope_safe(slot_value(global_slot(sc->list_values_symbol)));
+
+
+ s7_define_safe_function(sc, "tree-leaves", g_tree_leaves, 1, 0, false, "an experiment");
+ s7_define_safe_function(sc, "tree-memq", g_tree_memq, 2, 0, false, "an experiment");
+ s7_define_safe_function(sc, "tree-set-memq", g_tree_set_memq, 2, 0, false, "an experiment");
+ s7_define_safe_function(sc, "tree-count", g_tree_count, 2, 1, false, "an experiment");
/* -------- *features* -------- */
@@ -74858,7 +80601,6 @@ s7_scheme *s7_init(void)
sc->require_symbol = s7_define_macro(sc, "require", g_require, 0, 0, true, H_require);
sc->stacktrace_defaults = s7_list(sc, 5, small_int(3), small_int(45), small_int(80), small_int(45), sc->T);
-
/* -------- *#readers* -------- */
sym = s7_define_variable(sc, "*#readers*", sc->nil);
sc->sharp_readers = global_slot(sym);
@@ -74881,6 +80623,9 @@ s7_scheme *s7_init(void)
#if WITH_EXTRA_EXPONENT_MARKERS
s7_provide(sc, "dfls-exponents");
#endif
+#if HAVE_OVERFLOW_CHECKS
+ s7_provide(sc, "overflow-checks");
+#endif
#if WITH_SYSTEM_EXTRAS
s7_provide(sc, "system-extras");
#endif
@@ -74939,7 +80684,9 @@ s7_scheme *s7_init(void)
#ifdef __SUNPRO_C
s7_provide(sc, "sunpro_c");
#endif
-
+#ifdef __MINGW32__
+ s7_provide(sc, "mingw");
+#endif
sc->vector_set_function = slot_value(global_slot(sc->vector_set_symbol));
set_setter(sc->vector_set_symbol);
@@ -75002,6 +80749,7 @@ s7_scheme *s7_init(void)
*/
#define S7_LOG_LLONG_MAX 43.668274
#define S7_LOG_LONG_MAX 21.487562
+ sc->bignum_precision = DEFAULT_BIGNUM_PRECISION;
#endif
top = sizeof(s7_int);
@@ -75026,6 +80774,7 @@ s7_scheme *s7_init(void)
s7_define_constant(sc, "pi", real_pi);
sc->pi_symbol = s7_make_symbol(sc, "pi");
+ sc->objstr_max_len = s7_int_max;
{
s7_pointer p;
new_cell(sc, p, T_RANDOM_STATE);
@@ -75059,7 +80808,352 @@ s7_scheme *s7_init(void)
#endif
init_choosers(sc);
+ init_typers(sc);
+
+#if DEBUGGING
+ s7_define_safe_function(sc, "local-symbol?", g_is_local_symbol, 1, 0, false, "an experiment");
+#endif
+
+ /* -------------------------------------------------------------------------------- */
+ s7_set_d_pi_function(slot_value(global_slot(sc->float_vector_ref_symbol)), float_vector_ref_d);
+ s7_set_d_pid_function(slot_value(global_slot(sc->float_vector_set_symbol)), float_vector_set_d);
+
+ s7_set_i_pi_function(slot_value(global_slot(sc->int_vector_ref_symbol)), int_vector_ref_i);
+ s7_set_i_pii_function(slot_value(global_slot(sc->int_vector_set_symbol)), int_vector_set_i);
+ s7_set_i_pi_function(slot_value(global_slot(sc->byte_vector_ref_symbol)), byte_vector_ref_i);
+ s7_set_i_pii_function(slot_value(global_slot(sc->byte_vector_set_symbol)), byte_vector_set_i);
+
+ s7_set_p_pi_function(slot_value(global_slot(sc->vector_ref_symbol)), vector_ref_p_pi);
+ s7_set_p_pip_function(slot_value(global_slot(sc->vector_set_symbol)), vector_set_p_pip);
+ s7_set_p_pi_direct_function(slot_value(global_slot(sc->vector_ref_symbol)), vector_ref_p_pi_direct);
+ s7_set_p_pip_direct_function(slot_value(global_slot(sc->vector_set_symbol)), vector_set_p_pip_direct);
+
+ s7_set_p_pi_function(slot_value(global_slot(sc->list_ref_symbol)), list_ref_p_pi);
+ s7_set_p_pip_function(slot_value(global_slot(sc->list_set_symbol)), list_set_p_pip);
+ s7_set_p_pi_direct_function(slot_value(global_slot(sc->list_ref_symbol)), list_ref_p_pi_direct);
+ s7_set_p_pip_direct_function(slot_value(global_slot(sc->list_set_symbol)), list_set_p_pip_direct);
+
+ s7_set_p_pp_function(slot_value(global_slot(sc->let_ref_symbol)), let_ref_p_pp);
+ s7_set_p_ppp_function(slot_value(global_slot(sc->let_set_symbol)), let_set_p_ppp);
+
+ s7_set_p_pi_function(slot_value(global_slot(sc->string_ref_symbol)), string_ref_p_pi);
+ s7_set_p_pip_function(slot_value(global_slot(sc->string_set_symbol)), string_set_p_pip);
+ s7_set_p_pi_direct_function(slot_value(global_slot(sc->string_ref_symbol)), string_ref_p_pi_direct);
+ s7_set_p_pip_direct_function(slot_value(global_slot(sc->string_set_symbol)), string_set_p_pip_direct);
+
+ s7_set_p_pp_function(slot_value(global_slot(sc->hash_table_ref_symbol)), hash_table_ref_p_pp);
+ s7_set_p_ppp_function(slot_value(global_slot(sc->hash_table_set_symbol)), hash_table_set_p_ppp);
+ s7_set_p_pp_direct_function(slot_value(global_slot(sc->hash_table_ref_symbol)), hash_table_ref_p_pp_direct);
+ s7_set_p_ppp_direct_function(slot_value(global_slot(sc->hash_table_set_symbol)), hash_table_set_p_ppp_direct);
+
+#if (!WITH_GMP)
+ s7_set_p_ii_function(slot_value(global_slot(sc->complex_symbol)), complex_p_ii);
+ s7_set_p_p_function(slot_value(global_slot(sc->random_symbol)), random_p_p);
+#endif
+
+ s7_set_p_p_function(slot_value(global_slot(sc->car_symbol)), car_p_p);
+ s7_set_p_pp_function(slot_value(global_slot(sc->set_car_symbol)), set_car_p_pp);
+ s7_set_p_p_function(slot_value(global_slot(sc->cdr_symbol)), cdr_p_p);
+ s7_set_p_pp_function(slot_value(global_slot(sc->set_cdr_symbol)), set_cdr_p_pp);
+ s7_set_p_p_function(slot_value(global_slot(sc->caar_symbol)), caar_p_p);
+ s7_set_p_p_function(slot_value(global_slot(sc->cadr_symbol)), cadr_p_p);
+ s7_set_p_p_function(slot_value(global_slot(sc->cdar_symbol)), cdar_p_p);
+ s7_set_p_p_function(slot_value(global_slot(sc->cddr_symbol)), cddr_p_p);
+
+ s7_set_p_p_function(slot_value(global_slot(sc->string_to_symbol_symbol)), string_to_symbol_p_p);
+ s7_set_p_p_function(slot_value(global_slot(sc->symbol_to_string_symbol)), symbol_to_string_p);
+ s7_set_p_function(slot_value(global_slot(sc->newline_symbol)), newline_p);
+ s7_set_p_p_function(slot_value(global_slot(sc->newline_symbol)), newline_p_p);
+ s7_set_p_p_function(slot_value(global_slot(sc->display_symbol)), display_p_p);
+ s7_set_p_pp_function(slot_value(global_slot(sc->display_symbol)), display_p_pp);
+ s7_set_p_p_function(slot_value(global_slot(sc->write_symbol)), write_p_p);
+ s7_set_p_pp_function(slot_value(global_slot(sc->write_symbol)), write_p_pp);
+ s7_set_p_p_function(slot_value(global_slot(sc->write_char_symbol)), write_char_p_p);
+ s7_set_p_pp_function(slot_value(global_slot(sc->write_char_symbol)), write_char_p_pp);
+ s7_set_i_p_function(slot_value(global_slot(sc->port_line_number_symbol)), port_line_number_i_p);
+ s7_set_p_p_function(slot_value(global_slot(sc->number_to_string_symbol)), number_to_string_p);
+ s7_set_p_p_function(slot_value(global_slot(sc->number_to_string_symbol)), number_to_string_p_p);
+ s7_set_p_pp_function(slot_value(global_slot(sc->number_to_string_symbol)), number_to_string_p_pp);
+ s7_set_p_pp_function(slot_value(global_slot(sc->cons_symbol)), cons_p_pp);
+ s7_set_p_function(slot_value(global_slot(sc->s7_version_symbol)), s7_version_p);
+ s7_set_p_function(slot_value(global_slot(sc->open_output_string_symbol)), open_output_string_p);
+ s7_set_p_ppi_function(slot_value(global_slot(sc->char_position_symbol)), char_position_p_ppi);
+ s7_set_p_pp_function(slot_value(global_slot(sc->append_symbol)), append_p_pp);
+ s7_set_p_ppp_function(slot_value(global_slot(sc->append_symbol)), append_p_ppp);
+ s7_set_p_function(slot_value(global_slot(sc->values_symbol)), values_p);
+ s7_set_p_p_function(slot_value(global_slot(sc->values_symbol)), values_p_p);
+ s7_set_p_pp_function(slot_value(global_slot(sc->member_symbol)), member_p_pp);
+ s7_set_p_pp_function(slot_value(global_slot(sc->assoc_symbol)), assoc_p_pp);
+
+#if (!WITH_GMP)
+ s7_set_i_i_function(slot_value(global_slot(sc->abs_symbol)), abs_i_i);
+ s7_set_d_d_function(slot_value(global_slot(sc->abs_symbol)), abs_d_d);
+ s7_set_d_d_function(slot_value(global_slot(sc->exp_symbol)), exp_d_d);
+ s7_set_d_d_function(slot_value(global_slot(sc->sin_symbol)), sin_d_d);
+ s7_set_d_d_function(slot_value(global_slot(sc->cos_symbol)), cos_d_d);
+ s7_set_d_d_function(slot_value(global_slot(sc->tan_symbol)), tan_d_d);
+ s7_set_d_d_function(slot_value(global_slot(sc->sinh_symbol)), sinh_d_d);
+ s7_set_d_d_function(slot_value(global_slot(sc->cosh_symbol)), cosh_d_d);
+ s7_set_d_d_function(slot_value(global_slot(sc->tanh_symbol)), tanh_d_d);
+ s7_set_d_d_function(slot_value(global_slot(sc->random_symbol)), random_d_d);
+ s7_set_d_d_function(slot_value(global_slot(sc->round_symbol)), round_d_d);
+ s7_set_i_i_function(slot_value(global_slot(sc->round_symbol)), round_i_i);
+ s7_set_d_d_function(slot_value(global_slot(sc->floor_symbol)), floor_d_d);
+ s7_set_i_i_function(slot_value(global_slot(sc->floor_symbol)), floor_i_i);
+ s7_set_d_d_function(slot_value(global_slot(sc->truncate_symbol)), truncate_d_d);
+ s7_set_i_i_function(slot_value(global_slot(sc->truncate_symbol)), truncate_i_i);
+ s7_set_d_d_function(slot_value(global_slot(sc->ceiling_symbol)), ceiling_d_d);
+ s7_set_i_i_function(slot_value(global_slot(sc->ceiling_symbol)), ceiling_i_i);
+#endif
+
+ s7_set_d_d_function(slot_value(global_slot(sc->add_symbol)), add_d_d);
+ s7_set_d_d_function(slot_value(global_slot(sc->subtract_symbol)), subtract_d_d);
+ s7_set_d_d_function(slot_value(global_slot(sc->multiply_symbol)), multiply_d_d);
+ s7_set_d_d_function(slot_value(global_slot(sc->divide_symbol)), divide_d_d);
+
+ s7_set_d_dd_function(slot_value(global_slot(sc->add_symbol)), add_d_dd);
+ s7_set_d_dd_function(slot_value(global_slot(sc->subtract_symbol)), subtract_d_dd);
+ s7_set_d_dd_function(slot_value(global_slot(sc->multiply_symbol)), multiply_d_dd);
+ s7_set_d_dd_function(slot_value(global_slot(sc->divide_symbol)), divide_d_dd);
+#if (!WITH_GMP)
+ s7_set_d_dd_function(slot_value(global_slot(sc->atan_symbol)), atan_d_dd);
+ s7_set_d_dd_function(slot_value(global_slot(sc->quotient_symbol)), quotient_d_dd);
+ s7_set_d_dd_function(slot_value(global_slot(sc->remainder_symbol)), remainder_d_dd);
+ s7_set_d_dd_function(slot_value(global_slot(sc->modulo_symbol)), modulo_d_dd);
+#endif
+
+ s7_set_d_ddd_function(slot_value(global_slot(sc->add_symbol)), add_d_ddd);
+ s7_set_d_ddd_function(slot_value(global_slot(sc->subtract_symbol)), subtract_d_ddd);
+ s7_set_d_ddd_function(slot_value(global_slot(sc->multiply_symbol)), multiply_d_ddd);
+ s7_set_d_ddd_function(slot_value(global_slot(sc->divide_symbol)), divide_d_ddd);
+
+ s7_set_d_dddd_function(slot_value(global_slot(sc->add_symbol)), add_d_dddd);
+ s7_set_d_dddd_function(slot_value(global_slot(sc->subtract_symbol)), subtract_d_dddd);
+ s7_set_d_dddd_function(slot_value(global_slot(sc->multiply_symbol)), multiply_d_dddd);
+ s7_set_d_dddd_function(slot_value(global_slot(sc->divide_symbol)), divide_d_dddd);
+ s7_set_p_ii_function(slot_value(global_slot(sc->divide_symbol)), divide_p_ii);
+
+ s7_set_p_pp_function(slot_value(global_slot(sc->add_symbol)), add_p_pp);
+ s7_set_p_pp_function(slot_value(global_slot(sc->subtract_symbol)), subtract_p_pp);
+ s7_set_d_dd_function(slot_value(global_slot(sc->max_symbol)), max_d_dd);
+ s7_set_d_dd_function(slot_value(global_slot(sc->min_symbol)), min_d_dd);
+ s7_set_i_ii_function(slot_value(global_slot(sc->max_symbol)), max_i_ii);
+ s7_set_i_ii_function(slot_value(global_slot(sc->min_symbol)), min_i_ii);
+#if (!WITH_GMP)
+ s7_set_d_p_function(slot_value(global_slot(sc->real_part_symbol)), real_part_d_p);
+ s7_set_d_p_function(slot_value(global_slot(sc->imag_part_symbol)), imag_part_d_p);
+ s7_set_d_p_function(slot_value(global_slot(sc->magnitude_symbol)), magnitude_d_p);
+ s7_set_p_pp_function(slot_value(global_slot(sc->multiply_symbol)), multiply_p_pp);
+ s7_set_d_p_function(slot_value(global_slot(sc->angle_symbol)), angle_d_p);
+ s7_set_i_d_function(slot_value(global_slot(sc->round_symbol)), round_i_d);
+ s7_set_i_d_function(slot_value(global_slot(sc->floor_symbol)), floor_i_d);
+ s7_set_i_d_function(slot_value(global_slot(sc->truncate_symbol)), truncate_i_d);
+ s7_set_i_d_function(slot_value(global_slot(sc->ceiling_symbol)), ceiling_i_d);
+ s7_set_i_i_function(slot_value(global_slot(sc->random_symbol)), random_i_i);
+ s7_set_i_ii_function(slot_value(global_slot(sc->quotient_symbol)), quotient_i_ii);
+ s7_set_i_ii_function(slot_value(global_slot(sc->remainder_symbol)), remainder_i_ii);
+ s7_set_i_ii_function(slot_value(global_slot(sc->modulo_symbol)), modulo_i_ii);
+#endif
+ s7_set_i_i_function(slot_value(global_slot(sc->subtract_symbol)), subtract_i_i);
+ s7_set_i_i_function(slot_value(global_slot(sc->lognot_symbol)), lognot_i_i);
+
+ s7_set_i_ii_function(slot_value(global_slot(sc->add_symbol)), add_i_ii);
+ s7_set_i_iii_function(slot_value(global_slot(sc->add_symbol)), add_i_iii);
+ s7_set_i_ii_function(slot_value(global_slot(sc->subtract_symbol)), subtract_i_ii);
+ s7_set_i_iii_function(slot_value(global_slot(sc->subtract_symbol)), subtract_i_iii);
+ s7_set_i_ii_function(slot_value(global_slot(sc->multiply_symbol)), multiply_i_ii);
+ s7_set_i_iii_function(slot_value(global_slot(sc->multiply_symbol)), multiply_i_iii);
+ s7_set_i_ii_function(slot_value(global_slot(sc->ash_symbol)), ash_i_ii);
+ s7_set_i_ii_function(slot_value(global_slot(sc->logior_symbol)), logior_i_ii);
+ s7_set_i_ii_function(slot_value(global_slot(sc->logxor_symbol)), logxor_i_ii);
+ s7_set_i_ii_function(slot_value(global_slot(sc->logand_symbol)), logand_i_ii);
+
+#if (!WITH_PURE_S7)
+ s7_set_p_pp_function(slot_value(global_slot(sc->vector_append_symbol)), vector_append_p_pp);
+ s7_set_p_ppp_function(slot_value(global_slot(sc->vector_append_symbol)), vector_append_p_ppp);
+ s7_set_i_i_function(slot_value(global_slot(sc->integer_length_symbol)), integer_length_i_i);
+ s7_set_i_p_function(slot_value(global_slot(sc->string_length_symbol)), string_length_i);
+ s7_set_i_p_function(slot_value(global_slot(sc->vector_length_symbol)), vector_length_i);
+ s7_set_p_p_function(slot_value(global_slot(sc->vector_to_list_symbol)), vector_to_list_p_p);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_exact_symbol)), s7_is_rational);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_char_ready_symbol)), is_char_ready_b_p);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_exact_symbol)), is_exact_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_inexact_symbol)), is_inexact_b);
+#endif
+ s7_set_i_p_function(slot_value(global_slot(sc->numerator_symbol)), numerator_i);
+ s7_set_i_p_function(slot_value(global_slot(sc->denominator_symbol)), denominator_i);
+ s7_set_i_p_function(slot_value(global_slot(sc->char_to_integer_symbol)), char_to_integer_i);
+ s7_set_i_p_function(slot_value(global_slot(sc->hash_table_entries_symbol)), hash_table_entries_i);
+ s7_set_i_p_function(slot_value(global_slot(s7_make_symbol(sc, "tree-leaves"))), tree_leaves_i);
+
+ 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_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);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_continuation_symbol)), s7_is_continuation);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_c_pointer_symbol)), s7_is_c_pointer);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_dilambda_symbol)), s7_is_dilambda);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_eof_object_symbol)), s7_is_eof_object);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_even_symbol)), is_even_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_float_symbol)), is_float_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_float_vector_symbol)), s7_is_float_vector);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_gensym_symbol)), s7_is_gensym);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_hash_table_symbol)), s7_is_hash_table);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_infinite_symbol)), is_infinite_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_input_port_symbol)), is_input_port_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_integer_symbol)), s7_is_integer);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_int_vector_symbol)), s7_is_int_vector);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_keyword_symbol)), s7_is_keyword);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_let_symbol)), s7_is_let);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_list_symbol)), is_list_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_macro_symbol)), is_macro_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_nan_symbol)), is_nan_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_null_symbol)), is_null_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_number_symbol)), s7_is_number);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_odd_symbol)), is_odd_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_output_port_symbol)), is_output_port_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_pair_symbol)), s7_is_pair);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_port_closed_symbol)), is_port_closed_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_procedure_symbol)), s7_is_procedure);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_proper_list_symbol)), is_proper_list_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_random_state_symbol)), is_random_state_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_rational_symbol)), s7_is_rational);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_real_symbol)), s7_is_real);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_sequence_symbol)), is_sequence_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_string_symbol)), s7_is_string);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_symbol_symbol)), s7_is_symbol);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_syntax_symbol)), s7_is_syntax);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_vector_symbol)), s7_is_vector);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_iterator_symbol)), is_iterator_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_char_alphabetic_symbol)), is_char_alphabetic_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_char_lower_case_symbol)), is_char_lower_case_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_char_numeric_symbol)), is_char_numeric_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_char_upper_case_symbol)), is_char_upper_case_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_char_whitespace_symbol)), is_char_whitespace_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_openlet_symbol)), s7_is_openlet);
+ s7_set_b_p_function(slot_value(global_slot(sc->iterator_is_at_end_symbol)), iterator_is_at_end_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_zero_symbol)), is_zero_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_negative_symbol)), is_negative_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_positive_symbol)), is_positive_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->not_symbol)), not_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_provided_symbol)), is_provided_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_defined_symbol)), is_defined_b_p);
+ s7_set_b_pp_function(slot_value(global_slot(sc->is_defined_symbol)), is_defined_b_pp);
+ s7_set_b_pp_function(slot_value(global_slot(s7_make_symbol(sc, "tree-memq"))), tree_memq_b_pp);
+ s7_set_b_pp_function(slot_value(global_slot(s7_make_symbol(sc, "tree-set-memq"))), tree_set_memq_b_pp);
+
+ s7_set_p_p_function(slot_value(global_slot(sc->is_pair_symbol)), is_pair_p_p);
+ s7_set_p_p_function(slot_value(global_slot(sc->integer_to_char_symbol)), integer_to_char_p_p);
+
+#if WITH_SYSTEM_EXTRAS
+ s7_set_b_p_function(slot_value(global_slot(sc->is_directory_symbol)), is_directory_b);
+ s7_set_b_p_function(slot_value(global_slot(sc->file_exists_symbol)), file_exists_b);
+#endif
+
+ s7_set_b_i_function(slot_value(global_slot(sc->is_even_symbol)), is_even_i);
+ s7_set_b_i_function(slot_value(global_slot(sc->is_odd_symbol)), is_odd_i);
+ s7_set_b_i_function(slot_value(global_slot(sc->is_zero_symbol)), is_zero_i);
+ s7_set_b_d_function(slot_value(global_slot(sc->is_zero_symbol)), is_zero_d);
+ s7_set_b_i_function(slot_value(global_slot(sc->is_positive_symbol)), is_positive_i);
+ s7_set_b_d_function(slot_value(global_slot(sc->is_positive_symbol)), is_positive_d);
+ s7_set_b_i_function(slot_value(global_slot(sc->is_negative_symbol)), is_negative_i);
+ s7_set_b_d_function(slot_value(global_slot(sc->is_negative_symbol)), is_negative_d);
+
+ s7_set_b_ii_function(slot_value(global_slot(sc->logbit_symbol)), logbit_b_ii);
+ s7_set_b_ii_function(slot_value(global_slot(sc->eq_symbol)), req_b_ii);
+ s7_set_b_ii_function(slot_value(global_slot(sc->lt_symbol)), lt_b_ii);
+ s7_set_b_ii_function(slot_value(global_slot(sc->leq_symbol)), leq_b_ii);
+ s7_set_b_ii_function(slot_value(global_slot(sc->gt_symbol)), gt_b_ii);
+ s7_set_b_ii_function(slot_value(global_slot(sc->geq_symbol)), geq_b_ii);
+ s7_set_b_dd_function(slot_value(global_slot(sc->eq_symbol)), req_b_dd);
+ s7_set_b_dd_function(slot_value(global_slot(sc->lt_symbol)), lt_b_dd);
+ s7_set_b_dd_function(slot_value(global_slot(sc->leq_symbol)), leq_b_dd);
+ s7_set_b_dd_function(slot_value(global_slot(sc->gt_symbol)), gt_b_dd);
+ s7_set_b_dd_function(slot_value(global_slot(sc->geq_symbol)), geq_b_dd);
+
+#if (!WITH_GMP)
+ s7_set_p_pp_function(slot_value(global_slot(sc->eq_symbol)), equal_p_pp);
+ s7_set_p_pi_function(slot_value(global_slot(sc->eq_symbol)), equal_p_pi);
+ s7_set_p_pp_function(slot_value(global_slot(sc->lt_symbol)), less_p_pp);
+ s7_set_p_pi_function(slot_value(global_slot(sc->lt_symbol)), lt_p_pi);
+ s7_set_p_pp_function(slot_value(global_slot(sc->leq_symbol)), leq_p_pp);
+ s7_set_p_pi_function(slot_value(global_slot(sc->leq_symbol)), leq_p_pi);
+ s7_set_p_pp_function(slot_value(global_slot(sc->gt_symbol)), greater_p_pp);
+ s7_set_p_pi_function(slot_value(global_slot(sc->gt_symbol)), gt_p_pi);
+ s7_set_p_pp_function(slot_value(global_slot(sc->geq_symbol)), geq_p_pp);
+ s7_set_p_pi_function(slot_value(global_slot(sc->geq_symbol)), geq_p_pi);
+ /* 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);
+ s7_set_b_pp_function(slot_value(global_slot(sc->leq_symbol)), leq_b_pp);
+ s7_set_b_pp_function(slot_value(global_slot(sc->gt_symbol)), gt_b_pp);
+ s7_set_b_pp_function(slot_value(global_slot(sc->geq_symbol)), geq_b_pp);
+
+ s7_set_b_pi_function(slot_value(global_slot(sc->eq_symbol)), req_b_pi);
+ s7_set_b_pi_function(slot_value(global_slot(sc->lt_symbol)), lt_b_pi);
+ s7_set_b_pi_function(slot_value(global_slot(sc->leq_symbol)), leq_b_pi);
+ s7_set_b_pi_function(slot_value(global_slot(sc->gt_symbol)), gt_b_pi);
+ s7_set_b_pi_function(slot_value(global_slot(sc->geq_symbol)), geq_b_pi);
+#endif
+ s7_set_b_pp_function(slot_value(global_slot(sc->is_eq_symbol)), s7_is_eq);
+ s7_set_b_pp_function(slot_value(global_slot(sc->is_eqv_symbol)), s7_is_eqv);
+ s7_set_b_pp_function(slot_value(global_slot(sc->is_equal_symbol)), is_equal_b_pp);
+ s7_set_b_pp_function(slot_value(global_slot(sc->is_morally_equal_symbol)), is_morally_equal_b_pp);
+ s7_set_p_pp_function(slot_value(global_slot(sc->is_equal_symbol)), is_equal_p_pp);
+ s7_set_p_pp_function(slot_value(global_slot(sc->is_morally_equal_symbol)), is_morally_equal_p_pp);
+ s7_set_b_pp_function(slot_value(global_slot(sc->char_lt_symbol)), char_lt_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->char_leq_symbol)), char_leq_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->char_gt_symbol)), char_gt_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->char_geq_symbol)), char_geq_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->char_eq_symbol)), char_eq_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->string_lt_symbol)), string_lt_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->string_leq_symbol)), string_leq_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->string_gt_symbol)), string_gt_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->string_geq_symbol)), string_geq_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->string_eq_symbol)), string_eq_b);
+
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->char_lt_symbol)), char_lt_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->char_leq_symbol)), char_leq_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->char_gt_symbol)), char_gt_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->char_geq_symbol)), char_geq_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->char_eq_symbol)), char_eq_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->string_lt_symbol)), string_lt_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->string_leq_symbol)), string_leq_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->string_gt_symbol)), string_gt_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->string_geq_symbol)), string_geq_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->string_eq_symbol)), string_eq_b_direct);
+
+ s7_set_b_pp_function(slot_value(global_slot(sc->is_aritable_symbol)), is_aritable_b_pp);
+#if (!WITH_PURE_S7)
+ s7_set_b_pp_function(slot_value(global_slot(sc->char_ci_lt_symbol)), char_ci_lt_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->char_ci_leq_symbol)), char_ci_leq_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->char_ci_gt_symbol)), char_ci_gt_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->char_ci_geq_symbol)), char_ci_geq_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->char_ci_eq_symbol)), char_ci_eq_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->string_ci_lt_symbol)), string_ci_lt_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->string_ci_leq_symbol)), string_ci_leq_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->string_ci_gt_symbol)), string_ci_gt_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->string_ci_geq_symbol)), string_ci_geq_b);
+ s7_set_b_pp_function(slot_value(global_slot(sc->string_ci_eq_symbol)), string_ci_eq_b);
+
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->char_ci_lt_symbol)), char_ci_lt_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->char_ci_leq_symbol)), char_ci_leq_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->char_ci_gt_symbol)), char_ci_gt_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->char_ci_geq_symbol)), char_ci_geq_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->char_ci_eq_symbol)), char_ci_eq_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->string_ci_lt_symbol)), string_ci_lt_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->string_ci_leq_symbol)), string_ci_leq_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->string_ci_gt_symbol)), string_ci_gt_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->string_ci_geq_symbol)), string_ci_geq_b_direct);
+ s7_set_b_pp_direct_function(slot_value(global_slot(sc->string_ci_eq_symbol)), string_ci_eq_b_direct);
+#endif
+
+
+ /* -------------------------------------------------------------------------------- */
s7_define_macro(sc, "quasiquote", g_quasiquote, 1, 0, false, H_quasiquote);
#if (!WITH_PURE_S7)
@@ -75076,12 +81170,12 @@ s7_scheme *s7_init(void)
(letrec ((traverse (lambda (tree) \n\
(if (pair? tree) \n\
(cons (traverse (car tree)) \n\
- (if (null? (cdr tree)) () (traverse (cdr tree)))) \n\
+ (case (cdr tree) ((())) (else => traverse))) \n\
(if (memq tree '(and or not else)) tree \n\
(and (symbol? tree) (provided? tree))))))) \n\
(cons 'cond (map (lambda (clause) \n\
(cons (traverse (car clause)) \n\
- (if (null? (cdr clause)) '(#f) (cdr clause)))) \n\
+ (case (cdr clause) ((()) '(#f)) (else)))) \n\
clauses))))");
#endif
@@ -75091,25 +81185,28 @@ s7_scheme *s7_init(void)
(for-each \n\
(lambda (clause) \n\
(let ((val (eval (car clause)))) \n\
- (if val \n\
- (return (if (null? (cdr clause)) \n\
- val \n\
- (if (null? (cddr clause)) \n\
- (cadr clause) \n\
- (apply values (map quote (cdr clause))))))))) \n\
+ (when val \n\
+ (return (if (null? (cdr clause)) \n\
+ val \n\
+ (if (eq? (cadr clause) '=>) \n\
+ ((eval (caddr clause)) val) \n\
+ (if (null? (cddr clause)) \n\
+ (cadr clause) \n\
+ (apply values (map quote (cdr clause)))))))))) \n\
clauses) \n\
- (values))))");
+ (values))))"); /* this is not redundant */
s7_eval_c_string(sc, "(define make-hook \n\
(let ((signature '(procedure?)) \n\
(documentation \"(make-hook . pars) returns a new hook (a function) that passes the parameters to its function list.\")) \n\
- (lambda args \n\
+ (lambda hook-args \n\
(let ((body ())) \n\
- (apply lambda* args \n\
- '(let ((result #<unspecified>)) \n\
- (let ((hook (curlet))) \n\
- (for-each (lambda (hook-function) (hook-function hook)) body) \n\
- result)) \n\
+ (apply lambda* hook-args \n\
+ (copy '(let ((result #<unspecified>)) \n\
+ (let ((hook (curlet))) \n\
+ (for-each (lambda (hook-function) (hook-function hook)) body) \n\
+ result)) \n\
+ :readable) \n\
())))))");
s7_eval_c_string(sc, "(define hook-functions \n\
@@ -75119,40 +81216,14 @@ s7_scheme *s7_init(void)
(lambda (hook) \n\
((funclet hook) 'body)) \n\
(lambda (hook lst) \n\
- (if (or (null? lst) \n\
- (and (pair? lst) \n\
- (apply and (map (lambda (f) \n\
- (and (procedure? f) \n\
- (aritable? f 1))) \n\
- lst)))) \n\
+ (if (do ((p lst (cdr p))) \n\
+ ((not (and (pair? p) \n\
+ (procedure? (car p)) \n\
+ (aritable? (car p) 1))) \n\
+ (null? p))) \n\
(set! ((funclet hook) 'body) lst) \n\
(error 'wrong-type-arg \"hook-functions must be a list of functions, each accepting one argument: ~S\" lst))))))");
- s7_eval_c_string(sc, "(define-macro (let-temporarily vars . body) \n\
- `(with-let (#_inlet :orig (#_curlet) \n\
- :saved (#_list ,@(map car vars)) \n\
- :new (#_list ,@(map cadr vars))) \n\
- (when (memq #<undefined> saved) \n\
- (error 'unbound-variable \"let-temporarily: ~A is unbound\" \n\
- (car (list-ref ',vars (- (length saved) (length (memq #<undefined> saved))))))) \n\
- (dynamic-wind \n\
- (lambda () #f) \n\
- (lambda () \n\
- ,@(map (let ((ctr -1)) \n\
- (lambda (v) \n\
- (if (symbol? (car v)) \n\
- `(set! (orig ',(car v)) (list-ref new ,(set! ctr (+ ctr 1)))) \n\
- `(set! (with-let orig ,(car v)) (list-ref new ,(set! ctr (+ ctr 1))))))) \n\
- vars) \n\
- ,(and (pair? body) `(with-let orig , at body))) \n\
- (lambda () \n\
- ,@(map (let ((ctr -1)) \n\
- (lambda (v) \n\
- (if (symbol? (car v)) \n\
- `(set! (orig ',(car v)) (list-ref saved ,(set! ctr (+ ctr 1)))) \n\
- `(set! (with-let orig ,(car v)) (list-ref saved ,(set! ctr (+ ctr 1))))))) \n\
- vars)))))");
-
/* -------- *unbound-variable-hook* -------- */
sc->unbound_variable_hook = s7_eval_c_string(sc, "(make-hook 'variable)");
@@ -75180,9 +81251,10 @@ s7_scheme *s7_init(void)
"*read-error-hook* functions are called by the reader if it is unhappy, passing the current program string as (hook 'data).");
/* -------- *rootlet-redefinition-hook* -------- */
- sc->rootlet_redefinition_hook = s7_eval_c_string(sc, "(make-hook 'symbol 'value)");
+ sc->rootlet_redefinition_hook = s7_eval_c_string(sc, "(make-hook 'name 'value)");
s7_define_constant_with_documentation(sc, "*rootlet-redefinition-hook*", sc->rootlet_redefinition_hook,
- "*rootlet-redefinition-hook* functions are called when a top-level variable's value is changed, (hook 'symbol 'value).");
+ "*rootlet-redefinition-hook* functions are called when a top-level variable's value is changed, (hook 'name 'value).");
+ /* first parameter was originally 'symbol, but that collides with the built-in symbol function */
s7_define_constant(sc, "*s7*",
s7_openlet(sc, s7_inlet(sc,
@@ -75193,9 +81265,6 @@ s7_scheme *s7_init(void)
#if (!DISABLE_DEPRECATED)
s7_eval_c_string(sc, "(begin \n\
- (define-constant {apply_values} apply-values) \n\
- (define-constant {list} list-values) \n\
- (define-constant {append} append) \n\
(define global-environment rootlet) \n\
(define current-environment curlet) \n\
(define make-procedure-with-setter dilambda) \n\
@@ -75203,12 +81272,17 @@ s7_scheme *s7_init(void)
(define make-random-state random-state) \n\
(define make-complex complex) \n\
(define make-keyword string->keyword) \n\
- (define ->byte-vector string->byte-vector) \n\
(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(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 [size 72 if gmp], op: 321, opt: 400 */
+ /* 64 bit machine: size: 48 [size 72 if gmp, 120 if debugging], op: 409, opt: 410 */
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 *));
@@ -75216,6 +81290,7 @@ s7_scheme *s7_init(void)
save_unlet(sc);
init_s7_let(sc); /* set up *s7* */
already_inited = true;
+
return(sc);
}
@@ -75243,7 +81318,7 @@ int main(int argc, char **argv)
}
else
{
-#ifndef _MSC_VER
+#if (!MS_WINDOWS)
s7_load(sc, "repl.scm"); /* this is libc dependent */
s7_eval_c_string(sc, "((*repl* 'run))");
#else
@@ -75274,46 +81349,19 @@ int main(int argc, char **argv)
/* --------------------------------------------------------------------
*
- * 12 | 13 | 14 | 15 | 16 | 17
- *
- * index 44.3 | 3291 | 1725 | 1276 | 1156 | 1170
- * teq | | | 6612 | 2380 | 2380
- * tauto 265 | 89 | 9 | 8.4 | 2638 | 2694
- * s7test 1721 | 1358 | 995 | 1194 | 1122 | 2889
- * tcopy | | | 13.6 | 3204 | 3088
- * bench 42.7 | 8752 | 4220 | 3506 | 3230 | 3221
- * tform | | | 6816 | 3627 | 3724
- * tmap | | | 9.3 | 4176 | 4171
- * titer | | | 7503 | 5218 | 5227
- * thash | | | 50.7 | 8491 | 8518
- * | | | | |
- * tgen | 71 | 70.6 | 38.0 | 12.0 | 11.9
- * tall 90 | 43 | 14.5 | 12.7 | 15.0 | 15.0
- * calls 359 | 275 | 54 | 34.7 | 37.1 | 40.2
- *
- * --------------------------------------------------------------------
- *
* new snd version: snd.h configure.ac HISTORY.Snd NEWS barchive
*
- * with-let setter (op_set_with_let) still sometimes conses up the new expression
- * if with_history, each func could keep a (circular) history of calls(args/results/stack), vars via symbol-access?
- * with-let+lambda to increase opt? glosure for example
- * could (apply append (map...)) omit the extra copy?
- * repl: why does it drop the initial open paren? [string too long confusion -- why not broken?]
- * also write-up grepl called from anywhere
- * update libgsl.scm
- * pretty-print needs docs/tests [s7test has some minimal tests]
+ * s7:
+ * if profile, use line/file num to get at hashed count? and use that to annotate pp output via [count]-symbol pre-rewrite
+ * (profile-count file line)?
+ * perhaps add various version numbers etc to *features* (snd-help) or (*s7* 'version-info)?
*
- * how to add debugging checks that sc->tn_n are not stepped on and eval-local temps are not GC'd?
- * GC already checked via standard macros (car etc)
- * and how to generate tests for all cases?
- * for local see below, but more problematic are tn_n and its friends
- * #define save_elocal_2(Var1, Var2) s7_pointer elocal_1 = Var1, elocal_2 = Var2;
- * #define check_elocal_2(Var1, Var2) if ((Var1 != elocal_1) || (Var2 != elocal_2)) abort();
- * set args val1
- * save_elocal_2(args, val1);
- * use args, val1
- * check_elocal_2(args, val1);
+ * gtk_box_pack* has changed -- many uses!
+ * gtk4: no draw signal -- need to set the draw func
+ * musglyphs gtk version is broken (probably cairo_t confusion -- make/free-cairo are obsolete for example)
+ * the problem is less obvious:
+ * "The window 0x5555564dab00 already has a drawing context. You cannot call gdk_window_begin_draw_frame() without calling gdk_window_end_draw_frame() first."
+ * and the stupid thing segfaults. This is called in make-cairo, end in free-cairo.
*
* Snd:
* dac loop [need start/end of loop in dac_info, reader goes to start when end reached (requires rebuffering)
@@ -75324,9 +81372,70 @@ int main(int argc, char **argv)
*
* 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*
- * musglyphs gtk version is broken (probably cairo_t confusion)
* 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: clm2xen, dac, edits, fft, gxcolormaps, mix, region, snd. for snd-mix, tie-ins are in place
- * gtk4: no draw signal -- need to set the draw func
+ * ruby version crashes in test 4|8 -- file_copy?
+ *
+ * opt_let and opt_dotimes can be combined, at least from opt_let's view
+ * maybe split these at a lower level
+ * ip for pi cases (b_ip, but it doesn't appear to happen much)
+ * snd-test: if envelope-interp set! frample->file file->sample[d_p|vii] et al array-interp
+ * finish the t563.scm bugs: a couple number type problems 31905 30802
+ * weed out unused stuff -- choose.data/choose: not_is_string|char, simple_char_eq, is_eq_caar_q?
+ * ash if arg2 known -- forego checks, similarly quotient: i_ii_direct as in modulo (these need opt_choosers too->v7.fp)
+ * 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
+ * varlet et al ok if let is not curlet or outlet(curlet) -- opt_chooser somehow?
+ * need to 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
+ * see g_float_vector_ref -- 3mil univects! [call/all] [opt_p_cf_ss in call?]
+ * tref p_pip_ssf+p_p_f, let_a|s|one|c_a, int_opt check in new do(dox_ex) needs access to do-let
+ * let*->let: maybe frame-opt let* in do? or if names are unique we're safe: letz (not let_star2)
+ * so check_let_star looks for symbol_id==0 -- can this work? id==0 does happen
+ * macro expanded in func (optimize_lambda)
+ * need tests for cond/case in opt_dotimes_2
+ * why not dotimes in thash etc?
+ * do steppers (and many others) aren't marked local usually [tsort -- most loops are op_do!]
+ * arg list consed up in lambda_check can be freed or not created at all
+ * for-each with c-func of int|float-vect could surely use mutable arg, but this never happens?
+ * tform vector_a_ex -- local symbol here?
+ * catch/call-with-exit maybe be stack-unsafe, but we should ignore that for setting locals (if body is safe)
+ * pending-unsafe for catch/call-with-exit etc -- needs lambda walker
+ * sort and|or_bb1?
+ * even if body is unsafe, constants can be marked local
+ * local all_x_c_opssq_s? -- in fft.scm if args rl/im local (why aren't they?) all would be local
+ * opt overhead: after optimize, fill one array with opt_infos, then march through it -- no opt* call, cur_sc->pc = index into array
+ * an array of functions, but what form
+ * combine opts to reduce overhead, d_id_sf+d_dd_ff_o1, d_vid_ssf+same, opt_let d_dd_f2->d_vid_ssf, d_vd_o1+d_dd_ff_o3
+ * maybe d_dd_ff_o1+d_vd_o1
+ * perhaps combine all wrappers into one temp?
+ *
+ * --------------------------------------------------------------------
+ *
+ * 12 | 13 | 14 | 15 || 16 | 17.4 17.5 17.6
+ * tmac | | | || 9043 | 602 263
+ * index 44.3 | 3291 | 1725 | 1276 || 1231 | 1127 1080
+ * tref | | | 2372 || 2083 | 1289 1145
+ * teq | | | 6612 || 2787 | 2210 1990
+ * s7test 1721 | 1358 | 995 | 1194 || 2932 | 2643 2346
+ * tlet 5318 | 3701 | 3712 | 3700 || 4004 | 3641 2483
+ * bench 42.7 | 8752 | 4220 | 3506 || 3507 | 3032 2747
+ * lint | | | || 4029 | 3308 3021 [144.1]
+ * tmap | | | 9.3 || 4300 | 3716 3069
+ * tcopy | | | 13.6 || 3185 | 3342 3158
+ * tauto 265 | 89 | 9 | 8.4 || 2980 | 3248 3200
+ * tform | | | 6816 || 3850 | 3627 3374
+ * tfft | | 15.5 | 16.4 || 17.3 | 4920 3989
+ * tsort | | | || 9186 | 5403 4705
+ * titer | | | || 5964 | 5234 4714
+ * thash | | | 50.7 || 8926 | 8651 7910
+ * tgen | 71 | 70.6 | 38.0 || 12.7 | 12.4 12.6
+ * tall 90 | 43 | 14.5 | 12.7 || 17.9 | 20.1 18.0
+ * calls 359 | 275 | 54 | 34.7 || 43.4 | 42.5 41.1 [131.5]
+ *
+ * --------------------------------------------------------------------
*/
diff --git a/s7.h b/s7.h
index b2b737b..993d425 100644
--- a/s7.h
+++ b/s7.h
@@ -1,8 +1,8 @@
#ifndef S7_H
#define S7_H
-#define S7_VERSION "4.14"
-#define S7_DATE "2-Jan-17"
+#define S7_VERSION "5.3"
+#define S7_DATE "22-May-17"
typedef long long int s7_int; /* This sets the size of integers in Scheme; it needs to be big enough to accomodate a C pointer. */
typedef double s7_double; /* similarly for Scheme reals; only "double" works in C++ */
@@ -93,7 +93,6 @@ s7_pointer s7_wrong_type_arg_error(s7_scheme *sc, const char *caller, int arg_n,
/* set arg_n to 0 to indicate that caller takes only one argument (so the argument number need not be reported */
s7_pointer s7_out_of_range_error(s7_scheme *sc, const char *caller, int arg_n, s7_pointer arg, const char *descr);
s7_pointer s7_wrong_number_of_args_error(s7_scheme *sc, const char *caller, s7_pointer args);
-s7_pointer s7_stacktrace(s7_scheme *sc);
/* these are equivalent to (error ...) in Scheme
* the first argument to s7_error is a symbol that can be caught (via (catch tag ...))
@@ -116,6 +115,10 @@ s7_pointer s7_stacktrace(s7_scheme *sc);
* normally printing the error arguments to current-error-port.
*/
+s7_pointer s7_stacktrace(s7_scheme *sc);
+s7_pointer s7_history(s7_scheme *sc); /* the current (circular backwards) history buffer */
+s7_pointer s7_add_to_history(s7_scheme *sc, s7_pointer entry); /* add entry to the history buffer */
+
unsigned int s7_gc_protect(s7_scheme *sc, s7_pointer x);
void s7_gc_unprotect(s7_scheme *sc, s7_pointer x);
void s7_gc_unprotect_at(s7_scheme *sc, unsigned int loc);
@@ -216,7 +219,7 @@ s7_pointer s7_assoc(s7_scheme *sc, s7_pointer obj, s7_pointer lst); /*
s7_pointer s7_assq(s7_scheme *sc, s7_pointer obj, s7_pointer x); /* (assq obj lst) */
s7_pointer s7_member(s7_scheme *sc, s7_pointer obj, s7_pointer lst); /* (member obj lst) */
s7_pointer s7_memq(s7_scheme *sc, s7_pointer obj, s7_pointer x); /* (memq obj lst) */
-
+bool s7_tree_memq(s7_scheme *sc, s7_pointer sym, s7_pointer tree); /* (tree-memq sym tree) */
bool s7_is_string(s7_pointer p); /* (string? p) */
const char *s7_string(s7_pointer p); /* Scheme string -> C string (do not free the string) */
@@ -274,8 +277,8 @@ char *s7_number_to_string(s7_scheme *sc, s7_pointer obj, int radix); /* (
bool s7_is_vector(s7_pointer p); /* (vector? p) */
s7_int s7_vector_length(s7_pointer vec); /* (vector-length vec) */
int s7_vector_rank(s7_pointer vect); /* number of dimensions in vect */
-s7_int *s7_vector_dimensions(s7_pointer vec); /* dimensions */
-s7_int *s7_vector_offsets(s7_pointer vec); /* precalculated offsets to speed-up addressing */
+s7_int *s7_vector_dimensions(s7_pointer vec); /* dimensions (don't free the pointer) */
+s7_int *s7_vector_offsets(s7_pointer vec); /* precalculated offsets to speed-up addressing (don't free) */
s7_pointer *s7_vector_elements(s7_pointer vec); /* a pointer to the array of s7_pointers */
s7_int *s7_int_vector_elements(s7_pointer vec);
s7_double *s7_float_vector_elements(s7_pointer vec);
@@ -412,7 +415,7 @@ s7_pointer s7_openlet(s7_scheme *sc, s7_pointer e); /* (
bool s7_is_openlet(s7_pointer e); /* (openlet? e) */
s7_pointer s7_method(s7_scheme *sc, s7_pointer obj, s7_pointer method);
-s7_pointer s7_name_to_value(s7_scheme *sc, const char *name);
+s7_pointer s7_name_to_value(s7_scheme *sc, const char *name); /* name's value in the current environment (after turning name into a symbol) */
s7_pointer s7_symbol_table_find_name(s7_scheme *sc, const char *name);
s7_pointer s7_symbol_value(s7_scheme *sc, s7_pointer sym);
s7_pointer s7_symbol_set_value(s7_scheme *sc, s7_pointer sym, s7_pointer val);
@@ -576,10 +579,11 @@ s7_pointer s7_typed_dilambda(s7_scheme *sc,
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_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 */
@@ -651,53 +655,118 @@ void s7_autoload_set_names(s7_scheme *sc, const char **names, int 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);
- /* these are aimed at the CLM optimizer -- they change daily! */
-typedef s7_double (*s7_rf_t)(s7_scheme *sc, s7_pointer **p);
-typedef s7_rf_t (*s7_rp_t)(s7_scheme *sc, s7_pointer expr);
-void s7_rf_set_function(s7_pointer f, s7_rp_t rp);
-s7_rp_t s7_rf_function(s7_scheme *sc, s7_pointer func);
-s7_rf_t s7_rf_1(s7_scheme *sc, s7_pointer expr, s7_rf_t r, s7_rf_t s, s7_rf_t x);
-s7_rf_t s7_rf_2(s7_scheme *sc, s7_pointer expr, s7_rf_t rr, s7_rf_t sr, s7_rf_t xr, s7_rf_t rs, s7_rf_t ss, s7_rf_t xs, s7_rf_t rx, s7_rf_t sx, s7_rf_t xx);
-
-typedef s7_int (*s7_if_t)(s7_scheme *sc, s7_pointer **p);
-typedef s7_if_t (*s7_ip_t)(s7_scheme *sc, s7_pointer expr);
-void s7_if_set_function(s7_pointer f, s7_ip_t rp);
-s7_ip_t s7_if_function(s7_scheme *sc, s7_pointer func);
-
-typedef s7_pointer (*s7_pf_t)(s7_scheme *sc, s7_pointer **p);
-typedef s7_pf_t (*s7_pp_t)(s7_scheme *sc, s7_pointer expr);
-void s7_pf_set_function(s7_pointer f, s7_pp_t rp);
-s7_pp_t s7_pf_function(s7_scheme *sc, s7_pointer func);
-
-void s7_gf_set_function(s7_pointer f, s7_pp_t gp);
-s7_pp_t s7_gf_function(s7_scheme *sc, s7_pointer func);
-
-void *s7_xf_new(s7_scheme *sc, s7_pointer e);
-void s7_xf_free(s7_scheme *sc);
-s7_int s7_xf_store(s7_scheme *sc, s7_pointer val);
-void s7_xf_store_at(s7_scheme *sc, s7_int index, s7_pointer val);
-void *s7_xf_detach(s7_scheme *sc);
-void s7_xf_attach(s7_scheme *sc, void *ur);
-s7_pointer *s7_xf_start(s7_scheme *sc);
-s7_pointer *s7_xf_top(s7_scheme *sc, void *ur);
-bool s7_xf_is_stepper(s7_scheme *sc, s7_pointer sym);
-
-bool s7_arg_to_gf(s7_scheme *sc, s7_pointer a1);
-bool s7_arg_to_pf(s7_scheme *sc, s7_pointer a1);
-bool s7_arg_to_if(s7_scheme *sc, s7_pointer a1);
-bool s7_arg_to_rf(s7_scheme *sc, s7_pointer a1);
-
-s7_int s7_slot_integer_value(s7_pointer slot);
-bool s7_is_stepper(s7_pointer p);
-s7_double s7_slot_real_value(s7_scheme *sc, s7_pointer slot, const char *caller);
-void s7_slot_set_real_value(s7_scheme *sc, s7_pointer slot, s7_double value);
-void s7_object_type_set_xf(int tag, s7_ip_t ip, s7_ip_t set_ip, s7_rp_t rp, s7_rp_t set_rp);
+/* -------------------------------------------------------------------------------- */
+/* the new clm optimizer! this time for sure!
+ * d=double, i=integer, v=c_object, p=s7_pointer
+ * first return type, then arg types, d_vd -> returns double takes c_object and double (i.e. a standard clm generator)
+ */
+
+/* It is possible to tell s7 to call a foreign function directly, without any scheme-related
+ * overhead. The call needs to take the form of one of the s7_*_t functions in s7.h. For example,
+ * one way to call + is to pass it two s7_double arguments and get an s7_double back. This is the
+ * s7_d_dd_t function (the first letter gives the return type, the rest give successive argument types).
+ * We tell s7 about it via s7_set_d_dd_function. Whenever s7's optimizer encounters + with two arguments
+ * that it (the optimizer) knows are s7_doubles, in a context where an s7_double result is expected,
+ * s7 calls the s7_d_dd_t function directly without consing a list of arguments, and without
+ * wrapping up the result as a scheme cell.
+ */
+
+s7_function s7_optimize(s7_scheme *sc, s7_pointer expr);
+
+typedef s7_double (*s7_float_function)(s7_scheme *sc, s7_pointer args);
+s7_float_function s7_float_optimize(s7_scheme *sc, s7_pointer expr);
+
+typedef s7_double (*s7_d_t)(void);
+void s7_set_d_function(s7_pointer f, s7_d_t df);
+s7_d_t s7_d_function(s7_pointer f);
+
+typedef s7_double (*s7_d_d_t)(s7_double x);
+void s7_set_d_d_function(s7_pointer f, s7_d_d_t df);
+s7_d_d_t s7_d_d_function(s7_pointer f);
+
+typedef s7_double (*s7_d_dd_t)(s7_double x1, s7_double x2);
+void s7_set_d_dd_function(s7_pointer f, s7_d_dd_t df);
+s7_d_dd_t s7_d_dd_function(s7_pointer f);
+
+typedef s7_double (*s7_d_ddd_t)(s7_double x1, s7_double x2, s7_double x3);
+void s7_set_d_ddd_function(s7_pointer f, s7_d_ddd_t df);
+s7_d_ddd_t s7_d_ddd_function(s7_pointer f);
+
+typedef s7_double (*s7_d_dddd_t)(s7_double x1, s7_double x2, s7_double x3, s7_double x4);
+void s7_set_d_dddd_function(s7_pointer f, s7_d_dddd_t df);
+s7_d_dddd_t s7_d_dddd_function(s7_pointer f);
+
+typedef s7_double (*s7_d_v_t)(void *v);
+void s7_set_d_v_function(s7_pointer f, s7_d_v_t df);
+s7_d_v_t s7_d_v_function(s7_pointer f);
+
+typedef s7_double (*s7_d_vd_t)(void *v, s7_double d);
+void s7_set_d_vd_function(s7_pointer f, s7_d_vd_t df);
+s7_d_vd_t s7_d_vd_function(s7_pointer f);
+
+typedef s7_double (*s7_d_vdd_t)(void *v, s7_double x1, s7_double x2);
+void s7_set_d_vdd_function(s7_pointer f, s7_d_vdd_t df);
+s7_d_vdd_t s7_d_vdd_function(s7_pointer f);
+
+typedef s7_double (*s7_d_vid_t)(void *v, s7_int i, s7_double d);
+void s7_set_d_vid_function(s7_pointer f, s7_d_vid_t df);
+s7_d_vid_t s7_d_vid_function(s7_pointer f);
+
+typedef s7_double (*s7_d_p_t)(s7_pointer p);
+void s7_set_d_p_function(s7_pointer f, s7_d_p_t df);
+s7_d_p_t s7_d_p_function(s7_pointer f);
+
+typedef s7_double (*s7_d_pd_t)(s7_pointer v, s7_double x);
+void s7_set_d_pd_function(s7_pointer f, s7_d_pd_t df);
+s7_d_pd_t s7_d_pd_function(s7_pointer f);
+
+typedef s7_double (*s7_d_pid_t)(s7_pointer v, s7_int i, s7_double d);
+void s7_set_d_pid_function(s7_pointer f, s7_d_pid_t df);
+s7_d_pid_t s7_d_pid_function(s7_pointer f);
+
+typedef s7_double (*s7_d_id_t)(s7_int i, s7_double d);
+void s7_set_d_id_function(s7_pointer f, s7_d_id_t df);
+s7_d_id_t s7_d_id_function(s7_pointer f);
+
+typedef s7_int (*s7_i_i_t)(s7_int x);
+void s7_set_i_i_function(s7_pointer f, s7_i_i_t df);
+s7_i_i_t s7_i_i_function(s7_pointer f);
+
+typedef s7_int (*s7_i_d_t)(s7_double x);
+void s7_set_i_d_function(s7_pointer f, s7_i_d_t df);
+s7_i_d_t s7_i_d_function(s7_pointer f);
+
+typedef s7_int (*s7_i_ii_t)(s7_int i1, s7_int i2);
+void s7_set_i_ii_function(s7_pointer f, s7_i_ii_t df);
+s7_i_ii_t s7_i_ii_function(s7_pointer f);
+
+typedef s7_double (*s7_d_ip_t)(s7_int i, s7_pointer p);
+void s7_set_d_ip_function(s7_pointer f, s7_d_ip_t df);
+s7_d_ip_t s7_d_ip_function(s7_pointer f);
+
+typedef s7_int (*s7_i_p_t)(s7_pointer p);
+void s7_set_i_p_function(s7_pointer f, s7_i_p_t df);
+s7_i_p_t s7_i_p_function(s7_pointer f);
+
+typedef bool (*s7_b_p_t)(s7_pointer p);
+void s7_set_b_p_function(s7_pointer f, s7_b_p_t df);
+s7_b_p_t s7_b_p_function(s7_pointer f);
+
+typedef s7_double (*s7_d_pi_t)(s7_pointer v, s7_int i);
+void s7_set_d_pi_function(s7_pointer f, s7_d_pi_t df);
+s7_d_pi_t s7_d_pi_function(s7_pointer f);
+
+/* -------------------------------------------------------------------------------- */
+
+
+/* these are possibly temporary */
void s7_object_type_set_direct(int 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));
-/* end CLM stuff */
+void s7_slot_set_real_value(s7_scheme *sc, s7_pointer slot, s7_double value);
/* this is experimental */
@@ -779,6 +848,14 @@ s7_pointer s7_apply_n_9(s7_scheme *sc, s7_pointer args,
*
* s7 changes
*
+ * 22-May: lambda* keyword arg handling changed slightly.
+ * 9-May: s7_history, s7_add_to_history.
+ * 20-Apr: s7_tree_memq (for Snd), s7_type_of, many changes for new clm optimizer.
+ * 10-Apr: added s7_scheme first argument to s7_iterator_is_at_end.
+ * 28-Mar: removed the "rf", "pf" and "if" clm optimization functions.
+ * s7_optimize, s7_float_optimize, s7_procedure_signature.
+ * 22-Feb: removed the "gf" clm optimization functions.
+ * 11-Feb: #e, #i, #d removed. #i(...) is an int-vector constant, #r(...) a float-vector.
* 2-Jan-17: {apply_values} -> apply-values, {list} -> list-values, and {append} -> append.
* --------
* 23-Sep: make-keyword -> string->keyword.
diff --git a/s7.html b/s7.html
index 3ba42cb..a04cd36 100644
--- a/s7.html
+++ b/s7.html
@@ -207,7 +207,7 @@ indented and on a sort of brownish background.
<li><a href="#define*">define*, named let*</a>
<li><a href="#macros">define-macro</a>
<li><a href="#pws">procedure-setter</a>
- <li><a href="#generalizedset">generalized set!</a>
+ <li><a href="#generalizedset">generic functions, generalized set!</a>
<li><a href="#multidimensionalvectors">multidimensional vectors</a>
<li><a href="#hashtables">hash tables</a>
<li><a href="#environments">environments</a>
@@ -373,7 +373,7 @@ s7 includes:
<ul>
<li>sinh, cosh, tanh, asinh, acosh, atanh
-<li>logior, logxor, logand, lognot, logbit?, ash, integer-length, integer-decode-float
+<li>logior, logxor, logand, lognot, logbit?, ash, integer-decode-float
<li>random
<li>nan?, infinite?
</ul>
@@ -597,7 +597,7 @@ we can maintain backwards compatibility via:
(define (exact->inexact x) (* x 1.0))
</pre>
-<p>#i and #e are also useless because you can
+<p>Standard Scheme's #i and #e are also useless because you can
have any number after, for example, #b:
</p>
@@ -610,7 +610,8 @@ have any number after, for example, #b:
<em class="gray">15.625+1i</em>
</pre>
-<p>Speaking of #b and friends, what should <code>(string->number "#xffff" 2)</code> return?
+<p>(But s7 uses #i for int-vector and does not implement #e).
+Speaking of #b and friends, what should <code>(string->number "#xffff" 2)</code> return?
</p>
</div>
@@ -747,6 +748,25 @@ have been evaluated (as in named let).
<pre class="indented">
(define* (foo (a 0) (b (+ a 4)) (c (+ a 7))) (list a b c))
</pre>
+<p>Also CL and s7 handle keywords as values in the same way:
+</p>
+<pre class="indented">
+> (defun foo (&key a) a)
+<em class="gray">FOO</em>
+> (defvar x :a)
+<em class="gray">X</em>
+> (foo x 1)
+<em class="gray">1</em>
+</pre>
+
+<pre class="indented">
+> (define* (foo a) a)
+<em class="gray">foo</em>
+> (define x :a)
+<em class="gray">:a</em>
+> (foo x 1)
+<em class="gray">1</em>
+</pre>
</div>
@@ -1801,6 +1821,24 @@ or even <code>(> 1 0+i)</code>.
(<a href="#morallyequalp">morally-equal?</a> obj1 obj2)
</pre>
+<p><b>copy</b> returns a (shallow) copy of its argument. If a destination is provided,
+it need not match the source in size or type. The start and end indices refer to the source.
+</p>
+<pre class="indented">
+> (copy '(1 2 3 4) (make-list 2))
+<em class="gray">(1 2)</em>
+> (copy #(1 2 3 4) (make-list 5) 1) ; start at 1 in the source
+<em class="gray">(2 3 4 #f #f)</em>
+> (copy "1234" (make-vector 2))
+<em class="gray">#(#\1 #\2)</em>
+> (define lst (list 1 2 3 4 5))
+<em class="gray">(1 2 3 4 5)</em>
+> (copy #(8 9) (cddr lst))
+<em class="gray">(8 9 5)</em>
+> lst
+<em class="gray">(1 2 8 9 5)</em>
+</pre>
+
<p><b>reverse!</b> is an in-place version of reverse. That is,
it modifies the sequence passed to it in the process of reversing its contents.
If the sequence is a list, remember to use set!:
@@ -1808,6 +1846,14 @@ If the sequence is a list, remember to use set!:
but historically, lisp programmers have treated the in-place reverse as the fast
version, so s7 follows suit.
</p>
+<pre class="indented">
+> (define lst (list 1 2 3))
+<em class="gray">(1 2 3)</em>
+> (reverse! lst)
+<em class="gray">(3 2 1)</em>
+> lst
+<em class="gray">(1)</em>
+</pre>
<p>Leaving aside the weird list case,
<b>append</b> returns a sequence of the same type as its first argument.
@@ -1882,10 +1928,9 @@ value in the closure's environment:
(make-iterator
(let ((iterator? #t))
(lambda ()
- (let ((result (iter)))
- (if (eof-object? result)
- ((set! iter (make-iterator obj)))
- result)))))))
+ (case (iter)
+ ((#<eof>) ((set! iter (make-iterator obj))))
+ (else)))))))
</pre>
<p>The 'iterator? variable is similar to the 'documentation variable used by procedure-documentation.
It gives make-iterator some hope of catching inadvertent bogus function arguments that would
@@ -1939,9 +1984,7 @@ vector-dimensions returns a list of the dimensions.
</pre>
<p>make-int-vector and make-float-vector produce homogeneous vectors holding
-s7_ints or s7_doubles.
-These are mostly useful in conjunction with C code. These
-homogeneous vector functions are currently built-in:
+s7_ints or s7_doubles:
</p>
<pre class="indented">
@@ -1968,7 +2011,7 @@ homogeneous vector functions are currently built-in:
(<em class=def id="bytevectorset">byte-vector-set!</em> vect index byte)
(<em class=def id="stringtobytevector">string->byte-vector</em> str)
</pre>
-<p>but these are really just strings in disguise.</p>
+<p>but byte-vectors are just strings in disguise.</p>
</div>
<p>To access a vector's elements with different dimensions than the original had, use
@@ -2071,6 +2114,8 @@ homogeneous vector functions are currently built-in:
<p>Multidimensional vector constant syntax is modelled after CL: #nd(...) or #nD(...)
signals that the lists specify the elements of an 'n' dimensional vector: <code>#2D((1 2 3) (4 5 6))</code>
+int-vector constants use #i, float-vectors use #r. I wanted to use #f, but that is already taken.
+Append the "nD" business after the type indication: <code>#i2d((1 2) (3 4))</code>.
</p>
<pre class="indented">
@@ -2078,6 +2123,12 @@ signals that the lists specify the elements of an 'n' dimensional vector: <code>
<em class="gray">6</em>
> (matrix-multiply #2d((-1 0) (0 -1)) #2d((2 0) (-2 2)))
<em class="gray">#2D((-2 0) (2 -2))</em>
+> (int-vector 1 2 3)
+<em class="gray">#i(1 2 3)</em>
+> (make-float-vector '(2 3) 1.0)
+<em class="gray">#r2D((1.0 1.0 1.0) (1.0 1.0 1.0))</em>
+> (vector (vector 1 2) (int-vector 1 2) (float-vector 1 2))
+<em class="gray">#(#(1 2) #i(1 2) #r(1.0 2.0))</em>
</pre>
<p>If any dimension has 0 length, you get an n-dimensional empty vector. It is not
@@ -2153,11 +2204,6 @@ Perhaps we could use different colors? Or different size parentheses?
#2D<em class="bigger">(</em><em class="big">(</em>(0) (0) ((0))<em class="big">)</em> <em class="big">(</em>(0) 0 ((0))<em class="big">)</em><em class="bigger">)</em>
</pre>
-<p>A similar problem afflicts homogeneous vectors. We need some reasonable way to express
-such a vector even when it has more than one dimension. My first thought was <code>#(...)#</code>,
-but that makes <code>(let ((b1 0)) (#(1 2)#b1))</code> ambiguous.
-</p>
-
</div>
@@ -2228,6 +2274,10 @@ Currently, you can mix types with implicit indices,
but a function grabs all remaining indices. Trickier than I expected!
</p>
+<pre class="indented">
+> (vector-ref (vector abs log) 0 -1)
+<em class="gray">1</em> ; hmm...
+</pre>
</div>
</blockquote>
@@ -2426,7 +2476,7 @@ Environments are first class (and applicable) objects in s7.
(<em class=def id="lettemporarily">let-temporarily</em> vars . body)
</pre>
-<br>
+
<blockquote>
<pre class="indented">
> (inlet 'a 1 'b 2)
@@ -2504,6 +2554,26 @@ original value. It can handle anything settable:
<p>This sets s7's print-length variable to 8 while displaying x, then
puts it back to its original value.
</p>
+<pre class="indented">
+> (define ourlet
+ (let ((x 1))
+ (define (a-func) x)
+ (define b-func (let ((y 1))
+ (lambda ()
+ (+ x y))))
+ (curlet)))
+<em class="gray">(inlet 'x 1 'a-func a-func 'b-func b-func)</em>
+> (ourlet 'x)
+<em class="gray">1</em>
+> (let-temporarily (((ourlet 'x) 2))
+ ((ourlet 'a-func)))
+<em class="gray">2</em>
+> ((funclet (ourlet 'b-func)) 'y)
+<em class="gray">1</em>
+> (let-temporarily ((((funclet (ourlet 'b-func)) 'y) 3))
+ ((ourlet 'b-func)))
+<em class="gray">4</em>
+</pre>
<p>
@@ -2550,6 +2620,28 @@ local variable:
<em class="gray">100</em>
</pre>
+<p><b>funclet</b> returns a function's local environment. Here's an example that
+keeps a circular buffer of the calls to that function:
+</p>
+
+<pre class="indented">
+(define func (let ((history (let ((lst (make-list 8 #f)))
+ (set-cdr! (list-tail lst 7) lst)
+ lst)))
+ (lambda (x y)
+ (let ((result (+ x y)))
+ (set-car! history (list result x y))
+ (set! history (cdr history))
+ result))))
+
+> (func 1 2)
+<em class="gray">3</em>
+> (func 3 4)
+<em class="gray">7</em>
+> ((funclet func) 'history)
+<em class="gray">#1=(#f #f #f #f #f #f (3 1 2) (7 3 4) . #1#)</em>
+</pre>
+
<blockquote>
<div class="indented">
<p>I originally used a bunch of foolishly pompous names for the environment functions.
@@ -2587,6 +2679,9 @@ that unlet accesses is not accessible from scheme code, so there's no way
that those values can be clobbered).
</p>
+<p>
+<code>(fill! lt <undefined>)</code> removes all bindings from the let lt.
+</p>
<blockquote>
<div class="indented">
@@ -3653,7 +3748,8 @@ from a simple procedure.
<p>object->string returns the string representation of its argument. Its optional second argument
can be #f (use display), #t (the default, use write), or :readable. In the latter case, object->string
tries to produce a string that can be evaluated via eval-string to return an object equal to the
-original.
+original. The optional third argument sets the maximum desired string length; if object->string
+notices it has exceeded this limit, it returns the partial string.
</p>
<pre class="indented">
@@ -4738,7 +4834,7 @@ a top-level variable is redefined (via define and friends, not set!).
<pre class="indented">
(set! (hook-functions *rootlet-redefinition-hook*)
(list (lambda (hook)
- (format *stderr* "~A ~A~%" (hook 'symbol) (hook 'value)))))
+ (format *stderr* "~A ~A~%" (hook 'name) (hook 'value)))))
</pre>
<p>will print out the variable's name and the new value.
</p>
@@ -5078,7 +5174,7 @@ at startup *features* is:
<pre class="indented">
> *features*
<em class="gray">(snd-17.0 snd17 snd audio snd-s7 snd-gtk gsl alsa gtk2 xg clm6 clm sndlib linux
- dlopen complex-numbers system-extras ratio s7-3.26 s7) </em>
+ dlopen complex-numbers system-extras ratio s7-4.14 s7) </em>
> (provided? 'gsl)
<em class="gray">#t</em>
</pre>
@@ -5155,7 +5251,7 @@ tokens that start with "#". <b><em class=def id="sharpreaders">*#readers*</em><
one argument, the string that follows the #-sign up to the next delimiter. "func" is called
when #<char> is encountered. If it returns something other than #f, the #-expression
is replaced with that value. Scheme has several predefined #-readers for cases such
-as #b1, #\a, #i123, and so on, but you can override these if you like. If the string
+as #b1, #\a, and so on, but you can override these if you like. If the string
passed in is not the complete #-expression, the function can use read-char or read to get the
rest. Say we'd like #t<number> to interpret the number in base 12:
</p>
@@ -5236,7 +5332,7 @@ rest. Say we'd like #t<number> to interpret the number in base 12:
(define (traverse tree)
(if (pair? tree)
(cons (traverse (car tree))
- (if (null? (cdr tree)) () (traverse (cdr tree))))
+ (case (cdr tree) ((()) ()) (else => traverse)))
(if (memq tree '(and or not)) tree
(and (symbol? tree) (provided? tree)))))
(if (eval (traverse e))
@@ -5715,10 +5811,11 @@ default-random-state the default arg for random (settable)
cpu-time run time so far
file-names currently loaded files (a list)
-safety 0
+safety 0 (see below)
undefined-identifier-warnings #f
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)
@@ -5731,9 +5828,7 @@ stack the current stack entries
stacktrace-defaults stacktrace formatting info for error handler
symbol-table a vector
-symbol-table-locked? #f (if #t, no new symbols can be added to the symbol table)
rootlet-size the number of globals
-
heap-size total cells currently available
free-heap-size the number of currently unused cells
gc-freed number of cells freed by the last GC pass
@@ -5748,12 +5843,27 @@ Use the standard environment syntax to access these fields:
*s7*->list that returns most of these fields in a list.
</p>
-<p>
-Set (*s7* 'safety) to 2 or higher
-to turn off optimization. Set (*s7* 'autoloading) to #f to turn off the autoloader.
+<p><code>(set! (*s7* 'autoloading) #f)</code> turns off the autoloader.
</p>
-<p>stacktrace-defaults is a list of four integers and a boolean that tell the error
+<p>The 'safety variable is an integer. Currently:
+</p>
+<pre class="indented">
+0: default.
+1: no remove_from_heap (a GC optimization)
+ infinite loop check in eval, sort! and some iterators
+ immutable object check in reverse!, sort!, and fill!
+ more info in (*s7* 'history) for s7_apply_function, s7_call and s7_eval
+ less aggressive optimization in with-let and lambda
+ warnings about syntax redefinition
+2: incoming s7_pointer checks in some FFI functions
+ clm optimization off
+ bignum int to s7_int conversion checks
+3: all optimization off
+4: vector, string, and pair constants are immutable (but checks for this are currently sparse)
+</pre>
+
+<p><code>(*s7* 'stacktrace-defaults)</code> is a list of four integers and a boolean that tell the error
handler how to format stacktrace information. The four integers are:
how many frames to display,
how many columns are devoted to code display,
@@ -5812,6 +5922,7 @@ of the object's type in the (*s7* 'c-types) list.
<li>when and unless (for r7rs), returning the value of the last form.
<li>the "d", "f", "s", and "l" exponent markers are not supported by default (use "e", "E", or "@").
<li>quasiquoted vector constants are not supported (use the normal list expansions wrapped in list->vector).
+<li><em class=def id="typeof">type-of</em> returns a type indicator for its argument.
</ul>
<p>In s7 if a built-in function like gcd is referred to in a function
@@ -5837,7 +5948,7 @@ definition, and a later redefinition does not affect earlier uses.
</p>
<ul>
-<li>remove the exact/inexact distinction including #i and #e
+<li>remove the exact/inexact distinction including #i and #e (done! #i means int-vector constant).
<li>remove call-with-values and its friends
<li>remove char-ready?
<li>change eof-object? to eof? or just omit it (you can use eq? #<eof>)
@@ -5845,7 +5956,7 @@ definition, and a later redefinition does not affect earlier uses.
<li>remove unquote (the name, not the functionality).
<li>remove cond-expand.
<li>remove *-ci functions
-<li>remove #d
+<li>remove #d (done!)
</ul>
<p>(most of these are removed if you set the compiler flag WITH_PURE_S7), and perhaps:
@@ -5888,12 +5999,14 @@ so if we allow <code>(begin)</code>, we should allow case clauses to have no exp
In cond,
the "implicit progn" (in CL terminology) includes the test expression, so a clause without a result returns
the test result (if true of course). In the case case, s7 returns the selector.
-<code>(case x ((0 1)))</code> is equivalent to <code>(case x ((0 1) => values))</code>,
-just as <code>(cond (A))</code> is equivalent to <code>(cond (A => values))</code>.
+<code>(case x ((0 1)))</code> is equivalent to <code>(case x ((0 1) => values))</code>,
+just as <code>(cond (A))</code> is equivalent to <code>(cond (A => values))</code>.
One application is method lookup: <code>((case (obj 'abs) ((#<undefined>) abs) (else)) ...)</code>;
we would otherwise have to save the lookup result or do it twice.
This choice has a ripple
-effect on hash-tables. Currently hash-table-ref returns #f if the key is not in the table,
+effect on do: if no result is specified for do, s7 returns the test result.
+It also affects
+hash-tables. Currently hash-table-ref returns #f if the key is not in the table,
mimicking assoc and aimed at cond with =>, but if we also use case and #<undefined>,
it seems more useful and maybe intuitive to mimic let-ref instead. But if hash-table-ref returns
#<undefined>, it's harder to use hash-tables as sets. Hmm.
@@ -5945,7 +6058,7 @@ Better ideas are always welcome!
<li>omits unquote (the name)
<li>omits d/f/s/l exponents
<li>omits make-polar and make-rectangular (use complex)
-<li>omits integer-length, exact?, inexact?, exact->inexact, inexact->exact, #i and #e
+<li>omits exact?, inexact?, exact->inexact, inexact->exact
<li>omits set-current-output-port and set-current-input-port
</ul>
@@ -6104,7 +6217,7 @@ it is GC'd. Here is an example:
<p>Put this is a file, load it into the interpreter, then call <code>(bad-idea)</code> a
few times. You can turn off the optimization in question by setting the variable <code>(*s7* 'safety)</code>
-to 1. <code>(*s7* 'safety)</code> defaults to 0.
+to 3. <code>(*s7* 'safety)</code> defaults to 0.
</p>
<p>A similar problem arises when you want to walk a function's source or reuse a piece of
@@ -6503,8 +6616,8 @@ use a trailing null instead (mimicking apply* in some ancient lisps):
<p>
Currently, you can't set! a built-in syntactic keyword to some new value:
<code>(set! if 3)</code>.
-I hope this kind of thing is not actually very useful, but let me
-know if you need it. The issue is purely one of speed.
+let-temporarily uses set!, so <code>(let-temporarily ((if 3))...)</code>
+is also unlikely to work.
</p>
<p>Speaking of speed... It is widely believed
@@ -6520,12 +6633,10 @@ so misleading that I feel guilty about it):
(display ".")))
(newline))
-(for-each
- (lambda (n) (do-loop n))
- (list 1000 1000000 10000000))
+(for-each do-loop (list 1000 1000000 10000000))
</pre>
-<p>In s7, that takes 0.24 seconds on my home machine. In tinyScheme, from
+<p>In s7, that takes 0.22 seconds on my home machine. In tinyScheme, from
whence we sprang, it takes 85 seconds. In the chicken interpreter, 5.3
seconds, and after compilation (using -O2) of the chicken compiler output,
0.75 seconds. So, s7 is comparable to chicken in speed, even though chicken
@@ -6547,6 +6658,44 @@ of it as being a little REPL. begin does not introduce a new frame in
the current environment, so defines happen in the enclosing environment.
Finally, begin, explicit or otherwise, does not pretend to emulate letrec*.
</p>
+
+<p>If we allow defines anywhere, the notion of "lexical scope" becomes problematic.
+Scheme is already a mess in that regard: take
+</p>
+
+<pre class="indented">
+(let ((x 1))
+ (do ((y x x)
+ (x 3))
+ ((> y 1) y)))
+</pre>
+
+<p>In <code>(y x x)</code> the first x is the outer one, and the second is the
+following do variable, so this returns 3! But sticking to define, in
+</p>
+
+<pre class="indented">
+(let ((x 1))
+ (define y x)
+ (define x 2)
+ y)
+</pre>
+
+<p>s7 returns 1 even though technically the second x is in y's environment.
+Since we treat this as a REPL, y gets its value from the only x defined at
+the point it is defined. However,
+</p>
+
+<pre class="indented">
+(let ((x 1))
+ (define y (lambda () x))
+ (define x 2)
+ (y))
+</pre>
+
+<p>returns 2 in s7 because the x in y's function body is not evaluated
+until after the second x is defined.
+</p>
</div>
@@ -6576,65 +6725,7 @@ threads were not useful mainly because the GUI toolkits are not thread safe.
Last but not least, the effort to make the non-threaded
s7 faster messed up parts of the threaded version. Rather than
waste a lot of time fixing this, I chose to flush multithreading.
-Here's a very simple example of using an s7 interpreter per thread:
</p>
-
-<pre class="indented">
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <pthread.h>
-#include "s7.h"
-
-typedef struct {
- s7_scheme *sc;
- s7_pointer func;
- pthread_t *thread;
-} thred;
-
-static void *run_thread(void *obj)
-{
- thred *f = (thred *)obj;
- return((void *)s7_call(f->sc, f->func, s7_nil(f->sc)));
-}
-
-static thred *make_thread(s7_function func)
-{
- thred *f;
- f = (thred *)malloc(sizeof(thred));
- f->sc = s7_init();
- f->func = s7_make_function(f->sc, "a-test", func, 0, 0, false, "a test");
- f->thread = (pthread_t *)malloc(sizeof(pthread_t));
- pthread_create(f->thread, NULL, run_thread, (void *)f);
- return(f);
-}
-
-static s7_pointer a_test(s7_scheme *sc, s7_pointer args)
-{
- fprintf(stderr, "I am %p\n", sc);
- /* do something time-consuming... */
- return(args);
-}
-
-int main(int argc, char **argv)
-{
- thred *f1, *f2;
- f1 = make_thread(a_test);
- f2 = make_thread(a_test);
-
- pthread_join(*(f1->thread), NULL);
- pthread_join(*(f2->thread), NULL);
-}
-
-/* build s7 with -DWITH_THREADS, then
- * gcc -o repl repl.c s7.o -g3 -Wl,-export-dynamic -lpthread -lm -I. -ldl
- */
-</pre>
-
-<p>Unfortunately, there's no way yet to
-free all the resources s7_init allocates (the heap, stack, etc).
-</p>
-
</div>
</details>
@@ -8579,6 +8670,39 @@ function j0. See <a href="#cload">cload.scm</a> for more details.
</p>
+<p>Here's a shorter example:
+</p>
+<div class="indented">
+<pre>
+add1.c:
+
+#include <stdlib.h>
+#include "s7.h"
+
+static s7_pointer add1(s7_scheme *sc, s7_pointer args)
+{
+ if (s7_is_integer(s7_car(args)))
+ return(s7_make_integer(sc, 1 + s7_integer(s7_car(args))));
+ return(s7_wrong_type_arg_error(sc, "add1", 1, s7_car(args), "an integer"));
+}
+
+void add1_init(s7_scheme *sc);
+void add1_init(s7_scheme *sc)
+{
+ s7_define_function(sc, "add1", add1, 1, 0, false, "(add1 int) adds 1 to int");
+}
+
+/* gcc -fpic -c add1.c
+ * gcc -shared -Wl,-soname,libadd1.so -o libadd1.so add1.o -lm -lc
+ * gcc s7.c -o repl -fpic -DWITH_MAIN -I. -ldl -lm -Wl,-export-dynamic -DUSE_SND=0
+ * repl
+ * (load "libadd1.so" (inlet 'init_func 'add1_init))
+ * (add1 2)
+ */
+</pre>
+</div>
+
+
<div class="header" id="gmpex"><h4>Bignums in C</h4></div>
@@ -8819,7 +8943,12 @@ int main(int argc, char **argv)
s7 = s7_init();
+#if (GTK_CHECK_VERSION(3, 90, 0))
+ gtk_init();
+#else
gtk_init(&argc, &argv);
+#endif
+
shell = gtk_window_new(GTK_WINDOW_TOPLEVEL);
g_signal_connect(G_OBJECT(shell), "delete_event", G_CALLBACK(quit_repl), NULL);
@@ -8842,6 +8971,8 @@ int main(int argc, char **argv)
/* in gtk-2: gcc gcall.c -o gcall s7.o glistener.o `pkg-config --libs gtk+-2.0 --cflags` -lm -ldl
* in gtk-3: gcc gcall.c -o gcall s7.o glistener.o `pkg-config --libs gtk+-3.0 --cflags` -lm -ldl
+ * glistener.o can be built similarly:
+ * gcc glistener.c -c `pkg-config --libs gtk+-3.0 --cflags` -lm -ldl
*/
</pre>
@@ -8941,6 +9072,13 @@ end
document s7value
print the value of the variable passed by its print name: s7v "*features*"
end
+
+define s7let
+print s7_show_let(cur_sc)
+end
+document s7let
+show all non-global variables that are currently accessible
+end
</pre>
<p>gdbinit also has s7cell to decode every field of an s7_pointer, and two backtrace
diff --git a/s7test.scm b/s7test.scm
index ea35f1b..3bcd288 100644
--- a/s7test.scm
+++ b/s7test.scm
@@ -28,7 +28,7 @@
(define with-complex (provided? 'complex-numbers))
(define with-windows (provided? 'windows))
(if (not (defined? 's7test-exits)) (define s7test-exits #t))
-
+(define asan-flags "") ;" -fsanitize=address -fsanitize=bounds ")
;;; ---------------- pure-s7 ----------------
(define pure-s7 (provided? 'pure-s7))
@@ -208,11 +208,6 @@
(define *max-arity* #x20000000)
(define (-s7-stack-top-) (*s7* 'stack-top))
-(define -s7-symbol-table-locked? (dilambda
- (lambda ()
- (*s7* 'symbol-table-locked?))
- (lambda (val)
- (set! (*s7* 'symbol-table-locked?) val))))
(if (provided? 'profiling)
(load "profile.scm"))
@@ -223,17 +218,6 @@
(defined? 'mus-rand-seed))
(set! (mus-rand-seed) (current-time)))
-(define (format-logged . args)
- ;(if (not (eq? (current-output-port) old-stdout)) (apply format (cons old-stdout (cdr args))))
- (let ((str (apply format args)))
- ;(if (eq? (car args) #t) (flush-output-port (current-output-port)))
- (if (string? s7test-output)
- (let ((p (open-output-file s7test-output "a")))
- (display str p)
- (flush-output-port p)
- (close-output-port p)))
- str))
-
(define (ok? otst ola oexp)
(let ((result (catch #t ola
(lambda args
@@ -241,7 +225,7 @@
(begin (display args) (newline)))
'error))))
(if (not (equal? result oexp))
- (format-logged #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) otst result oexp))))
+ (format #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) otst result oexp))))
(if (not (defined? 'test))
(define-macro (test tst expected) ;(display tst *stderr*) (newline *stderr*)
@@ -268,7 +252,7 @@
(lambda args
(set! _result_ 'error)))
(if (not (equal? _result_ ,expected))
- (format-logged #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) ',tst _result_ ,expected))))
+ (format #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) ',tst _result_ ,expected))))
|#
)
@@ -280,7 +264,7 @@
'error))))
(if (or (not result)
(eq? result 'error))
- (format-logged #t "~A: ~A got ~S ~A~%~%" (port-line-number) otst result (or data "")))))
+ (format #t "~A: ~A got ~S ~A~%~%" (port-line-number) otst result (or data "")))))
(define-macro (test-t tst) ;(display tst *stderr*) (newline *stderr*)
`(tok? ',tst (lambda () ,tst)))
@@ -290,7 +274,7 @@
(lambda args
'error))))
(if (not (eq? result 'error))
- (format-logged #t "~A: (~A ~S) got ~S but expected 'error~%~%" (port-line-number) ,op ,arg result))))
+ (format #t "~A: (~A ~S) got ~S but expected 'error~%~%" (port-line-number) ,op ,arg result))))
(define (op-error op result expected)
@@ -357,7 +341,7 @@
(> (/ (abs (- result expected)) (max 1.0 (abs expected))) error-12))
(and (pair? tst)
(> (op-error (car tst) result expected) error-6))))
- (format-logged #t "~A: ~A got ~A~Abut expected ~A~%~%"
+ (format #t "~A: ~A got ~A~Abut expected ~A~%~%"
(port-line-number) tst result
(if (and (rational? result) (not (rational? expected)))
(format #f " (~A) " (* 1.0 result))
@@ -568,62 +552,6 @@ static s7_pointer g_block_set(s7_scheme *sc, s7_pointer obj, s7_pointer args)
return(s7_out_of_range_error(sc, \"block-set\", 2, s7_car(args), \"should be less than block length\"));
}
-static s7_double c_block_ref(s7_scheme *sc, s7_pointer **p)
-{
- s7_int ind;
- s7_if_t xf;
- g_block *g;
- g = (g_block *)(**p); (*p)++;
- xf = (s7_if_t)(**p); (*p)++;
- ind = xf(sc, p);
- return(g->data[ind]);
-}
-
-static s7_double c_block_set(s7_scheme *sc, s7_pointer **p)
-{
- s7_int ind;
- s7_double x;
- s7_rf_t rf;
- s7_if_t xf;
- g_block *g;
- g = (g_block *)(**p); (*p)++;
- xf = (s7_if_t)(**p); (*p)++;
- ind = xf(sc, p);
- rf = (s7_rf_t)(**p); (*p)++;
- x = rf(sc, p);
- g->data[ind] = x;
- return(x);
-}
-
-static s7_rf_t block_rf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer a1, gs;
- a1 = s7_car(expr);
- if ((s7_is_symbol(a1)) &&
- (s7_object_type(gs = s7_symbol_value(sc, a1)) == g_block_type))
- {
- s7_xf_store(sc, (s7_pointer)s7_object_value(gs));
- if (s7_arg_to_if(sc, s7_cadr(expr))) return(c_block_ref);
- }
- return(NULL);
-}
-
-static s7_rf_t block_set_rf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer a1, gs;
- a1 = s7_cadr(expr);
- if ((!s7_is_pair(a1)) || (!s7_is_symbol(s7_car(a1))) || (!s7_is_null(sc, s7_cddr(a1)))) return(NULL);
- gs = s7_symbol_value(sc, s7_car(a1));
- if (s7_object_type(gs) == g_block_type)
- {
- s7_xf_store(sc, (s7_pointer)s7_object_value(gs));
- if (!s7_arg_to_if(sc, s7_cadr(a1))) return(NULL);
- if (!s7_arg_to_rf(sc, s7_caddr(expr))) return(NULL);
- return(c_block_set);
- }
- return(NULL);
-}
-
static s7_pointer block_direct_ref(s7_scheme *sc, s7_pointer obj, s7_int index)
{
g_block *g;
@@ -988,7 +916,6 @@ void block_init(s7_scheme *sc)
'append block-append \
'reverse! block-reverse!))\");
s7_gc_protect(sc, g_block_methods);
- s7_object_type_set_xf(g_block_type, NULL, NULL, block_rf, block_set_rf);
s7_object_type_set_direct(g_block_type, block_direct_ref, block_direct_set);
s7_define_safe_function(sc, \"function-open-output\", fout_open, 0, 0, false, \"\");
@@ -1064,10 +991,9 @@ void block_init(s7_scheme *sc)
(when (and (provided? 'linux)
(not (provided? 'gmp)))
- (system "gcc -o ffitest ffitest.c -g3 -Wall s7.o -lm -I. -ldl")
+ (system (string-append "gcc -o ffitest ffitest.c -g3 -Wall s7.o " asan-flags " -lm -I. -ldl"))
(system "ffitest"))
-
-
+#|
(when with-block
;(define eval seval) ; finished ok
;(define dynamic-wind swind) ; finished ok
@@ -1081,7 +1007,7 @@ void block_init(s7_scheme *sc)
(test (+ 1 (values (sevalstr "(catch #t (lambda () asdf) (lambda args 2))") (sevalstr "(catch #t (lambda () asdf) (lambda args 3))"))) 6)
(test (seval '(+ 1 #())) 'error)
)
-
+|#
#|
(let ()
(if (null? (hook-functions *error-hook*))
@@ -1103,7 +1029,7 @@ void block_init(s7_scheme *sc)
(begin (display args) (newline)))
'error))))
(if (not (equal? result oexp))
- (format-logged #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) otst result oexp))))
+ (format #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) otst result oexp))))
(define-macro (test tst expected)
`(ok1? ',tst (lambda ()
@@ -1288,10 +1214,10 @@ void block_init(s7_scheme *sc)
(let ((len (length things)))
(do ((i 0 (+ i 1)))
((= i (- len 1)))
- (do ((j (+ i 1) (+ j 1)))
- ((= j len))
- (if (eq? (vector-ref things i) (vector-ref things j))
- (format-logged #t ";(eq? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j)))))))
+ (do ((j (+ i 1) (+ j 1)))
+ ((= j len))
+ (if (eq? (vector-ref things i) (vector-ref things j))
+ (format #t ";(eq? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j)))))))
;;; these are defined at user-level in s7 -- why are other schemes so coy about them?
(test (eq? (if #f #f) #<unspecified>) #t)
@@ -1374,6 +1300,17 @@ void block_init(s7_scheme *sc)
((= i 4) f)
(set! (f i) (+ (b i) 1.0)))))
(test (fv33) (block 2.0 3.0 4.0 5.0))
+
+ (define (fv34)
+ (let ((b (block 1 2 3 4))
+ (f (make-vector 4)))
+ (do ((k 0 (+ k 1)))
+ ((= k 1) f)
+ (do ((i 0 (+ i 1)))
+ ((= i 4))
+ (set! (f i) (b i))))))
+ (test (fv34) (vector 1.0 2.0 3.0 4.0))
+
)
(test (c-pointer? 0) #f)
@@ -1411,11 +1348,11 @@ void block_init(s7_scheme *sc)
(let ((x arg)
(y arg))
(if (not (eq? x x))
- (format-logged #t ";(eq? x x) of ~A -> #f?~%" x))
+ (format #t ";(eq? x x) of ~A -> #f?~%" x))
(if (not (eq? x arg))
- (format-logged #t ";(eq? x arg) of ~A ~A -> #f?~%" x arg))
+ (format #t ";(eq? x arg) of ~A ~A -> #f?~%" x arg))
(if (not (eq? x y))
- (format-logged #t ";(eq? x y) of ~A ~A -> #f?~%" x y))))
+ (format #t ";(eq? x y) of ~A ~A -> #f?~%" x y))))
;; actually I hear that #f is ok here for numbers
(list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3/4 #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined>))
@@ -1448,7 +1385,7 @@ void block_init(s7_scheme *sc)
(for-each
(lambda (arg)
(if (not ((lambda (p) (eq? p p)) arg))
- (format-logged #t "~A not eq? to itself?~%" arg)))
+ (format #t "~A not eq? to itself?~%" arg)))
(list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined> '(1 2 . 3)
(let ((lst (list 1 2)))
@@ -1549,8 +1486,6 @@ void block_init(s7_scheme *sc)
(test (eqv? 1+i 1+i) #t)
(test (eqv? -3.14 -3.14) #t)
(test (eqv? 1e2 1e2) #t)
-(test (eqv? #i3/5 #i3/5) #t)
-(test (eqv? #e0.6 #e0.6) #t)
(test (eqv? 1 1.0) #f)
(test (eqv? 1/2 0.5) #f)
(test (eqv? 1 1/1) #t)
@@ -1574,7 +1509,7 @@ void block_init(s7_scheme *sc)
(do ((j (+ i 1) (+ j 1)))
((= j len))
(if (eqv? (vector-ref things i) (vector-ref things j))
- (format-logged #t ";(eqv? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j)))))))
+ (format #t ";(eqv? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j)))))))
(test (eqv?) 'error)
(test (eqv? #t) 'error)
@@ -1617,12 +1552,12 @@ void block_init(s7_scheme *sc)
(eqv? (complex 1.0 +0.0)
(complex 1.0 -0.0)))
'(#t #t #t))
-(test (list (eq? +0.0 -0.0)
+(test (list ;(eq? +0.0 -0.0)
(eq? (complex +0.0 1.0)
(complex -0.0 1.0))
(eq? (complex 1.0 +0.0)
(complex 1.0 -0.0)))
- '(#t #f #f))
+ '(#f #f))
(test (list (eq? +0 -0)
(eq? (complex +0 1)
(complex -0 1))
@@ -1792,7 +1727,7 @@ void block_init(s7_scheme *sc)
(do ((j (+ i 1) (+ j 1)))
((= j len))
(if (equal? (vector-ref things i) (vector-ref things j))
- (format-logged #t ";(equal? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j)))))))
+ (format #t ";(equal? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j)))))))
(test (equal?) 'error)
(test (equal? #t) 'error)
@@ -2134,7 +2069,7 @@ void block_init(s7_scheme *sc)
(do ((j (+ i 1) (+ j 1)))
((= j len))
(if (morally-equal? (vector-ref things i) (vector-ref things j))
- (format-logged #t ";(morally-equal? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j)))))))
+ (format #t ";(morally-equal? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j)))))))
(test (morally-equal?) 'error)
(test (morally-equal? #t) 'error)
@@ -2695,26 +2630,26 @@ void block_init(s7_scheme *sc)
;;; ----------------
;;; try a bunch of combinations
-(define-expansion (format-logged-with-line port str . args)
- `(format-logged ,port ,str ,(port-line-number) , at args))
+(define-expansion (format-with-line port str . args)
+ `(format ,port ,str ,(port-line-number) , at args))
(let ((lst1 ())
(lst2 ()))
- (if (not (eq? lst1 lst2)) (format-logged-with-line #t ";~A: nils are not eq?~%"))
- (if (not (eqv? lst1 lst2)) (format-logged-with-line #t ";~A: nils are not eqv?~%"))
- (if (not (equal? lst1 lst2)) (format-logged-with-line #t ";~A: nils are not equal?~%"))
+ (if (not (eq? lst1 lst2)) (format-with-line #t ";~A: nils are not eq?~%"))
+ (if (not (eqv? lst1 lst2)) (format-with-line #t ";~A: nils are not eqv?~%"))
+ (if (not (equal? lst1 lst2)) (format-with-line #t ";~A: nils are not equal?~%"))
(let ((v1 (make-vector 100 #f))
(v2 (make-vector 100 #f)))
- (if (not (equal? v1 v2)) (format-logged-with-line #t ";~A: base vectors are not equal?~%"))
+ (if (not (equal? v1 v2)) (format-with-line #t ";~A: base vectors are not equal?~%"))
(let ((h1 (make-hash-table))
(h2 (make-hash-table)))
- (if (not (equal? h1 h2)) (format-logged-with-line #t ";~A: base hash-tables are not equal?~%"))
+ (if (not (equal? h1 h2)) (format-with-line #t ";~A: base hash-tables are not equal?~%"))
(let ((e1 (sublet (curlet)))
(e2 (sublet (curlet))))
- (if (not (equal? e1 e2)) (format-logged-with-line #t ";~A: base environments are not equal?~%"))
+ (if (not (equal? e1 e2)) (format-with-line #t ";~A: base environments are not equal?~%"))
(let ((ctr 0))
(for-each
@@ -2725,21 +2660,21 @@ void block_init(s7_scheme *sc)
(let ((a1 arg1)
(a2 arg2))
(if (not (eq? a1 arg1))
- (format-logged-with-line #t ";~A: ~A is not eq? to itself? ~A~%" arg1 a1))
+ (format-with-line #t ";~A: ~A is not eq? to itself? ~A~%" arg1 a1))
(if (and (eq? a1 a2) (not (eqv? a1 a2)))
- (format-logged-with-line #t ";~A: ~A is eq? but not eqv? ~A~%" a1 a2))
+ (format-with-line #t ";~A: ~A is eq? but not eqv? ~A~%" a1 a2))
(if (equal? a1 a2)
(begin
(if (and (eq? a1 a2) (not (eqv? a1 a2)))
- (format-logged-with-line #t ";~A: ~A is eq? and equal? but not eqv?? ~A~%" a1 a2))
+ (format-with-line #t ";~A: ~A is eq? and equal? but not eqv?? ~A~%" a1 a2))
(if (not (morally-equal? a1 a2))
- (format-logged-with-line #t ";~A: ~A is equal? but not morally-equal? ~A~%" a1 a2))
+ (format-with-line #t ";~A: ~A is equal? but not morally-equal? ~A~%" a1 a2))
(set! lst1 (cons a1 lst1))
(set! lst2 (cons a2 lst2))
(set! (v1 ctr) a1)
(set! (v2 ctr) a2)
- (let* ((sym1 (string->symbol (string-append "symbol-" (number->string ctr))))
+ (let* ((sym1 (symbol "symbol-" (number->string ctr)))
(sym2 (copy sym1)))
(set! (h1 sym1) a1)
(set! (h2 sym2) a2)
@@ -2748,29 +2683,29 @@ void block_init(s7_scheme *sc)
(if (not (equal? lst1 lst2))
(begin
- (format-logged-with-line #t ";~A: add ~A to lists, now not equal?~%" a1)
+ (format-with-line #t ";~A: add ~A to lists, now not equal?~%" a1)
(set! lst1 (cdr lst1))
(set! lst2 (cdr lst2))))
(if (not (equal? v1 v2))
(begin
- (format-logged-with-line #t ";~A: add ~A to vectors, now not equal?~%" a1)
+ (format-with-line #t ";~A: add ~A to vectors, now not equal?~%" a1)
(set! (v1 ctr) #f)
(set! (v2 ctr) #f)))
(if (not (equal? h1 h2))
(begin
- (format-logged-with-line #t ";~A: add ~A to hash-tables, now not equal?~%" a1)
+ (format-with-line #t ";~A: add ~A to hash-tables, now not equal?~%" a1)
(set! (h1 sym1) #f)
(set! (h2 sym2) #f)))
(if (not (equal? e1 e2))
(begin
- (format-logged-with-line #t ";~A: add ~A to environments, now not equal?~% ~A~% ~A~%" a1 e1 e2)
+ (format-with-line #t ";~A: add ~A to environments, now not equal?~% ~A~% ~A~%" a1 e1 e2)
(eval `(set! ,sym1 #f) e1)
(eval `(set! ,sym2 #f) e2)))
))
(begin
- (if (eq? a1 arg1) (format-logged-with-line #t ";~A: ~A is eq? but not equal? ~A~%" a1 a2))
- (if (eqv? a1 arg1) (format-logged-with-line #t ";~A: ~A is eqv? but not equal? ~A~%" a1 a2))
- (format-logged-with-line #t ";~A: ~A is not equal to ~A~%" a1 a2)))
+ (if (eq? a1 arg1) (format-with-line #t ";~A: ~A is eq? but not equal? ~A~%" a1 a2))
+ (if (eqv? a1 arg1) (format-with-line #t ";~A: ~A is eqv? but not equal? ~A~%" a1 a2))
+ (format-with-line #t ";~A: ~A is not equal to ~A~%" a1 a2)))
(set! ctr (+ ctr 1))))
@@ -2809,29 +2744,29 @@ void block_init(s7_scheme *sc)
(set! (v2 ctr) lst2)
(set! ctr (+ ctr 1))
(if (not (equal? v1 v2))
- (format-logged-with-line #t ";~A: add lists to vectors, now vectors not equal?~%")
+ (format-with-line #t ";~A: add lists to vectors, now vectors not equal?~%")
(begin
(set! lst1 (cons v1 lst1))
(set! lst2 (cons v2 lst2))
(if (not (equal? lst1 lst2))
(begin
- (format-logged-with-line #t ";~A: add vectors to lists, now lists not equal?~%")
+ (format-with-line #t ";~A: add vectors to lists, now lists not equal?~%")
(set! (h1 'lst1) lst1)
(set! (h2 'lst2) lst2)
(if (not (equal? h1 h2))
- (format-logged-with-line #t ";~A: add lists to hash-tables, not hash-tables not equal?~%")
+ (format-with-line #t ";~A: add lists to hash-tables, not hash-tables not equal?~%")
(begin
(set! (v1 ctr) v1)
(set! (v2 ctr) v2)
(set! ctr (+ ctr 1))
(if (not (equal? v1 v2))
- (format-logged-with-line #t ";~A: add vectors to themselves, now vectors not equal?~%"))
+ (format-with-line #t ";~A: add vectors to themselves, now vectors not equal?~%"))
(if (not (equal? lst1 lst2))
- (format-logged-with-line #t ";~A: add vectors to themselves, now lists not equal?~%"))
+ (format-with-line #t ";~A: add vectors to themselves, now lists not equal?~%"))
(set! (h1 'h1) h1)
(set! (h2 'h2) h2)
(if (not (equal? h1 h2))
- (format-logged-with-line #t ";~A: add hash-tables to themselves, not hash-tables not equal?~%"))
+ (format-with-line #t ";~A: add hash-tables to themselves, not hash-tables not equal?~%"))
)))))))))))
(define old-readers *#readers*)
@@ -2839,13 +2774,6 @@ void block_init(s7_scheme *sc)
(test (eval (with-input-from-string "(+ 10 #u12)" read)) 22)
(test (eval (with-input-from-string "(+ 10 #u87)" read)) 97)
-(do ((i (char->integer #\") (+ i 1)))
- ((= i 127))
- (when (not (member (integer->char i) '(#\( #\: #\|)))
- (set! *#readers* (cons (cons (integer->char i) (lambda (str) (string->number (substring str 1)))) ()))
- (let ((val (eval (with-input-from-string (string-append "(+ 10 #" (string (integer->char i)) "12)") read))))
- (if (not (equal? val 22)) (format *stderr* "~D (~C): ~A~%" i (integer->char i) val)))))
-
(set! *#readers*
(list (cons #\[
(lambda (str)
@@ -2872,6 +2800,38 @@ void block_init(s7_scheme *sc)
(test (let ((p (c-pointer 0))) (morally-equal? p (copy p))) #t)
+;;; --------------------------------------------------------------------------------
+;;; type-of
+
+(test (type-of) 'error)
+(test (type-of 1 2) 'error)
+(test (type-of #f) 'boolean?)
+(test (type-of ()) 'null?)
+(test (type-of (list 1)) 'pair?)
+(test (type-of 1) 'integer?)
+(test (type-of 1/2) 'rational?)
+(test (type-of 1.0) 'float?)
+(test (type-of 1+i) 'complex?)
+(test (type-of #<unspecified>) 'unspecified?)
+(test (type-of #<undefined>) 'undefined?)
+(test (type-of #<eof>) 'eof-object?)
+(test (type-of (hash-table)) 'hash-table?)
+(test (type-of #(1)) 'vector?)
+(test (type-of #r(1.0)) 'float-vector?)
+(test (type-of #i(1)) 'int-vector?)
+(test (type-of "") 'string?)
+(test (type-of #\a) 'char?)
+(test (type-of 'a) 'symbol?)
+(test (type-of :a) 'symbol?)
+(test (type-of (inlet 'a 1)) 'let?)
+(test (type-of *stderr*) 'output-port?)
+(test (type-of *stdin*) 'input-port?)
+(test (type-of abs) 'procedure?)
+(test (type-of +) 'procedure?)
+(test (type-of (c-pointer 0)) 'c-pointer?)
+(test (type-of (random-state 123)) 'random-state?)
+(test (type-of lambda) 'syntax?)
+
;;; --------------------------------------------------------------------------------
;;; boolean?
@@ -2898,7 +2858,7 @@ void block_init(s7_scheme *sc)
(for-each
(lambda (arg)
(if (boolean? arg)
- (format-logged #t ";(boolean? ~A) -> #t?~%" arg)))
+ (format #t ";(boolean? ~A) -> #t?~%" arg)))
(list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined>))
@@ -2937,7 +2897,7 @@ void block_init(s7_scheme *sc)
(for-each
(lambda (arg)
(if (not arg)
- (format-logged #t ";(not ~A) -> #t?~%" arg)))
+ (format #t ";(not ~A) -> #t?~%" arg)))
(list "hi" (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi #<eof> #<undefined> (if #f #f)))
@@ -2966,14 +2926,6 @@ void block_init(s7_scheme *sc)
(define (f15 lst) (memq (car lst) '(a b c))) (test (f15 '(a)) '(a b c)) (test (f15 '(d)) #f)
(define (f16 a b) (if a (begin (+ b a) (format #f "~A" a) (+ a a)))) (test (f16 1 2) 2)
(define (f17 a) (aritable? a 1)) (test (f17 abs) #t)
- (define (f18) (set! (-s7-symbol-table-locked?) #f)) (f18) (test (f18) #f)
- (define (f18a) (set! (-s7-symbol-table-locked?) #f)) (test (f18a) #f) (test (let () (f18a)) #f)
- (define (f19) (set! (-s7-symbol-table-locked?) #f) 1) (f19) (test (f19) 1)
- (define (f19a) (set! (-s7-symbol-table-locked?) #f) 1) (test (f19a) 1) (test (let () (f19a)) 1)
- (define (f20) (set! (-s7-symbol-table-locked?) #f) (+ 1 2)) (f20) (test (f20) 3)
- (define (f20a) (set! (-s7-symbol-table-locked?) #f) (+ 1 2)) (test (f20a) 3) (test (let () (f20a)) 3)
- (define (f21) (set! (-s7-symbol-table-locked?) #f) (+ 1 2) 4) (f21) (test (f21) 4)
- (define (f21a) (set! (-s7-symbol-table-locked?) #f) (+ 1 2) 4) (test (f21a) 4) (test (let () (f21a)) 4)
(define (f22) (begin (display ":") (display (object->string 2)) (display ":"))) (test (with-output-to-string (lambda () (f22))) ":2:")
(define (f23 a b) (list a b))
(define (f24 x y) (f23 (car x) (car y)))
@@ -3066,7 +3018,7 @@ void block_init(s7_scheme *sc)
(for-each
(lambda (arg)
(if (symbol? arg)
- (format-logged #t ";(symbol? ~A) -> #t?~%" arg)))
+ (format #t ";(symbol? ~A) -> #t?~%" arg)))
(list "hi" (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined>))
@@ -3110,6 +3062,32 @@ void block_init(s7_scheme *sc)
#t)
+;;; syntax?
+(test (syntax? 'lambda) #f)
+(test (syntax? lambda) #t)
+(test (syntax? if) #t)
+(test (syntax? macroexpand) #t)
+(test (syntax? 1) #f)
+(for-each
+ (lambda (arg)
+ (if (syntax? arg)
+ (format #t ";(syntax? ~A) -> #t?~%" arg)))
+ (list "hi" (integer->char 65) (list 1 2) '#t '3 (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined>))
+(test (syntax?) 'error)
+(test (syntax? 'hi 'ho) 'error)
+(test (syntax? 'hi 3) 'error)
+(test (syntax? 3 3) 'error)
+(test (syntax? 3 'hi) 'error)
+(test (syntax? 'else) #f)
+(test (syntax? '=>) #f)
+(test (syntax? else) #f)
+(let ()
+ (define (syntactic x)
+ (if x (case x ((1) 1) (else 2))))
+ (syntactic 1)
+ (let ((source (procedure-source syntactic)))
+ (test (syntax? (car source)) #f))) ; 'lambda from (lambda (x) (if x (case x ((1) 1) (else 2))))
;;; --------------------------------------------------------------------------------
@@ -3144,8 +3122,8 @@ void block_init(s7_scheme *sc)
(for-each
(lambda (arg)
(if (procedure? arg)
- (format-logged #t ";(procedure? ~A) -> #t?~%" arg)))
- (list "hi" _ht_ _null_ _c_obj_ :hi (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f #() (if #f #f)))
+ (format #t ";(procedure? ~A) -> #t?~%" arg)))
+ (list "hi" _ht_ _null_ :hi (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f #() (if #f #f)))
(test (procedure?) 'error)
(test (procedure? abs car) 'error)
@@ -3188,7 +3166,6 @@ void block_init(s7_scheme *sc)
(test (char? #\-) #t)
(test (char? #\n) #t)
(test (char? #\() #t)
-(test (char? #e1) #f)
(test (char? #\#) #t)
(test (char? #\x) #t)
(test (char? #\o) #t)
@@ -3211,7 +3188,7 @@ void block_init(s7_scheme *sc)
(for-each
(lambda (arg)
(if (char? arg)
- (format-logged #t ";(char? ~A) -> #t?~%" arg)))
+ (format #t ";(char? ~A) -> #t?~%" arg)))
(list "hi" () (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 #f #t (if #f #f) :hi (lambda (a) (+ a 1))))
@@ -3220,7 +3197,7 @@ void block_init(s7_scheme *sc)
(do ((i 0 (+ i 1)))
((= i 256))
(if (not (char? (integer->char i)))
- (format-logged #t ";(char? (integer->char ~A)) -> #f?~%" i)))
+ (format #t ";(char? (integer->char ~A)) -> #f?~%" i)))
(test (char?) 'error)
(test (char? #\a #\b) 'error)
@@ -3250,14 +3227,10 @@ void block_init(s7_scheme *sc)
(test (eval-string "(char? #\\x6#)") 'error)
(test (eval-string "(char? #\\x#b0)") 'error)
(test (eval-string "(char? #\\x#b0") 'error)
-(test (eval-string "(char? #\\x#e0.0") 'error)
(test (eval-string "(char? #\\x-0") 'error)
-(test (eval-string "(char? #\\x#e0e100") 'error)
(test (eval-string "(char? #\\x1.4)") 'error)
(test (eval-string "(char? #\\x#b0)") 'error)
-(test (eval-string "(char? #\\x#e0.0)") 'error)
(test (eval-string "(char? #\\x-0)") 'error)
-(test (eval-string "(char? #\\x#e0e100)") 'error)
(test (eval-string "(char? #\\x1.4)") 'error)
(test (char=? #\x6a #\j) #t)
@@ -3306,13 +3279,13 @@ void block_init(s7_scheme *sc)
(for-each
(lambda (arg)
(if (not (char-upper-case? arg))
- (format-logged #t ";(char-upper-case? ~A) -> #f?~%" arg)))
+ (format #t ";(char-upper-case? ~A) -> #f?~%" arg)))
cap-a-to-z)
(for-each
(lambda (arg)
(if (char-upper-case? arg)
- (format-logged #t ";(char-upper-case? ~A) -> #t?~%" arg)))
+ (format #t ";(char-upper-case? ~A) -> #t?~%" arg)))
a-to-z)
(test (char-upper-case? (integer->char 192)) #t) ; 192..208 for unicode
@@ -3336,13 +3309,13 @@ void block_init(s7_scheme *sc)
(for-each
(lambda (arg)
(if (not (char-lower-case? arg))
- (format-logged #t ";(char-lower-case? ~A) -> #f?~%" arg)))
+ (format #t ";(char-lower-case? ~A) -> #f?~%" arg)))
a-to-z)
(for-each
(lambda (arg)
(if (char-lower-case? arg)
- (format-logged #t ";(char-lower-case? ~A) -> #t?~%" arg)))
+ (format #t ";(char-lower-case? ~A) -> #t?~%" arg)))
cap-a-to-z)
(test (char-lower-case? 1) 'error)
@@ -3389,7 +3362,7 @@ void block_init(s7_scheme *sc)
(for-each
(lambda (arg1 arg2)
(if (not (char=? (char-upcase arg1) arg2))
- (format-logged #t ";(char-upcase ~A) != ~A?~%" arg1 arg2)))
+ (format #t ";(char-upcase ~A) != ~A?~%" arg1 arg2)))
a-to-z
cap-a-to-z)
@@ -3397,7 +3370,7 @@ void block_init(s7_scheme *sc)
((= i 256))
(if (and (not (char=? (integer->char i) (char-upcase (integer->char i))))
(not (char-alphabetic? (integer->char i))))
- (format-logged #t ";(char-upcase ~A) -> ~A but not alphabetic?~%" (integer->char i) (char-upcase (integer->char i)))))
+ (format #t ";(char-upcase ~A) -> ~A but not alphabetic?~%" (integer->char i) (char-upcase (integer->char i)))))
(test (recompose 12 char-upcase #\a) #\A)
(test (reinvert 12 char-upcase char-downcase #\a) #\a)
@@ -3429,7 +3402,7 @@ void block_init(s7_scheme *sc)
(for-each
(lambda (arg1 arg2)
(if (not (char=? (char-downcase arg1) arg2))
- (format-logged #t ";(char-downcase ~A) != ~A?~%" arg1 arg2)))
+ (format #t ";(char-downcase ~A) != ~A?~%" arg1 arg2)))
cap-a-to-z
a-to-z)
@@ -3461,13 +3434,13 @@ void block_init(s7_scheme *sc)
(for-each
(lambda (arg)
(if (char-numeric? arg)
- (format-logged #t ";(char-numeric? ~A) -> #t?~%" arg)))
+ (format #t ";(char-numeric? ~A) -> #t?~%" arg)))
cap-a-to-z)
(for-each
(lambda (arg)
(if (char-numeric? arg)
- (format-logged #t ";(char-numeric? ~A) -> #t?~%" arg)))
+ (format #t ";(char-numeric? ~A) -> #t?~%" arg)))
a-to-z)
(test (char-numeric?) 'error)
@@ -3509,13 +3482,13 @@ void block_init(s7_scheme *sc)
(for-each
(lambda (arg)
(if (char-whitespace? arg)
- (format-logged #t ";(char-whitespace? ~A) -> #t?~%" arg)))
+ (format #t ";(char-whitespace? ~A) -> #t?~%" arg)))
mixed-a-to-z)
(for-each
(lambda (arg)
(if (char-whitespace? arg)
- (format-logged #t ";(char-whitespace? ~A) -> #t?~%" arg)))
+ (format #t ";(char-whitespace? ~A) -> #t?~%" arg)))
digits)
(test (char-whitespace?) 'error)
@@ -3546,13 +3519,13 @@ void block_init(s7_scheme *sc)
(for-each
(lambda (arg)
(if (char-alphabetic? arg)
- (format-logged #t ";(char-alphabetic? ~A) -> #t?~%" arg)))
+ (format #t ";(char-alphabetic? ~A) -> #t?~%" arg)))
digits)
(for-each
(lambda (arg)
(if (not (char-alphabetic? arg))
- (format-logged #t ";(char-alphabetic? ~A) -> #f?~%" arg)))
+ (format #t ";(char-alphabetic? ~A) -> #f?~%" arg)))
mixed-a-to-z)
(test (char-alphabetic?) 'error)
@@ -3579,11 +3552,11 @@ void block_init(s7_scheme *sc)
(if (and (not (char=? ch chu))
(not (char-upper-case? chu)))
- (format-logged #t ";(char-upper-case? (char-upcase ~C)) is #f~%" ch))
+ (format #t ";(char-upper-case? (char-upcase ~C)) is #f~%" ch))
(if (and (not (char=? ch chd))
(not (char-lower-case? chd)))
- (format-logged #t ";(char-lower-case? (char-downcase ~C)) is #f~%" ch))
+ (format #t ";(char-lower-case? (char-downcase ~C)) is #f~%" ch))
(if (or (and (not (char=? ch chu))
(not (char=? ch (char-downcase chu))))
@@ -3860,7 +3833,7 @@ void block_init(s7_scheme *sc)
(for-each
(lambda (op1 op2)
(if (not (eq? (op1 c1 c2) (op2 (string c1) (string c2))))
- (format-logged #t ";(~A|~A ~A ~A) -> ~A|~A~%" op1 op2 c1 c2 (op1 c1 c2) (op2 (string c1) (string c2)))))
+ (format #t ";(~A|~A ~A ~A) -> ~A|~A~%" op1 op2 c1 c2 (op1 c1 c2) (op2 (string c1) (string c2)))))
(list char=? char<? char<=? char>? char>=? char-ci=? char-ci<? char-ci<=? char-ci>? char-ci>=?)
(list string=? string<? string<=? string>? string>=? string-ci=? string-ci<? string-ci<=? string-ci>? string-ci>=?)))))
|#
@@ -3996,7 +3969,7 @@ void block_init(s7_scheme *sc)
(do ((i 0 (+ i 1)))
((= i 256))
(if (not (= (char->integer (integer->char i)) i))
- (format-logged #t ";char->integer ~D ~A != ~A~%" i (integer->char i) (char->integer (integer->char i)))))
+ (format #t ";char->integer ~D ~A != ~A~%" i (integer->char i) (char->integer (integer->char i)))))
(test (reinvert 12 integer->char char->integer 60) 60)
@@ -4402,13 +4375,13 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (str2 k) (char-upcase (str1 k)))
(set! (str2 k) (char-downcase (str1 k)))))
(if (not (string-ci=? str1 str2))
- (format-logged #t "not =: ~S ~S~%" str1 str2))
+ (format #t "not =: ~S ~S~%" str1 str2))
(if (and (string-ci<? str1 str2)
(string-ci>=? str1 str2))
- (format-logged #t "< : ~S ~S~%" str1 str2))
+ (format #t "< : ~S ~S~%" str1 str2))
(if (and (string-ci>? str1 str2)
(string-ci<=? str1 str2))
- (format-logged #t "> : ~S ~S~%" str1 str2))))))
+ (format #t "> : ~S ~S~%" str1 str2))))))
@@ -5331,7 +5304,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(newstrlen (length newstr)))
(if (or (not (= lstlen strlen newstrlen))
(not (string=? newstr str)))
- (format-logged #t ";string->list->string: ~S -> ~A -> ~S~%" str lst newstr))))))))
+ (format #t ";string->list->string: ~S -> ~A -> ~S~%" str lst newstr))))))))
(when full-test
(let ()
@@ -5519,7 +5492,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((replacement (cond ((string=? substr "gt") ">")
((string=? substr "lt") "<")
((string=? substr "mdash") "-")
- (else (format-logged #t "unknown: ~A~%" substr)))))
+ (else (format #t "unknown: ~A~%" substr)))))
(string-append replacement
(fixit (substring str (+ epos 1)))))))))))
(test (fixit "(let ((f (hz->radians 100)) (g (hz->radians 200))) (< f g))")
@@ -5664,11 +5637,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (str 7) (integer->char i))
(set! (str 13) (integer->char i))
(let ((val (eval-string str)))
- #t)) ;(format-logged #t "ok: ~S -> ~S~%" str val)))
+ #t)) ;(format #t "ok: ~S -> ~S~%" str val)))
(lambda args
- (format-logged #t "bad but symbol: ~S~%" str))))) ; 11 12 # ' , .
+ (format #t "bad but symbol: ~S~%" str))))) ; 11 12 # ' , .
(lambda args
- (format-logged #t "bad: ~C~%" (integer->char i)))))) ; # ( ) ' " . ` nul 9 10 13 space 0..9 ;
+ (format #t "bad: ~C~%" (integer->char i)))))) ; # ( ) ' " . ` nul 9 10 13 space 0..9 ;
(let ((str "(let ((XY 3)) XY)"))
(do ((i 0 (+ i 1)))
@@ -5685,11 +5658,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (str 14) (integer->char i))
(set! (str 15) (integer->char k))
(let ((val (eval-string str)))
- #t)) ;(format-logged #t "ok: ~S -> ~S~%" str val)))
+ #t)) ;(format #t "ok: ~S -> ~S~%" str val)))
(lambda args
- (format-logged #t "bad but symbol: ~S~%" str))))) ; 11 12 # ' , .
+ (format #t "bad but symbol: ~S~%" str))))) ; 11 12 # ' , .
(lambda args
- (format-logged #t "bad: ~C~%" (integer->char i))))))) ; # ( ) ' " . ` nul 9 10 13 space 0..9 ;
+ (format #t "bad: ~C~%" (integer->char i))))))) ; # ( ) ' " . ` nul 9 10 13 space 0..9 ;
|#
@@ -5836,7 +5809,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(complicated-dynamic-binding)
(test (reverse bindings) '(1 2 1 3 4)))
-
+;;; (define (func x) (call-with-output-file "/dev/null" (symbol->dynamic-value __func__)))
+;;; gets either stack overflow or error: open-output-file: Too many open files "/dev/null"
+;;; because (symbol->dynamic-value __func__) is the calling function (func) so we have
+;;; an infinite recursion.
;;; --------------------------------------------------------------------------------
@@ -5896,7 +5872,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
;; should (vector? #u8(1 2)) be #t?
(test (format #f "~{~A ~}" (byte-vector 255 0)) "255 0 ")
-;;; string->byte-vector
+;;; string->byte-vector -- why is this needed? -- why not use copy instead?
(test (byte-vector? (string->byte-vector (string #\0))) #t)
(test (byte-vector? (string->byte-vector "")) #t)
(test (byte-vector? (string->byte-vector "1230")) #t)
@@ -5915,6 +5891,9 @@ zzy" (lambda (p) (eval (read p))))) 32)
;;; an experiment:
(test (string->byte-vector #x010203) #u8(3 2 1 0 0 0 0 0))
+(test (let ((str "123")) (string->byte-vector str) (byte-vector? str)) #t) ;??
+(test (let ((str (string #\a))) (string->byte-vector str) (byte-vector? str)) #t) ;??
+
;;; make-byte-vector
(test (equal? (make-byte-vector 0) #u8()) #t)
(test (equal? (make-byte-vector 0 32) #u8()) #t)
@@ -5964,6 +5943,52 @@ zzy" (lambda (p) (eval (read p))))) 32)
(copy bv bv1 1 3)
(test bv1 #u8(255 255 1 1)))) ; copy and fill do not interpret their indices in the same way (one is source, the other destination)
+(test (equal? (byte-vector (char->integer #\a)) (string #\a)) #t) ;??
+(test (morally-equal? (byte-vector (char->integer #\a)) (string #\a)) #t) ;?
+
+(test (byte-vector? (copy "12")) #f)
+(test (byte-vector? (copy #u8(0))) #t)
+(test (byte-vector? (reverse (byte-vector 0 1))) #t)
+(test (let ((v (byte-vector 0))) (fill! v #\a)) 'error)
+(test (let ((v (byte-vector 0))) (fill! v 1) v) #u8(1))
+(test (byte-vector? (append #u8(0 1) (byte-vector 2 3))) #t)
+
+;;; should string->byte-vector insist on string (not bv) arg? similarly for string-ref et al?
+
+;;; byte-vector-ref
+;;; byte-vector-set!
+
+(test (let ((str "123")) (byte-vector-ref str 0)) 'error)
+(test (let ((str "123")) (byte-vector-set! str 0 1)) 'error)
+(test (let ((str "123")) (byte-vector-set! str 0 #\1)) 'error)
+(test (let ((str (byte-vector 0 1 2))) (byte-vector-ref str 0)) 0)
+(test (let ((str (byte-vector 0 1 2))) (char? (byte-vector-ref str 0))) #f)
+(test (let ((str (byte-vector 0 1 2))) (byte-vector-set! str 0 1)) 1)
+(test (let ((str (byte-vector 0 1 2))) (byte-vector-set! str 0 #\1)) 'error)
+(test (byte-vector-ref #u8(0 1 2)) 'error)
+(test (byte-vector-ref) 'error)
+(test (byte-vector-ref #u8(0 1 2) 1 1) 'error)
+(test (byte-vector-ref #u8(0 1 2) -1) 'error)
+(test (byte-vector-set! #u8(0 1 2)) 'error)
+(test (byte-vector-set! #u8(0 1 2) 0) 'error)
+(test (byte-vector-set!) 'error)
+(test (byte-vector-set! #u8(0 1 2) 1 1 2) 'error)
+(test (byte-vector-set! #u8(0 1 2) -1 1) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (byte-vector-ref arg 0) 'error)
+ (test (byte-vector-set! arg 0 0) 'error)
+ (test (byte-vector-ref #u8(0 1 2) arg) 'error)
+ (test (byte-vector-set! #u8(0 1 2) arg 0) 'error)
+ (test (byte-vector-set! #u8(0 1 2) 0 arg) 'error)
+ (test (let ((v #u8(0 1 2))) (v arg)) 'error)
+ (test (let ((v #u8(0 1 2))) (set! (v arg) 0)) 'error))
+ (list #\a () (list 1) "str" "" '(1 . 2) #f (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1))))
+
+(test (let ((v #u8(0 1 2))) (v 1)) 1)
+(test (let ((v (byte-vector 0 1 2))) (set! (v 1) 3) v) #u8(0 3 2))
@@ -6038,7 +6063,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(if (not (equal? (car (cons arg ())) arg))
- (format-logged #t ";(car '(~A)) returned ~A?~%" arg (car (cons arg ()))))
+ (format #t ";(car '(~A)) returned ~A?~%" arg (car (cons arg ()))))
(test (car arg) 'error))
(list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0)
3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
@@ -6076,7 +6101,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(if (not (equal? (cdr (cons () arg)) arg))
- (format-logged #t ";(cdr '(() ~A) -> ~A?~%" arg (cdr (cons () arg))))
+ (format #t ";(cdr '(() ~A) -> ~A?~%" arg (cdr (cons () arg))))
(test (cdr arg) 'error))
(list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0)
3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
@@ -6163,7 +6188,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((val1 (catch #t (lambda () (op1 lst)) (lambda args 'error)))
(val2 (catch #t (lambda () (op2 lst)) (lambda args 'error))))
(if (not (equal? val1 val2))
- (format-logged #t ";(~A ~S) -> ~S, (~A-1): ~S?~%" name lst val1 name val2))))
+ (format #t ";(~A ~S) -> ~S, (~A-1): ~S?~%" name lst val1 name val2))))
lists))
(list 'caar 'cadr 'cdar 'cddr 'caaar 'caadr 'cadar 'cdaar 'caddr 'cdddr 'cdadr 'cddar
'caaaar 'caaadr 'caadar 'cadaar 'caaddr 'cadddr 'cadadr 'caddar 'cdaaar
@@ -6643,14 +6668,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (lst)
(if (proper-list? lst)
(if (not (equal? lst (reverse (reverse lst))))
- (format-logged #t ";(reverse (reverse ~A)) -> ~A?~%" lst (reverse (reverse lst))))))
+ (format #t ";(reverse (reverse ~A)) -> ~A?~%" lst (reverse (reverse lst))))))
lists)
(for-each
(lambda (lst)
(if (proper-list? lst)
(if (not (equal? lst (reverse (reverse (reverse (reverse lst))))))
- (format-logged #t ";(reverse...(4x) ~A) -> ~A?~%" lst (reverse (reverse (reverse (reverse lst))))))))
+ (format #t ";(reverse...(4x) ~A) -> ~A?~%" lst (reverse (reverse (reverse (reverse lst))))))))
lists)
(test (let ((x (list 1 2 3))) (list (recompose 32 reverse x) x)) '((1 2 3) (1 2 3)))
@@ -7080,7 +7105,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(if (pair? arg)
- (format-logged #t ";(pair? ~A) -> #t?~%" arg)))
+ (format #t ";(pair? ~A) -> #t?~%" arg)))
(list "hi" (integer->char 65) #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 #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
@@ -7149,7 +7174,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(if (list? arg)
- (format-logged #t ";(list? ~A) -> #t?~%" arg)))
+ (format #t ";(list? ~A) -> #t?~%" arg)))
(list "hi" (integer->char 65) #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 #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
@@ -7192,7 +7217,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(if (proper-list? arg)
- (format-logged #t ";(list? ~A) -> #t?~%" arg)))
+ (format #t ";(list? ~A) -> #t?~%" arg)))
(list "hi" (integer->char 65) #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 #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
@@ -7242,7 +7267,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(if (null? arg)
- (format-logged #t ";(null? ~A) -> #t?~%" arg)))
+ (format #t ";(null? ~A) -> #t?~%" arg)))
(list "hi" (integer->char 65) #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 #\f #t (if #f #f) :hi #<eof> #<undefined> (values) (lambda (a) (+ a 1))))
@@ -7359,7 +7384,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((val1 (catch #t (lambda () (op1 lst)) (lambda args 'error)))
(val2 (catch #t (lambda () (op2 lst)) (lambda args 'error))))
(if (not (equal? val1 val2))
- (format-logged #t ";(~A ~A) -> ~A ~A?~%" name lst val1 val2))))
+ (format #t ";(~A ~A) -> ~A ~A?~%" name lst val1 val2))))
lists))
(list 'list-ref:0 'list-ref:1 'list-ref:2 'list-ref:3)
(list car cadr caddr cadddr)
@@ -7691,7 +7716,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((val1 (catch #t (lambda () (op1 lst)) (lambda args 'error)))
(val2 (catch #t (lambda () (op2 lst)) (lambda args 'error))))
(if (not (equal? val1 val2))
- (format-logged #t ";(~A ~A) -> ~A ~A?~%" name lst val1 val2))))
+ (format #t ";(~A ~A) -> ~A ~A?~%" name lst val1 val2))))
lists))
(list 'list-tail:0 'list-tail:1 'list-tail:2 'list-tail:3 'list-tail:4)
(list (lambda (l) l) cdr cddr cdddr cddddr)
@@ -8410,7 +8435,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (arg)
(let ((result (catch #t (lambda () (op arg)) (lambda args 'error))))
(if (not (eq? result 'error))
- (format-logged #t ";(~A ~A) returned ~A?~%" op arg result))
+ (format #t ";(~A ~A) returned ~A?~%" op arg result))
(test (op arg () arg) 'error)
(test (op arg) 'error)))
(list () "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
@@ -8432,7 +8457,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (arg)
(let ((result (catch #t (lambda () (op #f arg)) (lambda args 'error))))
(if (not (eq? result 'error))
- (format-logged #t ";(~A #f ~A) returned ~A?~%" op arg result))))
+ (format #t ";(~A #f ~A) returned ~A?~%" op arg result))))
(list "hi" (integer->char 65) #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 #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
(list assq assv assoc memq memv member))
@@ -8844,6 +8869,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (make-shared-vector (make-shared-vector (float-vector 1.0 2.0 3.0 4.0) '(2 2)) '(1)) (float-vector 1.0))
(test ((make-shared-vector (make-shared-vector (float-vector 1.0 2.0 3.0 4.0) '(2 2)) '(4 1)) 2 0) 3.0)
+(let-temporarily (((*s7* 'print-length) 123123123))
+ (test (object->string (make-vector 2048 #f)) "(make-vector 2048 #f)")
+ (test (object->string (make-vector '(12 2048) #<unspecified>)) "(make-vector '(12 2048) #<unspecified>)")
+ (test (object->string (make-float-vector 2048 1.0)) "(make-float-vector 2048 1)")
+ (test (object->string (make-int-vector 2048 32)) "(make-int-vector 2048 32)")
+ (test (object->string (make-int-vector '(12 2048) 2)) "(make-int-vector '(12 2048) 2)")
+ (test (object->string (make-string 20000)) "(make-string 20000 #\\space)")
+ (test (object->string (make-byte-vector 2000 12)) "(make-byte-vector 2000 12)"))
(when with-bignums
(let ((v (float-vector (bignum "1.0") (bignum "2.0"))))
@@ -8887,6 +8920,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (equal? (vector) (float-vector)) #t)
(test (float-vector? (make-float-vector 3 0)) #t)
(test (float-vector? (make-float-vector 3 1/2)) #t)
+(test (float-vector? #r(1.0)) #t)
;;; make-int-vector
@@ -8897,6 +8931,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (int-vector? (make-int-vector 0)) #t)
(test (int-vector? (float-vector)) #f)
(test (int-vector? (vector)) #f)
+(test (int-vector? #i(1)) #t)
(test (equal? (make-int-vector 3 1) (int-vector 1 1 1)) #t)
(test ((make-int-vector '(2 3) 2) 1 2) 2)
@@ -8947,6 +8982,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (v 1 1) 2.0)
(test (v 0 1) 1.0)
(test (float-vector-ref v 1 1) 2.0)
+ (test (float-vector-ref #r2d((1 2) (3 4)) 1 1) 4.0)
(test (float-vector-ref v 0) (float-vector 1.0 1.0 1.0))
(test (float-vector-set! v 0 0 3.0) 3.0)
(test (float-vector-ref v 0 0) 3.0)
@@ -8976,7 +9012,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (float-vector-ref v1 -1) 'error)
(float-vector-set! v1 0 2/5)
(test (float-vector-ref v1 0) 0.4)
- (test (float-vector-set! v1 1 4) 4)
+ (test (float-vector-set! v1 1 4.0) 4.0)
(test (float-vector-ref v1 1) 4.0)
(test (float-vector-ref v 3 0) 'error)
(test (float-vector-ref v 1 3) 'error)
@@ -9065,6 +9101,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (v 1 1) 2)
(test (v 0 1) 1)
(test (int-vector-ref v 1 1) 2)
+ (test (int-vector-ref #i2d((1 2) (3 4)) 1 1) 4)
(test (int-vector-ref v 0) (int-vector 1 1 1))
(test (int-vector-set! v 0 0 3) 3)
(test (int-vector-ref v 0 0) 3)
@@ -9157,6 +9194,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (x 0) (complex 1 2))))
(test (f4) 'error))
+(when with-bignums
+ (test (int-vector 1 (bignum "2")) #i(1 2))
+ (test (float-vector 1.0 (bignum "2.0")) #r(1.0 2.0)))
+
;;; --------------------------------------------------------------------------------
;;; vector
@@ -9182,7 +9223,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (vector-ref (vector arg) 0) arg))
(list #\a 1 () (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0)
3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
-
+(test (vector 1 . 2) 'error)
+(test (apply vector (cons 1 2)) 'error)
@@ -9195,6 +9237,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (vector->list #(a b c)) '(a b c))
(test (vector->list #(#(0) #(1))) '(#(0) #(1)))
(test (vector? (list-ref (let ((v (vector 1 2))) (vector-set! v 1 v) (vector->list v)) 1)) #t)
+(test (vector->list #i(1 2)) '(1 2))
(test (list->vector ()) #())
(test (list->vector '(a b c)) #(a b c))
@@ -9298,6 +9341,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (vector-length (make-int-vector 3 0)) 3)
(if (not with-bignums) (test (vector-length (make-float-vector 3 pi)) 3))
(if (not with-bignums) (test (vector-length (make-float-vector '(2 3) pi)) 6))
+(test (vector-length #r(1 2)) 2)
(test (vector-length) 'error)
(test (vector-length #(1) #(2)) 'error)
@@ -9708,6 +9752,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((v (make-vector 3 0))) (vector-fill! v 32) (v 1)) 32)
(test (let ((v (make-vector 3 0))) (fill! v 32) (v 1)) 32)
(test (let ((v #2d((1 2 3) (4 5 6)))) (vector-fill! (v 1) 12) v) #2D((1 2 3) (12 12 12)))
+(test (let ((v #i(1 2))) (fill! v 3) v) #i(3 3))
(for-each
(lambda (arg)
@@ -9805,12 +9850,13 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (vector->list (vector-append (make-int-vector 1 3) (make-int-vector 2 1))) '(3 1 1))
(test (vector->list (vector-append (make-float-vector 1 0.0) (make-float-vector 2 1.0))) '(0.0 1.0 1.0))
-(for-each
- (lambda (arg)
- (test (vector-append arg) 'error)
- (test (vector-append #(1 2) arg) 'error))
- (list "hi" #\a () 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol 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))))
+(unless pure-s7
+ (for-each
+ (lambda (arg)
+ (test (vector-append arg) 'error)
+ (test (vector-append #(1 2) arg) 'error))
+ (list "hi" #\a () 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol 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)))))
(test (equal? (make-vector 3 1) (make-int-vector 3 1)) #f)
@@ -9948,7 +9994,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(do ((i 0 (+ i 1)))
((= i (length v)))
(if (not (= (correct i) (inexact->exact (v i))))
- (format-logged #t ";for-each call/cc data: ~A~%" v))))))
+ (format #t ";for-each call/cc data: ~A~%" v))))))
(list (make-vector 10)
(make-list 10)))
@@ -10068,21 +10114,20 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((str (object->string vect1t)))
(test str (case i
- ((1) "(make-shared-vector (int-vector 1 ...) '(2 2 3))")
- ((2) "(make-shared-vector (int-vector 1 2 ...) '(2 2 3))")
- ((3) "(make-shared-vector (int-vector 1 2 3 ...) '(2 2 3))")
- ((4) "(make-shared-vector (int-vector 1 2 3 3 ...) '(2 2 3))")
- ((5) "(make-shared-vector (int-vector 1 2 3 3 4 ...) '(2 2 3))")
- ((6) "(make-shared-vector (int-vector 1 2 3 3 4 5 ...) '(2 2 3))")
- ((7) "(make-shared-vector (int-vector 1 2 3 3 4 5 5 ...) '(2 2 3))")
- ((8) "(make-shared-vector (int-vector 1 2 3 3 4 5 5 6 ...) '(2 2 3))")
- ((9) "(make-shared-vector (int-vector 1 2 3 3 4 5 5 6 1 ...) '(2 2 3))")
- ((10) "(make-shared-vector (int-vector 1 2 3 3 4 5 5 6 1 7 ...) '(2 2 3))")
- ((11) "(make-shared-vector (int-vector 1 2 3 3 4 5 5 6 1 7 8 ...) '(2 2 3))")
- ((12) "(make-shared-vector (int-vector 1 2 3 3 4 5 5 6 1 7 8 2) '(2 2 3))")
- ((13) "(make-shared-vector (int-vector 1 2 3 3 4 5 5 6 1 7 8 2) '(2 2 3))")
- ((14) "(make-shared-vector (int-vector 1 2 3 3 4 5 5 6 1 7 8 2) '(2 2 3))"))))
-
+ ((1) "#i3D(((1 ...)...)...)")
+ ((2) "#i3D(((1 2 ...)...)...)")
+ ((3) "#i3D(((1 2 3)...)...)")
+ ((4) "#i3D(((1 2 3) (3 ...))...)")
+ ((5) "#i3D(((1 2 3) (3 4 ...))...)")
+ ((6) "#i3D(((1 2 3) (3 4 5))...)")
+ ((7) "#i3D(((1 2 3) (3 4 5)) ((5 ...)...))")
+ ((8) "#i3D(((1 2 3) (3 4 5)) ((5 6 ...)...))")
+ ((9) "#i3D(((1 2 3) (3 4 5)) ((5 6 1)...))")
+ ((10) "#i3D(((1 2 3) (3 4 5)) ((5 6 1) (7 ...)))")
+ ((11) "#i3D(((1 2 3) (3 4 5)) ((5 6 1) (7 8 ...)))")
+ ((12) "#i3D(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))")
+ ((13) "#i3D(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))")
+ ((14) "#i3D(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))"))))
(let ((str (object->string vect4)))
(test str (case i
@@ -10148,7 +10193,6 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (*s7* 'print-length) i)
(let ((str (object->string vect5)))
(test str (case i
-
((1) "#2D((#3D(((1 ...)...)...) ...)...)")
((2) "#2D((#3D(((1 2 ...)...)...) #2D((1 2 ...)...) ...)...)")
((3) "#2D((#3D(((1 2 3)...)...) #2D((1 2 3 ...)...) #(1 2 3 ...))...)")
@@ -10164,7 +10208,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
((13) "#2D((#3D(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))) #2D((1 2 3 4 5 6) (7 8 9 10 11 12)) #(1 2 3 4 5 6 7 8 9 10 11 12 13 ...)) (#3D(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12))) #(1 2 3) #2D()))")
((14) "#2D((#3D(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))) #2D((1 2 3 4 5 6) (7 8 9 10 11 12)) #(1 2 3 4 5 6 7 8 9 10 11 12 13 14)) (#3D(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12))) #(1 2 3) #2D()))"))))))))
-(test (object->string (make-int-vector 3 0)) "(int-vector 0 0 0)")
+(test (object->string (make-int-vector 3 0)) "#i(0 0 0)")
(let ((v (make-vector '(2 2))))
(set! (v 0 0) 1)
@@ -10174,6 +10218,13 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (v 0 1) #2d((1 2) (3 4)))
(test (object->string v) "#2D((1 #2D((1 2) (3 4))) (3 4))"))
+(let ((v (make-int-vector '(2 2))))
+ (set! (v 0 0) 1)
+ (set! (v 0 1) 2)
+ (set! (v 1 0) 3)
+ (set! (v 1 1) 4)
+ (test (object->string v) "#i2D((1 2) (3 4))"))
+
(let ((v #2d((1 2) (3 4))))
(set! (v 0 1) #2d((1 2) (3 4)))
(test (object->string v) "#2D((1 #2D((1 2) (3 4))) (3 4))"))
@@ -10190,12 +10241,12 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (v 1 2 0 0) 'error)
(test (object->string v) "#2D(((0 0) (0 1) (0 2)) ((1 0) (1 1) (1 2)))"))
-(test (object->string (make-float-vector 3 1.0)) "(float-vector 1.0 1.0 1.0)")
-(test (object->string (make-float-vector 3 -1.5)) "(float-vector -1.5 -1.5 -1.5)")
-(test (object->string (make-int-vector 3 1)) "(int-vector 1 1 1)")
-(test (object->string (make-int-vector 3 -1)) "(int-vector -1 -1 -1)")
+(test (object->string (make-float-vector 3 1.0)) "#r(1.0 1.0 1.0)")
+(test (object->string (make-float-vector 3 -1.5)) "#r(-1.5 -1.5 -1.5)")
+(test (object->string (make-int-vector 3 1)) "#i(1 1 1)")
+(test (object->string (make-int-vector 3 -1)) "#i(-1 -1 -1)")
(test (object->string (make-int-vector 0 0)) "#()")
-(test (object->string (make-float-vector '(3 2 0) 0.0)) "#()")
+(test (object->string (make-float-vector '(3 2 0) 0.0)) "#r3D()")
(test (let ((v1 (make-vector '(3 2) 1))
(v2 (make-vector '(3 2) 2))
@@ -10439,16 +10490,16 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((v1 (v 0))
(v2 (v 1)))
(if (not (equal? v1 #(1 2 3)))
- (format-logged #t ";(v 0) subvector: ~A~%" v1))
+ (format #t ";(v 0) subvector: ~A~%" v1))
(if (not (equal? v2 #(4 5 6)))
- (format-logged #t ";(v 1) subvector: ~A~%" v2))
+ (format #t ";(v 1) subvector: ~A~%" v2))
(let ((v3 (copy v1)))
(if (not (equal? v3 #(1 2 3)))
- (format-logged #t ";(v 0) copied subvector: ~A~%" v3))
+ (format #t ";(v 0) copied subvector: ~A~%" v3))
(if (not (= (length v3) 3))
- (format-logged #t ";(v 0) copied length: ~A~%" (length v3)))
+ (format #t ";(v 0) copied length: ~A~%" (length v3)))
(if (not (equal? v3 (copy (v 0))))
- (format-logged #t ";(v 0) copied subvectors: ~A ~A~%" v3 (copy (v 0)))))))
+ (format #t ";(v 0) copied subvectors: ~A ~A~%" v3 (copy (v 0)))))))
(let ((v1 (make-vector '(3 2 1) #f))
(v2 (make-vector '(3 2 1) #f)))
@@ -10993,7 +11044,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (*s7* 'print-length) old-print-length)
(let ((val (string=? result "#1=(hash-table '(\"hi\" . #1#))")))
(if (not val)
- (format-logged #t ";hash display:~% ~A~%" (object->string h1)))
+ (format #t ";hash display:~% ~A~%" (object->string h1)))
val)))
#t)
@@ -11564,7 +11615,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
#|
(define (for-each-permutation func vals) ; for-each-combination -- use for-each-subset below
"(for-each-permutation func vals) applies func to every permutation of vals"
- ;; (for-each-permutation (lambda args (format-logged #t "~{~A~^ ~}~%" args)) '(1 2 3))
+ ;; (for-each-permutation (lambda args (format #t "~{~A~^ ~}~%" args)) '(1 2 3))
(define (pinner cur nvals len)
(if (= len 1)
(apply func (cons (car nvals) cur))
@@ -11586,7 +11637,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
;; a slightly faster version (avoids consing and some recursion)
(define (for-each-permutation func vals) ; for-each-combination -- use for-each-subset below
"(for-each-permutation func vals) applies func to every permutation of vals"
- ;; (for-each-permutation (lambda args (format-logged #t "~A~%" args)) '(1 2 3))
+ ;; (for-each-permutation (lambda args (format #t "~A~%" args)) '(1 2 3))
(let ((cur (make-list (length vals))))
(define (pinner nvals len)
@@ -11599,7 +11650,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (cur 0) (cadr nvals))
(apply func cur))
- (do ((i 0 (+ i 1))) ; I suppose a named let would be more Schemish
+ (do ((i 0 (+ i 1)))
((= i len))
(let ((start nvals))
(set! nvals (cdr nvals))
@@ -11617,7 +11668,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
;; and continuing down that line...
(define (for-each-permutation func vals) ; for-each-combination -- use for-each-subset below
"(for-each-permutation func vals) applies func to every permutation of vals"
- ;; (for-each-permutation (lambda args (format-logged #t "~A~%" args)) '(1 2 3))
+ ;; (for-each-permutation (lambda args (format #t "~A~%" args)) '(1 2 3))
(let ((cur (make-list (length vals))))
(define (pinner nvals len)
@@ -11817,6 +11868,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (hook 'result) 32)))))
(let ((val (+ 1 _an_undefined_variable_i_hope_)))
(test val 33))
+ (let ((val (+ 1 _an_undefined_variable_i_hope_)))
+ (test (call/cc (lambda (_a_) (_a_ val))) 33))
(let ((val (* _an_undefined_variable_i_hope_ _an_undefined_variable_i_hope_)))
(test val 1024)))
@@ -11854,7 +11907,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((val (let ()
(define (hi x y) (let ((m (memq x y)) (loc (and m (- x (length m))))) loc))
(hi 'a '(a b c)))))
- (format-logged #t "~A: opt1 got ~S but expected 'error~%~%" (port-line-number) val)))
+ (format #t "~A: opt1 got ~S but expected 'error~%~%" (port-line-number) val)))
(catch #t opt1
(lambda (type info)
(if (or (not (eq? type 'syntax-error))
@@ -11866,7 +11919,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((val (let ()
(define (hi x y) (let* ((n (memq x y)) (loc (and m (- x (length m)))) (m (+ n 1))) loc))
(hi 'a '(a b c)))))
- (format-logged #t "~A: opt2 got ~S but expected 'error~%~%" (port-line-number) val)))
+ (format #t "~A: opt2 got ~S but expected 'error~%~%" (port-line-number) val)))
(catch #t opt2
(lambda (type info)
(if (or (not (eq? type 'syntax-error))
@@ -11879,7 +11932,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((val (let ()
(define (hi x y) (do ((m (memq x y) 0) (loc (and m (- x (length m))) 0)) (loc #t)))
(hi 'a '(a b c)))))
- (format-logged #t "~A: opt3 got ~S but expected 'error~%~%" (port-line-number) val)))
+ (format #t "~A: opt3 got ~S but expected 'error~%~%" (port-line-number) val)))
(catch #t opt3
(lambda (type info)
(if (or (not (eq? type 'syntax-error))
@@ -11901,7 +11954,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((val (let ()
(define (hi x y) (letrec* ((n (memq x y)) (loc (and m (- x (length m)))) (m (+ n 1))) loc))
(hi 'a '(a b c)))))
- (format-logged #t "~A: opt5 got ~S but expected 'error~%~%" (port-line-number) val)))
+ (format #t "~A: opt5 got ~S but expected 'error~%~%" (port-line-number) val)))
(catch #t opt5
(lambda (type info)
'error)))
@@ -11911,7 +11964,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((val (let ()
(define (hi x) (let ((m (memq n x)) (loc (and m (- x (length m))))) (define n 1) loc))
(hi '(a b c)))))
- (format-logged #t "~A: opt6 got ~S but expected 'error~%~%" (port-line-number) val)))
+ (format #t "~A: opt6 got ~S but expected 'error~%~%" (port-line-number) val)))
(catch #t opt6
(lambda (type info)
(if (or (not (eq? type 'syntax-error))
@@ -11924,7 +11977,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((val (let ()
(define* (f1 (a (+ m 1)) (m (+ a 1))) (+ a m))
(f1))))
- (format-logged #t "~A: opt7 got ~S but expected 'error~%~%" (port-line-number) val)))
+ (format #t "~A: opt7 got ~S but expected 'error~%~%" (port-line-number) val)))
(catch #t opt7
(lambda (type info)
'error)))
@@ -11936,7 +11989,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! x (+ m 1))
(define m 2)
x))))
- (format-logged #t "~A: opt8 got ~S but expected 'error~%~%" (port-line-number) val)))
+ (format #t "~A: opt8 got ~S but expected 'error~%~%" (port-line-number) val)))
(catch #t opt8
(lambda (type info)
(if (or (not (eq? type 'syntax-error))
@@ -11948,7 +12001,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(define (opt9)
(let ((val (let ()
(let ((x 1)) (set! x (and m (length m))) (define m 2) x))))
- (format-logged #t "~A: opt9 got ~S but expected 'error~%~%" (port-line-number) val)))
+ (format #t "~A: opt9 got ~S but expected 'error~%~%" (port-line-number) val)))
(catch #t opt9
(lambda (type info)
(if (or (not (eq? type 'syntax-error))
@@ -11970,19 +12023,19 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let-temporarily (((hook-functions *load-hook*) (list (lambda (hook)
(if (or val
(defined? 'load-hook-test))
- (format-logged #t ";*load-hook*: ~A ~A?~%" val load-hook-test))
+ (format #t ";*load-hook*: ~A ~A?~%" val load-hook-test))
(set! val (hook 'name))))))
(with-output-to-file "load-hook-test.scm"
(lambda ()
- (format-logged #t "(define (load-hook-test val) (+ val 1))")))
+ (format #t "(define (load-hook-test val) (+ val 1))")))
(load "load-hook-test.scm")
(if (or (not (string? val))
(not (string=? val "load-hook-test.scm")))
- (format-logged #t ";*load-hook-test* file: ~S~%" val))
+ (format #t ";*load-hook-test* file: ~S~%" val))
(if (not (defined? 'load-hook-test))
- (format-logged #t ";load-hook-test function not defined?~%")
+ (format #t ";load-hook-test function not defined?~%")
(if (not (= (load-hook-test 1) 2))
- (format-logged #t ";load-hook-test: ~A~%" (load-hook-test 1))))))
+ (format #t ";load-hook-test: ~A~%" (load-hook-test 1))))))
(let-temporarily (((hook-functions *error-hook*) ()))
(test (hook-functions *error-hook*) ())
@@ -12115,7 +12168,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((a-hook (make-hook 'error-type :rest 'error-info)))
(set! (hook-functions a-hook)
(list (lambda (hook)
- ;(format-logged #t "hooked-catch: ~A~%" (apply format #t (car (hook 'error-info))))
+ ;(format #t "hooked-catch: ~A~%" (apply format #t (car (hook 'error-info))))
(set! (hook 'result) 32))))
(test (hooked-catch a-hook (abs "hi")) 32)
@@ -12255,7 +12308,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((ht1 (make-hash-table 31))
(ht2 (make-hash-table 31)))
(if (not (equal? ht1 ht2))
- (format-logged #t ";ht1 and ht2 are empty, but not equal??~%"))
+ (format #t ";ht1 and ht2 are empty, but not equal??~%"))
;; these first tests take advantage of s7's hashing function
(hash-table-set! ht1 'abc 1)
@@ -12265,7 +12318,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(hash-table-set! ht2 'abcabc 2)
(hash-table-set! ht2 'abc 1)
(if (not (equal? ht1 ht2))
- (format-logged #t ";ht1 and ht2 have the same key value pairs, but are not equal??~%"))
+ (format #t ";ht1 and ht2 have the same key value pairs, but are not equal??~%"))
(test (make-hash-table 1 (call-with-exit (lambda (goto) goto))) 'error)
@@ -12274,20 +12327,20 @@ zzy" (lambda (p) (eval (read p))))) 32)
(hash-table-set! ht2 'abcabc 2)
(hash-table-set! ht2 'abcabcabc 3)
(if (not (equal? ht1 ht2))
- (format-logged #t ";ht1 and ht2 have the same key value pairs in the same order, but are not equal??~%"))
+ (format #t ";ht1 and ht2 have the same key value pairs in the same order, but are not equal??~%"))
(hash-table-set! ht2 'abc "1")
(if (equal? ht1 ht2)
- (format-logged #t ";ht1 and ht2 are equal but values are not~%"))
+ (format #t ";ht1 and ht2 are equal but values are not~%"))
(hash-table-set! ht2 'abc 1)
(if (not (equal? ht1 ht2))
- (format-logged #t ";after reset ht1 and ht2 have the same key value pairs in the same order, but are not equal??~%"))
+ (format #t ";after reset ht1 and ht2 have the same key value pairs in the same order, but are not equal??~%"))
(hash-table-set! ht2 1 'abc)
(if (equal? ht1 ht2)
- (format-logged #t ";ht1 and ht2 are equal but entries are not~%"))
+ (format #t ";ht1 and ht2 are equal but entries are not~%"))
(hash-table-set! ht1 1 'abc)
(if (not (equal? ht1 ht2))
- (format-logged #t ";after add ht1 and ht2 have the same key value pairs, but are not equal??~%"))
+ (format #t ";after add ht1 and ht2 have the same key value pairs, but are not equal??~%"))
;; these should force chaining in any case
(set! ht1 (make-hash-table 31))
@@ -12297,7 +12350,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(hash-table-set! ht1 i (* i 2))
(hash-table-set! ht2 i (* i 2)))
(if (not (equal? ht1 ht2))
- (format-logged #t ";ht1 and ht2 have the same (integer) key value pairs in the same order, but are not equal??~%"))
+ (format #t ";ht1 and ht2 have the same (integer) key value pairs in the same order, but are not equal??~%"))
(let ((h1 (hash-table* "a" 1))
(h2 (hash-table* 'a 1)))
@@ -12321,7 +12374,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(hash-table-set! ht2 i (* i 2)))
(test (hash-table-entries ht2) 100)
(if (not (equal? ht1 ht2))
- (format-logged #t ";ht1 and ht2 have the same (integer) key value pairs, but are not equal??~%"))
+ (format #t ";ht1 and ht2 have the same (integer) key value pairs, but are not equal??~%"))
(fill! ht1 ())
(test (hash-table-entries ht1) 100)
@@ -12584,6 +12637,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (make-hash-table most-negative-fixnum) 'error)
(test (make-hash-table 10 1) 'error)
+(let () ; size bug noticed by K.M. -- libasan reports it
+ (define hash (make-hash-table 1)) ;; Size must be 1.
+ (set! (hash :hello) "a50")
+ (gc))
+
(let ((ht (make-hash-table)))
(test (hash-table? ht ht) 'error)
(test (hash-table-ref ht #\a #\b) 'error)
@@ -12646,13 +12704,13 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((vals (list (hti) (hti))))
(if (not (equal? (sort! vals (lambda (a b) (< (car a) (car b)))) '((123 . "123") (456 . "456"))))
- (format-logged #t ";iterator: ~A~%" vals))
+ (format #t ";iterator: ~A~%" vals))
(let ((val (hti)))
(if (not (eof-object? val))
- (format-logged #t ";iterator at end: ~A~%" val)))
+ (format #t ";iterator at end: ~A~%" val)))
(let ((val (hti)))
(if (not (eof-object? val))
- (format-logged #t ";iterator at end (2): ~A~%" val)))))
+ (format #t ";iterator at end (2): ~A~%" val)))))
(test (make-iterator) 'error)
(test (make-iterator (make-hash-table) 1) 'error)
@@ -12873,13 +12931,13 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (a b)
(if (not (equal? (string->number (car a)) (cdr a)))
- (format-logged #t ";hash-table for-each (str . i): ~A?~%" a))
+ (format #t ";hash-table for-each (str . i): ~A?~%" a))
(if (not (equal? (number->string (car b)) (cdr b)))
- (format-logged #t ";hash-table for-each (i . str): ~A?~%" b))
+ (format #t ";hash-table for-each (i . str): ~A?~%" b))
(set! cases (+ cases 1)))
ht1 ht2)
(if (not (= cases 256))
- (format-logged #t ";hash-table for-each cases: ~A~%" cases)))
+ (format #t ";hash-table for-each cases: ~A~%" cases)))
(let ((iter1 (make-iterator ht1))
(iter2 (make-iterator ht2)))
(test (equal? iter1 iter2) #f)
@@ -12891,12 +12949,12 @@ zzy" (lambda (p) (eval (read p))))) 32)
((or (eof-object? a)
(eof-object? b)))
(if (not (equal? (string->number (car a)) (cdr a)))
- (format-logged #t ";hash-table iter1 (str . i): ~A?~%" a))
+ (format #t ";hash-table iter1 (str . i): ~A?~%" a))
(if (not (equal? (number->string (car b)) (cdr b)))
- (format-logged #t ";hash-table iter2 (i . str): ~A?~%" b))
+ (format #t ";hash-table iter2 (i . str): ~A?~%" b))
(set! cases (+ cases 1)))
(if (not (= cases 256))
- (format-logged #t ";hash-table iter1/2 cases: ~A~%" cases)))))
+ (format #t ";hash-table iter1/2 cases: ~A~%" cases)))))
(let ((ht (make-hash-table 31)))
(let ((ht1 (make-hash-table 31)))
@@ -13034,7 +13092,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(outlet (funclet f1)))
#f))))
(if (not (hash-table? ht))
- (format-logged #t ";can't find memo? ~A~%" (let->list (outlet (funclet f1))))
+ (format #t ";can't find memo? ~A~%" (let->list (outlet (funclet f1))))
(test (length (map (lambda (x) x) ht)) 2))))
(let ()
@@ -13814,16 +13872,16 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(if (input-port? arg)
- (format-logged #t ";(input-port? ~A) -> #t?~%" arg)))
+ (format #t ";(input-port? ~A) -> #t?~%" arg)))
(list "hi" #f (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f :hi #<eof> #<undefined> #<unspecified>))
(test (call-with-input-file "s7test.scm" input-port?) #t)
(if (not (eq? start-input-port (current-input-port)))
- (format-logged #t "call-with-input-file did not restore current-input-port? ~A from ~A~%" start-input-port (current-input-port)))
+ (format #t "call-with-input-file did not restore current-input-port? ~A from ~A~%" start-input-port (current-input-port)))
(test (let ((this-file (open-input-file "s7test.scm"))) (let ((res (input-port? this-file))) (close-input-port this-file) res)) #t)
(if (not (eq? start-input-port (current-input-port)))
- (format-logged #t "open-input-file clobbered current-input-port? ~A from ~A~%" start-input-port (current-input-port)))
+ (format #t "open-input-file clobbered current-input-port? ~A from ~A~%" start-input-port (current-input-port)))
(test (call-with-input-string "(+ 1 2)" input-port?) #t)
(test (let ((this-file (open-input-string "(+ 1 2)"))) (let ((res (input-port? this-file))) (close-input-port this-file) res)) #t)
@@ -14032,7 +14090,6 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((str (big-string)))
(test (length str) 6000))
-
(let ((big-string (eval (call-with-input-string
(call-with-output-string
(lambda (p)
@@ -14047,7 +14104,6 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((str (big-string)))
(test (length str) 6000)))
-
(call-with-output-file "test.scm"
(lambda (p)
(format p "(define (big-string)~%")
@@ -14062,7 +14118,6 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((str (big-string)))
(test (length str) 6001))
-
(let ((big-string (eval (call-with-input-string
(call-with-output-string
(lambda (p)
@@ -14077,15 +14132,13 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((str (big-string)))
(test (length str) 6001)))
-
(call-with-output-file "test.scm"
(lambda (p)
(format p "")))
(load "test.scm") ; #<unspecified>
-
- (call-with-output-file "test.scm"
- (lambda (p)
+ (let ()
+ (define (write-stuff p)
(format p ";")
(do ((i 0 (+ i 1)))
((= i 3000))
@@ -14093,25 +14146,24 @@ zzy" (lambda (p) (eval (read p))))) 32)
(if (char<? c #\space)
(display #\space p)
(display c p))))
- (format p "~%32~%")))
- (test (load "test.scm") 32)
+ (format p "~%32~%"))
+ (call-with-output-file "test.scm" write-stuff)
+ (test (load "test.scm") 32))
-
- (call-with-output-file "test.scm"
- (lambda (p)
+ (let ()
+ (define (write-stuff p)
(format p "(define (big-list)~% (list ")
(do ((i 0 (+ i 1)))
((= i 2000))
(format p "~D " i))
- (format p "))~%")))
-
- (load "test.scm")
- (let ((lst (big-list)))
- (test (length lst) 2000))
+ (format p "))~%"))
+ (call-with-output-file "test.scm" write-stuff)
+ (load "test.scm")
+ (let ((lst (big-list)))
+ (test (length lst) 2000)))
-
- (call-with-output-file "test.scm"
- (lambda (p)
+ (let ()
+ (define (write-stuff p)
(format p "(define (big-list)~% ")
(do ((i 0 (+ i 1)))
((= i 2000))
@@ -14120,12 +14172,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
(do ((i 0 (+ i 1)))
((= i 2000))
(format p ")"))
- (format p ")~%")))
-
+ (format p ")~%"))
+ (call-with-output-file "test.scm" write-stuff)
(load "test.scm")
(let ((lst (big-list)))
- (test (length lst) 2000))
-
+ (test (length lst) 2000)))
(call-with-output-file "test.scm"
(lambda (p)
@@ -14134,7 +14185,6 @@ zzy" (lambda (p) (eval (read p))))) 32)
(load "test.scm")
(test (a-char) #\a)
-
(call-with-output-file "test.scm"
(lambda (p)
(let ((a (char->integer #\a)))
@@ -14148,7 +14198,6 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((chars (big-char)))
(test (length chars) 2000))
-
(call-with-output-file "test.scm"
(lambda (p)
(let ((a (char->integer #\a)))
@@ -14162,23 +14211,22 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((chars (big-xchar)))
(test (length chars) 2000))
-
(call-with-output-file "test.scm"
(lambda (p)
(format p "(define (ychar) #\\~C)" (integer->char 255))))
(load "test.scm")
(test (ychar) (integer->char 255))
-
-
- (call-with-output-file "test.scm"
- (lambda (p)
+
+ (let ()
+ (define (write-stuff p)
(do ((i 0 (+ i 1)))
((= i 1000))
(format p "~D" i))
(format p "~%")
(do ((i 0 (+ i 1)))
((= i 1000))
- (format p "~D" i))))
+ (format p "~D" i)))
+ (call-with-output-file "test.scm" write-stuff))
(call-with-input-file "test.scm"
(lambda (p)
@@ -14188,7 +14236,6 @@ zzy" (lambda (p) (eval (read p))))) 32)
(= (length s1) 2890))
#t))))
-
(call-with-output-file "test.scm"
(lambda (p)
(format p "(define (big-int)~%")
@@ -14200,7 +14247,6 @@ zzy" (lambda (p) (eval (read p))))) 32)
(load "test.scm")
(test (big-int) 123)
-
(call-with-output-file "test.scm"
(lambda (p)
(format p "(define (big-rat)~%")
@@ -14216,7 +14262,6 @@ zzy" (lambda (p) (eval (read p))))) 32)
(load "test.scm")
(test (big-rat) 123/2)
-
(call-with-output-file "test.scm"
(lambda (p)
(format p "(define (big-hash)~% (hash-table ")
@@ -14236,7 +14281,6 @@ zzy" (lambda (p) (eval (read p))))) 32)
ht)
(test entries 2000)))
-
(call-with-output-file "test.scm"
(lambda (p)
(format p "(define (big-hash)~% (apply hash-table (list ")
@@ -14256,7 +14300,6 @@ zzy" (lambda (p) (eval (read p))))) 32)
ht)
(test entries 2000)))
-
(call-with-output-file "test.scm"
(lambda (p)
(let ((a (char->integer #\a)))
@@ -14283,7 +14326,6 @@ zzy" (lambda (p) (eval (read p))))) 32)
(if (not (equal? val i))
(format *stderr* ";env: ~A -> ~A, not ~D~%" sym val i))))))
-
(call-with-output-file "test.scm"
(lambda (p)
(format p "")))
@@ -14294,7 +14336,6 @@ zzy" (lambda (p) (eval (read p))))) 32)
(if (not (eof-object? val))
(format *stderr* ";read empty file: ~A~%" val)))
-
(call-with-output-file "test.scm"
(lambda (p)
(format p " ;")
@@ -14312,7 +14353,6 @@ zzy" (lambda (p) (eval (read p))))) 32)
(if (not (eof-object? val))
(format *stderr* ";read comment file: ~A~%" val)))
-
(call-with-output-file "test.scm"
(lambda (p)
(format p "\"~3001TT\"~%")))
@@ -14352,7 +14392,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(if (output-port? arg)
- (format-logged #t ";(output-port? ~A) -> #t?~%" arg)))
+ (format #t ";(output-port? ~A) -> #t?~%" arg)))
(list "hi" #f () 'hi (integer->char 65) 1 (list 1 2) _ht_ _null_ _c_obj_ '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f))
(for-each
@@ -14363,11 +14403,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (call-with-output-file tmp-output-file output-port?) #t)
(if (not (eq? start-output-port (current-output-port)))
- (format-logged #t "call-with-output-file did not restore current-output-port? ~A from ~A~%" start-output-port (current-output-port)))
+ (format #t "call-with-output-file did not restore current-output-port? ~A from ~A~%" start-output-port (current-output-port)))
(test (let ((this-file (open-output-file tmp-output-file))) (let ((res (output-port? this-file))) (close-output-port this-file) res)) #t)
(if (not (eq? start-output-port (current-output-port)))
- (format-logged #t "open-output-file clobbered current-output-port? ~A from ~A~%" start-output-port (current-output-port)))
+ (format #t "open-output-file clobbered current-output-port? ~A from ~A~%" start-output-port (current-output-port)))
(test (let ((val #f)) (call-with-output-string (lambda (p) (set! val (output-port? p)))) val) #t)
(test (let ((res #f)) (let ((this-file (open-output-string))) (set! res (output-port? this-file)) (close-output-port this-file) res)) #t)
@@ -14375,7 +14415,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(if (eof-object? arg)
- (format-logged #t ";(eof-object? ~A) -> #t?~%" arg)))
+ (format #t ";(eof-object? ~A) -> #t?~%" arg)))
(list "hi" () '(1 2) -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #f #t (if #f #f) #<undefined> (lambda (a) (+ a 1))))
@@ -14385,7 +14425,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda () (port-closed? arg))
(lambda args 'error))))
(if (not (eq? val 'error))
- (format-logged #t ";(port-closed? ~A) -> ~S?~%" arg val))))
+ (format #t ";(port-closed? ~A) -> ~S?~%" arg val))))
(list "hi" '(1 2) -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #f #t (if #f #f) #<undefined> #<eof> (lambda (a) (+ a 1))))
@@ -14455,7 +14495,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (eof-object? (read-char test-file)) #t)
(input-port? test-file)))))
(if (not (eq? val #t))
- (format-logged #t "input-port? in call-with-input-file? returned ~A from ~A~%" val name))))
+ (format #t "input-port? in call-with-input-file? returned ~A from ~A~%" val name))))
(test (call-with-output-file
tmp-output-file
@@ -14485,14 +14525,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(call-with-output-file tmp-output-file (lambda (p) (display "3.14" p)))
(test (with-input-from-file tmp-output-file read) 3.14)
(if (not (eq? start-input-port (current-input-port)))
- (format-logged #t "with-input-from-file did not restore current-input-port? ~A from ~A~%" start-input-port (current-input-port)))
+ (format #t "with-input-from-file did not restore current-input-port? ~A from ~A~%" start-input-port (current-input-port)))
(test (with-input-from-file tmp-output-file (lambda () (eq? (current-input-port) start-input-port))) #f)
(test (char->integer ((with-input-from-string (string (integer->char 255))(lambda () (read-string 1))) 0)) 255)
(test (with-output-to-file tmp-output-file (lambda () (eq? (current-output-port) start-output-port))) #f)
(if (not (eq? start-output-port (current-output-port)))
- (format-logged #t "with-output-to-file did not restore current-output-port? ~A from ~A~%" start-output-port (current-output-port)))
+ (format #t "with-output-to-file did not restore current-output-port? ~A from ~A~%" start-output-port (current-output-port)))
(let ((newly-found-sonnet-probably-by-shakespeare
@@ -14522,7 +14562,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(read)))))
(if (or (not (string? sonnet))
(not (string=? sonnet newly-found-sonnet-probably-by-shakespeare)))
- (format-logged #t "write/read long string returned: ~A~%" sonnet)))
+ (format #t "write/read long string returned: ~A~%" sonnet)))
(let ((file (open-output-file tmp-output-file)))
(let ((len (string-length newly-found-sonnet-probably-by-shakespeare)))
@@ -14541,7 +14581,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(close-input-port file)
(if (or (not (string? sonnet))
(not (string=? sonnet newly-found-sonnet-probably-by-shakespeare)))
- (format-logged #t "write-char/read long string returned: ~A~%" sonnet)))))
+ (format #t "write-char/read long string returned: ~A~%" sonnet)))))
(let ((file (open-output-file tmp-output-file)))
(for-each
@@ -14556,7 +14596,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (arg)
(let ((val (read file)))
(if (not (equal? val arg))
- (format-logged #t "read/write ~A returned ~A~%" arg val))))
+ (format #t "read/write ~A returned ~A~%" arg val))))
(list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
(close-input-port file))
@@ -14568,10 +14608,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda ()
(read)))))
(if (not (equal? val lists))
- (format-logged #t "read/write lists returned ~A~%" val)))
+ (format #t "read/write lists returned ~A~%" val)))
(if (not (string=? "" (with-output-to-string (lambda () (display "")))))
- (format-logged #t "with-output-to-string null string?"))
+ (format #t "with-output-to-string null string?"))
(let ((str (with-output-to-string
(lambda ()
@@ -14581,7 +14621,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
((eof-object? c))
(display c))))))))
(if (not (string=? str "hiho123"))
- (format-logged #t "with string ports 0: ~S?~%" str)))
+ (format #t "with string ports 0: ~S?~%" str)))
(let ((p1 (open-input-string "123"))
(p2 (open-input-string "123")))
@@ -14749,16 +14789,16 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let () (call-with-output-file ofile s7-version) (get-file-contents)) 'error))
(if (not (eof-object? (with-input-from-string "" (lambda () (read-char)))))
- (format-logged #t ";input from null string not #<eof>?~%")
+ (format #t ";input from null string not #<eof>?~%")
(let ((EOF (with-input-from-string "" (lambda () (read-char)))))
(if (not (eq? (with-input-from-string "" (lambda () (read-char)))
(with-input-from-string "" (lambda () (read-char)))))
- (format-logged #t "#<eof> is not eq? to itself?~%"))
+ (format #t "#<eof> is not eq? to itself?~%"))
(if (char? EOF)
(do ((c 0 (+ c 1)))
((= c 256))
(if (char=? EOF (integer->char c))
- (format-logged #t "#<eof> is char=? to ~C~%" (integer->char c)))))))
+ (format #t "#<eof> is char=? to ~C~%" (integer->char c)))))))
(test (+ 100 (call-with-output-file "tmp.r5rs" (lambda (p) (write "1" p) (values 1 2)))) 103)
(test (+ 100 (with-output-to-file "tmp.r5rs" (lambda () (write "2") (values 1 2)))) 103)
@@ -14773,7 +14813,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(eof-object? c)))
(display c))))))))
(if (not (string=? str "hiho123"))
- (format-logged #t "with string ports 1: ~S?~%" str))))
+ (format #t "with string ports 1: ~S?~%" str))))
(let ((str (with-output-to-string
(lambda ()
@@ -14783,7 +14823,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
((eof-object? c))
(display c))))))))
(if (not (string=? str ""))
- (format-logged #t "with string ports and null string: ~S?~%" str)))
+ (format #t "with string ports and null string: ~S?~%" str)))
(let ((str (with-output-to-string ; this is from the guile-user mailing list, I think -- don't know who wrote it
(lambda ()
@@ -14838,7 +14878,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(outx c))))
(outx)))))))))
(if (not (string=? str "ABB BEE EEE E44 446 66F GZY W22 220 0PQ 999 999 999 R."))
- (format-logged #t "call/cc with-input-from-string str: ~A~%" str)))
+ (format #t "call/cc with-input-from-string str: ~A~%" str)))
(let ((badfile tmp-output-file))
(let ((p (open-output-file badfile)))
@@ -14876,7 +14916,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (op)
(for-each
- (lambda (arg) ;(format-logged #t ";(~A ~A)~%" op arg)
+ (lambda (arg) ;(format #t ";(~A ~A)~%" op arg)
(test (op arg) 'error))
(list (integer->char 65) 1 0 -1 (list 1) (cons 1 2) 'a-symbol (make-vector 3) abs lambda with-let
_ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
@@ -14889,6 +14929,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (arg) (display "hi" arg))
call-with-input-file with-input-from-file call-with-output-file with-output-to-file))
+(unless pure-s7 (test (char-ready? (open-input-string "")) #t)) ; humph
(with-output-to-file tmp-output-file
(lambda ()
(display "this is a test")
@@ -14915,10 +14956,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let loop ((val (read-byte p)))
(if (eof-object? val)
(if (not (= ctr 26))
- (format-logged #t "read-byte done at ~A~%" ctr))
+ (format #t "read-byte done at ~A~%" ctr))
(begin
(if (not (= (bytes ctr) val))
- (format-logged #t "read-byte bytes[~D]: ~A ~A~%" ctr (bytes ctr) val))
+ (format #t "read-byte bytes[~D]: ~A ~A~%" ctr (bytes ctr) val))
(set! ctr (+ 1 ctr))
(loop (read-byte p))))))))
@@ -14928,10 +14969,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let loop ((val (read-char p)))
(if (eof-object? val)
(if (not (= ctr 26))
- (format-logged #t "read-char done at ~A~%" ctr))
+ (format #t "read-char done at ~A~%" ctr))
(begin
(if (not (= (bytes ctr) (char->integer val)))
- (format-logged #t "read-char bytes[~D]: ~A ~A~%" ctr (bytes ctr) (char->integer val)))
+ (format #t "read-char bytes[~D]: ~A ~A~%" ctr (bytes ctr) (char->integer val)))
(set! ctr (+ 1 ctr))
(loop (read-char p))))))))
)
@@ -14948,22 +14989,22 @@ zzy" (lambda (p) (eval (read p))))) 32)
(if (not (string=? (port-filename (current-input-port)) tmp-output-file)) (display (port-filename (current-input-port))))
(let ((val (read)))
(if (not (equal? val (list '+ 1 2)))
- (format-logged #t ";file read +: ~A~%" val)))
+ (format #t ";file read +: ~A~%" val)))
(let ((val (read)))
(if (not (equal? val 32))
- (format-logged #t "file read 32: ~A~%" val)))
+ (format #t "file read 32: ~A~%" val)))
(let ((val (read)))
(if (not (equal? val #\a))
- (format-logged #t "file read a: ~A~%" val)))
+ (format #t "file read a: ~A~%" val)))
(let ((val (read)))
(if (not (equal? val -1))
- (format-logged #t "file read -1: ~A~%" val)))
+ (format #t "file read -1: ~A~%" val)))
(let ((val (read)))
(if (not (eof-object? val))
- (format-logged #t "file read #<eof>: ~A~%" val)))
+ (format #t "file read #<eof>: ~A~%" val)))
(let ((val (read)))
(if (not (eof-object? val))
- (format-logged #t "file read #<eof> again: ~A~%" val)))))
+ (format #t "file read #<eof> again: ~A~%" val)))))
(let ()
(call-with-input-string "012"
@@ -14973,7 +15014,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((c (peek-char p)))
(let ((r (read-char p)))
(if (not (equal? c r))
- (format-logged #t ";peek-char: ~A ~A~%" c r))))))))
+ (format #t ";peek-char: ~A ~A~%" c r))))))))
(let ((port #f))
(call-with-exit
@@ -14982,13 +15023,13 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (p)
(set! port p)
(if (not (char=? (peek-char p) #\0))
- (format-logged #t ";peek-char input-string: ~A~%" (peek-char p)))
+ (format #t ";peek-char input-string: ~A~%" (peek-char p)))
(go)))))
(if (not (input-port? port))
- (format-logged #t ";c/e-> c/is -> port? ~A~%" port)
+ (format #t ";c/e-> c/is -> port? ~A~%" port)
(if (not (port-closed? port))
(begin
- (format-logged #t ";c/e -> c/is -> closed? ~A~%" port)
+ (format #t ";c/e -> c/is -> closed? ~A~%" port)
(close-input-port port)))))
(call-with-output-file tmp-output-file (lambda (p) (display "0123456789" p)))
@@ -15000,13 +15041,13 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (p)
(set! port p)
(if (not (char=? (peek-char p) #\0))
- (format-logged #t ";peek-char input-file: ~A~%" (peek-char p)))
+ (format #t ";peek-char input-file: ~A~%" (peek-char p)))
(go)))))
(if (not (input-port? port))
- (format-logged #t ";c/e -> c/if -> port? ~A~%" port)
+ (format #t ";c/e -> c/if -> port? ~A~%" port)
(if (not (port-closed? port))
(begin
- (format-logged #t ";c/e -> c/if -> closed? ~A~%" port)
+ (format #t ";c/e -> c/if -> closed? ~A~%" port)
(close-input-port port)))))
(let ((port #f))
@@ -15019,15 +15060,15 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (p)
(set! port p)
(if (not (char=? (peek-char p) #\0))
- (format-logged #t ";peek-char input-string 1: ~A~%" (peek-char p)))
+ (format #t ";peek-char input-string 1: ~A~%" (peek-char p)))
(go))))
(lambda ()
(close-input-port port)))))
(if (not (input-port? port))
- (format-logged #t ";c/e -> dw -> c/is -> port? ~A~%" port)
+ (format #t ";c/e -> dw -> c/is -> port? ~A~%" port)
(if (not (port-closed? port))
(begin
- (format-logged #t ";c/e -> dw -> c/is -> closed? ~A~%" port)
+ (format #t ";c/e -> dw -> c/is -> closed? ~A~%" port)
(close-input-port port)))))
(let ((port #f))
@@ -15040,15 +15081,15 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (p)
(set! port p)
(if (not (char=? (peek-char p) #\0))
- (format-logged #t ";peek-char input-file: ~A~%" (peek-char p)))
+ (format #t ";peek-char input-file: ~A~%" (peek-char p)))
(go))))
(lambda ()
(close-input-port port)))))
(if (not (input-port? port))
- (format-logged #t ";c/e -> dw -> c/if -> port? ~A~%" port)
+ (format #t ";c/e -> dw -> c/if -> port? ~A~%" port)
(if (not (port-closed? port))
(begin
- (format-logged #t ";c/e -> dw -> c/if -> closed? ~A~%" port)
+ (format #t ";c/e -> dw -> c/if -> closed? ~A~%" port)
(close-input-port port)))))
(let ((port #f))
@@ -15058,14 +15099,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (p)
(set! port p)
(if (not (char=? (peek-char p) #\0))
- (format-logged #t ";peek-char input-string: ~A~%" (peek-char p)))
+ (format #t ";peek-char input-string: ~A~%" (peek-char p)))
(error 'oops))))
(lambda args #f))
(if (not (input-port? port))
- (format-logged #t ";catch -> c/is -> error -> port? ~A~%" port)
+ (format #t ";catch -> c/is -> error -> port? ~A~%" port)
(if (not (port-closed? port))
(begin
- (format-logged #t ";catch -> c/is -> error -> closed? ~A~%" port)
+ (format #t ";catch -> c/is -> error -> closed? ~A~%" port)
(close-input-port port)))))
(let ((port #f))
@@ -15075,14 +15116,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (p)
(set! port p)
(if (not (char=? (peek-char p) #\0))
- (format-logged #t ";peek-char input-file: ~A~%" (peek-char p)))
+ (format #t ";peek-char input-file: ~A~%" (peek-char p)))
(error 'oops))))
(lambda args #f))
(if (not (input-port? port))
- (format-logged #t ";catch -> c/if -> error -> port? ~A~%" port)
+ (format #t ";catch -> c/if -> error -> port? ~A~%" port)
(if (not (port-closed? port))
(begin
- (format-logged #t ";catch -> c/if -> error -> closed? ~A~%" port)
+ (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\"")
@@ -15275,7 +15316,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~,123456789123456789123456789d" 1) 'error)
;format "~,123456789123456789123456789d" 1: numeric argument too large
-; (format-logged #t "~,123456789123456789123456789d" 1)
+; (format #t "~,123456789123456789123456789d" 1)
(test (format #f "~969424987x" 12) 'error)
(test (format #f "~D" 1 2) 'error)
@@ -15613,7 +15654,7 @@ a2" 3) "132")
(test (format #f "~1, 2F" 123.456789) 'error)
(test (format #f "~1, F" 123.456789) 'error)
-(when with-bignums
+(if with-bignums
(begin
(test (format #f "~o" 1e19) "1.053071060221172E21")
(test (format #f "~o" -1e19) "-1.053071060221172E21")
@@ -15949,7 +15990,7 @@ a2" 3) "132")
(list #\a #(1 2 3) "hi" () 'hi abs (lambda () 1) #(()) (list 1 2 3) '(1 . 2)))
(test (format #f "~D") 'error)
-(test (format () "hi") 'error)
+(test (format () "hi") #f) ; not an error now -- will print "hi" also
(test (format #f "~F" "hi") 'error)
(test (format #f "~D" #\x) 'error)
(test (format #f "~C" (list 1 2 3)) 'error)
@@ -16558,15 +16599,15 @@ a2" 3) "132")
(format this-file "this is a test")
(set! res (get-output-string this-file))
(if (not (string=? res "this is a test"))
- (format-logged #t "open-output-string + format expected \"this is a test\", but got ~S~%" res))
+ (format #t "open-output-string + format expected \"this is a test\", but got ~S~%" res))
(flush-output-port this-file)
(set! res (get-output-string this-file))
(if (not (string=? res "this is a test"))
- (format-logged #t "flush-output-port of string port expected \"this is a test\", but got ~S~%" res))
+ (format #t "flush-output-port of string port expected \"this is a test\", but got ~S~%" res))
(format this-file "this is a test")
(set! res (get-output-string this-file))
(if (not (string=? res "this is a testthis is a test"))
- (format-logged #t "open-output-string after flush expected \"this is a testthis is a test\", but got ~S~%" res))
+ (format #t "open-output-string after flush expected \"this is a testthis is a test\", but got ~S~%" res))
(close-output-port this-file)
(test (flush-output-port this-file) this-file)))
@@ -16593,9 +16634,9 @@ a2" 3) "132")
(format p2 "~D" 1)
(let ((p3 (open-output-string)))
(if (not (string=? (get-output-string p1) "0"))
- (format-logged #t ";format to nested ports, p1: ~S~%" (get-output-string p1)))
+ (format #t ";format to nested ports, p1: ~S~%" (get-output-string p1)))
(if (not (string=? (get-output-string p2) "1"))
- (format-logged #t ";format to nested ports, p2: ~S~%" (get-output-string p2)))
+ (format #t ";format to nested ports, p2: ~S~%" (get-output-string p2)))
(format p3 "~D" 2)
(format p2 "~D" 3)
(format p1 "~D" 4)
@@ -16603,26 +16644,26 @@ a2" 3) "132")
(set! res3 (get-output-string p3))
(close-output-port p3)
(if (not (string=? (get-output-string p1) "04"))
- (format-logged #t ";format to nested ports after close, p1: ~S~%" (get-output-string p1)))
+ (format #t ";format to nested ports after close, p1: ~S~%" (get-output-string p1)))
(if (not (string=? (get-output-string p2) "13"))
- (format-logged #t ";format to nested ports after close, p2: ~S~%" (get-output-string p2))))
+ (format #t ";format to nested ports after close, p2: ~S~%" (get-output-string p2))))
(format (or p1 p3) "~D" 6)
(format (and p1 p2) "~D" 7)
(set! res1 (get-output-string p1))
(close-output-port p1)
(if (not (string=? (get-output-string p2) "137"))
- (format-logged #t ";format to nested ports after 2nd close, p2: ~S~%" (get-output-string p2)))
+ (format #t ";format to nested ports after 2nd close, p2: ~S~%" (get-output-string p2)))
(format p2 "~D" 8)
(set! res2 (get-output-string p2))
(test (get-output-string p1) 'error)
(test (get-output-string p2 "hi") 'error)
(close-output-port p2)))
(if (not (string=? res1 "046"))
- (format-logged #t ";format to nested ports, res1: ~S~%" res1))
+ (format #t ";format to nested ports, res1: ~S~%" res1))
(if (not (string=? res2 "1378"))
- (format-logged #t ";format to nested ports, res2: ~S~%" res2))
+ (format #t ";format to nested ports, res2: ~S~%" res2))
(if (not (string=? res3 "25"))
- (format-logged #t ";format to nested ports, res3: ~S~%" res3)))
+ (format #t ";format to nested ports, res3: ~S~%" res3)))
(test (call/cc (lambda (return)
(let ((val (format #f "line 1~%line 2~%line 3")))
@@ -16632,7 +16673,7 @@ a2" 3) "132")
(test (get-output-string #f 64) 'error)
-;(format-logged #t "format #t: ~D" 1)
+;(format #t "format #t: ~D" 1)
;(format (current-output-port) " output-port: ~D! (this is testing output ports)~%" 2)
(call-with-output-file tmp-output-file
@@ -16770,13 +16811,13 @@ a2" 3) "132")
(display 1)
(write 2)
(write-char #\3)
- (format-logged #t "~D" 4) ; #t -> output port
+ (format #t "~D" 4) ; #t -> output port
(write-byte (char->integer #\5))
(let ((op2 (set-current-output-port (open-output-file "tmp2.r5rs"))))
(display 6)
(write 7)
(write-char #\8)
- (format-logged #t "~D" 9)
+ (format #t "~D" 9)
(write-byte (char->integer #\0))
(newline)
(close-output-port (current-output-port))
@@ -16818,14 +16859,14 @@ a2" 3) "132")
(display 1)
(write 2)
(write-char #\3)
- (format-logged #t "~D" 4) ; #t -> output port
+ (format #t "~D" 4) ; #t -> output port
(write-byte (char->integer #\5))
(let ((op2 (open-output-file "tmp2.r5rs")))
(let-temporarily (((current-output-port) op2))
(display 6)
(write 7)
(write-char #\8)
- (format-logged #t "~D" 9)
+ (format #t "~D" 9)
(write-byte (char->integer #\0))
(newline)
(close-output-port (current-output-port)))
@@ -17060,14 +17101,14 @@ a2" 3) "132")
(if (or (not (number? b))
(not (= b i)))
(begin
- (format-logged #t "read-byte got ~A, expected ~A~%" b i)
+ (format #t "read-byte got ~A, expected ~A~%" b i)
(quit)))))))
(let ((eof (read-byte p)))
(if (not (eof-object? eof))
- (format-logged #t "read-byte at end: ~A~%" eof)))
+ (format #t "read-byte at end: ~A~%" eof)))
(let ((eof (read-byte p)))
(if (not (eof-object? eof))
- (format-logged #t "read-byte at end: ~A~%" eof)))))
+ (format #t "read-byte at end: ~A~%" eof)))))
(call-with-output-file tmp-output-file
(lambda (p)
@@ -17087,15 +17128,15 @@ a2" 3) "132")
(if (or (not (char? b))
(not (char=? b (integer->char i))))
(begin
- (format-logged #t "read-char got ~A, expected ~A (~D: char? ~A)~%" b (integer->char i) i (char? (integer->char i)))
+ (format #t "read-char got ~A, expected ~A (~D: char? ~A)~%" b (integer->char i) i (char? (integer->char i)))
(quit)))))))
(let ((eof (read-char p)))
(if (not (eof-object? eof))
- (format-logged #t "read-char at end: ~A~%" eof))
+ (format #t "read-char at end: ~A~%" eof))
(set! our-eof eof))
(let ((eof (read-char p)))
(if (not (eof-object? eof))
- (format-logged #t "read-char again at end: ~A~%" eof)))))
+ (format #t "read-char again at end: ~A~%" eof)))))
(test (eof-object? (integer->char 255)) #f)
(test (eof-object? our-eof) #t)
@@ -17160,7 +17201,7 @@ a2" 3) "132")
(write-char #\a)
(with-output-to-file tmp-output-file
(lambda ()
- (format-logged #t "~C" #\b)
+ (format #t "~C" #\b)
(with-output-to-file "tmp2.r5rs"
(lambda ()
(display #\c)))
@@ -17213,7 +17254,7 @@ a2" 3) "132")
(read-line p)))))
(if (or (not (string? str))
(not (string=? str "start next done")))
- (format-logged #t ";call-with-output-file + error -> ~S~%" str)))
+ (format #t ";call-with-output-file + error -> ~S~%" str)))
(let ((str (call-with-input-file "tests.data"
(lambda (p)
@@ -17225,7 +17266,7 @@ a2" 3) "132")
(lambda args "s"))))))
(if (or (not (string? str))
(not (string=? str "s")))
- (format-logged #t ";call-with-input-file + error -> ~S~%" str)))
+ (format #t ";call-with-input-file + error -> ~S~%" str)))
(if (and (defined? 'file-exists?)
(file-exists? "tests.data"))
@@ -17233,20 +17274,20 @@ a2" 3) "132")
(with-output-to-file "tests.data"
(lambda ()
- (format-logged #t "start ")
+ (format #t "start ")
(catch #t
(lambda ()
- (format-logged #t "next ") (abs "hi") (format-logged #t "oops "))
+ (format #t "next ") (abs "hi") (format #t "oops "))
(lambda args
'error))
- (format-logged #t "done\n")))
+ (format #t "done\n")))
(let ((str (with-input-from-file "tests.data"
(lambda ()
(read-line)))))
(if (or (not (string? str))
(not (string=? str "start next done")))
- (format-logged #t ";with-output-to-file + error -> ~S~%" str)))
+ (format #t ";with-output-to-file + error -> ~S~%" str)))
(let ((str (with-input-from-file "tests.data"
(lambda ()
@@ -17258,7 +17299,7 @@ a2" 3) "132")
(lambda args "s"))))))
(if (or (not (string? str))
(not (string=? str "s")))
- (format-logged #t ";with-input-from-file + error -> ~S~%" str)))
+ (format #t ";with-input-from-file + error -> ~S~%" str)))
(test (call-with-output-string newline) (string #\newline))
(test (call-with-output-string append) "")
@@ -17274,20 +17315,20 @@ a2" 3) "132")
(format p "done")))))
(if (or (not (string? str))
(not (string=? str "start next done")))
- (format-logged #t ";call-with-output-string + error -> ~S~%" str)))
+ (format #t ";call-with-output-string + error -> ~S~%" str)))
(let ((str (with-output-to-string
(lambda ()
- (format-logged #t "start ")
+ (format #t "start ")
(catch #t
(lambda ()
- (format-logged #t "next ") (abs "hi") (format-logged #t "oops "))
+ (format #t "next ") (abs "hi") (format #t "oops "))
(lambda args
'error))
- (format-logged #t "done")))))
+ (format #t "done")))))
(if (or (not (string? str))
(not (string=? str "start next done")))
- (format-logged #t ";with-output-to-string + error -> ~S~%" str)))
+ (format #t ";with-output-to-string + error -> ~S~%" str)))
(test (with-output-to-string (lambda () (format (current-output-port) "a test ~D" 123))) "a test 123")
;(test (with-output-to-string (lambda () (format *stdout* "a test ~D" 1234))) "a test 1234")
@@ -17315,7 +17356,7 @@ a2" 3) "132")
(lambda args "s"))))))
(if (or (not (string? str))
(not (string=? str "s")))
- (format-logged #t ";call-with-input-string + error -> ~S~%" str)))
+ (format #t ";call-with-input-string + error -> ~S~%" str)))
(let ((str (with-input-from-string "12345"
(lambda ()
@@ -17327,7 +17368,7 @@ a2" 3) "132")
(lambda args "s"))))))
(if (or (not (string? str))
(not (string=? str "s")))
- (format-logged #t ";with-input-from-string + error -> ~S~%" str)))
+ (format #t ";with-input-from-string + error -> ~S~%" str)))
(for-each
(lambda (arg)
@@ -17473,7 +17514,7 @@ a2" 3) "132")
(lambda (op)
(let ((tag (catch #t (lambda () (op)) (lambda args 'error))))
(if (not (eq? tag 'error))
- (format-logged #t ";(~A) -> ~A (expected 'error)~%" op tag))))
+ (format #t ";(~A) -> ~A (expected 'error)~%" op tag))))
(list set-current-input-port set-current-error-port set-current-output-port
close-input-port close-output-port
write display write-byte write-char format ; newline
@@ -17489,7 +17530,7 @@ a2" 3) "132")
(lambda (op)
(let ((tag (catch #t (lambda () (op 1 2 3 4 5)) (lambda args 'error))))
(if (not (eq? tag 'error))
- (format-logged #t ";(~A 1 2 3 4 5) -> ~A (expected 'error)~%" op tag))))
+ (format #t ";(~A 1 2 3 4 5) -> ~A (expected 'error)~%" op tag))))
(list set-current-input-port set-current-error-port set-current-output-port
close-input-port close-output-port
write display write-byte write-char format newline
@@ -17514,12 +17555,12 @@ a2" 3) "132")
(let-temporarily ((*load-path* (cons "/home/bil/test" *load-path*)))
(with-output-to-file "/home/bil/test/load-path-test.scm"
(lambda ()
- (format-logged #t "(define (load-path-test) *load-path*)~%")))
+ (format #t "(define (load-path-test) *load-path*)~%")))
(load "load-path-test.scm")
(if (or (not (defined? 'load-path-test))
(not (equal? *load-path* (load-path-test))))
- (format-logged #t ";*load-path*: ~S, but ~S~%" *load-path* (load-path-test)))))
+ (format #t ";*load-path*: ~S, but ~S~%" *load-path* (load-path-test)))))
;;; function ports
(when with-block
@@ -17572,7 +17613,6 @@ a2" 3) "132")
;;; -------- poke at the reader --------
(test (cdr '(1 ."a")) "a")
-(test (cadr '(1 .#d2)) '.#d2)
(test '(1 .(2 3)) '(1 2 3))
(test '(1 .(2 3)) '(1 . (2 3)))
(test (+ .(2 .(3))) 5)
@@ -18099,6 +18139,14 @@ so anything that quotes ` is not going to equal quote quasiquote
(test (object->string "a\x00b" #t) "\"a\\x00b\"")
(test (object->string "a\x00b" #f) "a\x00b")
+(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 ...)")
+ (test (object->string (vector 1 2 3 4)) "#(1 2 3 ...)")
+ (test (object->string #r(1 2 3 4)) "#r(1.0 2.0 3.0 ...)")
+ (test (object->string #i(1 2 3 4)) "#i(1 2 3 ...)")
+ (test (object->string (list 1 2 3 4)) "(1 2 3 4)")) ; oops...
+;;; hash-tables are hard to check here -- order of entries is not known
+
#|
(do ((i 0 (+ i 1)))
((= i 256))
@@ -18107,10 +18155,10 @@ so anything that quotes ` is not going to equal quote quasiquote
(if (and (not (= (length str) 3)) ; "#\\a"
(or (not (char=? (str 2) #\x))
(not (= (length str) 5)))) ; "#\\xee"
- (format-logged #t "(#t) ~C: ~S~%" c str))
+ (format #t "(#t) ~C: ~S~%" c str))
(set! str (object->string c #f))
(if (not (= (length str) 1))
- (format-logged #t "(#f) ~C: ~S~%" c str)))))
+ (format #t "(#f) ~C: ~S~%" c str)))))
this prints:
(#t) : "#\\null"
(#f) : ""
@@ -18553,7 +18601,7 @@ c"
(test (object->string (inlet 'a lambda) :readable) "(inlet 'a lambda)")
(test (object->string (inlet 'a 'b) :readable) "(inlet 'a 'b)")
(test (object->string (inlet 'a (symbol "( a b c )")) :readable) "(inlet 'a (symbol \"( a b c )\"))")
-(test (object->string (inlet 'a else) :readable) "(inlet 'a else)")
+(test (object->string (inlet 'a else) :readable) "(inlet 'a 'else)")
(test (object->string (inlet 'a (cons 1 2)) :readable) "(inlet 'a (cons 1 2))")
(test (object->string (inlet 'a (list 1 2)) :readable) "(inlet 'a (list 1 2))")
(test (object->string (inlet 'a (list "hi")) :readable) "(inlet 'a (list \"hi\"))")
@@ -18569,8 +18617,8 @@ c"
(test (object->string (inlet 'a #()) :readable) "(inlet 'a #())")
(test (object->string (inlet 'a #(1 2 3)) :readable) "(inlet 'a (vector 1 2 3))")
(test (object->string (inlet 'a (vector "hi" #\a 'b)) :readable) "(inlet 'a (vector \"hi\" #\\a 'b))")
-(test (object->string (inlet 'a (float-vector 1 2 3)) :readable) "(inlet 'a (float-vector 1.0 2.0 3.0))")
-(test (object->string (inlet 'a (int-vector 1 2 3)) :readable) "(inlet 'a (int-vector 1 2 3))")
+(test (object->string (inlet 'a (float-vector 1 2 3)) :readable) "(inlet 'a #r(1.0 2.0 3.0))")
+(test (object->string (inlet 'a (int-vector 1 2 3)) :readable) "(inlet 'a #i(1 2 3))")
(test (object->string (inlet 'a #2d((1 2 3) (4 5 6))) :readable) "(inlet 'a (make-shared-vector (vector 1 2 3 4 5 6) '(2 3)))")
(test (object->string (inlet 'a abs) :readable) "(inlet 'a abs)")
(test (object->string (inlet 'a (lambda (b) (+ b 1))) :readable) "(inlet 'a (lambda (b) (+ b 1)))")
@@ -18620,7 +18668,7 @@ c"
(test (object->string (inlet 'a (make-iterator '(1 2 3))) :readable) "(inlet 'a (make-iterator (list 1 2 3)))")
(test (object->string
(inlet 'a (let ((iter (make-iterator (float-vector 1 2 3)))) (iter) iter)) :readable)
- "(inlet 'a (let ((iter (make-iterator (float-vector 1.0 2.0 3.0)))) (do ((i 0 (+ i 1))) ((= i 1) iter) (iterate iter))))")
+ "(inlet 'a (let ((iter (make-iterator #r(1.0 2.0 3.0)))) (do ((i 0 (+ i 1))) ((= i 1) iter) (iterate iter))))")
(test (object->string (let () (define (f1) (+ a 1)) (curlet)) :readable) "(inlet 'f1 (lambda () (+ a 1)))")
(test (object->string (let () (define (f1) 1) (let () (define f2 f1) (curlet))) :readable) "(inlet 'f2 (lambda () 1))")
@@ -18747,19 +18795,19 @@ c"
(for-each
(lambda (op)
(if (not (eq? op op))
- (format-logged #t "~A not eq? to itself?~%" op)))
+ (format #t "~A not eq? to itself?~%" op)))
control-ops)
(for-each
(lambda (op)
(if (not (eqv? op op))
- (format-logged #t "~A not eqv? to itself?~%" op)))
+ (format #t "~A not eqv? to itself?~%" op)))
control-ops)
(for-each
(lambda (op)
(if (not (equal? op op))
- (format-logged #t "~A not equal? to itself?~%" op)))
+ (format #t "~A not equal? to itself?~%" op)))
control-ops)
(define question-ops (list boolean? eof-object? string?
@@ -18771,7 +18819,7 @@ c"
(for-each
(lambda (op)
(if (ques op)
- (format-logged #t ";(~A ~A) returned #t?~%" ques op)))
+ (format #t ";(~A ~A) returned #t?~%" ques op)))
control-ops))
question-ops)
@@ -18779,13 +18827,13 @@ c"
(for-each
(lambda (op)
(if (op unspecified)
- (format-logged #t ";(~A #<unspecified>) returned #t?~%" op)))
+ (format #t ";(~A #<unspecified>) returned #t?~%" op)))
question-ops))
(for-each
(lambda (s)
(if (not (symbol? s))
- (format-logged #t ";(symbol? ~A returned #f?~%" s)))
+ (format #t ";(symbol? ~A returned #f?~%" s)))
'(+ - ... !.. $.+ %.- &.! *.: /:. <-. =. >. ?. ~. _. ^.))
@@ -19000,7 +19048,6 @@ c"
(test '#f #f)
(test '#t #t)
(test '#b1 1)
-(when (not pure-s7) (test (= 1/2 '#e#b1e-1) #t))
(test '() '())
(test '(1 . 2) (cons 1 2))
(test #(1 2) #(1 2))
@@ -19103,6 +19150,10 @@ c"
(test ((quote and) #f) 'error)
(test ((values quote) 1) 1)
+(test ((lambda () (define (_f_ $a$) $a$) (_f_ (quote 1 1)))) 'error)
+(test ((lambda () (define (_f_ $a$) $a$) (_f_ (quote 1 . 1)))) 'error)
+(test ((lambda () (define (_f_ $a$) $a$) (_f_ (quote . 1)))) 'error)
+
;; see also quasiquote
@@ -19198,6 +19249,16 @@ c"
lst)
(list 1 2 3))
+(test (let ((v (vector 0 0 0))
+ (iv #i(1 2 3))
+ (ctr 0))
+ (for-each (lambda (i)
+ (vector-set! v ctr i)
+ (set! ctr (+ ctr 1)))
+ iv)
+ v)
+ #(1 2 3))
+
;;; this is an infinite loop?
; (let ((cont #f)) (call/cc (lambda (x) (set! cont x))) (for-each cont (list 1 2 3)))
(test (call/cc (lambda (x) (for-each x (list 1 2 3)))) 1) ; map also gives 1 ... perhaps not actually legal?
@@ -19249,7 +19310,7 @@ c"
(for-each
(lambda (a)
(if (not (string=? a "hi"))
- (format-logged #t "yow: ~S" a)))
+ (format #t "yow: ~S" a)))
(list "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi"))
@@ -19379,7 +19440,7 @@ c"
(catch #t
(lambda ()
(if (defined? 'local-x)
- (format-logged #t ";for-each catch local env not cleared: ~A~%" local-x))
+ (format #t ";for-each catch local env not cleared: ~A~%" local-x))
(define local-x x)
local-x)
(lambda args #f)))
@@ -20277,7 +20338,7 @@ c"
(test (let () (define* (f2 a) (+ a 1)) (define (f1 a) (f2 a 1)) (define* (f2 a b) (- a b)) (f1 12)) 11)
(test (let () (define* (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define* (f2 a) (- a 1)) (f1 12)) 11)
-(test (map symbol->value (let ((lst (list 'integer? 'boolean?))) (set-cdr! (cdr lst) lst) lst)) (list integer?))
+;;; (test (map symbol->value (let ((lst (list 'integer? 'boolean?))) (set-cdr! (cdr lst) lst) lst)) (list integer?))
;;; I think this depends on when the list iterator notices the cycle
@@ -20444,7 +20505,7 @@ in s7:
(for-each
(lambda (arg)
(if (iterator? arg)
- (format-logged #t ";~A: (iterator? ~A) -> #t?~%" (port-line-number) arg)))
+ (format #t ";~A: (iterator? ~A) -> #t?~%" (port-line-number) arg)))
(list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined>))
@@ -20897,7 +20958,7 @@ in s7:
(make-iterator
(let ((iterator? #t))
(lambda* (p)
- (if (eq? p :eof)
+ (if (eq? p 'eof)
(begin
(close-input-port port)
#<eof>)
@@ -20908,7 +20969,7 @@ in s7:
(test (iter) "a")
(test (iter) "Scheme")
(test (iter) "interpreter")
- (test ((iterator-sequence iter) :eof) #<eof>)
+ (test ((iterator-sequence iter) 'eof) #<eof>)
)
@@ -20943,6 +21004,7 @@ in s7:
(test (do () ('())) ())
(test (do () (())) ())
(test (do) 'error)
+(test (do ((i 0 (+ i 1)) (i 0)) ((= i 0)) i) 'error)
(test (let ((x 0) (y 0)) (set! y (do () (#t (set! x 32) 123))) (list x y)) (list 32 123))
(test (let ((i 32)) (do ((i 0 (+ i 1)) (j i (+ j 1))) ((> j 33) i))) 2)
@@ -21019,8 +21081,43 @@ in s7:
(define (d2) (do ((i 0 (+ i 1))) ((= i 10) i) i))
(test (d1) 10)
(test (d1) (d2)))
-
-(test (do () (1)) ())
+(test (+ 1 (do ((i 2 (+ i 1))) ((values i (+ i 1))))) 6)
+(test (+ 1 (do ((i 2 (+ i 1))) ((= i 3) (values i (+ i 1))))) 8)
+(test (let () (define (f) (+ 1 (do ((i 2 (+ i 1))) ((values i (+ i 1)))))) (f) (f)) 6)
+(test (let () (define (f) (+ 1 (do ((i 2 (+ i 1))) ((= i 3) (values i (+ i 1)))))) (f) (f)) 8)
+(test (let ((lst '(1 2)))
+ (do ((p lst (cdr p)))
+ ((or (not (pair? p)) (car p))
+ => (lambda (val)
+ (and (pair? p)
+ val)))))
+ 1)
+(let ()
+ (define (f lst)
+ (do ((p lst (cdr p)))
+ ((or (not (pair? p)) (car p))
+ => (lambda (val)
+ (and (pair? p)
+ val)))))
+ (test (f '(1 2)) 1)
+ (test (f '(2 3)) 2))
+(let ()
+ (define (f lst)
+ (do ((p lst (cdr p)))
+ ((or (not (pair? p)) (car p))
+ => car)))
+ (test (f '((1) 2)) 1)
+ (test (f '((2) 3)) 2))
+(let ()
+ (define (f lst)
+ (do ((p lst (cdr p)))
+ ((or (not (pair? p))
+ (apply values (car p)))
+ => +)))
+ (test (f '((1 2) 2)) 3)
+ (test (f '((2 3 4) 3)) 9))
+
+(test (do () (1)) 1)
(test (do () (1 2)) 2)
(test (do () '2) 2)
(test (do () (())) ())
@@ -21031,7 +21128,7 @@ in s7:
;; this ^ will cause a segfault if optimized but how to catch it without a huge speed penalty?
(test (do ((i 0 (+ i 1))) ((>= i 2) i) (define i 10) i) 11)
-(test (let ((x (do ((i 0 (+ i 1))) (#t)))) x) ()) ; guile: #<unspecified>
+(test (let ((x (do ((i 0 (+ i 1))) (#t)))) x) #t) ; guile: #<unspecified>
(test (let ((lst '(1 2 3))
(v (vector 0 0 0)))
@@ -21077,7 +21174,7 @@ in s7:
;; do_all_x:
(let () (define (f1) (let ((v (vector 0 0 0))) (do ((i 0 (+ i 1))) ((= i 3) v) (vector-set! v i (abs i))))) (test (f1) #(0 1 2)))
(let () (define (f1) (let ((v (vector 0 0 0)) (x #f)) (do ((i 0 (+ i 1))) ((= i 3) (set! x v) x) (vector-set! v i (abs i))))) (test (f1) #(0 1 2)))
-(let () (define (f1) (let ((end 3) (v (vector 0 0 0))) (vector (do ((i 0 (+ i 1))) ((= i end)) (vector-set! v i (abs i))) v))) (test (f1) #(() #(0 1 2))))
+(let () (define (f1) (let ((end 3) (v (vector 0 0 0))) (vector (do ((i 0 (+ i 1))) ((= i end)) (vector-set! v i (abs i))) v))) (test (f1) #(#t #(0 1 2))))
(let () (define (f1) (let ((v (vector 0 0 0))) (do ((i 0 (+ i 1))) ((= i 3) v) (display i #f) (vector-set! v i (abs i))))) (test (f1) #(0 1 2)))
(let () (define (f1) (let ((v (vector 0 0 0))) (do ((i 0 (+ i 1))) ((= i 0) v) (vector-set! v i (abs i))))) (test (f1) #(0 0 0)))
@@ -21101,7 +21198,7 @@ in s7:
(test (call-with-exit (lambda (return) (do () (#t (return 123))))) 123)
(test (do () (/ 0)) 0)
-(test (do () (+)) ())
+(test (do () (+)) +)
(test (do () (+ +) *) +)
(when with-bignums
@@ -21399,7 +21496,7 @@ in s7:
(do ((i 0 (+ i 1)))
((= i 1))
(if (not (equal? (map abs x) '(2 3 4)))
- (display "fdo1 map case")))
+ (format () "fdo1 map case: ~S" (map abs x))))
(do ((i 0 (+ i 1)))
((= i 1))
(if (not (equal? (for-each abs x) #<unspecified>))
@@ -21435,6 +21532,73 @@ in s7:
(let () (define (fdo5) (do ((si () ())) ((null? si) 'mi))) (test (fdo5) 'mi))
(let () (define (fdo5) (do ((si () ())) ((null? si) 'mi))) (test (fdo5) 'mi))
+(let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (if x (set! y (+ y 1)))))) (test (f1 #t) 3)) ; b_s -> if_bp
+(let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (if (not x) (set! y (+ y 1)))))) (test (f1 #f) 3)) ; b_s -> if_nbp
+(let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond (x (set! y (+ y 1))) (else 3))))) (test (f1 #t) 3)) ; b_s
+(let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((zero? x) (set! y (+ y 1))) (else 3))))) (test (f1 0) 3)) ; b_i_s and b_t
+(let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((positive? x) (set! y (+ y 1))) (else 3))))) (test (f1 1.0) 3)) ; b_d_s
+(let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((positive? (car x)) (set! y (+ y 1))) (else 3))))) (test (f1 '(1)) 3)) ; b_p_f
+(let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= x 1) (set! y (+ y 1))) (else 3))))) (test (f1 1) 3)) ; b_ii_sc
+(let () (define (f1 x) (let ((y 0) (z 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= x z) (set! y (+ y 1))) (else 3))))) (test (f1 0) 3)) ; b_ii_ss
+(let () (define (f1 x) (let ((y 0) (z '(0))) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= x (car z)) (set! y (+ y 1))) (else 3))))) (test (f1 0) 3)) ; b_pp_sfo
+(let () (define (f1 x) (let ((y 0) (z '(0))) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= (car z) x) (set! y (+ y 1))) (else 3))))) (test (f1 0) 3)) ; b_pi_fs
+(let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= x 1.0) (set! y (+ y 1))) (else 3))))) (test (f1 1.0) 3)) ; b_dd_sc
+(let () (define (f1 x) (let ((y 0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= x z) (set! y (+ y 1))) (else 3))))) (test (f1 1.0) 3)) ; b_dd_ss
+
+(let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ y 1))))) (test (f1) 3)) ; i_ii_sc set_i_i_f
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ y z))))) (test (f1) 3)) ; i_ii_ss
+(let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y 1)))) (test (f1) 1)) ; i_c
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y z)))) (test (f1) 1)) ; i_s
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (floor z))))) (test (f1) 1)) ; i_i_s
+(let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (floor 1.1))))) (test (f1) 1)) ; i_d_c
+(let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (floor 1))))) (test (f1) 1)) ; i_i_c
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (floor (* 1.2 z)))))) (test (f1) 1)) ; i_d_f
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (floor (* 1 z)))))) (test (f1) 1)) ; i_ii_cs i_i_f set_i_i_f
+(let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ 1 1))))) (test (f1) 2)) ; i_ii_cc
+(let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ 1 (abs 1)))))) (test (f1) 2)) ; i_ii_cf
+(let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ (abs 1) 1))))) (test (f1) 2)) ; i_ii_fc
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z (abs 1)))))) (test (f1) 2)) ; i_ii_sf
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ (abs 1) (abs 1)))))) (test (f1) 2)) ; i_ii_ff
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z 1 z 1))))) (test (f1) 4)) ; i_add2
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z 1 z 1 z 1))))) (test (f1) 6)) ; i_add_any_f
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (* z 1 z 1))))) (test (f1) 1)) ; i_mul2
+(let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (* z 1 z 1 z 1))))) (test (f1) 1)) ; i_multiply_any_f
+
+(let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ y 1.0))))) (test (f1) 3.0)) ; d_dd_sc set_d_d_f
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ y z))))) (test (f1) 3.0)) ; d_dd_ss
+(let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y 1.0)))) (test (f1) 1.0)) ; d_c
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y z)))) (test (f1) 1.0)) ; d_s
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (abs z))))) (test (f1) 1.0)) ; d_d_s
+(let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (abs 1.1))))) (test (f1) 1.1)) ; d_d_c
+(let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (abs 1))))) (test (f1) 1.0)) ; d_d_c
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (abs (* 1.2 z)))))) (test (f1) 1.2)) ;d_dd_cs
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (abs (* 1 z)))))) (test (f1) 1.0)) ; d_dd_cs
+(let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ 1.0 1.0))))) (test (f1) 2.0)) ; d_dd_cc
+(let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ 1.0 (abs 1.0)))))) (test (f1) 2.0)) ; d_dd_cf
+(let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ (abs 1.0) 1.0))))) (test (f1) 2.0)) ; d_d_c d_dd_fc
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z (abs 1.0)))))) (test (f1) 2.0)) ; d_dd_sf
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ (abs 1.0) (abs 1.0)))))) (test (f1) 2.0)) ; d_dd_ff
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z 1.0 z 1.0))))) (test (f1) 4.0)) ; d_dddd_ffff
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z 1.0 z 1.0 z 1.0))))) (test (f1) 6.0)) ; d_add_any_f
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (* z 1.0 z 1.0))))) (test (f1) 1.0)) ; d_dddd_ffff
+(let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (* z 1.0 z 1.0 z 1.0))))) (test (f1) 1.0)) ; d_multiply_any_f
+
+(let () (define (f1) (let ((y #\b)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y #\a)))) (test (f1) #\a)) ; p_c set_p_p_f
+(let () (define (f1) (let ((y #\b) (z 0)) (do ((i 0 (+ i 1))) ((= i 3) z) (set! z (char->integer y))))) (test (f1) 98)) ; p_s i_p_f set_i_i_f
+(let () (define (f1) (let ((y #\b) (z 98)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (integer->char z))))) (test (f1) #\b)) ; p_p_s
+(let () (define (f1) (let ((y (list 2)) (z '(1))) (do ((i 0 (+ i 1))) ((= i 3) y) (list-set! y 0 (car z))))) (test (f1) '(1))) ; i_c p_pip_sff
+(let () (define (f1) (let ((y (list 2)) (z 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (list-set! y z (car '(1)))))) (test (f1) '(1))) ; p_pip_ssf
+(let () (define (f1) (let ((y 2) (z 0) (x '(1))) (do ((i 0 (+ i 1))) ((= i 3) x) (set! x (list y z))))) (test (f1) '(2 0))) ; p_cf_ss
+(let () (define (f1) (let ((y 2) (z 0) (x '(1))) (do ((i 0 (+ i 1))) ((= i 3) x) (set! x (list 0 0))))) (test (f1) '(0 0))) ; p_cf_ff
+(let () (define (f1) (let ((y 2) (z 0) (x '(1))) (do ((i 0 (+ i 1))) ((= i 3) x) (set! x (list y 0))))) (test (f1) '(2 0))) ; p_cf_sf
+(let () (define (f1) (let ((y 2) (z 0) (x '(1))) (do ((i 0 (+ i 1))) ((= i 3) x) (set! x (list 2 z))))) (test (f1) '(2 0))) ; p_cf_fs
+
+(let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (if (not (= (floor z) 1)) (display "oops"))))) (test (f1) 0)) ; b_ii_fc p_p_c if_nbp
+(let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (if (not (= (+ z z) 2.2)) (display (+ z z)))))) (test (f1) 0)) ; p_p_f b_dd_fc d_dd_ss p_pp_ss
+(let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (if (= (+ z 1) 2.2) (display (+ z 1)))))) (test (f1) 0)) ; if_bp p_pp_sc d_dd_sc
+(let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (when (= (+ 1 z) z) (display (+ 1 z)))))) (test (f1) 0)) ; when_p p_pp_cs b_dd_fs
+(let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (unless (= (+ z z 1) 3.2) (display (+ z z 1)))))) (test (f1) 0)) ; unless_p p_cf_ppp d_ddd_ssf
+(let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= (+ z (- y)) 2.1) (display (+ z (- y)))))))) (test (f1) 0)) ; cond p_cf_s p_pp_sf
;;; check an optimizer bug
(define _do_call_cc_end_ 1)
@@ -21457,6 +21621,7 @@ in s7:
(exit ctr)
(set! ctr 100) ctr)
#f))))))
+
(call-cc-do-test)
;;; and another
@@ -21466,10 +21631,10 @@ in s7:
(let ((chr (car nlst)))
(if (not (char-alphabetic? chr))
(if (not (char=? v chr))
- (format-logged #t ";(char-downcase #\\~A) -> ~A" chr v))
+ (format #t ";(char-downcase #\\~A) -> ~A" chr v))
(if (and (not (char=? chr v))
(not (char=? chr (char-upcase v))))
- (format-logged #t ";(char-downcase #\\~A) -> ~A~%" chr v))))))
+ (format #t ";(char-downcase #\\~A) -> ~A~%" chr v))))))
(result 0))
(let ((try 0))
(do ((i 0 (+ i 1)))
@@ -21477,11 +21642,11 @@ in s7:
(set! try i)
(checker '(#\a) #\a)
(checker '(#\a) #\a)))))
- (test (hi) ()))
+ (test (hi) #t))
(define (__a-func__ a)
- (format-logged #t ";oops called first a-func by mistake: ~A~%" a)
+ (format #t ";oops called first a-func by mistake: ~A~%" a)
(if (> a 0)
(__a-func__ (- a 1))))
@@ -21492,7 +21657,7 @@ in s7:
(__a-func__ 3)
(define (__c-func__ a)
- (format-logged #t ";oops called first __c-func__ by mistake: ~A~%" a)
+ (format #t ";oops called first __c-func__ by mistake: ~A~%" a)
(if (> a 0)
(__c-func__ (- a 1))))
@@ -22013,7 +22178,7 @@ in s7:
(test (let ((otherwise else)) (cond ((= 1 2) 1) (otherwise 3))) 3)
(test (let ((otherwise #t)) (cond ((= 1 2) 1) (otherwise 3))) 3) ; or actually anything... 12 for example
(test (let ((else #f)) (cond ((= 1 2) 1) (else 3))) #<unspecified>) ; was () -- 31-Dec-15
-(test (let ((else #f)) (cond ((= 1 2) 1) (#_else 3))) 3)
+;(test (let ((else #f)) (cond ((= 1 2) 1) (#_else 3))) 3) ; currently returns #<unspecified>
(test (let ((else 1)) (let ((otherwise else)) (case 0 (otherwise 1)))) 'error)
(test (let ((x 1)) (cond ((< x 0) 1))) #<unspecified>)
@@ -22043,7 +22208,7 @@ in s7:
(test (cond (else 1)) 1)
(test (call/cc (lambda (r) (cond ((r 4) 3) (else 1)))) 4)
(test (cond ((cond (#t 1)))) 1)
-(test (symbol? (cond (else else))) #f)
+(test (symbol? (cond (else else))) #t)
(test (equal? else (cond (else else))) #t)
(test (cond (#f 2) ((cond (else else)) 1)) 1)
(test (let ((x #f) (y #t)) (cond (x 1) (y 2))) 2)
@@ -22102,7 +22267,7 @@ in s7:
(test (cond (1 => + abs)) 'error)
(test (cond (1 =>)) 'error)
(test (cond ((values 1 2) => + abs)) 'error)
-(test (cond (else => symbol?)) #f) ; (symbol? else) -> #f
+(test (cond (else => symbol?)) #t) ; (symbol? else) -> #t
(test (eq? (cond (else => or)) else) #t)
(test (cond ((values #f 1) => or)) 1)
(test (+ (cond ((values 1 2 3)))) 6)
@@ -22176,7 +22341,7 @@ in s7:
(hi 1))
1)
(test (let ((x 0))
- (cond-expand (guile (format-logged #t ";oops~%"))
+ (cond-expand (guile (format #t ";oops~%"))
(else (set! x 32)))
x)
32)
@@ -22271,7 +22436,7 @@ in s7:
(test (let ((otherwise else)) (case 1 ((0) 123) (otherwise 321))) 321)
(test (case 1 ((0) 123) (#t 321)) 'error)
-(test (case else ((#f) 2) ((#t) 3) ((else) 4) (else 5)) 5) ; (eqv? 'else else) is #f (Guile says "unbound variable: else")
+(test (case else ((#f) 2) ((#t) 3) ((else) 4) (else 5)) 4) ; (eqv? 'else else) is #t (Guile says "unbound variable: else")
(test (case #t ((#f) 2) ((else) 4) (else 5)) 5) ; else is a symbol here
(test (equal? (case 0 ((0) else)) else) #t)
(test (cond ((case 0 ((0) else)) 1)) 1)
@@ -22333,8 +22498,6 @@ in s7:
(test (case #\newline ((#\newline) 1)) 1)
(test (case 'c (else => (lambda (x) (symbol? x)))) #t)
(test (case 1.0 ((1e0) 3) ((1.0) 4) (else 5)) 3)
-(test (case 1.0 ((#i1) 2) ((1e0) 3) ((1.0) 4) (else 5)) 2)
-(test (case 1 ((#i1) 2) ((1e0) 3) ((1.0) 4) (else 5)) 5)
(test (let ((x :a)) (case x ((:b) 1) ((:a) 0) (else 3))) 0)
(test (eval `(case ,+ ((,-) 0) ((,+) 1) (else 2))) 1)
@@ -22459,6 +22622,45 @@ in s7:
(let () (define (c1 s i) (case (string-ref s i) ((#\1)) ((#\2) 32))) (define (c3 s i) (c1 s i)) (c3 "0123" 1) (test (c3 "01234" 1) #\1))
(let () (define (c1 s i) (case s ((a)))) (define (c3 s i) (c1 s i)) (c3 "0123" 1) (test (c3 'a 1) 'a))
(let () (define (c1 s i) (case + ((-) 0) ((+)) ((#_+)) (else 3))) (define (c3 s i) (c1 s i)) (c3 "0123" 1) (test (c3 'a 1) +))
+(test (let () (define (f1) (let ((x 1)) (case 1 ((0) 0) ((1) 2) (else 3)))) (f1) (f1)) 2)
+(test (let () (define (f2) (let ((x 1)) (case x ((0) 0) ((1) 2) (else 3)))) (f2) (f2)) 2)
+(test (let () (define (f3) (let ((x 1)) (case (+ x (* x x) -1) ((0) 0) ((1) 2) (else 3)))) (f3) (f3)) 2)
+(test (let () (define (f11) (let ((x 2)) (case 2 ((0) 0) ((1) 2) (else 3)))) (f11) (f11)) 3)
+(test (let () (define (f12) (let ((x 2)) (case x ((0) 0) ((1) 2) (else 3)))) (f12) (f12)) 3)
+(test (let () (define (f13) (let ((x 2)) (case (+ x (abs (* x x))) ((0) 0) ((1) 2) (else 3)))) (f13) (f13)) 3)
+(test (let () (define (f21) (let ((x 2)) (case 2 ((0) 0) ((1) 2)))) (f21) (f21)) #<unspecified>)
+(test (let () (define (f22) (let ((x 2)) (case x ((0) 0) ((1) 2)))) (f22) (f22)) #<unspecified>)
+(test (let () (define (f23) (let ((x 2)) (case (+ x (abs (* x x))) ((0) 0) ((1) 2)))) (f23) (f23)) #<unspecified>)
+(test (let () (define (f31) (let ((x 'a)) (case x ((a) 0) ((b) 2) (else 3)))) (f31) (f31)) 0)
+(test (let () (define (f32) (let ((x '(a b))) (case (car x) ((a) 0) ((b) 2) (else 3)))) (f32) (f32)) 0)
+(test (let () (define (f33) (let ((x 'a)) (case (car (car (list (list x x)))) ((a) 0) ((b) 2) (else 3)))) (f33) (f33)) 0)
+(test (let () (define (f41) (let ((x 'c)) (case x ((a) 0) ((b) 2) (else 3)))) (f41) (f41)) 3)
+(test (let () (define (f42) (let ((x '(c b))) (case (car x) ((a) 0) ((b) 2) (else 3)))) (f42) (f42)) 3)
+(test (let () (define (f43) (let ((x 'c)) (case (car (car (list (list x x)))) ((a) 0) ((b) 2) (else 3)))) (f43) (f43)) 3)
+(test (let () (define (f51) (let ((x 'c)) (case x ((a) 0) ((b) 2)))) (f51) (f51)) #<unspecified>)
+(test (let () (define (f52) (let ((x '(c b))) (case (car x) ((a) 0) ((b) 2)))) (f52) (f52)) #<unspecified>)
+(test (let () (define (f53) (let ((x 'c)) (case (car (car (list (list x x)))) ((a) 0) ((b) 2)))) (f53) (f53)) #<unspecified>)
+(test (let () (define (f61) (let ((x 'a)) (case x ((a) 0) ((1) 2) (else 3)))) (f61) (f61)) 0)
+(test (let () (define (f62) (let ((x '(a b))) (case (car x) ((a) 0) ((1) 2) (else 3)))) (f62) (f62)) 0)
+(test (let () (define (f63) (let ((x 'a)) (case (car (car (list (list x x)))) ((a) 0) ((1) 2) (else 3)))) (f63) (f63)) 0)
+(test (let () (define (f71) (let ((x 'b)) (case x ((a) 0) ((1) 2) (else 3)))) (f71) (f71)) 3)
+(test (let () (define (f72) (let ((x '(b b))) (case (car x) ((a) 0) ((1) 2) (else 3)))) (f72) (f72)) 3)
+(test (let () (define (f73) (let ((x 'b)) (case (car (car (list (list x x)))) ((a) 0) ((1) 2) (else 3)))) (f73) (f73)) 3)
+(test (let () (define (f81) (let ((x 'b)) (case x ((a) 0) ((1) 2)))) (f81) (f81)) #<unspecified>)
+(test (let () (define (f82) (let ((x '(b b))) (case (car x) ((a) 0) ((1) 2)))) (f82) (f82)) #<unspecified>)
+(test (let () (define (f83) (let ((x 'b)) (case (car (car (list (list x x)))) ((a) 0) ((1) 2)))) (f83) (f83)) #<unspecified>)
+(test (let () (define (f91) (let ((x 'a)) (case x ((a) 0) ((b c) 2) (else 3)))) (f91) (f91)) 0)
+(test (let () (define (f92) (let ((x '(a b))) (case (car x) ((a) 0) ((b c) 2) (else 3)))) (f92) (f92)) 0)
+(test (let () (define (f93) (let ((x 'a)) (case (car (car (list (list x x)))) ((a) 0) ((b c) 2) (else 3)))) (f93) (f93)) 0)
+(test (let () (define (f101) (let ((x 'd)) (case x ((a) 0) ((b c) 2) (else 3)))) (f101) (f101)) 3)
+(test (let () (define (f102) (let ((x '(d b))) (case (car x) ((a) 0) ((b c) 2) (else 3)))) (f102) (f102)) 3)
+(test (let () (define (f103) (let ((x 'd)) (case (car (car (list (list x x)))) ((a) 0) ((b c) 2) (else 3)))) (f103) (f103)) 3)
+(test (let () (define (f111) (let ((x 'd)) (case x ((a) 0) ((b c) 2)))) (f111) (f111)) #<unspecified>)
+(test (let () (define (f112) (let ((x '(d b))) (case (car x) ((a) 0) ((b c) 2)))) (f112) (f112)) #<unspecified>)
+(test (let () (define (f113) (let ((x 'd)) (case (car (car (list (list x x)))) ((a) 0) ((b c) 2)))) (f113) (f113)) #<unspecified>)
+(test (let () (define (f121) (let ((x 'a)) (case x ((a) 0) ((b c 12) 2) (else 3)))) (f121) (f121)) 0)
+(test (let () (define (f122) (let ((x '(a b))) (case (car x) ((a) 0) ((b c 12) 2) (else 3)))) (f122) (f122)) 0)
+(test (let () (define (f123) (let ((x 'a)) (case (car (car (list (list x x)))) ((a) 0) ((b c 12) 2) (else 3)))) (f123) (f123)) 0)
;; newly optimized case
(let ((lt (inlet 'a 1 'b 2)))
@@ -22890,6 +23092,7 @@ in s7:
(test ((lambda . (x . (x))) 1) '(1))
(test ((lambda . ((x . ()) x)) 1) 1)
(test (eval-string "((lambda . (x 1 . 3)) 1)") 'error)
+(test (let () (define x (lambda . 1))) 'error)
(test (lambda 1) 'error)
(test (lambda (x 1) x) 'error)
@@ -22913,6 +23116,7 @@ in s7:
(test (lambda ((:hi . "hi") . "hi") 1) 'error)
(test ((lambda (x) (* quote ((x . 1) . 2))) 1) 'error)
(test ((lambda* (a (quote . -1)) a)) 'error)
+(test (let () (define x (lambda (= i 0) i))) 'error)
(test (let ((hi (lambda (a 0.0) (b 0.0) (+ a b)))) (hi)) 'error)
(test (object->string
@@ -23425,9 +23629,9 @@ in s7:
(test (let () (define (f f) f) (f 0)) 0)
(test (let () (define (f . f) f) (f 1 2)) '(1 2))
-(test (let () (define (f f) (define* (f1 (f f)) f) (f1)) (f 0)) 0)
-(test (let () (define (f1 f) (define* (f (f f)) f) (f)) (procedure? (f1 0))) #t) ; ?? see comment in s7.c -- this might also return 0
-(test (let () (define (f f) (define* (f (f f)) f) (f)) (procedure? (f 0))) #t)
+;(test (let () (define (f f) (define* (f1 (f f)) f) (f1)) (f 0)) 0)
+(test (let () (define (f1 f) (define* (f (f f)) f) (f)) (procedure? (f1 0))) #f) ; either way is fine...
+(test (let () (define (f f) (define* (f (f f)) f) (f)) (procedure? (f 0))) #f)
(test (let ((f1 (define f2 32))) (+ f1 f2)) 64)
(test (let () (define x (+ (define y 3) 2)) (list x y)) '(5 3))
(test (let ((a 1) (b 2)) (define (f a b) (let ((a a) (b b)) (+ a b))) (f 4 3)) 7)
@@ -23635,7 +23839,7 @@ in s7:
(not (= (cadr lst0) 0))
(> (abs (+ (car lst1) (sqrt 2))) .0001)
(> (abs (- (cadr lst1) (sqrt 3))) .0001))
- (format-logged #t ";cholesky decomp: ~A~%" lst))))
+ (format #t ";cholesky decomp: ~A~%" lst))))
(let () ; from Programming Praxis
(define (A k x1 x2 x3 x4 x5)
@@ -23698,7 +23902,7 @@ in s7:
(let ((nums (do ((lst () (cons i lst))
(i 0 (+ i 1)))
((> i n) (reverse lst)))))
- (format-logged #t "(let ((f~D (lambda (~{arg~D~^ ~})~% (+ ~{arg~D~^ ~}))))~% (f~D ~{~D~^ ~}))~%" n nums nums n nums)))
+ (format #t "(let ((f~D (lambda (~{arg~D~^ ~})~% (+ ~{arg~D~^ ~}))))~% (f~D ~{~D~^ ~}))~%" n nums nums n nums)))
|#
(test (let ((f128 (lambda (arg128 arg127 arg126 arg125 arg124 arg123 arg122 arg121 arg120 arg119 arg118 arg117 arg116 arg115 arg114 arg113 arg112 arg111 arg110 arg109 arg108 arg107 arg106 arg105 arg104 arg103 arg102 arg101 arg100 arg99 arg98 arg97 arg96 arg95 arg94 arg93 arg92 arg91 arg90 arg89 arg88 arg87 arg86 arg85 arg84 arg83 arg82 arg81 arg80 arg79 arg78 arg77 arg76 arg75 arg74 arg73 arg72 arg71 arg70 arg69 arg68 arg67 arg66 arg65 arg64 arg63 arg62 arg61 arg60 arg59 arg58 arg57 arg56 arg55 arg54 arg53 arg52 arg51 arg50 arg49 arg48 arg47 arg46 arg45 arg44 arg43 arg42 arg41 arg40 arg39 arg38 arg37 arg36 arg35 arg34 arg33 arg32 arg31 arg30 arg29 arg28 arg27 arg26 arg25 arg24 arg23 arg22 arg21 arg20 arg19 arg18 arg17 arg16 arg15 arg14 arg13 arg12 arg11 arg10 arg9 arg8 arg7 arg6 arg5 arg4 arg3 arg2 arg1 arg0)
@@ -23741,17 +23945,18 @@ in s7:
(define (f4 a b c d e) (list a b c d e))
(test (f4 1 2 3 4 5) '(1 2 3 4 5)))
-(define (redef-1 a) (+ a 1))
-(define (use-redef-1 b) (+ (redef-1 b) 2)) ; [use-redef](+ [redef-1](+ b 1) 2)
-(test (use-redef-1 3) 6) ; b=6
-(define (redef-1 a) (+ a 4))
-(test (use-redef-1 3) 9) ; [use-redef-1](+ [redef-1](+ a 4) 2), a=3
-(let ()
- (define (use-redef-2 c) (+ (redef-1 c) 5)) ; [use-redef-2](+ [redef-1](+ a 4) 5)
- (test (use-redef-2 6) 15) ; a=6
- (define (redef-1 a) (+ a 7)) ; so use-redef-1 is still [use-redef-1](+ [redef-1](+ a 4) 2)
- (test (use-redef-1 8) 14) ; a=8 -> 14
- (test (use-redef-2 8) 20)) ; but use-redef-2 (same let as shadowing use-redef-1) is (+ [new redef-1](+ a 7) 5), a=8 -> 20
+(let-temporarily (((*s7* 'safety) 2))
+ (define (redef-1 a) (+ a 1))
+ (define (use-redef-1 b) (+ (redef-1 b) 2)) ; [use-redef](+ [redef-1](+ b 1) 2)
+ (test (use-redef-1 3) 6) ; b=6
+ (define (redef-1 a) (+ a 4))
+ (test (use-redef-1 3) 9) ; [use-redef-1](+ [redef-1](+ a 4) 2), a=3
+ (let ()
+ (define (use-redef-2 c) (+ (redef-1 c) 5)) ; [use-redef-2](+ [redef-1](+ a 4) 5)
+ (test (use-redef-2 6) 15) ; a=6
+ (define (redef-1 a) (+ a 7)) ; so use-redef-1 is still [use-redef-1](+ [redef-1](+ a 4) 2)
+ (test (use-redef-1 8) 14) ; a=8 -> 14
+ (test (use-redef-2 8) 20))) ; but use-redef-2 (same let as shadowing use-redef-1) is (+ [new redef-1](+ a 7) 5), a=8 -> 20
(test (let () (define (f1 x) (abs x)) (define (f2 x) (f1 x)) (f2 -1)) 1) ; just trying to hit a portion of the s7 code
@@ -24451,9 +24656,10 @@ in s7:
(test (multiple-value-bind a (values 1 2 3) a) '(1 2 3))
(test (multiple-value-bind (x y z) (values 1 2 3) (list z y x)) '(3 2 1))
(test (multiple-value-bind (x y z) (values 1 2 3) (let ((x 4)) (list x y z))) '(4 2 3))
-(test (multiple-value-bind (x y z) (values 1 2 3 4 5 6) (list x y z)) 'error) ; was '(1 2 3)) -- 25-Jan-16
-(test (multiple-value-bind (x y z) (values 1 2) (list x y z)) 'error) ; was '(1 2 #f))
-(test (multiple-value-bind (x y z) (multiple-value-bind () (values 1 2) (values 'a 'b 'c)) (list x y z)) 'error) ;was '(a b c))
+(unless pure-s7
+ (test (multiple-value-bind (x y z) (values 1 2 3 4 5 6) (list x y z)) 'error) ; was '(1 2 3)) -- 25-Jan-16
+ (test (multiple-value-bind (x y z) (values 1 2) (list x y z)) 'error) ; was '(1 2 #f))
+ (test (multiple-value-bind (x y z) (multiple-value-bind () (values 1 2) (values 'a 'b 'c)) (list x y z)) 'error)) ;was '(a b c))
(test (let ((add (lambda (a b) (values (+ a 1) (+ b 1))))) (+ 1 (add 2 3))) 8)
(test (min (values 1 2) (values 3 0)) 0)
@@ -24702,19 +24908,19 @@ in s7:
(let ((__p__ 321))
(set! __p__ 432))
-(if (not (= __p__ 123)) (format-logged #t "__p__: ~A~%" __p__))
+(if (not (= __p__ 123)) (format #t "__p__: ~A~%" __p__))
(let ()
(define (args) (values __p__ (* __p__ 2)))
(let ((__p__ 0)
(q 1))
(call-with-values args (lambda (a b) (set! __p__ a) (set! q b)))
- (if (not (= __p__ 123)) (format-logged #t " local __p__: ~A~%" __p__))
+ (if (not (= __p__ 123)) (format #t " local __p__: ~A~%" __p__))
(set! __p__ 432)
(call-with-values args (lambda (__p__ q) (set! __p__ 321)))
- (if (not (= __p__ 432)) (format-logged #t " local __p__: ~A~%" __p__))))
+ (if (not (= __p__ 432)) (format #t " local __p__: ~A~%" __p__))))
-(if (not (= __p__ 123)) (format-logged #t "__p__: ~A~%" __p__))
+(if (not (= __p__ 123)) (format #t "__p__: ~A~%" __p__))
(let ()
(define-macro (args a b) `(values ,a ,b))
@@ -24725,32 +24931,32 @@ in s7:
(sp (args __p__ __p__))
(pq (args __p__ 567)))
-(if (not (= __p__ 123)) (format-logged #t "__p__: ~A~%" __p__))
+(if (not (= __p__ 123)) (format #t "__p__: ~A~%" __p__))
(let ((__p__ 321))
(eval '(set! __p__ 432) current-rootlet)
- (if (not (= __p__ 321)) (format-logged #t " local __p__: ~A~%" __p__))
+ (if (not (= __p__ 321)) (format #t " local __p__: ~A~%" __p__))
(eval '(set! __p__ 123))
- (if (not (= __p__ 123)) (format-logged #t " local __p__: ~A~%" __p__)))
+ (if (not (= __p__ 123)) (format #t " local __p__: ~A~%" __p__)))
-(if (not (= __p__ 432)) (format-logged #t "__p__: ~A~%" __p__))
+(if (not (= __p__ 432)) (format #t "__p__: ~A~%" __p__))
(let ()
(eval '(let ((__p__ 321)) (set! __p__ 456)) current-rootlet))
-(if (not (= __p__ 432)) (format-logged #t "__p__: ~A~%" __p__))
+(if (not (= __p__ 432)) (format #t "__p__: ~A~%" __p__))
(let ((__p__ (values __p__)))
- (if (not (= __p__ 432)) (format-logged #t " local __p__: ~A~%" __p__))
+ (if (not (= __p__ 432)) (format #t " local __p__: ~A~%" __p__))
(set! __p__ 123))
-(if (not (= __p__ 432)) (format-logged #t "__p__: ~A~%" __p__))
+(if (not (= __p__ 432)) (format #t "__p__: ~A~%" __p__))
(let ()
(define (sp __p__ q) (values __p__ q))
(call-with-values (lambda () (sp __p__ (* __p__ 2))) (let ((__p__ 1)) (lambda (a b) (set! __p__ a)))))
-(if (not (= __p__ 432)) (format-logged #t "__p__: ~A~%" __p__))
+(if (not (= __p__ 432)) (format #t "__p__: ~A~%" __p__))
(let ((lst (list __p__ (* __p__ 2))))
(define-macro (sp a) `(set! __p__ ,a))
@@ -24758,47 +24964,47 @@ in s7:
(q 1))
(define (pq a) (set! __p__ a))
(map sp (list __p__ q))
- (if (not (= __p__ 1)) (format-logged #t " local __p__: ~A~%" __p__))
+ (if (not (= __p__ 1)) (format #t " local __p__: ~A~%" __p__))
(for-each sp (list __p__ q))
- (if (not (= __p__ 1)) (format-logged #t " local __p__: ~A~%" __p__))
+ (if (not (= __p__ 1)) (format #t " local __p__: ~A~%" __p__))
(map sp lst)
- (if (not (= __p__ (* 432 2))) (format-logged #t " local __p__: ~A~%" __p__))
+ (if (not (= __p__ (* 432 2))) (format #t " local __p__: ~A~%" __p__))
(for-each sp lst)
- (if (not (= __p__ (* 432 2))) (format-logged #t " local __p__: ~A~%" __p__))
+ (if (not (= __p__ (* 432 2))) (format #t " local __p__: ~A~%" __p__))
(set! __p__ 0)
(set! q 1)
(map pq (list __p__ q))
- (if (not (= __p__ 1)) (format-logged #t " local __p__: ~A~%" __p__))
+ (if (not (= __p__ 1)) (format #t " local __p__: ~A~%" __p__))
(for-each pq (list __p__ q))
- (if (not (= __p__ 1)) (format-logged #t " local __p__: ~A~%" __p__))
+ (if (not (= __p__ 1)) (format #t " local __p__: ~A~%" __p__))
(map pq lst)
- (if (not (= __p__ (* 432 2))) (format-logged #t " local __p__: ~A~%" __p__))
+ (if (not (= __p__ (* 432 2))) (format #t " local __p__: ~A~%" __p__))
(for-each pq lst)
- (if (not (= __p__ (* 432 2))) (format-logged #t " local __p__: ~A~%" __p__))))
+ (if (not (= __p__ (* 432 2))) (format #t " local __p__: ~A~%" __p__))))
-(if (not (= __p__ 432)) (format-logged #t "__p__: ~A~%" __p__))
+(if (not (= __p__ 432)) (format #t "__p__: ~A~%" __p__))
(when (eq? (curlet) (rootlet))
(let ((__p__ 1))
(eval `(define (__p__ a) (+ a ,__p__)) current-rootlet)
- (if (not (= __p__ 1)) (format-logged #t " local __p__: ~A~%" __p__)))
+ (if (not (= __p__ 1)) (format #t " local __p__: ~A~%" __p__)))
- (if (not (procedure? __p__)) (format-logged #t "__p__: ~A~%" __p__))
- (if (not (= (__p__ 2) 3)) (format-logged #t "(__p__ 2): ~A~%" (__p__ 2)))
+ (if (not (procedure? __p__)) (format #t "__p__: ~A~%" __p__))
+ (if (not (= (__p__ 2) 3)) (format #t "(__p__ 2): ~A~%" (__p__ 2)))
(let ((__p__ 1))
(eval `(define __p__ 32))
- (if (not (= __p__ 32)) (format-logged #t " local __p__: ~A~%" __p__)))
+ (if (not (= __p__ 32)) (format #t " local __p__: ~A~%" __p__)))
- (if (not (procedure? __p__)) (format-logged #t "__p__: ~A~%" __p__))
- (if (not (= (__p__ 2) 3)) (format-logged #t "(__p__ 2): ~A~%" (__p__ 2)))
+ (if (not (procedure? __p__)) (format #t "__p__: ~A~%" __p__))
+ (if (not (= (__p__ 2) 3)) (format #t "(__p__ 2): ~A~%" (__p__ 2)))
(let ((__p__ 1))
(eval `(define __p__ 32) (curlet))
- (if (not (= __p__ 32)) (format-logged #t " local __p__: ~A~%" __p__)))
+ (if (not (= __p__ 32)) (format #t " local __p__: ~A~%" __p__)))
- (if (not (procedure? __p__)) (format-logged #t "__p__: ~A~%" __p__))
- (if (not (= (__p__ 2) 3)) (format-logged #t "(__p__ 2): ~A~%" (__p__ 2))))
+ (if (not (procedure? __p__)) (format #t "__p__: ~A~%" __p__))
+ (if (not (= (__p__ 2) 3)) (format #t "(__p__ 2): ~A~%" (__p__ 2))))
(let ()
(define-macro (m1) (values))
@@ -24813,6 +25019,39 @@ in s7:
(test (let () (m4) (+ a b)) 3)
(test (let () (m5 1 2) (+ a b)) 4))
+(let ((lst (list 1)))
+ (define (sf x y) (and (pair? x) (list x y)))
+ (define (mv x) (values x x))
+ (define (testsf)
+ (test (sf lst lst) '((1) (1)))
+ (test (sf (mv lst)) '((1) (1)))
+ (test (sf lst (mv lst)) 'error))
+ (testsf))
+
+(let ((lst (list 1)))
+ (define (sf x y) (and (pair? x) (pair? y)))
+ (define (mv x) (values x x))
+ (define (testsf)
+ (test (sf lst lst) #t)
+ (test (sf (mv lst)) #t)
+ (test (sf lst (mv lst)) 'error))
+ (testsf))
+
+(let ((lst (list 1)))
+ (define (sf x) (and (pair? x) (list x x)))
+ (define (mv x) (values x x))
+ (define (testsf)
+ (test (sf lst) '((1) (1)))
+ (test (sf (mv lst)) 'error))
+ (testsf))
+
+(let ((lst (list 1)))
+ (define (sf x) (and (pair? x) (pair? x)))
+ (define (mv x) (values x x))
+ (define (testsf)
+ (test (sf lst) #t)
+ (test (sf (mv lst)) 'error))
+ (testsf))
@@ -25036,6 +25275,13 @@ in s7:
(caller 1))
35)
+(let ()
+ (define (f)
+ (let ((f1 (lambda (arg) (+ arg 1))))
+ (let* ((x 32)
+ (f1 (lambda (arg) (f1 (+ x arg)))))
+ (f1 1))))
+ (test (f) 34))
(test (let* ((f1 3) (f1 4)) f1) 4)
(test (let ((f1 (lambda () 4))) (define (f1) 3) (f1)) 3)
@@ -25148,6 +25394,13 @@ in s7:
(test (let ((x 123)) (define (hi a) (+ x a)) (define x 0) (hi 1)) 1)
(test (let ((x 123) (y 0)) (define (hi a) (+ y a)) (define y x) (define x 0) (hi 1)) 124)
+(let () ; from scheme bboard
+ (define (make-accum n) (lambda* (m) (if m (set! n (+ n m)) n)))
+ (let ((x (make-accum 2)))
+ (test (x) 2) (test (x 1) 3) (test (x) 3)
+ (let ((y (make-accum 12))) (test (y) 12) (test (y 12) 24) (test (y) 24)
+ (test (x) 3))))
+
(for-each
(lambda (arg)
(test (let ((x arg)) x) arg))
@@ -25162,31 +25415,31 @@ in s7:
;(let ((initial-chars "aA!$%&*/:<=>?^_~")
; (subsequent-chars "9aA!$%&*+-./:<=>?@^_~")
; (ctr 0))
- ; (format-logged #t ";(let (")
+ ; (format #t ";(let (")
; (do ((i 0 (+ i 1)))
; ((= i (string-length initial-chars)))
- ; (format-logged #t ";(~A ~D) " (string (string-ref initial-chars i)) ctr)
+ ; (format #t ";(~A ~D) " (string (string-ref initial-chars i)) ctr)
; (set! ctr (+ ctr 1)))
;
; (do ((i 0 (+ i 1)))
; ((= i (string-length initial-chars)))
; (do ((k 0 (+ k 1)))
; ((= k (string-length subsequent-chars)))
- ; (format-logged #t ";(~A ~D) " (string (string-ref initial-chars i) (string-ref subsequent-chars k)) ctr)
+ ; (format #t ";(~A ~D) " (string (string-ref initial-chars i) (string-ref subsequent-chars k)) ctr)
; (set! ctr (+ ctr 1))))
;
- ; (format-logged #t ")~% (+ ")
+ ; (format #t ")~% (+ ")
; (do ((i 0 (+ i 1)))
; ((= i (string-length initial-chars)))
- ; (format-logged #t "~A " (string (string-ref initial-chars i))))
+ ; (format #t "~A " (string (string-ref initial-chars i))))
;
; (do ((i 0 (+ i 1)))
; ((= i (string-length initial-chars)))
; (do ((k 0 (+ k 1)))
; ((= k (string-length subsequent-chars)))
- ; (format-logged #t "~A " (string (string-ref initial-chars i) (string-ref subsequent-chars k)))))
+ ; (format #t "~A " (string (string-ref initial-chars i) (string-ref subsequent-chars k)))))
;
- ; (format-logged #t "))~%"))
+ ; (format #t "))~%"))
(num-test (let ((a 0) (A 1) (! 2) ($ 3) (% 4) (& 5) (| 8) (? 12) (^ 13) (_ 14) (~ 15) (a9 16) (aa 17) (aA 18) (a! 19) (a$ 20) (a% 21) (a& 22) (a* 23) (a+ 24) (a- 25) (a. 26) (a/ 27) (a| 28) (a< 29) (a= 30) (a> 31) (a? 32) (a@ 33) (a^ 34) (a_ 35) (a~ 36) (A9 37) (Aa 38) (AA 39) (A! 40) (A$ 41) (A% 42) (A& 43) (A* 44) (A+ 45) (A- 46) (A. 47) (A/ 48) (A| 49) (A< 50) (A= 51) (A> 52) (A? 53) (A@ 54) (A^ 55) (A_ 56) (A~ 57) (!9 58) (!a 59) (!A 60) (!! 61) (!$ 62) (!% 63) (!& 64) (!* 65) (!+ 66) (!- 67) (!. 68) (!/ 69) (!| 70) (!< 71) (!= 72) (!> 73) (!? 74) (!@ 75) (!^ 76) (!_ 77) (!~ 78) ($9 79) ($a 80) ($A 81) ($! 82) ($$ 83) ($% 84) ($& 85) ($* 86) ($+ 87) ($- 88) ($. 89) ($/ 90) ($| 91) ($< 92) ($= 93) ($> 94) ($? 95) ($@ 96) ($^ 97) ($_ 98) ($~ 99) (%9 100) (%a 101) (%A 102) (%! 103) (%$ 104) (%% 105) (%& 106) (%* 107) (%+ 108) (%- 109) (%. 110) (%/ 111) (%| 112) (%< 113) (%= 114) (%> 115) (%? 116) (%@ 117) (%^ 118) (%_ 119) (%~ 120) (&9 121) (&a 122) (&A 123) (&! 124) (&$ 125) (&% 126) (&& 127) (&* 128) (&+ 129) (&- 130) (&. 131) (&/ 132) (&| 133) (&< 134) (&= 135) (&> 136) (&? 137) (&@ 138) (&^ 139) (&_ 140) (&~ 141) (*9 142) (*a 143) (*A 144) (*! 145) (*$ 146) (*% 147) (*& 148) (** 149) (*+ 150) (*- 151) (*. 152) (*/ 153) (*| 154) (*< 155) (*= 156) (*> 157) (*? 158) (*@ 159) (*^ 160) (*_ 161) (*~ 162) (/9 163) (/a 164) (/A 165) (/! 166) (/$ 167) (/% 168) (/& 169) (/* 170) (/+ 171) (/- 172) (/. 173) (// 174) (/| 175) (/< 176) (/= 177) (/> 178) (/? 179) (/@ 180) (/^ 181) (/_ 182) (/~ 183) (|9 184) (ca 185) (CA 186) (|! 187) (|$ 188) (|% 189) (|& 190) (|* 191) (|+ 192) (|- 193) (|. 194) (|/ 195) (cc 196) (|< 197) (|= 198) (|> 199) (|? 200) (|@ 201) (|^ 202) (|_ 203) (|~ 204) (<9 205) (<a 206) (<A 207) (<! 208) (<$ 209) (<% 210) (<& 211) (<* 212) (<+ 213) (<- 214) (<. 215) (</ 216) (<| 217) (<< 218) (<> 220) (<? 221) (<@ 222) (<^ 223) (<_ 224) (<~ 225) (=9 226) (=a 227) (=A 228) (=! 229) (=$ 230) (=% 231) (=& 232) (=* 233) (=+ 234) (=- 235) (=. 236) (=/ 237) (=| 238) (=< 239) (== 240) (=> 241) (=? 242) (=@ 243) (=^ 244) (=_ 245) (=~ 246) (>9 247) (>a 248) (>A 249) (>! 250) (>$ 251) (>% 252) (>& 253) (>* 254) (>+ 255) (>- 256) (>. 257) (>/ 258) (>| 259) (>< 260) (>> 262) (>? 263) (>@ 264) (>^ 265) (>_ 266) (>~ 267) (?9 268) (?a 269) (?A 270) (?! 271) (?$ 272) (?% 273) (?& 274) (?* 275) (?+ 276) (?- 277) (?. 278) (?/ 279) (?| 280) (?< 281) (?= 282) (?> 283) (?? 284) (?@ 285) (?^ 286) (?_ 287) (?~ 288) (^9 289) (^a 290) (^A 291) (^! 292) (^$ 293) (^% 294) (^& 295) (^* 296) (^+ 297) (^- 298) (^. 299) (^/ 300) (^| 301) (^< 302) (^= 303) (^> 304) (^? 305) (^@ 306) (^^ 307) (^_ 308) (^~ 309) (_9 310) (_a 311) (_A 312) (_! 313) (_$ 314) (_% 315) (_& 316) (_* 317) (_+ 318) (_- 319) (_. 320) (_/ 321) (_| 322) (_< 323) (_= 324) (_> 325) (_? 326) (_@ 327) (_^ 328) (__ 329) (_~ 330) (~9 331) (~a 332) (~A 333) (~! 334) (~$ 335) (~% 336) (~& 337) (~* 338) (~+ 339) (~- 340) (~. 341) (~/ 342) (~| 343) (~< 344) (~= 345) (~> 346) (~? 347) (~@ 348) (~^ 349) (~_ 350) (~~ 351) )
(+ a A ! $ % & | ? ^ _ ~ a9 aa aA a! a$ a% a& a* a+ a- a. a/ a| a< a= a> a? a@ a^ a_ a~ A9 Aa AA A! A$ A% A& A* A+ A- A. A/ A| A< A= A> A? A@ A^ A_ A~ !9 !a !A !! !$ !% !& !* !+ !- !. !/ !| !< != !> !? !@ !^ !_ !~ $9 $a $A $! $$ $% $& $* $+ $- $. $/ $| $< $= $> $? $@ $^ $_ $~ %9 %a %A %! %$ %% %& %* %+ %- %. %/ %| %< %= %> %? %@ %^ %_ %~ &9 &a &A &! &$ &% && &* &+ &- &. &/ &| &< &= &> &? &@ &^ &_ &~ *9 *a *A *! *$ *% *& ** *+ *- *. */ *| *< *= *> *? *@ *^ *_ *~ /9 /a /A /! /$ /% /& /* /+ /- /. // /| /< /= /> /? /@ /^ /_ /~ |9 ca CA |! |$ |% |& |* |+ |- |. |/ cc |< |= |> |? |@ |^ |_ |~ <9 <a <A <! <$ <% <& <* <+ <- <. </ <| << <> <? <@ <^ <_ <~ =9 =a =A =! =$ =% =& =* =+ =- =. =/ =| =< == => =? =@ =^ =_ =~ >9 >a >A >! >$ >% >& >* >+ >- >. >/ >| >< >> >? >@ >^ >_ >~ ?9 ?a ?A ?! ?$ ?% ?& ?* ?+ ?- ?. ?/ ?| ?< ?= ?> ?? ?@ ?^ ?_ ?~ ^9 ^a ^A ^! ^$ ^% ^& ^* ^+ ^- ^. ^/ ^| ^< ^= ^> ^? ^@ ^^ ^_ ^~ _9 _a _A _! _$ _% _& _* _+ _- _. _/ _| _< _= _> _? _@ _^ __ _~ ~9 ~a ~A ~! ~$ ~% ~& ~* ~+ ~- ~. ~/ ~| ~< ~= ~> ~? ~@ ~^ ~_ ~~ ))
@@ -25368,6 +25621,9 @@ in s7:
(test (letrec* ((a 1) (a 2)) a) 'error)
(test (let* ((a 1) (a (+ a 1))) a) 2) ; ??
+(test (let* hi () . =>) 'error)
+(test (let hi () . =>) 'error)
+
(test (let hiho ((a 3) (hiho 4)) a) 3)
(test (let hiho ((hiho 4)) hiho) 4) ; guile=4
(test (let hiho ((hiho hiho)) hiho) 'error) ; guile sez error
@@ -26471,8 +26727,8 @@ in s7:
(test (call-with-exit (lambda arg ((car arg) 32)) "oops!") 'error)
(test (call-with-exit (lambda (a b) a)) 'error)
(test (call-with-exit (lambda (return) (apply return '(3)))) 3)
-(test (call-with-exit (lambda (return) (apply return (list (cons 1 2))) (format-logged #t "; call-with-exit: we shouldn't be here!"))) (cons 1 2))
-(test (call/cc (lambda (return) (apply return (list (cons 1 2))) (format-logged #t "; call/cc: we shouldn't be here!"))) (cons 1 2))
+(test (call-with-exit (lambda (return) (apply return (list (cons 1 2))) (format #t "; call-with-exit: we shouldn't be here!"))) (cons 1 2))
+(test (call/cc (lambda (return) (apply return (list (cons 1 2))) (format #t "; call/cc: we shouldn't be here!"))) (cons 1 2))
(test (procedure? (call-with-exit (lambda (return) (call-with-exit return)))) #t)
(test (call-with-exit (lambda (return) #f) 1) 'error)
(test (+ (call-with-exit ((lambda () (lambda (k) (k 1 2 3)))))) 6)
@@ -26513,6 +26769,14 @@ in s7:
(test (list val1 sum) '(4 4)))
(let ()
+ (define (fx ret)
+ (do ((n 0 (+ n 1)))
+ ((= n 6) n)
+ (if (> n 3)
+ (ret n))))
+ (test (call-with-exit fx) 4))
+
+(let ()
(define c #f)
(define (yow f)
(call-with-exit
@@ -26743,7 +27007,7 @@ in s7:
(for-each
(lambda (ques)
(if (ques a)
- (format-logged #t ";(~A ~A) returned #t?~%" ques a)))
+ (format #t ";(~A ~A) returned #t?~%" ques a)))
question-ops))
(test (let ((conts (make-vector 4 #f)))
@@ -26830,7 +27094,7 @@ in s7:
(#f)
(set! a (+ (* a1 tt) a2))
(set! b (+ (* tt b1) b2))
- ;(format-logged #t "~A ~A~%" a (- b a))
+ ;(format #t "~A ~A~%" a (- b a))
(if (or (<= (abs (- ux (/ a b))) err)
(> ctr 1000))
(return (/ a b)))
@@ -26865,11 +27129,11 @@ in s7:
(set! max-diff diff)
(set! max-case x))))
(if (> (abs (- r1 x)) (+ err epsilon))
- (format-logged #t "(rationalize ~A ~A) is off: ~A -> ~A~%" x err r1 (abs (- r1 x))))
+ (format #t "(rationalize ~A ~A) is off: ~A -> ~A~%" x err r1 (abs (- r1 x))))
(if (> (abs (- r2 x)) (+ err epsilon))
- (format-logged #t "(ratify ~A ~A) is off: ~A -> ~A~%" x err r2 (abs (- r2 x))))
+ (format #t "(ratify ~A ~A) is off: ~A -> ~A~%" x err r2 (abs (- r2 x))))
(if (< (denominator r2) (denominator r1))
- (format-logged #t "(ratify ~A ~A) is simpler? ~A ~A~%" x err r1 r2)))))))
+ (format #t "(ratify ~A ~A) is simpler? ~A ~A~%" x err r1 r2)))))))
(list max-case max-diff (cr max-case err)))
|#
@@ -27559,6 +27823,19 @@ who says the continuation has to restart the map from the top?
'(a b c d e f g b c d e f g h))
+(test (dynamic-wind
+ (lambda args
+ (if (not (null? args))
+ (format *stderr* "args: ~A~%": args)))
+ (lambda args
+ (if (not (null? args))
+ (format *stderr* "args: ~A~%": args))
+ args)
+ (lambda args
+ (if (not (null? args))
+ (format *stderr* "args: ~A~%": args))))
+ ())
+
(test (list (dynamic-wind
(lambda () #f)
(lambda () (values 'a 'b 'c))
@@ -28375,7 +28652,7 @@ who says the continuation has to restart the map from the top?
(lambda () (eval-string str))
(lambda args 'error))))
(if (not (eqv? val -1))
- (format-logged #t "~S = ~S?~%" str val))))
+ (format #t "~S = ~S?~%" str val))))
(list "( '(.1 -1)1)" "( - '`-00 1)" "( - .(,`1/1))" "( - .(`1) )" "( -(/ .(1)))" "( / 01 -1 )" "(' '` -1(/ ' 1))" "(' (-01 )0)"
"(' `'`` -1 1 01)" "(''-1 .(1))" "('(, -1 )0)" "('(,-1)'000)" "('(,-1)00)" "('(-1 -.0)0)" "('(-1 '1`)0)" "('(-1 .-/-)0)" "('(-1()),0)"
"('(-1) 0)" "('(10. -1 )1)" "(- '`1)" "(- `1 1 1)" "(- ' 1)" "(- ' 1)" "(- '1 .())" "(- '` ,``1)" "(- '` 1)" "(- '`, `1)" "(- '`,`1)"
@@ -28430,7 +28707,6 @@ who says the continuation has to restart the map from the top?
(do ((k 0 (+ k 1)))
((= k size))
(set! (str1 k) (str k)))))
- (set! (-s7-symbol-table-locked?) #t)
(if (and happy
(not (char=? (str1 1) #\))))
(catch #t
@@ -28440,8 +28716,7 @@ who says the continuation has to restart the map from the top?
(eqv? num -1))
(format *stderr* "~S ~%" str1))))
(lambda args
- 'error)))
- (set! (-s7-symbol-table-locked?) #f))))))
+ 'error))))))))
|#
(test (= 1 '+1 `+1 '`1 `01 ``1) #t)
@@ -28597,7 +28872,6 @@ who says the continuation has to restart the map from the top?
(test (sort! '(1 2 3) quasiquote) 'error)
(test (quasiquote . 1) 'error)
(test (let ((x 3)) (quasiquote . x)) 'error)
-(when (not pure-s7) (num-test `,#e.1 1/10))
(num-test `,,,-1 -1)
(num-test `,``,1 1)
(test (equal? ` 1 ' 1) #t)
@@ -28753,7 +29027,7 @@ who says the continuation has to restart the map from the top?
(let ((key (string->keyword str)))
(let ((newstr (symbol->string (keyword->symbol key))))
(if (not (string=? newstr str))
- (format-logged #t ";string->keyword -> string: ~S -> ~A -> ~S~%" str key newstr)))))))
+ (format #t ";string->keyword -> string: ~S -> ~A -> ~S~%" str key newstr)))))))
(let ()
(define* (hi a b) (+ a b))
@@ -28882,10 +29156,10 @@ who says the continuation has to restart the map from the top?
(if (eq? p 's7test)
(set! count (+ count 1)))
(if (not (provided? p))
- (format-logged #t ";~A is in *features* but not provided? ~A~%" p *features*)))
+ (format #t ";~A is in *features* but not provided? ~A~%" p *features*)))
*features*)
(if (not (= count 1))
- (format-logged #t ";*features* has ~D 's7test entries? ~A~%" count *features*)))
+ (format #t ";*features* has ~D 's7test entries? ~A~%" count *features*)))
(test (let ((*features* 123)) (provided? 's7)) #t)
@@ -28910,7 +29184,7 @@ who says the continuation has to restart the map from the top?
(for-each
(lambda (p)
(if (eq? p last)
- (format-logged #t ";*features has multiple ~A? ~A~%" p *features*))
+ (format #t ";*features has multiple ~A? ~A~%" p *features*))
(set! last p))
f)))
@@ -28950,6 +29224,32 @@ who says the continuation has to restart the map from the top?
(test (set! *load-path* (list 1 2 3)) 'error)
(set! *#readers* old-readers)
+(define old-safety (*s7* 'safety))
+(set! (*s7* 'safety) 4)
+
+ (let ((v #(1 2 3))
+ (iv #i(1 2 3))
+ (rv #r(1.0 2.0 3.0))
+ (str "123")
+ (pair '(1 2 3)))
+ (test (sort! v <) 'error)
+ (test (sort! iv <) 'error)
+ (test (sort! rv <) 'error)
+ (test (sort! str char<?) 'error)
+ (test (sort! pair <) 'error)
+ (test (reverse! v) 'error)
+ (test (reverse! iv) 'error)
+ (test (reverse! rv) 'error)
+ (test (reverse! str) 'error)
+ (test (reverse! pair) 'error)
+ (test (fill! v 0) 'error)
+ (test (fill! iv 0) 'error)
+ (test (fill! rv 0.0) 'error)
+ (test (fill! str #\a) 'error)
+ (test (fill! pair 0) 'error))
+
+(set! (*s7* 'safety) old-safety)
+
;;; (*s7* 'print-length)
(test (integer? (*s7* 'print-length)) #t)
@@ -29247,7 +29547,7 @@ who says the continuation has to restart the map from the top?
((= i 999) #t)
(if (< (v i) (v (+ i 1)))
(begin
- (format-logged #t "random vals after sort: ~A ~A~%" (v i) (v (+ i 1)))
+ (format #t "random vals after sort: ~A ~A~%" (v i) (v (+ i 1)))
(return #f)))))))
#t)
@@ -29257,7 +29557,7 @@ who says the continuation has to restart the map from the top?
(set! v (cons (random 100.0) v)))
(set! v (sort! v >))
(if (not (apply >= v))
- (format-logged #t ";sort!: v not sorted by >: ~A~%" )))
+ (format #t ";sort!: v not sorted by >: ~A~%" )))
(test (sort! (list 3 2 1) (lambda (m n) (let ((vals (sort! (list m n) <))) (< m n)))) '(1 2 3))
@@ -29283,7 +29583,7 @@ who says the continuation has to restart the map from the top?
(let ((v1 (copy v)))
(sort! v <)
(if (not (apply < (vector->list v)))
- (format-logged #t ";(sort! ~A <) -> ~A?" v1 v)))))
+ (format #t ";(sort! ~A <) -> ~A?" v1 v)))))
(test (sort!) 'error)
(test (sort! '(1 2 3) < '(3 2 1)) 'error)
@@ -29363,7 +29663,7 @@ who says the continuation has to restart the map from the top?
(lambda () (sort! '(1 2 "hi" 3) <))
(lambda () (set! ok #t))))
(lambda args 'error))
- (if (not ok) (format-logged #t "dynamic-wind out of sort! skipped cleanup?~%")))
+ (if (not ok) (format #t "dynamic-wind out of sort! skipped cleanup?~%")))
(test (let ((v (float-vector 1 2 3))) (sort! v (lambda (a b) (call-with-exit (lambda (r) (> a b))))) v) (float-vector 3 2 1))
(test (let ((v (int-vector 1 2 3))) (sort! v (lambda (a b) (call-with-exit (lambda (r) (> a b))))) v) (int-vector 3 2 1))
@@ -29380,7 +29680,7 @@ who says the continuation has to restart the map from the top?
#t)))
(lambda args (car args)))))
(if (not (eq? val 'sort-error))
- (format-logged #t ";sort! with error: ~A~%" val)))
+ (format #t ";sort! with error: ~A~%" val)))
(let ((val (call-with-exit
(lambda (return)
@@ -29389,7 +29689,7 @@ who says the continuation has to restart the map from the top?
(if (< a b) (return 'sort-error))
#t))))))
(if (not (eq? val 'sort-error))
- (format-logged #t ";sort! call-with-exit: ~A~%" val)))
+ (format #t ";sort! call-with-exit: ~A~%" val)))
(let ((val (call/cc
(lambda (return)
@@ -29398,10 +29698,141 @@ who says the continuation has to restart the map from the top?
(if (< a b) (return 'sort-error))
#t))))))
(if (not (eq? val 'sort-error))
- (format-logged #t ";sort! call/cc: ~A~%" val))))
+ (format #t ";sort! call/cc: ~A~%" val))))
(let-temporarily (((*s7* 'safety) 1))
- (test (sort! #(1 2 3) (lambda (a b) (and #t (= a b)))) 'error))
+ (define (f1 x) (let ((y x)) y))
+ (define (_sort_)
+ (sort! #(1 2 3) (lambda (a b) (f1 (= a b)))))
+ (test (_sort_) 'error))
+
+(let ((size 100))
+
+ (define (less a b)
+ (< a b))
+ (define (car-less a b)
+ (< (car a) (car b)))
+
+ (define (check-numbers vc)
+ (do ((i 1 (+ i 1))
+ (x (vc 0))
+ (y (vc 1)))
+ ((or (= i (- size 1))
+ (and (> x y)
+ (or (format *stderr* "~A > ~A?~%" x y) #t))))
+ (set! x y)
+ (set! y (vc (+ i 1)))))
+
+ (define (check-chars vc)
+ (do ((i 1 (+ i 1))
+ (x (vc 0))
+ (y (vc 1)))
+ ((or (= i (- size 1))
+ (and (char>? x y)
+ (or (format *stderr* "~A > ~A?~%" x y) #t))))
+ (set! x y)
+ (set! y (vc (+ i 1)))))
+
+ (define (check-strings vc)
+ (do ((i 1 (+ i 1))
+ (x (vc 0))
+ (y (vc 1)))
+ ((or (= i (- size 1))
+ (and (string>? x y)
+ (or (format *stderr* "~A > ~A?~%" x y) #t))))
+ (set! x y)
+ (set! y (vc (+ i 1)))))
+
+ (let ((v (make-vector size)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (vector-set! v i (random 1.0)))
+ (let ((vc (copy v)))
+ (sort! vc <)
+ (check-numbers vc))
+ (let ((vc (copy v)))
+ (sort! vc less)
+ (check-numbers vc))
+ (sort! v (lambda (a b) (< a b)))
+ (check-numbers v))
+
+ (let ((v (make-float-vector size)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (vector-set! v i (random 100.0)))
+ (let ((vc (copy v)))
+ (sort! vc <)
+ (check-numbers vc))
+ (let ((vc (copy v)))
+ (sort! vc less)
+ (check-numbers vc))
+ (sort! v (lambda (a b) (< a b)))
+ (check-numbers v))
+
+ (let ((v (make-int-vector size)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (vector-set! v i (random 10000000)))
+ (let ((vc (copy v)))
+ (sort! vc <)
+ (check-numbers vc))
+ (let ((vc (copy v)))
+ (sort! vc less)
+ (check-numbers vc))
+ (sort! v (lambda (a b) (< a b)))
+ (check-numbers v))
+
+ (let ((v (make-vector size)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (vector-set! v i (string (integer->char (random 256)) (integer->char (random 256)))))
+ (let ((vc (copy v)))
+ (sort! vc string<?)
+ (check-strings vc))
+ (sort! v (lambda (a b) (string<? a b)))
+ (check-strings v)
+
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (vector-set! v i (integer->char (random 256))))
+ (let ((vc (copy v)))
+ (sort! vc char<?)
+ (check-chars vc))
+ (sort! v (lambda (a b) (char<? a b)))
+ (check-chars v)
+
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (vector-set! v i (cons (random 1.0) (random 100000))))
+ (let ((vc (copy v)))
+ (sort! vc (lambda (a b) (< (car a) (car b))))
+ (do ((i 1 (+ i 1))
+ (x (car (vc 0)))
+ (y (car (vc 1))))
+ ((or (= i (- size 1))
+ (and (> x y)
+ (or (format *stderr* "~A > ~A?~%" x y) #t))))
+ (set! x y)
+ (set! y (car (vc (+ i 1))))))
+ (let ((vc (copy v)))
+ (sort! vc car-less)
+ (do ((i 1 (+ i 1))
+ (x (car (vc 0)))
+ (y (car (vc 1))))
+ ((or (= i (- size 1))
+ (and (> x y)
+ (or (format *stderr* "~A > ~A?~%" x y) #t))))
+ (set! x y)
+ (set! y (car (vc (+ i 1))))))
+ (sort! v (lambda (a b) (< (cdr a) (cdr b))))
+ (do ((i 1 (+ i 1))
+ (x (cdr (v 0)))
+ (y (cdr (v 1))))
+ ((or (= i (- size 1))
+ (and (> x y)
+ (or (format *stderr* "~A > ~A?~%" x y) #t))))
+ (set! x y)
+ (set! y (cdr (v (+ i 1)))))))
;;; --------------------------------------------------------------------------------
@@ -29469,6 +29900,8 @@ who says the continuation has to restart the map from the top?
(test (catch-test-1 'a2) '(a1 a2))
(test (catch-test-1 'a3) '(a1 a2 a3))
(test (catch-test-1 'a4) '(a1 a2 a3 a4))
+(test (procedure? (catch #t make-hook /)) #t)
+(test (catch #t (lambda* (:rest a) a) /) ())
(test (catch #t (catch #t (lambda () (lambda () 1)) (lambda args 'oops)) (lambda args 'error)) 1)
(test (catch #t (catch #t (lambda () (error 'oops)) (lambda args (lambda () 1))) (lambda args 'error)) 1)
@@ -29779,7 +30212,7 @@ who says the continuation has to restart the map from the top?
(lambda args (cadr args)))
'(1 2 3)))
(lambda args
- (format-logged #t "~A not caught~%" (car args)))))
+ (format #t "~A not caught~%" (car args)))))
(list #\a 'a-symbol #f #t abs #<unspecified>))
(test (let ((e #f))
@@ -29841,14 +30274,14 @@ who says the continuation has to restart the map from the top?
(lambda (tag)
(let ((val (catch tag (lambda () (error tag "an error") 123) (lambda args (car args)))))
(if (not (equal? tag val))
- (format-logged #t ";catch ~A -> ~A~%" tag val))))
+ (format #t ";catch ~A -> ~A~%" tag val))))
(list :hi () #() #<eof> #f #t #<unspecified> car #\a 32 9/2))
(for-each
(lambda (tag)
(let ((val (catch #t (lambda () (error tag "an error") 123) (lambda args (car args)))))
(if (not (equal? tag val))
- (format-logged #t ";catch #t (~A) -> ~A~%" tag val))))
+ (format #t ";catch #t (~A) -> ~A~%" tag val))))
(list :hi () #<eof> #f #t #<unspecified> car #\a 32 9/2 '(1 2 3) '(1 . 2) #(1 2 3) #()))
(for-each
@@ -29860,13 +30293,13 @@ who says the continuation has to restart the map from the top?
;; (error <string>...) throws 'no-catch which makes it harder to check
(let ((val (catch #t (lambda () (error "hi") 123) (lambda args (car args)))))
(if (not (eq? val 'no-catch))
- (format-logged #t ";catch #t, tag is string -> ~A~%" val)))
+ (format #t ";catch #t, tag is string -> ~A~%" val)))
(for-each
(lambda (tag)
(let ((val (catch tag (lambda () (error #t "an error") 123) (lambda args (car args)))))
(if (not (equal? #t val))
- (format-logged #t ";catch ~A -> ~A (#t)~%" tag val))))
+ (format #t ";catch ~A -> ~A (#t)~%" tag val))))
(list :hi () #<eof> #f #t #<unspecified> car #\a 32 9/2))
(let ((tag 'tag)) (test (catch (let () tag) (lambda () (set! tag 123) (error 'tag "tag") tag) (lambda args (car args))) 'tag))
@@ -30054,7 +30487,7 @@ who says the continuation has to restart the map from the top?
(let ((val (first_even '(1 3 5 6 7 8 9))))
(if (not (equal? val (list 6)))
- (format-logged #t "first_even (tagbody, gensym, reverse!) (6): '~A~%" val)))
+ (format #t "first_even (tagbody, gensym, reverse!) (6): '~A~%" val)))
)
#|
@@ -30082,6 +30515,129 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (hi :b 1) 'error))
+(let ()
+ (define* (f0) #f)
+ (test (f0) #f)
+ (test (f0 :a) 'error))
+
+(let ()
+ (define* (f00 a :allow-other-keys) a)
+ (test (f00) #f)
+ (test (f00 :a) 'error) ; key needs value
+ (test (f00 :a 1) 1)
+ (test (let ((x 0)) (f00 :b (set! x 1)) x) 1)
+ (test (f00 :a 1 :b :c :d 2) 1))
+
+(let ()
+ (define* (f000 :rest a) a) ; rest argname is not a keyword argname
+ (test (f000 :a) '(:a))
+ (test (f000 :a 1) '(:a 1))
+ (test (f000 1) '(1))
+ (test (f000 1 :a 2) '(1 :a 2)))
+
+(let ()
+ (define* (f1 (a 0)) a)
+ ;;; (define (f2 x) (f1 x))
+ (test (f1) 0)
+ (test (f1 :a) 'error)
+ (test (f1 :a 1) 1)
+ (test (f1 :a :b) :b)
+ (test (f1 :a :a) :a)
+ (test (f1 :b) 'error)
+ (test (f1 :a 0 :a) 'error)
+ (test (f1 :a 0 :a 1) 'error)
+ (test (f1 0) 0)
+ (test (f1 0 :a) 'error)
+ (test (f1 0 :a 1) 'error)
+ (test (f1 'a) 'a)
+ (test (f1 ':a) 'error)
+ (test (f1 '':a) '':a)
+ (test (f1 ':a 0) 0)
+ (test (f1 a: 0) 0)
+ (let ((x :a))
+ (test (f1 x 0) 0)
+ (test (f1 x) 'error)
+ (test (apply f1 (list x 0)) 0)
+ (test (apply f1 '(x)) 'x)
+ (test (apply f1 '(:a)) 'error))
+ (let ((x :b))
+ (test (f1 x) 'error))
+ (let ((mk (lambda () :a)))
+ (test (f1 (mk)) 'error)
+ (test (f1 (mk) 0) 0)
+ (test (f1 (mk) (mk)) (mk)) ;!
+ (test (apply f1 (list (mk) 0)) 0)))
+
+(let ()
+ (define* (f1u (a 0)) (car (member a (list a) (lambda (a b) a))))
+ ;;; (define (f2 x) (f1u x))
+ (test (f1u) 0)
+ (test (f1u :a) 'error)
+ (test (f1u :a 1) 1)
+ (test (f1u :a :b) :b)
+ (test (f1u :a :a) :a)
+ (test (f1u :b) 'error)
+ (test (f1u :a 0 :a) 'error)
+ (test (f1u :a 0 :a 1) 'error)
+ (test (f1u 0) 0)
+ (test (f1u 0 :a) 'error)
+ (test (f1u 0 :a 1) 'error)
+ (test (f1u 'a) 'a)
+ (test (f1u ':a) 'error)
+ (test (f1u '':a) '':a)
+ (test (f1u ':a 0) 0)
+ (test (f1u a: 0) 0)
+ (let ((x :a))
+ (test (f1u x 0) 0)
+ (test (f1u x) 'error)
+ (test (apply f1u (list x 0)) 0)
+ (test (apply f1u '(x)) 'x)
+ (test (apply f1u '(:a)) 'error))
+ (let ((x :b))
+ (test (f1u x) 'error))
+ (let ((mk (lambda () :a)))
+ (test (f1u (mk)) 'error)
+ (test (f1u (mk) 0) 0)
+ (test (f1u (mk) (mk)) (mk)) ;!
+ (test (apply f1u (list (mk) 0)) 0)))
+
+(let ((x 1))
+ (define fx (lambda* ((a (+ x 1)) (b (let ((y (+ x 1))) (+ y 1)))) (list a b)))
+ (define* (fy (a (* x 2)) (b (fx :a 1 :b 2))) (list a b))
+ (test (fx) '(2 3))
+ (test (fy) '(2 (1 2)))
+ (test (fy :a 0) '(0 (1 2))))
+
+(let ()
+ (define* (f a (b :c)) b)
+ (test (f :b 1 :d) 'error))
+
+(let ()
+ (define* (f1a (a :a)) a)
+ (test (f1a) :a))
+
+(let ()
+ (define* (f2 (a 0) (b 1)) (list a b))
+ (test (f2 :a) 'error)
+ (test (f2 :a 1 :b) 'error)
+ (test (f2 :a 1 :b 1 :c) 'error)
+ (test (f2 (car '(:a)) 2) '(2 1))
+ (test (f2 :b 2) '(0 2))
+ (test (f2 :a 2) '(2 1))
+ (test (f2 :a 1 :b 2) '(1 2))
+ (test (let ((x :a)) (f2 x 2)) '(2 1))
+ (test (let ((x :a)) (f2 x x)) '(:a 1)) ; (f2 :a :a) so a=:a b=1
+ (test (let ((x -1) (y :a)) (f2 y x)) '(-1 1))
+ (test (let ((x 3) (y :b)) (f2 y x)) '(0 3))
+ (test (let ((x 3) (y :c)) (f2 y x)) 'error)
+ (test (let ((x 3) (y :c)) (f2 x y)) 'error))
+
+(let ()
+ (define* (f3 (a :a) (b :a)) (list a b))
+ (test (f3 :a) 'error)
+ (test (f3) '(:a :a))
+ (test (f3 :b 1) '(:a 1))) ; default value is a value not a keyword-as-parameter-indicator
+
(let ((hi (lambda* ((a 1)) a)))
(test (hi 2) 2)
(test (hi) 1)
@@ -30242,7 +30798,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (keyword? :rest) #t)
(test (eq? :rest ':rest) #t)
-(test (let () (define* (f (a :b)) a) (list (f) (f 1) (f :c) (f :a :c) (f :a 1) (f))) '(:b 1 :c :c 1 :b))
+(test (let () (define* (f (a :b)) a) (list (f) (f 1) (f :a :c) (f :a 1) (f))) '(:b 1 :c 1 :b))
(test (let () (define* (f a (b :c)) b) (f :b 1 :d)) 'error)
(test ((lambda* (:rest (b 1)) b)) 'error) ; "lambda* :rest parameter can't have a default value." ?
(test ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ a (* b 3)))) c)))) 7)
@@ -30371,6 +30927,25 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (-nxy- g) 0.0))
#|
+(let ()
+ ;; quoted arg default bug (from K Matheussen)
+ ;; why is this sometimes an error and other times not??
+ (define make-event
+ (lambda* ((patternnum 'must-be-defined) (channel 'must-be-defined))
+ (if #f (throw "strange"))))
+ (define (call-make-event a b)
+ (make-event a b))
+ (call-make-event :a 0))
+|#
+
+(let ((x 1))
+ (define fx (lambda* ((a (+ x 1)) (b (let ((y (+ x 1))) (+ y 1)))) (list a b)))
+ (define* (fy (a (* x 2)) (b (fx :a 1 :b 2))) (list a b))
+ (test (fx) '(2 3))
+ (test (fy) '(2 (1 2)))
+ (test (fy :a 0) '(0 (1 2))))
+
+#|
(let ((choices (list "a " "b " " . " ":rest " ":allow-other-keys "))
(args (list "1 " ":a " ":b " ":c ")))
@@ -30383,9 +30958,9 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(catch #t
(lambda ()
(let ((val (eval-string expr)))
- (format-logged #t "~A -> ~A~%" expr val)))
+ (format #t "~A -> ~A~%" expr val)))
(lambda args
- ;(format-logged #t " ~A: ~A~%" expr (apply format #f (cadr args)))
+ ;(format #t " ~A: ~A~%" expr (apply format #f (cadr args)))
'error)))
(if (< n 6)
@@ -30432,11 +31007,11 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test ((lambda* (:rest a b ) (list a b)) 1 1) '((1 1) 1))
(test ((lambda* (:rest a :rest b ) (list a b)) :a 1) '((:a 1) (1)))
(test ((lambda* (:allow-other-keys) #f) :c 1) 'error)
-(test ((lambda* (a :allow-other-keys) a) :a) :a)
-(test ((lambda* (a) a) :a) :a)
+(test ((lambda* (a :allow-other-keys) a) :a) 'error)
+(test ((lambda* (a) a) :a) 'error)
(test ((lambda* (a :allow-other-keys) a) :a 1 :a 2) 1) ; this is very tricky to catch
(test ((lambda* (a :allow-other-keys) a) :c :c :c :c) #f)
-(test ((lambda* (a :allow-other-keys) a) :c) :c)
+(test ((lambda* (a :allow-other-keys) a) :c) 'error)
(test ((lambda* (a b :allow-other-keys ) (list a b)) :b :a :c 1) '(#f :a))
(test ((lambda* (a :allow-other-keys ) a) :c 1 1) 1) ; ??
@@ -30787,7 +31362,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
`(and ,@(map (lambda (arg) `(,function ,arg)) args)))
(let ((lst ()))
- (and-call (lambda (a) (and a (set! lst (cons a lst)))) (+ 1 2) #\a #f (format-logged #t "oops!~%"))
+ (and-call (lambda (a) (and a (set! lst (cons a lst)))) (+ 1 2) #\a #f (format #t "oops!~%"))
(test lst (list #\a 3))))
(let ()
@@ -30820,12 +31395,12 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(let ((res ((if free add-1 add-2) (+ 1 2 3))))
(if (or (not (equal? val '(+ 1 2 3)))
(not (= res 7)))
- (format-logged #t ";mac/proc[#t]: ~A ~A~%" val res)))
+ (format #t ";mac/proc[#t]: ~A ~A~%" val res)))
(set! free #f)
(let ((res ((if free add-1 add-2) (+ 1 2 3))))
(if (or (not (equal? val '6))
(not (= res 7)))
- (format-logged #t ";mac/proc[#f]: ~A ~A~%" val res)))))
+ (format #t ";mac/proc[#f]: ~A ~A~%" val res)))))
;; define-macro* default arg expr does not see definition-time closure:
(test (let ((mac #f))
@@ -31078,13 +31653,13 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(y2 (mac-y2))
(y3 (mac-y3)))
(if (not (morally-equal? y0 y1))
- (format-logged #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) 'mac-y0 y0 y1))
+ (format #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) 'mac-y0 y0 y1))
(if (not (morally-equal? y2 y3))
- (format-logged #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) 'mac-y2 y2 y3)))
+ (format #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) 'mac-y2 y2 y3)))
(let ((y (+ (mac-y0) (mac-y1) (mac-y2) (mac-y3))))
(if (> (abs (- y (* 4 9.5))) 1e-9)
- (format-logged #t "(2) ~A: ~A got ~S but expected ~S~%~%" (port-line-number) 'mac-y0 y (* 4 9.5)))))
+ (format #t "(2) ~A: ~A got ~S but expected ~S~%~%" (port-line-number) 'mac-y0 y (* 4 9.5)))))
(let ((val 0))
(let ()
@@ -31124,14 +31699,14 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(for-each
(lambda (arg)
(if (aritable? arg 0)
- (format-logged #t ";(aritable? ~A) -> #t?~%" arg)))
+ (format #t ";(aritable? ~A) -> #t?~%" arg)))
(list :hi (integer->char 65) 1 #t 3.14 3/4 1.0+1.0i #\f #<eof> #<unspecified>))
(for-each
(lambda (arg)
(let ((val (catch #t (lambda () (aritable? abs arg)) (lambda args 'error))))
(if (not (eq? val 'error))
- (format-logged #t ";(aritable? abs ~A) -> ~A?~%" arg val))))
+ (format #t ";(aritable? abs ~A) -> ~A?~%" arg val))))
(list :hi (integer->char 65) -1 most-negative-fixnum macroexpand quasiquote (lambda () #f)
car #() "hi" (list 1 2) 3.14 3/4 1.0+1.0i #\f #<eof> #<unspecified>))
@@ -31209,7 +31784,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(for-each
(lambda (arg)
(if (arity arg)
- (format-logged #t ";(arity ~A) -> ~A?~%" arg (arity arg))))
+ (format #t ";(arity ~A) -> ~A?~%" arg (arity arg))))
(list :hi (integer->char 65) 1 #t 3.14 3/4 1.0+1.0i #\f #<eof> #<unspecified> #<undefined> () 'a))
@@ -31310,7 +31885,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(catch #t
(lambda ()
(let ((min-max (arity func)))
- (format-logged #t "(test (arity ~A) ~70T'~A)~%" sym min-max)
+ (format #t "(test (arity ~A) ~70T'~A)~%" sym min-max)
(if min-max
(begin
(if (> (cdr min-max) 6)
@@ -31318,19 +31893,19 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(do ((i 0 (+ i 1)))
((= i (car min-max)))
(if (aritable? func i)
- (format-logged #t ";~A: arity: ~A, arg: ~A?~%" sym min-max i)))
+ (format #t ";~A: arity: ~A, arg: ~A?~%" sym min-max i)))
(do ((i (car min-max) (+ i 1)))
((> i (cdr min-max)))
(if (not (aritable? func i))
- (format-logged #t ";~A: arity: ~A, arg: ~A?~%" sym min-max i)))
+ (format #t ";~A: arity: ~A, arg: ~A?~%" sym min-max i)))
(do ((i (+ 1 (cdr min-max)) (+ i 1)))
((>= i 6))
(if (aritable? func i)
- (format-logged #t ";~A: arity: ~A, arg: ~A?~%" sym min-max i)))
+ (format #t ";~A: arity: ~A, arg: ~A?~%" sym min-max i)))
))))
(lambda args
- (format-logged #t " ~A: ~A~%" sym (apply format #f (cadr args)))
+ (format #t " ~A: ~A~%" sym (apply format #f (cadr args)))
'error)))))
st))
|#
@@ -31362,7 +31937,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (arity pi) '#f)
(test (arity or) (cons 0 *max-arity*))
(test (arity *stdin*) '#f)
-(test (arity complex) '(2 . 2))
+(test (arity complex) '(2 . 2))
(test (arity values) (cons 0 *max-arity*))
(test (arity string->number) '(1 . 2))
(test (arity most-negative-fixnum) '#f)
@@ -31370,12 +31945,14 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (arity char->integer) '(1 . 1))
(test (arity vector) (cons 0 *max-arity*))
(test (arity call/cc) '(1 . 1))
-(when (not pure-s7) (test (arity set-current-input-port) '(1 . 1)))
+(when (not pure-s7)
+ (test (arity set-current-input-port) '(1 . 1)))
(test (arity current-input-port) '(0 . 0))
(test (arity write) '(1 . 2))
(test (arity zero?) '(1 . 1))
(test (arity char<?) (cons 2 *max-arity*))
-(test (arity char-ci<?) (cons 2 *max-arity*))
+(when (not pure-s7)
+ (test (arity char-ci<?) (cons 2 *max-arity*)))
(test (arity infinite?) '(1 . 1))
(test (arity open-input-file) '(1 . 2))
(test (arity with-let) (cons 1 *max-arity*))
@@ -31397,7 +31974,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (arity append) (cons 0 *max-arity*))
(test (arity list-ref) (cons 2 *max-arity*))
(test (arity *stderr*) '#f)
-(test (arity object->string) '(1 . 2))
+(test (arity object->string) '(1 . 3))
(test (arity string) (cons 0 *max-arity*))
(test (arity dynamic-wind) '(3 . 3))
(test (arity symbol-access) '(1 . 2))
@@ -31424,7 +32001,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (arity dilambda) '(2 . 2))
(test (arity letrec*) (cons 2 *max-arity*))
(test (arity make-iterator) '(1 . 2))
-(test (arity random-state) '(1 . 2))
+(test (arity random-state) '(1 . 2))
(test (arity format) (cons 1 *max-arity*))
(test (arity vector-ref) (cons 2 *max-arity*))
(test (arity with-input-from-file) '(2 . 2))
@@ -31526,7 +32103,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (arity define-constant) (cons 2 *max-arity*))
(test (arity list?) '(1 . 1))
(test (arity open-output-file) '(1 . 2))
-(test (arity rootlet) '(0 . 0))
+(test (arity rootlet) '(0 . 0))
(test (arity quotient) '(2 . 2))
(test (arity pair?) '(1 . 1))
(test (arity call-with-input-string) '(2 . 2))
@@ -31537,6 +32114,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (arity hash-table?) '(1 . 1))
(test (arity hash-table) (cons 0 *max-arity*))
(test (arity close-output-port) '(1 . 1))
+(test (arity type-of) '(1 . 1))
(test (let () (define-macro (mac1 a b c) `(+ ,a ,b)) (arity mac1)) '(3 . 3))
(test (let () (define-macro (mac1 a b . c) `(+ ,a ,b)) (arity mac1)) (cons 2 *max-arity*))
@@ -31583,7 +32161,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(if (null? source)
(begin
(if (member dest subsets)
- (format-logged #t ";got ~S twice in for-each-subset: ~S~%" dest args))
+ (format #t ";got ~S twice in for-each-subset: ~S~%" dest args))
(set! subsets (cons dest subsets))
(if (aritable? func len)
(apply func dest)))
@@ -31649,9 +32227,9 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(snarf-1 n func lst)))))))))
-(test (let ((lst '(1 2 3 4))) (catch #t (lambda () (snarf (lambda (a b) (format-logged #t "~A ~A~%" a b c)) lst)) (lambda args 'error)) lst) '(1 2 3 4))
-(test (snarf (lambda (a b) (format-logged #t "~A ~A~%" a b)) '(1 2 3 4 5)) 'error)
-(test (snarf (lambda (a b) (format-logged #t "~A ~A~%" a b)) '(1)) 'error)
+(test (let ((lst '(1 2 3 4))) (catch #t (lambda () (snarf (lambda (a b) (format #t "~A ~A~%" a b c)) lst)) (lambda args 'error)) lst) '(1 2 3 4))
+(test (snarf (lambda (a b) (format #t "~A ~A~%" a b)) '(1 2 3 4 5)) 'error)
+(test (snarf (lambda (a b) (format #t "~A ~A~%" a b)) '(1)) 'error)
(test (let ((x 0)) (snarf (lambda (a) (set! x (+ x a))) '(1 2 3)) x) 6)
(test (let ((x 0)) (snarf (lambda (a b) (set! x (+ x a b))) '(1 2 3 4)) x) 10)
(test (let ((x 0)) (snarf (lambda* (a b) (set! x (+ x a b))) '(1 2 3 4)) x) 10)
@@ -31798,6 +32376,13 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (set! (< 3 2) 3) #f)
(test (set! (< 1) 2) #t))
+(let ((old-setter (procedure-setter abs))) ; check gc protection
+ (set! (procedure-setter abs) (define-macro (_m1_ x) `(+ ,x 1)))
+ (define-macro (_m1_ x) `(- ,x 1))
+ (gc)
+ (gc)
+ (test (macro? (procedure-setter abs)) #t)
+ (set! (procedure-setter abs) old-setter))
;;; --------------------------------------------------------------------------------
@@ -31908,6 +32493,40 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature f1) '(real? boolean?))
(test (procedure-signature f2) '(real? boolean?)))
+(when (not pure-s7)
+ (test (procedure-signature make-polar) '(number? real? real?))
+ (test (procedure-signature string-copy) '(string? string?))
+ (test (procedure-signature char-ci>=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+ (test (procedure-signature char-ci<?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+ (test (procedure-signature char-ci=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+ (test (procedure-signature char-ci>?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+ (test (procedure-signature char-ci<=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+ (test (procedure-signature string-ci<=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+ (test (procedure-signature string-ci>=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+ (test (procedure-signature string-ci<?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+ (test (procedure-signature string-ci=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+ (test (procedure-signature string-ci>?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+ (test (procedure-signature string-length) '(integer? string?))
+ (test (procedure-signature vector-length) '(integer? vector?))
+ (test (procedure-signature set-current-output-port) '(output-port? output-port?))
+ (test (procedure-signature set-current-input-port) '(input-port? input-port?))
+ (test (procedure-signature set-current-error-port) '(output-port? output-port?))
+ (test (procedure-signature char-ready?) '(boolean? input-port?))
+ (test (procedure-signature string-fill!) (let ((L (list '(char? integer?) 'string? 'char? 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L))
+ (test (procedure-signature string->list) (let ((L (list 'proper-list? 'string? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+ (test (procedure-signature vector-fill!) (let ((L (list #t 'vector? #t 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L))
+ (test (procedure-signature let->list) '(pair? let?))
+ (test (procedure-signature vector-append) (let ((L (list 'vector?))) (set-cdr! L L) L))
+ (test (procedure-signature list->string) '(string? proper-list?))
+ (test (procedure-signature list->vector) '(vector? proper-list?))
+ (test (procedure-signature exact?) '(boolean? number?))
+ (test (procedure-signature exact->inexact) (let ((L (list 'real?))) (set-cdr! L L) L))
+ (test (procedure-signature inexact?) '(boolean? number?))
+ (test (procedure-signature inexact->exact) '(rational? real?))
+ (test (procedure-signature vector->list) (let ((L (list 'proper-list? 'vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+ (test (procedure-signature integer-length) (let ((L (list 'integer?))) (set-cdr! L L) L))
+ )
+
(test (procedure-signature cddddr) '(#t pair?))
(test (procedure-signature *) (let ((L (list 'number?))) (set-cdr! L L) L))
(test (procedure-signature +) (let ((L (list 'number?))) (set-cdr! L L) L))
@@ -31920,12 +32539,10 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature close-input-port) '(unspecified? input-port?))
(test (procedure-signature string-append) (let ((L (list 'string?))) (set-cdr! L L) L))
(test (procedure-signature caar) '(#t pair?))
-(test (procedure-signature make-polar) '(number? real? real?))
(test (procedure-signature provided?) '(boolean? symbol?))
(test (procedure-signature make-byte-vector) (let ((L (list 'byte-vector? 'integer?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature byte-vector-ref) '(integer? byte-vector? integer?))
(test (procedure-signature byte-vector-set!) '(integer? byte-vector? integer? integer?))
-(test (procedure-signature string-copy) '(string? string?))
(test (procedure-signature append) (let ((L (list #t))) (set-cdr! L L) L))
(test (procedure-signature cosh) (let ((L (list 'number?))) (set-cdr! L L) L))
(test (procedure-signature positive?) '(boolean? real?))
@@ -31943,19 +32560,16 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature cdar) '(#t pair?))
(test (procedure-signature hash-table-entries) '(integer? hash-table?))
(test (procedure-signature copy) (let ((L (list #t #t #t 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L))
-(test (procedure-signature char-ci>=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature cadadr) '(#t pair?))
(test (procedure-signature openlet) (let ((L (list (list 'let? 'procedure? 'macro? 'c-object?)))) (set-cdr! L L) L))
(test (procedure-signature set-cdr!) '(#t pair? #t))
(test (procedure-signature rootlet) '(let?))
-(test (procedure-signature object->string) '(string? #t (boolean? keyword?)))
+(test (procedure-signature object->string) '(string? #t (boolean? keyword?) integer?))
(test (procedure-signature stacktrace) '(string? integer? integer? integer? integer? boolean?))
;(test (procedure-signature make-hook) '(procedure?))
-(test (procedure-signature string-length) '(integer? string?))
(test (procedure-signature char-whitespace?) '(boolean? char?))
(test (procedure-signature random) '(number? number? random-state?))
(test (procedure-signature hash-table*) (let ((L (list 'hash-table? #t))) (set-cdr! (cdr L) (cdr L)) L))
-(test (procedure-signature string-ci<=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature arity) '((pair? boolean?) #t))
(test (procedure-signature number?) '(boolean? #t))
(test (procedure-signature infinite?) '(boolean? number?))
@@ -31970,7 +32584,6 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature <=) (let ((L (list 'boolean? 'real?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature >=) (let ((L (list 'boolean? 'real?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature throw) (let ((L (list #t))) (set-cdr! L L) L))
-(test (procedure-signature string-ci>=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
(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))
@@ -31991,12 +32604,9 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature make-string) '(string? integer? char?))
(test (procedure-signature int-vector) (let ((L (list 'int-vector? 'integer?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature truncate) '(integer? real?))
-(test (procedure-signature set-current-output-port) '(output-port? output-port?))
(test (procedure-signature list-ref) (let ((L (list #t 'pair? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
-(test (procedure-signature char-ci<?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature aritable?) '(boolean? #t integer?))
(test (procedure-signature read-char) '((char? eof-object?) input-port?))
-(test (procedure-signature char-ready?) '(boolean? input-port?))
(test (procedure-signature eof-object?) '(boolean? #t))
(test (procedure-signature gensym?) '(boolean? #t))
(test (procedure-signature output-port?) '(boolean? #t))
@@ -32005,7 +32615,6 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature iterator-at-end?) '(boolean? iterator?))
(test (procedure-signature gensym) '(gensym? string?))
(test (procedure-signature cdddar) '(#t pair?))
-(test (procedure-signature string-fill!) (let ((L (list '(char? integer?) 'string? 'char? 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L))
(test (procedure-signature (symbol "(c-object set)")) #f)
(test (procedure-signature curlet) '(let?))
(test (procedure-signature quotient) (let ((L (list 'real?))) (set-cdr! L L) L))
@@ -32022,13 +32631,12 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature acos) (let ((L (list 'number?))) (set-cdr! L L) L))
(test (procedure-signature string->keyword) '(keyword? string?))
(test (procedure-signature write-char) '(char? char? output-port?))
-(test (procedure-signature float-vector-ref) (let ((L (list 'float? 'float-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature float-vector-ref) (let ((L (list '(float? float-vector?) 'float-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
(test (procedure-signature cyclic-sequences) '(proper-list? #t))
(test (procedure-signature reverse) '(sequence? sequence?))
(test (procedure-signature with-output-to-file) '(#t string? procedure?))
(test (procedure-signature procedure-documentation) '(string? procedure?))
(test (procedure-signature open-output-string) '(output-port?))
-(test (procedure-signature let->list) '(pair? let?))
(test (procedure-signature string<?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature caaar) '(#t pair?))
(test (procedure-signature equal?) (let ((L (list 'boolean? #t))) (set-cdr! (cdr L) (cdr L)) L))
@@ -32049,7 +32657,6 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature keyword?) '(boolean? #t))
(test (procedure-signature acosh) (let ((L (list 'number?))) (set-cdr! L L) L))
(test (procedure-signature make-hash-table) '(hash-table? integer? (procedure? pair?)))
-(test (procedure-signature string->list) (let ((L (list 'proper-list? 'string? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
(test (procedure-signature cdaar) '(#t pair?))
(test (procedure-signature set-car!) '(#t pair? #t))
(test (procedure-signature lcm) (let ((L (list 'rational?))) (set-cdr! L L) L))
@@ -32057,9 +32664,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature magnitude) '(real? number?))
(test (procedure-signature cddaar) '(#t pair?))
(test (procedure-signature list-tail) '(list? pair? integer?))
-(test (procedure-signature vector-length) '(integer? vector?))
(test (procedure-signature read) '(#t input-port?))
-(test (procedure-signature vector-fill!) (let ((L (list #t 'vector? #t 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L))
(test (procedure-signature for-each) (let ((L (list 'unspecified? 'procedure? 'sequence?))) (set-cdr! (cddr L) (cddr L)) L))
(test (procedure-signature memq) '((pair? boolean?) #t list?))
(test (procedure-signature int-vector-set!) (let ((L (list 'integer? 'int-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
@@ -32070,7 +32675,6 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature dilambda?) '(boolean? #t))
(test (procedure-signature not) '(boolean? #t))
(test (procedure-signature logxor) (let ((L (list 'integer?))) (set-cdr! L L) L))
-(test (procedure-signature char-ci=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature c-object?) '(boolean? #t))
(test (procedure-signature vector?) '(boolean? #t))
(test (procedure-signature length) '((real? boolean?) #t))
@@ -32085,15 +32689,12 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature format) (let ((L (list '(string? boolean?) #t))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature hash-table) (let ((L (list 'hash-table? 'list?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature file-mtime) '(integer? string?))
-(test (procedure-signature vector-append) (let ((L (list 'vector?))) (set-cdr! L L) L))
(test (procedure-signature constant?) '(boolean? #t))
-(test (procedure-signature string-ci<?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature random-state->list) '(pair? random-state?))
(test (procedure-signature boolean?) '(boolean? #t))
(test (procedure-signature max) (let ((L (list 'real?))) (set-cdr! L L) L))
(test (procedure-signature cadr) '(#t pair?))
(test (procedure-signature cdaddr) '(#t pair?))
-(test (procedure-signature string-ci=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature car) '(#t pair?))
(test (procedure-signature integer->char) '(char? integer?))
(test (procedure-signature char>?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
@@ -32102,7 +32703,6 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature flush-output-port) '(#t output-port?))
(test (procedure-signature owlet) '(let?))
(test (procedure-signature c-pointer) '(c-pointer? integer?))
-(test (procedure-signature string-ci>?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature with-output-to-string) '(string? procedure?))
(test (procedure-signature memv) '((pair? boolean?) #t list?))
(test (procedure-signature char?) '(boolean? #t))
@@ -32118,18 +32718,16 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature open-input-string) '(input-port? string?))
(test (procedure-signature write) '(#t #t output-port?))
(test (procedure-signature cdr) '(#t pair?))
-(test (procedure-signature list->string) '(string? proper-list?))
(test (procedure-signature catch) (let ((L (list 'values #t 'procedure?))) (set-cdr! (cddr L) (cddr L)) L))
(test (procedure-signature call/cc) '(values procedure?))
(test (procedure-signature port-filename) '(string? #t))
(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))
-(test (procedure-signature integer-length) (let ((L (list 'integer?))) (set-cdr! L L) L))
(test (procedure-signature symbol) (let ((L (list 'symbol? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature asinh) (let ((L (list 'number?))) (set-cdr! L L) L))
-(test (procedure-signature pair-line-number) '(integer? pair?))
-(test (procedure-signature pair-filename) '(string? pair?))
+(test (procedure-signature pair-line-number) '((integer? boolean?) pair?))
+(test (procedure-signature pair-filename) '((string? boolean?) pair?))
(test (procedure-signature load) '(values string? let?))
(test (procedure-signature cos) (let ((L (list 'number?))) (set-cdr! L L) L))
(test (procedure-signature iterate) '(#t iterator?))
@@ -32144,7 +32742,6 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature string-ref) '(char? string? integer?))
(test (procedure-signature float-vector?) '(boolean? #t))
(test (procedure-signature log) (let ((L (list 'number?))) (set-cdr! L L) L))
-(test (procedure-signature char-ci>?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature fill!) (let ((L (list #t 'sequence? #t 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L))
(test (procedure-signature cdaadr) '(#t pair?))
(test (procedure-signature even?) '(boolean? integer?))
@@ -32153,12 +32750,10 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature defined?) '(boolean? symbol? let? boolean?))
(test (procedure-signature with-input-from-file) '(#t string? procedure?))
(test (procedure-signature with-input-from-string) '(#t string? procedure?))
-(test (procedure-signature char-ci<=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature real-part) '(real? number?))
(test (procedure-signature sqrt) (let ((L (list 'number?))) (set-cdr! L L) L))
(test (procedure-signature char-downcase) (let ((L (list 'char?))) (set-cdr! L L) L))
(test (procedure-signature symbol->value) '(#t symbol? let?))
-(test (procedure-signature set-current-input-port) '(input-port? input-port?))
(test (procedure-signature assq) '((pair? boolean?) #t list?))
(test (procedure-signature make-vector) '(vector? (integer? pair?) #t))
(test (procedure-signature eval) '(values #t let?))
@@ -32166,16 +32761,13 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature cons) '(pair? #t #t))
(test (procedure-signature port-closed?) '(boolean? #t))
(test (procedure-signature char-upcase) (let ((L (list 'char?))) (set-cdr! L L) L))
-(test (procedure-signature list->vector) '(vector? proper-list?))
(test (procedure-signature sort!) '(#t 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?))
(test (procedure-signature file-exists?) '(boolean? string?))
(test (procedure-signature vector-dimensions) '(pair? vector?))
-(test (procedure-signature exact?) '(boolean? number?))
(test (procedure-signature imag-part) '(real? number?))
-(test (procedure-signature exact->inexact) (let ((L (list 'real?))) (set-cdr! L L) L))
(test (procedure-signature make-int-vector) '(int-vector? (integer? pair?) integer?))
(test (procedure-signature procedure-source) '(list? procedure?))
(test (procedure-signature zero?) '(boolean? number?))
@@ -32196,7 +32788,6 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature call-with-current-continuation) '(values procedure?))
(test (procedure-signature newline) '(unspecified? output-port?))
(test (procedure-signature symbol-table) '(vector?))
-(test (procedure-signature set-current-error-port) '(output-port? output-port?))
(test (procedure-signature char-numeric?) '(boolean? char?))
(test (procedure-signature string-upcase) (let ((L (list 'string?))) (set-cdr! L L) L))
(test (procedure-signature member) '((pair? boolean?) #t list? procedure?))
@@ -32213,7 +32804,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature caaaar) '(#t pair?))
(test (procedure-signature port-line-number) '(integer? (input-port? null?)))
(test (procedure-signature c-pointer?) '(boolean? #t))
-(test (procedure-signature int-vector-ref) (let ((L (list 'integer? 'int-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature int-vector-ref) (let ((L (list '(integer? int-vector?) 'int-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
(test (procedure-signature gc) '(#t boolean?))
(test (procedure-signature angle) '(real? number?))
(test (procedure-signature coverlet) (let ((L (list (list 'let? 'procedure? 'macro? 'c-object?)))) (set-cdr! L L) L))
@@ -32239,24 +32830,22 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature char=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature cadddr) '(#t pair?))
(test (procedure-signature apply) (let ((L (list 'values '(procedure? sequence?) #t))) (set-cdr! (cddr L) (cddr L)) L))
-(test (procedure-signature inexact?) '(boolean? number?))
(test (procedure-signature open-output-file) '(output-port? string? string?))
(test (procedure-signature rationalize) '(rational? real? real?))
-(test (procedure-signature inexact->exact) '(rational? real?))
(test (procedure-signature string>?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature iterator?) '(boolean? #t))
(test (procedure-signature string->symbol) '(symbol? string?))
(test (procedure-signature symbol->string) '(string? symbol?))
(test (procedure-signature read-string) '((string? eof-object?) integer? input-port?))
-(test (procedure-signature vector->list) (let ((L (list 'proper-list? 'vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
(test (procedure-signature odd?) '(boolean? integer?))
(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 list-set!) (let ((L (list #t 'pair? #t))) (set-cdr! (cddr 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?))
+(test (procedure-signature type-of) '((symbol? boolean?) #t))
#|
(define (show-cycle sig)
@@ -32441,7 +33030,7 @@ func
(with-let e
(hash-table-set! ht :a (abs x)))))
(f1 (inlet :ht (make-hash-table) :x -1))
- (test (f1 (inlet :ht (make-hash-table) :x -1)) ()))
+ (test (f1 (inlet :ht (make-hash-table) :x -1)) #t))
(test (let ()
(define hi (let ((a 32))
@@ -32489,7 +33078,7 @@ func
(not (char=? (name i) #\-))
(not (char-numeric? (name i))))
(begin
- (format-logged #t "ok? file name: ~S~%" name)
+ (format #t "ok? file name: ~S~%" name)
(oops #f))))))))))
#t)))
@@ -32840,6 +33429,9 @@ func
(test (eval (eval (cons quote "hi"))) 'error)
(test (eval (eval (list and "hi"))) "hi")
+(let-temporarily (((*s7* 'safety) 1))
+ (test (eval (cdr (procedure-signature /))) 'error))
+
(test (apply + (+ 1) ()) 1)
(test (apply #(1) (+) ()) 1)
(test (apply + (+) ()) 0)
@@ -32864,7 +33456,7 @@ func
(test (eval-string "(+ 1 (eval (list '+ 1 2)))") 4)
(test (eq? (eval-string "else") else) #t)
-(test (eq? (with-input-from-string "else" read) else) #f)
+(test (eq? (with-input-from-string "else" read) else) #t)
(test (eq? (with-input-from-string "lambda" read) lambda) #f)
(test (eq? (eval-string "lambda") lambda) #t)
(test (((eval-string "lambda") () (+ 1 2))) 3)
@@ -33246,7 +33838,7 @@ func
(if (or (not (= val 11))
fe1-called
fe2-called)
- (format-logged #t "fully-expand: ~A ~A ~A ~A~%" val (procedure-source fe3) fe1-called fe2-called)))
+ (format #t "fully-expand: ~A ~A ~A ~A~%" val (procedure-source fe3) fe1-called fe2-called)))
(let ()
(define-macro (swap a b)
@@ -33788,11 +34380,6 @@ func
*#readers*))
(num-test (string->number "#tb") 11)
(num-test (string->number "#t11.3") 13.25)
- (when (not pure-s7)
- (num-test (string->number "#e#t11.3") 53/4)
- (num-test (string->number "#t#e1.5") 17/12)
- (num-test (string->number "#i#t1a") 22.0)
- (num-test (string->number "#t#i1a") 22.0)) ; ??? this is analogous to #x#i1a = 26.0
(num-test (string->number "#t#t1a") 22.0)
(num-test (string->number "#t#t#t1a") 22.0)
(test (eval-string "#t") #t)
@@ -33828,9 +34415,6 @@ func
(num-test (string->number "#x12") 9)
(num-test (string->number "#x-142.1e-1") -11.30612244898)
- (when (not pure-s7)
- (num-test (string->number "#e#x-142.1e-1") -554/49)
- (num-test (string->number "#e#ta.a") 65/6))
(num-test (string->number "#t460.88") 648.72222222222)
(num-test (string->number "#x1") 1)
(test (string->number "#te") #f)
@@ -33864,8 +34448,7 @@ func
(let ((p1 (dilambda (lambda (str) (string->number (substring str 1) 12)) (lambda (a) a))))
(set! *#readers* (list (cons #\t p1)))
(num-test (string->number "#ta") 10)
- (num-test (string->number "#t11.6") 13.5)
- (when (not pure-s7) (num-test (string->number "#e#t11.6") 27/2))))
+ (num-test (string->number "#t11.6") 13.5)))
(num-test (string->number "#x106") 262)
(num-test (string->number "#x17") 23)
@@ -34015,10 +34598,8 @@ func
(format port "(define r8 '(1 #+s7 #1=(1 2) 3))~%")
(format port "(define r9 '(1 #+asdf #1=(1 2) 3))~%")
(format port "(define r10 #. #1#)~%")
- (format port "(define r13 #+s7 #e0.0)~%")
(format port "(define r14 #. #o1)~%")
(format port "(define r15 #. #_-)~%")
- (format port "(define r16 (#+s7 #_- #d0))~%")
(format port "(define r17 (#. #_- #o1))~%")
(format port "(define r18 (#. #. #_+))~%")
(format port "(define r19 (#. #+s7 #_+))~%")
@@ -34044,56 +34625,54 @@ func
(let ()
(load reader-file (curlet))
- (if (not (= x 6)) (format-logged #t ";#.(+ 1 2 3) -> ~A~%" x))
- (if (not (equal? xlst '(1 2 3 4))) (format-logged #t ";#.(* 2 2) -> ~A~%" xlst))
- (if (not (equal? (object->string y) "#1=(2 . #1#)")) (format-logged #t ";'#1=(2 . #1#) -> ~S~%" (object->string y)))
+ (if (not (= x 6)) (format #t ";#.(+ 1 2 3) -> ~A~%" x))
+ (if (not (equal? xlst '(1 2 3 4))) (format #t ";#.(* 2 2) -> ~A~%" xlst))
+ (if (not (equal? (object->string y) "#1=(2 . #1#)")) (format #t ";'#1=(2 . #1#) -> ~S~%" (object->string y)))
(if (not (equal? (object->string y1) "#1=(2 #3=(3 #2=(#1#) . #2#) . #3#)"))
- (format-logged #t ";'#1=(2 #2=(3 #3=(#1#) . #3#) . #2#) -> ~S~%" (object->string y1)))
- (if (not (equal? y2 #2d((1 2) (3 4)))) (format-logged #t ";#2d((1 2) (3 4)) -> ~A~%" y2))
- (if (not (= z 32)) (format-logged #t ";#+asdf? -> ~A~%" z))
- (if (not (= z1 1)) (format-logged #t ";#(or ... +asdf)? -> ~A~%" z1))
- (if (not (= x2 5)) (format-logged #t ";(+ 1 #;(* 2 3) 4) -> ~A~%" x2))
- (if (not (= x3 3)) (format-logged #t ";(+ #;32 1 2) -> ~A~%" x3))
- (if (not (= x4 3)) (format-logged #t ";(+ #; 32 1 2) -> ~A~%" x4))
- (if (not (= y3 3)) (format-logged #t ";(+ 1 (car '#1=(2 . #1#))) -> ~A~%" y3))
- (if (not (= y4 3)) (format-logged #t ";#.(+ 1 (car '#1=(2 . #1#))) -> ~A~%" y4))
- (if (not (= y5 51)) (format-logged #t ";(+ 1 #.(* 2 3) #.(* 4 #.(+ 5 6))) -> ~A~%" y5))
-
- (if (not (equal? r1 '(1 4))) (format-logged #t ";'(1 #. #;(+ 2 3) 4) -> ~A~%" r1))
- (if (not (equal? r2 '(1 (* 2 4)))) (format-logged #t ";'(1 #. #;(+ 2 3) (* 2 4)) -> ~A~%" r2))
- (if (not (equal? r3 '(1 (* 2 4)))) (format-logged #t ";'(1 #; #.(+ 2 3) (* 2 4)) -> ~A~%" r3))
- (if (not (equal? r4 '(1 5 (* 2 4)))) (format-logged #t ";'(1 #. #1=(+ 2 3) (* 2 4)) -> ~A~%" r4))
- (if (not (equal? r5 '(1 5 (* 2 4)))) (format-logged #t ";'(1 #. #1=(+ 2 #. 3) (* 2 4)) -> ~A~%" r5))
- (if (not (equal? r6 '(1 2 (* 2 4)))) (format-logged #t ";'(1 #. #1=(+ 2 #+pi 3) (* 2 4)) -> ~A~%" r6))
- (if (not (equal? r7 '(1 2 (* 2 4)))) (format-logged #t ";'(1 #. #1=(+ 2 #+pi #1#) (* 2 4)) -> ~A~%" r7))
- (if (not (equal? r8 '(1 (1 2) 3))) (format-logged #t ";'(1 #+s7 #1=(1 2) 3) -> ~A~%" r8))
- (if (not (equal? r9 '(1 3))) (format-logged #t ";'(1 #+asdf #1=(1 2) 3)) -> ~A~%" r9))
- (if (not (equal? r10 ':1)) (format-logged #t ";#. #1# -> ~A~%" r10))
- (if (not (equal? r13 0)) (format-logged #t ";#+s7 #e0.0 -> ~A~%" r13))
- (if (not (equal? r14 1)) (format-logged #t ";#. #o1 -> ~A~%" r14))
- (if (not (equal? r15 -)) (format-logged #t ";#. #_- -> ~A~%" r15))
- (if (not (equal? r16 0)) (format-logged #t ";(#+s7 #_- #d0) -> ~A~%" r16))
- (if (not (equal? r17 -1)) (format-logged #t ";(#. #_- #o1) -> ~A~%" r17))
- (if (not (equal? r18 0)) (format-logged #t ";(#. #. #_+) -> ~A~%" r18))
- (if (not (equal? r19 0)) (format-logged #t ";(#. #+s7 #_+) -> ~A~%" r19))
- (if (not (equal? r20 0)) (format-logged #t ";(#+s7 #+s7 #_+) -> ~A~%" r20))
- (if (not (equal? r21 0)) (format-logged #t ";(#_-(#_+ 1 2)3) -> ~A~%" r21))
- (if (not (equal? r22 1)) (format-logged #t ";(#(#_+ 1 2)#o1) -> ~A~%" r22))
- (if (not (equal? r23 0)) (format-logged #t ";(+ #;#1.##+asdf ) -> ~A~%" r23))
- (if (not (equal? r24 0)) (format-logged #t ";(+ #. #;(#_+ 1 2)) -> ~A~%" r24))
- (if (not (equal? r25 0)) (format-logged #t ";(+ #;#1=#2=) -> ~A~%" r25))
- (if (not (equal? r26 3)) (format-logged #t ";(+ #;#2#(#_+ 1 2)) -> ~A~%" r26))
- (if (not (equal? r27 0)) (format-logged #t ";(+ #;#1=.) -> ~A~%" r27))
- (if (not (equal? r28 0)) (format-logged #t ";(+ #; #; #; ()) -> ~A~%" r28))
- (if (not (equal? r29 6)) (format-logged #t ";(+ 3(#_+ 1 2)#;#. ) -> ~A~%" r29))
- (if (not (equal? r30 0)) (format-logged #t ";(+ #;#2=#+asdf#+s7) -> ~A~%" r30))
- (if (not (equal? r31 0)) (format-logged #t ";(+ #;#f#=#\\) -> ~A~%" r31))
- (if (not (equal? r32 -3)) (format-logged #t ";(#. + (#_-(#_+ 1 2))) -> ~A~%" r32))
- (if (not (equal? r33 3)) (format-logged #t ";(+ 1 #+asdf #\\a 2) -> ~A~%" r33))
- (if (not (equal? r34 0)) (format-logged #t ";(+ #++(#. #\\a)) -> ~A~%" r34))
- (if (not (equal? r35 0)) (format-logged #t ";(+ #+s7 #; (33)) -> ~A~%" r35))
-
- (if (not (morally-equal? r36 -1.0)) (format-logged #t ";(cos #. #. #. `(string->symbol \"pi\")) -> ~A~%" r36))
+ (format #t ";'#1=(2 #2=(3 #3=(#1#) . #3#) . #2#) -> ~S~%" (object->string y1)))
+ (if (not (equal? y2 #2d((1 2) (3 4)))) (format #t ";#2d((1 2) (3 4)) -> ~A~%" y2))
+ (if (not (= z 32)) (format #t ";#+asdf? -> ~A~%" z))
+ (if (not (= z1 1)) (format #t ";#(or ... +asdf)? -> ~A~%" z1))
+ (if (not (= x2 5)) (format #t ";(+ 1 #;(* 2 3) 4) -> ~A~%" x2))
+ (if (not (= x3 3)) (format #t ";(+ #;32 1 2) -> ~A~%" x3))
+ (if (not (= x4 3)) (format #t ";(+ #; 32 1 2) -> ~A~%" x4))
+ (if (not (= y3 3)) (format #t ";(+ 1 (car '#1=(2 . #1#))) -> ~A~%" y3))
+ (if (not (= y4 3)) (format #t ";#.(+ 1 (car '#1=(2 . #1#))) -> ~A~%" y4))
+ (if (not (= y5 51)) (format #t ";(+ 1 #.(* 2 3) #.(* 4 #.(+ 5 6))) -> ~A~%" y5))
+
+ (if (not (equal? r1 '(1 4))) (format #t ";'(1 #. #;(+ 2 3) 4) -> ~A~%" r1))
+ (if (not (equal? r2 '(1 (* 2 4)))) (format #t ";'(1 #. #;(+ 2 3) (* 2 4)) -> ~A~%" r2))
+ (if (not (equal? r3 '(1 (* 2 4)))) (format #t ";'(1 #; #.(+ 2 3) (* 2 4)) -> ~A~%" r3))
+ (if (not (equal? r4 '(1 5 (* 2 4)))) (format #t ";'(1 #. #1=(+ 2 3) (* 2 4)) -> ~A~%" r4))
+ (if (not (equal? r5 '(1 5 (* 2 4)))) (format #t ";'(1 #. #1=(+ 2 #. 3) (* 2 4)) -> ~A~%" r5))
+ (if (not (equal? r6 '(1 2 (* 2 4)))) (format #t ";'(1 #. #1=(+ 2 #+pi 3) (* 2 4)) -> ~A~%" r6))
+ (if (not (equal? r7 '(1 2 (* 2 4)))) (format #t ";'(1 #. #1=(+ 2 #+pi #1#) (* 2 4)) -> ~A~%" r7))
+ (if (not (equal? r8 '(1 (1 2) 3))) (format #t ";'(1 #+s7 #1=(1 2) 3) -> ~A~%" r8))
+ (if (not (equal? r9 '(1 3))) (format #t ";'(1 #+asdf #1=(1 2) 3)) -> ~A~%" r9))
+ (if (not (equal? r10 ':1)) (format #t ";#. #1# -> ~A~%" r10))
+ (if (not (equal? r14 1)) (format #t ";#. #o1 -> ~A~%" r14))
+ (if (not (equal? r15 -)) (format #t ";#. #_- -> ~A~%" r15))
+ (if (not (equal? r17 -1)) (format #t ";(#. #_- #o1) -> ~A~%" r17))
+ (if (not (equal? r18 0)) (format #t ";(#. #. #_+) -> ~A~%" r18))
+ (if (not (equal? r19 0)) (format #t ";(#. #+s7 #_+) -> ~A~%" r19))
+ (if (not (equal? r20 0)) (format #t ";(#+s7 #+s7 #_+) -> ~A~%" r20))
+ (if (not (equal? r21 0)) (format #t ";(#_-(#_+ 1 2)3) -> ~A~%" r21))
+ (if (not (equal? r22 1)) (format #t ";(#(#_+ 1 2)#o1) -> ~A~%" r22))
+ (if (not (equal? r23 0)) (format #t ";(+ #;#1.##+asdf ) -> ~A~%" r23))
+ (if (not (equal? r24 0)) (format #t ";(+ #. #;(#_+ 1 2)) -> ~A~%" r24))
+ (if (not (equal? r25 0)) (format #t ";(+ #;#1=#2=) -> ~A~%" r25))
+ (if (not (equal? r26 3)) (format #t ";(+ #;#2#(#_+ 1 2)) -> ~A~%" r26))
+ (if (not (equal? r27 0)) (format #t ";(+ #;#1=.) -> ~A~%" r27))
+ (if (not (equal? r28 0)) (format #t ";(+ #; #; #; ()) -> ~A~%" r28))
+ (if (not (equal? r29 6)) (format #t ";(+ 3(#_+ 1 2)#;#. ) -> ~A~%" r29))
+ (if (not (equal? r30 0)) (format #t ";(+ #;#2=#+asdf#+s7) -> ~A~%" r30))
+ (if (not (equal? r31 0)) (format #t ";(+ #;#f#=#\\) -> ~A~%" r31))
+ (if (not (equal? r32 -3)) (format #t ";(#. + (#_-(#_+ 1 2))) -> ~A~%" r32))
+ (if (not (equal? r33 3)) (format #t ";(+ 1 #+asdf #\\a 2) -> ~A~%" r33))
+ (if (not (equal? r34 0)) (format #t ";(+ #++(#. #\\a)) -> ~A~%" r34))
+ (if (not (equal? r35 0)) (format #t ";(+ #+s7 #; (33)) -> ~A~%" r35))
+
+ (if (not (morally-equal? r36 -1.0)) (format #t ";(cos #. #. #. `(string->symbol \"pi\")) -> ~A~%" r36))
)
(set! *#readers* old-readers)
@@ -34437,13 +35016,13 @@ func
(if (equal? val 33.2)
(set! val (bad-idea)))
(if (equal? val 33.2)
- (format-logged #t ";bad-idea 3rd time: ~A~%" val)))
+ (format #t ";bad-idea 3rd time: ~A~%" val)))
(num-test (bad-idea-1) 2)
(let ((val (bad-idea-1)))
(if (equal? val 33.2)
(set! val (bad-idea-1)))
(if (equal? val 33.2)
- (format-logged #t ";bad-idea-1 3rd time: ~A~%" val)))
+ (format #t ";bad-idea-1 3rd time: ~A~%" val)))
(set! (*s7* 'safety) 1)
(load tmp-output-file)
(num-test (bad-idea) 2)
@@ -34486,7 +35065,7 @@ func
(test (macroexpand (m1 (display 1) (newline))) '(begin (display 1) (newline))))
(test (let ((a 3) (b (list 2 3 4))) (quasiquote (+ ,a 1 , at b))) '(+ 3 1 2 3 4))
-(test (let ((a 3) (b (list 2 3 4))) (macroexpand (quasiquote (+ ,a 1 , at b)))) (list list-values ''+ 'a 1 (list apply-values 'b)))
+(test (let ((a 3) (b (list 2 3 4))) (macroexpand (quasiquote (+ ,a 1 , at b)))) (list 'list-values ''+ 'a 1 (list 'apply-values 'b)))
(let ()
(define-macro* (m2 (a 3) (b 2)) `(+ ,a ,b))
@@ -34557,14 +35136,26 @@ func
(test (macroexpand (_expansion_ 3)) `(+ 3 1))
(test '(_expansion_ 3) (quote (_expansion_ 3)))
(test (_expansion_ (+ (_expansion_ 1) 2)) 5)
-(test (let ((x _expansion_)) (x 3)) '(+ 3 1))
-(test (let ((x 3)) (define (hi a) (a x)) (hi _expansion_)) '(+ x 1))
+(test (let ((x _expansion_)) (x 3)) (+ 3 1))
+(test (let ((x 3)) (define (hi a) (a x)) (hi _expansion_)) 4)
(define-expansion (whatever->zero . whatever) 0)
(let ((val (+ 1 (whatever->zero 2 3) 4)))
(if (not (= val 5))
(format *stderr* "whatever->zero: ~A?" val)))
+(define (make-instrument-conf6) (<gui3>))
+(define-expansion (<gui3>) `(+ 2 3))
+(test (make-instrument-conf6) 5)
+
+(define (make-instrument-conf5) (<gui2>))
+(define-macro (<gui2>) `(+ 2 3))
+(test (make-instrument-conf5) 5)
+
+(define-expansion (<gui1>) `(+ 2 3))
+(define (make-instrument-conf4) (<gui1>))
+(test (make-instrument-conf4) 5)
+
;;; define-constant
@@ -34931,6 +35522,15 @@ func
(test (g (f 'sam)) 'sam)
(test (g (f (g (f (f 'sym))))) 'sam))
+
+(let ((f (inlet :a 1 :b 2)))
+ (test (length f) 2)
+ (fill! f #<undefined>)
+ (test (length f) 0)
+ (test (f 'b) #<undefined>)
+ (test (let-ref f 'a) #<undefined>))
+
+
(test (apply inlet (map values (hash-table '(a . 1) '(b . 2)))) (inlet 'b 2 'a 1))
(test (apply hash-table (map values (inlet 'a 1 'b 2))) (hash-table '(a . 1) '(b . 2)))
@@ -35158,6 +35758,8 @@ func
(test (inlet 'a 2 'b) 'error)
(test (with-let (inlet 'a (let ((p (open-output-string))) (display "32" p) p)) (get-output-string a)) "32")
+(test (set! (with-let) 1) 'error)
+(test (set! (with-let (curlet)) 1) 'error)
(for-each
(lambda (arg)
@@ -35194,6 +35796,7 @@ func
(test (etest 1) 33))
(test (let-set!) 'error)
(test (let-set! a b) 'error)
+(let ((e (inlet 'a 1))) (test (let-set! e 'b 2) 'error))
(let ((e (inlet (cons 'a 1))))
(define (eref a) (e a))
(define (eset a b) (set! (e a) b))
@@ -35306,12 +35909,12 @@ func
(set! e (curlet))
(set! g (rootlet))
(if (not (equal? e (curlet))) ; test here introduces a new environment
- (format-logged #t ";(equal? e (curlet)) -> #f?~%"))
+ (format #t ";(equal? e (curlet)) -> #f?~%"))
(test g (rootlet))
(test (equal? e g) #f)
(let ()
(if (not (equal? e (curlet)))
- (format-logged #t ";2nd case (equal? e (curlet)) -> #f?~%"))))
+ (format #t ";2nd case (equal? e (curlet)) -> #f?~%"))))
(let ()
(define global-env (rootlet))
@@ -36610,9 +37213,9 @@ func
(test (object->let 12 21) 'error)
(test (object->let ()) (inlet :value () :type 'null?))
-(test (object->let #<unspecified>) (inlet :value #<unspecified> :type #<unspecified>))
+(test (object->let #<unspecified>) (inlet :value #<unspecified> :type 'unspecified?))
(test (object->let #<undefined>) (inlet :value #<undefined> :type #<undefined>))
-(test (object->let else) (inlet :value else :type else))
+(test (object->let else) (inlet :value else :type 'symbol?))
(test (object->let with-baffle) (inlet :value with-baffle :type 'syntax?))
(test (object->let #<eof>) (inlet :value #<eof> :type 'eof-object?))
(test (object->let #t) (inlet :value #t :type 'boolean?))
@@ -36647,8 +37250,9 @@ func
(test (object->let c) (inlet :value c :type 'goto? :active #f)))
(call-with-exit (lambda (f) (test (object->let f) (inlet :value f :type 'goto? :active #t))))
-(let ((r (random-state 1234)))
- (test (object->let r) (inlet :value r :type 'random-state? :seed 1234 :carry 1675393560)))
+(when (not with-bignums)
+ (let ((r (random-state 1234)))
+ (test (object->let r) (inlet :value r :type 'random-state? :seed 1234 :carry 1675393560))))
(test (object->let (vector 1 2 3)) (inlet :value (vector 1 2 3) :type 'vector? :length 3 :dimensions '(3) :shared #f))
(test (object->let (int-vector 1 2 3)) (inlet :value (int-vector 1 2 3) :type 'int-vector? :length 3 :dimensions '(3) :shared #f))
@@ -36709,7 +37313,7 @@ func
(let ((cl (object->let jet-colormap)))
(test (let? cl) #t)
(test (cl 'value) jet-colormap)
- (test (cl 'length) 512)
+ (test (pair? (memv (cl 'length) '(64 512))) #t)
(test (cl 'type) 'c-object?)
(test (cl 'class) "<colormap>")
(test (integer? (cl 'c-type)) #t)
@@ -36729,7 +37333,7 @@ func
(lambda ()
(read-char)
(test (object->let (current-input-port))
- (inlet :value (current-input-port) :type 'input-port? :port-type 'string :closed #f :length 4 :position 1 :data "1234"))))
+ (inlet :value (current-input-port) :type 'input-port? :port-type 'string :closed #f :length 4 :position 1 :data "1"))))
(call-with-output-string
(lambda (p)
(display 123 p)
@@ -36789,7 +37393,132 @@ func
(test (e 'value) 1+)
(test (e 'type) 'macro?)
(test (e 'arity) '(1 . 1))
- (test (e 'source) '(lambda (x) (#_list-values '+ x 1)))))
+ (test (e 'source) '(lambda (x) (list-values '+ x 1)))))
+
+
+;;; --------------------------------------------------------------------------------
+;;; let-temporarily
+
+(let ((aaa 1)
+ (bbb 0)
+ (ccc 0))
+ (let-temporarily ((aaa 2))
+ (set! bbb aaa)
+ (set! aaa 32)
+ (set! ccc aaa))
+ (test (list aaa bbb ccc) '(1 2 32)))
+
+(test (let ((aaa 0)
+ (bbb 0))
+ (let-temporarily ((aaa 32))
+ (set! bbb aaa)
+ (let-temporarily ((bbb 10))
+ (set! aaa bbb)))
+ (list aaa bbb))
+ '(0 32))
+
+(let ()
+ (define f2 (let ((x '(0 1)))
+ (dilambda (lambda () x)
+ (lambda (y) (set! x y)))))
+ (let-temporarily (((f2) '(3 2)))
+ (test (f2) '(3 2)))
+ (test (f2) '(0 1)))
+
+(let ()
+ (define f3 (let ((x 'z))
+ (dilambda (lambda () x)
+ (lambda (y) (set! x y)))))
+ (let ((z 32))
+ (let-temporarily (((f3) 'z))
+ (test (f3) 'z))
+ (test (f3) 'z)))
+
+(let ((z 1)
+ (x 32))
+ (let-temporarily ((z 'x))
+ (test z 'x))
+ (test z 1))
+
+(let ((saved 0)
+ (orig 1)
+ (vars 2)
+ (body 3))
+ (let ((vals (list (let-temporarily ((saved 30)
+ (orig 31)
+ (vars 32)
+ (body 33))
+ (let ((inner (list saved orig vars body)))
+ (set! saved 41)
+ (set! orig 42)
+ (set! vars 43)
+ (set! body 44)
+ inner))
+ (list saved orig vars body))))
+ (test vals '((30 31 32 33) (0 1 2 3)))))
+
+(let ((cons +)
+ (curlet abs)
+ (inlet call/cc)
+ (saved 32)
+ (inner-let -1))
+ (let-temporarily ((saved *))
+ (set! inner-let (cons (saved (abs inner-let) 2) 3)))
+ (test inner-let 5)
+ (test (eq? curlet abs) #t))
+
+(let ((a (vector 1 2 3))
+ (x 1)
+ (y 32))
+ (let-temporarily (((a x) y))
+ (test (a x) y))
+ (test (a x) 2))
+
+(let ((a (inlet 'b (vector 1 2 3)))
+ (x 32)
+ (y 1))
+ (let-temporarily ((((a 'b) 1) 32))
+ (test (a 'b) #(1 32 3)))
+ (test (a 'b) #(1 2 3)))
+
+(let ((x 1)
+ (y 2))
+ (let-temporarily ((x 32) (y x))
+ (test (list x y) '(32 1)))
+ (test (list x y) '(1 2)))
+
+(let ((a (vector 1 2 3))
+ (x 1)
+ (y 32)
+ (z 0))
+ (let-temporarily (((a x) y) (z (a x)))
+ (test (list (a x) y z) '(32 32 2)))
+ (test (list (a x) y z) '(2 32 0)))
+
+(test (let ((x 1)) (let-temporarily ((x 32)))) ()) ; was #f when let-temporarily was a macro -- not sure what it should be
+
+(test (let-temporarily . 1) 'error)
+(test (let-temporarily 1 1) 'error)
+(test (let-temporarily ((a 1) . 2) a) 'error)
+(test (let-temporarily (1 2) #t) 'error)
+(test (let-temporarily ((pi 3)) pi) 'error)
+(test (let-temporarily ((if 3)) if) 'error)
+(test (let-temporarily ((x . 1)) x) 'error)
+(test (let-temporarily ((x 1 2 3)) x) 'error)
+;; let ((x 0) (y 0)) (let-temporarily ((x 1) (x 2)) (set! y x)) (list x y)) '(0 1) ? let*-temp -> '(0 2)
+
+(let ()
+ (define ourlet
+ (let ((x 1))
+ (define (a-func) x)
+ (define b-func (let ((y 1))
+ (lambda ()
+ (+ x y))))
+ (curlet)))
+ (test (ourlet 'x) 1)
+ (test (let-temporarily (((ourlet 'x) 2)) ((ourlet 'a-func))) 2)
+ (test ((funclet (ourlet 'b-func)) 'y) 1)
+ (test (let-temporarily ((((funclet (ourlet 'b-func)) 'y) 3)) ((ourlet 'b-func))) 4))
@@ -37121,9 +37850,6 @@ hi6: (string-app...
(test (call-with-exit (lambda (return) (dilambda? return))) #f)
(test (dilambda? quasiquote) #f)
-(test (dilambda? -s7-symbol-table-locked?) #t)
-
-;; (test (dilambda? '-s7-symbol-table-locked?) #f) ; this parallels (procedure? 'abs) -> #f but seems inconsistent with other *? funcs
(test (let ((pws (dilambda (lambda args (apply + args)) (lambda args (apply * args))))) (pws 2 3 4)) 9)
(test (let ((pws (dilambda (lambda args (apply + args)) (lambda args (apply * args))))) (set! (pws 2 3 4) 5)) 120)
@@ -37302,7 +38028,7 @@ hi6: (string-app...
(set! (cdr (cddr lst)) lst)
(copy #(1 2 3 4 5 6) lst 0 1)
(test (car lst) 1)
- (copy #(1 2 3 4 5 6) lst 1 5)
+ (copy #(1 2 3 4 5 6) lst 1 4)
(test (car lst) 2))
(test (copy #(#\a #\b #\c) (make-string 2) 1) "bc")
@@ -37974,7 +38700,7 @@ hi6: (string-app...
(if (< b c)
(tc-1 b c))))
(tc-1 0 32)
- (if (> max-stack 12) (format-logged #t "tc-1 max: ~D~%" max-stack))) ; 18 here and below in repl.scm
+ (if (> max-stack 12) (format #t "tc-1 max: ~D~%" max-stack))) ; 18 here and below in repl.scm
(let ((max-stack 0))
(define (tc-1 a c)
@@ -37988,7 +38714,7 @@ hi6: (string-app...
(if (< a c)
(tc-1 (+ a 1) c)))
(tc-1 0 32)
- (if (> max-stack 12) (format-logged #t "tc-1-1 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-1-1 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-2 a c)
@@ -37999,7 +38725,7 @@ hi6: (string-app...
#f
(tc-2 b c))))
(tc-2 0 32)
- (if (> max-stack 12) (format-logged #t "tc-2 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-2 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-2 a c)
@@ -38010,7 +38736,7 @@ hi6: (string-app...
(tc-2 b c)
#f)))
(tc-2 0 32)
- (if (> max-stack 12) (format-logged #t "tc-2-1 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-2-1 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-3 a c)
@@ -38021,7 +38747,7 @@ hi6: (string-app...
((< b c)
(tc-3 b c)))))
(tc-3 0 32)
- (if (> max-stack 12) (format-logged #t "tc-3 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-3 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-4 a c)
@@ -38031,7 +38757,7 @@ hi6: (string-app...
(cond ((= b c) #f)
(else (tc-4 b c)))))
(tc-4 0 32)
- (if (> max-stack 12) (format-logged #t "tc-4 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-4 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-5 a c)
@@ -38042,7 +38768,7 @@ hi6: (string-app...
((32) #f)
(else (tc-5 b c)))))
(tc-5 0 32)
- (if (> max-stack 12) (format-logged #t "tc-5 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-5 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-6 a c)
@@ -38054,7 +38780,7 @@ hi6: (string-app...
((0 1 2 3 4 5 6 7 8) (tc-6 b c))
((9 10 11 12 13 14 15 16) (tc-6 b c)))))
(tc-6 0 32)
- (if (> max-stack 12) (format-logged #t "tc-6 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-6 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-7 a c)
@@ -38064,7 +38790,7 @@ hi6: (string-app...
(or (>= b c)
(tc-7 b c))))
(tc-7 0 32)
- (if (> max-stack 12) (format-logged #t "tc-7 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-7 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-8 a c)
@@ -38074,7 +38800,7 @@ hi6: (string-app...
(and (< b c)
(tc-8 b c))))
(tc-8 0 32)
- (if (> max-stack 12) (format-logged #t "tc-8 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-8 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-9 a c)
@@ -38084,7 +38810,7 @@ hi6: (string-app...
(if (< b c)
(tc-9a (+ b 1)))))
(tc-9 0 32)
- (if (> max-stack 12) (format-logged #t "tc-9 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-9 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-10 a c)
@@ -38094,7 +38820,7 @@ hi6: (string-app...
(and (< b c)
(tc-10 b c))))
(tc-10 0 32)
- (if (> max-stack 12) (format-logged #t "tc-10 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-10 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-11 a c)
@@ -38104,7 +38830,7 @@ hi6: (string-app...
(and (< b c)
(tc-11 b c))))
(tc-11 0 32)
- (if (> max-stack 12) (format-logged #t "tc-11 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-11 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-12 a c)
@@ -38114,7 +38840,7 @@ hi6: (string-app...
(set! max-stack (-s7-stack-top-)))
(tc-12 (+ a 1) c))))
(tc-12 0 32)
- (if (> max-stack 12) (format-logged #t "tc-12 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-12 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-13 a c)
@@ -38125,7 +38851,7 @@ hi6: (string-app...
(if (> a c) (display "oops"))
(tc-13 (+ a 1) c))))
(tc-13 0 32)
- (if (> max-stack 12) (format-logged #t "tc-13 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-13 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-14 a c)
@@ -38134,7 +38860,7 @@ hi6: (string-app...
(cond ((>= a c) #f)
((values (+ a 1) c) => tc-14)))
(tc-14 0 32)
- (if (> max-stack 12) (format-logged #t "tc-14 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-14 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-15 a c)
@@ -38143,7 +38869,7 @@ hi6: (string-app...
(or (>= a c)
(apply tc-15 (list (+ a 1) c))))
(tc-15 0 32)
- (if (> max-stack 12) (format-logged #t "tc-15 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-15 max: ~D~%" max-stack)))
(let ((max-stack 0)
(e #f))
@@ -38179,8 +38905,8 @@ hi6: (string-app...
(set! max-stack (-s7-stack-top-))))
a))
(let ((val (tc-21 0)))
- (if (> max-stack 12) (format-logged #t "tc-21 max: ~D~%" max-stack))
- (if (not (= val 32)) (format-logged #t "tc-21 returned: ~A~%" val))))
+ (if (> max-stack 12) (format #t "tc-21 max: ~D~%" max-stack))
+ (if (not (= val 32)) (format #t "tc-21 returned: ~A~%" val))))
(let ((max-stack 0))
(define (tc-env a c)
@@ -38190,7 +38916,7 @@ hi6: (string-app...
(if (< b c)
(tc-env b c))))
(tc-env 0 32)
- (if (> max-stack 12) (format-logged #t "tc-env max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-env max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-env-1 a)
@@ -38200,7 +38926,7 @@ hi6: (string-app...
(with-let (curlet)
(tc-env-1 (- a 1)))))
(tc-env-1 32)
- (if (> max-stack 12) (format-logged #t "tc-env-1 max: ~D~%" max-stack)))
+ (if (> max-stack 12) (format #t "tc-env-1 max: ~D~%" max-stack)))
;;; make sure for-each and map aren't messed up
@@ -38340,14 +39066,6 @@ hi6: (string-app...
(num-test(cos(sin(log(tan(*))))) 0.90951841537482)
(num-test (asinh (- 9223372036854775807)) -44.361419555836)
(num-test (imag-part (asin -9223372036854775808)) 44.361419555836)
-(when (provided? 'dfls-exponents)
- ;; proof that these exponents should be disallowed
- (num-test (string->number "1l1") 10.0)
- (num-test (string->number "1l1+1l1i") 10+10i)
- (num-test (string->number "1l11+11l1i") 100000000000+110i)
- (num-test (string->number "#d1d1") 10.0)
- (num-test (string->number "#d0001d0001") 10.0))
-(test (#|#<|# = #|#f#|# #o#e0 #|#>|# #e#o0 #|#t#|#) #t)
(num-test (apply * (map (lambda (r) (sin (* pi (/ r 130)))) (list 1 67 69 73 81 97))) (/ 1.0 64))
(num-test (max 0(+)(-(*))1) 1)
@@ -39202,7 +39920,7 @@ hi6: (string-app...
(lambda () ( (cadr op) forms (append clauses parsed) ops))
(lambda (a b) (set! clause a) (set! remains b)))
- ;(format-logged #t "~%after call clause=~s forms=~S" clause forms)
+ ;(format #t "~%after call clause=~s forms=~S" clause forms)
(set! parsed (append parsed (list clause)))
(set! previous forms)
@@ -39514,7 +40232,7 @@ hi6: (string-app...
(test (do* ((i 0 (1+ i))) ((> i 10) (values))) #<unspecified>)
(test (+ 1 (do* ((i 0 (1+ i))) ((> i 10) (values i (1+ i))))) 24)
(test (do* ((i 0 (1+ i))) ((> i 10) (set! i (+ i 1)) (set! i (+ i 1)) i)) 13)
- (test (do* ((i 0 (1+ i))) ((> i 10))) ())
+ (test (do* ((i 0 (1+ i))) ((> i 10))) #t)
(test (map (lambda (f) (f)) (let ((x ())) (do* ((i 0 (+ i 1))) ((= i 5) x) (set! x (cons (lambda () i) x))))) '(5 5 5 5 5))
(test (do* ((lst (list 0 1 2 3 4 5 6 7 8 9) (cdr lst))
(elm (car lst) (and (pair? lst) (car lst)))
@@ -39528,13 +40246,13 @@ hi6: (string-app...
(set! n (+ n elm)))
45)
(test (let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
- (and (null? (do* ((n #f)
- (i 0 (+ i 1))
- (j (- 9 i) (- 9 i)))
- ((>= i j))
- (set! n (vec i))
- (set! (vec i) (vec j))
- (set! (vec j) n)))
+ (and (do* ((n #f)
+ (i 0 (+ i 1))
+ (j (- 9 i) (- 9 i)))
+ ((>= i j))
+ (set! n (vec i))
+ (set! (vec i) (vec j))
+ (set! (vec j) n))
(equal? vec #(9 8 7 6 5 4 3 2 1 0))))
#t)
@@ -45296,7 +46014,7 @@ hi6: (string-app...
(test-t (string= (cl-make-string 1 :initial-element #\space) " "))
(test-t (string= (cl-make-string 0) ""))
- (test-t (null (dotimes (i 10))))
+ (test-t (dotimes (i 10)))
(test-t (= (dotimes (temp-one 10 temp-one)) 10))
(test-t (let ((temp-two 0)) (and (eq t (dotimes (temp-one 10 t) (incf temp-two))) (eql temp-two 10))))
(test-t (let ((count 0)) (eql (dotimes (i 5 count) (incf count)) 5)))
@@ -45319,15 +46037,15 @@ hi6: (string-app...
(test-t (= 3 (let ((x 0)) (dotimes (i 3 x) (incf x)))))
(test-t (= 3 (dotimes (i 3 i) )))
(test-t (= 3 (let ((x 0)) (dotimes (i 3 x) (declare (fixnum i)) (incf x)))))
- (test-t (null (dolist (x ()))))
- (test-t (null (dolist (x '(a)))))
+ (test-t (dolist (x ())))
+ (test-t (dolist (x '(a))))
(test-t (eq t (dolist (x nil t))))
(test-t (= 6 (let ((sum 0)) (dolist (x '(0 1 2 3) sum) (incf sum x)))))
(test-t (let ((temp-two ())) (equal (dolist (temp-one '(1 2 3 4) temp-two) (push temp-one temp-two)) '(4 3 2 1))))
- (test-t (let ((temp-two 0)) (and (null (dolist (temp-one '(1 2 3 4)) (incf temp-two))) (eql temp-two 4))))
- (test-t (null (dolist (var nil var))))
+ (test-t (let ((temp-two 0)) (and (dolist (temp-one '(1 2 3 4)) (incf temp-two)) (eql temp-two 4))))
+ (test-t (not (dolist (var nil var))))
(test-t (let ((list nil)) (equal (dolist (var '(0 1 2 3) list) (push var list)) '(3 2 1 0))))
- (test-t (null (dolist (var '(0 1 2 3)))))
+ (test-t (dolist (var '(0 1 2 3))))
(test-t (eql (do ((temp-one 1 (1+ temp-one)) (temp-two 0 (1- temp-two))) ((> (- temp-one temp-two) 5) temp-one)) 4))
(test-t (eql (do ((temp-one 1 (1+ temp-one)) (temp-two 0 (1+ temp-one))) ((= 3 temp-two) temp-one)) 3))
(test-t (eql (do* ((temp-one 1 (1+ temp-one)) (temp-two 0 (1+ temp-one))) ((= 3 temp-two) temp-one)) 2))
@@ -45351,53 +46069,53 @@ hi6: (string-app...
#(9 8 7 6 5 4 3 2 1 0))))
(test-t (let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
- (and (null (do ((i 0 (1+ i))
- (n #f)
- (j 9 (1- j)))
- ((>= i j))
- (setq n (aref vec i))
- (setf (aref vec i) (aref vec j))
- (setf (aref vec j) n)))
+ (and (do ((i 0 (1+ i))
+ (n #f)
+ (j 9 (1- j)))
+ ((>= i j))
+ (setq n (aref vec i))
+ (setf (aref vec i) (aref vec j))
+ (setf (aref vec j) n))
(equalp vec #(9 8 7 6 5 4 3 2 1 0)))))
(test-t (let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
- (and (null (do ((i 0 (1+ i))
- (n #f)
- (j 9 (1- j)))
- ((>= i j))
- (setq n (aref vec i))
- (setf (aref vec i) (aref vec j))
- (setf (aref vec j) n)))
+ (and (do ((i 0 (1+ i))
+ (n #f)
+ (j 9 (1- j)))
+ ((>= i j))
+ (setq n (aref vec i))
+ (setf (aref vec i) (aref vec j))
+ (setf (aref vec j) n))
(equalp vec #(9 8 7 6 5 4 3 2 1 0)))))
(test-t (let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
- (and (null (do ((i 0 (1+ i))
- (n #f)
- (j 9 (1- j)))
- ((>= i j))
- (setq n (aref vec i))
- (setf (aref vec i) (aref vec j))
- (setf (aref vec j) n)))
+ (and (do ((i 0 (1+ i))
+ (n #f)
+ (j 9 (1- j)))
+ ((>= i j))
+ (setq n (aref vec i))
+ (setf (aref vec i) (aref vec j))
+ (setf (aref vec j) n))
(equalp vec #(9 8 7 6 5 4 3 2 1 0)))))
(test-t (let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
- (and (null (do ((n #f)
- (i 0 (1+ i))
- (j 9 (1- j)))
- ((>= i j))
- (setq n (aref vec i))
- (setf (aref vec i) (aref vec j))
- (setf (aref vec j) n)))
+ (and (do ((n #f)
+ (i 0 (1+ i))
+ (j 9 (1- j)))
+ ((>= i j))
+ (setq n (aref vec i))
+ (setf (aref vec i) (aref vec j))
+ (setf (aref vec j) n))
(equalp vec #(9 8 7 6 5 4 3 2 1 0)))))
(test-t (let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
- (and (null (do ((i 0 (1+ i))
- (j 9 (1- j))
- (n #f))
- ((>= i j))
- (setq n (aref vec i))
- (setf (aref vec i) (aref vec j))
- (setf (aref vec j) n)))
+ (and (do ((i 0 (1+ i))
+ (j 9 (1- j))
+ (n #f))
+ ((>= i j))
+ (setq n (aref vec i))
+ (setf (aref vec i) (aref vec j))
+ (setf (aref vec j) n))
(equalp vec #(9 8 7 6 5 4 3 2 1 0)))))
(test-t (= (funcall (lambda (x) (+ x 3)) 4) 7))
@@ -46560,14 +47278,14 @@ hi6: (string-app...
(do ((n 0 (+ n 1)))
((= n 16))
(if (not (= n (logand (boole (boole-n-vector n) #b0101 #b0011) #b1111)))
- (format-logged #t "~A: ~A ~A~%" n (boole-n-vector n) (logand (boole (boole-n-vector n) #b0101 #b0011) #b1111))))
+ (format #t "~A: ~A ~A~%" n (boole-n-vector n) (logand (boole (boole-n-vector n) #b0101 #b0011) #b1111))))
(let ((lst ()))
(do ((n #b0000 (+ n 1)))
((> n #b1111))
(set! lst (cons (boole (boole-n-vector n) 5 3) lst)))
(if (not (equal? (reverse lst)
(list 0 1 2 3 4 5 6 7 -8 -7 -6 -5 -4 -3 -2 -1)))
- (format-logged #t ";boole: ~A~%" (reverse lst)))))
+ (format #t ";boole: ~A~%" (reverse lst)))))
(test (digit-char-p #\a) #f)
(test (digit-char-p #\a 16) 10)
@@ -46791,17 +47509,17 @@ hi6: (string-app...
;;; already a constant now (define-constant nan.0 (string->number "nan.0"))
(test (constant? nan.0) #t)
-(if (not (nan? nan.0)) (format-logged #t ";(string->number \"nan.0\") returned ~A~%" nan.0))
-(if (infinite? nan.0) (format-logged #t ";nan.0 is infinite?~%"))
+(if (not (nan? nan.0)) (format #t ";(string->number \"nan.0\") returned ~A~%" nan.0))
+(if (infinite? nan.0) (format #t ";nan.0 is infinite?~%"))
(define-constant +inf.0 (string->number "+inf.0"))
-(if (not (infinite? +inf.0)) (format-logged #t ";(string->number \"+inf.0\") returned ~A~%" +inf.0))
-(if (nan? +inf.0) (format-logged #t ";+inf.0 is NaN?~%"))
+(if (not (infinite? +inf.0)) (format #t ";(string->number \"+inf.0\") returned ~A~%" +inf.0))
+(if (nan? +inf.0) (format #t ";+inf.0 is NaN?~%"))
(test (constant? -inf.0) #t)
;;; (define-constant -inf.0 (string->number "-inf.0"))
-(if (not (infinite? -inf.0)) (format-logged #t ";(string->number \"-inf.0\") returned ~A~%" -inf.0))
-(if (nan? -inf.0) (format-logged #t ";-inf.0 is NaN?~%"))
+(if (not (infinite? -inf.0)) (format #t ";(string->number \"-inf.0\") returned ~A~%" -inf.0))
+(if (nan? -inf.0) (format #t ";-inf.0 is NaN?~%"))
;;; (define-constant inf.0 +inf.0)
(define-constant inf+infi (complex inf.0 inf.0))
@@ -46858,7 +47576,7 @@ hi6: (string-app...
(for-each
(lambda (n)
(let ((nb (catch #t (lambda () (number? n)) (lambda args 'error))))
- (if (not nb) (format-logged #t ";(number? ~A) -> #f?~%" n))))
+ (if (not nb) (format #t ";(number? ~A) -> #f?~%" n))))
(list '1e311 '1e-311 '0e311 '2.1e40000))
(when with-bignums
@@ -46876,7 +47594,7 @@ hi6: (string-app...
(for-each
(lambda (arg)
(if (op arg)
- (format-logged #t ";(~A ~A) -> #t?~%" op arg)))
+ (format #t ";(~A ~A) -> #t?~%" op arg)))
(list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
#<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>)))
(list number? complex? real? rational? integer? float?)
@@ -46911,7 +47629,7 @@ hi6: (string-app...
(for-each
(lambda (arg)
(if (not (complex? arg))
- (format-logged #t ";(complex? ~A) -> #f?~%" arg)))
+ (format #t ";(complex? ~A) -> #f?~%" arg)))
(list 1 1.0 1.0+0.5i 1/2))
(when with-bignums
@@ -47082,7 +47800,6 @@ hi6: (string-app...
(test (integer? 1+0i) #f) ; hmmm -- guile says #t, but it thinks 1.0 is an integer
(test (integer? 0/0) #f)
(test (integer? 1/0) #f)
-(test (integer? #e.1e010) #t)
(test (integer? (/ 2 1)) #t)
(test (integer? (/ 2 1.0)) #f)
(test (integer? -1.797693134862315699999999999999999999998E308) #f)
@@ -47249,7 +47966,7 @@ hi6: (string-app...
(let ((num (string->number (substring str 0 j))))
(if (or (nan? num)
(infinite? num))
- (format-logged #t "~A: ~S -> ~A~%" (if (infinite? num) 'inf 'nan) str num)))
+ (format #t "~A: ~S -> ~A~%" (if (infinite? num) 'inf 'nan) str num)))
)))
|#
@@ -47713,13 +48430,13 @@ hi6: (string-app...
(for-each
(lambda (n)
(if (not (positive? n))
- (format-logged #t ";(positive? ~A) -> #f?~%") n))
+ (format #t ";(positive? ~A) -> #f?~%") n))
(list 1 123 123456123 1.4 0.001 1/2 124124124.2))
(for-each
(lambda (n)
(if (positive? n)
- (format-logged #t ";(positive? ~A) -> #t?~%" n)))
+ (format #t ";(positive? ~A) -> #t?~%" n)))
(list -1 -123 -123456123 -3/2 -0.00001 -1.4 -123124124.1))
(when with-bignums
@@ -47785,13 +48502,13 @@ hi6: (string-app...
(for-each
(lambda (n)
(if (negative? n)
- (format-logged #t ";(negative? ~A) -> #t?~%" n)))
+ (format #t ";(negative? ~A) -> #t?~%" n)))
(list 1 123 123456123 1.4 0.001 1/2 12341243124.2))
(for-each
(lambda (n)
(if (not (negative? n))
- (format-logged #t ";(negative? ~A) -> #f?~%" n)))
+ (format #t ";(negative? ~A) -> #f?~%" n)))
(list -1 -123 -123456123 -2/3 -0.00001 -1.4 -123124124.1))
(let ((val1 (catch #t (lambda () (negative? 0.0)) (lambda args 'error)))
@@ -47848,13 +48565,13 @@ hi6: (string-app...
(for-each
(lambda (n)
(if (odd? n)
- (format-logged #t ";(odd? ~A) -> #t?~%" n)))
+ (format #t ";(odd? ~A) -> #t?~%" n)))
(list 0 2 1234 -4 -10000002 1000000006))
(for-each
(lambda (n)
(if (not (odd? n))
- (format-logged #t ";(odd? ~A) -> #f?~%" n)))
+ (format #t ";(odd? ~A) -> #f?~%" n)))
(list 1 -1 31 50001 543321))
(when with-bignums
@@ -47911,13 +48628,13 @@ hi6: (string-app...
(for-each
(lambda (n)
(if (not (even? n))
- (format-logged #t ";(even? ~A) -> #f?~%" n)))
+ (format #t ";(even? ~A) -> #f?~%" n)))
(list 0 2 1234 -4 -10000002 1000000006))
(for-each
(lambda (n)
(if (even? n)
- (format-logged #t ";(even? ~A) -> #t?~%" n)))
+ (format #t ";(even? ~A) -> #t?~%" n)))
(list 1 -1 31 50001 543321))
(let ((top-exp 60))
@@ -48148,7 +48865,6 @@ hi6: (string-app...
;(num-test (inexact->exact 9007199254740995.0) 9007199254740995)
;this can't work in the non-gmp case -- see s7.c under BIGNUM_PLUS
-;#e4611686018427388404.0 -> 4611686018427387904
(if with-bignums
(begin
@@ -48157,8 +48873,6 @@ hi6: (string-app...
(num-test (inexact->exact 1e20) 100000000000000000000)
(num-test (inexact->exact 9007199254740995.0) 9007199254740995)
(num-test (inexact->exact 4611686018427388404.0) 4611686018427388404)
- (num-test #e9007199254740995.0 9007199254740995)
- (num-test #e4611686018427388404.0 4611686018427388404)
(test (inexact->exact (bignum "0+1.5i")) 'error))
(begin
(test (inexact->exact 1.1e54) 'error)
@@ -51029,7 +51743,7 @@ hi6: (string-app...
(let ((val (integer-decode-float 1.0e-307)))
(if (and (not (equal? val '(5060056332682765 -1072 1)))
(not (equal? val '(5060056332682766 -1072 1))))
- (format-logged #t ";(integer-decode-float 1.0e-307) got ~A?~%" val)))
+ (format #t ";(integer-decode-float 1.0e-307) got ~A?~%" val)))
(test (integer-decode-float (/ 1.0e-307 100.0e0)) '(4706001880677807 -1075 1)) ; denormal
(test (integer-decode-float (/ (log 0.0))) '(6755399441055744 972 -1)) ; nan
@@ -51087,7 +51801,7 @@ hi6: (string-app...
(lambda (arg)
(let ((val (catch #t (lambda () (op arg)) (lambda args 'error))))
(if (not (equal? val 'error))
- (format-logged #t ";(~A ~A) -> ~A?~%" op arg val))))
+ (format #t ";(~A ~A) -> ~A?~%" op arg val))))
(list "hi" _ht_ _null_ _c_obj_ () '(1 2) #f (integer->char 65) 'a-symbol (make-vector 3) 3.14 3/4 3.1+i abs #\f (lambda (a) (+ a 1)))))
(list logior logand lognot logxor logbit? ash integer-length))
@@ -51097,7 +51811,7 @@ hi6: (string-app...
(lambda (arg)
(let ((val (catch #t (lambda () (op 1 arg)) (lambda args 'error))))
(if (not (equal? val 'error))
- (format-logged #t ";(~A ~A) -> ~A?~%" op arg val))))
+ (format #t ";(~A ~A) -> ~A?~%" op arg val))))
(list "hi" _ht_ _null_ _c_obj_ () '(1 2) #f (integer->char 65) 'a-symbol (make-vector 3) 3.14 -1/2 1+i abs #\f (lambda (a) (+ a 1)))))
(list logior logand logxor lognot logbit?))
@@ -51110,7 +51824,6 @@ hi6: (string-app...
(num-test (lognot 12341234) -12341235)
(num-test (lognot #b-101) 4)
(num-test (lognot (+ 1 (lognot 1000))) 999)
-(num-test (lognot #e10e011) -1000000000001)
(num-test (lognot -9223372036854775808) 9223372036854775807)
(num-test (lognot 9223372036854775807) -9223372036854775808)
(num-test (lognot most-positive-fixnum) most-negative-fixnum)
@@ -51350,7 +52063,7 @@ hi6: (string-app...
(set! ints (cons (- (random 1000) 500) ints)))
(let ((result (apply log-1-of ints)))
- ;;(format-logged #t "(test (log-1-of ~{~D~^ ~}) #b~B) ; (~D)~%" ints result result)
+ ;;(format #t "(test (log-1-of ~{~D~^ ~}) #b~B) ; (~D)~%" ints result result)
(do ((b 0 (+ b 1)))
((= b top-checked-bit))
@@ -51363,9 +52076,9 @@ hi6: (string-app...
(if (logbit? result b) ;(not (zero? (logand result (ash 1 b))))
(if (not (= counts 1))
- (format-logged #t ";(log-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" ints result (ash 1 b) counts))
+ (format #t ";(log-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" ints result (ash 1 b) counts))
(if (= counts 1)
- (format-logged #t ";(log-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts = 1 but we're off]~%" ints result (ash 1 b)))))))))
+ (format #t ";(log-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts = 1 but we're off]~%" ints result (ash 1 b)))))))))
(define (log-n-1-of . ints) ; bits on in exactly n-1 of ints
@@ -51436,7 +52149,7 @@ hi6: (string-app...
(set! ints (cons (- (random 1000) 500) ints)))
(let ((result (apply log-n-1-of ints)))
- ;;(format-logged #t "(test (log-n-1-of ~{~D~^ ~}) #b~B) ; (~D)~%" ints result result)
+ ;;(format #t "(test (log-n-1-of ~{~D~^ ~}) #b~B) ; (~D)~%" ints result result)
(do ((b 0 (+ b 1)))
((= b top-checked-bit))
@@ -51449,9 +52162,9 @@ hi6: (string-app...
(if (logbit? result b) ;(not (zero? (logand result (ash 1 b))))
(if (not (= counts (- len 1)))
- (format-logged #t ";(log-n-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" ints result (ash 1 b) counts))
+ (format #t ";(log-n-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" ints result (ash 1 b) counts))
(if (and (> len 1) (= counts (- len 1)))
- (format-logged #t ";(log-n-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're off]~%" ints result (ash 1 b) counts))))))))
+ (format #t ";(log-n-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're off]~%" ints result (ash 1 b) counts))))))))
(define (log-n-of n . ints) ; bits on in exactly n of ints
(let ((len (length ints)))
@@ -51561,7 +52274,7 @@ hi6: (string-app...
(set! ints (cons (- (random 1000) 500) ints)))
(let ((result (apply log-n-of n ints)))
- ;;(format-logged #t "(test (log-n-of ~D ~{~D~^ ~}) #b~B) ; (~D)~%" n ints result result)
+ ;;(format #t "(test (log-n-of ~D ~{~D~^ ~}) #b~B) ; (~D)~%" n ints result result)
(do ((b 0 (+ b 1)))
((= b top-checked-bit))
@@ -51574,9 +52287,9 @@ hi6: (string-app...
(if (logbit? result b) ;(not (zero? (logand result (ash 1 b))))
(if (not (= counts n))
- (format-logged #t ";(log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" n ints result (ash 1 b) counts))
+ (format #t ";(log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" n ints result (ash 1 b) counts))
(if (and (> len 1) (= counts n))
- (format-logged #t ";(log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're off]~%" n ints result (ash 1 b) counts))))))))
+ (format #t ";(log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're off]~%" n ints result (ash 1 b) counts))))))))
(define (simple-log-n-of n . ints) ; bits on in exactly n of ints
@@ -51630,9 +52343,9 @@ hi6: (string-app...
(if (logbit? result b) ;(not (zero? (logand result (ash 1 b))))
(if (not (= counts n))
- (format-logged #t ";(simple-log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" n ints result (ash 1 b) counts))
+ (format #t ";(simple-log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" n ints result (ash 1 b) counts))
(if (and (> len 1) (= counts n))
- (format-logged #t ";(simple-log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're off]~%" n ints result (ash 1 b) counts)))))))))
+ (format #t ";(simple-log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're off]~%" n ints result (ash 1 b) counts)))))))))
(let () ; from sbcl/contrib/sb-rotate-byte
(define (rotate-byte count bytespec integer) ; logrot?
@@ -51731,7 +52444,7 @@ hi6: (string-app...
(let ((on? (logbit? x index))
(ash? (not (zero? (logand x (ash 1 index))))))
(if (not (eq? on? ash?))
- (format-logged #t "(logbit? ~A ~A): ~A ~A~%" x index on? ash?)))))
+ (format #t "(logbit? ~A ~A): ~A ~A~%" x index on? ash?)))))
@@ -52207,7 +52920,6 @@ hi6: (string-app...
;;; ceiling
;;; --------------------------------------------------------------------------------
-(num-test (ceiling #e-01-0i ) -1)
(num-test (ceiling (- (+ 1 -1/123400000))) 0)
(num-test (ceiling (- 1 1/123400000)) 1)
(num-test (ceiling (/ (- most-positive-fixnum 1) most-positive-fixnum)) 1)
@@ -52446,7 +53158,8 @@ hi6: (string-app...
(test (= (round (* 131836323/93222358 131836323/93222358 1.0)) (round (* 318281039/225058681 318281039/225058681))) #t)
(test (= (round (* 1393/985 1393/985 1.0)) (round (* 3363/2378 3363/2378))) #t)
(test (= (round (* 1607521/1136689 1607521/1136689 1.0)) (round (* 3880899/2744210 3880899/2744210))) #t)
-(test (= (round (* 1855077841/1311738121 1855077841/1311738121 1.0)) (round (* 4478554083/3166815962 4478554083/3166815962))) #t)
+(if (provided? 'overflow-checks)
+ (test (= (round (* 1855077841/1311738121 1855077841/1311738121 1.0)) (round (* 4478554083/3166815962 4478554083/3166815962))) #t))
(test (= (round (* 19601/13860 19601/13860 1.0)) (round (* 47321/33461 47321/33461))) #t)
(test (= (round (* 275807/195025 275807/195025 1.0)) (round (* 1607521/1136689 1607521/1136689))) #t)
(test (= (round (* 318281039/225058681 318281039/225058681 1.0)) (round (* 1855077841/1311738121 1855077841/1311738121))) #t)
@@ -52467,6 +53180,7 @@ hi6: (string-app...
#<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
(num-test (round 400000000000000000/800000000000000001) 0)
+(num-test (round 400000000000000000/800000000000000000) 0)
(num-test (round 400000000000000000/799999999999999999) 1)
(when with-bignums
@@ -52540,13 +53254,13 @@ hi6: (string-app...
(cv (ceiling val1))
(tv (truncate val1)))
(if (not (= fv (- val2 1)))
- (begin (set! happy #f) (format-logged #t ";(floor ~S) = ~S?~%" val1 fv)))
+ (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
(if (not (= cv val2))
- (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+ (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
(if (not (= tv (- val2 1)))
- (begin (set! happy #f) (format-logged #t ";(truncate ~S) = ~S?~%" val1 tv)))
+ (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
(if (not (= rv val2))
- (begin (set! happy #f) (format-logged #t ";(round ~S) = ~S?~%" val1 rv))))))
+ (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))))
(let ((happy #t))
(do ((i 2 (+ i 1)))
@@ -52558,13 +53272,13 @@ hi6: (string-app...
(cv (ceiling val1))
(tv (truncate val1)))
(if (not (= fv val2))
- (begin (set! happy #f) (format-logged #t ";(floor ~S) = ~S?~%" val1 fv)))
+ (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
(if (not (= cv (+ val2 1)))
- (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+ (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
(if (not (= tv val2))
- (begin (set! happy #f) (format-logged #t ";(truncate ~S) = ~S?~%" val1 tv)))
+ (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
(if (not (= rv val2))
- (begin (set! happy #f) (format-logged #t ";(round ~S) = ~S?~%" val1 rv))))))
+ (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))))
(let ((happy #t))
(do ((i 2 (+ i 1)))
@@ -52572,13 +53286,13 @@ hi6: (string-app...
(let* ((val1 (expt 2 i))
(val2 (- val1 1)))
(if (= (floor val1) (floor val2))
- (begin (set! happy #f) (format-logged #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
(if (= (ceiling val1) (ceiling val2))
- (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
(if (= (truncate val1) (truncate val2))
- (begin (set! happy #f) (format-logged #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
(if (= (round val1) (round val2))
- (begin (set! happy #f) (format-logged #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
+ (begin (set! happy #f) (format #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
(let ((happy #t))
(do ((i 2 (+ i 1)))
@@ -52586,13 +53300,13 @@ hi6: (string-app...
(let* ((val1 (/ (- (expt 2 i) 1) 2))
(val2 (/ (- (expt 2 i) 3) 2)))
(if (= (floor val1) (floor val2))
- (begin (set! happy #f) (format-logged #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
(if (= (ceiling val1) (ceiling val2))
- (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
(if (= (truncate val1) (truncate val2))
- (begin (set! happy #f) (format-logged #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
(if (= (round val1) (round val2))
- (begin (set! happy #f) (format-logged #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
+ (begin (set! happy #f) (format #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
(let ((happy #t)
(off-by 1/3))
@@ -52604,16 +53318,16 @@ hi6: (string-app...
(tv (truncate val1))
(rv (round val1)))
(if (not (= fv (- val1 off-by)))
- (begin (set! happy #f) (format-logged #t ";(floor ~S) = ~S?~%" val1 fv)))
+ (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
(if (not (= cv (+ val1 (- 1 off-by))))
- (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+ (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
(if (not (= tv (- val1 off-by)))
- (begin (set! happy #f) (format-logged #t ";(truncate ~S) = ~S?~%" val1 tv)))
+ (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
(if (= off-by 1/3)
(if (not (= rv (- val1 off-by)))
- (begin (set! happy #f) (format-logged #t ";(round ~S) = ~S?~%" val1 rv)))
+ (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv)))
(if (not (= rv (+ val1 (- 1 off-by))))
- (begin (set! happy #f) (format-logged #t ";(round ~S) = ~S?~%" val1 rv))))
+ (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))
(if (= off-by 1/3)
(set! off-by 2/3)
(set! off-by 1/3)))))
@@ -52628,13 +53342,13 @@ hi6: (string-app...
(cv (ceiling val1))
(tv (truncate val1)))
(if (not (= fv val2))
- (begin (set! happy #f) (format-logged #t ";(floor ~S) = ~S?~%" val1 fv)))
+ (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
(if (not (= cv (+ val2 1)))
- (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+ (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
(if (not (= tv (+ val2 1)))
- (begin (set! happy #f) (format-logged #t ";(truncate ~S) = ~S?~%" val1 tv)))
+ (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
(if (not (= rv val2))
- (begin (set! happy #f) (format-logged #t ";(round ~S) = ~S?~%" val1 rv))))))
+ (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))))
(let ((happy #t))
(do ((i 2 (+ i 1)))
@@ -52646,13 +53360,13 @@ hi6: (string-app...
(cv (ceiling val1))
(tv (truncate val1)))
(if (not (= fv (- val2 1)))
- (begin (set! happy #f) (format-logged #t ";(floor ~S) = ~S?~%" val1 fv)))
+ (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
(if (not (= cv val2))
- (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+ (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
(if (not (= tv val2))
- (begin (set! happy #f) (format-logged #t ";(truncate ~S) = ~S?~%" val1 tv)))
+ (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
(if (not (= rv val2))
- (begin (set! happy #f) (format-logged #t ";(round ~S) = ~S?~%" val1 rv))))))
+ (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))))
(let ((happy #t))
(do ((i 2 (+ i 1)))
@@ -52660,13 +53374,13 @@ hi6: (string-app...
(let* ((val1 (- (expt 2 i)))
(val2 (+ val1 1)))
(if (= (floor val1) (floor val2))
- (begin (set! happy #f) (format-logged #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
(if (= (ceiling val1) (ceiling val2))
- (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
(if (= (truncate val1) (truncate val2))
- (begin (set! happy #f) (format-logged #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
(if (= (round val1) (round val2))
- (begin (set! happy #f) (format-logged #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
+ (begin (set! happy #f) (format #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
(let ((happy #t))
(do ((i 2 (+ i 1)))
@@ -52674,13 +53388,13 @@ hi6: (string-app...
(let* ((val1 (- (/ (- (expt 2 i) 1) 2)))
(val2 (- (/ (- (expt 2 i) 3) 2))))
(if (= (floor val1) (floor val2))
- (begin (set! happy #f) (format-logged #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
(if (= (ceiling val1) (ceiling val2))
- (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
(if (= (truncate val1) (truncate val2))
- (begin (set! happy #f) (format-logged #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
(if (= (round val1) (round val2))
- (begin (set! happy #f) (format-logged #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
+ (begin (set! happy #f) (format #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
(let ((happy #t)
(off-by 2/3))
@@ -52692,16 +53406,16 @@ hi6: (string-app...
(tv (truncate val1))
(rv (round val1)))
(if (not (= fv (- val1 off-by)))
- (begin (set! happy #f) (format-logged #t ";(floor ~S) = ~S?~%" val1 fv)))
+ (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
(if (not (= cv (+ val1 (- 1 off-by))))
- (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+ (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
(if (not (= tv (+ val1 (- 1 off-by))))
- (begin (set! happy #f) (format-logged #t ";(truncate ~S) = ~S?~%" val1 tv)))
+ (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
(if (= off-by 1/3)
(if (not (= rv (- val1 off-by)))
- (begin (set! happy #f) (format-logged #t ";(round ~S) = ~S?~%" val1 rv)))
+ (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv)))
(if (not (= rv (+ val1 (- 1 off-by))))
- (begin (set! happy #f) (format-logged #t ";(round ~S) = ~S?~%" val1 rv))))
+ (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))
(if (= off-by 1/3)
(set! off-by 2/3)
(set! off-by 1/3)))))
@@ -53963,7 +54677,8 @@ hi6: (string-app...
(if with-bignums (test (= (quotient 2.0 (* 318281039/225058681 318281039/225058681)) (quotient (* 1855077841/1311738121 1855077841/1311738121) 2.0)) #f))
(test (= (quotient 318281039/225058681 1855077841/1311738121) (floor (/ 318281039/225058681 1855077841/1311738121))) #t)
(if with-bignums (test (= (quotient (* 1855077841/1311738121 1855077841/1311738121) 2) (quotient (* 4478554083/3166815962 4478554083/3166815962) 2)) #f))
-(test (= (quotient 2.0 (* 1855077841/1311738121 1855077841/1311738121)) (quotient (* 4478554083/3166815962 4478554083/3166815962) 2.0)) #t)
+(if (provided? 'overflow-checks)
+ (test (= (quotient 2.0 (* 1855077841/1311738121 1855077841/1311738121)) (quotient (* 4478554083/3166815962 4478554083/3166815962) 2.0)) #t))
(test (= (quotient 1855077842/1311738121 4478554083/3166815962) (floor (/ 1855077842/1311738121 4478554083/3166815962))) #t)
;;; there's one really dumb problem here:
@@ -54454,9 +55169,10 @@ hi6: (string-app...
(num-test (remainder 110.123 4.0) 2.123)
(num-test (remainder 110.123 1000.1) 110.123)
-(num-test (remainder 3/2 most-negative-fixnum) 3/2)
-(num-test (remainder 3/2 most-positive-fixnum) 3/2)
-(num-test (remainder most-negative-fixnum -1) 0)
+(when (provided? 'overflow-checks)
+ (num-test (remainder 3/2 most-negative-fixnum) 3/2)
+ (num-test (remainder 3/2 most-positive-fixnum) 3/2)
+ (num-test (remainder most-negative-fixnum -1) 0))
(test (= (remainder (* 577/408 577/408) 2) (remainder (* 1393/985 1393/985) 2)) #f)
(test (= (remainder 2.0 (* 577/408 577/408)) (remainder (* 1393/985 1393/985) 2.0)) #f)
@@ -54488,11 +55204,12 @@ hi6: (string-app...
(num-test (+ (remainder 959536/125743 47321/33461) (* 47321/33461 (quotient 959536/125743 47321/33461))) 959536/125743)
(num-test (+ (remainder 2606489/301994 114243/80782) (* 114243/80782 (quotient 2606489/301994 114243/80782))) 2606489/301994)
(num-test (+ (remainder 97961303/11350029 275807/195025) (* 275807/195025 (quotient 97961303/11350029 275807/195025))) 97961303/11350029)
-(num-test (+ (remainder 109303762/16483927 1607521/1136689) (* 1607521/1136689 (quotient 109303762/16483927 1607521/1136689))) 109303762/16483927)
-(num-test (+ (remainder 27869189/17087915 3880899/2744210) (* 3880899/2744210 (quotient 27869189/17087915 3880899/2744210))) 27869189/17087915)
-(num-test (+ (remainder 564541319/85137581 9369319/6625109) (* 9369319/6625109 (quotient 564541319/85137581 9369319/6625109))) 564541319/85137581)
-(num-test (+ (remainder 2351934037/272500658 54608393/38613965) (* 54608393/38613965 (quotient 2351934037/272500658 54608393/38613965))) 2351934037/272500658)
-(num-test (+ (remainder 1657851173/630138897 131836323/93222358) (* 131836323/93222358 (quotient 1657851173/630138897 131836323/93222358))) 1657851173/630138897)
+(when (provided? 'overflow-checks)
+ (num-test (+ (remainder 109303762/16483927 1607521/1136689) (* 1607521/1136689 (quotient 109303762/16483927 1607521/1136689))) 109303762/16483927)
+ (num-test (+ (remainder 27869189/17087915 3880899/2744210) (* 3880899/2744210 (quotient 27869189/17087915 3880899/2744210))) 27869189/17087915)
+ (num-test (+ (remainder 564541319/85137581 9369319/6625109) (* 9369319/6625109 (quotient 564541319/85137581 9369319/6625109))) 564541319/85137581)
+ (num-test (+ (remainder 2351934037/272500658 54608393/38613965) (* 54608393/38613965 (quotient 2351934037/272500658 54608393/38613965))) 2351934037/272500658)
+ (num-test (+ (remainder 1657851173/630138897 131836323/93222358) (* 131836323/93222358 (quotient 1657851173/630138897 131836323/93222358))) 1657851173/630138897))
(when with-bignums
(num-test (remainder -9223372036854775808 5.551115123125783999999999999999999999984E-17) -2.295798100238055639010781305842101573944E-17)
@@ -55923,16 +56640,18 @@ hi6: (string-app...
(num-test (lcm 169216424701305960 17) 2876679219922201320)
(num-test (lcm 178335507754891305 817) 178335507754891305)
+(when (provided? 'overflow-checks)
+ (num-test (lcm 10781274/17087915 3880899/2744210) (/ (* 10781274/17087915 3880899/2744210) (gcd 10781274/17087915 3880899/2744210)))
+ (num-test (lcm 190537/301994 114243/80782) (/ (* 190537/301994 114243/80782) (gcd 190537/301994 114243/80782)))
+ (num-test (lcm 397573379/630138897 131836323/93222358) (/ (* 397573379/630138897 131836323/93222358) (gcd 397573379/630138897 131836323/93222358))))
+
(num-test (lcm 10400200/16483927 1607521/1136689) (/ (* 10400200/16483927 1607521/1136689) (gcd 10400200/16483927 1607521/1136689)))
-(num-test (lcm 10781274/17087915 3880899/2744210) (/ (* 10781274/17087915 3880899/2744210) (gcd 10781274/17087915 3880899/2744210)))
(num-test (lcm 12/19 41/29) (/ (* 12/19 41/29) (gcd 12/19 41/29)))
(num-test (lcm 12941/20511 3363/2378) (/ (* 12941/20511 3363/2378) (gcd 12941/20511 3363/2378)))
(num-test (lcm 15601/24727 19601/13860) (/ (* 15601/24727 19601/13860) (gcd 15601/24727 19601/13860)))
(num-test (lcm 171928773/272500658 54608393/38613965) (/ (* 171928773/272500658 54608393/38613965) (gcd 171928773/272500658 54608393/38613965)))
-(num-test (lcm 190537/301994 114243/80782) (/ (* 190537/301994 114243/80782) (gcd 190537/301994 114243/80782)))
(num-test (lcm 2/3 3/2) (/ (* 2/3 3/2) (gcd 2/3 3/2)))
(num-test (lcm 253/401 577/408) (/ (* 253/401 577/408) (gcd 253/401 577/408)))
-(num-test (lcm 397573379/630138897 131836323/93222358) (/ (* 397573379/630138897 131836323/93222358) (gcd 397573379/630138897 131836323/93222358)))
(num-test (lcm 4201378396/6659027209 318281039/225058681) (/ (* 4201378396/6659027209 318281039/225058681) (gcd 4201378396/6659027209 318281039/225058681)))
(num-test (lcm 5/8 17/12) (/ (* 5/8 17/12) (gcd 5/8 17/12)))
(num-test (lcm 53/84 99/70) (/ (* 53/84 99/70) (gcd 53/84 99/70)))
@@ -56325,7 +57044,6 @@ hi6: (string-app...
(test (lcm 0 "hi") 'error)
(test (lcm 0 1 "hi") 'error)
-(test (lcm 1 ' #e1.(logior )) 0) ; (lcm 1 1 0)
(test (lcm 1.4 2.3) 'error)
(test (lcm 2 1.0+0.5i) 'error)
@@ -56838,7 +57556,7 @@ hi6: (string-app...
(vector-set! diffs i diff)
(if (> diff err)
(begin
- (format-logged #t "|~A - ~A| = ~A > ~A (2^~A -> 2^~A)?~%" val rat diff err (log diff 2) (log err 2))
+ (format #t "|~A - ~A| = ~A > ~A (2^~A -> 2^~A)?~%" val rat diff err (log diff 2) (log err 2))
(return #f)))))
(and (apply >= (vector->list diffs))
(apply <= (map denominator ratios)))))))
@@ -56853,7 +57571,7 @@ hi6: (string-app...
(let ((val (- (random 2.0) 1.0)))
(let ((rat (check-rationalize val 40)))
(if (not rat)
- (format-logged #t "rationalize trouble with ~A~%" val)))))
+ (format #t "rationalize trouble with ~A~%" val)))))
(when with-bignums
(let-temporarily (((*s7* 'bignum-precision) 4096))
@@ -56921,7 +57639,7 @@ hi6: (string-app...
((= i 100))
(if (not (zero? (random fraction)))
(ok))))
- (format-logged #t ";random of small ratios is always 0 below ca. ~A~%" (expt 10.0 k))
+ (format #t ";random of small ratios is always 0 below ca. ~A~%" (expt 10.0 k))
(done))))))
@@ -57697,24 +58415,6 @@ hi6: (string-app...
;; mpfr says the first fraction is 1.000000000000000020925101928970235578612E-3
(num-test (max 1e18 most-positive-fixnum) most-positive-fixnum) ; in bignum case there's type confusion here I think (hence num-test)
-(when with-bignums
- (num-test (max 12345678901234567890 12345678901234567891) 12345678901234567891)
- (num-test (max 9223372036854776/9223372036854775807 #i9223372036854775/9223372036854775000) 1.000000000000000020925101928970235578612E-3)
- (num-test (max #i9223372036854776/9223372036854775807 9223372036854775/9223372036854775000) 1.000000000000000020925101928970235578612E-3)
- (num-test (max #i92233720368547757/9223372036854775807 92233720368547758/9223372036854775807) 9.999999999999999992410584792601468961145E-3)
- (num-test (max 92233720368547757/9223372036854775807 #i92233720368547758/9223372036854775807) 9.999999999999999992410584792601468961145E-3)
-
- ;; in these cases, the non-gmp s7 can't win:
- ;; :(max 9223372036854776/9223372036854775807 #i9223372036854775/9223372036854775000)
- ;; 9223372036854776/9223372036854775807
- ;; :(max #i9223372036854776/9223372036854775807 9223372036854775/9223372036854775000)
- ;; 0.001
- ;; :(max #i92233720368547757/9223372036854775807 92233720368547758/9223372036854775807)
- ;; 0.01
- ;; :(max 92233720368547757/9223372036854775807 #i92233720368547758/9223372036854775807)
- ;; 92233720368547757/9223372036854775807
- )
-
(test (max) 'error)
(test (max 1.23+1.0i) 'error)
(test (max -0.0+0.00000001i) 'error)
@@ -59114,7 +59814,6 @@ hi6: (string-app...
(test (= 2 -1) #f)
(test (= 2 -2) #f)
-(test (= #i3/5 #i3/5) #t)
(test (= -0 0) #t)
(test (= -0-0i 0.0) #t)
(test (= -0.0 0.0) #t)
@@ -59304,7 +60003,6 @@ hi6: (string-app...
(test (= (* 1.0 16743730547042864/1996007985) 8388609) #f)
(test (= (* 1.0 13981015002796202/1666666667) 8388609) #f)
- (test (= (string->number "#e.1e20") 1e19) #t)
(test (= (bignum "3") 1/0) #f)
(test (= 12345678901234567890 12345678901234567891) #f)
(test (= most-positive-fixnum (- (/ most-negative-fixnum -1) 1)) #t)
@@ -59996,7 +60694,7 @@ hi6: (string-app...
(let ((val1 (catch #t (lambda () (op 1.0)) (lambda args 'error)))
(val2 (catch #t (lambda () (op 1.0+0i)) (lambda args 'error))))
(if (not (morally-equal? val1 val2)) ; ignore nans
- (format-logged #t ";(~A 1) != (~A 1+0i)? (~A ~A)~%" op op val1 val2))))
+ (format #t ";(~A 1) != (~A 1+0i)? (~A ~A)~%" op op val1 val2))))
(list magnitude angle rationalize abs exp log sin cos tan asin acos atan
sinh cosh tanh asinh acosh atanh sqrt floor ceiling truncate round + - * /
max min number? integer? real? complex? rational?
@@ -60654,7 +61352,7 @@ hi6: (string-app...
(set! max-case (/ m n))
(set! maxerr err)))))))))
(if (> maxerr 1e-35)
- (format-logged #t "sin-m*pi/n (~A cases) max err ~A at ~A~%" cases maxerr max-case)))))
+ (format #t "sin-m*pi/n (~A cases) max err ~A at ~A~%" cases maxerr max-case)))))
(let ((sins (list
0.00000000000000000000000000000000000000000000000000000000000000000000
@@ -60697,7 +61395,7 @@ hi6: (string-app...
(let ((err (abs (- (sin x) (list-ref sins i)))))
(if (> err mxerr)
(set! mxerr err))))
- (if (> mxerr 1e-12) (format-logged #t "sin err: ~A~%" mxerr))))
+ (if (> mxerr 1e-12) (format #t "sin err: ~A~%" mxerr))))
(when with-bignums
(let-temporarily (((*s7* 'bignum-precision) 500))
@@ -60737,7 +61435,7 @@ hi6: (string-app...
((= k 30))
(let ((sin-val-2 (number->string (sin (/ k (bignum "10"))))))
(if (not (string=? (substring (list-ref sin-vals k) 3 60) (substring sin-val-2 2 59)))
- (format-logged #t ";(sin (/ ~A 10)) mp: ~A does not match~%~A~%" k (substring (list-ref sin-vals k) 3 60) (substring sin-val-2 2 59))))))
+ (format #t ";(sin (/ ~A 10)) mp: ~A does not match~%~A~%" k (substring (list-ref sin-vals k) 3 60) (substring sin-val-2 2 59))))))
(let ((sin-vals (list ;arprec mathtool table[Sin[k/10], {k, 0, 30}]
0.00000000000000000000000000000000000000000000000000000000000000000000
@@ -60782,7 +61480,7 @@ hi6: (string-app...
(if (> err mxerr)
(set! mxerr err)))))))
(if (> mxerr 1e-35)
- (format-logged #t ";(sin big-angle) max error: ~A" mxerr)))))
+ (format #t ";(sin big-angle) max error: ~A" mxerr)))))
@@ -61304,7 +62002,7 @@ hi6: (string-app...
(if (> err mx)
(set! mx err))))
(if (> mx 1e-6)
- (format-logged #t "dht error: ~A~%" mx)))))
+ (format #t "dht error: ~A~%" mx)))))
(let ((coss (list
1.00000000000000000000000000000000000000000000000000000000000000000000
@@ -61347,7 +62045,7 @@ hi6: (string-app...
(let ((err (abs (- (cos x) (list-ref coss i)))))
(if (> err mxerr)
(set! mxerr err))))
- (if (> mxerr 1e-12) (format-logged #t "cos err: ~A~%" mxerr))))
+ (if (> mxerr 1e-12) (format #t "cos err: ~A~%" mxerr))))
(when with-bignums
(num-test (cos 100000000000000000000000000000000) -9.207313839241906875982573440296245746235E-1)
@@ -61389,7 +62087,7 @@ hi6: (string-app...
((= k 30))
(let ((cos-val-2 (number->string (cos (/ k (bignum "20"))))))
(if (not (string=? (substring (list-ref cos-vals k) 3 60) (substring cos-val-2 2 59)))
- (format-logged #t ";(cos (/ ~A 20)) mp: ~A does not match~%~A~%" k (substring (list-ref cos-vals k) 3 60) (substring cos-val-2 2 59))))))))
+ (format #t ";(cos (/ ~A 20)) mp: ~A does not match~%~A~%" k (substring (list-ref cos-vals k) 3 60) (substring cos-val-2 2 59))))))))
@@ -61831,7 +62529,7 @@ hi6: (string-app...
(set! mxerr err)
(set! mxcase i))))))
(if (> mxerr 1e-35)
- (format-logged #t "sum-cot max error ~A at ~A~%" mxerr mxcase)))))
+ (format #t "sum-cot max error ~A at ~A~%" mxerr mxcase)))))
(for-each
(lambda (num-and-val)
@@ -61886,7 +62584,7 @@ hi6: (string-app...
((= i 30))
(let ((val (tan (/ i (bignum "10")))))
(if (> (magnitude (- val (list-ref tans i))) 1e-35)
- (format-logged #t ";(tan ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref tans i) (magnitude (- val (list-ref tans i))))))))))
+ (format #t ";(tan ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref tans i) (magnitude (- val (list-ref tans i))))))))))
(test (tan) 'error)
(test (tan "hi") 'error)
@@ -62402,7 +63100,7 @@ hi6: (string-app...
(let ((y (magnitude (- x (sin (asin x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-12)
- (format-logged #t ";(sin (asin ~A)) error: ~A~%" mx err)))
+ (format #t ";(sin (asin ~A)) error: ~A~%" mx err)))
(let ((err 0.0)
(mx 0.0))
@@ -62412,7 +63110,7 @@ hi6: (string-app...
(let ((y (magnitude (- x (sin (asin x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-9)
- (format-logged #t ";(sin (asin ~A)) error: ~A~%" mx err)))
+ (format #t ";(sin (asin ~A)) error: ~A~%" mx err)))
(test (asin) 'error)
(test (asin "hi") 'error)
@@ -62474,7 +63172,7 @@ hi6: (string-app...
(let ((err (abs (- (asin x) (list-ref asins i)))))
(if (> err mxerr)
(set! mxerr err))))
- (if (> mxerr 1e-12) (format-logged #t "asin err: ~A~%" mxerr))))
+ (if (> mxerr 1e-12) (format #t "asin err: ~A~%" mxerr))))
(when with-bignums
(let-temporarily (((*s7* 'bignum-precision) 500))
@@ -62514,7 +63212,7 @@ hi6: (string-app...
((= i 30))
(let ((val (asin (/ i (bignum "30")))))
(if (> (magnitude (- val (list-ref asins i))) 1e-36)
- (format-logged #t ";(asin ~A) -> ~A ~A~%[~A]~%" (/ i 30) val (list-ref asins i) (magnitude (- val (list-ref asins i))))))))))
+ (format #t ";(asin ~A) -> ~A ~A~%[~A]~%" (/ i 30) val (list-ref asins i) (magnitude (- val (list-ref asins i))))))))))
@@ -63018,7 +63716,7 @@ hi6: (string-app...
(let ((y (magnitude (- x (cos (acos x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-12)
- (format-logged #t ";(cos (acos ~A)) error: ~A~%" mx err)))
+ (format #t ";(cos (acos ~A)) error: ~A~%" mx err)))
(let ((err 0.0)
(mx 0.0))
@@ -63028,7 +63726,7 @@ hi6: (string-app...
(let ((y (magnitude (- x (cos (acos x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-10)
- (format-logged #t ";(cos (acos ~A)) error: ~A~%" mx err)))
+ (format #t ";(cos (acos ~A)) error: ~A~%" mx err)))
(test (acos) 'error)
(test (acos "hi") 'error)
@@ -63079,7 +63777,7 @@ hi6: (string-app...
((= i 30))
(let ((val (acos (/ i (bignum "30")))))
(if (> (magnitude (- val (list-ref acoss i))) 1e-36)
- (format-logged #t ";(acos ~A) -> ~A ~A~%[~A]~%" (/ i 30) val (list-ref acoss i) (magnitude (- val (list-ref acoss i))))))))))
+ (format #t ";(acos ~A) -> ~A ~A~%[~A]~%" (/ i 30) val (list-ref acoss i) (magnitude (- val (list-ref acoss i))))))))))
@@ -64054,7 +64752,7 @@ hi6: (string-app...
(set! mxerr err)))))
formulas)
(if (> mxerr 1e-30)
- (format-logged #t "big max error: ~A~%" mxerr)))))
+ (format #t "big max error: ~A~%" mxerr)))))
(let ((atans (list
0.00000000000000000000000000000000000000000000000000000000000000000000
@@ -64105,7 +64803,7 @@ hi6: (string-app...
(let ((err (abs (- (atan x) (list-ref atans i)))))
(if (> err mxerr)
(set! mxerr err))))
- (if (> mxerr 1e-12) (format-logged #t "atan err: ~A~%" mxerr))))
+ (if (> mxerr 1e-12) (format #t "atan err: ~A~%" mxerr))))
(when with-bignums
(let-temporarily (((*s7* 'bignum-precision) 500))
@@ -64145,7 +64843,7 @@ hi6: (string-app...
((= i 30))
(let ((val (atan (/ i (bignum "10")))))
(if (> (magnitude (- val (list-ref atans i))) 1e-36)
- (format-logged #t ";(atan ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref atans i) (magnitude (- val (list-ref atans i))))))))))
+ (format #t ";(atan ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref atans i) (magnitude (- val (list-ref atans i))))))))))
@@ -65002,9 +65700,9 @@ hi6: (string-app...
(set! max-sh-error err)
(set! max-sh-error-case x))))))
(if (> max-s-error 1e-35)
- (format-logged #t "s^2 + c^2 error: ~A at ~A~%" max-s-error max-s-error-case))
+ (format #t "s^2 + c^2 error: ~A at ~A~%" max-s-error max-s-error-case))
(if (> max-sh-error 1e-33)
- (format-logged #t "sh^2 + ch^2 error: ~A at ~A~%" max-sh-error max-sh-error-case)))
+ (format #t "sh^2 + ch^2 error: ~A at ~A~%" max-sh-error max-sh-error-case)))
(num-test (sinh 1000.0) 9.850355570085234969444396761216615626576E433)
(num-test (cosh 1000.0) 9.850355570085234969444396761216615626576E433))
@@ -65436,19 +66134,6 @@ hi6: (string-app...
(num-test (tanh -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308)
(num-test (tanh 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999995438476E-16)
-(when (provided? 'dfls-exponents)
- (num-test (tanh 1s13) 1s0)
- (num-test (tanh 1s3) 1s0)
- (num-test (tanh 1s2) 1s0)
- (num-test (tanh 1s1) 1s0)
- (num-test (tanh 1l0) 0.7615941559557648881L0)
- (num-test (tanh 1l1) 0.9999999958776927636L0)
- (num-test (tanh 1l100) 1L0)
- (num-test (tanh 1f10) 1f0)
- (num-test (tanh 1L-10) 1L-10)
- (num-test (tanh 1L-17) 1L-17)
- (num-test (tanh 1L-47) 1L-47))
-
(test (nan? (tanh 1/0)) #t)
;(test (nan? (tanh 1/0+i)) #t)
;(test (nan? (tanh 1/0+1/0i)) #t)
@@ -66955,7 +67640,7 @@ hi6: (string-app...
(let ((y (abs (- x (cosh (acosh x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-14)
- (format-logged #t ";(cosh (acosh ~A)) error: ~A~%" mx err)))
+ (format #t ";(cosh (acosh ~A)) error: ~A~%" mx err)))
(let ((err 0.0)
(mx 0.0))
@@ -66965,7 +67650,7 @@ hi6: (string-app...
(let ((y (magnitude (- x (cosh (acosh x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-14)
- (format-logged #t ";(cosh (acosh ~A)) error: ~A~%" mx err)))
+ (format #t ";(cosh (acosh ~A)) error: ~A~%" mx err)))
(let ((err 0.0)
(mx 0.0))
@@ -66975,7 +67660,7 @@ hi6: (string-app...
(let ((y (abs (- x (sinh (asinh x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-14)
- (format-logged #t ";(sinh (asinh ~A)) error: ~A~%" mx err)))
+ (format #t ";(sinh (asinh ~A)) error: ~A~%" mx err)))
(let ((err 0.0)
(mx 0.0))
@@ -66985,7 +67670,7 @@ hi6: (string-app...
(let ((y (magnitude (- x (sinh (asinh x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-9)
- (format-logged #t ";(sinh (asinh ~A)) error: ~A~%" mx err)))
+ (format #t ";(sinh (asinh ~A)) error: ~A~%" mx err)))
(let ((err 0.0)
(mx 0.0))
@@ -66995,7 +67680,7 @@ hi6: (string-app...
(let ((y (magnitude (- x (tanh (atanh x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-12)
- (format-logged #t ";(tanh (atanh ~A)) error: ~A~%" mx err)))
+ (format #t ";(tanh (atanh ~A)) error: ~A~%" mx err)))
(for-each
(lambda (num-and-val)
@@ -67560,7 +68245,7 @@ hi6: (string-app...
(let ((val (sqrt n)))
(if (or (not (integer? val))
(not (eqv? sqn val)))
- (format-logged #t ";(sqrt ~A) expected ~A but got ~A~%" n sqn val)))))
+ (format #t ";(sqrt ~A) expected ~A but got ~A~%" n sqn val)))))
(list 9 491401 19439281 1248844921 235565593201)
(list 3 701 4409 35339 485351))
@@ -67570,7 +68255,7 @@ hi6: (string-app...
(let ((val (sqrt n)))
(if (or (integer? val)
(> (abs (- (* val val) n)) .001))
- (format-logged #t ";(sqrt ~A) expected ~A but got ~A~%" n (sqrt (* 1.0 n)) val)))))
+ (format #t ";(sqrt ~A) expected ~A but got ~A~%" n (sqrt (* 1.0 n)) val)))))
(list 10 491400 19439282 1248844920 235565593200))
(test (eqv? (expt 2 3) 8) #t)
@@ -67588,7 +68273,7 @@ hi6: (string-app...
(let ((y (magnitude (- x (* (sqrt x) (sqrt x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-14)
- (format-logged #t ";(sqr (sqrt ~A)) error: ~A~%" mx err)))
+ (format #t ";(sqr (sqrt ~A)) error: ~A~%" mx err)))
(let ((err 0.0)
(mx 0.0))
@@ -67598,7 +68283,7 @@ hi6: (string-app...
(let ((y (magnitude (- x (* (sqrt x) (sqrt x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-12)
- (format-logged #t ";(sqr (sqrt ~A)) error: ~A~%" mx err)))
+ (format #t ";(sqr (sqrt ~A)) error: ~A~%" mx err)))
(num-test (* (/ 4 (sqrt 522))
(log (* (expt (/ (+ 5 (sqrt 29)) (sqrt 2)) 3)
@@ -67744,7 +68429,7 @@ hi6: (string-app...
(let ((err (abs (- (sqrt i) (list-ref sqrts (- i 1))))))
(if (> err mxerr)
(set! mxerr err))))
- (if (> mxerr 1e-12) (format-logged #t "sqrt err: ~A~%" mxerr))))
+ (if (> mxerr 1e-12) (format #t "sqrt err: ~A~%" mxerr))))
(when with-bignums
(num-test (/ (sqrt (* 1.2345e-170 1.2345e-170))) 8.100445524503847216161209708816501953798E169)
@@ -67788,7 +68473,7 @@ hi6: (string-app...
((= i 30))
(let ((val (sqrt (/ i (bignum "10")))))
(if (> (magnitude (- val (list-ref sqrts i))) 1e-36)
- (format-logged #t ";(sqrt ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref sqrts i) (magnitude (- val (list-ref sqrts i))))))))))
+ (format #t ";(sqrt ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref sqrts i) (magnitude (- val (list-ref sqrts i))))))))))
@@ -68290,7 +68975,7 @@ hi6: (string-app...
(let ((val1 (* 1000 (- (exp 30) 10686474581524)))
(val2 (* 1000 (- (exp (bignum "30")) 10686474581524))))
(if (> (abs (- val1 val2)) 1)
- (format-logged #t "(exp 30): ~A ~A~%" val1 val2)))
+ (format #t "(exp 30): ~A ~A~%" val1 val2)))
(num-test (exp (* 172.60813659204 (log 172.60813659204))) 1.364508485146898675293943657160611234948E386) ; not inf!
(num-test (exp 800.0) 2.726374572112566567364779546367269757963E347)
(num-test (exp -800.0) 3.667874584177687213455495654260798215465E-348)
@@ -68334,7 +69019,7 @@ hi6: (string-app...
((= i 30))
(let ((val (exp (/ i (bignum "10")))))
(if (> (magnitude (- val (list-ref exps i))) 1e-36)
- (format-logged #t ";(exp ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref exps i) (magnitude (- val (list-ref exps i))))))))))
+ (format #t ";(exp ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref exps i) (magnitude (- val (list-ref exps i))))))))))
@@ -69062,7 +69747,7 @@ hi6: (string-app...
(let ((y (magnitude (- x (exp (log x))))))
(if (> y err) (begin (set! mx x) (set! err y))))))
(if (> err 1e-14)
- (format-logged #t ";(exp (log ~A)) error: ~A~%" mx err)))
+ (format #t ";(exp (log ~A)) error: ~A~%" mx err)))
(let ((err 0.0)
(mx 0.0))
@@ -69073,7 +69758,7 @@ hi6: (string-app...
(let ((y (magnitude (- x (exp (log x))))))
(if (> y err) (begin (set! err y) (set! mx x))))))
(if (> err 1e-14)
- (format-logged #t ";(exp (log ~A)) error: ~A~%" mx err)))
+ (format #t ";(exp (log ~A)) error: ~A~%" mx err)))
(do ((i 0 (+ i 1)))
((= i 100))
@@ -69190,7 +69875,7 @@ hi6: (string-app...
(abs (- (log y) (list-ref logs-2 i))))))
(if (> err mxerr)
(set! mxerr err))))
- (if (> mxerr 1e-12) (format-logged #t "log err: ~A~%" mxerr))))
+ (if (> mxerr 1e-12) (format #t "log err: ~A~%" mxerr))))
(when with-bignums
(let-temporarily (((*s7* 'bignum-precision) 500))
@@ -69231,7 +69916,7 @@ hi6: (string-app...
((= i 30))
(let ((val (log (+ (/ i (bignum "10")) (bignum "1.0")))))
(if (> (magnitude (- val (list-ref logs i))) 1e-36)
- (format-logged #t ";(log ~A) -> ~A ~A~%[~A]~%" (+ 1.0 (/ i 10)) val (list-ref logs i) (magnitude (- val (list-ref logs i))))))))))
+ (format #t ";(log ~A) -> ~A ~A~%[~A]~%" (+ 1.0 (/ i 10)) val (list-ref logs i) (magnitude (- val (list-ref logs i))))))))))
(test (log) 'error)
(test (log "hi") 'error)
@@ -69307,7 +69992,6 @@ hi6: (string-app...
(num-test (/ (expt 2.3 50) (expt 2.3 49)) 2.3)
(num-test (/ (sqrt (* 7 (- 2 (expt 2 1/7)))) (expt 2 1/14)) (+ -1 (* 2 (expt 2 1/7)) (expt 2 3/7) (expt 2 5/7) (- (expt 2 6/7))))
(num-test (do ((i 1 (+ i 1)) (sum 0.0 (+ sum (expt (sin (/ (* pi i) (* 2 10))) 4)))) ((= i 11) sum)) 4.25)
-(num-test (expt #e1 -111) 1)
(num-test (expt (+ (cos (/ (* 2 pi) 20)) (* 0+i (sin (/ (* 2 pi) 20)))) 20) 1.0)
(num-test (expt (+ pi 20) 0+i) -0.99999999924368-3.8892669402222e-05i)
(num-test (expt (- (expt 2 1/3) 1) 1/3) (+ (expt 1/9 1/3) (- (expt 2/9 1/3)) (expt 4/9 1/3)))
@@ -69348,7 +70032,6 @@ hi6: (string-app...
(num-test (expt (expt 20 10) 1/10) 20)
(num-test (expt (expt 40 10) 1/10) 40)
(num-test (expt -0 -0) 1)
-(num-test (expt -0(quasiquote #e0)) 1)
(num-test (expt -0.0 -0.0) 0.0)
(num-test (expt -0.0 0) 0.0)
(num-test (expt -0.0 0-i) 0.0)
@@ -70269,7 +70952,7 @@ hi6: (string-app...
#|
(do ((i 30 (+ i 1)))
((= i 63))
- (format-logged #t "~D: (- ~A ~A) -> ~A~%" i (+ (expt 2.0 i) 500) (+ (expt 2.0 i) 100) (- (+ (expt 2.0 i) 500) (+ (expt 2.0 i) 100))))
+ (format #t "~D: (- ~A ~A) -> ~A~%" i (+ (expt 2.0 i) 500) (+ (expt 2.0 i) 100) (- (+ (expt 2.0 i) 500) (+ (expt 2.0 i) 100))))
55: (- 3.6028797018964e+16 3.6028797018964e+16) -> 400.0
56: (- 7.2057594037928e+16 7.2057594037928e+16) -> 400.0
@@ -70299,7 +70982,7 @@ hi6: (string-app...
(lambda (y)
(num-test (expt (expt x y) (/ y)) x)
;; (if (> (magnitude (- (expt (expt x y) (/ y)) x)) 1e-6)
- ;; (format-logged #t ";(expt (expt ~A ~A) (/ ~A)) -> ~A (~A)~%" x y y (expt (expt x y) (/ y)) (magnitude (- (expt (expt x y) (/ y)) x))))
+ ;; (format #t ";(expt (expt ~A ~A) (/ ~A)) -> ~A (~A)~%" x y y (expt (expt x y) (/ y)) (magnitude (- (expt (expt x y) (/ y)) x))))
)
ys))
xs))
@@ -70315,7 +70998,7 @@ hi6: (string-app...
(g2 (gx (expt 10 (- i)))))
(let ((diff (abs (- g1 g2))))
(if (or (nan? diff) (> diff (expt 10 (- -7 i))))
- (format-logged #t ";g(1e-~D) -> ~A ~A, diff: ~A~%" i g1 g2 (abs (- g1 g2))))))))
+ (format #t ";g(1e-~D) -> ~A ~A, diff: ~A~%" i g1 g2 (abs (- g1 g2))))))))
(let ((p (lambda (x y) (+ (* 2 y y) (* 9 x x x x) (* -1 y y y y)))))
(num-test (p 408855776 708158977) 1))
@@ -70406,7 +71089,7 @@ hi6: (string-app...
(min (magnitude (- val1 val2))
(magnitude (- val1 val3)))))
(if (> (/ diff (max (magnitude val1) 1)) 1e-12)
- (format-logged #t ";(expt ~A ~A), ~A ~A ~A: ~A~%" (v k) (v j) val1 val2 val3 diff)))))))))))
+ (format #t ";(expt ~A ~A), ~A ~A ~A: ~A~%" (v k) (v j) val1 val2 val3 diff)))))))))))
(if with-bignums
(num-test (let ((dickey (lambda (x y) ; from Kawa
@@ -70940,9 +71623,9 @@ hi6: (string-app...
(for-each
(lambda (e)
(if (> (magnitude (- (expt rval e) (expt frval e))) eps)
- (format-logged #t "~A: ;(expt ~A e) != (expt ~A e) -> ~A~%" e rval frval (magnitude (- (expt rval e) (expt frval e)))))
+ (format #t "~A: ;(expt ~A e) != (expt ~A e) -> ~A~%" e rval frval (magnitude (- (expt rval e) (expt frval e)))))
(if (> (magnitude (- (expt ival e) (expt fival e))) eps)
- (format-logged #t "~A ;(expt ~A e) != (expt ~A e) -> ~A~%" e ival fival (magnitude (- (expt ival e) (expt fival e))))))
+ (format #t "~A ;(expt ~A e) != (expt ~A e) -> ~A~%" e ival fival (magnitude (- (expt ival e) (expt fival e))))))
(list 0 0.0 (log 0) (real-part (log 0)) (- (real-part (log 0))))))))))
|#
@@ -71913,19 +72596,20 @@ hi6: (string-app...
(num-test (* 9223372036854775807 (/ 9223372036854775807)) 1)
(num-test (* 1234567890e24 1e-33) 1.23456789)
(num-test (* 1234567890e-24 1e20) 123456.789)
-(num-test (* 92233720/9221 -92233720/9221 9221/92233720 -9221/92233720) 1)
-(num-test (* 9221/92233720 -9221/92233720 92233720/9221 -92233720/9221) 1)
+(when (provided? 'overflow-checks)
+ (num-test (* 92233720/9221 -92233720/9221 9221/92233720 -9221/92233720) 1)
+ (num-test (* 9221/92233720 -9221/92233720 92233720/9221 -92233720/9221) 1))
(for-each-permutation
(lambda args
(if (not (< (magnitude (- (apply * args) 0.25+0.25i)) 1e-15))
- (format-logged #t "~A: (* ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply * args))))
+ (format #t "~A: (* ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply * args))))
'(1 1/2 0.5 1+i))
(for-each-permutation
(lambda args
(if (not (< (magnitude (- (apply * args) 1.0)) 1e-15))
- (format-logged #t "~A: (* ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply * args))))
+ (format #t "~A: (* ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply * args))))
'(5 1/3 0.5 1+i 1/5 3 2.0 0.5-0.5i))
(num-test (* 7/1000 1000/999 999/7 most-positive-fixnum) most-positive-fixnum)
@@ -72085,7 +72769,9 @@ hi6: (string-app...
(num-test (* 19813/30200 41168/38464 2571/31632) 43688873593/765502835200)
(num-test (* 16476/12673 40086/15929) 38850408/11874601)
-(num-test (* 22713/35036 2008/41994 58982/21726 37919/44341 59831/3870) 608349727545125531/546777281752405290)
+
+(if (provided? 'overflow-checks)
+ (num-test (* 22713/35036 2008/41994 58982/21726 37919/44341 59831/3870) 608349727545125531/546777281752405290))
(num-test (* 26100/43623 64347/64939 51424/56858) 4798021185600/8948293077857)
(num-test (* 13336/48674 21323/50854 60055/14813) 4269362918510/9166534724887)
(num-test (* 33457/53498 45548/13003 50476/8209 9613/3657) 369717652332927784/10441582621738311)
@@ -72132,7 +72818,7 @@ hi6: (string-app...
(num-test (bes-i0 50.0) 2.93255291463847587034176447517387076592E20) ;2.932553783849336E+20) arprec
(num-test (bes-i0 100.0) 1.073751199431789167620943174959211991306E42))
-(unless with-bignums
+(unless (or with-bignums (not (provided? 'overflow-checks)))
(num-test (* 1/9223372036854775807 1/9223372036854775806) 1.1754943508223e-38)
(num-test (* 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) 3.9223808052178e-27)
(num-test (* 1/98947 2/97499 3/76847 4/61981 5/59981) 4.3539080668052e-23)
@@ -72153,13 +72839,13 @@ hi6: (string-app...
(do ((i 0 (+ i 1)))
((= i 29))
(if (not (= (twos (+ i 1)) (* 8 (twos i))))
- (format-logged #t "~A * 8 -> ~A (~A)~%" (twos i) (* 8 (twos i)) (twos (+ i 1))))
+ (format #t "~A * 8 -> ~A (~A)~%" (twos i) (* 8 (twos i)) (twos (+ i 1))))
(if (not (= (+ (twos (+ i 1)) (* 8 (twos i))) (* 2 (twos (+ i 1)))))
- (format-logged #t "~A + ~A -> ~A (~A)~%" (* 8 (twos i)) (twos (+ i 1)) (* 2 (twos (+ i 1)))))
+ (format #t "~A + ~A -> ~A (~A)~%" (* 8 (twos i)) (twos (+ i 1)) (* 2 (twos (+ i 1)))))
(if (not (= (/ (twos (+ i 1)) (twos i)) 8))
- (format-logged #t "~A / ~A = ~A (8)~%" (twos (+ i 1)) (twos i) (/ (twos (+ i 1)) (twos i))))
+ (format #t "~A / ~A = ~A (8)~%" (twos (+ i 1)) (twos i) (/ (twos (+ i 1)) (twos i))))
(if (not (= (- (twos (+ i 1)) (* 8 (twos i))) 0))
- (format-logged #t "~A - ~A -> ~A (0)~%" (* 8 (twos i)) (twos (+ i 1)) (- (twos (+ i 1)) (* 8 (twos i)))))))
+ (format #t "~A - ~A -> ~A (0)~%" (* 8 (twos i)) (twos (+ i 1)) (- (twos (+ i 1)) (* 8 (twos i)))))))
(letrec ((factorial (lambda (n i) (if (positive? n) (factorial (- n 1) (* i n)) i))))
(num-test (/ (factorial 100 1) (factorial 99 1)) 100)
@@ -72485,7 +73171,8 @@ hi6: (string-app...
(num-test (let ((n 40) (s 1)) (do ((i 0 (+ i 1))) ((= i n) s) (set! s (* s 2/3)))) 1099511627776/12157665459056928801)
(num-test (expt 2 40) 1099511627776)
(num-test (expt 3 40) 12157665459056928801))
- (num-test (let ((n 40) (s 1)) (do ((i 0 (+ i 1))) ((= i n) s) (set! s (* s 2/3)))) 9.043772683816628192400549525035572818665E-8))
+ (if (provided? 'overflow-checks)
+ (num-test (let ((n 40) (s 1)) (do ((i 0 (+ i 1))) ((= i n) s) (set! s (* s 2/3)))) 9.043772683816628192400549525035572818665E-8)))
(test (* 0 1 "hi") 'error)
(test (* 0.0 "hi") 'error)
@@ -73291,13 +73978,13 @@ hi6: (string-app...
(for-each-permutation
(lambda args
(if (not (= (apply + args) 3+i))
- (format-logged #t "~A: (+ ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply + args))))
+ (format #t "~A: (+ ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply + args))))
'(1 1/2 0.5 1+i))
(for-each-permutation
(lambda args
(if (not (zero? (apply + args)))
- (format-logged #t "~A: (+ ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply + args))))
+ (format #t "~A: (+ ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply + args))))
'(1 1/2 0.5 1+i -1/2 -1 -0.5 -1-i))
(num-test (+ 10.0+0.i) 10.0)
@@ -73323,25 +74010,28 @@ hi6: (string-app...
(num-test (+ 9223372036854775807 -9223372036854775808) -1)
(num-test (+ 0.(*)) 1.0)
(num-test (+ 0.(+)) 0.0)
-(num-test (+ 1/9223372036854775807 1/9223372036854775807) 2/9223372036854775807)
-(num-test (+ 10000000/9223372036854775807 1/3) 3.333333333344175355058188377674583355698E-1)
-(num-test (+ 1073741824 1073741824 1073741824 1073741824) (* 4 1073741824))
-(num-test (+ 268435456/129140163 129140163/268435456 7/19 29/19) 2933929486555791403/658650172313567232)
-(num-test (+ 268435456/129140163 129140163/268435456 7/29 29/19) 4.327416192871913348352681814704887193821E0)
-(num-test (+ -9223372036854775808 9223372036854775807) -1)
-(num-test (+ -9221/92233720 -92233720/9221 9221/92233720 92233720/9221) 0)
+(when (provided? 'overflow-checks)
+ (num-test (+ 1/9223372036854775807 1/9223372036854775807) 2/9223372036854775807)
+ (num-test (+ 10000000/9223372036854775807 1/3) 3.333333333344175355058188377674583355698E-1)
+ (num-test (+ 1073741824 1073741824 1073741824 1073741824) (* 4 1073741824))
+ (num-test (+ 268435456/129140163 129140163/268435456 7/19 29/19) 2933929486555791403/658650172313567232)
+ (num-test (+ 268435456/129140163 129140163/268435456 7/29 29/19) 4.327416192871913348352681814704887193821E0)
+ (num-test (+ -9223372036854775808 9223372036854775807) -1)
+ (num-test (+ -9221/92233720 -92233720/9221 9221/92233720 92233720/9221) 0))
(num-test (+ (/ most-negative-fixnum 2) (/ most-negative-fixnum 2)) -9223372036854775808)
(num-test (+ (/ most-negative-fixnum 2) (/ most-negative-fixnum 2) 1) -9223372036854775807)
(num-test (+ (/ most-negative-fixnum 2) (/ most-negative-fixnum 2) -1) (if with-bignums -9223372036854775809 -9.223372036854776e+18))
-(num-test (- (/ most-negative-fixnum 2) (/ most-positive-fixnum 2) 1) (if with-bignums -18446744073709551617/2 -9.223372036854776e+18))
+(if (provided? 'overflow-checks)
+ (num-test (- (/ most-negative-fixnum 2) (/ most-positive-fixnum 2) 1) (if with-bignums -18446744073709551617/2 -9.223372036854776e+18)))
(num-test (* 3037000499 3037000500) 9223372033963249500)
(num-test (* 3037000499 3037000499) 9223372030926249001)
;(num-test (* 3037000500 3037000500) (if with-bignums 9223372037000250000 9.223372037000249e+18))
;(num-test (/ (* (/ 3037000499) (/ 3037000498))) 9223372027889248502)
-(num-test (/ (* (/ 3037000500) (/ 3037000500))) (if with-bignums 9223372037000250000 9.223372037000251e+18))
-(num-test (/ 3037000499 (/ 3037000499)) 9223372030926249001)
-(num-test (/ 3037000500 (/ 3037000500)) (if with-bignums 9223372037000250000 9.223372037000251e+18))
+(when (provided? 'overflow-checks)
+ (num-test (/ (* (/ 3037000500) (/ 3037000500))) (if with-bignums 9223372037000250000 9.223372037000251e+18))
+ (num-test (/ 3037000499 (/ 3037000499)) 9223372030926249001)
+ (num-test (/ 3037000500 (/ 3037000500)) (if with-bignums 9223372037000250000 9.223372037000251e+18)))
(num-test (+ 0.6049332056786565E0 -0.9611373574853808E0) -3.562041518067242999999999999999999999981E-1)
(num-test (+ -0.4763715667865308E0 0.25936932107685584E0) -2.170022457096749600000000000000000000008E-1)
@@ -73529,7 +74219,7 @@ hi6: (string-app...
(num-test (+) 0 )
(num-test (+ 123123123123123 123123123123123) 246246246246246)
-(unless with-bignums
+(unless (or with-bignums (not (provided? 'overflow-checks)))
(num-test (+ 3/4 4611686018427387904) 4.61168601842738790475E18)
(num-test (+ 1/17179869184 1073741824) 1.073741824000000000058207660913467407227E9)
(num-test (+ 1/8589934592 1073741824) 1.073741824000000000116415321826934814453E9)
@@ -73600,7 +74290,7 @@ hi6: (string-app...
(* two i i))))))
(* (log 2) (log 2)))
-(unless with-bignums
+(unless (or with-bignums (not (provided? 'overflow-checks)))
(num-test (+ 1/9223372036854775807 1/9223372036854775806) 2.168404344971e-19)
(num-test (+ 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) 0.00030764243484887)
(num-test (+ 1/98947 2/97499 3/76847 4/61981 5/59981) 0.00021755369744252)
@@ -74826,7 +75516,7 @@ but it's the printout that is at fault:
(for-each-permutation
(lambda args
(when (not (morally-equal? (apply - args) (- (car args) (apply + (cdr args)))))
- (format-logged #t "~A: ~A != ~A?~%" (port-line-number) (apply - args) (- (car args) (apply + (cdr args))))
+ (format #t "~A: ~A != ~A?~%" (port-line-number) (apply - args) (- (car args) (apply + (cdr args))))
(ok)))
'(1 1/2 0.5 1+i))))
@@ -74835,7 +75525,7 @@ but it's the printout that is at fault:
(for-each-permutation
(lambda args
(when (not (morally-equal? (apply - args) (+ (car args) (- (apply + (cdr args))))))
- (format-logged #t "~A: (- ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply - args))
+ (format #t "~A: (- ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply - args))
(ok)))
'(1 1/2 0.5 1+i -1/2 -1 -0.5 -1-i))))
@@ -74854,13 +75544,12 @@ but it's the printout that is at fault:
(num-test (- 1/98947 2/97499 3/76847) -36656755224/741360956847391)
(num-test (- 500009/500029 500057/500041) -18001284/250035001189)
-(if (not with-bignums)
- (begin
- (num-test (- 8 -1/9223372036854775807 1/9223372036854775807) 8.0)
+(unless (or with-bignums (not (provided? 'overflow-checks)))
+ (num-test (- 8 -1/9223372036854775807 1/9223372036854775807) 8.0)
; (num-test (- most-positive-fixnum most-negative-fixnum) 1.8446744073709551615E19)
; (num-test (- most-negative-fixnum most-positive-fixnum) -1.8446744073709551615E19)
;;; currently s7's optimizer screws up these cases
- ))
+ )
(num-test (- -0.011326914400453525E0 -0.6668141757661364E0) 6.554872613656828749999999999999999999976E-1)
(num-test (- -0.46185382764946437E0 0.7488210697846337E0) -1.210674897434098070000000000000000000001E0)
@@ -75015,7 +75704,7 @@ but it's the printout that is at fault:
(num-test (- 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99) -4948)
-(unless with-bignums
+(unless (or with-bignums (not (provided? 'overflow-checks)))
(num-test (- 1/9223372036854775807 1/9223372036854775806) -1.1754943508223e-38)
(num-test (- 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) -0.00028742959363084)
(num-test (- 1/98947 2/97499 3/76847 4/61981 5/59981) -0.00019734085622449)
@@ -75881,10 +76570,11 @@ but it's the printout that is at fault:
(num-test (/ 362880/1234) 1234/362880)
(num-test (/ 1/2 1+i 1-i) 0.25)
-(num-test (/ 2/9223372036854775807 2) 1/9223372036854775807)
-(num-test (/ -63/288230376151711744 -63) 1/288230376151711744)
+(when (provided? 'overflow-checks)
+ (num-test (/ 2/9223372036854775807 2) 1/9223372036854775807)
+ (num-test (/ -63/288230376151711744 -63) 1/288230376151711744))
-(unless with-bignums
+(unless (or with-bignums (not (provided? 'overflow-checks)))
(num-test (/ 1/2305843009213693952 -1 4194304/2097151) -2.168403310995243176730312012479018335398E-19)
(num-test (/ 1/2199023255552 -63 8388608/4194303) -3.609105098938467225452985162735872325445E-15)
(num-test (/ 1/17179869184 -1 1073741824/536870911) -2.91038304025235949890060282996273599565E-11))
@@ -75892,7 +76582,7 @@ but it's the printout that is at fault:
(for-each-permutation
(lambda args
(if (not (= (apply / args) (/ (car args) (apply * (cdr args)))))
- (format-logged #t "~A: ~A != ~A?~%" (port-line-number) (apply / args) (/ (car args) (apply * (cdr args))))))
+ (format #t "~A: ~A != ~A?~%" (port-line-number) (apply / args) (/ (car args) (apply * (cdr args))))))
'(1 1/2 0.5 1+i))
(num-test (/ -9223372036854775808 5.551115123125783999999999999999999999984E-17) -1.661534994731144452653560599947843044136E35)
@@ -75920,7 +76610,8 @@ but it's the printout that is at fault:
(num-test (/ 1234567890/9223372036854775807 123456789/9223372036854775807) 10)
(num-test (/ 2 -9223372036854775808) -1/4611686018427387904)
(num-test (/ 2 most-negative-fixnum) -1/4611686018427387904)
-(num-test (/ 2/9223372036854775807 2/3) 3/9223372036854775807)
+(when (provided? 'overflow-checks)
+ (num-test (/ 2/9223372036854775807 2/3) 3/9223372036854775807))
(num-test (/ 9223372036854775807/123456789 9223372036854775807/123456789) 1)
(num-test (/ 9223372036854775807/1234567890 9223372036854775807/12345678900) 10)
(num-test (/ most-negative-fixnum 2) -4611686018427387904)
@@ -76114,7 +76805,7 @@ but it's the printout that is at fault:
(num-test (/ (/ -1 most-positive-fixnum)) (- most-positive-fixnum))
(num-test (/ (/ most-positive-fixnum) 1) 1/9223372036854775807) ; why isn't this a ratio in the non-bignum case?
-(unless with-bignums
+(unless (or with-bignums (not (provided? 'overflow-checks)))
(num-test (/ -1024 1/9765625 1/512 1/1953125) -1e19)
(num-test (/ 1/19073486328125 -524288) -1e-19)
(num-test (/ 1/19073486328125 524288) 1e-19)
@@ -76534,17 +77225,17 @@ but it's the printout that is at fault:
(for-each
(lambda (a b)
(if (not (< (abs (- b fifth)) (abs (- a fifth))))
- (format-logged #t ";fifth: ~A is not better than ~A??~%" b a))
+ (format #t ";fifth: ~A is not better than ~A??~%" b a))
(if (not (< (magnitude (- (complex b b) c-fifth)) (magnitude (- (complex a a) c-fifth))))
- (format-logged #t ";rectangular fifth: ~A is not better than ~A??~%" b a))
+ (format #t ";rectangular fifth: ~A is not better than ~A??~%" b a))
(let ((pa (make-polar (* (sqrt 2.0) a) (/ pi 4)))
(pb (make-polar (* (sqrt 2.0) b) (/ pi 4))))
(if (not (< (magnitude (- pb p-fifth)) (magnitude (- pa p-fifth))))
- (format-logged #t ";polar fifth: ~A is not better than ~A??~%" b a)))
+ (format #t ";polar fifth: ~A is not better than ~A??~%" b a)))
(if (not (< (abs (- b last-rat)) (abs (- a last-rat))))
- (format-logged #t ";- last: ~A is not better than ~A??~%" b a))
+ (format #t ";- last: ~A is not better than ~A??~%" b a))
(if (not (< (magnitude (sqrt (- b last-rat))) (magnitude (sqrt (- a last-rat)))))
- (format-logged #t ";sqrt last: ~A is not better than ~A??~%" b a)))
+ (format #t ";sqrt last: ~A is not better than ~A??~%" b a)))
rats (cdr rats)))))
(if with-bignums
@@ -76564,7 +77255,7 @@ but it's the printout that is at fault:
((= i n))
(let ((y (random range)))
(if (not (chker y))
- (format-logged #t ";(random ~A) -> ~A?~%" range y))
+ (format #t ";(random ~A) -> ~A?~%" range y))
(let ((iy (min 99 (floor (* 100 (/ y range))))))
(vector-set! hits iy (+ 1 (vector-ref hits iy))))))
(let ((sum 0.0)
@@ -76584,7 +77275,7 @@ but it's the printout that is at fault:
(let ((val (rtest)))
(if (or (> val 1.0)
(< val -1.0))
- (format-logged #t "(- (random 2.0) 1.0): ~A~%" i val)))))
+ (format #t "(- (random 2.0) 1.0): ~A~%" i val)))))
(let ((vr (v 1000
1.0
@@ -76594,7 +77285,7 @@ but it's the printout that is at fault:
(<= val 1.0))))))
(if (or (< vr 40)
(> vr 400))
- (format-logged #t ";(random 1.0) not so random? ~A~%" vr)))
+ (format #t ";(random 1.0) not so random? ~A~%" vr)))
(let ((vr (v 1000
100
@@ -76604,7 +77295,7 @@ but it's the printout that is at fault:
(<= val 100))))))
(if (or (< vr 40)
(> vr 400))
- (format-logged #t ";(random 100) not so random? ~A~%" vr)))
+ (format #t ";(random 100) not so random? ~A~%" vr)))
(let ((vr (v 1000
1/2
@@ -76614,7 +77305,7 @@ but it's the printout that is at fault:
(<= val 1/2))))))
(if (or (< vr 40)
(> vr 400))
- (format-logged #t ";(random 1/2) not so random? ~A~%" vr)))
+ (format #t ";(random 1/2) not so random? ~A~%" vr)))
(let ((vr (v 1000
-10.0
@@ -76624,7 +77315,7 @@ but it's the printout that is at fault:
(>= val -10.0))))))
(if (or (< vr 40)
(> vr 400))
- (format-logged #t ";(random -10.0) not so random? ~A~%" vr)))
+ (format #t ";(random -10.0) not so random? ~A~%" vr)))
(let ((imax 0.0)
(rmax 0.0)
@@ -76643,7 +77334,7 @@ but it's the printout that is at fault:
(< rmin 0.0)
(< rmax 0.001)
(< imax 0.001))
- (format-logged #t ";(random 1+i): ~A ~A ~A ~A~%" rmin rmax imin imax)))
+ (format #t ";(random 1+i): ~A ~A ~A ~A~%" rmin rmax imin imax)))
(let ((imax 0.0)
(rmax 0.0)
@@ -76661,7 +77352,7 @@ but it's the printout that is at fault:
(> rmax 0.0)
(< rmin 0.0)
(< imax 0.001))
- (format-logged #t ";(random 0+i): ~A ~A ~A ~A~%" rmin rmax imin imax)))
+ (format #t ";(random 0+i): ~A ~A ~A ~A~%" rmin rmax imin imax)))
(let ((imax 0.0)
(rmax 0.0)
@@ -76680,7 +77371,7 @@ but it's the printout that is at fault:
(< rmin 0.0)
(< imax 0.1)
(< rmax 0.01))
- (format-logged #t ";(random 100+10i): ~A ~A ~A ~A~%" rmin rmax imin imax)))
+ (format #t ";(random 100+10i): ~A ~A ~A ~A~%" rmin rmax imin imax)))
(do ((i 0 (+ i 1)))
@@ -76690,7 +77381,7 @@ but it's the printout that is at fault:
(> (real-part val) 1.0)
(> (imag-part val) 1.0)
(< (real-part val) 0.0))
- (format-logged #t ";(random 1.0+1.0i) -> ~A?~%" val))))
+ (format #t ";(random 1.0+1.0i) -> ~A?~%" val))))
(let ((rs (random-state 12345678)))
(do ((i 0 (+ i 1)))
@@ -76699,7 +77390,7 @@ but it's the printout that is at fault:
(if (or (not (real? val))
(negative? val)
(> val 1.0))
- (format-logged #t ";(random 1.0 rs) -> ~A?~%" val)))))
+ (format #t ";(random 1.0 rs) -> ~A?~%" val)))))
(when with-bignums
(num-test (random (bignum "0")) 0)
@@ -76713,7 +77404,7 @@ but it's the printout that is at fault:
(<= val 1.0))))))
(if (or (< vr 40)
(> vr 400))
- (format-logged #t ";(big-random 1.0) not so random? ~A~%" vr)))
+ (format #t ";(big-random 1.0) not so random? ~A~%" vr)))
(let ((vr (v 1000
(bignum "100")
@@ -76723,7 +77414,7 @@ but it's the printout that is at fault:
(<= val 100))))))
(if (or (< vr 40)
(> vr 400))
- (format-logged #t ";(big-random 100) not so random? ~A~%" vr)))
+ (format #t ";(big-random 100) not so random? ~A~%" vr)))
(let ((vr (v 1000
(bignum "1/2")
@@ -76733,7 +77424,7 @@ but it's the printout that is at fault:
(<= val 1/2))))))
(if (or (< vr 40)
(> vr 400))
- (format-logged #t ";(big-random 1/2) not so random? ~A~%" vr)))
+ (format #t ";(big-random 1/2) not so random? ~A~%" vr)))
(let ((vr (v 1000
(bignum "-10.0")
@@ -76743,7 +77434,7 @@ but it's the printout that is at fault:
(>= val -10.0))))))
(if (or (< vr 40)
(> vr 400))
- (format-logged #t ";(big-random -10.0) not so random? ~A~%" vr)))
+ (format #t ";(big-random -10.0) not so random? ~A~%" vr)))
(do ((i 0 (+ i 1)))
((= i 100))
@@ -76752,7 +77443,7 @@ but it's the printout that is at fault:
(> (real-part val) 1.0)
(> (imag-part val) 1.0)
(< (real-part val) 0.0))
- (format-logged #t ";(big-random 1.0+1.0i) -> ~A?~%" val))))
+ (format #t ";(big-random 1.0+1.0i) -> ~A?~%" val))))
(let ((rs (random-state (bignum "12345678"))))
(do ((i 0 (+ i 1)))
@@ -76761,12 +77452,12 @@ but it's the printout that is at fault:
(if (or (not (real? val))
(negative? val)
(> val 1.0))
- (format-logged #t ";(big-random 1.0 rs) -> ~A?~%" val)))
+ (format #t ";(big-random 1.0 rs) -> ~A?~%" val)))
(let ((val (random 1.0 rs)))
(if (or (not (real? val))
(negative? val)
(> val 1.0))
- (format-logged #t ";(big-random small-1.0 rs) -> ~A?~%" val)))))
+ (format #t ";(big-random small-1.0 rs) -> ~A?~%" val)))))
(let ((rs (random-state 1234)))
(do ((i 0 (+ i 1)))
@@ -76775,12 +77466,12 @@ but it's the printout that is at fault:
(if (or (not (real? val))
(negative? val)
(> val 1.0))
- (format-logged #t ";(big-random 1.0 small-rs) -> ~A?~%" val)))
+ (format #t ";(big-random 1.0 small-rs) -> ~A?~%" val)))
(let ((val (random 1.0 rs)))
(if (or (not (real? val))
(negative? val)
(> val 1.0))
- (format-logged #t ";(random small-1.0 rs) -> ~A?~%" val)))))
+ (format #t ";(random small-1.0 rs) -> ~A?~%" val)))))
))
(test (random 0 #t) 'error)
@@ -76891,15 +77582,15 @@ but it's the printout that is at fault:
(let ((v1 (random 1.0 rs2))
(v2 (random 1.0 rs3)))
(if (not (= v1 v2 (r1 i)))
- (format-logged #t ";random v1: ~A, v2: ~A, r1[~A]: ~A~%" v1 v2 i (r1 i))))
+ (format #t ";random v1: ~A, v2: ~A, r1[~A]: ~A~%" v1 v2 i (r1 i))))
(if (> i 3)
(let ((v3 (random 1.0 rs4)))
(if (not (= v3 (r1 i)))
- (format-logged #t ";random v3: ~A, r1[~A]: ~A~%" v3 i (r1 i)))))
+ (format #t ";random v3: ~A, r1[~A]: ~A~%" v3 i (r1 i)))))
(if (> i 5)
(let ((v4 (random 1.0 rs5)))
(if (not (= v4 (r1 i)))
- (format-logged #t ";random v4: ~A, r1[~A]: ~A~%" v4 i (r1 i)))))))))
+ (format #t ";random v4: ~A, r1[~A]: ~A~%" v4 i (r1 i)))))))))
(do ((i 0 (+ i 1)))
((= i 20)) ; this was ((+ i 100)) !! -- surely a warning would be in order?
@@ -76961,15 +77652,12 @@ but it's the printout that is at fault:
(test (string->number "+#.#") #f)
(test (string->number "-#.#") #f)
(test (string->number "#.#") #f)
-(when (not pure-s7)
- (test (string->number "#i") #f)
- (test (string->number "#e") #f))
(test (string->number "#") #f)
(for-each
(lambda (n)
(if (not (eqv? n (string->number (number->string n))))
- (format-logged #t ";(string->number (number->string ~A)) = ~A?~%" n (string->number (number->string n)))))
+ (format #t ";(string->number (number->string ~A)) = ~A?~%" n (string->number (number->string n)))))
(list 1 2 3 10 1234 1234000000 500029 362880 0/1 0/2 0/3 0/10 0/1234 0/1234000000 0/500029
0/362880 1/1 1/2 1/3 1/10 1/1234 1/1234000000 1/500029 1/362880 2/1 2/2 2/3 2/10 2/1234
2/1234000000 2/500029 2/362880 3/1 3/2 3/3 3/10 3/1234 3/1234000000 3/500029 3/362880
@@ -76983,7 +77671,7 @@ but it's the printout that is at fault:
(for-each
(lambda (x)
(if (not (fequal? x (string->number (number->string x))))
- (format-logged #t ";(string->number (number->string ~A)) -> ~A?~%" x (string->number (number->string x)))))
+ (format #t ";(string->number (number->string ~A)) -> ~A?~%" x (string->number (number->string x)))))
(list 0.000000 1.000000 3.141593 2.718282 1234.000000 1234000000.000000 0.000000+0.000000i 0.000000+0.000000i 0.000000+1.000000i
0.000000+3.141593i 0.000000+2.718282i 0.000000+1234.000000i 0.000000+1234000000.000000i 0.000000+0.000000i 0.000000+0.000000i
0.000000+1.000000i 0.000000+3.141593i 0.000000+2.718282i 0.000000+1234.000000i 0.000000+1234000000.000000i 1.000000+0.000000i
@@ -77049,7 +77737,6 @@ but it's the printout that is at fault:
(num-test (string->number ".a at 0" 12) 0.83333333333333)
(num-test (string->number "a. at 0" 16) 10.0)
(num-test (string->number "0a" 16) 10)
- (when (not pure-s7) (num-test (string->number "#e0a" 16) 10))
(num-test (string->number "a at -1" 16) 0.625)
(num-test 1 at 0+1@0i 1+1i)
@@ -77060,7 +77747,6 @@ but it's the printout that is at fault:
(num-test (string->number ".2 at -22") 2e-23)
(num-test (string->number "+02 at 02") 200.0)
(num-test (string->number "2fe2 at 2" 16) 3138048.0)
- (when (not pure-s7) (num-test (string->number "#i1 at 01" 16) 16.0))
(num-test (string->number "1 at -0-bc/di" 16) 1-14.461538461538i)
(num-test (string->number ".f-a.c1 at 0i" 16) 0.9375-10.75390625i)
(num-test (string->number "df2 at 2-ccfi" 16) 913920-3279i)
@@ -77072,8 +77758,6 @@ but it's the printout that is at fault:
(num-test (string->number "b.+0 at 01i" 12) 11.0)
(num-test (string->number "-0 at -0221" 12) 0.0)
(num-test (string->number "-a-01 at 2i" 12) -10-144i)
- (num-test (string->number "#d.0 at -11" 10) 0.0)
- (num-test (string->number "#i+1 at 002" 10) 100.0)
(num-test (string->number "-111 at -1-1i" 10) -11.1-1i)
(num-test (string->number "122 at 9-2@0i" 10) 122000000000-2i)
(num-test (string->number "-0 at +10-20i" 10) 0-20i)
@@ -77083,7 +77767,6 @@ but it's the printout that is at fault:
(test (= .6 (string->number ".6")) #t)
(test (= 0.60 (string->number "0.60")) #t)
(test (= 60e-2 (string->number "60e-2")) #t)
-(test (= #i3/5 (string->number "#i3/5")) #t)
(test (= 0.11 (string->number "0.11")) #t)
(test (= 0.999 (string->number "0.999")) #t)
(test (= 100.000 (string->number "100.000")) #t)
@@ -77103,7 +77786,6 @@ but it's the printout that is at fault:
(test (= 0.60 (string->number (number->string 0.60))) #t)
(test (= 60e-2 (string->number (number->string 60e-2))) #t)
(test (= 0.6-.1i (string->number (number->string 0.6-.1i))) #t))
-;(test (= #i3/5 (string->number (number->string #i3/5))) #t)
(test (= 0.11 (string->number (number->string 0.11))) #t)
(test (= 0.999 (string->number (number->string 0.999))) #t)
(test (= 100.000 (string->number (number->string 100.000))) #t)
@@ -77156,7 +77838,7 @@ but it's the printout that is at fault:
(string->number str6)
(string->number str7))))
(if (not (apply = args))
- (format-logged #t "~A.~A: ~{~D~^~4T~}~%" strd str
+ (format #t "~A.~A: ~{~D~^~4T~}~%" strd str
(map (lambda (val)
(let ((ctr 0))
(for-each
@@ -77306,154 +77988,6 @@ etc....
(test (infinite? 2e12341234123123123123213123123123) #t)
(test (infinite? 2e9223372036854775807) #t))
-(when (provided? 'dfls-exponents)
- (test (> 1.0L10 1.0e9) #t)
- (test (> 1.0l10 1.0e9) #t)
- (test (> 1.0s10 1.0e9) #t)
- (test (> 1.0S10 1.0e9) #t)
- (test (> 1.0d10 1.0e9) #t)
- (test (> 1.0D10 1.0e9) #t)
- (test (> 1.0f10 1.0e9) #t)
- (test (> 1.0F10 1.0e9) #t)
-
- (test (> (real-part 1.0L10+i) 1.0e9) #t)
- (test (> (real-part 1.0l10+i) 1.0e9) #t)
- (test (> (real-part 1.0s10+i) 1.0e9) #t)
- (test (> (real-part 1.0S10+i) 1.0e9) #t)
- (test (> (real-part 1.0d10+i) 1.0e9) #t)
- (test (> (real-part 1.0D10+i) 1.0e9) #t)
- (test (> (real-part 1.0f10+i) 1.0e9) #t)
- (test (> (real-part 1.0F10+i) 1.0e9) #t)
-
- (test (> (imag-part 1.0+1.0L10i) 1.0e9) #t)
- (test (> (imag-part 1.0+1.0l10i) 1.0e9) #t)
- (test (> (imag-part 1.0+1.0s10i) 1.0e9) #t)
- (test (> (imag-part 1.0+1.0S10i) 1.0e9) #t)
- (test (> (imag-part 1.0+1.0d10i) 1.0e9) #t)
- (test (> (imag-part 1.0+1.0D10i) 1.0e9) #t)
- (test (> (imag-part 1.0+1.0f10i) 1.0e9) #t)
- (test (> (imag-part 1.0+1.0F10i) 1.0e9) #t)
-
- (test (> (string->number "1.0L10") 1.0e9) #t)
- (test (> (string->number "1.0l10") 1.0e9) #t)
- (test (> (string->number "1.0s10") 1.0e9) #t)
- (test (> (string->number "1.0S10") 1.0e9) #t)
- (test (> (string->number "1.0d10") 1.0e9) #t)
- (test (> (string->number "1.0D10") 1.0e9) #t)
- (test (> (string->number "1.0f10") 1.0e9) #t)
- (test (> (string->number "1.0F10") 1.0e9) #t)
-
- (test (> (real-part (string->number "1.0L10+i")) 1.0e9) #t)
- (test (> (real-part (string->number "1.0l10+i")) 1.0e9) #t)
- (test (> (real-part (string->number "1.0s10+i")) 1.0e9) #t)
- (test (> (real-part (string->number "1.0S10+i")) 1.0e9) #t)
- (test (> (real-part (string->number "1.0d10+i")) 1.0e9) #t)
- (test (> (real-part (string->number "1.0D10+i")) 1.0e9) #t)
- (test (> (real-part (string->number "1.0f10+i")) 1.0e9) #t)
- (test (> (real-part (string->number "1.0F10+i")) 1.0e9) #t)
-
- (test (> (imag-part (string->number "1.0+1.0L10i")) 1.0e9) #t)
- (test (> (imag-part (string->number "1.0+1.0l10i")) 1.0e9) #t)
- (test (> (imag-part (string->number "1.0+1.0s10i")) 1.0e9) #t)
- (test (> (imag-part (string->number "1.0+1.0S10i")) 1.0e9) #t)
- (test (> (imag-part (string->number "1.0+1.0d10i")) 1.0e9) #t)
- (test (> (imag-part (string->number "1.0+1.0D10i")) 1.0e9) #t)
- (test (> (imag-part (string->number "1.0+1.0f10i")) 1.0e9) #t)
- (test (> (imag-part (string->number "1.0+1.0F10i")) 1.0e9) #t)
-
- (when with-bignums
- (test (> (string->number "1.0L100") 1.0e98) #t)
- (test (> (string->number "1.0l100") 1.0e98) #t)
- (test (> (string->number "1.0s100") 1.0e98) #t)
- (test (> (string->number "1.0S100") 1.0e98) #t)
- (test (> (string->number "1.0d100") 1.0e98) #t)
- (test (> (string->number "1.0D100") 1.0e98) #t)
- (test (> (string->number "1.0f100") 1.0e98) #t)
- (test (> (string->number "1.0F100") 1.0e98) #t)
- (test (> (string->number "1.0E100") 1.0e98) #t)
-
- (test (> 1.0L100 1.0e98) #t)
- (test (> 1.0l100 1.0e98) #t)
- (test (> 1.0s100 1.0e98) #t)
- (test (> 1.0S100 1.0e98) #t)
- (test (> 1.0d100 1.0e98) #t)
- (test (> 1.0D100 1.0e98) #t)
- (test (> 1.0f100 1.0e98) #t)
- (test (> 1.0F100 1.0e98) #t)
-
- (test (> (real-part (string->number "1.0L100+i")) 1.0e98) #t)
- (test (> (real-part (string->number "1.0l100+i")) 1.0e98) #t)
- (test (> (real-part (string->number "1.0s100+i")) 1.0e98) #t)
- (test (> (real-part (string->number "1.0S100+i")) 1.0e98) #t)
- (test (> (real-part (string->number "1.0d100+i")) 1.0e98) #t)
- (test (> (real-part (string->number "1.0D100+i")) 1.0e98) #t)
- (test (> (real-part (string->number "1.0f100+i")) 1.0e98) #t)
- (test (> (real-part (string->number "1.0F100+i")) 1.0e98) #t)
-
- (test (> (real-part 1.0L100+i) 1.0e98) #t)
- (test (> (real-part 1.0l100+i) 1.0e98) #t)
- (test (> (real-part 1.0s100+i) 1.0e98) #t)
- (test (> (real-part 1.0S100+i) 1.0e98) #t)
- (test (> (real-part 1.0d100+i) 1.0e98) #t)
- (test (> (real-part 1.0D100+i) 1.0e98) #t)
- (test (> (real-part 1.0f100+i) 1.0e98) #t)
- (test (> (real-part 1.0F100+i) 1.0e98) #t)
-
- (test (> (imag-part (string->number "1.0+1.0L100i")) 1.0e98) #t)
- (test (> (imag-part (string->number "1.0+1.0l100i")) 1.0e98) #t)
- (test (> (imag-part (string->number "1.0+1.0s100i")) 1.0e98) #t)
- (test (> (imag-part (string->number "1.0+1.0S100i")) 1.0e98) #t)
- (test (> (imag-part (string->number "1.0+1.0d100i")) 1.0e98) #t)
- (test (> (imag-part (string->number "1.0+1.0D100i")) 1.0e98) #t)
- (test (> (imag-part (string->number "1.0+1.0f100i")) 1.0e98) #t)
- (test (> (imag-part (string->number "1.0+1.0F100i")) 1.0e98) #t)
-
- (test (> (imag-part 1.0+1.0L100i) 1.0e98) #t)
- (test (> (imag-part 1.0+1.0l100i) 1.0e98) #t)
- (test (> (imag-part 1.0+1.0s100i) 1.0e98) #t)
- (test (> (imag-part 1.0+1.0S100i) 1.0e98) #t)
- (test (> (imag-part 1.0+1.0d100i) 1.0e98) #t)
- (test (> (imag-part 1.0+1.0D100i) 1.0e98) #t)
- (test (> (imag-part 1.0+1.0f100i) 1.0e98) #t)
- (test (> (imag-part 1.0+1.0F100i) 1.0e98) #t)))
-
-(when (and with-bignums (not pure-s7))
- (test (number? (string->number "#e1.0e564")) #t)
- (test (number? (string->number "#e1.0e307")) #t)
- (test (number? (string->number "#e1.0e310")) #t)
- (num-test (string->number "#e1624540914719833702142058941") 1624540914719833702142058941)
- (num-test (string->number "#i1624540914719833702142058941") 1.624540914719833702142058941E27)
- (num-test (string->number "#e8978167593632120808315265/5504938256213345873657899") 8978167593632120808315265/5504938256213345873657899)
- (num-test (string->number "#i8978167593632120808315265/5504938256213345873657899") 1.630929753571457437099527114342760854299E0)
- (num-test (string->number "#i119601499942330812329233874099/12967220607") 9.223372036854775808414213562473095048798E18)
- ;; this next test needs more bits to compare with other schemes -- this is the result if 128 bits
- (num-test (string->number "#e005925563891587147521650777143.74135805596e05") 826023606487248364518118333837545313/1394)
- (num-test (string->number "#e-1559696614.857e28") -15596966148570000000000000000000000000)
- (test (integer? (string->number "#e1e310")) #t)
- (test (number? (string->number "#e1.0e310")) #t))
-;; in the non-gmp case #e1e321 is a read error -- should s7 return NaN silently?
-
-(when (and (not with-bignums)
- (not pure-s7))
- (test (string->number "#e1e307") #f)
- (test (eval-string "(number? #e1.0e564)") 'error)
- (test (string->number "#e005925563891587147521650777143.74135805596e05") #f)
- (test (string->number "#e78.5e65") #f)
- (test (string->number "#e1e543") #f)
- (test (string->number "#e120d21") #f)
- (test (string->number "#e-2.2e021") #f)
- (if (provided? '@-exponent)
- (test (infinite? (string->number "9221. at 9129" 10)) #t))
- (test (string->number "#e120 at 21" 12) #f)
- (test (string->number "#d#e120 at 21") #f)
- (test (string->number "#b#e120 at 21") #f)
- (test (string->number "#e#b120 at 21") #f)
- (test (string->number "#e#d120 at 21") #f)
- (test (nan? (string->number "0f0/00" 16)) #t)
- (test (string->number "#e-1559696614.857e28") #f)
- (test (string->number "#e1+1i") #f)
- (test (= 0 00 -000 #e-0 0/1 #e#x0 #b0000 #e#d0.0 -0 +0) #t))
-
;; (do ((i 0 (+ i 1)) (n 1 (* n 2))) ((= i 63)) (display n) (display " ") (display (number->string n 16)) (newline))
(test (number->string 3/4 2) "11/100")
@@ -77530,16 +78064,6 @@ etc....
(test (string->number "1E1") 10.0)
(test (string->number "1e1") 10.0)
-(when (provided? 'dfls-exponents)
- (test (string->number "1D1") 10.0)
- (test (string->number "1S1") 10.0)
- (test (string->number "1F1") 10.0)
- (test (string->number "1L1") 10.0)
- (test (string->number "1d1") 10.0)
- (test (string->number "1s1") 10.0)
- (test (string->number "1f1") 10.0)
- (test (string->number "1l1") 10.0))
-
(num-test (string->number "1234567890123456789012345678901234567890.123456789e-30") 1234567890.1235)
(num-test (string->number "123456789012345678901234567890123456789012345678901234567890.123456789e-50") 1234567890.1235)
(num-test (- 1234567890123456789012345678901234567890123456789012345678901234567890.123456789e-60 12345678901234567890123456789012345678901234567890.123456789e-40) 0.0)
@@ -77644,9 +78168,6 @@ etc....
(num-test #b111111111111111111111111111111111111111111111111111111111111111 most-positive-fixnum)
(num-test #o777777777777777777777 most-positive-fixnum)
(num-test #x7fffffffffffffff most-positive-fixnum)
-(num-test #d9223372036854775807 most-positive-fixnum)
-
-(num-test #d-9223372036854775808 most-negative-fixnum)
(num-test #o-1000000000000000000000 most-negative-fixnum)
(num-test #x-8000000000000000 most-negative-fixnum)
(num-test #b-1000000000000000000000000000000000000000000000000000000000000000 most-negative-fixnum)
@@ -77734,15 +78255,12 @@ etc....
(let ((str (string-append "#" (string (integer->char i)) "1.0e8")))
(catch #t (lambda ()
(let ((val (eval-string str)))
- (format-logged #t "~A -> ~S~%" str val)))
+ (format #t "~A -> ~S~%" str val)))
(lambda args 'error))))
|#
(num-test #b1.0e8 256.0)
(num-test #o1.0e8 16777216.0)
-(num-test #d1.0e8 100000000.0)
(num-test #x1.0e8 1.056640625) ; e is a digit
-(num-test #e1.0e8 100000000)
-(num-test #i1.0e8 100000000.0)
(if with-bignums
(num-test #b1.1111111111111111111111111111111111111111111111111110011101010100100100011001011011111011000011001110110101010011110011000100111E1023 1.7976931348623156E308))
@@ -77759,44 +78277,6 @@ etc....
(test (string->number "1e#b0") #f)
(test (string->number "#B0") #f)
(test (string->number "0+I") #f)
-(when (not pure-s7)
- (test (string->number "#b#i0/0") #f)
- (test (string->number "#b#e0/0") #f)
- (test (string->number "#b#e1/0+i") #f) ; inf+i?
- (test (string->number "#e#b0/0") #f)
- (test (string->number "#i#b0/0") #f)
- (test (string->number "#e0/0") #f)
- (test (number? (string->number "#i0/0")) #t) ; nan since (number? 0/0) is #t
- (test (string->number "#e#b1/0") #f)
- (test (string->number "#i#b1/0") #f)
- (test (string->number "#e1/0") #f)
- (test (number? (string->number "#i1/0")) #t)
- (test (string->number "#e#b1/0+i") #f)
- (test (string->number "#i#b1/0+i") #f) ; inf+i?
- (test (string->number "#e1/0+i") #f)
- (test (number? (string->number "#i1/0+i")) #t)
- (test (number? (string->number "#i0/0+i")) #t)
- (test (nan? #i0/0) #t) ; but #i#d0/0 is a read error?
-
- (num-test (string->number "#b#e11e30") 3221225472) ; very confusing!
- (num-test (string->number "#b#i11e30") 3221225472.0)
- (num-test (string->number "#e#b11e30") 3221225472)
- (num-test (string->number "#i#b11e30") 3221225472.0)
- (num-test (string->number "#b#e+1e+1+0e+10i") 2)
- (num-test (string->number "#e+.0e-00-0i") 0)
- (num-test (string->number "#e-0/1110010") 0)
- (num-test (string->number "#x#e00110e") 4366)
- (num-test (string->number "#e#x-e/001") -14)
- (num-test (string->number "#e.001e-11") 0)
- (num-test (string->number "#x#e00/00e") 0)
- (num-test (string->number "#e#x+1e.01e10100") 65366158/2178339)
- (num-test (string->number "#i#x0e10-000i") 3600.0)
- (num-test (string->number "#x0/e010-e/1i") 0-14i)
- (num-test (string->number "#i-1/1-1.0e1i") -1-10i)
- (num-test (string->number "#e#x001ee11e1") 32379361)
- (num-test (string->number "#e#x010e10.e1") 17699041/256)
- (num-test #b#i.110e-1 0.375)
- (num-test #e01.1e1+00.i 11))
(num-test (string->number "#x10+10i") 16+16i)
(num-test 00-10e+001i 0-100i)
@@ -77815,39 +78295,8 @@ etc....
(num-test (string->number "#x+ee.-e00e0110i") 238-3759014160i)
(num-test (string->number "#x-e0/1ee") -112/247)
-(when (provided? 'dfls-exponents)
- (num-test (string->number "#d.0d1+i") 0+1i)
- (num-test (string->number "+.0d-1+i") 0+1i)
- (num-test (string->number "#d1d+0-1d-1i") 1-0.1i)
- (num-test (string->number "#i+1+0.d-0i") 1.0)
- (num-test (string->number "#o#i-101d+0") -65.0)
- (num-test (string->number "+001.110d+1") 11.1)
- (num-test (string->number "#e01+0d000i") 1)
- (num-test (string->number "#d1d0-0.d0i") 1.0)
- (num-test (string->number "#d#i001d+00") 1.0)
- (num-test (string->number "#o0010111/1") 4169)
- (num-test (string->number "0d00-0.d+0i") 0.0)
- (num-test (string->number "#o1.d0+10.d00i") 1+8i)
- (num-test (string->number "0d+01+1e+1i") 0+10i)
- (num-test (string->number "10.d-005" 2) 0.0625)
- (num-test (string->number "+7f2-73i" 8) 448-59i))
-
-(num-test (string->number "#e#d+11.e-0") 11)
-(num-test (string->number "#d.0e011110") 0.0)
(num-test (string->number "+01e01+0/1i") 10.0)
-(num-test (string->number "#i#d1e1+.0i") 10.0)
(num-test (string->number "1.-0.0e+00i") 1.0)
-
-(when (not pure-s7)
- (test (string->number "#o#e10.+1.i") #f)
- (test (string->number "#x#e1+i") #f)
- (test (string->number "#x#1+#e1i") #f)
- (test (string->number "#x#e1+#e1i") #f)
- (test (string->number "#b#e1+i") #f)
- (test (string->number "#o#e1-110.i") #f)
- (num-test (string->number "#e1+0i") 1)
- (num-test (string->number "#x#e1+0i") 1)
- (num-test (string->number "#e#x1+0i") 1))
(num-test (string->number "#x1/7e2") 1/2018)
(num-test (string->number "0.1e00" 2) 0.5)
@@ -77881,22 +78330,6 @@ etc....
(num-test (string->number "acd/eabf" 16) 79/1717)
(num-test (string->number "-1e-1-1e-1i") -0.1-0.1i)
(num-test (string->number "+1e+1+1e+1i") 10+10i)
-(when (not pure-s7)
- (num-test (string->number "#i#d+1e+1+1e+1i") 10+10i)
- (test (string->number "#e+1e+1+1e+1i") #f)
- ;; these depend on rationalize's default error I think
- ;; and they cause valgrind to hang!!
- ;;(num-test (string->number "#e.1e-11") 0)
- ;;(num-test (string->number "#e1e-12") 0)
- (num-test (string->number "#e1e-11") 1/90909090910)
- (test (string->number "#e#f1") #f)
-
- (when with-bignums
- (test (= (string->number "#e1e19") (string->number "#e.1e20")) #t)
- (test (= (string->number "#e1e19") (* 10 (string->number "#e1e18"))) #t)
- (test (= (string->number "#e1e20") (* 100 (string->number "#e1e18"))) #t))
-
- (test (= #i1e19 #i.1e20) #t))
(test (= 1e19 .1e20) #t)
(test (string->number "15+b7a9+8bbi-95+4e" 16) #f)
@@ -77917,18 +78350,6 @@ etc....
(when (and with-bignums (not pure-s7))
(test (number->string (/ most-positive-fixnum most-negative-fixnum) 2) "-111111111111111111111111111111111111111111111111111111111111111/1000000000000000000000000000000000000000000000000000000000000000")
(test (string->number "-111111111111111111111111111111111111111111111111111111111111111/1000000000000000000000000000000000000000000000000000000000000000" 2) -9223372036854775807/9223372036854775808)
- (num-test (string->number "#b#e-11e+111") -7788445287802241442795744493830144)
- (num-test (string->number "#i#b-11e+111") -7.788445287802241442795744493830144E33)
- (num-test (string->number "#b#i-11e+111") -7.788445287802241442795744493830144E33)
- (num-test (string->number "#i3e+111") 3.0e111)
- (num-test (string->number "#e3e30") 3000000000000000000000000000000)
- (num-test (string->number "#i3e30") 3.000E30)
-
- (num-test (string->number "#b#e11e80") 3626777458843887524118528)
- (num-test (string->number "#b#i11e80") 3626777458843887524118528.0)
- (num-test (string->number "#e#b11e80") 3626777458843887524118528)
- (num-test (string->number "#i#b11e80") 3626777458843887524118528.0)
-
(num-test (string->number "b2706b3d3e8e46ad5aae" 15) 247500582888444441302414)
(num-test (string->number "ceec932122d7c22289da9144.4b7836de0a2f5ef" 16) 6.403991331575236168367699181229480307503E28)
(num-test (string->number "c23177c20fb1296/fcf15a82c8544613721236e2" 16) 437284287268358475/39141000511500755277510679409)
@@ -77953,13 +78374,12 @@ etc....
(test (infinite? (string->number "8e7290491476" 10)) #t)
(num-test (string->number "4ff7da4d/ab09e16255c06a55c5cb7193ebb2fbb" 16) 1341643341/14209330580250438592763227155654717371)
- (num-test (string->number "#d3000000000000000000000000000000") 3000000000000000000000000000000)
(num-test (string->number "#x400000000000000000") (expt 2 70))
(for-each
(lambda (op)
(if (not (= (op 1e19) (op .1e20)))
- (format-logged #t ";(~A 1e19) = ~A, but (~A .1e20) = ~A?~%"
+ (format #t ";(~A 1e19) = ~A, but (~A .1e20) = ~A?~%"
op (op 1e19)
op (op .1e20))))
(list floor ceiling truncate round inexact->exact exact->inexact))
@@ -77967,86 +78387,32 @@ etc....
(for-each
(lambda (op)
(if (not (= (op -1e19) (op -.1e20)))
- (format-logged #t ";(~A -1e19) = ~A, but (~A -.1e20) = ~A?~%"
+ (format #t ";(~A -1e19) = ~A, but (~A -.1e20) = ~A?~%"
op (op -1e19)
op (op -.1e20))))
(list floor ceiling truncate round inexact->exact exact->inexact)))
(num-test #b+01 1)
(num-test #b-01 -1)
-(num-test #d-1/2 -1/2)
-(num-test #d+1/2 1/2)
(num-test #b1.0e-8 0.00390625)
(num-test #o1.0e-8 5.9604644775391e-08)
-(num-test #d1.0e-8 1.0e-8)
(num-test #b-.1 -0.5)
(num-test #o-.1 -0.125)
-(num-test #d-.1 -0.1)
(num-test #x-.1 -0.0625)
(num-test #b+.1 +0.5)
(num-test #o+.1 +0.125)
-(num-test #d+.1 +0.1)
(num-test #x+.1 +0.0625)
(num-test #b+.1e+1 1.0)
-(num-test #d+.1e+1 1.0)
(num-test #o+.1e+1 1.0)
(num-test #b000000001 1)
(num-test #b1e1 2.0)
(num-test #b1.e1 2.0)
-(when (not pure-s7)
- (num-test #b#e-.1 -1/2)
- (num-test #o#e-.1 -1/8)
- (num-test #d#e-.1 -1/10)
- (num-test #x#e-.1 -1/16)
- (num-test #b#e1.1e2 6)
- (num-test #o#e1.1e2 72)
- (num-test #d#e1.1e2 110)
- (num-test #b#i-1.1e-2 -0.375)
- (num-test #o#i-1.1e-2 -0.017578125)
- (num-test #d#i-1.1e-2 -0.011)
- (num-test #e#b1e-10 1/1024)
- (num-test #e#b+1.1 3/2)
- (num-test #e#o+1.1 9/8)
- (num-test #e#d+1.1 11/10)
- (num-test #e#x+1.1 17/16)
- (num-test #e#b+1.1e+2 6)
- (num-test #e#o+1.1e+2 72)
- (num-test #e#d+1.1e+2 110)
- (num-test #i#b.001 0.125)
- (num-test #i#b000000000011 3.0)
- (num-test #i#b-000000000011e1 -6.0)
- (num-test #i#b-000000000011e+11 -6144.0)
- ;;(num-test #b#e0+i 0+1i) ; these 2 are now read-errors (#e0+i is an error because inexact->exact does not accept complex args in s7)
- ;;(num-test #b#e0+1.1i 0+1.5i)
- (test (string->number "#b#e0+i") #f)
- (num-test #i#xf/c 1.25)
- (num-test #e#x1.4 5/4)
- (num-test #e2/3 2/3)
- (num-test #b#e+.1e+1 1)
- (num-test #b#e.011-0.i 3/8)
- (num-test #b#i1.1e0-.0i 1.5)
- (num-test #b#e1.1e0-.0i 3/2)
- (num-test #b#e-1.00e+001 -2)
- (num-test #b#e+.01011100 23/64)
- (num-test #b#i-00-0/001i 0.0)
- (num-test #e#x1234/12 (string->number "#x#e1234/12"))
- (num-test #x#e.1 #e#x.1))
-
-(num-test #e-.0 0)
-(num-test #e-123.0 -123)
-(num-test #i-123 -123.0)
-(num-test #e+123.0 123)
-(num-test #i+123 123.0)
-(num-test #i-0 0.0)
-(num-test #e-0.0 0)
-;;; in guile #e1e-10 is 7737125245533627/77371252455336267181195264
-
(num-test #x-AAF -2735)
(num-test #x-aAf -2735)
@@ -78054,27 +78420,18 @@ etc....
(num-test #xf/c 5/4)
(num-test #x+f/c 5/4)
(num-test #x-f/c -5/4)
-(num-test #d1/2 1/2)
-
-;; nutty: #e+inf.0 #e+nan.0
-;; these don't arise in s7 because we don't define inf.0 and nan.0
-(if with-bignums (num-test #e9007199254740995.0 9007199254740995))
(num-test #b0/1 0)
;(test #b0/0 'division-by-zero) ; read-error
-(num-test #d3/4 3/4)
(num-test #o7/6 7/6)
(num-test #o11/2 9/2)
-(num-test #d11/2 11/2)
(num-test #x11/2 17/2)
(num-test #b111/11 7/3)
(num-test #b111111111111111111111111111111111111111111111111111111111111111/111 1317624576693539401)
-(num-test #d9223372036854775807/7 1317624576693539401)
(num-test (* 1317624576693539401 7) most-positive-fixnum)
(num-test #o777777777777777777777/7 1317624576693539401)
(num-test #x7fffffffffffffff/7 1317624576693539401)
(num-test (string->number "#x1234/12") (string->number "1234/12" 16))
-(num-test #d#i1/10 #i#d1/10)
(test (equal? 0.0 #b0e0) #t)
(test (equal? 0.0 #b0e-0) #t)
@@ -78123,20 +78480,6 @@ etc....
(num-test #b-0/1 0)
(num-test #b1.+.1i 1+0.5i)
(num-test 1e-0 1.0)
-(when (not pure-s7)
- (num-test #b#i0-0i 0.0)
- (num-test #b#e1e01 2)
- (num-test #b#e1e-0 1)
- (num-test #b#e11e-1 3/2)
- ;;(num-test #b#e-0/1+i 0+1i)
- (test (string->number "#b#e-1/1+01.1e1i") #f)
- (test (string->number "#d#i0/0") #f)
- (test (string->number "#i#x0/0") #f)
- (test (exact? #i#b1) #f)
- (test (exact? #e#b1) #t)
- (num-test #x#e1.5 21/16)
- (num-test #x#i3 3.0))
-
(num-test #b0100/10 2)
(num-test #b0e+1-0.i 0.0)
(num-test #b.1-0/01i 0.5)
@@ -78146,10 +78489,6 @@ etc....
(num-test #b00e+0-.00e11i 0.0)
(num-test #b-000e+10110001 0.0)
-(test (exact? #i1) #f)
-(test (exact? #e1.0) #t)
-(test (exact? #i1.0) #f)
-(test (exact? #e1) #t)
(test (number? ''1) #f)
(test (symbol? ''1) #f)
(test (string->number "''1") #f)
@@ -78165,11 +78504,6 @@ etc....
(test (number? '00-) #f)
(test (string->number "00-") #f)
-(if pure-s7 (exit)) ; no way to go on...
-
-(num-test #e0.1 1/10)
-(num-test #x#if 15.0)
-(num-test #i1/1 1.0)
(num-test #o-11 -9)
(num-test #o-0. 0.0)
(num-test #o+.0 0.0)
@@ -78181,27 +78515,12 @@ etc....
(num-test #x+00 0)
(num-test #x.c0 0.75)
(num-test #x-fc -252)
-(test (equal? #e1.5 3/2) #t)
-(test (equal? #e1.0 1) #t)
-(test (equal? #e-.1 -1/10) #t)
-(test (equal? #e1 1) #t)
-(test (equal? #e3/2 3/2) #t)
-(test (< (abs (- #i3/2 1.5)) 1e-12) #t)
-(test (< (abs (- #i1 1.0)) 1e-12) #t)
-(test (< (abs (- #i-1/10 -0.1)) 1e-12) #t)
-(test (< (abs (- #i1.5 1.5)) 1e-12) #t)
(num-test (= 0e-1 0.0) #t)
;;; (/ (/ 0))??
(num-test #x.a+i 0.625+1i)
(num-test #b1.+i 1+1i)
(num-test 0.e-0 0.0)
-(when (provided? 'dfls-exponents)
- (num-test (string->number "#i1s0") 1.0) ; need the s->n to avoid confusing reader in non-dfls case
- (num-test -0d-0 0.0)
- (num-test +1d+1 10.0)
- (num-test +1s00 1.0))
-
(let ((str (make-string 3)))
(set! (str 0) #\#)
(set! (str 1) #\b)
@@ -78248,9 +78567,7 @@ etc....
(integer->char (+ (char->integer #\a) (- digit 10)))))
(define (exponent-marker)
- (if (provided? 'dfls-exponents)
- (string-ref "eEsSfFdDlL" (random 10))
- (string-ref "eE" (random 2))))
+ (string-ref "eE" (random 2)))
(if signed
(begin
@@ -78292,23 +78609,23 @@ etc....
(let ((rad (+ 2 (random 15))))
(let ((str (make-number rad)))
(if (not (number? (string->number str rad)))
- (format-logged #t ";(1) trouble in string->number ~A ~S: ~A~%"
+ (format #t ";(1) trouble in string->number ~A ~S: ~A~%"
rad str
(string->number str rad))
(if (not (string? (number->string (string->number str rad) rad)))
- (format-logged #t ";(2) trouble in number->string ~A ~S: ~A ~S~%"
+ (format #t ";(2) trouble in number->string ~A ~S: ~A ~S~%"
rad str
(string->number str rad)
(number->string (string->number str rad) rad))
(if (not (number? (string->number (number->string (string->number str rad) rad) rad)))
- (format-logged #t ";(3) trouble in number->string ~A ~S: ~A ~S ~A~%"
+ (format #t ";(3) trouble in number->string ~A ~S: ~A ~S ~A~%"
rad str
(string->number str rad)
(number->string (string->number str rad) rad)
(string->number (number->string (string->number str rad) rad) rad))
(let ((diff (abs (- (string->number (number->string (string->number str rad) rad) rad) (string->number str rad)))))
(if (> diff 2e-5)
- (format-logged #t "(string->number ~S ~D): ~A, n->s: ~S, s->n: ~A, diff: ~A~%"
+ (format #t "(string->number ~S ~D): ~A, n->s: ~S, s->n: ~A, diff: ~A~%"
str rad
(string->number str rad)
(number->string (string->number str rad) rad)
@@ -78322,7 +78639,7 @@ etc....
((= i len))
(if (and (not (char=? (str i) #\.))
(>= (string->number (string (str i)) 16) radix))
- (format-logged #t ";~S in base ~D has ~C?" str radix (str i))))))
+ (format #t ";~S in base ~D has ~C?" str radix (str i))))))
(no-char (number->string (* 1.0 2/3) 9) 9)
(no-char (number->string (string->number "0.05" 9) 9) 9)
@@ -78344,15 +78661,15 @@ etc....
(if (not (eqv? 3/4 (string->number (number->string 3/4 i) i)))
(begin
(set! happy #f)
- (format-logged #t ";(string<->number 3/4 ~A) -> ~A?~%" i (string->number (number->string 3/4 i) i))))
+ (format #t ";(string<->number 3/4 ~A) -> ~A?~%" i (string->number (number->string 3/4 i) i))))
(if (not (eqv? 1234/11 (string->number (number->string 1234/11 i) i)))
(begin
(set! happy #f)
- (format-logged #t ";(string<->number 1234/11 ~A) -> ~A?~%" i (string->number (number->string 1234/11 i) i))))
+ (format #t ";(string<->number 1234/11 ~A) -> ~A?~%" i (string->number (number->string 1234/11 i) i))))
(if (not (eqv? -1234/11 (string->number (number->string -1234/11 i) i)))
(begin
(set! happy #f)
- (format-logged #t ";(string<->number -1234/11 ~A) -> ~A?~%" i (string->number (number->string -1234/11 i) i))))))
+ (format #t ";(string<->number -1234/11 ~A) -> ~A?~%" i (string->number (number->string -1234/11 i) i))))))
(test (< (abs (- (string->number "3.1415926535897932384626433832795029") 3.1415926535897932384626433832795029)) 1e-7) #t)
@@ -78395,39 +78712,16 @@ etc....
(test (string->number "2/#b1" 10) #f)
(test (string->number "2.i" 10) #f)
(num-test (string->number "6+3.i" 10) 6+3i)
-(num-test (string->number "#e8/2" 11) 4)
(num-test (string->number "-61" 7) -43)
-;(num-test (string->number "#eb8235.9865c01" 13) 19132998081/57607)
-; this one depends on the underlying size (32/64)
(num-test (string->number "10100.000e11+011110111.1010110e00i" 2) 40960+247.671875i)
-(num-test (string->number "#i-0.e11" 2) 0.0)
(num-test (string->number "+4a00/b" 16) 18944/11)
-(num-test (string->number "#i+9/9" 10) 1.0)
-(num-test (string->number "#e9e-999" 10) 0)
-(num-test (string->number "#e-9.e-9" 10) -1/111098767)
-(num-test (string->number "#e-.9e+9" 10) -900000000)
(num-test (string->number "9-9.e+9i" 10) 9-9000000000i)
(num-test (string->number "-9+9e-9i" 10) -9+9e-09i) ; why the 09?
-(num-test (string->number "#e-.9e+9" 10) -900000000)
(num-test (string->number "9-9.e+9i" 10) 9-9000000000i)
-(num-test #e+32/1-0.i 32)
-(num-test #e+32.-0/1i 32)
-(num-test #e-32/1+.0i -32)
-(num-test #e+2.-0/31i 2)
(num-test +2-0.e-1i 2.0)
(num-test +2.-0e-1i 2.0)
-(num-test #b#e.01 1/4)
-(num-test #e#b.01 1/4)
-(num-test #b#e10. 2)
-(num-test #e#b10. 2)
-(num-test #b#e0.e11 0)
-(num-test #b#e1.e10 1024)
-(num-test #b#e-0.e+1 0)
-(num-test #b#e+.1e-0 1/2)
-(num-test #b#e+1.e-0 1)
-(num-test #b#e-1.e+0 -1)
;; weird cases:
(num-test (string->number "#b1000" 8) 8)
@@ -78440,30 +78734,8 @@ etc....
(num-test (string->number "#xffff" 10) 65535)
(num-test (string->number "#xffff" 6) 65535)
(num-test (string->number "#xffff" 16) 65535)
-(num-test (string->number "#d9.11" 16) 9.11)
-(num-test (string->number "#d9.11" 10) 9.11)
(num-test (string->number "#x35/3de" 10) 53/990)
-(num-test (string->number "#e87" 16) 135)
-(num-test (string->number "#e87" 10) 87)
-(num-test (string->number "#e#x87" 10) 135)
-(num-test (string->number "#e#x87" 16) 135)
-(num-test (string->number "#x#e87" 10) 135)
-(num-test (string->number "#i87" 16) 135.0)
-(num-test (string->number "#i87" 12) 103.0)
-(num-test (string->number "#ee" 16) 14)
-(num-test (string->number "#if" 16) 15.0)
-
-(num-test (string->number "#e10.01" 2) 9/4)
-(num-test (string->number "#e10.01" 6) 217/36)
-(num-test (string->number "#e10.01" 10) 1001/100)
-(num-test (string->number "#e10.01" 14) 2745/196)
-(num-test (string->number "#i10.01" 2) 2.25)
-(num-test (string->number "#i10.01" 6) 6.0277777777778)
-(num-test (string->number "#i10.01" 10) 10.01)
-(num-test (string->number "#i10.01" 14) 14.005102040816)
-(num-test (string->number "#i-.c2e9" 16) -0.76136779785156)
-
(test (string->number "#x#|1|#1") #f)
(test (string->number "#||#1") #f)
(test (string->number "#<") #f)
@@ -78472,7 +78744,6 @@ etc....
(num-test (string->number "4\x32\x37") 427)
(num-test (string->number "\x32.\x39") 2.9)
-(num-test (string->number "#i\x32\x38\x36") 286.0)
(num-test (string->number "4\x31+3\x36i") 41+36i)
(when with-bignums
@@ -78492,7 +78763,7 @@ etc....
(let ((val (string->number (string-append "1" exponent "1") base)))
(if (and (number? val)
(> (abs (- val base)) 1e-9))
- (format-logged #t ";(string->number ~S ~A) returned ~A?~%"
+ (format #t ";(string->number ~S ~A) returned ~A?~%"
(string-append "1" exponent "1") base (string->number (string-append "1" exponent "1") base)))))
(do ((base 2 (+ base 1)))
@@ -78500,7 +78771,7 @@ etc....
(let ((val (string->number (string-append "1.1" exponent "1") base)))
(if (and (number? val)
(> (abs (- val (+ base 1))) 1e-9))
- (format-logged #t ";(string->number ~S ~A) returned ~A?~%"
+ (format #t ";(string->number ~S ~A) returned ~A?~%"
(string-append "1.1" exponent "1") base (string->number (string-append "1.1" exponent "1") base)))))
(do ((base 2 (+ base 1)))
@@ -78508,7 +78779,7 @@ etc....
(let ((val (string->number (string-append "1" exponent "+1") base)))
(if (and (number? val)
(> (abs (- val base)) 1e-9))
- (format-logged #t ";(string->number ~S ~A) returned ~A?~%"
+ (format #t ";(string->number ~S ~A) returned ~A?~%"
(string-append "1" exponent "+1") base (string->number (string-append "1" exponent "+1") base)))))
; in base 16 this is still not a number because of the + (or -)
; but "1e+1i" is a number -- gad!
@@ -78518,7 +78789,7 @@ etc....
(let ((val (string->number (string-append "1" exponent "-1+1i") base)))
(if (and (number? val)
(> (magnitude (- val (complex (/ base) 1))) 1e-6))
- (format-logged #t ";(string->number ~S ~A) returned ~A?~%"
+ (format #t ";(string->number ~S ~A) returned ~A?~%"
(string-append "1" exponent "-1+1i") base (string->number (string-append "1" exponent "-1+1i") base)))))))
(list #\e #\d #\f #\s #\l))
@@ -78550,7 +78821,7 @@ etc....
(if (> (abs (- val (string->number str i))) 1e-7)
(begin
(set! happy #f)
- (format-logged #t ";(string->number ~S ~A) -> ~A (expected ~A)?~%" str i (string->number str i) val)))))
+ (format #t ";(string->number ~S ~A) -> ~A (expected ~A)?~%" str i (string->number str i) val)))))
(let* ((radlim (list 0 0 62 39 31 26 23 22 20 19 18 17 17 16 16 15 15))
(digits "00123456789abcdef"))
@@ -78562,7 +78833,7 @@ etc....
(if (> (abs (- val (string->number str i))) 1e-7)
(begin
(set! happy #f)
- (format-logged #t ";(string->number ~S ~A) -> ~A (expected ~A)?~%" str i (string->number str i) val)))))))))
+ (format #t ";(string->number ~S ~A) -> ~A (expected ~A)?~%" str i (string->number str i) val)))))))))
(let ((happy #t))
(do ((i 2 (+ i 1)))
@@ -78571,17 +78842,17 @@ etc....
(if (> (abs (- 0.75 (string->number (number->string 0.75 i) i))) 1e-6)
(begin
(set! happy #f)
- (format-logged #t ";(string->number (number->string 0.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string 0.75 i) i))))
+ (format #t ";(string->number (number->string 0.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string 0.75 i) i))))
(if (> (abs (- 1234.75 (string->number (number->string 1234.75 i) i))) 1e-6)
(begin
(set! happy #f)
- (format-logged #t ";(string->number (number->string 1234.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string 1234.75 i) i))))
+ (format #t ";(string->number (number->string 1234.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string 1234.75 i) i))))
(if (> (abs (- -1234.25 (string->number (number->string -1234.25 i) i))) 1e-6)
(begin
(set! happy #f)
- (format-logged #t ";(string->number (number->string -1234.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string -1234.75 i) i))))
+ (format #t ";(string->number (number->string -1234.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string -1234.75 i) i))))
(let ((val (string->number (number->string 12.5+3.75i i) i)))
(if (or (not (number? val))
@@ -78589,7 +78860,7 @@ etc....
(> (abs (- (imag-part val) 3.75)) 1e-6))
(begin
(set! happy #f)
- (format-logged #t ";(string->number (number->string 12.5+3.75i ~A) ~A) -> ~A?~%" i i (string->number (number->string 12.5+3.75i i) i)))))
+ (format #t ";(string->number (number->string 12.5+3.75i ~A) ~A) -> ~A?~%" i i (string->number (number->string 12.5+3.75i i) i)))))
(let ((happy #t))
(do ((base 2 (+ base 1)))
@@ -78616,7 +78887,7 @@ etc....
(> (abs (- (imag-part nval) (imag-part val))) 1e-3))
(begin
(set! happy #f)
- (format-logged #t ";(number<->string ~S ~A) -> ~A? [~A ~S]~%" str base nval sn nsn)
+ (format #t ";(number<->string ~S ~A) -> ~A? [~A ~S]~%" str base nval sn nsn)
)))))))))
@@ -78675,24 +78946,14 @@ etc....
((4 5 6) 'real)
(else 'complex))))
- ;; possible #e or #i
- (if (and (not (eq? choice 'complex))
- (> (random 10) 8))
- (begin
- (set! (str j) #\#)
- (set! j (+ j 1))
- (set! (str j) (#(#\e #\i) (random 2)))
- (if (char=? (str j) #\e) (set! edigits 0))
- (set! j (+ j 1))))
-
;; possible #x etc
(if (> (random 10) 7)
(begin
(set! (str j) #\#)
(set! j (+ j 1))
- (let ((rchoice (random 4)))
- (set! (str j) (#(#\b #\d #\o #\x) rchoice))
- (set! radix (#(2 10 8 16) rchoice)))
+ (let ((rchoice (random 3)))
+ (set! (str j) (#(#\b #\o #\x) rchoice))
+ (set! radix (#(2 8 16) rchoice)))
(set! j (+ j 1))))
;; possible sign
@@ -78785,12 +79046,6 @@ etc....
(test (string->number-1 "-") #f )
(test (string->number-1 "+") #f )
- (test (string->number-1 "#i1-1ei") #f)
- (test (string->number-1 "#i-2e+i") #f)
- (test (string->number-1 "#i1+i1i") #f)
- (test (string->number-1 "#i1+1") #f)
- (test (string->number-1 "#i2i.") #f)
-
(test (string->number "1e0+i") 1+i)
(test (string->number "1+ie0") #f)
(test (string->number "1+e0") #f)
@@ -78802,26 +79057,10 @@ etc....
(test (string->number "0+I") #f)
(num-test (string->number-1 "3.4e3") 3400.0)
- (num-test (string->number-1 "0") 0)
- (num-test (string->number-1 "#x#e-2e2") -738)
- )
+ (num-test (string->number-1 "0") 0))
(test (let* ((str "1+0i") (x (string->number str))) (and (number? x) (string=? str "1+0i"))) #t)
-(test (= 1 #e1 1/1 #e1/1 #e1.0 #e1e0 #b1 #x1 #o1 #d1 #o001 #o+1 #o#e1 #e#x1 #e1+0i #e10e-1 #e0.1e1 #e+1-0i #e#b1) #t)
-;(test (= 0.3 3e-1 0.3e0 3e-1) #t)
-(test (= 0 +0 0.0 +0.0 0/1 +0/24 0+0i #e0 #b0 #x0 #o0 #e#b0) #t)
-
-(let ((things (vector 123 #e123 #b1111011 #e#b1111011 #b#e1111011 #o173 #e#o173 #o#e173
- #x7b #e#x7b #x#e7b (string->number "123") 246/2 #e123/1 #d123 #e#d123 #d#e123)))
- (do ((i 0 (+ i 1)))
- ((= i (- (vector-length things) 1)))
- (do ((j (+ i 1) (+ j 1)))
- ((= j (vector-length things)))
- (if (not (eqv? (vector-ref things i) (vector-ref things j)))
- (begin
- (display "(eqv? ") (display (vector-ref things i)) (display " ") (display (vector-ref things j)) (display ") -> #f?") (newline))))))
-
(for-each
(lambda (n)
(let ((nb
@@ -78833,28 +79072,6 @@ etc....
(if (not nb)
(begin
(display "(number? ") (display n) (display ") returned #f?") (newline)))))
- (if (provided? 'dfls-exponents)
- (list 1 -1 +1 +.1 -.1 .1 .0 0. 0.0 -0 +0 -0. +0.
- +1.1 -1.1 1.1
- '1.0e2 '-1.0e2 '+1.0e2
- '1.1e-2 '-1.1e-2 '+1.1e-2
- '1.1e+2 '-1.1e+2 '+1.1e+2
- '1/2 '-1/2 '+1/2
- '1.0s2 '-1.0s2 '+1.0s2
- '1.0d2 '-1.0d2 '+1.0d2
- '1.0f2 '-1.0f2 '+1.0f2
- '1.0l2 '-1.0l2 '+1.0l2
- '1.0+1.0i '1.0-1.0i '-1.0-1.0i '-1.0+1.0i
- '1+i '1-i '-1-i '-1+i
- '2/3+i '2/3-i '-2/3+i
- '1+2/3i '1-2/3i '2/3+2/3i '2.3-2/3i '2/3-2.3i
- '2e2+1e3i '2e2-2e2i '2.0e2+i '1+2.0e2i '2.0e+2-2.0e-1i '2/3-2.0e3i '2e-3-2/3i
- '-2.0e-2-2.0e-2i '+2.0e+2+2.0e+2i '+2/3-2/3i '2e2-2/3i
- '1e1-i '1.-i '.0+i '-.0-1e-1i '1.+.1i '0.-.1i
- '.1+.0i '1.+.0i '.1+.1i '1.-.1i '.0+.00i '.10+.0i '-1.+.0i '.1-.01i '1.0+.1i
- '1e1+.1i '-1.-.10i '1e01+.0i '0e11+.0i '1.e1+.0i '1.00-.0i '-1e1-.0i '1.-.1e0i
- '1.+.001i '1e10-.1i '1e+0-.1i '-0e0-.1i
- '-1.0e-1-1.0e-1i '-111e1-.1i '1.1-.1e11i '-1e-1-.11i '-1.1-.1e1i '-.1+.1i)
(list 1 -1 +1 +.1 -.1 .1 .0 0. 0.0 -0 +0 -0. +0.
+1.1 -1.1 1.1
'1.0e2 '-1.0e2 '+1.0e2
@@ -78871,7 +79088,7 @@ etc....
'.1+.0i '1.+.0i '.1+.1i '1.-.1i '.0+.00i '.10+.0i '-1.+.0i '.1-.01i '1.0+.1i
'1e1+.1i '-1.-.10i '1e01+.0i '0e11+.0i '1.e1+.0i '1.00-.0i '-1e1-.0i '1.-.1e0i
'1.+.001i '1e10-.1i '1e+0-.1i '-0e0-.1i
- '-1.0e-1-1.0e-1i '-111e1-.1i '1.1-.1e11i '-1e-1-.11i '-1.1-.1e1i '-.1+.1i)))
+ '-1.0e-1-1.0e-1i '-111e1-.1i '1.1-.1e11i '-1e-1-.11i '-1.1-.1e1i '-.1+.1i))
(for-each
(lambda (n rl im)
@@ -78957,7 +79174,7 @@ etc....
'-1.1e1-e1i '-1.e1-e-1i '.1e1-e-11i
'3.-3. '1'2 '+-2 '1?
'1a '1.a '-a '+a '1.. '..1 '-..1 '1ee1 '1ef2 '1+ief2 '1.+ '1.0- '1/2+/3
- '1'2 '1-#i '1-i. '1-ie '1... '1/1/1/1 '1//1 '-.e1
+ '1'2 '1-i. '1-ie '1... '1/1/1/1 '1//1 '-.e1
)
(list "1e" "--1" "++1" "+." "+.+" ".." ".-" "1e-" "+" "-" "-e1"
"1/2/3" "1/2+/2" "/2" "2/" "1+2" "1/+i" "1/2e1" "1/2."
@@ -78980,7 +79197,7 @@ etc....
"-1.1e1-e1i" "-1.e1-e-1i" ".1e1-e-11i"
"3.-3." "'1'2" "'+-2" "'1?"
"1a" "1.a" "-a" "+a" "1.." "..1" "-..1" "1ee1" "1ef2" "1+ief2" "1.+" "1.0-" "1/2+/3"
- "'1'2" "1-#i" "1-i." "1-ie" "1..." "1/1/1/1" "1//1" "-.e1"
+ "'1'2" "1-i." "1-ie" "1..." "1/1/1/1" "1//1" "-.e1"
))
(let ((val (catch #t
@@ -78989,11 +79206,11 @@ etc....
01 +1 1.
- 001 +01 1/1 1.0 1e0 01. +1. #b1 #d1 #e1 #o1 #x1 2/2 3/3 4/4 5/5 6/6 7/7 8/8 9/9
+ 001 +01 1/1 1.0 1e0 01. +1. #b1 #o1 #x1 2/2 3/3 4/4 5/5 6/6 7/7 8/8 9/9
1E0 1e0
0001 +001 1/01 .1e1 01/1 +1/1 1.00 1e00 01.0 +1.0 1e+0 1e-0 01e0 +1e0 1.e0 001. +01. 1+0i 1-0i
- #b+1 #b01 #b1. #d+1 #d01 #d1. #e+1 #e01 #e1. #i+1 #i01 #i1. #o+1 #o01 #o1. #x+1 #x01 #x1.
+ #b+1 #b01 #b1. #o+1 #o01 #o1. #x+1 #x01 #x1.
+1E0 +1e0 +2/2 +3/3 +4/4 +5/5 +6/6 +7/7 +8/8 +9/9
.1E1 0001 001. 01.0 01/1 01E0
02/2 03/3 04/4 05/5 06/6 07/7 08/8 09/9
@@ -79057,79 +79274,7 @@ etc....
+0001.e0 0000001. +000001.))
(lambda args 'error))))
(if (not (eq? val #t))
- (format-logged #t ";funny 1's are not all equal to 1? ~A~%" val)))
-
-(do ((i 0 (+ i 1)))
- ((= i 30))
- (for-each
- (lambda (lst)
- (for-each
- (lambda (str)
- (let ((val (catch #t (lambda () (string->number str)) (lambda args 'error))))
- (if (or (not (number? val))
- (> (abs (- val 1.0)) 1.0e-15))
- (format-logged #t ";(string->number ~S) = ~A?~%" str val))))
- lst))
- (list
- (list "1")
-
- (list "01" "+1" "1.")
-
- (list "001" "+01" "#e1" "#i1" "1/1" "#b1" "#x1" "#d1" "#o1" "1.0" "1e0" "9/9" "01." "+1." "1E0")
-
- (list "0001" "+001" "#e01" "#i01" "1/01" "#b01" "#x01" "#d01" "#o01" "#e+1" "#i+1" "#b+1" "#x+1" "#d+1" "#o+1" ".1e1" "01/1" "+1/1" "1.00" "1e00" "01.0" "+1.0" "1e+0" "1e-0" "01e0" "+1e0" "1.e0" "9/09" "09/9" "+9/9" "001." "+01." "#e1." "#i1." "1+0i" "1-0i" "#d1.")
-
- (list "11/11" "00001" "+0001" "#e001" "#i001" "1/001" "#b001" "#x001" "#d001" "#o001" "#e+01" "#i+01" "#b+01" "#x+01" "#d+01" "#o+01" ".1e01" "01/01" "+1/01" "91/91" ".1e+1" "10e-1" "0.1e1" "+.1e1" ".10e1" "#b#e1" "#x#e1" "#d#e1" "#o#e1" "#b#i1" "#x#i1" "#d#i1" "#o#i1" "001/1" "+01/1" "#e1/1" "#i1/1" "#b1/1" "#x1/1" "#d1/1" "#o1/1" "#e#b1" "#i#b1" "#e#x1" "#i#x1" "#e#d1" "#i#d1" "#e#o1" "#i#o1" "10/10" "1.000" "1e000" "01.00" "+1.00" "1e+00" "1e-00" "01e00" "+1e00" "1.e00" "90/90" "001.0" "+01.0" "#e1.0" "#i1.0" "01e+0" "+1e+0" "1.e+0" "01e-0" "+1e-0" "1.e-0" "001e0" "+01e0" "#e1e0" "#i1e0" "1.0e0" "01.e0" "+1.e0" "19/19" "9/009" "09/09" "+9/09" "99/99" "009/9" "+09/9" "#e9/9" "#i9/9" "#x9/9" "#d9/9" "0001." "+001." "#e01." "#i01." "#e+1." "#i+1." "#xe/e" "1+00i" "1-00i" "1+.0i" "1-.0i" "01+0i" "+1+0i" "1.+0i" "01-0i" "+1-0i" "1.-0i" "1+0.i" "1-0.i" "#xb/b" "#xd/d" "#xf/f")
-
- ;; remove "9":
-
- (list "11/011" "011/11" "+11/11" "000001" "+00001" "#e0001" "#i0001" "1/0001" "#b0001" "#x0001" "#d0001" "#o0001" "#e+001" "#i+001" "#b+001" "#x+001" "#d+001" "#o+001" ".1e001" "01/001" "+1/001" ".1e+01" "10e-01" "0.1e01" "+.1e01" ".10e01" "#b#e01" "#x#e01" "#d#e01" "#o#e01" "#b#i01" "#x#i01" "#d#i01" "#o#i01" "001/01" "+01/01" "#e1/01" "#i1/01" "#b1/01" "#x1/01" "#d1/01" "#o1/01" "#e#b01" "#i#b01" "#e#x01" "#i#x01" "#e#d01" "#i#d01" "#e#o01" "#i#o01" "0.1e+1" "+.1e+1" ".10e+1" "#b#e+1" "#x#e+1" "#d#e+1" "#o#e+1" "#b#i+1" "#x#i+1" "#d#i+1" "#o#i+1" "#e#b+1" "#i#b+1" "#e#x+1" "#i#x+1" "#e#d+1" "#i#d+1" "#e#o+1" "#i#o+1" "010e-1" "+10e-1" "10.e-1" "00.1e1" "+0.1e1" "#e.1e1" "#i.1e1" "0.10e1" "+.10e1" ".100e1" "0001/1" "+001/1" "#e01/1" "#i01/1" "#b01/1" "#x01/1" "#d01/1" "#o01/1" "#e+1/1" "#i+1/1" "#b+1/1" "#x+1/1" "#d+1/1" "#o+1/1" "10/010" "010/10" "+10/10" "1.0000" "1e0000" "01.000" "+1.000" "1e+000" "1e-000" "01e000" "+1e000" "1.e000" "001.00" "+01.00" "#e1.00" "#i1.00" "01e+00" "+1e+00" "1.e+00" "01e-00" "+1e-00" "1.e-00" "001e00" "+01e00" "#e1e00" "#i1e00" "1.0e00" "01.e00" "+1.e00" "0001.0" "+001.0" "#e01.0" "#i01.0" "#e+1.0" "#i+1.0" "001e+0" "+01e+0" "#e1e+0" "#i1e+0" "1.0e+0" "01.e+0" "+1.e+0" "001e-0" "+01e-0" "#e1e-0" "#i1e-0" "1.0e-0" "01.e-0" "+1.e-0" "0001e0" "+001e0" "#e01e0" "#i01e0" "#e+1e0" "#i+1e0" "1.00e0" "01.0e0" "+1.0e0" "001.e0" "+01.e0" "#e1.e0" "#i1.e0" "00001." "+0001." "#e001." "#i001." "#e+01." "#i+01." "#xe/0e" "#x0e/e" "#x+e/e" "1+0e1i" "1-0e1i" "1+0/1i" "1-0/1i" "1+000i" "1-000i" "1+.00i" "1-.00i" "01+00i" "+1+00i" "1.+00i" "01-00i" "+1-00i" "1.-00i" "1+0.0i" "1-0.0i" "01+.0i" "+1+.0i" "1.+.0i" "01-.0i" "+1-.0i" "1.-.0i" "001+0i" "+01+0i" "#e1+0i" "#i1+0i" "1/1+0i" "1.0+0i" "1e0+0i" "01.+0i" "+1.+0i" "001-0i" "+01-0i" "#e1-0i" "#i1-0i" "1/1-0i" "1.0-0i" "1e0-0i" "01.-0i" "+1.-0i" "1+0e0i" "1-0e0i" "1+00.i" "1-00.i" "01+0.i" "+1+0.i" "1.+0.i" "01-0.i" "+1-0.i" "1.-0.i" "#xb/0b" "#x0b/b" "#x+b/b" "#xd/0d" "#x0d/d" "#x+d/d" "#xf/0f" "#x0f/f" "#x+f/f")
-
- (list "111/111" "11/0011" "011/011" "+11/011" "0011/11" "+011/11" "#e11/11" "#i11/11" "#b11/11" "#x11/11" "#d11/11" "#o11/11" "101/101" "0000001" "+000001" "#e00001" "#i00001" "1/00001" "#b00001" "#x00001" "#d00001" "#o00001" "#e+0001" "#i+0001" "#b+0001" "#x+0001" "#d+0001" "#o+0001" ".1e0001" "01/0001" "+1/0001" ".1e+001" "10e-001" "0.1e001" "+.1e001" ".10e001" "#b#e001" "#x#e001" "#d#e001" "#o#e001" "#b#i001" "#x#i001" "#d#i001" "#o#i001" "001/001" "+01/001" "#e1/001" "#i1/001" "#b1/001" "#x1/001" "#d1/001" "#o1/001" "#e#b001" "#i#b001" "#e#x001" "#i#x001" "#e#d001" "#i#d001" "#e#o001" "#i#o001" "0.1e+01" "+.1e+01" ".10e+01" "#b#e+01" "#x#e+01" "#d#e+01" "#o#e+01" "#b#i+01" "#x#i+01" "#d#i+01" "#o#i+01" "#e#b+01" "#i#b+01" "#e#x+01" "#i#x+01" "#e#d+01" "#i#d+01" "#e#o+01" "#i#o+01" "010e-01" "+10e-01" "10.e-01" "1.00000" "1e00000" "01.0000" "+1.0000" "1e+0000" "1e-0000" "01e0000" "+1e0000" "1.e0000" "001.000" "+01.000" "#e1.000" "#i1.000" "#d1.000" "01e+000" "+1e+000" "1.e+000" "01e-000" "+1e-000" "1.e-000" "001e000" "+01e000" "#e1e000" "#i1e000" "#d1e000" "1.0e000" "+1.e000" "0001.00" "+001.00" "#e01.00" "#i01.00" "#d01.00" "#e+1.00" "#i+1.00" "#d+1.00" "001e+00" "+01e+00" "#e1e+00" "#i1e+00" "#d1e+00" "1.0e+00" "01.e+00" "+1.e+00" "001e-00" "+01e-00" "#e1e-00" "#i1e-00" "#d1e-00" "1.0e-00" "01.e-00" "+1.e-00" "000001." "+00001." "#e0001." "#i0001." "#d0001." "#e+001." "#i+001." "#d+001." "#d#e01." "#d#i01." "#e#d01." "#i#d01." "#d#e+1." "#d#i+1." "#e#d+1." "#i#d+1." "#x1e/1e" "#xe/00e" "#x0e/0e" "#x+e/0e" "#xee/ee" "#x00e/e" "#x+0e/e" "#x#ee/e" "#x#ie/e" "#e#xe/e" "#i#xe/e" "#xbe/be" "#xde/de" "1+0e11i" "1-0e11i" "1+0/11i" "1-0/11i" "1+0e01i" "1-0e01i" "1+0/01i" "1-0/01i" "1+0e+1i" "1-0e+1i" "1+0e-1i" "1-0e-1i" "1+00e1i" "1-00e1i" "1+.0e1i" "1-.0e1i" "01+0e1i" "+1+0e1i" "1.+0e1i" "01-0e1i" "+1-0e1i" "1.-0e1i" "1+0.e1i" "1-0.e1i" "1+00/1i" "1-00/1i" "01+0/1i" "+1+0/1i" "1.+0/1i" "01-0/1i" "+1-0/1i" "1.-0/1i" "1+0e10i" "1-0e10i" "1+0/10i" "1-0/10i" "1+0000i" "1-0000i" "1+.000i" "1-.000i" "01+000i" "+1+000i" "1.+000i" "01-000i" "+1-000i" "1.-000i" "1+0.00i" "1-0.00i" "01+.00i" "+1+.00i" "1.+.00i" "01-.00i" "+1-.00i" "1.-.00i" "001+00i" "+01+00i" "#e1+00i" "#i1+00i" "1/1+00i" "#b1+00i" "#x1+00i" "#d1+00i" "#o1+00i" "1.0+00i" "1e0+00i" "01.+00i" "+1.+00i" "001-00i" "+01-00i" "#e1-00i" "#i1-00i" "1/1-00i" "#b1-00i" "#x1-00i" "#d1-00i" "#o1-00i" "1.0-00i" "1e0-00i" "01.-00i" "+1.-00i" "1+0e00i" "1-0e00i" "1+00.0i" "1-00.0i" "01+0.0i" "+1+0.0i" "1.+0.0i" "01-0.0i" "+1-0.0i" "1.-0.0i" "001+.0i" "+01+.0i" "#e1+.0i" "#i1+.0i" "1/1+.0i" "#d1+.0i" "1.0+.0i" "1e0+.0i" "01.+.0i" "+1.+.0i" "001-.0i" "+01-.0i" "#e1-.0i" "#i1-.0i" "1/1-.0i" "#d1-.0i" "1.0-.0i" "1e0-.0i" "01.-.0i" "+1.-.0i" "0001+0i" "+001+0i" "#e01+0i" "#i01+0i" "1/01+0i" "#b01+0i" "#x01+0i" "#d01+0i" "#o01+0i" "#e+1+0i" "#i+1+0i" "#b+1+0i" "#x+1+0i" "#d+1+0i" "#o+1+0i" ".1e1+0i" "01/1+0i" "+1/1+0i" "1.00+0i" "1e00+0i" "01.0+0i" "+1.0+0i" "1e+0+0i" "1e-0+0i" "01e0+0i" "+1e0+0i" "1.e0+0i" "001.+0i" "+01.+0i" "#e1.+0i" "#i1.+0i" "#d1.+0i" "1+0e+0i" "1-0e+0i" "0001-0i" "+001-0i" "#e01-0i" "#i01-0i" "1/01-0i" "#b01-0i" "#x01-0i" "#d01-0i" "#o01-0i" "#e+1-0i" "#i+1-0i" "#b+1-0i" "#x+1-0i" "#d+1-0i" "#o+1-0i" ".1e1-0i" "01/1-0i" "+1/1-0i" "1.00-0i" "1e00-0i" "01.0-0i" "+1.0-0i" "1e+0-0i" "1e-0-0i" "01e0-0i" "+1e0-0i" "1.e0-0i" "001.-0i" "+01.-0i" "#e1.-0i" "#i1.-0i" "#d1.-0i" "1+0e-0i" "1-0e-0i" "1+00e0i" "1-00e0i" "1+.0e0i" "1-.0e0i" "01+0e0i" "+1+0e0i" "1.+0e0i" "01-0e0i" "+1-0e0i" "1.-0e0i" "1+0.e0i" "1-0.e0i" "1+000.i" "1-000.i" "01+00.i" "+1+00.i" "1.+00.i" "01-00.i" "+1-00.i" "1.-00.i" "001+0.i" "+01+0.i" "#e1+0.i" "#i1+0.i" "1/1+0.i" "#d1+0.i" "1.0+0.i" "1e0+0.i" "+1.+0.i" "001-0.i" "+01-0.i" "#e1-0.i" "#i1-0.i" "1/1-0.i" "#d1-0.i" "1.0-0.i" "1e0-0.i" "01.-0.i" "+1.-0.i" "#xb/00b" "#x0b/0b" "#x+b/0b" "#xeb/eb" "#x00b/b" "#x+0b/b" "#x#eb/b" "#x#ib/b" "#e#xb/b" "#i#xb/b" "#xbb/bb" "#xdb/db" "#xd/00d" "#x0d/0d" "#x+d/0d" "#xed/ed")
-
-;;; selected ones...
-
- (list "#i+11/011" "+101/0101" "#o#e11/11" "#d+11/011" "#e1/0001" "#e#b+001" "#e10e-1"
- "#x#e1/001" "000000001" "#i+.1e+01" "#d+.1e+01" "00.10e+01" "+0.10e+01" "#e.10e+01" "#i.10e+01" "#d.10e+01"
- "#e.10e+01" "#i10.0e-01" "+010.e-01" "#e10.e-01" "#e00.1e01" "#e#d.1e01" "#i#d1e0+0e0i"
- "#e#d10e-1+0e-2i" "#e#d1e0+0e-2i" "#i#d+0.001e+03+0.0e-10i" "#i#d+1/1-0/1i"
- )
- )))
-
-(for-each
- (lambda (str)
- (let ((val (catch #t (lambda () (string->number str)) (lambda args 'error))))
- (if (or (not (number? val))
- (= val 1))
- (format-logged #t ";(string->number ~S = ~A?~%" str val))))
- (list "011e0" "11e-00" "00.e01-i" "+10e10+i" "+1.110+i" "10011-0i" "-000.111" "0.100111" "-11.1111" "10.00011" "110e00+i"
- "1e-011+i" "101001+i" "+11e-0-0i" "11+00e+0i" "-11101.-i" "1110e-0-i"))
-
-(for-each
- (lambda (str)
- (test (string->number str) #f)) ; an error but string->number is not supposed to return an error -- just #f or a number
- (list "#e1+i" "#e1-i" "#e01+i" "#e+1+i" "#e1.+i" "#e01-i" "#e+1-i" "#e1.-i" "#e1+1i" "#e1-1i"))
-
-(num-test (let ((0- 1) (1+ 2) (-0+ 3) (1e 4) (1/+2 5) (--1 6)) (+ 0- 1+ -0+ 1e 1/+2 --1)) 21)
-
-(for-each
- (lambda (str)
- (let ((val (catch #t (lambda () (string->number str)) (lambda args 'error))))
- (if val ;(number? val)
- (format-logged #t ";(string->number ~S) = ~A?~%" str val))))
- (list "#b#e#e1" "#x#e#e1" "#d#e#e1" "#o#e#e1" "#b#i#e1" "#x#i#e1" "#d#i#e1" "#o#i#e1" "#e#b#e1" "#i#b#e1" "#e#x#e1" "#i#x#e1"
- "#e#d#e1" "#i#d#e1" "#e#o#e1" "#i#o#e1" "#e#b#i1" "#e#x#i1" "#e#d#i1" "#e#o#i1" "#b#e#b1" "#x#e#b1" "#d#e#b1" "#o#e#b1"
- "#b#i#b1" "#x#i#b1" "#d#i#b1" "#o#i#b1" "#b#e#x1" "#x#e#x1" "#d#e#x1" "#o#e#x1" "#b#i#x1" "#x#i#x1" "#d#i#x1" "#o#i#x1"
- "#b#e#d1" "#x#e#d1" "#d#e#d1" "#o#e#d1" "#b#i#d1" "#x#i#d1" "#d#i#d1" "#o#i#d1" "#b#e#o1" "#x#e#o1" "#d#e#o1" "#o#e#o1"
- "#b#i#o1" "#x#i#o1" "#d#i#o1" "#o#i#o1"
-
- "+1ei" "-1ei" "+0ei" "-0ei" "+1di" "-1di" "+0di" "-0di" "+1fi" "-1fi" "+0fi" "-0fi" "0e-+i" "1d-+i"
- "0d-+i" "1f-+i" "0f-+i" "1e++i" "0e++i" "1d++i" ".10-10." "-1.e++i" "0e--01i" "1-00." "0-00." "#xf+b"
- "#x1+d" "0f++1i" "1+0d-i" ".0f--i" "1-0d-i" "#xe-ff" "0-" "0-e0"
-
- "-#b1" "#b.i" "#b+i" "#b1e.1" "#b1+1" "#b#e#e1" "#b#ee1" "#b#e0e" "#d#d1" "#d#1d1"
- "#b+1ei" "#b-1ei" "#b+0ei" "#b-0ei" "#b+1di" "#b-1di" "#b+0di" "#b-0di" "#b+1fi" "#b-1fi" "#b+0fi" "#b-0fi" "#b0e-+i" "#b1d-+i"
- ))
+ (format #t ";funny 1's are not all equal to 1? ~A~%" val)))
(num-test (string->number "2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427") 2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427)
@@ -79287,30 +79432,19 @@ etc....
(mnum (string->number str))
(diff (let ()
(if (not (string? n2s))
- (format-logged #t "(number->string ~A) #f?~%" fnum))
+ (format #t "(number->string ~A) #f?~%" fnum))
(if (not (number? s2n))
- (format-logged #t "(string->number ~S) #f?~%" n2s))
+ (format #t "(string->number ~S) #f?~%" n2s))
(/ (abs (- mnum s2n)) (max (expt 2 -31.0) (abs fnum))))))
(if (> diff maxdiff)
(begin
(set! maxdiff diff)
(set! maxdiff-case (car lst))))))
(if (> maxdiff 1e-15) ; we're only interested in real problems
- (format-logged #t ";number->string rounding checks worst case relative error ~A ~A ~S~%" maxdiff (car maxdiff-case) (cadr maxdiff-case)))
+ (format #t ";number->string rounding checks worst case relative error ~A ~A ~S~%" maxdiff (car maxdiff-case) (cadr maxdiff-case)))
))
-(for-each
- (lambda (p)
- (let ((sym (car p))
- (num (cdr p)))
- (let ((tag (catch #t (lambda () (string->number sym)) (lambda args 'error))))
- (if (not (equal? num tag))
- (format-logged #t ";(string->number ~S) = ~A [~A]~%" sym tag num)))))
- '(("#xe/d" . 14/13) ("#xb/d" . 11/13) ("#xf/d" . 15/13) ("#x1/f" . 1/15) ("#xd/f" . 13/15) ("#xe/f" . 14/15) ("#d.1" . .1) ("#d01" . 1)
- ("#d+1" . 1) ("#d+0" . 0) ("#d0+i" . 0+i) ("#xe+i" . 14.0+1.0i) ("#xf+i" . 15.0+1.0i) ("#d1-i" . 1.0-1.0i); ("#e1+i" . 1+i)
- ))
-
#|
;;; here's code to generate all (im)possible numbers (using just a few digits) of a given length
@@ -79363,7 +79497,7 @@ etc....
(for-each
(lambda (n name)
(if (number? n)
- (format-logged #t ";(number? ~A) returned #t?~%" name)))
+ (format #t ";(number? ~A) returned #t?~%" name)))
(list
'a9 'aa 'aA 'a! 'a$ 'a% 'a& 'a* 'a+ 'a- 'a. 'a/ 'a: 'a< 'a= 'a> 'a? 'a@ 'a^ 'a_ 'a~ 'A9 'Aa 'AA 'A! 'A$ 'A% 'A& 'A* 'A+ 'A- 'A. 'A/ 'A: 'A< 'A= 'A> 'A? 'A@ 'A^ 'A_ 'A~ '!9 '!a '!A '!! '!$ '!% '!& '!* '!+ '!- '!. '!/ '!: '!< '!= '!> '!? '!@ '!^ '!_ '!~ '$9 '$a '$A '$! '$$ '$% '$& '$* '$+ '$- '$. '$/ '$: '$< '$= '$> '$? '$@ '$^ '$_ '$~ '%9 '%a '%A '%! '%$ '%% '%& '%* '%+ '%- '%. '%/ '%: '%< '%= '%> '%? '%@ '%^ '%_ '%~ '&9 '&a '&A '&! '&$ '&% '&& '&* '&+ '&- '&. '&/ '&: '&< '&= '&> '&? '&@ '&^ '&_ '&~ '*9 '*a '*A '*! '*$ '*% '*& '** '*+ '*- '*. '*/ '*: '*< '*= '*> '*? '*@ '*^ '*_ '*~ '/9 '/a '/A '/! '/$ '/% '/& '/* '/+ '/- '/. '// '/: '/< '/= '/> '/? '/@ '/^ '/_ '/~ ':9 ':a ':A ':! ':$ ':% ':& ':* ':+ ':- ':. ':/ ':: ':< ':= ':> ':? ':@ ':^ ':_ ':~ '<9 '<a '<A '<! '<$ '<% '<& '<* '<+ '<- '<. '</ '<: '<< '<= '<> '<? '<@ '<^ '<_ '<~ '=9 '=a '=A '=! '=$ '=% '=& '=* '=+ '=- '=. '=/ '=: '=< '== '=> '=? '=@ '=^ '=_ '=~ '>9 '>a '>A '>! '>$ '>% '>& '>* '>+ '>- '>. '>/ '>: '>< '>= '>> '>? '>@ '>^ '>_ '>~ '?9 '?a '?A '?! '?$ '?% '?& '?* '?+ '?- '?. '?/ '?: '?< '?= '?> '?? '?@ '?^ '?_ '?~ '^9 '^a '^A '^! '^$ '^% '^& '^* '^+ '^- '^. '^/ '^: '^< '^= '^> '^? '^@ '^^ '^_ '^~ '_9 '_a '_A '_! '_$ '_% '_& '_* '_+ '_- '_. '_/ '_: '_< '_= '_> '_? '_@ '_^ '__ '_~ '~9 '~a '~A '~! '~$ '~% '~& '~* '~+ '~- '~. '~/ '~: '~< '~= '~> '~? '~@ '~^ '~_ '~~)
@@ -79376,34 +79510,34 @@ etc....
; ((= i (string-length initial-chars)))
; (do ((k 0 (+ k 1)))
; ((= k (string-length subsequent-chars)))
- ; (format-logged #t "'~A " (string (string-ref initial-chars i) (string-ref subsequent-chars k))))))
+ ; (format #t "'~A " (string (string-ref initial-chars i) (string-ref subsequent-chars k))))))
(for-each
(lambda (z)
(if (not (zero? z))
- (format-logged #t "~A is not zero?~%" z))
+ (format #t "~A is not zero?~%" z))
(if (and (real? z) (positive? z))
- (format-logged #t "~A is positive?~%" z))
+ (format #t "~A is positive?~%" z))
(if (and (real? z) (negative? z))
- (format-logged #t "~A is negative?~%" z)))
- '(0 -0 +0 0.0 -0.0 +0.0 0/1 -0/1 +0/24 0+0i 0-0i -0-0i +0-0i 0.0-0.0i -0.0+0i #b0 #o-0 #x000 #e0 #e0.0 #e#b0 #b#e0 #e0/1 #b+0 #d000/1111 000/111))
+ (format #t "~A is negative?~%" z)))
+ '(0 -0 +0 0.0 -0.0 +0.0 0/1 -0/1 +0/24 0+0i 0-0i -0-0i +0-0i 0.0-0.0i -0.0+0i #b0 #o-0 #x000 000/111))
(for-each
(lambda (x)
(if (string->number x)
- (format-logged #t ";(string->number ~A) returned ~A~%" x (string->number x))))
+ (format #t ";(string->number ~A) returned ~A~%" x (string->number x))))
'("" "q" "1q" "6+7iq" "8+9q" "10+11" "13+" "18 at 19q" "20 at q" "23@"
"+25iq" "26i" "-q" "-iq" "i" "5#.0" "8/" "10#11" ".#" "."
"3.4q" "15.16e17q" "18.19e+q" ".q" ".17#18" "10q" "#b2" "#b12" "#b-12"
"#b3" "#b4" "#b5" "#b6" "#b7" "#b8" "#b9" "#ba" "#bb" "#bc"
- "#bd" "#be" "#bf" "#q" "#b#b1" "#o#o1" "#d#d1" "#x#x1" "#e#e1" "#xag" "#x1x"
- "#o8" "#o9" "1/#e1" "#o#" "#e#i1" "#d--2" "#b#x1" "#i#x#b1" "#e#e#b1" "#e#b#b1"
- "-#b1" "+#b1" "#b1/#b2" "#b1+#b1i" "1+#bi" "1+#b1i" "1#be1" "#b" "#o" "#" "#ea" "#e1a" "1+ie1" "1+i1" "1e+1i"
- "#e#b" "#b#b" "#b#b1" "1e3e4" "1.0e-3e+4" "1e3s" "1e3s3" "#o#x1" "#i#i1" "1e-i" "#be1" "1/i" "1/e1" "1+e1"
+ "#bd" "#be" "#bf" "#q" "#xag" "#x1x"
+ "#o8" "#o9" "#o#"
+ "-#b1" "+#b1" "#b1/#b2" "#b1+#b1i" "1+#bi" "1+#b1i" "1#be1" "#b" "#o" "#" "1+ie1" "1+i1" "1e+1i"
+ "#b#b" "1e3e4" "1.0e-3e+4" "1e3s" "1e3s3" "1e-i" "#be1" "1/i" "1/e1" "1+e1"
"1e+" "1e1+" "1e1e1" "1e-+1" "1e0x1" "1e-" "1/#o2" "-#xae" "-#o-7"
- "#i#i1" "12 at 12i"))
+ "12 at 12i"))
(for-each
(lambda (couple)
@@ -79415,7 +79549,7 @@ etc....
(and (rational? y)
(not (eqv? xx y)))
(> (abs (- xx y)) 1e-12))
- (format-logged #t ";(string->number ~A) returned ~A but expected ~A (~A ~A ~A ~A)~%"
+ (format #t ";(string->number ~A) returned ~A but expected ~A (~A ~A ~A ~A)~%"
x (string->number x) y
xx (eq? xx #f)
(if (and xx y) (and (rational? y) (not (eqv? xx y))) #f)
@@ -79425,39 +79559,26 @@ etc....
("#b0" 0) ("#b1" 1) ("#o0" 0) ("#b-1" -1) ("#b+1" 1)
("#o1" 1) ("#o2" 2) ("#o3" 3) ("#o-1" -1)
("#o4" 4) ("#o5" 5) ("#o6" 6)
- ("#o7" 7) ("#d0" 0) ("#d1" 1)
- ("#d2" 2) ("#d3" 3) ("#d4" 4)
- ("#d5" 5) ("#d6" 6) ("#d7" 7) ("#d-123" -123) ("#d+123" 123)
- ("#d8" 8) ("#d9" 9)
+ ("#o7" 7)
("#xa" 10) ("#xb" 11) ("#x-1" -1) ("#x-a" -10)
("#xc" 12) ("#xd" 13)
("#xe" 14) ("#xf" 15) ("#x-abc" -2748)
("#b1010" 10)
("#o12345670" 2739128)
- ("#d1234567890" 1234567890)
("#x1234567890abcdef" 1311768467294899695)
- ("#e1" 1) ("#e1.2" 12/10)
- ("#i1.1" 1.1) ("#i1" 1.0)
("1" 1) ("23" 23) ("-1" -1)
("-45" -45) ;("2#" 20.0) ("2##" 200.0) ("12##" 1200.0) ; this # = 0 is about the stupidest thing I've ever seen
- ("#b#i100" 4.0) ("#b#e100" 4) ("#i#b100" 4.0) ("#e#b100" 4)
- ("#b#i-100" -4.0) ("#b#e+100" 4) ("#i#b-100" -4.0) ("#e#b+100" 4)
- ("#o#i100" 64.0) ("#o#e100" 64) ("#i#o100" 64.0) ("#e#o100" 64)
- ("#d#i100" 100.0) ("#d#e100" 100) ("#i#d100" 100.0) ("#e#d100" 100)
- ("#x#i100" 256.0) ("#x#e100" 256) ("#i#x100" 256.0) ("#e#x100" 256)
- ("#e#xee" 238) ("#e#x1e1" 481)
("#xA" 10) ("#xB" 11) ("#x-1" -1) ("#x-A" -10)
("#xC" 12) ("#xD" 13)
("#xE" 14) ("#xF" 15) ("#x-ABC" -2748)
("#xaBC" 2748) ("#xAbC" 2748) ("#xabC" 2748) ("#xABc" 2748)
- ("1/1" 1) ("1/2" 1/2) ("-1/2" -1/2) ("#e9/10" 9/10) ("#i6/8" 0.75) ("#i1/1" 1.0)
+ ("1/1" 1) ("1/2" 1/2) ("-1/2" -1/2)
("1e2" 100.0)
("1e+2" 100.0) ("1e-2" 0.01)
(".1" .1) (".0123456789" 123456789e-10)
(".0123456789e10" 123456789.0)
("3." 3.0) ("3.e0" 3.0)
("1+i" 1+1i) ("1-i" 1-1i)
- ("#e1e1" 10) ("#i1e1+i" 10.0+1.0i)
))
;;; some schemes are case insensitive throughout -- they accept 0+I, #X11 etc
@@ -79551,13 +79672,7 @@ etc....
(num-test (string->number "0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123e309") 1.23)
(num-test (string->number "-.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123456e312") -1234.56)
-(num-test #e0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300 1)
-(num-test #e0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e309 1)
-(num-test #e0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123e309 123/100)
-(num-test #e-.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123456e314 -123456)
-
(num-test #b0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300 1.0)
-(num-test #d0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300 1.0)
(num-test #o0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300 1.0)
(num-test #x0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300 1.0)
@@ -79571,16 +79686,10 @@ etc....
(num-test (string->number "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309") 1.0)
(num-test (string->number "-1234000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309") -1.234)
-(num-test #e1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-300 1)
-(num-test #e1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309 1)
-(num-test #e-1234000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309 -617/500)
-
(num-test 1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-300 1.0)
-(num-test #e1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-300 1)
(num-test (string->number "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-300") 1.0)
(num-test 1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309 1.0)
-(num-test #e1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309 1)
(num-test (string->number "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309") 1.0)
(num-test (string->number "7218817.36503571385593731949749063134519967478471341285646368059547752954588980538968510599079437e7") 7.218817365035713855937319497490631345183E13)
@@ -79591,11 +79700,8 @@ etc....
(num-test (string->number "9418.b89a40b0211a01147b75b23a529b0382775b32b+45936610b.a936586185a57b00ba4a90a139343235054b2i" 12) 1.614897792919114090019672485580641433273E4+1.926841115897881740778679262842131716289E9i)
(num-test (string->number "1.0e0000000000000000000000000000000000001") 10.0)
-(num-test #e1.0e0000000000000000000000000000000000001 10)
-(num-test #e1.0e-0000000000000000000000000000000000001 1/10)
(num-test 00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 10.0)
-(num-test #e00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 10)
(num-test (string->number "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001") 10.0)
(num-test (string->number "\
@@ -79635,7 +79741,6 @@ etc....
(num-test 00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001/00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 1)
(num-test (string->number "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001/00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001") 1)
-(num-test #i00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001/00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 1.0)
#|
;;; if not gmp:
@@ -79688,7 +79793,6 @@ etc
(when with-bignums
(test (bignum? (bignum "2")) #t)
- (test (bignum? (bignum "#e1.5")) #t)
(num-test (bignum "6/3") 2)
(num-test (bignum "+3/6") 1/2)
@@ -79738,17 +79842,17 @@ etc
(lambda (arg)
(let ((val (catch #t (lambda () (op arg)) (lambda args 'error))))
(if (not (eq? val 'error))
- (format-logged #t "(~A ~A) -> ~A (expected 'error)~%" op arg val)))
+ (format #t "(~A ~A) -> ~A (expected 'error)~%" op arg val)))
(let ((val (catch #t (lambda () (op 0 arg)) (lambda args 'error))))
(if (not (eq? val 'error))
- (format-logged #t "(~A 0 ~A) -> ~A (expected 'error)~%" op arg val)))
+ (format #t "(~A 0 ~A) -> ~A (expected 'error)~%" op arg val)))
(let ((val (catch #t (lambda () (op 0 1 arg)) (lambda args 'error))))
(if (not (eq? val 'error))
- (format-logged #t "(~A 0 1 ~A) -> ~A (expected 'error)~%" op arg val)))
+ (format #t "(~A 0 1 ~A) -> ~A (expected 'error)~%" op arg val)))
(if with-bignums
(let ((val (catch #t (lambda () (op (expt 2 60) arg)) (lambda args 'error))))
(if (not (eq? val 'error))
- (format-logged #t "(~A 2^60 ~A) -> ~A (expected 'error)~%" op arg val)))))
+ (format #t "(~A 2^60 ~A) -> ~A (expected 'error)~%" op arg val)))))
(list "hi" () #\a (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs #t _ht_ _null_ _c_obj_ :hi (if #f #f) (lambda (a) (+ a 1)) #<undefined> #<unspecified> #<eof> :rest)))
@@ -80034,10 +80138,10 @@ etc
|#
-(if (not (provided? 'snd)) (load "stuff.scm"))
+(load "stuff.scm")
(let ()
- (if (provided? 'snd) (load "stuff.scm" (curlet)))
+ ;(load "stuff.scm" (curlet))
(test (first '(1 2 3 4 5 6 7 8 9 10)) 1)
(test (second '(1 2 3 4 5 6 7 8 9 10)) 2)
@@ -80198,121 +80302,6 @@ etc
(test (multiple-value-set! () ()) ())
(test (multiple-value-set! () () 1 2) 2)
- ;; let-temporarily
-
- (let ((aaa 1)
- (bbb 0)
- (ccc 0))
- (let-temporarily ((aaa 2))
- (set! bbb aaa)
- (set! aaa 32)
- (set! ccc aaa))
- (test (list aaa bbb ccc) '(1 2 32)))
-
- (test (let ((aaa 0)
- (bbb 0))
- (let-temporarily ((aaa 32))
- (set! bbb aaa)
- (let-temporarily ((bbb 10))
- (set! aaa bbb)))
- (list aaa bbb))
- '(0 32))
-
- (let ()
- (define f2 (let ((x '(0 1)))
- (dilambda (lambda () x)
- (lambda (y) (set! x y)))))
- (let-temporarily (((f2) '(3 2)))
- (test (f2) '(3 2)))
- (test (f2) '(0 1)))
-
- (let ()
- (define f3 (let ((x 'z))
- (dilambda (lambda () x)
- (lambda (y) (set! x y)))))
- (let ((z 32))
- (let-temporarily (((f3) 'z))
- (test (f3) 'z))
- (test (f3) 'z)))
-
- (let ((z 1)
- (x 32))
- (let-temporarily ((z 'x))
- (test z 'x))
- (test z 1))
-
- (let ((saved 0)
- (orig 1)
- (vars 2)
- (body 3))
- (let ((vals (list (let-temporarily ((saved 30)
- (orig 31)
- (vars 32)
- (body 33))
- (let ((inner (list saved orig vars body)))
- (set! saved 41)
- (set! orig 42)
- (set! vars 43)
- (set! body 44)
- inner))
- (list saved orig vars body))))
- (test vals '((30 31 32 33) (0 1 2 3)))))
-
- (let ((cons +)
- (curlet abs)
- (inlet call/cc)
- (saved 32)
- (inner-let -1))
- (let-temporarily ((saved *))
- (set! inner-let (cons (saved (abs inner-let) 2) 3)))
- (test inner-let 5)
- (test (eq? curlet abs) #t))
-
- (let ((a (vector 1 2 3))
- (x 1)
- (y 32))
- (let-temporarily (((a x) y))
- (test (a x) y))
- (test (a x) 2))
-
- (let ((a (inlet 'b (vector 1 2 3)))
- (x 32)
- (y 1))
- (let-temporarily ((((a 'b) 1) 32))
- (test (a 'b) #(1 32 3)))
- (test (a 'b) #(1 2 3)))
-
- (let ((x 1)
- (y 2))
- (let-temporarily ((x 32) (y x))
- (test (list x y) '(32 1)))
- (test (list x y) '(1 2)))
-
- (let ((x 1)
- (y 2))
- (let*-temporarily ((x 32) (y x))
- (test (list x y) '(32 32)))
- (test (list x y) '(1 2)))
-
- (let ((a (vector 1 2 3))
- (x 1)
- (y 32)
- (z 0))
- (let-temporarily (((a x) y) (z (a x)))
- (test (list (a x) y z) '(32 32 2)))
- (test (list (a x) y z) '(2 32 0)))
-
- (let ((a (vector 1 2 3))
- (x 1)
- (y 32)
- (z 0))
- (let*-temporarily (((a x) y) (z (a x)))
- (test (list (a x) y z) '(32 32 32)))
- (test (list (a x) y z) '(2 32 0)))
-
- (test (let ((x 1)) (let-temporarily ((x 32)))) #f)
-
-
(test (hash-table->alist (hash-table)) ())
(test (hash-table->alist (hash-table '(a . 1))) '((a . 1)))
(test (let ((lst (hash-table->alist (hash-table '(a . 1) '(b . 2)))))
@@ -80471,6 +80460,20 @@ etc
(test (let ((v (vector 1 2))) (set! (v 1) v) (safe-count-if (lambda (x) (and (integer? x) (= x 1))) v)) 1)
(test (let ((v (vector 1 2)) (lst (list 1 2))) (set! (v 1) lst) (set! (lst 1) v) (safe-count-if (lambda (x) (and (integer? x) (= x 1))) v)) 2)
+ (let ((x 1)
+ (y 2))
+ (let*-temporarily ((x 32) (y x))
+ (test (list x y) '(32 32)))
+ (test (list x y) '(1 2)))
+
+ (let ((a (vector 1 2 3))
+ (x 1)
+ (y 32)
+ (z 0))
+ (let*-temporarily (((a x) y) (z (a x)))
+ (test (list (a x) y z) '(32 32 32)))
+ (test (list (a x) y z) '(2 32 0)))
+
(test (make-directory-iterator #\a) 'error)
(test (catch #t
(lambda ()
@@ -81240,7 +81243,7 @@ etc
(for-each
(lambda (arg)
(if (boolean=? #f arg)
- (format-logged #t ";(boolean=? #f ~A) -> #t?~%" arg)))
+ (format #t ";(boolean=? #f ~A) -> #t?~%" arg)))
(list "hi" '(1 2) () "" #() (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined> #<unspecified>))
@@ -81257,7 +81260,7 @@ etc
(for-each
(lambda (arg)
(if (symbol=? 'abs arg)
- (format-logged #t ";(symbol=? 'abs ~A) -> #t?~%" arg)))
+ (format #t ";(symbol=? 'abs ~A) -> #t?~%" arg)))
(list "hi" (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined>))
;(test (symbol=?) 'error)
@@ -81795,6 +81798,22 @@ etc
(#t 'error)))
(test (rt3) 3)
+(define (rt2)
+ (reader-cond ((> 3 2))
+ (#t 'error)))
+(test (rt2) #t)
+
+(define (rt2)
+ (reader-cond ((> 3 2)
+ (values 1 2 3))
+ (#t 'error)))
+(test (+ (rt2) 4) 10)
+
+(define (rt2)
+ (reader-cond ((assq 'x '((a . 3) (x . 4))) => cdr)
+ (#t 'error)))
+(test (+ (rt2) 2) 6)
+
(let ()
(define (f1)
(let ((x 1)
@@ -81953,11 +81972,28 @@ etc
(test (acos -1) 5)))
(test-acos)
+ (define (test-acos1)
+ (let ()
+ (if #f (define (acos x) (+ x 6)))
+ (test (acos 1) 0)))
+ (test-acos1)
+
+ (define (test-acos2)
+ (let ()
+ (if #t (define (acos x) (+ x 6)))
+ (test (acos -3) 3)))
+ (test-acos2)
+
(define (test-atan)
(define (atan x) (+ x 7))
(test (atan -1) 6))
(test-atan)
+ (define (test-atan1)
+ (if #f (define (atan x) (+ x 7)))
+ (test (atan 0) 0))
+ (test-atan1)
+
(define (test-asin)
(define asin (let () (lambda (x) (+ x 8))))
(test (asin -1) 7))
@@ -81969,355 +82005,6 @@ etc
(test (sinh -1) 8)))
(test-sinh))
-(test (let ((equal? #f)) (member 3 '(1 2 3))) '(3))
-(test (let ((eqv? #f)) (case 1 ((1) 1))) 1) ; scheme wg
-(test (let ((eqv? equal?)) (case "asd" (("asd") 1) (else 2))) 2)
-(test (let ((eq? #f)) (memq 'a '(a b c))) '(a b c))
-(test (let ((if #t)) (or if)) #t)
-(test (let ((if +)) (if 1 2 3)) 6)
-(test (if (let ((if 3)) (> 2 if)) 4 5) 5)
-(test (let ('1 ) quote) 1)
-(test (let ((quote 1)) (+ quote 1)) 2)
-(test (let ((quote -)) '32) -32)
-(test (do ((do 1)) (#t do)) 1)
-(test (do ((do 1 (+ do do))) ((> do 3) do)) 4)
-(test (do ((do 1 do) (j do do)) (do do)) 1)
-(test (do ((do do do)) (do do)) do)
-(test (do ((do do do)) (do do do)) do) ; ok ok!
-(test (or (let ((or #t)) or)) #t)
-(test (and (let ((and #t)) and)) #t)
-(test (let ((=> 3) (cond 4)) (+ => cond)) 7)
-(test (case 1 ((1 2) (let ((case 3)) (+ case 1))) ((3 4) 0)) 4)
-(test (let ((lambda 4)) (+ lambda 1)) 5)
-
-(test (let () (define (hi a) (let ((pair? +)) (pair? a 1))) (hi 2)) 3)
-(test ((lambda (let) (let* ((letrec 1)) (+ letrec let))) 123) 124)
-
-(test (let ((begin 3)) (+ begin 1)) 4)
-(test ((lambda (let*) (let ((letrec 1)) (+ letrec let*))) 123) 124)
-(test ((lambda (quote) (+ quote 1)) 2) 3)
-(test ((lambda (quote . args) (list quote args)) 1 2 3) '(1 (2 3)))
-(test (let ((do 1) (map 2) (for-each 3) (quote 4)) (+ do map for-each quote)) 10)
-(test ((lambda lambda lambda) 'x) '(x))
-(test ((lambda (begin) (begin 1 2 3)) (lambda lambda lambda)) '(1 2 3))
-(test (let* ((let 3) (x let)) (+ x let)) 6)
-(test (((lambda case lcm))) 1)
-(test (((lambda let* *))) 1)
-(test (do ((i 0 1) '(list)) (#t quote)) ())
-(test ((lambda (let) (+)) 0) 0)
-(test (let () (define (hi cond) (+ cond 1)) (hi 2)) 3)
-(test (let () (define* (hi (cond 1)) (+ cond 1)) (hi 2)) 3)
-(test (let () (define* (hi (cond 1)) (+ cond 1)) (hi)) 2)
-(test (let () ((lambda (cond) (+ cond 1)) 2)) 3)
-(test (let () ((lambda* (cond) (+ cond 1)) 2)) 3)
-(test (let () (define-macro (hi cond) `(+ 1 ,cond)) (hi 2)) 3)
-(test (let () (define-macro* (hi (cond 1)) `(+ 1 ,cond)) (hi)) 2)
-(test (let () (define (hi abs) (+ abs 1)) (hi 2)) 3)
-(test (let () (define (hi if) (+ if 1)) (hi 2)) 3)
-
-(test (let () (define* (hi (lambda 1)) (+ lambda 1)) (hi)) 2)
-(test (do ((i 0 0) '(+ 0 1)) ((= i 0) i)) 0) ; guile also! (do ((i 0 0) (quote list (+ 0 1))) ((= i 0) i))?
-(test (let () (define (cond a) a) (cond 1)) 1)
-(test (let ((cond 1)) (+ cond 3)) 4)
-(test (let () (define (tst cond) (if cond 0 1)) (tst #f)) 1)
-(test (let () (define (tst fnc) (fnc ((> 0 1) 2) (#t 3))) (tst cond)) 3)
-(test (let () (define (tst fnc) (fnc ((> 0 1) 2) (#t 3))) (define (val) cond) (tst (val))) 3)
-(test (let () (define-macro (hi a) `(let ((lambda +)) (lambda ,a 1))) (hi 2)) 3)
-(test ((let ((do or)) do) 1 2) 1)
-
-(test (let () (define (hi) (let ((oscil *)) (if (< 3 2) (+ 1 2) (oscil 4 2)))) (hi) (hi)) 8)
-(test (let () (define (hi) (let ((oscil *)) (if (< 3 2) (+ 1 2) (oscil 4 2)))) (hi) (hi) (hi) (hi)) 8)
-(test (let ((x 12)) (define (hi env) (set! x (env 0)) x) (hi '(1 2 3)) (hi '(1 2 3))) 1)
-(test (let ((x 12)) (define (hi env) (set! x (+ x (env 0))) x) (hi '(1 2 3)) (hi '(1 2 3))) 14)
-(test (let ((x 12)) (define (hi env) (set! x (+ (env 0) x)) x) (hi '(1 2 3)) (hi '(1 2 3))) 14)
-(test (let ((x 12)) (define (hi env) (set! x (+ x (env 0))) x) (hi '(1 2 3)) (hi '(1 2 3)) (hi '(1 2 3))) 15)
-(test (let ((x 12)) (define (hi env) (set! x (+ (env 0) x)) x) (hi '(1 2 3)) (hi '(1 2 3)) (hi '(1 2 3))) 15)
-
-(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i (env 1 2)))) ((> i (env 4 5)) (env 1 2 3)) (+ x (env 1)))) (hi) (hi)) 6)
-(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i (env 4 5)) (env 1 2 3)) (+ x (env 1)))) (hi) (hi)) 6)
-(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i (env 4 5)) (env 1 2 3)) (+ x 1))) (hi) (hi)) 6)
-(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i 9) (env 1 2 3)) (+ x 1))) (hi) (hi)) 6)
-(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i 9) (+ 1 2 3)) (+ x 1))) (hi) (hi)) 6)
-(test (let * ((i 0)) (if (< i 1) (* (+ i 1))) i) 0)
-(test (let ((car if)) (car #t 0 1)) 0)
-(test (call-with-exit (lambda (abs) (abs -1))) -1)
-
-(test (let ((sqrt (lambda (a) (* a a)))) `(+ ,@(map sqrt '(1 4 9)) 2)) '(+ 1 16 81 2))
-(test (let ((sqrt (lambda (a) (* a a)))) `(+ ,(sqrt 9) 4)) '(+ 81 4))
-(test `(+ ,(let ((sqrt (lambda (a) (* a a)))) (sqrt 9)) 4) '(+ 81 4))
-(test `(+ (let ((sqrt (lambda (a) (* a a)))) ,(sqrt 9)) 4) '(+ (let ((sqrt (lambda (a) (* a a)))) 3) 4))
-(test (let ((sqrt (lambda (a) (* a a)))) `(+ ,(apply values (map sqrt '(1 4 9))) 2)) '(+ 1 16 81 2))
-(if (not (provided? 'immutable-unquote)) (test (let ((sqrt (lambda (a) (* a a)))) `(+ (unquote (apply values (map sqrt '(1 4 9)))) 2)) '(+ 1 16 81 2)))
-
-(test ((((eval lambda) lcm gcd))) 0)
-(test ((((lambda - -) -) 0) 1) -1)
-
-(test (let () (define (hi) (let ((oscil >)) (or (< 3 2) (oscil 4 2)))) (hi) (hi)) #t)
-(test (let () (define (hi) (let ((oscil >)) (and (< 2 3) (oscil 4 2)))) (hi) (hi)) #t)
-
-(test ((lambda* ((- 0)) -) :- 1) 1)
-
-(let ()
- (define-macro (i_ arg)
- `(with-let (unlet) ,arg))
-
- (define-bacro* (mac b)
- `((i_ let) ((a 12))
- ((i_ +) a ,(symbol->value b))))
- ;; this assumes the 'b' value is a symbol: (let ((a 1)) (mac (* a 2))) is an error -- see s7.html for a better version
- (test (let ((a 32)
- (+ -))
- (mac a))
- 44))
-
-;(define (hi) (do ((i 0 (+ i 1))) ((= i 200000) i) (abs i)))
-;(test (hi) 200000)
-
-(let ()
- (define-macro (cube x) `(with-let (inlet :x ,x) (* x x x)))
- (test (cube 2) 8)
- (let ((x 2)) (test (cube (set! x (+ x 1))) 27))
-
- (define-macro (pop! sym)
- `(with-let (#_inlet :e (#_curlet) :result (#_car ,sym))
- (with-let e (#_set! ,sym (#_cdr ,sym)))
- result))
-
- (test (let ((lst '(1 2 3))) (list (pop! lst) lst)) '(1 (2 3)))
- (test (let ((lst (vector (list 1 2 3)))) (list (pop! (lst 0)) lst)) '(1 #((2 3))))
- (test (let ((result '(1 2 3))) (list (pop! result) result)) '(1 (2 3)))
- (test (let ((cdr '(1 2 3))) (list (pop! cdr) cdr)) '(1 (2 3)))
-
- (define-macro (pushnew! val lst)
- `(set! ,lst (with-let (inlet :val ,val :lst ,lst)
- (if (not (member val lst))
- (cons val lst)
- lst))))
-
- (test (let ((lst (list 1 2))) (pushnew! 3 lst)) '(3 1 2))
- (test (let ((val (list 1 2)) (lst 3)) (pushnew! lst val)) '(3 1 2))
- (test (let ((lst (list 1 2)) (val 3)) (pushnew! val lst)) '(3 1 2))
- (test (let ((lst (list 1 2)) (member 3)) (pushnew! member lst)) '(3 1 2))
- )
-
-
-(test (let ()
- (define-immaculo (hi a) `(let ((b 23)) (+ b ,a)))
- (let ((+ *)
- (b 12))
- (hi b)))
- 35)
-
-(test (let ()
- (define-clean-macro (hi a) `(+ ,a 1))
- (let ((+ *)
- (a 12))
- (hi a)))
- 13)
-
-(test (let ()
- (define-immaculo (hi a) `(+ ,a 1))
- (let ((+ *)
- (a 12))
- (hi a)))
- 13)
-
-(test (let ()
- (define-clean-macro (mac a . body)
- `(+ ,a , at body))
- (let ((a 2)
- (+ *))
- (mac a (- 5 a) (* a 2))))
- 9)
-
-(test (let ()
- (define-macro (mac b)
- `(let ((a 12))
- (,+ a ,b)))
- (let ((a 1)
- (+ *))
- (mac a)))
- 24)
-
-(test (let ()
- (define-macro (mac b)
- `(let ((a 12))
- (+ a ,b)))
- (let ((a 1)
- (+ *))
- (mac a)))
- 144)
-
-(test (let ()
- (define-immaculo (mac c d) `(let ((a 12) (b 3)) (+ a b ,c ,d)))
- (let ((a 21) (b 10) (+ *)) (mac a b)))
- 46)
-
-(let ()
- (define-macro (pure-let bindings . body)
- `(with-let (unlet)
- (let ,bindings , at body)))
- (test (let ((+ *) (lambda abs)) (pure-let ((x 2)) ((lambda (y) (+ x y)) 3))) 5))
-
-(test (let ((name '+))
- (let ((+ *))
- (eval (list name 2 3))))
- 6)
-(test (let ((name +))
- (let ((+ *))
- (eval (list name 2 3))))
- 5)
-;; why is this considered confusing? It has nothing to do with eval!
-
-(test (let ((call/cc (lambda (x)
- (let ((c (call/cc x))) c))))
- (call/cc (lambda (r) (r 1))))
- 1)
-
-; (test (with-let (sublet (curlet) (cons '+ (lambda args (apply * args)))) (+ 1 2 3 4)) 24) ; not sure about this -- the inner '+ might be optimized
-
-(let ()
- (define-constant [begin] begin)
- (define-constant [if] if)
- (define-macro (when1 expr . body)
- `([if] ,expr ([begin] , at body)))
- (let ((if 32) (begin +))
- (test (when1 (> 2 1) 1 2 3) 3)
- (test (when1 (> 1 2) 3 4 5) #<unspecified>))
- (test (when1 (> 2 1) 3) 3))
-
-(test (let ((car 1) (cdr 2) (list '(1 2 3))) (+ car cdr (cadr list))) 5)
-(test (letrec ((null? (lambda (car cdr) (+ car cdr)))) (null? 1 2)) 3)
-(test (letrec ((append (lambda (car list) (car list)))) (append cadr '(1 2 3))) 2)
-(test (let () (define (hi) (let ((car 1) (cdr 2) (list '(1 2 3))) (+ car cdr (cadr list)))) (hi)) 5)
-(test (let () (define (hi) (letrec ((null? (lambda (car cdr) (+ car cdr)))) (null? 1 2))) (hi)) 3)
-(test (let () (define (hi) (letrec ((append (lambda (car list) (car list)))) (append cadr '(1 2 3)))) (hi)) 2)
-
-(let ()
- (test ((lambda 'a (eval-string "1")) (curlet) 1) 1)
- (test ((lambda 'a (eval-string "a")) (curlet) 1) 1))
-
-;;; check optimizer
-(let ((lst (list 1 2 3))
- (old-lambda lambda)
- (ho #f)
- (val #f))
- (let* ((lambda 1))
- (define (hi)
- (for-each (lambda (a) (display a)) lst))
- (set! val (+ lambda 2))
- (set! ho hi))
- (test val 3)
- (test (ho) 'error))
-
-(let ()
- (define mac (let ((var (gensym)))
- (define-macro (mac-inner b)
- `(#_let ((,var 12)) (#_+ ,var ,b)))
- mac-inner))
- (test (let ((a 1) (+ *) (let /)) (mac a)) 13)
- (test (let ((a 1) (+ *) (let /)) (mac (mac a))) 25))
-
-(test (let ((begin +)) (with-let (unlet) (begin 1 2))) 2)
-(test (let () (define (f x) (let > (begin (vector-dimensions 22)))) (f 0)) 'error)
-(test (let () (define (f x) (let asd ())) (f 1)) 'error)
-(test (let () (define (f x) (hook *)) (f #f)) 'error)
-(test (let ((e (sublet () '(a . 1)))) (define (f x) (e *)) (f 1)) 'error)
-(test (let () (define (f) (eval (lambda 2.(hash-table-ref 1-)))) (f)) 'error)
-(test (let () (eval (lambda 2.(hash-table-ref 1-)))) 'error)
-(test (let () (define (f) (eval (lambda 2 #f))) (f)) 'error)
-(test (let () (define (f) (eval (lambda #f))) (f)) 'error)
-(test (let () (define (f) (eval (lambda))) (f)) 'error)
-(test (let () ((lambda () (eval (lambda 2 #f))))) 'error)
-(test (let () (define (f x) (help (lambda `(x 1) 12))) (f (string #\a))) 'error)
-(test (let () (define (func x) (* +(quote (vector? )))) (func '((x 1) (y) . 2))) 'error)
-(test (let () (define (func x) (* +(quote i))) (func cond)) 'error)
-(test (let ((i 1)) (define (func x) (begin i(let -))) (func macroexpand)) 'error)
-(test (let ((i 1)) (define (func x) (if (* i '((x 1) (y) . 2) ) (atan (procedure? 2(sin ))))) (func '(values #\c 3 1.2))) 'error)
-(test (let ((i 1)) (define (func x) (* 1- '(values #\c 3 1.2) )) (func set!)) 'error)
-(test (let ((dynamic-wind 1)) (+ dynamic-wind 2)) 3)
-
-#|
-;;; after much dithering I've decided that built-in C functions have a very aggressive take
-;;; on "lexical scope": if gcd appears as the car of an expression in a function, and
-;;; at that point in the overall s7 process gcd has not been redefined, then the function
-;;; can embed the actual gcd function in that part of its source (as if it was (#_gcd ...)).
-;;; Hence a subsequent (set! gcd +) has no effect on any call that lexically (textually)
-;;; preceded that set!. This is different from the handling of scheme-defined functions
-;;; where (define (a) 0) (define (b) (a)) (define (c) 1) (set! a c) (b) -> 1.
-;;; The decision as to when to replace the 'gcd with the gcd function is up to the optimizer, so
-;;; consistency here is considered of no importance compared to speed -- either don't (set! gcd +)
-;;; or do it before using gcd in any way.
-
-(test (let ()
- (define (gset-test)
- (let-temporarily ((gcd +))
- (do ((sum 0)
- (x 12)
- (y 4)
- (i 0 (+ i 1)))
- ((= i 3)
- sum)
- (set! sum (+ sum (gcd x y)))
- (set! gcd +))))
- (define (gset-test-1) (gset-test))
- (gset-test-1))
- 36 or 12 -- who knows)
-
-(let ()
- (define %gcd gcd)
- (define (gset-test-x)
- (let ((sum 0)
- (x 12)
- (y 4))
- (do ((i 0 (+ i 1)))
- ((= i 3) sum)
- (set! sum (+ sum (%gcd x y))))))
- (define (gset-test-1x) (gset-test-x))
-
- (define (gset-test-a)
- (let ((sum 0)
- (x 12)
- (y 4))
- (do ((i 0 (+ i 1)))
- ((= i 3) sum)
- (set! sum (+ sum (gcd x y))))))
- (define (gset-test-1a) (gset-test-a))
-
- (define (gset-test-b)
- (let ((sum 0)
- (x 12)
- (y 4))
- (do ((i 0 (+ i 1)))
- ((= i 3) sum)
- (set! sum (+ sum (gcd x y)))
- (set! gcd +))))
- (define (gset-test-1b) (gset-test-b))
-
- (define (gset-test-c)
- (let ((sum 0)
- (x 12)
- (y 4))
- (do ((i 0 (+ i 1)))
- ((= i 3) sum)
- (set! sum (+ sum (gcd x y))))))
- (define (gset-test-1c) (gset-test-c))
-
- (let* ((x (gset-test-1x))
- (a (gset-test-1a))
- (b (gset-test-1b))
- (c (gset-test-1c))
- (a (gset-test-1a)))
- (set! %gcd +)
- (let ((xx (gset-test-1x)))
- (display (list x a b c a xx))
- (newline))))
-
-
-;;; s7: 12 12 12 12 12 12 12
-;;; guile: 12 12 36 48 48 12 48
-|#
-
(define-class quaternion ()
'((r 0) (i 0) (j 0) (k 0))
@@ -82438,6 +82125,7 @@ etc
(test (- q1 1 0.0+i) (make-quaternion 0.0 0.0 0.0 0.0))
(test (- 1 q1) (make-quaternion 0.0 -1.0 0.0 0.0))
+
(test (+ (make-pfloat 1.0) 1.0) (make-pfloat 2.0))
(test (+ (make-quaternion 1 0 0 0) (make-pfloat 1.0)) 'error)
(test (+ (make-pfloat 1.0) 2 (make-quaternion 1 1 1 1)) 'error)
@@ -82447,10 +82135,17 @@ etc
(test (make-quaternion 1 2 3 "hi") 'error)
(let () (define (a1 q) (+ q 1)) (test (a1 q1) (make-quaternion 2.0 1.0 0.0 0.0)))
+ (let () (define (a1 q) (+ q 1)) (test (a1 (+ q1 1)) (make-quaternion 3.0 1.0 0.0 0.0)))
+ (let () (define (a1 q) (+ q 1)) (test (a1 (- q1 1)) q1))
+ (let () (define (a1 q) (+ q 1)) (test (a1 (+ 1 q1)) (make-quaternion 3.0 1.0 0.0 0.0)))
+ (let () (define (a1 q) (+ q 1)) (test (a1 (- 1 q1)) (make-quaternion 1.0 -1.0 0.0 0.0)))
+ (let () (define (a1 q) (+ q 1)) (test (a1 (+ q1 q1)) (make-quaternion 3.0 2.0 0.0 0.0)))
(let () (define (a1 q) (+ 1 q)) (test (a1 q1) (make-quaternion 2.0 1.0 0.0 0.0)))
(let () (define (a1 q) (+ q q)) (test (a1 q1) (make-quaternion 2.0 2.0 0.0 0.0)))
(let () (define (a1 q) (- q 1)) (test (a1 q1) (make-quaternion 0.0 1.0 0.0 0.0)))
- ))
+ (let () (define (a2 q p) (+ q p)) (test (a2 q1 q2) (make-quaternion 3.0 2.0 0.0 0.0)))
+ (let () (define (a2 q p) (+ q p)) (test (a2 (+ 1 q1) (+ q2 1)) (make-quaternion 5.0 2.0 0.0 0.0)))
+ ))
(unless with-bignums
(let ((e1 (openlet
@@ -82596,6 +82291,13 @@ etc
(let ((e (openlet (inlet 'x (list 1 2 3) 'make-iterator (let ((iterator? #t)) (lambda (y) (#_make-iterator (y 'x))))))))
(test (map (lambda (z) (+ z 1)) e) '(2 3 4)))
+(let ()
+ (let ((x (openlet (inlet 'integer? (lambda (y) #t)))))
+ (define (func)
+ (let ((z (vector (integer? x) (vector (integer? x)))))
+ (test (z 0) ((z 1) 0))))
+ (func)))
+
(let ()
(require mockery.scm)
(let ((v ((*mock-vector* 'make-mock-vector) 10 0)))
@@ -83131,13 +82833,13 @@ etc
(define (p1-check . args)
(if (> (magnitude (- (apply * args) 0.25+0.25i)) 1e-15)
- (format-logged #t "~A: (* ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply * args)))
+ (format #t "~A: (* ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply * args)))
(if (not (= (apply + args) 3+i))
- (format-logged #t "~A: (+ ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply + args)))
+ (format #t "~A: (+ ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply + args)))
(if (not (= (apply - args) (- (car args) (apply + (cdr args)))))
- (format-logged #t "~A: ~A != ~A?~%" (port-line-number) (apply - args) (- (car args) (apply + (cdr args)))))
+ (format #t "~A: ~A != ~A?~%" (port-line-number) (apply - args) (- (car args) (apply + (cdr args)))))
(if (not (= (apply / args) (/ (car args) (apply * (cdr args)))))
- (format-logged #t "~A: ~A != ~A?~%" (port-line-number) (apply / args) (/ (car args) (apply * (cdr args))))))
+ (format #t "~A: ~A != ~A?~%" (port-line-number) (apply / args) (/ (car args) (apply * (cdr args))))))
(for-each
(lambda (lst)
@@ -83185,7 +82887,7 @@ etc
(test (mock-pair? lst) #t)
(test (morally-equal? (list 1 2 3) lst) #t)
(test (morally-equal? lst (mock-pair 1 2 3)) #t)
- (test (integer? (pair-line-number lst)) #t)
+ ;(test (integer? (pair-line-number lst)) #t)
(unless pure-s7 (test (list->string (mock-pair #\a #\b #\c)) "abc"))
(test (object->string lst) "(1 2 3)")
(test (list? lst) #t)
@@ -83598,7 +83300,7 @@ etc
(lambda (f1)
(write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) abs f1))
(list 'procedure-documentation 'funclet
- 'procedure-setter 'procedure-source 'dilambda? 'procedure?))
+ 'procedure-setter 'procedure-source 'dilambda?))
(for-each
(lambda (f1)
@@ -83802,7 +83504,6 @@ etc
(test (integer? (*s7* 'free-heap-size)) #t)
(test (integer? (*s7* 'gc-freed)) #t)
(test (real? (*s7* 'cpu-time)) #t)
-(test (vector? (*s7* 'symbol-table)) #t)
(test (integer? (*s7* 'max-string-length)) #t)
(test (integer? (*s7* 'max-list-length)) #t)
(test (integer? (*s7* 'max-vector-length)) #t)
@@ -83880,6 +83581,10 @@ etc
(let-temporarily (((*s7* 'max-string-length) 12))
(test (catch #t (lambda () (make-string 256)) (lambda args 'error)) 'error))
+(let-temporarily (((*s7* 'max-string-length) 20))
+ (let ((str "0123456789"))
+ (test (string-append str str str) 'error)))
+
(let-temporarily (((*s7* 'max-list-length) 1))
(test (catch #t (lambda () (make-list 256)) (lambda args 'error)) 'error))
@@ -83905,7 +83610,7 @@ etc
(for-each
(lambda (arg)
(test (set! (*s7* field) arg) 'error))
- (list "hi" (integer->char 65) (list 1 2) #t (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ (list "hi" (integer->char 65) (list 1 2) #t (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined>)))
'(print-length safety cpu-time heap-size free-heap-size gc-freed max-string-length max-list-length max-vector-length max-vector-dimensions
default-hash-table-length initial-string-port-length gc-protected-objects file-names rootlet-size c-types stack-top stack-size stacktrace-defaults max-stack-size
@@ -83913,6 +83618,22 @@ etc
(for-each
(lambda (field)
+ (let ((old-val (*s7* field)))
+ (test (set! (*s7* field) -12) 'error)
+ (test (set! (*s7* field) 0) 'error)
+ (set! (*s7* field) old-val)))
+ '(max-string-length max-list-length max-vector-length max-vector-dimensions bignum-precision
+ default-hash-table-length initial-string-port-length max-stack-size))
+
+(for-each
+ (lambda (field)
+ (let ((old-val (*s7* field)))
+ (test (set! (*s7* field) -12) 'error)
+ (set! (*s7* field) old-val)))
+ '(print-length float-format-precision))
+
+(for-each
+ (lambda (field)
(for-each
(lambda (arg)
(test (set! (*s7* field) arg) 'error))
@@ -83927,7 +83648,7 @@ etc
(test (set! (*s7* field) arg) 'error))
(list "hi" (integer->char 65) (list 1 2) (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand
3/4 3.14 1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined>)))
- '(undefined-identifier-warnings gc-stats symbol-table-locked?))
+ '(undefined-identifier-warnings gc-stats))
(test (set! #_abs 32) 'error)
(test (define (#_abs a) (= a 1)) 'error)
@@ -83942,6 +83663,384 @@ etc
;(test (let () (define (hi) (let ((cond 3)) (set! cond 4) cond)) (hi)) 4)
;(test (let ((old+ +) (j 0)) (do ((i 0 (+ i 1))) ((or (< i -3) (> i 3))) (set! + -) (set! j (old+ j i))) (set! + old+) j) -6)
+;;; test stack size check
+(let-temporarily (((*s7* 'max-stack-size) 1024))
+ (let ()
+ (define (rdiv2 l) (cond ((null? l) ()) (else (cons (car l) (rdiv2 (cddr l))))))
+ (test (rdiv2 (make-list 200 ())) (make-list 100 ())))
+ (define-macro (stack-test tst)
+ `(if (not (eq? (catch #t
+ (lambda () ,tst)
+ (lambda (type info)
+ type))
+ 'stack-too-big))
+ (format *stderr* "stack: ~S~%" ',tst)))
+ ;; same for op_c_p
+ (stack-test (let () (define (r3 lst) (if (pair? lst) (append (r3 (cdr lst))) ())) (r3 (make-list 200))))
+ ;; safe_c_sp
+ (stack-test (let ((x 1)) (define (r3 lst) (if (pair? lst) (cons x (r3 (cdr lst))) ())) (r3 (make-list 200))))
+ ;; safe_c_cp
+ (stack-test (let () (define (r3 lst) (if (pair? lst) (cons 1 (r3 (cdr lst))) ())) (r3 (make-list 200))))
+ ;; safe_c_qp
+ (stack-test (let ((x 1)) (define (r3 lst) (if (pair? lst) (cons 'x (r3 (cdr lst))) ())) (r3 (make-list 200))))
+ ;; safe_c_ap
+ (stack-test (let ((x 1)) (define (r3 lst) (if (pair? lst) (cons (cons (+ x 1) 2) (r3 (cdr lst))) ())) (r3 (make-list 200))))
+ ;; safe_c_ssp
+ (stack-test (let ((x 1)) (define (r3 lst) (if (pair? lst) (list x x (r3 (cdr lst))) ())) (r3 (make-list 200))))
+ ;; not_p
+ (stack-test (let () (define (r3 lst) (not (r3 (cdr lst)))) (r3 (make-list 200))))
+ ;; safe_c_p
+ (stack-test (let () (define (r3 lst) (pair? (r3 (cdr lst)))) (r3 (make-list 200))))
+ ;; safe_closure_p
+ (stack-test (let () (define (f x) (pair? x)) (define (r3 lst) (f (r3 (cdr lst)))) (r3 (make-list 200))))
+ ;; closure_p
+ (stack-test (let () (define (f x) (map car x)) (define (r3 lst) (f (r3 (cdr lst)))) (r3 (make-list 200))))
+ )
+
+;;; bizarre optimizer checks
+(test (let () (define (func x) (if (pair? (cdr /)) 3)) (define (hi) (func (integer->char 255))) (catch #t (lambda () (hi) (func (integer->char 255))) (lambda arg #f))) #f)
+(test (catch #t (lambda () (define (func x) (cond (case `((1)) (if x y) =>))) (define (hi) (func ())) (hi)) (lambda args 'error)) 'error)
+(let ()
+ (define (func x)
+ (case x
+ ((#t) (- (cdaadr)))
+ (('(((x 1) 2) 3)) (cadddr or (list (list 1 2)) (<= (sort!))))
+ (else (cond (case / #() let* 0+1/0i (list (list 1)) (lambda* / (caadar (read-byte // (assv)))))))))
+ (define (hi)
+ (func 1+0/0i))
+ (hi)
+ (func 1+0/0i))
+
+(test (let ()
+ (define (f1 a b)
+ (list a b))
+ (define (f2)
+ (when #f (define f2_c 2))
+ (f1 f2_c #f))
+ (f2)) 'error)
+
+(test (let ()
+ (define (f1 a b)
+ (list a b))
+ (define (f3)
+ (if #f (define f3_c 2))
+ (f1 f3_c f3_c))
+ (f3)) 'error)
+
+(test (let ()
+ (define (f4 a b)
+ (catch #t (lambda () a) (lambda args (display (ow!)))))
+ (define (f5)
+ (when #f (define f5_c 50))
+ (f4 f5_c (lambda () 1)))
+ (f5)) 'error)
+
+(test (let ()
+ (define (f6)
+ (and #f (define f7_c 50))
+ (+ f7_c ((lambda () 1))))
+ (f6)) 'error)
+
+(test (let () (define (func x) (call-with-exit (lambda ((i 0 (+ i 1))) #f))) (define (hi) (func begin)) (hi) (func begin)) 'error)
+(test (let () (define (func x) (if (cond (cddr => (lambda))) (cddddr `(((+ x 1)))))) (define (hi) (func '((x 1) (y) . 2))) (hi) (func '((x 1) (y) . 2))) 'error)
+(test (let () (define (func x) (if (memq / (quote . "")) (assv '()))) (define (hi) (func x y z)) (hi) (func x y z)) 'error)
+(test (let () (define (func x) (cond (case / (set! _settee_ (caadr))))) (define (hi) (func 0/0+0/0i)) (hi) (func 0/0+0/0i)) 'error)
+(test (let () (define (func x) (object->string (list (funclet /)))) (define (hi) (func abs)) (hi)) "((rootlet))")
+(test (let () (define (func x) (cdadar (not (eq? / '())))) (define (hi) (func '((())))) (hi)) 'error)
+(test (let () (define (func x) (append (inlet 'integer? (lambda (f) #f)) (hash-table `((+ x 1)) '(((x 1) 2) 3)))) (define (hi) (func 1)) (hi)) 'error)
+(test (let () (define (func x) (float-vector? (<= / (let-ref 1+0/0i 0)))) (define (hi) (func 0/0+i)) (hi)) 'error)
+(test (let () (set! else #(0 0)) (define (func x) (car (boolean? (char=? (else ()) (= i 2))))) (define (hi) (func '(()))) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (logior // (+)))) (define (hi) (func 0+1/0i)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (int-vector-ref /(asinh (logand))))) (define (hi) (func 0+1/0i)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (logxor /(lognot (gcd))))) (define (hi) (func (list (list 1 2)))) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (int-vector-set! / 1 2))) (define (hi) (func 1.5)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (quote . /))) (define (hi) (func (integer->char 255))) (hi)) 'error)
+(test (let () (define (func x) (cond ((if if . :readable) #f))) (define (hi) (func begin)) (hi)) 'error)
+(test (let () (define (func x) (if (not . /) x)) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (set! (with-let / begin `(+ ,a ,b , at c) #<undefined>) #f)) (define (hi) (func #f)) (hi)) 'error)
+(test (procedure? (let () (define (func) (cond (case 'x (lambda / x)))) (func))) #t)
+(test (let () (define (func x) (let () (define _x_ (lambda* '((x 1 . 2) . 3) `((x)) (reverse! /))))) (define (hi) (func #f)) (hi)) 'error)
+(test (procedure? (let () (define (func x) (cond (case / (lambda* abs /)) (else #f))) (define (hi) (func #f)) (hi))) #t)
+(test (let () (define (func x) (let () (define _x_ (lambda* . let*)))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (set! (with-let . ()) #f)) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (call/cc (lambda (_x_) (acosh (unlet))))) (define (hi) (func #f)) (hi)) 'error)
+(test (procedure? (let () (define (func x) (cond (case '((x 1) y . 2) 1/0+i :readable (lambda / macroexpand `(x 1))) (else #f))) (define (hi) (func #f)) (hi))) #t)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (member :rest (cons 1 2) /))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (char-numeric? (make-vector 3) 1.5 `((+ x 1)) ))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (procedure? //))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (char-numeric? (char-ready? )))) (define (hi) (func #f)) (hi)) 'error) ;#t if opt
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (iterator-at-end? /))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (hash-table-ref /(flush-output-port )))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (let () (set! ((dilambda / (let ((x 3)) (lambda (y) (+ x y))) )) 3))) (define (hi) (func #f)) (hi)) 6) ;!
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (unlet /(constant? )))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (catch #f (vector-ref #(1 2) 0 1.0+1.0i) (vector-ref #(1 2) 0 1.0+1.0i))) (define (hi) (func #f)) (hi)) 'error)
+(test (vector-ref (vector abs log) 0 -1) 1) ; weird...
+(test (let () (define (func x) (cond (lambda (if x y) 0 1.0+1.0i (string>=? / `((+ x 1)) x y z (integer->char 255))) (else #f))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (format `((x)) (list 1) cons else (read (string-append /))))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (<= -1 (round /)))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (byte-vector-ref (make-string 3) 0))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (char-ci<? (null? i) (quote . let)))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (int-vector-ref #i2d((1 2) (3 4)) 0))) (define (hi) (func #f)) (hi)) #t)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (denominator (sqrt (hash-table-ref (if x y) 0+0/0i))))) (define (hi) (func #f)) (hi)) 'error)
+(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) (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 (f) (let ((_x_ (+ _x_ 1.0))) 1)) (f)) 'error)
+(test (let () (define (f) (define _x_ (let-ref (cdr _x_) 'a))) (f)) 'error)
+(test (let () (define (f) (define _x_ (define _x_ 1))) (f)) 1)
+(test (let () (define (f y) (define _x_ (* y (cos _x_))) 1) (f 1)) 'error)
+(test (let () (define (f y) (define _x_ (* _x_ y)) 1) (f 1)) 'error)
+(test (let () (define (f) (define _x_ (+ _x_ 123)) 1) (f)) 'error)
+(test (let () (define (f) (define _x_ (+ _x_ 1)) 1) (f)) 'error)
+(test (let () (define (f) (define _x_ (+ 1 _x_)) 1) (f)) 'error)
+(test (let () (define (f) (define _x_ (* .1 _x_)) 1) (f)) 'error)
+(test (let () (define (f) (define _x_ (+ .1 _x_)) 1) (f)) 'error)
+(test (let () (define (f) (define _x_ (+ _x_ .1)) 1) (f)) 'error)
+
+(when (defined? 's7-optimize)
+ (test (s7-optimize '((cdadr (cddddr (symbol->string (min '((x 1 . 2) . 3) #<undefined> '((x 1) . 2))))))) #<undefined>) ; #<undefined> is s7-optimize's error value
+ (test (s7-optimize '((set! (cyclic-sequences . 0+0/0i) #f))) #<undefined>)
+ )
+
+;;; clumsy test, but will hang in older s7's
+(define global_fi
+ (let ((documentation "docs"))
+ (lambda (par_f lst)
+ (do ((p lst (cdr p)))
+ ((or (not (pair? p))
+ (par_f (car p)))
+ (and (pair? p)
+ (car p)))))))
+
+(define (par_f)
+ (let ((items (list 1 (list 2 3 4))))
+ (global_fi (lambda (x)
+ (not (or (symbol? x)
+ (memq x '(#f #t () #<unspecified> #<undefined> #<eof>)))))
+ (cadr items))))
+(par_f)
+(par_f)
+
+;;; check cond=>opt result
+(let ()
+ (define (f) (cond ((= 1 2) => (lambda (s) s))))
+ (test (f) #<unspecified>)
+ (test (f) #<unspecified>))
+
+;;; some clm optimizer stuff
+(let ()
+ (define (fdo1)
+ (let ((sum 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 10) sum)
+ (do ((j 0 (+ j 1)))
+ ((= j 3))
+ (set! sum (+ sum j))))))
+
+ (let ((sum (fdo1)))
+ (if (not (= sum 30))
+ (format *stderr* "fdo1: ~A~%" sum)))
+
+ (define (fdo2)
+ (let ((sum 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 10) sum)
+ (do ((j 0 (+ j 1)))
+ ((= j 3))
+ (set! sum (+ sum i j))))))
+
+ (let ((sum (fdo2)))
+ (if (not (= sum 165))
+ (format *stderr* "fdo2: ~A~%" sum)))
+
+ (define (fdo3)
+ (let ((sum 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 10) sum)
+ (do ((j 0 (+ j 1)))
+ ((= j 3))
+ (do ((k 0 (+ k 1)))
+ ((= k 2))
+ (set! sum (+ sum 1)))))))
+
+ (let ((sum (fdo3)))
+ (if (not (= sum 60))
+ (format *stderr* "fdo3: ~A~%" sum)))
+
+ (define (fdo4)
+ (do ((i 0 (+ i 1)))
+ ((= i 10) i)
+ (do ((j 0 (+ j 1)))
+ ((= j 3)))))
+
+ (let ((sum (fdo4)))
+ (if (not (= sum 10))
+ (format *stderr* "fdo4: ~A~%" sum)))
+
+ (define (fdo5)
+ (let ((sum 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 10) sum)
+ (do ((j 0 (+ j 1)))
+ ((= j 3))
+ (set! sum (+ sum j))
+ (set! sum (+ sum i))))))
+
+ (let ((sum (fdo5)))
+ (if (not (= sum 165))
+ (format *stderr* "fdo5: ~A~%" sum)))
+
+ (define (fdo6)
+ (let ((sum 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (if (zero? sum)
+ (do ((j 0 (+ j 1)))
+ ((= j 3))
+ (set! sum (+ sum j)))))
+ sum))
+
+ (let ((sum (fdo6)))
+ (if (not (= sum 3))
+ (format *stderr* "fdo6: ~A~%" sum)))
+
+ (define (f1)
+ (let ((x 0))
+ (do ((i 0 (+ i 1/2)))
+ ((= i 3) x)
+ (set! x (+ x i)))))
+ (f1)
+
+ (define (fdo7)
+ (let ((sum 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) sum)
+ (if (zero? sum)
+ (do ((j 0 (+ j 1)))
+ ((= j 3))
+ (set! sum (+ sum j)))))))
+
+ (let ((sum (fdo7)))
+ (if (not (= sum 3))
+ (format *stderr* "fdo7: ~A~%" sum)))
+
+ (define (fdo8)
+ (let ((sum 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) (set! sum (+ sum 1)) (* sum 2))
+ (if (zero? sum)
+ (do ((j 0 (+ j 1)))
+ ((= j 3))
+ (set! sum (+ sum j)))))))
+
+ (let ((sum (fdo8)))
+ (if (not (= sum 8))
+ (format *stderr* "fdo8: ~A~%" sum)))
+
+ (define (fdo9)
+ (let ((sum 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) sum)
+ (do ()
+ ((> (* sum 3) i))
+ (set! sum (+ sum 1))))))
+
+ (let ((sum (fdo9)))
+ (if (not (= sum 1))
+ (format *stderr* "fdo9: ~A~%" sum)))
+
+ (define (fdo10)
+ (let ((sum 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) sum)
+ (do ((k 1))
+ ((> sum 3))
+ (set! sum (+ sum k))))))
+
+ (let ((sum (fdo10)))
+ (if (not (= sum 4))
+ (format *stderr* "fdo10: ~A~%" sum)))
+
+ (define (fdo11)
+ (let ((sum 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) sum)
+ (do ((k 1 (+ k 1))
+ (j 2 (+ j 2)))
+ ((> k 3))
+ (set! sum (+ sum k j))))))
+
+ (let ((sum (fdo11)))
+ (if (not (= sum 54))
+ (format *stderr* "fdo11: ~A~%" sum)))
+
+ (define (fdo12)
+ (let ((sum 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) sum)
+ (do ((k 1 (+ k 1))
+ (j 2 (+ j k)))
+ ((> k 3))
+ (set! sum (+ sum k j))))))
+
+ (let ((sum (fdo12)))
+ (if (not (= sum 48))
+ (format *stderr* "fdo12: ~A~%" sum)))
+
+ (define size 100)
+
+ (define (ft1)
+ (let ((sum 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 10) sum)
+ (do ((k 0 (+ k 1)))
+ ((= k size))
+ (set! sum (+ sum 1))))))
+
+ (let ((sum (ft1)))
+ (if (not (= sum (* size 10)))
+ (format *stderr* "ft1: ~A~%" sum)))
+
+ (define (fcond1)
+ (let ((res 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 1))
+ (cond ((zero? i) (set! res (+ i 21)))
+ (else (set! res -1))))
+ res))
+
+ (let ((res (fcond1)))
+ (if (not (= res 21))
+ (format *stderr* "fcond1: ~A~%" res)))
+
+ (define (fcond2)
+ (let ((res 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 1))
+ (cond ((negative? i) (set! res (+ i 21)))
+ (else (set! res -1))))
+ res))
+
+ (let ((res (fcond2)))
+ (if (not (= res -1))
+ (format *stderr* "fcond2: ~A~%" res)))
+
+ (define (fcond3)
+ (let ((res 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 1))
+ (cond ((negative? i) (set! res (+ i 21)))
+ ((> i 4) (set! res 100))))
+ res))
+
+ (let ((res (fcond3)))
+ (if (not (zero? res))
+ (format *stderr* "fcond3: ~A~%" res)))
+ )
+
;;; --------------------------------------------------------------------------------
;;; libm
@@ -84280,16 +84379,11 @@ etc
(num-test (isnormal 1234567.6) 1)
(num-test (isnormal 0) 0)
- (num-test (signbit 1.5) 0)
- (reader-cond ((provided? 'linux)
- (test (pair? (memv (signbit -1.5) '(1 128))) #t) ; good grief
- (test (pair? (memv (signbit -1) '(1 128))) #t))
- ((provided? 'osx)
- (num-test (signbit -1.5) 1)
- (num-test (signbit -1) 1)))
- (num-test (signbit 0) 0)
- (num-test (signbit inf.0) 0)
- (num-test (signbit nan.0) 0))
+ (when (defined? 'signbit)
+ (num-test (signbit 1.5) 0)
+ (num-test (signbit 0) 0)
+ (num-test (signbit inf.0) 0)
+ (num-test (signbit nan.0) 0)))
(num-test (floor 1.5) 1.0)
(num-test (floor 3/4) 0.0)
@@ -85402,6 +85496,27 @@ etc
;;; --------------------------------------------------------------------------------
(define (string-wi=? s1 s2)
+ (let ((len1 (length s1))
+ (len2 (length s2)))
+ (let loop ((i1 0) (i2 0))
+ (if (< i1 len1)
+ (if (< i2 len2)
+ (if (char=? (s1 i1) (s2 i2))
+ (loop (+ i1 1) (+ i2 1))
+ (or (and (char-whitespace? (s2 i2))
+ (loop i1 (+ i2 1)))
+ (and (char-whitespace? (s1 i1))
+ (loop (+ i1 1) i2))))
+ (and (char-whitespace? (s1 i1))
+ (loop (+ i1 1) i2)))
+ (if (< i2 len2)
+ (and (char-whitespace? (s2 i2))
+ (loop i1 (+ i2 1)))
+ (and (= i1 len1)
+ (= i2 len2)))))))
+#|
+;;; slower:
+(define (string-wi=? s1 s2)
(or (string=? s1 s2)
(let ((len1 (length s1))
(len2 (length s2)))
@@ -85418,6 +85533,21 @@ etc
(< i2 len2)
(char=? (s1 i1) (s2 i2))
(loop (+ i1 1) (+ i2 1))))))))))
+;;; even slower
+(define (no-spaces s1)
+ (let ((len (length s1)))
+ (do ((i 0 (+ i 1))
+ (str (make-string len))
+ (j 0))
+ ((= i len)
+ (copy str (make-string j)))
+ (when (not (char-whitespace? (s1 i)))
+ (set! (str j) (s1 i))
+ (set! j (+ j 1))))))
+(define (string-wi=? s1 s2)
+ (or (string=? s1 s2)
+ (string=? (no-spaces s1) (no-spaces s2))))
+|#
(test (string-wi=? "" "") #t)
(test (string-wi=? "" " ") #t)
@@ -85434,23 +85564,23 @@ etc
(let ()
(require lint.scm)
- (define (lint-test str1 str2) ;(display str1) (newline)
- (let ((result (call-with-output-string
- (lambda (op)
- (call-with-input-string str1
- (lambda (ip)
- (lint ip op)))))))
-
- (define (no-lines s)
- (let ((pos (string-position "(line " s))
- (epos (string-position "): " s)))
- (if (and pos epos)
- (no-lines (string-append (substring s 0 (- pos 1)) (substring s (+ epos 1)))) ; sometimes there are two "(line ...)" intrusions
- s)))
-
- (if (and (not (string-wi=? result str2))
- (not (string-wi=? (no-lines result) str2)))
- (format *stderr* ";(lint ~S) -> ~S~%" str1 result))))
+ (define lint-test
+ (letrec ((no-lines
+ (lambda (s)
+ (let* ((pos (string-position "(line " s))
+ (epos (and pos (string-position "): " s (+ pos 1))))) ; might be "):" unrelated to (line...)!
+ (if (and pos epos)
+ (no-lines (string-append (substring s 0 (- pos 1)) (substring s (+ epos 1)))) ; sometimes there are two "(line ...)" intrusions
+ s)))))
+ (lambda (str1 str2)
+ (let ((result (call-with-output-string
+ (lambda (op)
+ (call-with-input-string str1
+ (lambda (ip)
+ (lint ip op)))))))
+ (if (and (not (string-wi=? result str2))
+ (not (string-wi=? (no-lines result) str2)))
+ (format *stderr* ";(lint ~S) -> ~S~%" str1 result))))))
(lint-test "(+ 1 2)" " +: perhaps (+ 1 2) -> 3")
(lint-test "(+ 1 (+ 2 3))" " +: perhaps (+ 1 (+ 2 3)) -> 6")
@@ -85462,7 +85592,7 @@ etc
(lint-test "(+ 1/3 2/3)" " +: perhaps (+ 1/3 2/3) -> 1")
(lint-test "(+ (log x) (log 3))" "") ; oops...
(lint-test "(+ x 0 (+ 0 0))" " +: perhaps (+ x 0 (+ 0 0)) -> x")
- (lint-test "(+ x #(0))" " +: in (+ x #(0)), +'s argument 2 should be a number, but #(0) is a vector?")
+ (lint-test "(+ x #(a))" " +: in (+ x #(a)), +'s argument 2 should be a number, but #(a) is a vector?")
(lint-test "(+ x 2.0 -2)" " +: perhaps (+ x 2.0 -2) -> (* x 1)") ; ??
(lint-test "(+ x (+ y z) (+ a b))" " +: perhaps (+ x (+ y z) (+ a b)) -> (+ x y z a b)")
(lint-test "(+ (- x) y)" " +: perhaps (+ (- x) y) -> (- y x)")
@@ -85638,6 +85768,8 @@ etc
(lint-test "(/ (/ z x y))" " /: perhaps (/ (/ z x y)) -> (/ (* x y) z)")
(lint-test "(/ 1 (/ 1 x y))" " /: perhaps (/ 1 (/ 1 x y)) -> (* x y)")
(lint-test "(/ x y (length z))" " /: (length z) will cause division by 0 if z is empty")
+ (lint-test "(/ (length x))" " /: (length x) will cause division by 0 if x is empty")
+ (lint-test "(/ (length x) z)" "")
(lint-test "(/ (exact->inexact x) 10)" " /: perhaps (/ (exact->inexact x) 10) -> (/ x 10.0)")
(lint-test "(+ (exact->inexact x) 10)" " +: perhaps (+ (exact->inexact x) 10) -> (+ x 10.0)")
@@ -85876,13 +86008,11 @@ etc
(lint-test "(negative? (string-length s))" " negative?: string-length can't be negative: (negative? (string-length s))")
(lint-test "(not (positive? (- n 2)))" " not: perhaps (positive? (- n 2)) -> (> n 2)")
- (lint-test "(+ #e21 x)" " this #e is dumb, #e21 -> 21")
- (lint-test "(+ #i1.0 x)" " this #i is dumb, #i1.0 -> 1.0")
- (lint-test "(+ #e1+i x)" " #e can't handle complex numbers, #e1+i -> 1+1i reader[0]: unknown # object: #e1+i")
- (lint-test "(+ #e1.0 x)" " perhaps #e1.0 -> 1")
- (lint-test "(+ #d1 x)" " #d is pointless, #d1 -> 1")
- (lint-test "(+ #i1 x)" " perhaps #i1 -> 1.0")
- (lint-test "(+ 1 +i)" "+i is not a number in s7")
+ (lint-test "(+ 1 +i)" " +: +i is not a number in s7")
+ (lint-test "(let ((|ABS| abs)) |ABS|)"
+ " let: | is not a special character in s7, so |ABS| is not the symbol ABS
+ let: perhaps (let ((|ABS| abs)) |ABS|) -> abs
+ let: assuming we see all set!s, the binding (|ABS| abs) is pointless: perhaps (let ((|ABS| abs)) |ABS|) -> abs")
(lint-test "(char? '#\\a)"
" char?: perhaps (char? '#\\a) -> #t
@@ -85896,7 +86026,7 @@ etc
(lint-test "(memq 1.0 x)" " memq: (memq 1.0 x): perhaps memq -> memv")
(lint-test "(assq \"test\" x)" " assq: (assq \"test\" x): perhaps assq -> assoc")
(lint-test "(assq (cons 1 2) x)" " assq: (assq (cons 1 2) x): perhaps assq -> assoc")
- (lint-test "(assv #(0) x)" " assv: (assv #(0) x): perhaps assv -> assoc")
+ (lint-test "(assv #(a) x)" " assv: (assv #(a) x): perhaps assv -> assoc")
(lint-test "(member 'a x (lambda (a b c) (eq? a b)))" " member: member equality function (optional third arg) should take two arguments")
(lint-test "(member 'a x (lambda (a b) (eq? a (car b))))" " member: member might perhaps be assq")
(lint-test "(member y x (lambda (a b) (equal? a (car b))))" " member: member might perhaps be assoc")
@@ -85921,8 +86051,8 @@ etc
memq: stray comma? (memq x '(a (unquote b) c))")
(lint-test "(memq x '(a (+ 1 2) 3))" " memq: memq should be member in (memq x '(a (+ 1 2) 3))
memq: pointless list member: (+ 1 2) in (memq x '(a (+ 1 2) 3))")
- (lint-test "(memq x '(a #(0)))" " memq: memq should be member in (memq x '(a #(0)))
- memq: pointless list member: #(0) in (memq x '(a #(0)))")
+ (lint-test "(memq x '(a #(a)))" " memq: memq should be member in (memq x '(a #(a)))
+ memq: pointless list member: #(a) in (memq x '(a #(a)))")
(lint-test "(memv x '(#f #\\c a 1 () :a))" "")
(lint-test "(memq x '(a b a c))" " memq: duplicated entry a in '(a b a c)")
(lint-test "(assq x '((a . 1)))" "")
@@ -85960,7 +86090,7 @@ etc
memq: perhaps (list #\\{ #\\[ #\\() -> '(#\\{ #\\[ #\\()")
(lint-test "(member (car op) (list x y z))" "")
(lint-test "(member (car op) (list \"a\" (f x)))" "")
- (lint-test "(member (car op) (list \"a\" #(1)))" " member: perhaps (list \"a\" #(1)) -> '(\"a\" #(1))")
+ (lint-test "(member (car op) (list \"a\" #(1)))" " member: perhaps (list \"a\" #(1)) -> '(\"a\" #(1)) member: #(1) could be #i(1)")
(lint-test "(member (car op) '(\"a\" #()))" "")
(lint-test "(memq (car op) '(\"a\" #()))" " memq: memq should be member in (memq (car op) '(\"a\" #()))
memq: pointless list member: \"a\" in (memq (car op) '(\"a\" #()))")
@@ -86373,7 +86503,7 @@ etc
(lint-test "(let loop ((lst x) (res ())) (cond ((null? lst) (reverse res)) (else (loop (cdr lst) (cons (car lst) res)))))"
" loop: perhaps (let loop ((lst x) (res ())) (cond ((null? lst) (reverse res)) (else (loop... -> (copy x)")
(lint-test "(let loop ((x y)) (if (null? x) () (let ((p (car x))) (cons p (loop (cdr x))))))"
- " loop: perhaps (let loop ((x y)) (if (null? x) () (let ((p (car x))) (cons p (loop (cdr x)))))) -> (copy y)")
+ " loop: perhaps (let loop ((x y)) (if (null? x) () (let ((p (car x))) (cons p (loop (cdr... -> (copy y)")
(lint-test "(if (char=? (str i) #\\]) (set! (str i) #\\)) (if (char=? (str i) #\\[) (set! (str i) #\\()))"
" if: perhaps (if (char=? (str i) #\\]) (set! (str i) #\\)) (if (char=? (str i) #\\[) (set!... ->
@@ -86394,6 +86524,16 @@ etc
" if: perhaps (if (null? (f x)) 0 (if (eof-object? (f x)) (g (f x)) (f x))) -> (case (f x) ((()) 0) ((#<eof>) => g) (else))
if: perhaps use case: (if (eof-object? (f x)) (g (f x)) (f x)) -> (case (f x) ((#<eof>) (g (f x))) (else))")
+ (lint-test "(if z (f y) (f x))" " if: perhaps (if z (f y) (f x)) -> (f (if z y x))")
+ (lint-test "(if z (f y) (g y))" " if: perhaps (if z (f y) (g y)) -> ((if z f g) y)")
+ (lint-test "(if z (f (g y)) (f (h y)))" " if: perhaps (if z (f (g y)) (f (h y))) -> (f ((if z g h) y))")
+ (lint-test "(if z (f (g x)) (f (h x)))" " if: perhaps (if z (f (g x)) (f (h x))) -> (f ((if z g h) x))")
+ (lint-test "(if z (f (h x)) (g (h x)))" " if: perhaps (if z (f (h x)) (g (h x))) -> ((if z f g) (h x))")
+ (lint-test "(if z (f (g (h x))) (f (g (h y))))" " if: perhaps (if z (f (g (h x))) (f (g (h y)))) -> (f (g (h (if z x y))))")
+ (lint-test "(if z (f (g (h x))) (f (g (j x))))" " if: perhaps (if z (f (g (h x))) (f (g (j x)))) -> (f (g ((if z h j) x)))")
+ (lint-test "(if z (f (g (h x))) (f (j (h x))))" " if: perhaps (if z (f (g (h x))) (f (j (h x)))) -> (f ((if z g j) (h x)))")
+ (lint-test "(if z (f (g (h x))) (h (g (h x))))" " if: perhaps (if z (f (g (h x))) (h (g (h x)))) -> ((if z f h) (g (h x)))")
+
(lint-test "(begin (if A (f B) (g C)) (if (and A D) (g Z)) X)"
" begin: perhaps (... (if A (f B) (g C)) (if (and A D) (g Z)) ...) -> (... (if A (begin (f B) (when D (g Z))) (g C)) ...)")
(lint-test "(begin (if A (f B)) (if (and A C) (g D) (h E)) X)" "")
@@ -86459,7 +86599,8 @@ etc
(lint-test "(if A (begin (f x) (g y) (h z)) (begin (f x) (g x) (h z)))"
" if: perhaps (if A (begin (f x) (g y) (h z)) (begin (f x) (g x) (h z))) -> (begin (f x) (g (if A y x)) (h z))")
(lint-test "(if (not x) (display (+ y 1)) (display x))"
- " if: perhaps (if (not x) (display (+ y 1)) (display x)) -> (display (if (not x) (+ y 1) x))")
+ " if: perhaps (if (not x) (display (+ y 1)) (display x)) -> (display (or x (+ y 1)))")
+ (lint-test "(if (not x) (set! y z) (set! y x))" " if: perhaps (if (not x) (set! y z) (set! y x)) -> (set! y (or x z))")
(lint-test "(if a A (if b A (if c A B)))"
" if: perhaps use cond: (if a A (if b A (if c A B))) -> (cond (a A) (b A) (c A) (else B))
if: perhaps (if a A (if b A (if c A B))) -> (if (or a b c) A B)
@@ -86632,7 +86773,7 @@ etc
(lint-test "(cond (t 2))" " cond: odd cond clause test: is t supposed to be #t? (t 2)")
(lint-test "(cond ((memq x '(a b)) => car) ((eq? x 'c) 2))" "") ; this should not got to case because the => operator won't work the same
(lint-test "(cond ((char=? c #\\a) (set! x y)) ((char=? c #\\b) (set! y x)) (else (set! x z)))"
- " cond: perhaps use case instead of cond: (cond ((char=? c #\\a) (set! x y)) ((char=? c #\\b) (set! y x)) (else (set! x z))) ->
+ " cond: perhaps use case instead of cond: (cond ((char=? c #\\a) (set! x y)) ((char=? c #\\b) (set! y x)) (else (set!... ->
(case c ((#\\a) (set! x y)) ((#\\b) (set! y x)) (else (set! x z)))")
(lint-test "(cond ((char-ci=? c #\\a) (set! x y)) ((char=? c #\\b) (set! y x)) (else (set! x z)))"
" cond: perhaps use case instead of cond: (cond ((char-ci=? c #\\a) (set! x y)) ((char=? c #\\b) (set! y x)) (else... ->
@@ -86814,7 +86955,7 @@ etc
" cond: perhaps (cond ((pair? x) 3) ((eq? x 'a) 4) ((eq? x 'b) 5) ((eq? x 'c) 6) (else #f)) ->
(cond ((pair? x) 3) ((assq x '((a . 4) (b . 5) (c . 6))) => cdr) (else #f))")
(lint-test "(cond ((pair? x) 3) ((eq? x 'a) 4) ((eq? x 'b) 5) ((eq? x 'c) 6) ((eq? x 'd) 7))"
- " cond: perhaps (cond ((pair? x) 3) ((eq? x 'a) 4) ((eq? x 'b) 5) ((eq? x 'c) 6) ((eq? x 'd) 7)) ->
+ " cond: perhaps (cond ((pair? x) 3) ((eq? x 'a) 4) ((eq? x 'b) 5) ((eq? x 'c) 6) ((eq? x... ->
(cond ((pair? x) 3) ((assq x '((a . 4) (b . 5) (c . 6) (d . 7))) => cdr))")
(lint-test "(cond ((= i n) #f) ((pred? (vector-ref v i)) #t) (else (loop (+ 1 i))))"
" cond: perhaps (cond ((= i n) #f) ((pred? (vector-ref v i)) #t) (else (loop (+ 1 i)))) ->
@@ -87049,7 +87190,10 @@ etc
(lint-test "(vector-append)" " vector-append: perhaps (vector-append) -> #()")
(lint-test "(vector-append x)" " vector-append: perhaps (vector-append x) -> (copy x)")
- (lint-test "(vector-append #(1 2) (vector-append #(3)))" " vector-append: perhaps (vector-append #(1 2) (vector-append #(3))) -> #(1 2 3)")
+ (lint-test "(vector-append #(1 2) (vector-append #(3)))"
+ " vector-append: perhaps (vector-append #(1 2) (vector-append #(3))) -> #(1 2 3)
+ vector-append: #(1 2) could be #i(1 2)
+ vector-append: #(3) could be #i(3)")
(lint-test "(vector-append x (vector-append y z))" " vector-append: perhaps (vector-append x (vector-append y z)) -> (vector-append x y z)")
(lint-test "(vector-append v1 (apply vector-append vs))"
" vector-append: perhaps (vector-append v1 (apply vector-append vs)) -> (vector-append v1 (apply values vs))")
@@ -87171,10 +87315,10 @@ etc
(lint-test "(append '(1) '(2 3))"
" append: append does not copy its last argument, so (append '(1) '(2 3)) is dangerous
append: perhaps (append '(1) '(2 3)) -> (list 1 2 3)")
- (lint-test "(append '(x) '((+ 1 2) #(0)))"
- " append: append does not copy its last argument, so (append '(x) '((+ 1 2) #(0))) is dangerous
- append: perhaps (append '(x) '((+ 1 2) #(0))) -> (list 'x '(+ 1 2) #(0))")
- ;; (equal? (list 'x '(+ 1 2) #(0)) (append '(x) '((+ 1 2) #(0)))) -> #t
+ (lint-test "(append '(x) '((+ 1 2) #(a)))"
+ " append: append does not copy its last argument, so (append '(x) '((+ 1 2) #(a))) is dangerous
+ append: perhaps (append '(x) '((+ 1 2) #(a))) -> (list 'x '(+ 1 2) #(a))")
+ ;; (equal? (list 'x '(+ 1 2) #(a)) (append '(x) '((+ 1 2) #(a)))) -> #t
(lint-test "(append (list x) (list y z) (list 1))" " append: perhaps (append (list x) (list y z) (list 1)) -> (list x y z 1)")
(lint-test "(append (list x y) '(z))"
" append: append does not copy its last argument, so (append (list x y) '(z)) is dangerous
@@ -87266,16 +87410,26 @@ etc
(lint-test "(define-macro (g x) `(, at x ,y , at z))" " g: perhaps (list-values (apply-values x) y (apply-values z)) -> (append x (cons y z))")
(lint-test "(define-macro (g x) `(, at x , at y ,z))" " g: perhaps (list-values (apply-values x) (apply-values y) z) -> (append x y (list z))")
(lint-test "(define f `((cond . ,forced-indent) (case . ,print-case) (let . ,let-expr)))"
- " f: perhaps (list-values (append (list-values 'cond) forced-indent) (append... -> (list (cons 'cond forced-indent) (cons 'case print-case) ...)")
+ " f: perhaps (list-values (append (list-values 'cond) forced-indent) (append... -> (list (cons 'cond forced-indent) (cons 'case print-case) ...)
+ f: perhaps (append (list 'cond) forced-indent) -> (cons 'cond forced-indent)")
(lint-test "(define f `((cond . ,forced-indent) (let . ,let-expr)))"
- " f: perhaps (list-values (append (list-values 'cond) forced-indent) (append... -> (list (cons 'cond forced-indent) (cons 'let let-expr))")
- (lint-test "(set! x `(f . (,g . 100)))" " set!: perhaps (append (list-values 'f g) 100) -> (cons 'f (cons g 100))")
- (lint-test "(set! x `(f . (g . 100)))" " set!: perhaps (append (list-values 'f 'g) 100) -> (cons 'f (cons 'g 100))")
- (lint-test "(set! x `(f . g))" " set!: perhaps (append (list-values 'f) 'g) -> (cons 'f 'g)")
+ " f: perhaps (list-values (append (list-values 'cond) forced-indent) (append... -> (list (cons 'cond forced-indent) (cons 'let let-expr))
+ f: perhaps (append (list 'cond) forced-indent) -> (cons 'cond forced-indent)")
+ (lint-test "(set! x `(f . (,g . 100)))"
+ " set!: perhaps (append (list 'f g) 100) -> (cons 'f (cons g 100))
+ set!: perhaps (list-values 'f g) -> (list 'f g)")
+ (lint-test "(set! x `(f . (g . 100)))"
+ " set!: perhaps (append (list 'f 'g) 100) -> (cons 'f (cons 'g 100))
+ set!: perhaps (list-values 'f 'g) -> (list 'f 'g)")
+ (lint-test "(set! x `(f . g))"
+ " set!: perhaps (append (list 'f) 'g) -> (cons 'f 'g)
+ set!: perhaps (list-values 'f) -> (list 'f)")
(lint-test "(set! x `((f . (,g . 100)) (f1 . (,g1 . 1001))))"
- " set!: perhaps (list-values (append (list-values 'f g) 100) (append (list-values 'f1 g1) 1001)) -> (list (cons 'f (cons g 100)) (cons 'f1 (cons g1 1001)))")
+ " set!: perhaps (list-values (append (list-values 'f g) 100) (append (list-values 'f1 g1)... -> (list (cons 'f (cons g 100)) (cons 'f1 (cons g1 1001)))
+ set!: perhaps (append (list 'f g) 100) -> (cons 'f (cons g 100))")
(lint-test "(set! x `((f . (g . 100)) (f1 . (g1 . 1001))))"
- " set!: perhaps (list-values (append (list-values 'f 'g) 100) (append (list-values 'f1... -> (list (cons 'f (cons 'g 100)) (cons 'f1 (cons 'g1 1001)))")
+ " set!: perhaps (list-values (append (list-values 'f 'g) 100) (append (list-values 'f1... -> (list (cons 'f (cons 'g 100)) (cons 'f1 (cons 'g1 1001)))
+ set!: perhaps (append (list 'f 'g) 100) -> (cons 'f (cons 'g 100))")
(lint-test "(sort! x abs)" " sort!: abs is a questionable sort! function")
(lint-test "(sort! x (lambda (a b) (< a b)))" " sort!: perhaps (lambda (a b) (< a b)) -> <")
@@ -87504,8 +87658,8 @@ etc
(lint-test "(let ((x (undo-edit))) (set! y (or y x)))"
" let: perhaps, ignoring short-circuit issues, (let ((x (undo-edit))) (set! y (or y x))) -> (set! y (or y (undo-edit)))
let: perhaps (set! y (or y x)) -> (if (not y) (set! y x))")
- (lint-test "(let ((x #(0 0))) (fill! x 1) (f x (x 1)))"
- " let: perhaps (let ((x #(0 0))) (fill! x 1) (f x (x 1))) -> (let ((x #(1 1))) (f x (x 1)))")
+ (lint-test "(let ((x #(0 a))) (fill! x 1) (f x (x 1)))"
+ " let: perhaps (let ((x #(0 a))) (fill! x 1) (f x (x 1))) -> (let ((x #(1 1))) (f x (x 1)))")
(lint-test "(let ((x (make-vector 3))) (fill! x 1) (f x (x 1)))"
" let: perhaps (let ((x (make-vector 3))) (fill! x 1) (f x (x 1))) -> (let ((x (make-vector 3 1))) (f x (x 1)))")
(lint-test "(let ((x (make-list 3 9))) (fill! x 1) (f x (x 1)))"
@@ -87710,8 +87864,8 @@ etc
(lint-test "(eq? x 1.5)" " eq?: eq? should be eqv? in (eq? x 1.5)")
(lint-test "(eq? 3 x)" " eq?: eq? should be eqv? in (eq? 3 x)")
(lint-test "(eq? x (not x))" " eq?: this looks odd: (eq? x (not x))")
- (lint-test "(eq? #(0) #(0))"
- " eq?: this looks odd: (eq? #(0) #(0)) eq?: perhaps (eq? #(0) #(0)) -> #f eq?: eq? should be equal? in (eq? #(0) #(0))")
+ (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 "(eqv? x #())" " eqv?: eqv? should be equal? in (eqv? x #())")
(lint-test "(eq? x \"\")" " eq?: eq? should be equal? in (eq? x \"\")")
@@ -87726,7 +87880,7 @@ etc
(lint-test "(eq? x '#\\a)" " eq?: eq? should be eqv? in (eq? x '#\\a) eq?: quote is not needed here: '#\\a")
(lint-test "(eqv? x ())" " eqv?: eqv? could be null?: (eqv? x ()) -> (null? x)")
(lint-test "(eqv? x '())" " eqv?: eqv? could be null?: (eqv? x '()) -> (null? x) eqv?: quote is not needed here: '()")
- (lint-test "(eqv? x #(0))" " eqv?: eqv? should be equal? in (eqv? x #(0))")
+ (lint-test "(eqv? x #(a))" " eqv?: eqv? should be equal? in (eqv? x #(a))")
(lint-test "(eqv? x 'a)" " eqv?: eqv? could be eq? in (eqv? x 'a)")
(lint-test "(eqv? x #f)" " eqv?: eqv? could be not: (eqv? x #f) -> (not x)")
(lint-test "(equal? x 'a)" " equal?: equal? could be eq? in (equal? x 'a)")
@@ -87758,7 +87912,8 @@ etc
(lint-test "(map (lambda (a) (abs a)) '(1 2 3))" " map: perhaps (lambda (a) (abs a)) -> abs")
(lint-test "(map abs (vector->list #(1 2)))"
" map: (vector->list #(1 2)) could be simplified to: #(1 2) ; (map accepts non-list sequences)
- map: perhaps (vector->list #(1 2)) -> '(1 2)")
+ map: perhaps (vector->list #(1 2)) -> '(1 2)
+ map: #(1 2) could be #i(1 2)")
(lint-test "(begin (map g123 x) x)" " begin: map could be for-each: (for-each g123 x)")
(lint-test "(map log x x)" "")
(lint-test "(map f (map g h))" " map: perhaps (map f (map g h)) -> (map (lambda (_1_) (f (g _1_))) h)")
@@ -87805,24 +87960,25 @@ etc
for-each: quote is not needed here: '()")
(lint-test "(for-each fxy #())" " for-each: this (for-each fxy #()) has no effect (zero length arg)")
(lint-test "(map car (list (cons a b)))" " map: perhaps (map car (list (cons a b))) -> (list (car (cons a b)))")
- (lint-test "(map abs #(1))" " map: perhaps (map abs #(1)) -> (list (abs 1))")
+ (lint-test "(map abs #(1))" " map: perhaps (map abs #(1)) -> (list (abs 1)) map: #(1) could be #i(1)")
- (lint-test "(catch #(0) (lambda () #f) (lambda a a))" " catch: catch tag #(0) is unreliable (catch uses eq? to match tags)")
+ (lint-test "(catch #(a) (lambda () #f) (lambda a a))" " catch: catch tag #(a) is unreliable (catch uses eq? to match tags)")
(lint-test "(catch x (lambda () #f) (lambda a a))" "")
(lint-test "(catch 'hi x y)" "")
- (lint-test "(car #(0))" " car: in (car #(0)), car's argument should be a pair, but #(0) is a vector?")
- (lint-test "(vector->list 1.4)" " vector->list: in (vector->list 1.4), vector->list's argument should be a vector, but 1.4 is real?")
- (lint-test "(vector-set! #(0 1) 0 2)" " vector-set!: #(0 1) is a constant that is discarded; perhaps (vector-set! #(0 1) 0 2) -> 2")
+ (lint-test "(car #(a))" " car: in (car #(a)), car's argument should be a pair, but #(a) is a vector?")
+ (lint-test "(vector->list 1.4)" " vector->list: in (vector->list 1.4), vector->list's argument should be a vector, but 1.4 is a float?")
+ (lint-test "(vector-set! #(0 a) 0 2)"
+ " vector-set!: #(0 a) is a constant, so vector-set! is problematic, and #(0 a) is discarded; perhaps (vector-set! #(0 a) 0 2) -> 2")
(lint-test "(list-set! (list 0 1) 0 2)" " list-set!: (list 0 1) is simply discarded; perhaps (list-set! (list 0 1) 0 2) -> 2")
(lint-test "(string-set! (make-string 3) 0 #\\a)"
" string-set!: (make-string 3) is simply discarded; perhaps (string-set! (make-string 3) 0 #\\a) -> #\\a")
(lint-test "(let ((x '(0 1))) (list-set! x 0 3.1))"
"let: perhaps (let ((x '(0 1))) (list-set! x 0 3.1)) -> (list-set! '(0 1) 0 3.1)
let: x's value, '(0 1), is a literal constant, so this set! is trouble: (list-set! x 0 3.1)")
- (lint-test "(let ((c #(0 1))) (vector-set! c 0 1))"
- "let: perhaps (let ((c #(0 1))) (vector-set! c 0 1)) -> (vector-set! #(0 1) 0 1)
- let: c's value, #(0 1), is a literal constant, so this set! is trouble: (vector-set! c 0 1)")
+ (lint-test "(let ((c #(0 a))) (vector-set! c 0 1))"
+ "let: perhaps (let ((c #(0 a))) (vector-set! c 0 1)) -> (vector-set! #(0 a) 0 1)
+ let: c's value, #(0 a), is a literal constant, so this set! is trouble: (vector-set! c 0 1)")
(lint-test "(let ((x (vector 0 1))) (vector-set! x 0 1))"
" let: perhaps (let ((x (vector 0 1))) (vector-set! x 0 1)) -> (vector-set! (vector 0 1) 0 1)")
(lint-test "(let ((x (vector 0 1))) (string-set! x 0 #\\a))"
@@ -87846,7 +88002,7 @@ etc
(lint-test "(set! a b c)" " set!: set! has too many arguments: (set! a b c)")
(lint-test "(set! a)" " set!: set! has too few arguments: (set! a)")
- (lint-test "(set! (vector-ref v 0) 3)" " set!: vector-ref as target of set! (set! (vector-ref v 0) 3)")
+ (lint-test "(set! (vector-ref v 0) 3)" " set!: perhaps (set! (vector-ref v 0) 3) -> (vector-set! v 0 3)")
(lint-test "(set! pi 3)" " set!: can't set! (set! pi 3) (it is a constant)")
(lint-test "(set! if 3)" " set!: bad idea: (set! if 3)")
(lint-test "(set! abs 3)" " set!: not recommended: (set! abs 3)")
@@ -87872,7 +88028,7 @@ etc
(lint-test "(quote 3)" " quote: quote is not needed here: '3")
(lint-test "(quote . 3)" " quote: stray dot in quote's arguments? (quote . 3)")
(lint-test "(quote 3 4)" " quote: quote has too many arguments: (quote 3 4)")
- (lint-test "'#(0)" " quote: quote is not needed here: '#(0)")
+ (lint-test "'#(a)" " quote: quote is not needed here: '#(a)")
(lint-test "(let () (when a (+ x 1)) y)"
" let: let could be begin: (let () (when a (+ x 1)) y) -> (begin (when a (+ x 1)) y)
@@ -87900,7 +88056,7 @@ etc
(lint-test "(let () (do ((i 0 (+ i 1))) ((= i 1))) x)"
" let: let could be begin: (let () (do ((i 0 (+ i 1))) ((= i 1))) x) -> (begin (do ((i 0 (+ i 1))) ((= i 1))) x)
let: this could be omitted: (do ((i 0 (+ i 1))) ((= i 1)))
- let: this do-loop could be replaced by (): (do ((i 0 (+ i 1))) ((= i 1)))")
+ let: this do-loop could probably be replaced by the end test in a let: (do ((i 0 (+ i 1))) ((= i 1)))")
(lint-test "(let () (write-byte i) (write-byte i) (write-byte i) (write-byte i) (write-byte i) (newline))"
" let: let could be begin: (let () (write-byte i) (write-byte i) (write-byte i) (write-byte i)... ->
(begin (write-byte i) (write-byte i) (write-byte i) (write-byte i)...
@@ -87939,9 +88095,9 @@ etc
(lint-test "(case x ((0)))" "") ; result can be null
(lint-test "(case x ((0) 1) ((1) 2) ((3 0) 4))" " case: repeated case key 0 in ((3 0) 4)")
(lint-test "(case x ((0) 1) ((1) 2) ((3 . 0) 4))" " case: stray dot in case case key list: ((3 . 0) 4)")
- (lint-test "(case x ((#(0)) 2))"
- " case: perhaps (case x ((#(0)) 2)) -> (if (eqv? x #(0)) 2)
- case: case key #(0) in ((#(0)) 2) is unlikely to work (case uses eqv? but it is a vector)")
+ (lint-test "(case x ((#(a)) 2))"
+ " case: perhaps (case x ((#(a)) 2)) -> (if (eqv? x #(a)) 2)
+ case: case key #(a) in ((#(a)) 2) is unlikely to work (case uses eqv? but it is a vector)")
(lint-test "(case x (else 2) ((0) 1))" " case: case else clause is not the last: ((else 2) ((0) 1))")
(lint-test "(case x ((0) 32) (else 32))" " case: perhaps (case x ((0) 32) (else 32)) -> 32")
(lint-test "(case (string->symbol x) ((a) 1) ((2 3) 3))" " case: case key 2 in ((2 3) 3) is pointless case: case key 3 in ((2 3) 3) is pointless")
@@ -88062,9 +88218,9 @@ etc
(case y ... ((C D) => (let ((x 2)) (lambda (m) (+ m x)))) ...)")
(lint-test "(do ())" " do: do is messed up: (do ())")
- (lint-test "(do () ())" " do: this do-loop could be replaced by (): (do () ())")
+ (lint-test "(do () ())" "") ; ??
(lint-test "(do ((x 2) y) ())" " do: do binding is not a list? y do: x not used, initially: 2 from do")
- (lint-test "(do ((x 2 1)) () x)" " do: this do-loop could be replaced by (): (do ((x 2 1)) () x) do: this could be omitted: x")
+ (lint-test "(do ((x 2 1)) () x)" " do: this could be omitted: x")
(lint-test "(do ((x 2 1)) () (display 1))" " do: x set, but not used: 2 from do")
(lint-test "(do ((x 2)) () (display 1))" " do: x not used, initially: 2 from do")
(lint-test "(do ((i 0 (+ i 1))) ((+ i 10) i))" " do: end test is never false: (+ i 10)")
@@ -88103,11 +88259,17 @@ etc
(lint-test "(do ((p (list 1) (cdr p))) ((null? p)) (set! y (log z 2)) (do ((z z (+ z 1))) ((= z 0)) (display z)) (display x))"
" do: perhaps (do ((p (list 1) (cdr p))) ((null? p)) (set! y (log z 2)) (do ((z z (+ z... ->
(for-each (lambda ([p]) (set! y (log z 2)) (do ((z z (+ z 1))) ((= z 0)) (display z)) (display x)) (list 1))")
- (lint-test "(do ((i 0 (+ i 1))) ((= i 3) ()) (display i))" " do: nil return value is redundant: ((= i 3) ())")
+ (lint-test "(do ((i 0 (+ i 1))) ((= i 3) ()) (display i))" "")
(lint-test "(do ((x y (cdr x))) ((null? x)) (let ((y x)) (car y)))"
- " do: this do-loop could be replaced by (): (do ((x y (cdr x))) ((null? x)) (let ((y x)) (car y)))
+ " do: this do-loop could probably be replaced by the end test in a let: (do ((x y (cdr x))) ((null? x)) (let ((y x)) (car y)))
do: this could be omitted: (let ((y x)) (car y)) do: perhaps (let ((y x)) (car y)) -> (car x)
do: assuming we see all set!s, the binding (y x) is pointless: perhaps (let ((y x)) (car y)) -> (car x)")
+ (lint-test "(do ((i 0 (+ i 1))) ((= i 3) ()))" " do: this do-loop could be replaced by (): (do ((i 0 (+ i 1))) ((= i 3) ()))")
+ (lint-test "(do ((i 0 (+ i 1))) ((= i 3) #t))"
+ " do: this do-loop could be replaced by #t: (do ((i 0 (+ i 1))) ((= i 3) #t))
+ do: return value is redundant: ((= i 3) #t)")
+ (lint-test "(do ((i 0 (+ i 1))) ((vector-ref v i) (vector-ref v i)))" " do: return value is redundant: ((vector-ref v i) (vector-ref v i))")
+ (lint-test "(do ((i 0 (+ i 1))) ((= i 3) (not (= i 3))) (display i))" " do: perhaps use => here: ((= i 3) (not (= i 3))) -> ((= i 3) => not)")
(lint-test "(begin (do ((i 0 (+ i 1))) ((= i 3)) (display i)) 32)"
" begin: perhaps (begin (do ((i 0 (+ i 1))) ((= i 3)) (display i)) 32) -> (do ((i 0 (+ i 1))) ((= i 3) 32) (display i))")
@@ -88139,9 +88301,18 @@ etc
(lint-test "(do ((i 0 j) (j 0 (+ j 1))) ((= i 2)) (display i))"
" do: perhaps (do ((i 0 j) (j 0 (+ j 1))) ((= i 2)) (display i)) ->
(do ((i 0) (j 0 (+ j 1))) ((= i 2)) (display i) (set! i j))")
+ (lint-test "(do ((i 0 (+ i 1)) (j 1)) ((= i 3)) (display (+ i j)) (set! j (+ j 1)))"
+ " do: perhaps move (set! j (+ j 1)) to j's step expression: (j 1 (+ j 1))")
+ (lint-test "(do ((i 0 (+ i 1)) (j 1)) ((= i 3)) (display (+ i j)) (set! j (+ j i)))" "")
+ (lint-test "(do ((i 0 (+ i 1)) (j 1 (+ j 1))) ((= i 3)) (display (+ i j)) (set! j (+ j 1)))"
+ " do: perhaps move (set! j (+ j 1)) to j's step expression: (j 1 (+ 2 j))")
+ (lint-test "(do ((i 0 (+ i 1)) (j 1 0)) ((= i 3)) (display (+ i j)) (set! j (+ j i)))"
+ " do: this set! is pointless: (set! j (+ j i))")
+ (lint-test "(do ((i 0 (+ i 1)) (j 1 0)) ((= i 3)) (display (+ i j)) (set! j (display (+ j i))))"
+ " do: this set! is pointless: (set! j (display (+ j i))); perhaps replace it with (display (+ j i))")
(lint-test "(do ((i 0 (+ i j)) (j 0 (+ k 1)) (k 1)) ((= i 10)) (display (+ i j k)))"
" do: perhaps (do ((i 0 (+ i j)) (j 0 (+ k 1)) (k 1)) ((= i 10)) (display (+ i j k))) ->
- (do ((i 0) (j 0 (+ k 1)) (k 1)) ((= i 10)) (display (+ i j k)) (set! i (+ i j)))")
+ (do ((i 0) (j 0) (k 1)) ((= i 10)) (display (+ i j k)) (set! i (+ i j)) (set! j (+ k 1)))")
(lint-test "(do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 4)) (display (+ i j)))"
" do: this do loop is unreadable; perhaps (do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 4)) (display (+ i j))) ->
(let _1_ ((i 0)
@@ -88176,6 +88347,9 @@ etc
" do: perhaps (let ((a 12)) (set! a (+ a i)) (display a)) -> (let ((a (+ 12 i))) (display a))
do: perhaps (do () ((= i 3)) (let ((a 12)) (set! a (+ a i)) (display a))) ->
(do ((a 12 12)) ((= i 3)) (set! a (+ a i)) ...)")
+ (lint-test "(do ((i 0 (+ i 1))) ((= i 3)) (let ((j (abs x))) (display (+ i j (* 2 j)))))"
+ " do: perhaps (do ((i 0 (+ i 1))) ((= i 3)) (let ((j (abs x))) (display (+ i j (* 2 j))))) ->
+ (do ((i 0 (+ i 1)) (j (abs x) (abs x))) ((= i 3)) (display (+ i j (* 2 j))))")
(lint-test "(do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12) (b 1)) (set! a (+ a b i)) (display a)))"
" do: perhaps combine these two lines: (set! a (+ a b i)) (display a)
do: perhaps (do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12) (b 1)) (set! a (+ a b i))... ->
@@ -88225,6 +88399,10 @@ etc
(for-each (lambda ([v]) (let ((x [v])) (f (car x) (cdr x)))) v)
let: perhaps (let ((n (length v))) (do ((j 0 (+ j 1))) ((= j n)) (let ((x (vector-ref v... ->
(do ((n (length v)) (j 0 (+ j 1))) ...)")
+ (lint-test "(do ((dist 0.01) (i 0 (+ i 1)) (beg2 (+ beg 2.36) (+ beg2 dist)) (af .1 (* af .85))) ((= i 20)) (savannah-8 beg2 (* amp af)) (set! dist (+ dist .001)))"
+ " do: perhaps (do ((dist 0.01) (i 0 (+ i 1)) (beg2 (+ beg 2.36) (+ beg2 dist)) (af 0.1... ->
+ (do ((dist 0.01) (i 0 (+ i 1)) (beg2 (+ beg 2.36)) (af 0.1 (* af 0.85))) ((= i 20))
+ (savannah-8 beg2 (* amp af)) (set! dist (+ dist 0.001)) (set! beg2 (+ beg2 dist)))")
(lint-test "(let ((x (f y))) (display x) (define z (f x)) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ x z i))))"
" let: the scope of z could be reduced: (... (define z (f x)) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ x z i)))) ->
@@ -88380,6 +88558,10 @@ etc
(lint-test "(let ((old-p (*s7* 'print-length))) (set! (*s7* 'print-length) 32) (display x) (set! (*s7* 'print-length) old-p))"
" let: perhaps use let-temporarily here: (let ((old-p (*s7* 'print-length))) (set! (*s7* 'print-length) 32)... ->
(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 "(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)))))... ->
@@ -88415,9 +88597,8 @@ etc
(lint-test "(let* ((x 1) (a 1)) (display (f x)) (let ((b 2)) (display (+ a b))) (display c))"
" let*: let* could be let: (let* ((x 1) (a 1)) (display (f x)) (let ((b 2)) (display (+ a b)))...
let*: perhaps (let ((b 2)) (display (+ a b))) -> (display (+ a 2))
- let*: perhaps move 'a into the inner let:
- (let* ((x 1) (a 1)) (display (f x)) (let ((b 2)) (display (+ a b))) (display c)) ->
- (let ((a 1) (b 2)) (display (+ a b)))")
+ let*: perhaps move 'a into the inner let: (let* ((x 1) (a 1)) (display (f x)) (let ((b 2)) (display (+ a b)))... ->
+ (let ((a 1) (b 2)) (display (+ a b)))")
(lint-test "(lambda () (let ((a 1)) (define (f211 x) (+ x 1)) (display a) (let ((b 2)) (display (f211 (+ a b))))))"
" 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 () ...))
@@ -88430,9 +88611,7 @@ etc
(lint-test "(lambda* ((a 1)) (define f213 (lambda (x) (+ x 1))) (let () (display a) (let ((b 2)) (display (f213 (+ a b))))))"
" lambda*: the inner function f213 could be moved outside the lambda*: (lambda* ((a 1)) (define f213 (lambda (x) (+ x 1))) (let () (display a)... ->
(let () (define f213 (lambda (x) (+ x 1))) (lambda* ((a 1)) ...))
- lambda*: pointless let: (let () (display a) (let ((b 2)) (display (f213 (+ a b)))))
- lambda*: perhaps move 'f213 into the inner let: (lambda* ((a 1)) (define f213 (lambda (x) (+ x 1))) (let () (display a)... ->
- (let ((f213 (lambda (x) (+ x 1))) (b 2)) (display (f213 (+ a b))))")
+ lambda*: pointless let: (let () (display a) (let ((b 2)) (display (f213 (+ a b)))))")
(lint-test "(let ((a 1)) (let ((f214 (lambda (x) (+ x 1))) (f22 (lambda (x) (+ x 2)))) (* a (f214 1) (f22 2))))"
" let: perhaps move 'a into the inner let: (let ((a 1)) (let ((f214 (lambda (x) (+ x 1))) (f22 (lambda (x) (+ x 2))))... ->
(let ((a 1) (f214 (lambda (x) (+ x 1))) (f22 (lambda (x) (+ x 2)))) (* a...")
@@ -88566,7 +88745,7 @@ etc
(let* ((a (log b)) (z (log w))) (do ((x (log z))) ...))")
(lint-test "(let* ((a 1) (b (f a)) (c 2) (e 0) (d (g (+ a b c)))) (display d) (* a b c d e))"
- " let*: perhaps split this let*: (let* ((a 1) (b (f a)) (c 2) (e 0) (d (g (+ a b c)))) (display d) (* a b c d e)) ->
+ " let*: perhaps split this let*: (let* ((a 1) (b (f a)) (c 2) (e 0) (d (g (+ a b c)))) (display d) (* a b c... ->
(let ((a 1) (c 2) (e 0)) (let* ((b (f a)) (d (g (+ a b c)))) ...))")
(lint-test "(let* ((a 1) (b (f a)) (c 2) (d (g (+ a b c))) (e (+ d 1))) (display d) (* a b c d e))"
" let*: perhaps split this let*: (let* ((a 1) (b (f a)) (c 2) (d (g (+ a b c))) (e (+ d 1))) (display d) (*... ->
@@ -88578,7 +88757,8 @@ etc
" let*: perhaps split this let*: (let* ((a 1) (b (f a)) (d (g (+ a b c))) (e (+ d 1)) (f (+ d 2))) (display... ->
(let* ((a 1) (b (f a)) (d (g (+ a b c)))) (let ((e (+ d 1)) (f (+ d 2))) ...))")
(lint-test "(let* ((a 1) (b (f a)) (d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* a b d e f))"
- " let*: perhaps split this let*: (let* ((a 1) (b (f a)) (d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* a b d e f)) ->
+ " let*: perhaps split this let*:
+ (let* ((a 1) (b (f a)) (d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* a b d... ->
(let ((a 1) (d 3)) (let ((b (f a))) (let ((e (+ d 1)) (f (+ d 2))) ...)))")
(lint-test "(let* ((a 1) (d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* a d e f))"
" let*: perhaps split this let*: (let* ((a 1) (d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* a d e f)) ->
@@ -88698,10 +88878,7 @@ etc
(lint-test "(for-each (lambda (x) (newline port) (write-char x port)) args)"
" for-each: perhaps (for-each (lambda (x) (newline port) (write-char x port)) args) -> (format port \"~{~%~C~}\" args)")
(lint-test "(for-each (lambda (x) (newline port) (display (number->string x 16) port)) args)"
- " for-each: perhaps (for-each (lambda (x) (newline port) (display (number->string x 16) port)) args) -> (format port \"~{~%~X~}\" args)")
- (lint-test "(if (pair? x) (for-each display x))"
- " if: perhaps (for-each display x) -> (format () \"~{~A~}\" x)")
-
+ " for-each: perhaps (for-each (lambda (x) (newline port) (display (number->string x 16) port))... -> (format port \"~{~%~X~}\" args)")
(lint-test "(values 1)" " values: perhaps (values 1) -> 1")
(lint-test "(call-with-values p c)" " call-with-values: perhaps (call-with-values p c) -> (c (p))")
(lint-test "(call-with-values log c)" " call-with-values: log does not return multiple values")
@@ -88885,7 +89062,8 @@ etc
(lint-test "(vector (car x) (car x) (car x) (car x))" " vector: perhaps (vector (car x) (car x) (car x) (car x)) -> (make-vector 4 (car x))")
(lint-test "(vector #(1 2) #(1 2) #(1 2) #(1 2))"
" vector: perhaps (vector #(1 2) #(1 2) #(1 2) #(1 2)) -> (make-vector 4 #(1 2))
- or wrap (copy #(1 2)) in a function and call that 4 times")
+ or wrap (copy #(1 2)) in a function and call that 4 times
+ vector: #(1 2) could be #i(1 2) vector: #(1 2) could be #i(1 2) vector: #(1 2) could be #i(1 2) vector: #(1 2) could be #i(1 2)")
(lint-test "((list 1 2 3) x)" " (list 1 2 3): perhaps use vector here: ((list 1 2 3) x)")
(lint-test "(int-vector 0 0 0 0)" " int-vector: perhaps (int-vector 0 0 0 0) -> (make-int-vector 4)")
(lint-test "(unless x)" " unless: unless is messed up: (unless x)")
@@ -88930,8 +89108,8 @@ etc
" or: perhaps (or (eq? x 'a) (eq? x 'b) (eq? x 'c)) -> (memq x '(a b c))")
(lint-test "(or (= x 1) (= x 2) (= x 3))"
" or: perhaps (or (= x 1) (= x 2) (= x 3)) -> (member x '(1 2 3) =)")
- (lint-test "(or (equal? x #()) (equal? x #(1)))"
- " or: perhaps (or (equal? x #()) (equal? x #(1))) -> (member x '(#() #(1)))")
+ (lint-test "(or (equal? x #()) (equal? x #(a)))"
+ " or: perhaps (or (equal? x #()) (equal? x #(a))) -> (member x '(#() #(a)))")
(lint-test "(or (string=? x \"a\") (string=? x \"b\"))"
" or: perhaps (or (string=? x \"a\") (string=? x \"b\")) -> (member x '(\"a\" \"b\") string=?)")
(lint-test "(or (char=? (cadr x) #\\a) (char=? (cadr x) #\\b))"
@@ -89290,6 +89468,16 @@ etc
(lint-test "(cadr (cddr (cdddr x)))" " cadr: perhaps (cadr (cddr (cdddr x))) -> (list-ref x 6)")
(lint-test "(cadr (cddr (cdddr (cdr x))))" " cadr: perhaps (cadr (cddr (cdddr (cdr x)))) -> (list-ref x 7)")
(lint-test "(cddddr (cdddr (cddddr x)))" " cddddr: perhaps (cddddr (cdddr (cddddr x))) -> (list-tail x 11)")
+ (lint-test "(car (caddr x))" " car: perhaps (car (caddr x)) -> (caaddr x)")
+ (lint-test "(cdr (caadr x))" " cdr: perhaps (cdr (caadr x)) -> (cdaadr x)")
+ (lint-test "(car (cadddr x))" "")
+ (lint-test "(cdr (caaddr x))" "")
+ (lint-test "(cadr (cddr x))" " cadr: perhaps (cadr (cddr x)) -> (cadddr x)")
+ (lint-test "(cddr (cadr x))" " cddr: perhaps (cddr (cadr x)) -> (cddadr x)")
+ (lint-test "(caddr (cddr x))" " caddr: perhaps (caddr (cddr x)) -> (list-ref x 4)")
+ (lint-test "(cdddr (cadr x))" "")
+ (lint-test "(caddr (cdr x))" " caddr: perhaps (caddr (cdr x)) -> (cadddr x)")
+ (lint-test "(cdddr (car x))" " cdddr: perhaps (cdddr (car x)) -> (cdddar x)")
(lint-test "(let ((x 3) (y 5)) (set! x (+ x y)) (+ x y))" " let: set! returns the new value, so this could be omitted: (+ x y)")
(lint-test "(let ((x 3)) (set! x (+ x 1)) x)"
@@ -89433,6 +89621,7 @@ etc
(lint-test "(let ((v (vector 1 2 3))) (apply v (make-list 1 0)))" ; don't complain here that v is not a procedure!
" let: perhaps (let ((v (vector 1 2 3))) (apply v (make-list 1 0))) -> (apply (vector 1 2 3) (make-list 1 0))")
(lint-test "(apply (lambda (x) (+ x 1)) y ())" " apply: perhaps (apply (lambda (x) (+ x 1)) y ()) -> ((lambda (x) (+ x 1)) y)")
+ (lint-test "(apply append (map list x))" " apply: perhaps (apply append (map list x)) -> x")
(lint-test "(eval '(+ 1 2))" " eval: perhaps (eval '(+ 1 2)) -> (+ 1 2)")
(lint-test "(eval 32)" " eval: this eval is pointless; perhaps (eval 32) -> 32")
@@ -89469,10 +89658,10 @@ etc
(lint-test "(let ((v (make-vector 3))) (vector-set! v 3.14 #\\a))"
"let: perhaps (let ((v (make-vector 3))) (vector-set! v 3.14 #\\a)) -> (vector-set! (make-vector 3) 3.14 #\\a)
- let: in (vector-set! v 3.14 #\\a), vector-set!'s argument 2 should be an integer, but 3.14 is real?")
+ let: in (vector-set! v 3.14 #\\a), vector-set!'s argument 2 should be an integer, but 3.14 is a float?")
(lint-test "(let ((v (make-float-vector 3))) (float-vector-set! v 3.14 1))"
"let: perhaps (let ((v (make-float-vector 3))) (float-vector-set! v 3.14 1)) -> (float-vector-set! (make-float-vector 3) 3.14 1)
- let: in (float-vector-set! v 3.14 1), float-vector-set!'s argument 2 should be an integer, but 3.14 is real?")
+ let: in (float-vector-set! v 3.14 1), float-vector-set!'s argument 2 should be an integer, but 3.14 is a float?")
(lint-test "(let ((v (make-float-vector 3))) (float-vector-set! v 1 3.14))"
"let: perhaps (let ((v (make-float-vector 3))) (float-vector-set! v 1 3.14)) -> (float-vector-set! (make-float-vector 3) 1 3.14)")
(lint-test "(let ((v (make-float-vector 3))) (float-vector-set! v 1 #\\a))"
@@ -89481,6 +89670,53 @@ etc
(lint-test "(vector-set! (vector-ref a i) j x)" " vector-set!: perhaps (vector-set! (vector-ref a i) j x) -> (set! (a i j) x)")
(lint-test "(vector-set! (vector-copy doc) i newval)"
" vector-set!: (vector-copy doc) is simply discarded; perhaps (vector-set! (vector-copy doc) i newval) -> newval")
+
+ (lint-test "(reverse! #i(1 2))"
+ " reverse!: perhaps (reverse! #i(2 1)) -> #i(2 1)
+ reverse!: #i(2 1) is a constant, so (reverse! #i(2 1)) is problematic")
+ (lint-test "(sort! #r(0 1 2) <)" " sort!: #r(0.0 1.0 2.0) is a constant, so (sort! #r(0.0 1.0 2.0) <) is problematic")
+ (lint-test "(string-fill! \"123\" #\\c)" " string-fill!: 123 is a constant, so (string-fill! \"123\" #\\c) is problematic")
+ (lint-test "(list-fill! '(1 2 3) 1)" " list-fill!: '(1 2 3) is a constant, so (list-fill! '(1 2 3) 1) is problematic")
+ (lint-test "(vector-fill! #(0 a) 2)" " vector-fill!: #(0 a) is a constant, so (vector-fill! #(0 a) 2) is problematic")
+ (lint-test "(fill! #r(0 1 2) <)" " fill!: #r(0.0 1.0 2.0) is a constant, so (fill! #r(0.0 1.0 2.0) <) is problematic")
+ (lint-test "(set-car! '(1 2) 3)" " set-car!: '(1 2) is a constant, so (set-car! '(1 2) 3) is problematic")
+ (lint-test "(set-cdr! '(1 2) 3)" " set-cdr!: '(1 2) is a constant, so (set-cdr! '(1 2) 3) is problematic")
+ (lint-test "(let ((x #r(1 2))) (vector-set! x 0 1))"
+ " let: perhaps (let ((x #r(1.0 2.0))) (vector-set! x 0 1)) -> (vector-set! #r(1.0 2.0) 0 1)
+ let: x's value, #r(1.0 2.0), is a literal constant, so this set! is trouble: (vector-set! x 0 1)
+ let: x is a float-vector, so perhaps use float-vector-set!, not vector-set!")
+ (lint-test "(int-vector-set! #i(0 1) 0 1)"
+ " int-vector-set!: #i(0 1) is a constant, so int-vector-set! is problematic, and #i(0 1) is discarded; perhaps (int-vector-set! #i(0 1) 0 1) -> 1")
+ (lint-test "(float-vector-set! #r(0 1) 0 1)"
+ " float-vector-set!: #r(0.0 1.0) is a constant, so float-vector-set! is problematic, and #r(0.0 1.0) is discarded; perhaps (float-vector-set! #r(0.0 1.0) 0 1) -> 1")
+ (lint-test "(list-set! '(1 2) 0 1)"
+ " list-set!: '(1 2) is a constant, so list-set! is problematic, and '(1 2) is discarded; perhaps (list-set! '(1 2) 0 1) -> 1")
+ (lint-test "(string-set! \"123\" 0 #\\c)"
+ " string-set!: \"123\" is a constant, so string-set! is problematic, and \"123\" is discarded; perhaps (string-set! \"123\" 0 #\\c) -> #\\c")
+ (lint-test "(vector-set! #(1 2) 0 32)"
+ " vector-set!: #(1 2) is a constant, so vector-set! is problematic, and #(1 2) is discarded; perhaps (vector-set! #(1 2) 0 32) -> 32
+ vector-set!: #(1 2) could be #i(1 2)")
+ (lint-test "(int-vector-set! #r(0 1) 0 1)"
+ " int-vector-set!: in (int-vector-set! #r(0.0 1.0) 0 1),
+ int-vector-set!'s argument 1 should be an int-vector, but #r(0.0 1.0) is a float-vector?
+ int-vector-set!: #r(0.0 1.0) is a constant, so int-vector-set! is problematic, and #r(0.0 1.0) is discarded; perhaps (int-vector-set! #r(0.0 1.0) 0 1) -> 1")
+ (lint-test "(float-vector-set! #i(0 1) 0 1)"
+ " float-vector-set!: in (float-vector-set! #i(0 1) 0 1),
+ float-vector-set!'s argument 1 should be a float-vector, but #i(0 1) is an int-vector?
+ float-vector-set!: #i(0 1) is a constant, so float-vector-set! is problematic, and #i(0 1) is discarded; perhaps (float-vector-set! #i(0 1) 0 1) -> 1")
+ (lint-test "(float-vector-set! #(0 1) 0 1)"
+ " float-vector-set!: in (float-vector-set! #(0 1) 0 1),
+ float-vector-set!'s argument 1 should be a float-vector, but #(0 1) is a vector?
+ float-vector-set!: #(0 1) is a constant, so float-vector-set! is problematic, and #(0 1) is discarded; perhaps (float-vector-set! #(0 1) 0 1) -> 1
+ float-vector-set!: #(0 1) could be #i(0 1)")
+ (lint-test "(vector-set! (make-vector 1) 0 1)"
+ " vector-set!: (make-vector 1) is simply discarded; perhaps (vector-set! (make-vector 1) 0 1) -> 1")
+ (lint-test "(vector-set! #(0) 1 2)" " vector-set!: index 1 is too large in (vector-set! #(0) 1 2) vector-set!: #(0) could be #i(0)")
+ (lint-test "(int-vector-set! (float-vector 0 1) 0 1)"
+ " int-vector-set!: in (int-vector-set! (float-vector 0 1) 0 1), int-vector-set!'s argument 1 should be an int-vector, but (float-vector 0 1) is a float-vector?
+ int-vector-set!: (float-vector 0 1) is simply discarded; perhaps (int-vector-set! (float-vector 0 1) 0 1) -> 1")
+ (lint-test "(set! (#(1 a) 0) 32)" " set!: #(1 a) is a constant so (set! (#(1 a) 0) 32) is problematic")
+
(lint-test "(string-downcase \"SPEAK SOFTLY\")" " string-downcase: perhaps (string-downcase \"SPEAK SOFTLY\") -> \"speak softly\"")
(lint-test "(vector-length (copy arr))" " vector-length: perhaps (vector-length (copy arr)) -> (vector-length arr)")
(lint-test "(vector-length (copy src dest))" " vector-length: perhaps (vector-length (copy src dest)) -> (vector-length dest)")
@@ -89562,9 +89798,7 @@ etc
(lint-test "(and (symbol? x) (gensym? x))" " and: perhaps (and (symbol? x) (gensym? x)) -> (gensym? x)")
(lint-test "(integer? (*s7* 'vector-print-length))" " integer?: unknown *s7* field: 'vector-print-length")
(lint-test "(dynamic-wind (lambda () (s7-version)) (lambda () (list)) (lambda () #f))"
- " dynamic-wind: this could be omitted: (s7-version) in (lambda () (s7-version))
- dynamic-wind: this dynamic-wind is pointless, (dynamic-wind (lambda () (s7-version)) (lambda () (list)) (lambda () #f)) -> (list)
- dynamic-wind: perhaps (lambda () (s7-version)) -> s7-version
+ " dynamic-wind: perhaps (lambda () (s7-version)) -> s7-version
dynamic-wind: perhaps (lambda () (list)) -> list
dynamic-wind: perhaps (list) -> (); there is only one nil")
(lint-test "(lambda args (apply + args))" " lambda: perhaps (lambda args (apply + args)) -> +")
@@ -89613,7 +89847,7 @@ etc
(lint-test "(define a . b)" " define: (define a . b) makes no sense")
(lint-test "(define a b c)" " define: (define a b c) has too many values?")
(lint-test "(define a a)" " define: this define is either not needed, or is an error: (define a a)")
- (lint-test "(define #(0) 2)" " define: strange form: (define #(0) 2)")
+ (lint-test "(define #(a) 2)" " define: strange form: (define #(a) 2)")
(lint-test "(define (f1 a) (abs a))" " f1: f1 could be (define f1 abs)")
(lint-test "(define (f1 a b) \"a docstring\" (log a b))" " f1: f1 could be (define f1 log)")
(lint-test "(let () (define (f1 a b) (* 2 (log a b))) (define (f2 a b) (f1 a b)) (f2 1 2))"
@@ -89955,14 +90189,14 @@ etc
(lint-test "(begin (define (f12 x) (log x 2)) (f12 \"asdf\"))"
" begin: in (f12 \"asdf\"), f12's argument should be a number, but \"asdf\" is a string?")
(lint-test "(+ a #\\a 2)" " +: in (+ a #\\a 2), +'s argument 2 should be a number, but #\\a is a char?")
- (lint-test "(begin (define (f13 x) (string-ref x 0)) (f13 #(0 1 2)))"
- " begin: in (f13 #(0 1 2)), f13's argument should be a string, but #(0 1 2) is a vector?")
+ (lint-test "(begin (define (f13 x) (string-ref x 0)) (f13 #i(0 1 2)))"
+ " begin: in (f13 #i(0 1 2)), f13's argument should be a string, but #i(0 1 2) is an int-vector?")
(lint-test "(begin (define (f14 x) (float-vector-set! v x 1.0)) (f14 1+i))"
- " begin: in (f14 1+1i), f14's argument should be an integer, but 1+1i is a number?")
+ " begin: in (f14 1+1i), f14's argument should be an integer, but 1+1i is complex?")
(lint-test "(begin (define (f14 x) (float-vector-set! x 1 1.0)) (f14 1+i))"
- " begin: in (f14 1+1i), f14's argument should be a float-vector, but 1+1i is a number?")
+ " begin: in (f14 1+1i), f14's argument should be a float-vector, but 1+1i is complex?")
(lint-test "(begin (define (f14 x) (* 2 (float-vector-set! x 1 1.0))) (f14 1+i))"
- " begin: in (f14 1+1i), f14's argument should be a float-vector, but 1+1i is a number?")
+ " begin: in (f14 1+1i), f14's argument should be a float-vector, but 1+1i is complex?")
(lint-test "(begin (define (f15 x) (* 2 (+ x 1))) (f15 #()))"
" begin: in (f15 #()), f15's argument should be a number, but #() is a vector?")
(lint-test "(begin (define (f16 x) (vector-set! v 1 x)) (f16 #f))" "")
@@ -90037,8 +90271,7 @@ etc
(lint-test "(case-lambda ((x) (log x 2)) ((y x z) (log x y)))" "")
(lint-test "(let loop ((pi 1.0) (+ pi 1)))"
- " let: in (let loop ((pi 1.0) (+ pi 1))), lambda parameter 'pi is a constant
- let: can't bind a constant: (pi 1.0)
+ " let: can't bind a constant: (pi 1.0)
let: let binding is messed up: (+ pi 1)
let: loop not used, value: (let loop ((pi 1.0) (+ pi 1)))")
(lint-test "(define (f12 pi) pi)" " define: f12 parameter can't be a constant: (f12 pi)")
@@ -90053,8 +90286,8 @@ etc
" let: can't set! __lt1__ in (set! __lt1__ 3) (it is a constant: 32)")
(lint-test "(let () (define (f1 x) (+ x 1)) f1)" " let: perhaps omit f1, and change (define (f1 x) ...) -> (lambda (x) ...)")
(lint-test "(let () (define (f1 x) (f2 (+ x 1))) (define (f2 x) x) (f1 3))" "")
- (lint-test "(let () (define (f1 a) (let ((a (vector->list a))) (car a))) (f1 #(0)))"
- " let: perhaps (... (define (f1 a) (let ((a (vector->list a))) (car a))) (f1 #(0))) -> (... (let ((a #(0))) (let ((a (vector->list a))) (car a))))
+ (lint-test "(let () (define (f1 a) (let ((a (vector->list a))) (car a))) (f1 #(a)))"
+ " let: perhaps (... (define (f1 a) (let ((a (vector->list a))) (car a))) (f1 #(a))) -> (... (let ((a #(a))) (let ((a (vector->list a))) (car a))))
f1: perhaps (let ((a (vector->list a))) (car a)) -> (car (vector->list a))")
(lint-test "(car (vector->list a))" " car: perhaps (car (vector->list a)) -> (vector-ref a 0)")
@@ -90285,8 +90518,8 @@ etc
" loop: perhaps (define (loop a) (cond ((< a 0)) (else (loop (f1 a))))) -> (define (loop a) (do ((a a (f1 a))) ((< a 0) #t)))
loop: perhaps (cond ((< a 0)) (else (loop (f1 a)))) -> (or (< a 0) (loop (f1 a)))")
- (lint-test "(define make-rectangular (lambda args 32))" " top-level redefinition of built-in function make-rectangular: (define make-rectangular (lambda args 32))")
- (lint-test "(define abs (lambda args 32))" " top-level redefinition of built-in function abs: (define abs (lambda args 32))")
+ (lint-test "(define make-rectangular (lambda args 32))" " top-level (line 0) redefinition of built-in function make-rectangular: (define make-rectangular (lambda args 32))")
+ (lint-test "(define abs (lambda args 32))" " top-level (line 0) redefinition of built-in function abs: (define abs (lambda args 32))")
;; this is a write.scm lint-pp bug regression test
(lint-test "(define (any-random amount e) (letrec ((next-random (lambda () (let ((x 32)) (if (<= y (envelope-interp x e)) (next-random)))))) (next-random)))"
@@ -90308,13 +90541,13 @@ etc
(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 2): 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 2): the inner function f14 could be moved into the let:
+ " 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 ((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 2): perhaps (... (define (f14 x y) (if (positive? x) (+ x y) y)) (+ x (f14 1 2))) ->
+ let (line 0): 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")
+ f14 (line 1): 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))
@@ -90606,8 +90839,9 @@ etc
define: letrec could be let: (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (f0 (+ b 1))))
define: perhaps (define f43 (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (f0 (+ b 1))))) -> (define (f43 b) (let f0 ((a (+ b 1))) (+ a 1)))")
(lint-test "(define f43 (letrec ((f0 (lambda (a b) (+ (f0 a b) 1)))) (lambda (b) (f0 b 0))))"
- " define: perhaps (letrec ((f0 (lambda (a b) (+ (f0 a b) 1)))) (lambda (b) (f0 b 0))) -> (lambda (b) (let f0 ((a b) (b 0)) (+ (f0 a b) 1)))
- define: perhaps (define f43 (letrec ((f0 (lambda (a b) (+ (f0 a b) 1)))) (lambda (b) (f0 b 0)))) ->
+ " define: perhaps (letrec ((f0 (lambda (a b) (+ (f0 a b) 1)))) (lambda (b) (f0 b 0))) ->
+ (lambda (b) (let f0 ((a b) (b 0)) (+ (f0 a b) 1)))
+ define: perhaps (define f43 (letrec ((f0 (lambda (a b) (+ (f0 a b) 1)))) (lambda (b) (f0 b... ->
(define (f43 b) (let f0 ((a b) (b 0)) (+ (f0 a b) 1)))")
(lint-test "(define f43 (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (if (> b 0) (f0 (+ b 1))))))"
" define: perhaps (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (if (> b 0) (f0 (+ b 1))))) -> (lambda (b) (if (> b 0) (let f0 ((a (+ b 1))) (+ a 1))))
@@ -90643,7 +90877,17 @@ etc
loop: perhaps (let loop ((x x)) (if (positive? x) (loop (- x 1)) 0)) -> (do ((x x (- x 1))) ((not (positive? x)) 0))")
(lint-test "(define (f61) (let loop () (if (positive? x) (loop) 0)))"
" define: perhaps (define (f61) (let loop () (if (positive? x) (loop) 0))) -> (define (f61) (if (positive? x) (f61) 0))")
-
+ (lint-test "(define (rep x) (f x) (f x) (f x) (f x) (f x))" "rep: perhaps (f x)... -> (do ((i 0 (+ i 1))) ((= i 5)) (f x))")
+ (lint-test "(define (rep1 lim)
+ (let ((sum 0))
+ (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i)))
+ (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i)))
+ (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i)))
+ (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i)))
+ sum))"
+ "rep1: perhaps (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i)))... ->
+ (do ((_1_ 0 (+ _1_ 1))) ((= _1_ 4)) (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i))))")
+
(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)))"
@@ -90798,9 +91042,14 @@ etc
" f210: perhaps (define (f210 . opt) (let ((ip (if (null? opt) #f (car opt)))) (g ip) (f ip))) -> (define* (f210 ip) ...)
f210: perhaps (if (null? opt) #f (car opt)) -> (and (not (null? opt)) (car opt))")
+ (lint-test "(define f230 (lambda* (:allow-other-keys) 1))" " lambda*: :allow-other-keys can't be the only parameter: (:allow-other-keys)")
+ (lint-test "(define* (f230 :allow-other-keys) 1)" " f230: :allow-other-keys can't be the only parameter: (:allow-other-keys)")
+ (lint-test "(define f230 (lambda* (:rest) 1))" " lambda*: :rest parameter needs a name: (:rest)")
+ (lint-test "(define* (f230 :rest) 1)" " f230: :rest parameter needs a name: (:rest)")
+
(let-temporarily ((*report-clobbered-function-return-value* #t))
(lint-test "(let ((v #f)) (define (f80) (display v) \"a string\") (set! v (f80)) (string-set! v 0 #\\a))"
- " let: perhaps (... (define (f80) (display v) \"a string\") (set! v (f80)) (string-set! v 0 #\\a)) ->
+ " let: perhaps (... (define (f80) (display v) \"a string\") (set! v (f80)) (string-set! v 0... ->
(... (set! v (let () (display v) \"a string\")) (string-set! v 0 #\\a))
f80: returns a string constant: \"a string\"
let: (set! v (f80)) returns a constant sequence, but (string-set! v 0 #\\a) appears to clobber it")
@@ -90824,12 +91073,51 @@ etc
(let ((f33 33)) (if (g x) (begin (define f33 4) (g f33)) 4)) -> (if (g x) (let ((f33 33)) (define f33 4) (g f33)) 4)
let: begin variable f33 in (define f33 4) shadows an earlier declaration
let: let variable f33 is redefined in the let body. Perhaps use set! instead: (set! f33 4)
- let: f33 not used, initially: 33 from let"))
-
+ let: f33 not used, initially: 33 from let")
+ ;; check built-in names
+ (lint-test "(define abs 3)" " top-level (line 0) redefinition of built-in function abs: (define abs 3)")
+ (lint-test "(define* (abs (ab 1)) (+ ab 1))" " top-level (line 0) redefinition of built-in function abs: (define* (abs (ab 1)) (+ ab 1))")
+ (lint-test "(define (f x abs y) (+ x (- abs y)))"
+ " define: f parameter abs shadows built-in abs
+ f: perhaps (+ x (- abs y)) -> (- (+ x abs) y)")
+ (lint-test "(let ((abs 3)) (f abs))"
+ " let: let variable abs shadows built-in abs
+ let: perhaps, assuming f is not a macro, (let ((abs 3)) (f abs)) -> (f 3)")
+ (lint-test "(do ((abs 0 (+ abs 1))) ((= abs 3) 32) (display abs))" " do: do variable abs shadows built-in abs")
+ (lint-test "(let abs ((i 10)) (if (positive? i) (abs (- i 1))))"
+ " let: let named-let-function-name abs shadows built-in abs
+ abs: perhaps (let abs ((i 10)) (if (positive? i) (abs (- i 1)))) -> (do ((i 10 (- i 1))) ((not (positive? i))))")
+ (lint-test "(let* abs ((i 10) (j i)) (if (positive? i) (abs (- i j) j)))" " let*: let* named-let*-function-name abs shadows built-in abs")
+ (lint-test "(f (lambda (abs) (+ abs 1)))" " lambda: :lambda parameter abs shadows built-in abs")
+ (lint-test "(map (lambda (abs) (car abs)) lst)"
+ " map: perhaps (lambda (abs) (car abs)) -> car
+ lambda: :lambda parameter abs shadows built-in abs")
+ (lint-test "(call-with-exit (lambda (abs) (abs 1)))"
+ " call-with-exit: call-with-exit exit-function abs shadows built-in abs
+ call-with-exit: abs is redundant here: (abs 1)")
+ (lint-test "(call/cc (lambda (abs) (abs 1)))"
+ " call/cc: call/cc continuation abs shadows built-in abs
+ call/cc: perhaps call/cc could be call-with-exit: (call/cc (lambda (abs) (abs 1)))
+ call/cc: abs is redundant here: (abs 1)")
+ (lint-test "(call-with-output-file x (lambda (abs) (read abs)))"
+ " call-with-output-file: call-with-output-file port abs shadows built-in abs
+ call-with-output-file: perhaps (call-with-output-file x (lambda (abs) (read abs))) -> (call-with-output-file x read)
+ call-with-output-file: abs is an output-port, but read in (read abs) wants an input-port?"))
+
+ (lint-test "(call-with-input-file file (lambda (p) (write c p) (write-string str p)))"
+ " call-with-input-file: p is an input-port, but write-string in (write-string str p) wants an output-port?
+ call-with-input-file: p is an input-port, but write in (write c p) wants an output-port?")
+ (lint-test "(call-with-input-string str (lambda (p) (write c p) (read p)))"
+ " call-with-input-string: p is an input-port, but write in (write c p) wants an output-port?")
+ (lint-test "(call-with-output-string (lambda (p) (write c p) (read p)))"
+ " call-with-output-string: p is an output-port, but read in (read p) wants an input-port?")
+ (lint-test "(call-with-output-file file (lambda (p) (read p) (write c p)))"
+ " call-with-output-file: p is an output-port, but read in (read p) wants an input-port?")
+
(let-temporarily ((*report-func-as-arg-arity-mismatch* #t))
(lint-test "(let () (define (f43 x) (+ x 1)) (define (f44 y z) (y (+ z 1) abs)) (f44 f43 2))"
" let: perhaps change f44 to a let:
- (let () (define (f43 x) (+ x 1)) (define (f44 y z) (y (+ z 1) abs)) (f44 f43 2)) -> (... (let ((y f43) (z 2)) ...))
+ (let () (define (f43 x) (+ x 1)) (define (f44 y z) (y (+ z 1) abs)) (f44... -> (... (let ((y f43) (z 2)) ...))
let: f44's parameter y is passed f43 and called (y (+ z 1) abs), but f43 takes only 1 argument")
(lint-test "(let () (define (f45 x) (+ x 1)) (define (f46 y z) (if z (y))) (f46 f45 2))"
" let: perhaps change f46 to a let:
@@ -90983,6 +91271,7 @@ etc
(lint-test " (vector-length (make-vector 10))" " vector-length: perhaps (vector-length (make-vector 10)) -> 10")
(lint-test " (max (log x) :minlog)" " max: in (max (log x) :minlog), max's argument 2 should be real, but :minlog is a keyword?")
+ (lint-test "(member outport (list *stderr* *stdout*))" "") ; not '(*stderr*...)!
(lint-test "(define ((foo x) y) (list x y))"
" define: perhaps (define ((foo x) y) (list x y)) -> (define (foo x) (lambda (y) (list x y)))")
(lint-test "(let () (define ((foo x) y) (list x y)) (foo 1 2))"
@@ -91024,7 +91313,7 @@ etc
(lint-test "(let ((x 0)) (case x ((0) 3) (else 4)))" " let: perhaps (case x ((0) 3) (else 4)) -> (if (eqv? x 0) 3 4)")
(lint-test "(let ((x 0)) (do ((i x (+ i 1))) ((= i 0))))"
- " let: this do-loop could be replaced by (): (do ((i x (+ i 1))) ((= i 0)))
+ " let: this do-loop could probably be replaced by the end test in a let: (do ((i x (+ i 1))) ((= i 0)))
let: perhaps (let ((x 0)) (do ((i x (+ i 1))) ((= i 0)))) -> (do ((i 0 (+ i 1))) ...)")
(lint-test "(let ((x 32)) (display x) (set! y (f x)) (g (+ x 1) y) (a y) (f y) (g y) (h y) (i y) (set! x 3) (display x) (h y x))"
@@ -91073,11 +91362,11 @@ etc
(... (let* f51 ((a -1) (b 32)) (if (zero? a) 3 (f51 (- a 1)))))")
(lint-test "(let () (lambda (a b) (+ a (* 2 b))))" " let: pointless let: (let () (lambda (a b) (+ a (* 2 b))))")
(lint-test "(let () (define (f x) x) (do ((i 0 (+ i 1))) ((= i 10)) (f i)))"
- " let: this do-loop could be replaced by (): (do ((i 0 (+ i 1))) ((= i 10)) (f i))
- let: this could be omitted: (f i)
- let: perhaps (do ((i 0 (+ i 1))) ((= i 10)) (f i)) -> (do ((i 0 (+ i 1))) ((= i 10)) i)")
+ " let: this do-loop could probably be replaced by the end test in a let: (do ((i 0 (+ i 1))) ((= i 10)) (f i))
+ let: this could be omitted: (f i)
+ let: perhaps (do ((i 0 (+ i 1))) ((= i 10)) (f i)) -> (do ((i 0 (+ i 1))) ((= i 10)) i)")
(lint-test "(let () (define (f x) (abs (* 2 x))) (do ((i 0 (+ i 1))) ((= i 10)) (f i)))"
- " let: this do-loop could be replaced by (): (do ((i 0 (+ i 1))) ((= i 10)) (f i))
+ " let: this do-loop could probably be replaced by the end test in a let: (do ((i 0 (+ i 1))) ((= i 10)) (f i))
let: this could be omitted: (f i)
let: perhaps (do ((i 0 (+ i 1))) ((= i 10)) (f i)) -> (do ((i 0 (+ i 1))) ((= i 10)) (abs (* 2 i)))")
@@ -91174,14 +91463,15 @@ etc
(lint-test "(error 'oops \"error: ~A ~A~%\" x)" " error: error has too few arguments: (error 'oops \"error: ~A ~A~%\" x)")
(lint-test "(define (f75) \"a string\")" " f75: returns a string constant: \"a string\"")
- (lint-test "(define (f75) #(0 1 2 3))" " f75: returns a vector constant: #(0 1 2 3)")
+ (lint-test "(define (f75) #i(0 1 2 3))" " f75: returns an int-vector constant: #i(0 1 2 3)")
(lint-test "(define (f75) '(0 1 2 3))" " f75: returns a list constant: '(0 1 2 3)")
(lint-test "(define (f75 x) (if x '(0 1 2 3) (+ x 1)))" " f75: returns a list constant: '(0 1 2 3)")
(lint-test "(define (f73 x) (let ((result 0)) (if (positive? x) (set! result 32) (set! result -1))))"
" f73: perhaps (if (positive? x) (set! result 32) (set! result -1)) -> (set! result (if (positive? x) 32 -1))
f73: result set, but not used: (set! result -1) (set! result 32)")
- (lint-test "(do ((res 0 (+ res 1))) ((= res 3)) (set! res (+ res 32)))" "")
+ (lint-test "(do ((res 0 (+ res 1))) ((= res 3)) (set! res (+ res 32)))"
+ " do: perhaps move (set! res (+ res 32)) to res's step expression: (res 0 (+ 33 res))")
(lint-test "(begin (define res 0) (set! res (+ res 32)))" "")
(lint-test "(cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2)((string=? x \"c\") 3) ((string=? \"a\" x) 4))"
" cond: cond test (string=? \"a\" x) is never true: (cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2) ((string=? x \"c\") 3)...
@@ -91233,6 +91523,7 @@ etc
" listtail: perhaps (define (listtail x k) (if (zero? k) x (listtail (cdr x) (- k 1)))) ->
(define (listtail x k) (do ((x x (cdr x)) (k k (- k 1))) ((zero? k) x)))
listtail: listtail is the same as the built-in function list-tail")
+ ;; too tricky! (lint-test "(define (mdi) (define reader1 (lambda* (quit) (reader1))))" "")
(lint-test "(cdr '(a))" " cdr: perhaps (cdr '(a)) -> ()")
(lint-test "(char-upcase #\\a)" " char-upcase: perhaps (char-upcase #\\a) -> #\\A")
@@ -91344,9 +91635,13 @@ etc
" begin: this could be omitted: (let loop ((x y)) (if (null? x) 1 (loop (cdr x))))
loop: perhaps (let loop ((x y)) (if (null? x) 1 (loop (cdr x)))) -> (do ((x y (cdr x))) ((null? x) 1))")
(lint-test "(begin (do ((x y (cdr x))) ((null? x) 1)) x)"
- " begin: perhaps (begin (do ((x y (cdr x))) ((null? x) 1)) x) -> (do ((x y (cdr x))) ((null? x) 1 x))
- begin: this could be omitted: (do ((x y (cdr x))) ((null? x) 1))
+ " begin: this could be omitted: (do ((x y (cdr x))) ((null? x) 1))
begin: this do-loop could be replaced by 1: (do ((x y (cdr x))) ((null? x) 1))")
+ (lint-test "(begin (do ((x y (cdr x)) (i 0 ( i 1)) (j 1 (+ j i))) ((null? x) 1)) j)"
+ " begin: (do ((x y (cdr x)) (i 0 (i 1)) (j 1 (+ j i))) ((null? x) 1)): result 1 is not used
+ begin: perhaps (do ((x y (cdr x)) (i 0 (i 1)) (j 1 (+ j i))) ((null? x) 1)) ->
+ (do ((x y (cdr x)) (i 0 (i 1)) (j 1)) ((null? x) 1) (set! j (+ j i)))
+ begin: j set, but not used: 1 from do")
(lint-test "(begin (define (f300 x) (if (null? x) 0 (f300 (cdr x)))) (display x) (f300 '(1)) x)"
" f300: perhaps (define (f300 x) (if (null? x) 0 (f300 (cdr x)))) -> (define (f300 x) (do ((x x (cdr x))) ((null? x) 0)))
begin: this could be omitted: (f300 '(1))")
@@ -91360,6 +91655,13 @@ etc
begin: #t is probably redundant; map can't return #f")
(lint-test "(begin (set! y (map f x)) #t)" " begin: #t is probably redundant; map can't return #f")
+ (lint-test "(cond (A =>) (else B))" " cond: cond => target is messed up: (A =>)")
+ (lint-test "(case x ((A) =>) (else B))" " case: perhaps (case x ((A) =>) (else B)) -> (if (eq? x 'A) => B) case: case => target is messed up: ((A) =>)")
+ (lint-test "(do ((i 0 (+ i 1))) (i =>))" " do: do-result => target is messed up: (i =>)")
+ (lint-test "(cond (A => . B) (else B))" " cond: cond => target is messed up: (A => . B)")
+ (lint-test "(case x ((A) => . B) (else B))" " case: case => target is messed up: ((A) => . B)")
+ (lint-test "(do ((i 0 (+ i 1))) (i => . B))" " do: do is messed up: (do ((i 0 (+ i 1))) (i => . B))")
+
(when (provided? 'snd)
(lint-test "(begin (cond ((find-sound \"test.snd\") => close-sound)) (display x))" "")
(lint-test "(if (real? (oscil x)) 1.0 0.0)" " if: perhaps (real? (oscil x)) -> #t if: perhaps (if (real? (oscil x)) 1.0 0.0) -> 1.0")
@@ -91374,7 +91676,7 @@ etc
(lint-test "(set! (show-indices) #t)" "")
(lint-test "(mus-header-type-name 121)" " mus-header-type-name: mus-header-type-name's argument, 121, should be an integer between 1 and 70")
(lint-test "(mus-header-type-name 2)" "")
- (lint-test "(mus-header-type-name 3.5)" " mus-header-type-name: in (mus-header-type-name 3.5), mus-header-type-name's argument should be an integer, but 3.5 is real?")
+ (lint-test "(mus-header-type-name 3.5)" " mus-header-type-name: in (mus-header-type-name 3.5), mus-header-type-name's argument should be an integer, but 3.5 is a float?")
(lint-test "(mus-header-type-name mus-aiff)" "")
(when (provided? 'snd-gtk)
@@ -91427,13 +91729,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: 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")
+ " 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")
(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?
@@ -91497,8 +91799,7 @@ etc
func: unless is messed up: (unless .+2 '((x 1) y . 2) 1 - or case quote . __asdf__)")
(lint-test "(define (func x) (lambda* .(lcm . do)))" " func: lambda* is messed up in (lambda* lcm . do)")
(lint-test "(define (func x) (let . `(((x 1))) ))"
- " func: in (let quote (((x 1)))), lambda parameter '(x 1) is a pair (perhaps you want define* or lambda*?)
- func: let variable is not a symbol? ((x 1))
+ " func: let variable is not a symbol? ((x 1))
func: let variable named quote is asking for trouble
func: quote not used, value: (let quote (((x 1))))")
(lint-test "(define (func x) (do . 1))" " func: do is messed up: (do . 1)")
@@ -91519,7 +91820,7 @@ etc
func: denominator needs 1 argument: (denominator)
func: with-let is messed up: (with-let .0+)
func: in (cdaadr (floor (random nan.0 inf.0))), cdaadr's argument should be a pair, but (floor (random nan.0 inf.0)) is an integer?
- func: in (random nan.0 inf.0), random's argument 2 should be a random-state, but inf.0 is real?")
+ func: in (random nan.0 inf.0), random's argument 2 should be a random-state, but inf.0 is a float?")
(lint-test "(define (func x) (if (begin 2(caaar 2)) (make-list (unless +)) (char-upper-case? 0i2 0+1/0i
`(((x 1))) (cons 1 2) (string (or / (let ((x 3)) (lambda (y) (+ x y))) . =>)))))"
" func: this could be omitted: 2
@@ -91530,8 +91831,7 @@ etc
func: unexpected dot: (or / (let ((x 3)) (lambda (y) (+ x y))) . =>)")
(lint-test "(define (func x) (if (lambda* +i . begin ) (symbol->value i-/)))" " func: lambda* is messed up in (lambda* +i . begin)")
(lint-test "(define (func x) (let . '((())) ))"
- " func: in (let quote ((()))), lambda parameter '() is a constant
- func: let variable is not a symbol? (())
+ " func: let variable is not a symbol? (())
func: let variable named quote is asking for trouble
func: quote not used, value: (let quote ((())))")
(lint-test "(define (func x) (if (defined? +) (when (string=? +))))"
@@ -91618,7 +91918,7 @@ etc
(glint "(define (func x) (case x ((define*) (current-input-port .1+)) (((values #\\c 3 1.2))
(symbol .2/)) (else (procedure-documentation 2-2i(char=? (+ (reverse (list-tail (reverse /)))))))))")
(glint "(define (func x) (if (values i-(caaaar)) (cdaddr ++) (assv +(list (quote 2)))))")
- (glint "(define (func x) (/ 0(/ 0(let-temporarily))))")
+ (glint "(define (func x) (/ 0(/ 0 (let-temporarily))))")
(glint "(define (func x) (cond ((when 1/1.2 #2d((1 2) (3 4)) /1) (openlet (caadar 0))) (else (let*-values (string-ci=? 0-(min //))))))")
(glint "(define (func x) (cond ((let* 'hi (let)) (make-rectangular +)) (else (cutlet 002 define-bacro #<unspecified> i(list-ref '((x 1) 2) macroexpand #t)))))")
(glint "(if x (int-vector-set! z 0 1) (begin .1 (let ((x 3)) (lambda (y) (+ x y))) . #t))")
@@ -91766,8 +92066,47 @@ etc
(glint "(even? /(make-shared-vector 0-(list->string 1(cond ((i 0 (+ i 1))) ((x . 1) . 2) (#t ())))))")
(glint "(cond ((x 1) (y) . 2) (else (f x) B) ((x 1) (y) . 2))")
(glint "(cons +1.(list 02/ (pi 0) `(+ ,a , at b) ((null? i) i) 2201))")
+ (glint "(let* / ((1)) (unless (unless '((())) x y z 1+0/0i most-negative-fixnum /)))")
+ (glint "(define* ((x . 1)) letrec ((1)) (pi 0) let (+ x 1) (x . 1) set! x quasiquote (f x) i `(+ ,a , at b) )")
+ (glint "(define* , `(+ ,a ,b , at c) (define* macroexpand macroexpand \"\"))")
+ (glint "(define* ((i 0 (+ i 1))) (define* 3/4 unless (call/cc (lambda (go) (go 9) 0)) or ' `(+ ,a , at b) 1.0+1.0i abs (abs x) (A (f x) B) () ((1) . x) ))")
+ (glint "(define* , (else ()) ,(lambda))")
+ (glint "(cond ` (#t ()) (abs x) (= i 2) ((+ x 1)) (else (f x) B) ((x 1) (y) . 2) (A (f x) B))")
+ (glint "(unless (set! _x1_ 3) `(+ ,a , at b) `(+ ,a , at b) `(+ ,a , at b) `(+ ,a ,b) (((x 1))) (vector 1 '(3)) (else (f x) B) nan.0 ((x 1)))")
+ (glint "(lambda* .(:allow-other-keys (integer->char 255) define x (lambda args args) \" \"))")
+ (glint "(begin (define* (_d1_ (a 1)) (+ a 1)) (f x) (define* (_d1_ (a 1)) (+ a 1)) (else (f x) B) (- 1) ' ((x 1) 2) (A (f x) B) `(+ ,a ,b , at c) #(1 2) .\" ` ` \")")
+ (glint "(define-macro* (null? i) #t (list 1 2) (define* (_d1_ (a 1)) (+ a 1)) ((x 1 . 2) . 3) ' 1 defmacro #f if (#t ()) quasiquote (quote ))")
+ (glint "(define-bacro (pi) (let .' define x cons or (#t ()) defmacro (x . y) (string (integer->char 255)) ((x 1 . 2) . 3) ,\"\"))")
+ (glint "(cond `(+ ,a , at b) ((x 1) (y) . 2) (else (f x) B) ((x 1) (y) . 2))")
+ (glint "(lambda* lambda* -1 (= i 2) (- i 1) cons \" \")")
+ (glint "(define-macro (pi) (quote))")
+ (glint "(cond (1) (else))")
+ (glint "(pair? (defmacro* define #(#(0)) 3/4 `(+ ,a ,b , at c) `(+ ,a b , at c ',d) ((x 1 . 2) . 3) set! x))")
+ (glint "(list-values (apply-values))")
+ (glint "(list-values (begin (f x) B) nan.0 (apply-values))")
+ (glint "(symbol->value (vector->list quasiquote (list-values -1.3 (apply-values))))")
+ (glint "(define-macro (list (list 1 2)) (list-values))")
+ (glint "(define-bacro (x => y) (cond ((x 1) . 2) ))")
+ (glint "(int-vector-set! ((+ x 1)) \"hi\" '(string #\\a #\\null #\\b) 3/4 (((+ x 1))) (1) (do (#t ()) #() (= i 2)))")
+ (glint "(list-values (list-values . -1))")
+ (glint "(lambda* `(string>? inf.0 ((set! x (+ x 1)) (* x 2)) macroexpand `(+ ,a ,b , at c) (()) pi (pi 0) (= i 2) let (1) begin (1 2 . 3) if cond (begin (f x) B) (()) (define-macro (_m1_ a) `(+ ,a 1)) (x y) (values \"hi\") ((+ x 1)) :hi ((set! x (+ x 1)) (* x 2)) inf.0 (()) (pi 0) ((x 1 . 2) . 3) (x y) (x . 1) ((x . 1) . 2) nan.0 (if x y) `(+ ,a b , at c ',d) (make-dilambda (lambda () 1) (lambda (a) a)) with-let ))")
)
-
+
+ (test (tree-leaves '(lambda () 1)) 3)
+ (test (tree-leaves ()) 0)
+ (test (tree-leaves 1) 1)
+ (test (tree-leaves '(a . b)) 2)
+ (test (tree-memq 'a '(a b c)) #t)
+ (test (tree-memq 'a '(b c . a)) #t)
+ (test (tree-memq 'a '(b c . e)) #f)
+ (test (tree-memq 'a '(c b c)) #f)
+ (test (tree-memq 'a '(b c ((b a)))) #t)
+ (test (tree-memq 3 '(b c ((b 3)))) #t)
+ (test (tree-count 'x '(a b c)) 0)
+ (test (tree-count 'x '(a x c)) 1)
+ (test (tree-count 'x '(a x x)) 2)
+ (test (tree-count 'x '(a x x) 1) 1)
+ (test (tree-count 'x '(x x x) 2) 2)
(let ((out-vars (*lint* 'out-vars)))
(test (out-vars 'hi '(a b) '(+ a b)) '(() ()))
@@ -91803,16 +92142,16 @@ etc
(test (out-vars 'hi '(a b) '(let* () (define c 1) (+ a b c d))) '((d) ()))
(test (out-vars 'hi '(a b) '(let () (define (c s) (* s 2)) (+ a b (c d)))) '((d) ())))
-#|
- (define fmatch (*lint* 'function-match))
- (define walkfunc (*lint* 'lint-walk-function))
- (define (f1 x) (if (< x 3) (+ x 1) (+ x 2)))
- (let ((e (walkfunc 'define 'f1 '(x) '((if (< x 3) (+ x 1) (+ x 2))) '(define (f1 x) (if (< x 3) (+ x 1) (+ x 2))) ())))
- (fmatch 'tester '(if (< y 3) (+ y 1) (+ y 2)) e))
- (define sequal? (*lint* 'structures-equal?))
- (sequal? '(if (< y 3) (+ y 1) (+ y 2)) '(if (< x 3) (+ x 1) (+ x 2)) '((y . :unset)) () ())
- (sequal? '(and x y) '(and a b) '((x . a) (y . b)) () ())
-|#
+
+; (define fmatch (*lint* 'function-match))
+; (define walkfunc (*lint* 'lint-walk-function))
+; (define (f1 x) (if (< x 3) (+ x 1) (+ x 2)))
+; (let ((e (walkfunc 'define 'f1 '(x) '((if (< x 3) (+ x 1) (+ x 2))) '(define (f1 x) (if (< x 3) (+ x 1) (+ x 2))) ())))
+; (fmatch 'tester '(if (< y 3) (+ y 1) (+ y 2)) e))
+; (define sequal? (*lint* 'structures-equal?))
+; (sequal? '(if (< y 3) (+ y 1) (+ y 2)) '(if (< x 3) (+ x 1) (+ x 2)) '((y . :unset)) () ())
+; (sequal? '(and x y) '(and a b) '((x . a) (y . b)) () ())
+
(define f321
(let ((signature '(float? integer?)))
@@ -91825,6 +92164,360 @@ etc
(set! reader-cond #f)
)
+
+;;; --------------------------------------------------------------------------------
+
+(test (let ((equal? #f)) (member 3 '(1 2 3))) '(3))
+(test (let ((eqv? #f)) (case 1 ((1) 1))) 1) ; scheme wg
+(test (let ((eqv? equal?)) (case "asd" (("asd") 1) (else 2))) 2)
+(test (let ((eq? #f)) (memq 'a '(a b c))) '(a b c))
+(test (let ((if #t)) (or if)) #t)
+(test (let ((if +)) (if 1 2 3)) 6)
+(test (if (let ((if 3)) (> 2 if)) 4 5) 5)
+(test (let ('1 ) quote) 1)
+(test (let ((quote 1)) (+ quote 1)) 2)
+(test (let ((quote -)) '32) -32)
+(test (do ((do 1)) (#t do)) 1)
+(test (do ((do 1 (+ do do))) ((> do 3) do)) 4)
+(test (do ((do 1 do) (j do do)) (do do)) 1)
+(test (do ((do do do)) (do do)) do)
+(test (do ((do do do)) (do do do)) do) ; ok ok!
+(test (or (let ((or #t)) or)) #t)
+(test (and (let ((and #t)) and)) #t)
+(test (let ((=> 3) (cond 4)) (+ => cond)) 7)
+(test (case 1 ((1 2) (let ((case 3)) (+ case 1))) ((3 4) 0)) 4)
+(test (let ((lambda 4)) (+ lambda 1)) 5)
+
+(test (let () (define (hi a) (let ((pair? +)) (pair? a 1))) (hi 2)) 3)
+(test ((lambda (let) (let* ((letrec 1)) (+ letrec let))) 123) 124)
+
+(test (let ((begin 3)) (+ begin 1)) 4)
+(test ((lambda (let*) (let ((letrec 1)) (+ letrec let*))) 123) 124)
+(test ((lambda (quote) (+ quote 1)) 2) 3)
+(test ((lambda (quote . args) (list quote args)) 1 2 3) '(1 (2 3)))
+(test (let ((do 1) (map 2) (for-each 3) (quote 4)) (+ do map for-each quote)) 10)
+(test ((lambda lambda lambda) 'x) '(x))
+(test ((lambda (begin) (begin 1 2 3)) (lambda lambda lambda)) '(1 2 3))
+(test (let* ((let 3) (x let)) (+ x let)) 6)
+(test (((lambda case lcm))) 1)
+(test (((lambda let* *))) 1)
+(test (do ((i 0 1) '(list)) (#t quote)) ())
+(test ((lambda (let) (+)) 0) 0)
+(test (let () (define (hi cond) (+ cond 1)) (hi 2)) 3)
+(test (let () (define* (hi (cond 1)) (+ cond 1)) (hi 2)) 3)
+(test (let () (define* (hi (cond 1)) (+ cond 1)) (hi)) 2)
+(test (let () ((lambda (cond) (+ cond 1)) 2)) 3)
+(test (let () ((lambda* (cond) (+ cond 1)) 2)) 3)
+(test (let () (define-macro (hi cond) `(+ 1 ,cond)) (hi 2)) 3)
+(test (let () (define-macro* (hi (cond 1)) `(+ 1 ,cond)) (hi)) 2)
+(test (let () (define (hi abs) (+ abs 1)) (hi 2)) 3)
+(test (let () (define (hi if) (+ if 1)) (hi 2)) 3)
+
+(test (let () (define* (hi (lambda 1)) (+ lambda 1)) (hi)) 2)
+(test (do ((i 0 0) '(+ 0 1)) ((= i 0) i)) 0) ; guile also! (do ((i 0 0) (quote list (+ 0 1))) ((= i 0) i))?
+(test (let () (define (cond a) a) (cond 1)) 1)
+(test (let ((cond 1)) (+ cond 3)) 4)
+(test (let () (define (tst cond) (if cond 0 1)) (tst #f)) 1)
+(test (let () (define (tst fnc) (fnc ((> 0 1) 2) (#t 3))) (tst cond)) 3)
+(test (let () (define (tst fnc) (fnc ((> 0 1) 2) (#t 3))) (define (val) cond) (tst (val))) 3)
+(test (let () (define-macro (hi a) `(let ((lambda +)) (lambda ,a 1))) (hi 2)) 3)
+(test ((let ((do or)) do) 1 2) 1)
+
+(test (let () (define (hi) (let ((oscil *)) (if (< 3 2) (+ 1 2) (oscil 4 2)))) (hi) (hi)) 8)
+(test (let () (define (hi) (let ((oscil *)) (if (< 3 2) (+ 1 2) (oscil 4 2)))) (hi) (hi) (hi) (hi)) 8)
+(test (let ((x 12)) (define (hi env) (set! x (env 0)) x) (hi '(1 2 3)) (hi '(1 2 3))) 1)
+(test (let ((x 12)) (define (hi env) (set! x (+ x (env 0))) x) (hi '(1 2 3)) (hi '(1 2 3))) 14)
+(test (let ((x 12)) (define (hi env) (set! x (+ (env 0) x)) x) (hi '(1 2 3)) (hi '(1 2 3))) 14)
+(test (let ((x 12)) (define (hi env) (set! x (+ x (env 0))) x) (hi '(1 2 3)) (hi '(1 2 3)) (hi '(1 2 3))) 15)
+(test (let ((x 12)) (define (hi env) (set! x (+ (env 0) x)) x) (hi '(1 2 3)) (hi '(1 2 3)) (hi '(1 2 3))) 15)
+
+(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i (env 1 2)))) ((> i (env 4 5)) (env 1 2 3)) (+ x (env 1)))) (hi) (hi)) 6)
+(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i (env 4 5)) (env 1 2 3)) (+ x (env 1)))) (hi) (hi)) 6)
+(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i (env 4 5)) (env 1 2 3)) (+ x 1))) (hi) (hi)) 6)
+(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i 9) (env 1 2 3)) (+ x 1))) (hi) (hi)) 6)
+(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i 9) (+ 1 2 3)) (+ x 1))) (hi) (hi)) 6)
+(test (let * ((i 0)) (if (< i 1) (* (+ i 1))) i) 0)
+(test (let ((car if)) (car #t 0 1)) 0)
+(test (call-with-exit (lambda (abs) (abs -1))) -1)
+
+(test (let ((sqrt (lambda (a) (* a a)))) `(+ ,@(map sqrt '(1 4 9)) 2)) '(+ 1 16 81 2))
+(test (let ((sqrt (lambda (a) (* a a)))) `(+ ,(sqrt 9) 4)) '(+ 81 4))
+(test `(+ ,(let ((sqrt (lambda (a) (* a a)))) (sqrt 9)) 4) '(+ 81 4))
+(test `(+ (let ((sqrt (lambda (a) (* a a)))) ,(sqrt 9)) 4) '(+ (let ((sqrt (lambda (a) (* a a)))) 3) 4))
+(test (let ((sqrt (lambda (a) (* a a)))) `(+ ,(apply values (map sqrt '(1 4 9))) 2)) '(+ 1 16 81 2))
+(if (not (provided? 'immutable-unquote)) (test (let ((sqrt (lambda (a) (* a a)))) `(+ (unquote (apply values (map sqrt '(1 4 9)))) 2)) '(+ 1 16 81 2)))
+
+(test ((((eval lambda) lcm gcd))) 0)
+(test ((((lambda - -) -) 0) 1) -1)
+
+(test (let () (define (hi) (let ((oscil >)) (or (< 3 2) (oscil 4 2)))) (hi) (hi)) #t)
+(test (let () (define (hi) (let ((oscil >)) (and (< 2 3) (oscil 4 2)))) (hi) (hi)) #t)
+
+(test ((lambda* ((- 0)) -) :- 1) 1)
+
+(let ()
+ (define-macro (i_ arg)
+ `(with-let (unlet) ,arg))
+
+ (define-bacro* (mac b)
+ `((i_ let) ((a 12))
+ ((i_ +) a ,(symbol->value b))))
+ ;; this assumes the 'b' value is a symbol: (let ((a 1)) (mac (* a 2))) is an error -- see s7.html for a better version
+ (test (let ((a 32)
+ (+ -))
+ (mac a))
+ 44))
+
+;(define (hi) (do ((i 0 (+ i 1))) ((= i 200000) i) (abs i)))
+;(test (hi) 200000)
+
+(let ()
+ (define-macro (cube x) `(with-let (inlet :x ,x) (* x x x)))
+ (test (cube 2) 8)
+ (let ((x 2)) (test (cube (set! x (+ x 1))) 27))
+
+ (define-macro (pop! sym)
+ `(with-let (#_inlet :e (#_curlet) :result (#_car ,sym))
+ (with-let e (#_set! ,sym (#_cdr ,sym)))
+ result))
+
+ (test (let ((lst '(1 2 3))) (list (pop! lst) lst)) '(1 (2 3)))
+ (test (let ((lst (vector (list 1 2 3)))) (list (pop! (lst 0)) lst)) '(1 #((2 3))))
+ (test (let ((result '(1 2 3))) (list (pop! result) result)) '(1 (2 3)))
+ (test (let ((cdr '(1 2 3))) (list (pop! cdr) cdr)) '(1 (2 3)))
+
+ (define-macro (pushnew! val lst)
+ `(set! ,lst (with-let (inlet :val ,val :lst ,lst)
+ (if (not (member val lst))
+ (cons val lst)
+ lst))))
+
+ (test (let ((lst (list 1 2))) (pushnew! 3 lst)) '(3 1 2))
+ (test (let ((val (list 1 2)) (lst 3)) (pushnew! lst val)) '(3 1 2))
+ (test (let ((lst (list 1 2)) (val 3)) (pushnew! val lst)) '(3 1 2))
+ (test (let ((lst (list 1 2)) (member 3)) (pushnew! member lst)) '(3 1 2))
+ )
+
+
+(test (let ()
+ (define-immaculo (hi a) `(let ((b 23)) (+ b ,a)))
+ (let ((+ *)
+ (b 12))
+ (hi b)))
+ 35)
+
+(test (let ()
+ (define-clean-macro (hi a) `(+ ,a 1))
+ (let ((+ *)
+ (a 12))
+ (hi a)))
+ 13)
+
+(test (let ()
+ (define-immaculo (hi a) `(+ ,a 1))
+ (let ((+ *)
+ (a 12))
+ (hi a)))
+ 13)
+
+(test (let ()
+ (define-clean-macro (mac a . body)
+ `(+ ,a , at body))
+ (let ((a 2)
+ (+ *))
+ (mac a (- 5 a) (* a 2))))
+ 9)
+
+(test (let ()
+ (define-macro (mac b)
+ `(let ((a 12))
+ (,+ a ,b)))
+ (let ((a 1)
+ (+ *))
+ (mac a)))
+ 24)
+
+(test (let ()
+ (define-macro (mac b)
+ `(let ((a 12))
+ (+ a ,b)))
+ (let ((a 1)
+ (+ *))
+ (mac a)))
+ 144)
+
+(test (let ()
+ (define-immaculo (mac c d) `(let ((a 12) (b 3)) (+ a b ,c ,d)))
+ (let ((a 21) (b 10) (+ *)) (mac a b)))
+ 46)
+
+(let ()
+ (define-macro (pure-let bindings . body)
+ `(with-let (unlet)
+ (let ,bindings , at body)))
+ (test (let ((+ *) (lambda abs)) (pure-let ((x 2)) ((lambda (y) (+ x y)) 3))) 5))
+
+(test (let ((name '+))
+ (let ((+ *))
+ (eval (list name 2 3))))
+ 6)
+(test (let ((name +))
+ (let ((+ *))
+ (eval (list name 2 3))))
+ 5)
+;; why is this considered confusing? It has nothing to do with eval!
+
+(test (let ((call/cc (lambda (x)
+ (let ((c (call/cc x))) c))))
+ (call/cc (lambda (r) (r 1))))
+ 1)
+
+; (test (with-let (sublet (curlet) (cons '+ (lambda args (apply * args)))) (+ 1 2 3 4)) 24) ; not sure about this -- the inner '+ might be optimized
+
+(let ()
+ (define-constant [begin] begin)
+ (define-constant [if] if)
+ (define-macro (when1 expr . body)
+ `([if] ,expr ([begin] , at body)))
+ (let ((if 32) (begin +))
+ (test (when1 (> 2 1) 1 2 3) 3)
+ (test (when1 (> 1 2) 3 4 5) #<unspecified>))
+ (test (when1 (> 2 1) 3) 3))
+
+(test (let ((car 1) (cdr 2) (list '(1 2 3))) (+ car cdr (cadr list))) 5)
+(test (letrec ((null? (lambda (car cdr) (+ car cdr)))) (null? 1 2)) 3)
+(test (letrec ((append (lambda (car list) (car list)))) (append cadr '(1 2 3))) 2)
+(test (let () (define (hi) (let ((car 1) (cdr 2) (list '(1 2 3))) (+ car cdr (cadr list)))) (hi)) 5)
+(test (let () (define (hi) (letrec ((null? (lambda (car cdr) (+ car cdr)))) (null? 1 2))) (hi)) 3)
+(test (let () (define (hi) (letrec ((append (lambda (car list) (car list)))) (append cadr '(1 2 3)))) (hi)) 2)
+
+(let ()
+ (test ((lambda 'a (eval-string "1")) (curlet) 1) 1)
+ (test ((lambda 'a (eval-string "a")) (curlet) 1) 1))
+
+;;; check optimizer
+(let ((lst (list 1 2 3))
+ (old-lambda lambda)
+ (ho #f)
+ (val #f))
+ (let* ((lambda 1))
+ (define (hi)
+ (for-each (lambda (a) (display a)) lst))
+ (set! val (+ lambda 2))
+ (set! ho hi))
+ (test val 3)
+ (test (ho) #<unspecified>))
+
+(let ()
+ (define mac (let ((var (gensym)))
+ (define-macro (mac-inner b)
+ `(#_let ((,var 12)) (#_+ ,var ,b)))
+ mac-inner))
+ (test (let ((a 1) (+ *) (let /)) (mac a)) 13)
+ (test (let ((a 1) (+ *) (let /)) (mac (mac a))) 25))
+
+(test (let ((begin +)) (with-let (unlet) (begin 1 2))) 2)
+(test (let () (define (f x) (let > (begin (vector-dimensions 22)))) (f 0)) 'error)
+(test (let () (define (f x) (let asd ())) (f 1)) 'error)
+(test (let () (define (f x) (hook *)) (f #f)) 'error)
+(test (let ((e (sublet () '(a . 1)))) (define (f x) (e *)) (f 1)) 'error)
+(test (let () (define (f) (eval (lambda 2.(hash-table-ref 1-)))) (f)) 'error)
+(test (let () (eval (lambda 2.(hash-table-ref 1-)))) 'error)
+(test (let () (define (f) (eval (lambda 2 #f))) (f)) 'error)
+(test (let () (define (f) (eval (lambda #f))) (f)) 'error)
+(test (let () (define (f) (eval (lambda))) (f)) 'error)
+(test (let () ((lambda () (eval (lambda 2 #f))))) 'error)
+(test (let () (define (f x) (help (lambda `(x 1) 12))) (f (string #\a))) 'error)
+(test (let () (define (func x) (* +(quote (vector? )))) (func '((x 1) (y) . 2))) 'error)
+(test (let () (define (func x) (* +(quote i))) (func cond)) 'error)
+(test (let ((i 1)) (define (func x) (begin i(let -))) (func macroexpand)) 'error)
+(test (let ((i 1)) (define (func x) (if (* i '((x 1) (y) . 2) ) (atan (procedure? 2(sin ))))) (func '(values #\c 3 1.2))) 'error)
+(test (let ((i 1)) (define (func x) (* 1- '(values #\c 3 1.2) )) (func set!)) 'error)
+(test (let ((dynamic-wind 1)) (+ dynamic-wind 2)) 3)
+
+#|
+;;; after much dithering I've decided that built-in C functions have a very aggressive take
+;;; on "lexical scope": if gcd appears as the car of an expression in a function, and
+;;; at that point in the overall s7 process gcd has not been redefined, then the function
+;;; can embed the actual gcd function in that part of its source (as if it was (#_gcd ...)).
+;;; Hence a subsequent (set! gcd +) has no effect on any call that lexically (textually)
+;;; preceded that set!. This is different from the handling of scheme-defined functions
+;;; where (define (a) 0) (define (b) (a)) (define (c) 1) (set! a c) (b) -> 1.
+;;; The decision as to when to replace the 'gcd with the gcd function is up to the optimizer, so
+;;; consistency here is considered of no importance compared to speed -- either don't (set! gcd +)
+;;; or do it before using gcd in any way.
+
+(test (let ()
+ (define (gset-test)
+ (let-temporarily ((gcd +))
+ (do ((sum 0)
+ (x 12)
+ (y 4)
+ (i 0 (+ i 1)))
+ ((= i 3)
+ sum)
+ (set! sum (+ sum (gcd x y)))
+ (set! gcd +))))
+ (define (gset-test-1) (gset-test))
+ (gset-test-1))
+ 36 or 12 -- who knows)
+
+(let ()
+ (define %gcd gcd)
+ (define (gset-test-x)
+ (let ((sum 0)
+ (x 12)
+ (y 4))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) sum)
+ (set! sum (+ sum (%gcd x y))))))
+ (define (gset-test-1x) (gset-test-x))
+
+ (define (gset-test-a)
+ (let ((sum 0)
+ (x 12)
+ (y 4))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) sum)
+ (set! sum (+ sum (gcd x y))))))
+ (define (gset-test-1a) (gset-test-a))
+
+ (define (gset-test-b)
+ (let ((sum 0)
+ (x 12)
+ (y 4))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) sum)
+ (set! sum (+ sum (gcd x y)))
+ (set! gcd +))))
+ (define (gset-test-1b) (gset-test-b))
+
+ (define (gset-test-c)
+ (let ((sum 0)
+ (x 12)
+ (y 4))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) sum)
+ (set! sum (+ sum (gcd x y))))))
+ (define (gset-test-1c) (gset-test-c))
+
+ (let* ((x (gset-test-1x))
+ (a (gset-test-1a))
+ (b (gset-test-1b))
+ (c (gset-test-1c))
+ (a (gset-test-1a)))
+ (set! %gcd +)
+ (let ((xx (gset-test-1x)))
+ (display (list x a b c a xx))
+ (newline))))
+
+
+;;; s7: 12 12 12 12 12 12 12
+;;; guile: 12 12 36 48 48 12 48
+|#
+
+;;; --------------------------------------------------------------------------------
+
#|
;; here's a reasonably complete test of part of the 'or handling
(let ((ops #(not = null? eof-object? boolean? eq? eqv? equal? memq memv member char=? string=? char-ci=? string-ci=? zero?))
@@ -91868,11 +92561,7 @@ etc
xvals))
ops op-args))
ops op-args))
-|#
-
-
-#|
(let ((old+ +))
(let ((vals
(list (let ()
@@ -91905,8 +92594,8 @@ etc
)))
(set! + old+)
(test (car vals) (cadr vals))))
-|#
+;; these confuse t101.scm test suite do loops using +
(let ((old+ +))
(define (f x) (with-let (unlet) (+ x 1)))
(set! + -)
@@ -91923,8 +92612,6 @@ etc
(test (f 2) -1)
(set! + old+)))
-
-#|
;;; this is confusing lint in t101.scm
(set! *#readers* old-readers)
@@ -91944,10 +92631,7 @@ etc
(test (#A #B #C) 2) ; yow!!
(set! *#readers* old-readers)
-|#
-
-#|
(define (mu) ; infinite loop if bignums
(let* ((x 1)
(xp (+ x 1)))
@@ -92094,10 +92778,15 @@ apparently in solaris, it's NaN.0 not nan.0?
|#
(if (provided? 'debugging)
- (format-logged #t "~%;all done! (debugging flag is on)~%")
- (format-logged #t "~%;all done!~%"))
+ (format #t "~%;all done! (debugging flag is on)~%")
+ (format #t "~%;all done!~%"))
;(close-output-port error-port)
+(when (provided? 'profiling)
+ (load "profile.scm")
+ (show-profile 200))
+
(s7-version)
(if s7test-exits (exit))
+
diff --git a/snd-1.h b/snd-1.h
index c3b43e3..bb709aa 100644
--- a/snd-1.h
+++ b/snd-1.h
@@ -369,7 +369,7 @@ typedef struct snd_info {
int selected_channel;
char *filename;
char *short_filename;
- int nchans;
+ unsigned int nchans; /* "unsigned" to make gcc 7.1 happy */
Xen properties;
int properties_loc;
bool remembering;
@@ -1717,6 +1717,7 @@ void reset_mix_ctr(void);
void preload_mixes(mix_state **mixes, int low_id, ed_list *ed);
void free_channel_mixes(chan_info *cp);
void delete_any_remaining_mix_temp_files_at_exit(chan_info *cp);
+void mix_info_to_file(FILE *fd, chan_info *cp);
int mix_sync_from_id(int id);
int mix_set_sync_from_id(int id, int new_sync);
void set_mix_waveform_height(int new_val);
diff --git a/snd-axis.c b/snd-axis.c
index 97af655..53ff79b 100644
--- a/snd-axis.c
+++ b/snd-axis.c
@@ -1893,9 +1893,9 @@ static Xen g_set_x_bounds(Xen bounds, Xen snd, Xen chn, Xen ax)
{
if ((!Xen_is_bound(chn)) && (cp->sound->channel_style == CHANNELS_COMBINED))
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
- if (i != cp->chan)
+ if ((int)i != cp->chan)
set_x_axis_x0x1(sp->chans[i], x0, x1);
/* y-bounds are already tied together in the channels-combined case */
}
diff --git a/snd-chn.c b/snd-chn.c
index f447974..447f5eb 100644
--- a/snd-chn.c
+++ b/snd-chn.c
@@ -44,7 +44,7 @@ chan_info *get_cp(Xen snd, Xen x_chn_n, const char *caller)
chn_n = sp->selected_channel;
else chn_n = 0;
- if ((chn_n >= 0) && (chn_n < sp->nchans) && (sp->chans[chn_n]))
+ if ((chn_n >= 0) && (chn_n < (int)sp->nchans) && (sp->chans[chn_n]))
return(sp->chans[chn_n]);
snd_no_such_channel_error(caller, snd, x_chn_n);
@@ -310,7 +310,7 @@ void chans_field(fcp_t field, mus_float_t val)
int i;
for (i = 0; i < ss->max_sounds; i++)
{
- int j;
+ unsigned int j;
snd_info *sp;
sp = ss->sounds[i];
if ((sp) && ((sp->inuse == SOUND_NORMAL) || (sp->inuse == SOUND_WRAPPER)))
@@ -818,9 +818,9 @@ void add_channel_data(char *filename, chan_info *cp, channel_graph_t graphed)
if ((sp->channel_style == CHANNELS_COMBINED) &&
(sp->nchans > 1))
{
- if (cp->chan == sp->nchans - 1)
+ if (cp->chan == (int)sp->nchans - 1)
{
- int i;
+ unsigned int i;
ymax = 0.0;
for (i = 0; i < sp->nchans; i++)
{
@@ -932,7 +932,7 @@ void apply_y_axis_change(chan_info *cp)
if (sp->channel_style != CHANNELS_SEPARATE)
{
- int i;
+ unsigned int i;
mus_float_t zy, sy;
sy = ap->sy;
zy = ap->zy;
@@ -1076,7 +1076,7 @@ void apply_x_axis_change(chan_info *cp)
else
{
if (sp->channel_style != CHANNELS_SEPARATE)
- for (i = 0; i < sp->nchans; i++) /* not 1 (25-Oct-07: 1 might be selected chan, but 0 needs to reflect changes as well */
+ for (i = 0; i < (int)sp->nchans; i++) /* not 1 (25-Oct-07: 1 might be selected chan, but 0 needs to reflect changes as well */
update_xs(sp->chans[i], ap);
}
}
@@ -1187,9 +1187,9 @@ void focus_x_axis_change(chan_info *cp, int focus_style)
sync = sp->sync;
if (sync != 0)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
- if (i != ncp->chan)
+ if ((int)i != ncp->chan)
{
newf = zoom_focus_location(sp->chans[i]);
if (newf != NO_ZOOM_FOCUS_LOCATION)
@@ -2341,7 +2341,7 @@ static void make_fft_graph(chan_info *cp, axis_info *fap, graphics_context *ax,
mus_long_t size;
size = hisamp - losamp + 1;
fft_phases = (mus_float_t *)malloc(size * sizeof(mus_float_t));
- memcpy((void *)fft_phases, (void *)(&(fp->phases[losamp])), size * sizeof(mus_float_t));
+ copy_floats(fft_phases, &(fp->phases[losamp]), size);
free_phases = true;
}
}
@@ -4398,7 +4398,7 @@ static void display_channel_data_1(chan_info *cp, bool just_fft, bool just_lisp,
channel_set_mix_tags_erased(cp);
#endif
- if ((cp->chan == (sp->nchans - 1)) &&
+ if ((cp->chan == (int)(sp->nchans - 1)) &&
((offset + chan_height) < height))
chan_height = height - offset;
if (((y0 < top) && (y0 >= bottom)) ||
@@ -4802,7 +4802,7 @@ void show_cursor_info(chan_info *cp)
s1 = x_axis_location_to_string(cp, (double)samp / (double)snd_srate(sp)),
samp,
s2 = prettyf(y, digits));
- for (i = 1; i < sp->nchans; i++)
+ for (i = 1; i < (int)sp->nchans; i++)
{
chan_info *ncp;
@@ -5188,7 +5188,7 @@ static char *describe_fft_point(chan_info *cp, int x, int y)
else
return(mus_format("(%.1f%s: %.*f%s (unscaled: %.*f)",
xf,
- ((cp->transform_type == AUTOCORRELATION) ? " samps" : " Hz"),
+ (((cp->transform_type == AUTOCORRELATION) || (cp->transform_type == CEPSTRUM)) ? " samps" : " Hz"),
digits,
(cp->fft_log_magnitude) ? in_dB(cp->min_dB, cp->lin_dB, (fp->data[ind] * fp->scale)) : (fp->data[ind] * fp->scale),
(cp->fft_log_magnitude) ? "dB" : "",
@@ -5249,7 +5249,7 @@ void waveb(chan_info *cp, bool on)
static void propagate_wf_state(snd_info *sp)
{
- int i;
+ unsigned int i;
bool w, f;
chan_info *cp;
@@ -5281,7 +5281,7 @@ void f_button_callback(chan_info *cp, bool on, bool with_control)
update_graph_or_warn(cp);
if (with_control)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
{
chan_info *ncp;
@@ -5315,7 +5315,7 @@ void w_button_callback(chan_info *cp, bool on, bool with_control)
update_graph_or_warn(cp);
if (with_control)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
{
chan_info *ncp;
@@ -5369,7 +5369,7 @@ void key_press_callback(chan_info *ncp, int x, int y, int key_state, int keysym)
chan_info *which_channel(snd_info *sp, int y)
{
- int i;
+ unsigned int i;
chan_info *ncp = NULL;
if (y <= 0) /* this can happen if we drag the mouse over the top of the Snd window, then release it */
@@ -5964,7 +5964,7 @@ void edit_history_select(chan_info *cp, int row)
#if WITH_RELATIVE_PANES || USE_GTK
if (cp->sound->channel_style != CHANNELS_SEPARATE)
{
- int k;
+ unsigned int k;
snd_info *sp;
chan_info *ncp = NULL;
sp = cp->sound;
@@ -6497,7 +6497,7 @@ static Xen channel_get(Xen snd, Xen chn_n, cp_field_t fld, const char *caller)
sp = get_sp(snd);
if (!sp)
return(snd_no_such_sound_error(caller, snd));
- for (i = sp->nchans - 1; i >= 0; i--)
+ for (i = (int)sp->nchans - 1; i >= 0; i--)
res = Xen_cons(channel_get(snd, C_int_to_Xen_integer(i), fld, caller), res);
return(res);
}
@@ -6722,7 +6722,7 @@ static Xen channel_set(Xen snd, Xen chn_n, Xen on, cp_field_t fld, const char *c
sp = get_sp(snd);
if (!sp)
return(snd_no_such_sound_error(caller, snd));
- for (i = sp->nchans - 1; i >= 0; i--)
+ for (i = (int)sp->nchans - 1; i >= 0; i--)
res = Xen_cons(channel_set(snd, C_int_to_Xen_integer(i), on, fld, caller), res);
return(res);
}
@@ -7578,7 +7578,7 @@ static Xen g_maxamp(Xen snd, Xen chn_n, Xen edpos)
sp = get_sp(snd);
if (sp)
{
- int i;
+ unsigned int i;
mus_float_t mx = 0.0;
mus_float_t *vals = NULL;
bool save_maxamp = true;
@@ -9465,7 +9465,7 @@ If 'data' is a list of numbers, it is treated as an envelope."
lg->data[graph] = (mus_float_t *)calloc(len, sizeof(mus_float_t));
lg->len[graph] = len;
}
- memcpy((void *)(lg->data[graph]), (void *)mus_vct_data(v), len * sizeof(mus_float_t));
+ copy_floats(lg->data[graph], mus_vct_data(v), len);
if (ymin > ymax)
{
for (i = 0; i < len; i++)
diff --git a/snd-dac.c b/snd-dac.c
index fd0eae3..0eb738b 100644
--- a/snd-dac.c
+++ b/snd-dac.c
@@ -656,7 +656,7 @@ static void stop_playing_with_toggle(dac_info *dp, dac_toggle_t toggle, with_hoo
(sp->inuse == SOUND_NORMAL) &&
(sp->index >= 0))
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
{
chan_info *cp;
@@ -1354,7 +1354,7 @@ static dac_info *play_sound_1(snd_info *sp, mus_long_t start, mus_long_t end, pl
Xen edpos, Xen stop_proc, const char *caller, int arg_pos)
{
/* just plays one sound (ignores possible sync) */
- int i;
+ unsigned int i;
dac_info *dp = NULL, *rtn_dp = NULL;
if ((background == NOT_IN_BACKGROUND) &&
@@ -1578,10 +1578,10 @@ static int fill_dac_buffers(int write_ok)
framples = snd_dacp->framples;
/* clear buffers */
for (i = 0; i < snd_dacp->channels; i++)
- memset(dac_buffers[i], 0, framples * sizeof(mus_float_t));
+ clear_floats(dac_buffers[i], framples);
if (global_rev)
for (i = 0; i < snd_dacp->channels; i++)
- memset(rev_ins[i], 0, framples * sizeof(mus_float_t));
+ clear_floats(rev_ins[i], framples);
if (dac_pausing)
cursor_change = false;
@@ -2614,7 +2614,7 @@ void clear_players(void)
int i;
for (i = 0; i < players_size; i++)
{
- int j;
+ unsigned int j;
snd_info *sp;
sp = players[i];
if (sp)
@@ -3018,7 +3018,7 @@ If object is a string, it is assumed to be a file name: \n " play_example "\n
play_sound_1(sp, start, end, background, edit_position, stop_func, S_play, edpos_argpos);
else
{
- if ((channel < sp->nchans) &&
+ if ((channel <(int)(sp->nchans)) &&
(channel >= 0))
{
int pos;
@@ -3118,7 +3118,7 @@ static Xen g_player_home(Xen player)
(index < players_size) &&
(players[index]) &&
(players[index]->chans) &&
- (player_chans[index] < players[index]->nchans))
+ (player_chans[index] < (int)players[index]->nchans))
{
chan_info *cp;
cp = players[index]->chans[player_chans[index]]; /* trying to get back to the original sound index (not the player index) */
@@ -3206,7 +3206,7 @@ If a play-list is waiting, start it."
Xen_check_type(Xen_is_boolean_or_unbound(In_Background), In_Background, 3, S_start_playing, "a boolean");
if (Xen_is_integer(Chans)) chans = Xen_integer_to_C_int(Chans);
- if ((chans <= 0) || (chans > 256))
+ if ((chans <= 0) || (chans > MUS_MAX_CHANS))
Xen_out_of_range_error(S_start_playing, 1, Chans, "chans <= 0 or > 256?");
if (Xen_is_integer(Srate)) srate = Xen_integer_to_C_int(Srate);
diff --git a/snd-data.c b/snd-data.c
index d2673ca..5aeba48 100644
--- a/snd-data.c
+++ b/snd-data.c
@@ -370,7 +370,7 @@ snd_info *make_snd_info(snd_info *sip, const char *filename, file_info *hdr, int
void free_snd_info(snd_info *sp)
{
- int i;
+ unsigned int i;
#if (!USE_NO_GUI)
env_editor *edp;
@@ -474,7 +474,7 @@ void for_each_chan_with_int(void (*func)(chan_info *ncp, int val), int value)
int i;
for (i = 0; i < ss->max_sounds; i++)
{
- int j;
+ unsigned int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -491,7 +491,7 @@ void for_each_chan_with_mus_long_t(void (*func)(chan_info *ncp, mus_long_t val),
int i;
for (i = 0; i < ss->max_sounds; i++)
{
- int j;
+ unsigned int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -508,7 +508,7 @@ void for_each_chan_with_bool(void (*func)(chan_info *ncp, bool val), bool value)
int i;
for (i = 0; i < ss->max_sounds; i++)
{
- int j;
+ unsigned int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -525,7 +525,7 @@ void for_each_chan_with_float(void (*func)(chan_info *ncp, mus_float_t val), mus
int i;
for (i = 0; i < ss->max_sounds; i++)
{
- int j;
+ unsigned int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -542,7 +542,7 @@ void for_each_chan(void (*func)(chan_info *ncp))
int i;
for (i = 0; i < ss->max_sounds; i++)
{
- int j;
+ unsigned int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -559,7 +559,7 @@ void for_each_normal_chan_with_void(void (*func)(chan_info *ncp, void *ptr), voi
int i;
for (i = 0; i < ss->max_sounds; i++)
{
- int j;
+ unsigned int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -576,7 +576,7 @@ void for_each_normal_chan_with_int(void (*func)(chan_info *ncp, int val), int va
int i;
for (i = 0; i < ss->max_sounds; i++)
{
- int j;
+ unsigned int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -593,7 +593,7 @@ void for_each_normal_chan_with_refint(void (*func)(chan_info *ncp, int *val), in
int i;
for (i = 0; i < ss->max_sounds; i++)
{
- int j;
+ unsigned int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -610,7 +610,7 @@ void for_each_normal_chan(void (*func)(chan_info *ncp))
int i;
for (i = 0; i < ss->max_sounds; i++)
{
- int j;
+ unsigned int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -624,8 +624,8 @@ void for_each_normal_chan(void (*func)(chan_info *ncp))
void for_each_sound_chan_with_int(snd_info *sp, void (*func)(chan_info *ncp, int val1), int value)
{
- int j;
- chan_info *cp;
+ unsigned int j;
+ chan_info *cp;
for (j = 0; j < sp->nchans; j++)
if ((cp = sp->chans[j]))
(*func)(cp, value);
@@ -634,7 +634,7 @@ void for_each_sound_chan_with_int(snd_info *sp, void (*func)(chan_info *ncp, int
bool map_over_sound_chans(snd_info *sp, bool (*func)(chan_info *ncp))
{
- int j;
+ unsigned int j;
bool val = false;
chan_info *cp;
for (j = 0; j < sp->nchans; j++)
@@ -649,7 +649,7 @@ bool map_over_sound_chans(snd_info *sp, bool (*func)(chan_info *ncp))
void for_each_sound_chan(snd_info *sp, void (*func)(chan_info *ncp))
{
- int j;
+ unsigned int j;
chan_info *cp;
for (j = 0; j < sp->nchans; j++)
if ((cp = sp->chans[j]))
@@ -971,7 +971,7 @@ sync_info *snd_sync(int sync)
(sp->inuse == SOUND_NORMAL) &&
(sp->sync == sync))
{
- int k;
+ unsigned int k;
for (k = 0; k < sp->nchans; k++, j++)
si->cps[j] = sp->chans[k];
}
diff --git a/snd-edits.c b/snd-edits.c
index 4abd21a..9faa32b 100644
--- a/snd-edits.c
+++ b/snd-edits.c
@@ -3008,7 +3008,7 @@ snd_info *sound_is_silence(snd_info *sp)
{
if (sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
{
chan_info *cp;
@@ -3657,7 +3657,7 @@ bool insert_complete_file(snd_info *sp, const char *str, mus_long_t chan_beg, fi
ncp = sp->chans[0];
else ncp = any_selected_channel(sp);
first_chan = ncp->chan;
- for (i = first_chan, j = 0; (j < nc) && (i < sp->nchans); i++, j++)
+ for (i = first_chan, j = 0; (j < nc) && (i < (int)sp->nchans); i++, j++)
{
char *origin;
ncp = sp->chans[i];
@@ -5527,7 +5527,7 @@ io_error_t save_edits_and_update_display(snd_info *sp)
ofile = snd_tempnam();
/* this will use user's TMPDIR if temp_dir(ss) is not set, else stdio.h's P_tmpdir else /tmp */
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
chan_info *ncp;
ncp = sp->chans[i];
@@ -5542,7 +5542,7 @@ io_error_t save_edits_and_update_display(snd_info *sp)
{
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++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
chan_info *ncp;
ncp = sp->chans[i];
@@ -5552,7 +5552,7 @@ io_error_t save_edits_and_update_display(snd_info *sp)
}
sf = (snd_fd **)calloc(sp->nchans, sizeof(snd_fd *));
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
sf[i] = init_sample_read(0, sp->chans[i], READ_FORWARD);
if (!sf[i])
@@ -5570,7 +5570,7 @@ io_error_t save_edits_and_update_display(snd_info *sp)
/* write the new file */
io_err = snd_make_file(ofile, sp->nchans, sp->hdr, sf, samples, true);
- for (i = 0; i < sp->nchans; i++) free_snd_fd(sf[i]);
+ for (i = 0; i < (int)sp->nchans; i++) free_snd_fd(sf[i]);
free(sf);
sf = NULL;
if (io_err != IO_NO_ERROR)
@@ -5589,7 +5589,7 @@ io_error_t save_edits_and_update_display(snd_info *sp)
sphdr->samples = samples * sp->nchans;
ms = (void *)sound_store_marks(sp);
old_cursors = (mus_long_t *)calloc(sp->nchans, sizeof(mus_long_t));
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
chan_info *cp;
cp = sp->chans[i];
@@ -5643,7 +5643,7 @@ io_error_t save_edits_and_update_display(snd_info *sp)
restore_axes_data(sp, sa, mus_sound_duration(sp->filename), true);
sound_restore_marks(sp, ms);
free_axes_data(sa);
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
cursor_sample(sp->chans[i]) = old_cursors[i];
free(old_cursors);
reflect_file_revert_in_label(sp);
@@ -5687,7 +5687,7 @@ io_error_t save_edits_without_display(snd_info *sp, const char *new_name, mus_he
else hdr->comment = NULL;
hdr->data_location = 0; /* in case comment changes it */
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
chan_info *ncp;
ncp = sp->chans[i];
@@ -5702,7 +5702,7 @@ io_error_t save_edits_without_display(snd_info *sp, const char *new_name, mus_he
{
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++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
chan_info *ncp;
ncp = sp->chans[i];
@@ -5712,7 +5712,7 @@ io_error_t save_edits_without_display(snd_info *sp, const char *new_name, mus_he
}
sf = (snd_fd **)malloc(sp->nchans * sizeof(snd_fd *));
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
chan_info *cp;
int local_pos;
@@ -5722,7 +5722,7 @@ io_error_t save_edits_without_display(snd_info *sp, const char *new_name, mus_he
sf[i] = init_sample_read_any(0, cp, READ_FORWARD, local_pos);
if (!sf[i])
{
- int k;
+ unsigned int k;
/* this should not (cannot?) happen since we've supposedly checked before getting here... */
for (k = 0; k < sp->nchans; k++)
sf[k] = free_snd_fd(sf[k]);
@@ -5747,7 +5747,7 @@ io_error_t save_edits_without_display(snd_info *sp, const char *new_name, mus_he
free(times);
}
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
free_snd_fd(sf[i]);
free(sf);
free_file_info(hdr);
@@ -5802,7 +5802,7 @@ io_error_t save_channel_edits(chan_info *cp, const char *ofile, int pos)
bool has_unsaved_edits(snd_info *sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
if (sp->chans[i]->edit_ctr > 0)
return(true);
@@ -6958,7 +6958,6 @@ static Xen g_sampler_position(Xen obj)
return(C_llong_to_Xen_llong(region_current_location(fd)));
}
}
-
if (is_mix_sampler(obj))
return(g_mix_sampler_position(obj));
@@ -6988,7 +6987,6 @@ if 'obj' is a mix-sampler, the id of underlying mix"
C_int_to_Xen_integer(fd->cp->chan)));
}
}
-
if (is_mix_sampler(obj))
return(g_mix_sampler_home(obj));
@@ -7105,7 +7103,7 @@ snd can be a filename, a mix, a region, or a sound index number."
else return(snd_no_such_file_error(S_make_sampler, snd));
if (Xen_is_integer(chn)) chan = Xen_integer_to_C_int(chn);
if ((chan < 0) ||
- (chan >= loc_sp->nchans))
+ (chan >= (int)loc_sp->nchans))
{
completely_free_snd_info(loc_sp);
return(snd_no_such_channel_error(S_make_sampler, snd, chn));
@@ -7153,9 +7151,8 @@ static Xen g_is_sampler(Xen obj)
{
snd_fd *fd;
fd = Xen_to_C_sampler(obj);
- return(C_bool_to_Xen_boolean(fd->type == SAMPLER));
+ return(C_bool_to_Xen_boolean((fd->type == SAMPLER) || (fd->type == REGION_READER)));
}
-
if (is_mix_sampler(obj))
return(C_string_to_Xen_symbol("mix"));
@@ -7163,9 +7160,9 @@ static Xen g_is_sampler(Xen obj)
}
-static Xen g_region_is_sampler(Xen obj)
+static Xen g_is_region_sampler(Xen obj)
{
- #define H_region_is_sampler "(" S_is_region_sampler " obj): " PROC_TRUE " if obj is a region sampler."
+ #define H_is_region_sampler "(" S_is_region_sampler " obj): " PROC_TRUE " if obj is a region sampler."
if (is_sampler(obj))
{
snd_fd *fd;
@@ -7203,7 +7200,6 @@ static Xen g_copy_sampler(Xen obj)
}
return(Xen_false);
}
-
if (is_mix_sampler(obj))
return(g_copy_mix_sampler(obj));
@@ -7300,9 +7296,9 @@ static Xen g_free_sampler(Xen obj)
free_snd_fd_almost(fd); /* this is different from sf_free! */
if (sp) completely_free_snd_info(sp);
}
-
if (is_mix_sampler(obj))
return(g_free_mix_sampler(obj));
+
return(Xen_false);
}
@@ -7342,7 +7338,7 @@ static Xen g_save_edit_history(Xen filename, Xen snd, Xen chn)
{
sp = get_sp(snd);
if (sp)
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
edit_history_to_file(fd, sp->chans[i], false);
}
else
@@ -7350,7 +7346,7 @@ static Xen g_save_edit_history(Xen filename, Xen snd, Xen chn)
for (i = 0; i < ss->max_sounds; i++)
{
- int j;
+ unsigned int j;
sp = ss->sounds[i];
if ((sp) && (sp->inuse == SOUND_NORMAL))
for (j = 0; j < sp->nchans; j++)
@@ -7930,7 +7926,7 @@ return sample samp in snd's channel chn (this is a slow access -- use samplers f
beg = beg_to_sample(samp_n, S_sample);
loc = snd_protect(lst);
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
if (pos > sp->chans[i]->edit_ctr)
lst = Xen_cons(C_double_to_Xen_real(chn_sample(beg, sp->chans[i], sp->chans[i]->edit_ctr)), lst);
@@ -8300,7 +8296,7 @@ vct *samples_to_vct(mus_long_t beg, mus_long_t len, chan_info *cp, int pos, mus_
if (sf->runf == next_sample_value_unscaled)
{
- memcpy((void *)(fvals + i), (void *)(sf->data + sf->loc), dur * sizeof(mus_float_t));
+ copy_floats(fvals + i, sf->data + sf->loc, dur);
i += dur;
}
else
@@ -8309,7 +8305,7 @@ vct *samples_to_vct(mus_long_t beg, mus_long_t len, chan_info *cp, int pos, mus_
{
mus_float_t scl;
scl = sf->fscaler;
- memcpy((void *)(fvals + i), (void *)(sf->data + sf->loc), dur * sizeof(mus_float_t));
+ copy_floats(fvals + i, sf->data + sf->loc, dur);
left = i + dur;
for (; i < left; i++) fvals[i] *= scl;
}
@@ -8647,7 +8643,7 @@ position.\n " insert_sound_example "\ninserts all of oboe.snd starting at sampl
int i;
snd_info *sp;
sp = cp->sound;
- if (sp->nchans < nc) nc = sp->nchans;
+ if ((int)sp->nchans < nc) nc = sp->nchans;
for (i = 0; i < nc; i++)
{
#if HAVE_FORTH
@@ -9074,112 +9070,31 @@ static Xen g_edit_list_to_function(Xen snd, Xen chn, Xen start, Xen end)
}
#if HAVE_SCHEME
-static s7_double next_sample_rf_s(s7_scheme *sc, s7_pointer **p)
+static s7_double next_sample_dv(void *o)
{
- snd_fd *fd;
- fd = (snd_fd *)(*(*p)); (*p)++;
+ snd_fd *fd = (snd_fd *)o;
return(protected_next_sample(fd));
}
-static s7_double read_sample_rf_s(s7_scheme *sc, s7_pointer **p)
+static s7_double read_sample_dv(void *o)
{
- snd_fd *fd;
- fd = (snd_fd *)(*(*p)); (*p)++;
+ snd_fd *fd = (snd_fd *)o;
return(read_sample(fd));
}
-static s7_double next_mix_sample_rf_s(s7_scheme *sc, s7_pointer **p)
+static s7_double next_mix_sample_dv(void *o)
{
snd_fd *fd;
- fd = (snd_fd *)(*(*p)); (*p)++;
+ fd = (snd_fd *)mf_to_snd_fd(o);
return(protected_next_sample(fd));
}
-static s7_double read_mix_sample_rf_s(s7_scheme *sc, s7_pointer **p)
+static s7_double read_mix_sample_dv(void *o)
{
snd_fd *fd;
- fd = (snd_fd *)(*(*p)); (*p)++;
+ fd = (snd_fd *)mf_to_snd_fd(o);
return(read_sample(fd));
}
-
-static s7_rf_t read_sample_rf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer sym, o;
- snd_fd *g;
-
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); /* just (gen s) for now */
- sym = s7_cadr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- if (s7_xf_is_stepper(sc, sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- g = (snd_fd *)s7_object_value_checked(o, sf_tag);
- if (g)
- {
- s7_xf_store(sc, (s7_pointer)g);
- return(read_sample_rf_s);
- }
- if (is_mix_sampler(o))
- {
- s7_xf_store(sc, (s7_pointer)mf_to_snd_fd(s7_object_value(o)));
- return(read_mix_sample_rf_s);
- }
- return(NULL);
-}
-
-static s7_rf_t next_sample_rf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer sym, o;
- snd_fd *g;
-
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL);
- sym = s7_cadr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- if (s7_xf_is_stepper(sc, sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- g = (snd_fd *)s7_object_value_checked(o, sf_tag);
- if (g)
- {
- s7_xf_store(sc, (s7_pointer)g);
- return(next_sample_rf_s);
- }
- if (is_mix_sampler(o))
- {
- s7_xf_store(sc, (s7_pointer)mf_to_snd_fd(s7_object_value(o)));
- return(next_mix_sample_rf_s);
- }
- return(NULL);
-}
-
-static s7_pointer is_sampler_at_end_pf_s(s7_scheme *sc, s7_pointer **p)
-{
- snd_fd *fd;
- fd = (snd_fd *)(*(*p)); (*p)++;
- return(s7_make_boolean(sc, fd->at_eof));
-}
-
-static s7_pf_t is_sampler_at_end_pf(s7_scheme *sc, s7_pointer expr)
-{
- s7_pointer sym, o;
- snd_fd *g;
-
- if (!s7_is_null(sc, s7_cddr(expr))) return(NULL);
- sym = s7_cadr(expr);
- if (!s7_is_symbol(sym)) return(NULL);
- if (s7_xf_is_stepper(sc, sym)) return(NULL);
- o = s7_symbol_value(sc, sym);
- g = (snd_fd *)s7_object_value_checked(o, sf_tag);
- if (g)
- {
- s7_xf_store(sc, (s7_pointer)g);
- return(is_sampler_at_end_pf_s);
- }
- if (is_mix_sampler(o))
- {
- s7_xf_store(sc, (s7_pointer)mf_to_snd_fd(s7_object_value(o)));
- return(is_sampler_at_end_pf_s);
- }
- return(NULL);
-}
#endif
@@ -9193,7 +9108,7 @@ Xen_wrap_1_arg(g_free_sampler_w, g_free_sampler)
Xen_wrap_1_arg(g_sampler_home_w, g_sampler_home)
Xen_wrap_1_arg(g_sampler_position_w, g_sampler_position)
Xen_wrap_1_arg(g_is_sampler_w, g_is_sampler)
-Xen_wrap_1_arg(g_region_is_sampler_w, g_region_is_sampler)
+Xen_wrap_1_arg(g_is_region_sampler_w, g_is_region_sampler)
Xen_wrap_1_arg(g_sampler_at_end_w, g_sampler_at_end)
Xen_wrap_1_arg(g_copy_sampler_w, g_copy_sampler)
Xen_wrap_3_optional_args(g_save_edit_history_w, g_save_edit_history)
@@ -9248,7 +9163,8 @@ void g_init_edits(void)
smp = s7_make_symbol(s7, "sampler?");
x = s7_make_signature(s7, 2, smp, s7_make_symbol(s7, "mix-sampler?"));
t = s7_t(s7);
- pl_fx = s7_make_signature(s7, 2, f, x);
+ /* 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);
#else
@@ -9278,7 +9194,7 @@ void g_init_edits(void)
Xen_define_typed_procedure(S_free_sampler, g_free_sampler_w, 1, 0, 0, H_free_sampler, s7_make_signature(s7, 2, b, x));
Xen_define_typed_procedure(S_sampler_home, g_sampler_home_w, 1, 0, 0, H_sampler_home, s7_make_signature(s7, 2, t, x));
Xen_define_typed_procedure(S_is_sampler, g_is_sampler_w, 1, 0, 0, H_is_sampler, s7_make_signature(s7, 2, b, t));
- Xen_define_typed_procedure(S_is_region_sampler, g_region_is_sampler_w, 1, 0, 0, H_region_is_sampler, s7_make_signature(s7, 2, b, x));
+ Xen_define_typed_procedure(S_is_region_sampler, g_is_region_sampler_w, 1, 0, 0, H_is_region_sampler, s7_make_signature(s7, 2, b, x));
Xen_define_typed_procedure(S_is_sampler_at_end, g_sampler_at_end_w, 1, 0, 0, H_sampler_at_end, s7_make_signature(s7, 2, b, x));
Xen_define_typed_procedure(S_sampler_position, g_sampler_position_w, 1, 0, 0, H_sampler_position, s7_make_signature(s7, 2, i, x));
Xen_define_typed_procedure(S_copy_sampler, g_copy_sampler_w, 1, 0, 0, H_copy_sampler, s7_make_signature(s7, 2, x, x));
@@ -9358,13 +9274,16 @@ keep track of which files are in a given saved state batch, and a way to rename
edit_finish = s7_make_function(s7, "(finish-as-one-edit)", g_edit_finish, 0, 0, false, "");
f = s7_name_to_value(s7, "next-sample");
- s7_rf_set_function(f, next_sample_rf);
+ s7_set_d_v_function(f, next_sample_dv);
f = s7_name_to_value(s7, "read-sample");
- s7_rf_set_function(f, read_sample_rf);
+ s7_set_d_v_function(f, read_sample_dv);
+
+ f = s7_name_to_value(s7, "next-mix-sample");
+ s7_set_d_v_function(f, next_mix_sample_dv);
- f = s7_name_to_value(s7, "sampler-at-end?");
- s7_pf_set_function(f, is_sampler_at_end_pf);
+ f = s7_name_to_value(s7, "read-mix-sample");
+ s7_set_d_v_function(f, read_mix_sample_dv);
}
#endif
diff --git a/snd-env.c b/snd-env.c
index 3d9bcea..18980bb 100644
--- a/snd-env.c
+++ b/snd-env.c
@@ -35,7 +35,7 @@ env *copy_env(env *e)
ne->pts = e->pts;
ne->data_size = e->pts * 2;
ne->data = (mus_float_t *)malloc(ne->data_size * sizeof(mus_float_t));
- memcpy((void *)(ne->data), (void *)(e->data), ne->data_size * sizeof(mus_float_t));
+ copy_floats(ne->data, e->data, ne->data_size);
ne->base = e->base;
return(ne);
}
diff --git a/snd-fft.c b/snd-fft.c
index a85dd09..eb8587f 100644
--- a/snd-fft.c
+++ b/snd-fft.c
@@ -47,7 +47,7 @@ static void wavelet_transform(mus_float_t *data, mus_long_t num, mus_float_t *cc
data1[ii + nh] += cr[k] * data[jf];
}
}
- memcpy((void *)data, (void *)data1, n * sizeof(mus_float_t));
+ copy_floats(data, data1, n);
}
if (data1) free(data1);
@@ -742,15 +742,15 @@ void fourier_spectrum(snd_fd *sf, mus_float_t *fft_data, mus_long_t fft_size, mu
}
if (data_len < fft_size)
- memset((void *)(fft_data + data_len), 0, (fft_size - data_len) * sizeof(mus_float_t));
+ clear_floats(fft_data + data_len, fft_size - data_len);
if (fft_size <= fs_idata_size)
- memset((void *)fs_idata, 0, fft_size * sizeof(mus_float_t));
+ clear_floats(fs_idata, fft_size);
else
{
if (!fs_idata)
fs_idata = (mus_float_t *)malloc(fft_size * sizeof(mus_float_t));
else fs_idata = (mus_float_t *)realloc(fs_idata, fft_size * sizeof(mus_float_t));
- memset((void *)fs_idata, 0, fft_size * sizeof(mus_float_t));
+ clear_floats(fs_idata, fft_size);
fs_idata_size = fft_size;
}
@@ -838,35 +838,35 @@ static void apply_fft(fft_state *fs)
case WAVELET:
for (i = 0; i < data_len; i++) fft_data[i] = read_sample(sf);
if (data_len < fs->size)
- memset((void *)(fft_data + data_len), 0, (fs->size - data_len) * sizeof(mus_float_t));
+ clear_floats(fft_data + data_len, fs->size - data_len);
wavelet_transform(fft_data, fs->size, wavelet_data[cp->wavelet_type], wavelet_sizes[cp->wavelet_type]);
break;
case HAAR:
for (i = 0; i < data_len; i++) fft_data[i] = read_sample(sf);
if (data_len < fs->size)
- memset((void *)(fft_data + data_len), 0, (fs->size - data_len) * sizeof(mus_float_t));
+ clear_floats(fft_data + data_len, fs->size - data_len);
haar_transform(fft_data, fs->size);
break;
case CEPSTRUM:
for (i = 0; i < data_len; i++) fft_data[i] = read_sample(sf);
if (data_len < fs->size)
- memset((void *)(fft_data + data_len), 0, (fs->size - data_len) * sizeof(mus_float_t));
+ clear_floats(fft_data + data_len, fs->size - data_len);
mus_cepstrum(fft_data, fs->size);
break;
case WALSH:
for (i = 0; i < data_len; i++) fft_data[i] = read_sample(sf);
if (data_len < fs->size)
- memset((void *)(fft_data + data_len), 0, (fs->size - data_len) * sizeof(mus_float_t));
+ clear_floats(fft_data + data_len, fs->size - data_len);
walsh_transform(fft_data, fs->size);
break;
case AUTOCORRELATION:
for (i = 0; i < data_len; i++) fft_data[i] = read_sample(sf);
if (data_len < fs->size)
- memset((void *)(fft_data + data_len), 0, (fs->size - data_len) * sizeof(mus_float_t));
+ clear_floats(fft_data + data_len, fs->size - data_len);
mus_autocorrelate(fft_data, fs->size);
break;
@@ -887,7 +887,7 @@ static void apply_fft(fft_state *fs)
mus_long_t len;
v = Xen_to_vct(res);
len = mus_vct_length(v);
- memcpy((void *)fft_data, (void *)(mus_vct_data(v)), len * sizeof(mus_float_t));
+ copy_floats(fft_data, mus_vct_data(v), len);
}
snd_unprotect_at(gc_loc);
snd_unprotect_at(sf_loc);
@@ -979,7 +979,7 @@ static void display_fft(fft_state *fs)
(sp->nchans > 1) &&
(sp->channel_style == CHANNELS_SUPERIMPOSED)))
{
- int j;
+ unsigned int j;
for (j = 0; j < sp->nchans; j++)
{
ncp = sp->chans[j];
@@ -1303,7 +1303,7 @@ static void one_fft(fft_state *fs)
last_wintype = fs->wintype;
last_zero = fs->pad_zero;
}
- memcpy(fs->window, (void *)last_window, fs->size * sizeof(mus_float_t));
+ copy_floats(fs->window, last_window, fs->size);
}
apply_fft(fs);
}
@@ -1871,7 +1871,7 @@ void c_convolve(const char *fname, mus_float_t amp, int filec, mus_long_t filehd
else
{
/* amp == 0.0 means un-normalized output */
- memcpy((void *)pbuf, (void *)rl0, data_size * sizeof(mus_float_t));
+ copy_floats(pbuf, rl0, data_size);
}
progress_report(gcp, .9);
@@ -2069,7 +2069,7 @@ return a " S_vct " (obj if it's passed), with the current transform data from sn
if (v1)
fvals = mus_vct_data(v1);
else fvals = (mus_float_t *)malloc(len * sizeof(mus_float_t));
- memcpy((void *)fvals, (void *)(fp->data), len * sizeof(mus_float_t));
+ copy_floats(fvals, fp->data, len);
if (v1)
return(v);
else return(xen_make_vct(len, fvals));
diff --git a/snd-file.c b/snd-file.c
index ed55089..b650fdd 100644
--- a/snd-file.c
+++ b/snd-file.c
@@ -997,9 +997,9 @@ file_info *make_file_info(const char *fullname, read_only_t read_only, bool sele
sr = mus_sound_srate(fullname);
ch = mus_sound_chans(fullname);
if ((fallback_srate > 0) && ((sr <= 0) || (sr > 100000000))) sr = fallback_srate;
- if ((fallback_chans > 0) && ((ch >= 256) || (ch <= 0))) ch = fallback_chans;
+ if ((fallback_chans > 0) && ((ch >= MUS_MAX_CHANS) || (ch <= 0))) ch = fallback_chans;
if ((sr <= 0) || (sr > 100000000) ||
- (ch >= 256) || (ch <= 0))
+ (ch >= MUS_MAX_CHANS) || (ch <= 0))
return(tackle_bad_header(fullname, read_only, selected));
/* header is ok */
@@ -1268,7 +1268,6 @@ snd_info *snd_open_file(const char *filename, read_only_t read_only)
void snd_close_file(snd_info *sp)
{
- int i;
Xen res = Xen_false;
snd_info *chosen_sp = NULL;
@@ -1310,20 +1309,23 @@ void snd_close_file(snd_info *sp)
* segfault!
*/
- for (i = 0; i < sp->nchans; i++)
- sp->chans[i]->squelch_update = true;
- /* check_for_event(); */
-
- sp->file_watcher = unmonitor_file(sp->file_watcher);
-
- /* exit does not go through this function to clean up temps -- see snd_exit_cleanly in snd-main.c */
- if (selection_creation_in_progress()) finish_selection_creation();
-
- if (ss->deferred_regions > 0)
- for (i = 0; i < sp->nchans; i++)
- if (sp->chans[i])
- sequester_deferred_regions(sp->chans[i], -1);
-
+ {
+ unsigned int i;
+ for (i = 0; i < sp->nchans; i++)
+ sp->chans[i]->squelch_update = true;
+ /* check_for_event(); */
+
+ sp->file_watcher = unmonitor_file(sp->file_watcher);
+
+ /* exit does not go through this function to clean up temps -- see snd_exit_cleanly in snd-main.c */
+ if (selection_creation_in_progress()) finish_selection_creation();
+
+ if (ss->deferred_regions > 0)
+ for (i = 0; i < sp->nchans; i++)
+ if (sp->chans[i])
+ sequester_deferred_regions(sp->chans[i], -1);
+ }
+
sp->inuse = SOUND_IDLE;
if (sp->playing)
stop_playing_sound(sp, PLAY_CLOSE);
@@ -1414,7 +1416,7 @@ snd_info *make_sound_readable(const char *filename, bool post_close)
sp->index = TEMP_SOUND_INDEX;
len = (hdr->samples) / (hdr->chans);
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
int fd;
cp = make_chan_info(NULL, i, sp);
@@ -1499,7 +1501,7 @@ axes_data *make_axes_data(snd_info *sp)
void restore_axes_data(snd_info *sp, axes_data *sa, mus_float_t new_duration, bool need_edit_history_update)
{
int i, j;
- for (i = 0, j = 0; i < sp->nchans; i++)
+ for (i = 0, j = 0; i < (int)sp->nchans; i++)
{
chan_info *cp;
axis_info *ap;
@@ -1661,7 +1663,7 @@ static snd_info *sound_store_chan_info(snd_info *sp)
{
chan_info **cps;
snd_info *nsp;
- int i;
+ unsigned int i;
nsp = (snd_info *)calloc(1, sizeof(snd_info));
cps = (chan_info **)calloc(sp->nchans, sizeof(chan_info *));
@@ -1679,7 +1681,7 @@ static snd_info *sound_store_chan_info(snd_info *sp)
static void sound_restore_chan_info(snd_info *nsp, snd_info *osp)
{
- int i;
+ unsigned int i;
chan_info **cps;
cps = osp->chans;
@@ -1845,17 +1847,17 @@ snd_info *snd_update(snd_info *sp)
nsp->saved_controls = saved_controls;
if (saved_controls) restore_controls(nsp);
- if (nsp->nchans == sp_chans) sound_restore_chan_info(nsp, saved_sp);
+ if ((int)nsp->nchans == sp_chans) sound_restore_chan_info(nsp, saved_sp);
if ((old_selected_channel != NO_SELECTION) &&
- (old_selected_channel < nsp->nchans) &&
+ (old_selected_channel < (int)nsp->nchans) &&
(nsp == selected_sound()))
select_channel(nsp, old_selected_channel);
restore_axes_data(nsp, sa, mus_sound_duration(filename), false);
sound_restore_marks(nsp, ms);
- for (i = 0; (i < nsp->nchans) && (i < sp_chans); i++)
+ for (i = 0; (i < (int)nsp->nchans) && (i < sp_chans); i++)
cursor_sample(nsp->chans[i]) = old_cursors[i];
if ((nsp->nchans > 1) &&
@@ -1875,7 +1877,7 @@ snd_info *snd_update(snd_info *sp)
if (saved_sp)
{
- for (i = 0; i < saved_sp->nchans; i++)
+ for (i = 0; i < (int)saved_sp->nchans; i++)
if (saved_sp->chans[i]) free(saved_sp->chans[i]);
free(saved_sp->chans);
free(saved_sp);
@@ -2785,7 +2787,8 @@ static char *display_file_maxamps(const char *filename, int chans)
static char *display_sound_maxamps(snd_info *sp)
{
char *ampstr = NULL;
- int i, len;
+ unsigned int i;
+ int len;
len = sp->nchans * 32;
ampstr = (char *)calloc(len, sizeof(char));
snprintf(ampstr, len, "maxamp%s: ", (sp->nchans > 1) ? "s" : "");
@@ -2835,7 +2838,7 @@ void display_info(snd_info *sp)
post_it_append(buffer);
}
- if (hdr->chans != sp->nchans)
+ if (hdr->chans != (int)sp->nchans)
{
snprintf(buffer, INFO_BUFFER_SIZE, " original chans: %d\n", hdr->chans);
post_it_append(buffer);
@@ -2856,7 +2859,7 @@ void display_info(snd_info *sp)
if (mus_sound_maxamp_exists(sp->filename))
{
- int i;
+ unsigned int i;
bool edits = false;
for (i = 0; i < sp->nchans; i++)
if (sp->chans[i]->edit_ctr > 0)
@@ -3575,7 +3578,7 @@ displayed whn it is opened."
sp = ss->sounds[i];
if ((sp) && (sp->inuse == SOUND_NORMAL))
{
- int j;
+ unsigned int j;
for (j = 0; j < sp->nchans; j++)
set_x_axis_x0x1(sp->chans[j], 0.0, sp->chans[j]->axis->xmax);
}
@@ -3626,7 +3629,7 @@ max and min when it is opened."
sp = ss->sounds[i];
if ((sp) && (sp->inuse == SOUND_NORMAL))
{
- int j;
+ unsigned int j;
for (j = 0; j < sp->nchans; j++)
{
chan_info *cp;
diff --git a/snd-find.c b/snd-find.c
index b2ebb17..f8cb310 100644
--- a/snd-find.c
+++ b/snd-find.c
@@ -121,7 +121,7 @@ static char *channel_search(chan_info *cp, read_direction_t direction)
static char *global_search(read_direction_t direction, bool repeating)
{
- int i, j;
+ int i;
if ((repeating) &&
((!previous_channel) ||
@@ -132,7 +132,7 @@ static char *global_search(read_direction_t direction, bool repeating)
for (i = 0; i < ss->max_sounds; i++)
{
snd_info *sp;
-
+ unsigned int j;
sp = ss->sounds[i];
if ((sp) &&
(sp->inuse == SOUND_NORMAL))
diff --git a/snd-gchn.c b/snd-gchn.c
index 7969e92..ae8f58f 100644
--- a/snd-gchn.c
+++ b/snd-gchn.c
@@ -523,7 +523,8 @@ static void remake_edit_history(chan_info *cp)
sp = cp->sound;
if (sp->channel_style != CHANNELS_SEPARATE)
{
- int k, ed, filelen;
+ unsigned int k;
+ int ed, filelen;
char *title;
chan_info *ncp;
filelen = 16 + strlen(sp->filename);
@@ -992,8 +993,10 @@ int add_channel_window(snd_info *sp, int channel, int chan_y, int insertion, Gtk
}
else recolor_graph(cp, false); /* in case selection color left over from previous use */
+#if (!GTK_CHECK_VERSION(3, 90, 0))
if ((sp->channel_style != CHANNELS_COMBINED) || (channel == 0))
gtk_widget_show_all(cw[W_main_window]);
+#endif
if ((need_extra_scrollbars) && (sp->channel_style != CHANNELS_COMBINED))
hide_gz_scrollbars(sp); /* default is on in this case */
@@ -1100,7 +1103,7 @@ void change_channel_style(snd_info *sp, channel_style_t new_style)
if (new_style != old_style)
{
- int i;
+ unsigned int i;
int height[1];
if ((new_style == CHANNELS_SEPARATE) || (old_style == CHANNELS_SEPARATE))
remake_edit_history(sp->chans[0]);
@@ -1138,7 +1141,7 @@ void change_channel_style(snd_info *sp, channel_style_t new_style)
for (i = 0; i < sp->nchans; i++)
{
- if (i != selected_cp->chan)
+ if ((int)i != selected_cp->chan)
{
chan_info *ncp;
ncp = sp->chans[i];
@@ -1166,7 +1169,7 @@ void change_channel_style(snd_info *sp, channel_style_t new_style)
for (i = 0; i < sp->nchans; i++)
{
- if (i != selected_cp->chan)
+ if ((int)i != selected_cp->chan)
set_axes(sp->chans[i], ap->x0, ap->x1, ap->y0, ap->y1);
if (i > 0)
@@ -1186,7 +1189,7 @@ void change_channel_style(snd_info *sp, channel_style_t new_style)
if (new_style == CHANNELS_SEPARATE)
{
/* height[0] = total space available */
- height[0] /= sp->nchans;
+ height[0] /= (int)sp->nchans;
for_each_sound_chan(sp, channel_open_pane);
/* for (i = 0; i < sp->nchans; i++) reset_mix_graph_parent(sp->chans[i]); */
@@ -1199,7 +1202,9 @@ void change_channel_style(snd_info *sp, channel_style_t new_style)
cp->ax->w = channel_to_widget(cp);
cp->ax->wn = WIDGET_TO_WINDOW(cp->ax->w);
cw = cp->chan_widgets;
+#if (!GTK_CHECK_VERSION(3, 90, 0))
gtk_widget_show_all(cw[W_main_window]);
+#endif
}
set_toggle_button(unite_button(sp), false, false, (void *)sp);
if (sp->selected_channel > 0) color_selected_channel(sp);
diff --git a/snd-genv.c b/snd-genv.c
index ef79a92..8038183 100644
--- a/snd-genv.c
+++ b/snd-genv.c
@@ -136,10 +136,7 @@ static void help_enved_callback(GtkWidget *w, gpointer context)
static void force_update(GtkWidget *wid)
{
if ((wid) && (WIDGET_TO_WINDOW(wid)))
- {
- gdk_window_invalidate_rect(GDK_WINDOW(WIDGET_TO_WINDOW(wid)), NULL, true);
- gdk_window_process_updates(GDK_WINDOW(WIDGET_TO_WINDOW(wid)), true);
- }
+ gdk_window_invalidate_rect(GDK_WINDOW(WIDGET_TO_WINDOW(wid)), NULL, true);
}
diff --git a/snd-gfft.c b/snd-gfft.c
index 68b99d9..aa8c168 100644
--- a/snd-gfft.c
+++ b/snd-gfft.c
@@ -150,9 +150,9 @@ static void get_fft_window_data(void)
mus_make_fft_window_with_window(fft_window(ss), GRAPH_SIZE,
fft_window_beta(ss) * fft_beta_max(fft_window(ss)),
fft_window_alpha(ss), graph_data);
- memset((void *)graph_fftr, 0, GRAPH_SIZE * 2 * sizeof(mus_float_t));
- memset((void *)graph_ffti, 0, GRAPH_SIZE * 2 * sizeof(mus_float_t));
- memcpy((void *)graph_fftr, (void *)graph_data, GRAPH_SIZE * sizeof(mus_float_t));
+ clear_floats(graph_fftr, GRAPH_SIZE * 2);
+ clear_floats(graph_ffti, GRAPH_SIZE * 2);
+ copy_floats(graph_fftr, graph_data, GRAPH_SIZE);
mus_spectrum(graph_fftr, graph_ffti, NULL, GRAPH_SIZE * 2, MUS_SPECTRUM_IN_DB);
for (i = 0; i < GRAPH_SIZE; i++)
graph_fftr[i] = (graph_fftr[i] + 80.0) / 80.0; /* min dB -80.0 */
diff --git a/snd-gfile.c b/snd-gfile.c
index 8279f13..607ed4e 100644
--- a/snd-gfile.c
+++ b/snd-gfile.c
@@ -1826,7 +1826,7 @@ static void make_auto_comment(file_dialog_info *fd)
(!(*(fdat->saved_comment))))
fdat->saved_comment = NULL;
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
if (sp->chans[i]->edit_ctr != 0)
{
edits = true;
@@ -1853,7 +1853,7 @@ static void make_auto_comment(file_dialog_info *fd)
mus_strlen(original_sound_comment);
edit_strs = (char **)malloc(sp->nchans * sizeof(char *));
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
edit_strs[i] = edit_list_to_function(sp->chans[i], 1, sp->chans[i]->edit_ctr);
len += mus_strlen(edit_strs[i]);
@@ -1865,12 +1865,12 @@ static void make_auto_comment(file_dialog_info *fd)
snd_local_time(),
sp->filename);
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
if (sp->nchans > 1)
{
- char buf[32];
- snprintf(buf, 32, "\n-------- channel %d --------\n", i);
+ char buf[64];
+ snprintf(buf, 64, "\n-------- channel %d --------\n", i);
strcat(comment, buf);
}
strcat(comment, edit_strs[i]);
diff --git a/snd-gl.scm b/snd-gl.scm
index 713ed6f..11da8bb 100644
--- a/snd-gl.scm
+++ b/snd-gl.scm
@@ -10,13 +10,13 @@
(let ((documentation "(gl-info) prints out GL-related info")
(class-of (lambda (n)
(and (number? n)
- (cond ((= n (*motif* 'StaticGray)) "static-gray")
- ((= n (*motif* 'GrayScale)) "gray-scale")
- ((= n (*motif* 'StaticColor)) "static-color")
- ((= n (*motif* 'PseudoColor)) "pseudo-color")
- ((= n (*motif* 'TrueColor)) "true-color")
- ((= n (*motif* 'DirectColor)) "direct-color")
- (#t "??"))))))
+ (copy (cond ((= n (*motif* 'StaticGray)) "static-gray")
+ ((= n (*motif* 'GrayScale)) "gray-scale")
+ ((= n (*motif* 'StaticColor)) "static-color")
+ ((= n (*motif* 'PseudoColor)) "pseudo-color")
+ ((= n (*motif* 'TrueColor)) "true-color")
+ ((= n (*motif* 'DirectColor)) "direct-color")
+ (#t "??")))))))
(lambda ()
(let* ((cx (snd-gl-context))
(dpy ((*motif* 'XtDisplay) (cadr (main-widgets))))
diff --git a/snd-glistener.c b/snd-glistener.c
index a0d296b..0c03a8f 100644
--- a/snd-glistener.c
+++ b/snd-glistener.c
@@ -100,8 +100,8 @@ static s7_pointer g_listener_load_hook(s7_scheme *sc, s7_pointer args)
{
/* arg is the hook, (hook 'name) is the file */
s7_pointer hook, file;
- if (!(ss->listener)) return(args);
char msg[128];
+ if (!(ss->listener)) return(args);
hook = s7_car(args);
file = s7_let_ref(s7, hook, s7_make_symbol(s7, "name"));
if (!s7_is_string(file))
diff --git a/snd-gmain.c b/snd-gmain.c
index c460d51..73ccd43 100644
--- a/snd-gmain.c
+++ b/snd-gmain.c
@@ -411,7 +411,11 @@ void snd_doit(int argc, char **argv)
GtkWidget *shell;
int i;
+#if (GTK_CHECK_VERSION(3, 90, 0))
+ gtk_init();
+#else
gtk_init(&argc, &argv);
+#endif
#if (!GTK_CHECK_VERSION(3, 0, 0)) && (!__APPLE__)
gdk_set_locale();
@@ -661,6 +665,7 @@ void snd_doit(int argc, char **argv)
color_chan_components(ss->zoom_color, COLOR_ZOOM);
color_chan_components(ss->position_color, COLOR_POSITION);
#endif
+
if ((!listener_exists()) &&
(!(ss->sounds[0])))
handle_listener(true);
diff --git a/snd-gmenu.c b/snd-gmenu.c
index 5ae30af..9728c39 100644
--- a/snd-gmenu.c
+++ b/snd-gmenu.c
@@ -1442,7 +1442,7 @@ static void full_dur_callback(GtkWidget *w, gpointer info)
sp = any_selected_sound();
if (sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
set_x_axis_x0x1(sp->chans[i], 0.0, sp->chans[i]->axis->xmax);
}
@@ -1455,7 +1455,7 @@ static void zoom_out_callback(GtkWidget *w, gpointer info)
sp = any_selected_sound();
if (sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
zx_incremented(sp->chans[i], 2.0);
}
@@ -1468,7 +1468,7 @@ static void zoom_in_callback(GtkWidget *w, gpointer info)
sp = any_selected_sound();
if (sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
zx_incremented(sp->chans[i], 0.5);
}
@@ -1481,7 +1481,7 @@ static void goto_start_callback(GtkWidget *w, gpointer info)
sp = any_selected_sound();
if (sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
set_x_axis_x0x1(sp->chans[i], 0.0, sp->chans[i]->axis->x1 - sp->chans[i]->axis->x0);
}
@@ -1493,7 +1493,7 @@ static void go_back_callback(GtkWidget *w, gpointer info)
sp = any_selected_sound();
if (sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
sx_incremented(sp->chans[i], -1.0);
}
@@ -1506,7 +1506,7 @@ static void go_forward_callback(GtkWidget *w, gpointer info)
sp = any_selected_sound();
if (sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
sx_incremented(sp->chans[i], 1.0);
}
@@ -1519,7 +1519,7 @@ static void goto_end_callback(GtkWidget *w, gpointer info)
sp = any_selected_sound();
if (sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
set_x_axis_x0x1(sp->chans[i], sp->chans[i]->axis->xmax - sp->chans[i]->axis->x1 + sp->chans[i]->axis->x0, sp->chans[i]->axis->xmax);
}
diff --git a/snd-gregion.c b/snd-gregion.c
index f5dec34..96e4f0a 100644
--- a/snd-gregion.c
+++ b/snd-gregion.c
@@ -57,7 +57,7 @@ void reflect_regions_in_region_browser(void)
{
if (rsp)
{
- int i;
+ unsigned int i;
rsp->active = true;
if (rsp->chans)
for (i = 0; i < rsp->nchans; i++)
@@ -70,7 +70,7 @@ void reflect_no_regions_in_region_browser(void)
{
if (rsp)
{
- int i;
+ unsigned int i;
rsp->active = false;
if (rsp->chans)
for (i = 0; i < rsp->nchans; i++)
diff --git a/snd-gsnd.c b/snd-gsnd.c
index 088398c..0dfe206 100644
--- a/snd-gsnd.c
+++ b/snd-gsnd.c
@@ -1656,7 +1656,7 @@ snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr
SG_SIGNAL_CONNECT(STOP_PIX(sp), "button_press_event", stop_sign_press, sp);
{
- int i;
+ unsigned int i;
sp->clock_widgets = (GtkWidget **)calloc(sp->nchans, sizeof(GtkWidget *));
sp->clock_pix_ax = (graphics_context **)calloc(sp->nchans, sizeof(graphics_context *));
@@ -2104,7 +2104,9 @@ void snd_info_cleanup(snd_info *sp)
void show_controls(snd_info *sp)
{
+#if (!GTK_CHECK_VERSION(3, 90, 0))
gtk_widget_show_all(CONTROL_PANEL(sp));
+#endif
/* control panel is pane 2 of SND_PANE(sp); PANE_BOX is pane 1 */
/* gtk_paned_set_position(GTK_PANED(sound_pane(ss)), (gint)(widget_height(sound_pane(ss)) * .75)); (glistener) */
}
diff --git a/snd-gtk.scm b/snd-gtk.scm
index 0beae08..575c23c 100644
--- a/snd-gtk.scm
+++ b/snd-gtk.scm
@@ -424,6 +424,7 @@
0)))))
(lambda (hook)
;; (show-disk-space snd) adds a label to snd's status-area area showing the current free space (for use with after-open-hook)
+ ;; (set! (hook-functions after-open-hook) (list (*motif* 'show-disk-space)))
(let* ((snd (hook 'snd))
(previous-label (let find-if ((pred (lambda (n)
@@ -450,7 +451,7 @@
;;; (remove-main-menu 5) removes the Help menu
(define remove-main-menu
- (let ((documentation "(remove-main-menu menu) removes the specified top-level menu: (remove-main-menu 5) removes the Help menu"))
+ (let ((documentation "(remove-main-menu menu) removes the specified top-level menu: ((*gtk* 'remove-main-menu) 5) removes the Help menu"))
(lambda (menu)
(gtk_widget_hide ((menu-widgets) menu)))))
@@ -759,7 +760,6 @@
(define (make-variables-dialog)
(set! variables-dialog (gtk_dialog_new))
(gtk_window_set_title (GTK_WINDOW variables-dialog) "Variables")
- ;(gtk_container_set_border_width (GTK_CONTAINER variables-dialog) 10)
(gtk_window_set_default_size (GTK_WINDOW variables-dialog) -1 -1)
(gtk_window_set_resizable (GTK_WINDOW variables-dialog) #t)
(gtk_widget_realize variables-dialog)
@@ -832,7 +832,6 @@
(define variable-display
(let ((force-update (lambda (wid)
(gdk_window_invalidate_rect (GDK_WINDOW (gtk_widget_get_window (GTK_WIDGET wid))) (list 'GdkRectangle_ 0) #t)
- ;;(gdk_window_process_updates (GDK_WINDOW (gtk_widget_get_window (GTK_WIDGET wid))) #t)
))
(widget? (lambda (w)
(and (pair? w)
@@ -871,4 +870,4 @@
(define (notebook-with-top-tabs)
(gtk_notebook_set_tab_pos (GTK_NOTEBOOK ((main-widgets) 5)) GTK_POS_TOP))
- ) ; *gtk*
\ No newline at end of file
+ ) ; *gtk*
diff --git a/snd-init.el b/snd-init.el
new file mode 100644
index 0000000..1c148da
--- /dev/null
+++ b/snd-init.el
@@ -0,0 +1,14 @@
+(defun dired-open-snd-file ()
+ "Open the file where point is or the marked files in Dired with inf-snd program."
+ (interactive)
+ (let* ((file-list
+ (dired-get-marked-files)))
+ (mapc
+ (lambda (file-path)
+ (snd-scheme-open-file file-path))
+ file-list)))
+
+(define-key dired-mode-map (kbd "C-<return>") 'dired-open-snd-file)
+
+;;; USAGE: Open a directory in emacs' dired-mode. position the cursor on a
+;;; soundfile or mark some soundfiles and press C-<return> to open them.
diff --git a/snd-io.c b/snd-io.c
index 0034231..1846fbf 100644
--- a/snd-io.c
+++ b/snd-io.c
@@ -673,14 +673,17 @@ snd_data *copy_snd_data(snd_data *sd, mus_long_t beg, int bufsize)
snd_data *make_snd_data_buffer(mus_float_t *data, int len, int ctr)
{
snd_data *sf;
+
sf = (snd_data *)calloc(1, sizeof(snd_data));
sf->type = SND_DATA_BUFFER;
sf->buffered_data = (mus_float_t *)malloc((len + 1) * sizeof(mus_float_t));
- /* sigh... using len + 1 rather than len to protect against access to inserted buffer at end mixups (final fragment uses end + 1) */
- /* the real problem here is that I never decided whether insert starts at the cursor or just past it */
- /* when the cursor is on the final sample, this causes cross-fragment ambiguity as to the length of a trailing insertion */
- /* C > (make-region 1000 2000) (insert-region (cursor)) C-v hits this empty slot and gets confused about the previously final sample value */
- memcpy((void *)(sf->buffered_data), (void *)data, len * sizeof(mus_float_t));
+ /* sigh... using len + 1 rather than len to protect against access to inserted buffer at end mixups (final fragment uses end + 1)
+ * the real problem here is that I never decided whether insert starts at the cursor or just past it
+ * when the cursor is on the final sample, this causes cross-fragment ambiguity as to the length of a trailing insertion
+ * C > (make-region 1000 2000) (insert-region (cursor)) C-v hits this empty slot and gets confused about the previously final sample value
+ */
+
+ copy_floats(sf->buffered_data, data, len);
sf->buffered_data[len] = 0.0;
sf->edit_ctr = ctr;
sf->copy = false;
diff --git a/snd-kbd.c b/snd-kbd.c
index 382dd28..3804131 100644
--- a/snd-kbd.c
+++ b/snd-kbd.c
@@ -499,7 +499,7 @@ static chan_info *goto_next_graph(chan_info *cp, int count)
if (count < 0)
return(goto_previous_graph(cp, count));
k = count;
- if (chan < (sp->nchans - 1))
+ if (chan < ((int)(sp->nchans) - 1))
{
/* goto next channel in current sound */
k -= (sp->nchans-chan - 1);
@@ -1429,7 +1429,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
if (cp->sound->channel_style != CHANNELS_SEPARATE)
{
int i;
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
if ((i != cp->chan) &&
(selection_is_active_in_channel(sp->chans[i])))
{
diff --git a/snd-lint.scm b/snd-lint.scm
index 756eab0..12f0ded 100644
--- a/snd-lint.scm
+++ b/snd-lint.scm
@@ -89,18 +89,8 @@
(let ((gen? (symbol name "?"))
(gen-make (symbol "make-" name)))
- (list (make-fvar :name gen?
- :ftype 'define
- :decl (dummy-func 'define `(define (,gen? x) (let? x)) '(define (_ x) #f))
- :initial-value `(define (,gen? x) (let? x))
- :arglist (list 'x)
- :env env)
- (make-fvar :name gen-make
- :ftype 'define*
- :decl (dummy-func 'define* `(define* (,gen-make :rest x :allow-other-keys) (apply inlet x)) '(define (_ . x) #f))
- :initial-value `(define* (,gen-make :rest x :allow-other-keys) (apply inlet x))
- :arglist (list :rest 'x :allow-other-keys)
- :env env)))))))
+ (list (make-fvar gen? 'define (list 'x) `(define (,gen? x) (let? x)) env)
+ (make-fvar gen-make 'define* (list :rest 'x :allow-other-keys) `(define* (,gen-make :rest x :allow-other-keys) (apply inlet x)) env)))))))
(hash-table-set! (*lint* 'walker-functions) 'defgenerator
(lambda (caller form env)
diff --git a/snd-main.c b/snd-main.c
index d341c03..d0217f2 100644
--- a/snd-main.c
+++ b/snd-main.c
@@ -1044,7 +1044,7 @@ void save_sound_state(snd_info *sp, void *ptr)
{
save_property_list(fd, Xen_vector_ref(sp->properties, 0), -1, -1); /* sound-properties */
}
- for (chan = 0; chan < sp->nchans; chan++)
+ for (chan = 0; chan < (int)sp->nchans; chan++)
{
axis_info *ap;
@@ -1146,6 +1146,9 @@ void save_sound_state(snd_info *sp, void *ptr)
}
}
+#if HAVE_SCHEME
+ mix_info_to_file(fd, cp);
+#endif
if (cursor_sample(cp) != 0) pcp_sod(fd, S_cursor, cursor_sample(cp), chan);
check_selection(fd, cp);
if ((!sp->remembering) &&
diff --git a/snd-marks.c b/snd-marks.c
index 77bf234..c53fd89 100644
--- a/snd-marks.c
+++ b/snd-marks.c
@@ -169,10 +169,10 @@ static mark *find_mark_from_id(int id, chan_info **cps, int pos)
{
chan_info *cp;
snd_info *sp;
- int j;
+ unsigned int j;
sp = ss->sounds[i];
if ((sp) && (sp->inuse == SOUND_NORMAL))
- for (j = 0; j<(sp->nchans); j++)
+ for (j = 0; j < sp->nchans; j++)
if ((cp = ((chan_info *)(sp->chans[j]))))
{
if (pos < cp->edit_size) /* pos can be -1 */
@@ -710,7 +710,7 @@ typedef struct {
void *sound_store_marks(snd_info *sp)
{
- int i;
+ unsigned int i;
mark_info **res = NULL;
marks_info *rtn = NULL;
res = (mark_info **)calloc(sp->nchans, sizeof(mark_info *));
@@ -750,7 +750,7 @@ void sound_restore_marks(snd_info *sp, void *mrk)
mark_info **marks;
marks = mrks->ms;
lim = mrks->size;
- if (sp->nchans < lim) lim = sp->nchans; /* update can change channel number either way */
+ if ((int)sp->nchans < lim) lim = sp->nchans; /* update can change channel number either way */
for (i = 0; i < lim; i++)
{
if (marks[i])
@@ -2589,7 +2589,7 @@ mark list is: channel given: (id id ...), snd given: ((id id) (id id ...)), neit
sp = get_sp(snd);
if (!sp)
return(snd_no_such_sound_error(S_marks, snd));
- for (i = sp->nchans - 1; i >= 0; i--)
+ for (i = (int)sp->nchans - 1; i >= 0; i--)
{
cp = sp->chans[i];
ids = channel_marks(cp, cp->edit_ctr);
@@ -2753,7 +2753,7 @@ void save_mark_list(FILE *fd, chan_info *cp, bool all_chans)
sv->syncs = NULL;
if (all_chans)
{
- int i;
+ unsigned int i;
snd_info *sp;
sp = cp->sound;
for (i = 0; i < sp->nchans; i++)
diff --git a/snd-menu.c b/snd-menu.c
index 9b62d75..975447a 100644
--- a/snd-menu.c
+++ b/snd-menu.c
@@ -205,7 +205,7 @@ void revert_file_from_menu(void)
sp = any_selected_sound();
if (sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
revert_edits(sp->chans[i]);
reflect_file_revert_in_label(sp);
diff --git a/snd-mix.c b/snd-mix.c
index 1f2b3cd..6e22ab7 100644
--- a/snd-mix.c
+++ b/snd-mix.c
@@ -165,7 +165,7 @@ void drag_and_drop_mix_at_x_y(int data, const char *filename, int x, int y)
(snd < ss->max_sounds) &&
(snd_ok(ss->sounds[snd])) &&
(chn >= 0) &&
- (chn < ss->sounds[snd]->nchans) &&
+ (chn < (int)(ss->sounds[snd]->nchans)) &&
(mus_file_probe(filename)))
{
snd_info *sp = NULL;
@@ -190,6 +190,8 @@ void drag_and_drop_mix_at_x_y(int data, const char *filename, int x, int y)
}
+static int mix_infos_ctr = 0;
+
int mix_complete_file(snd_info *sp, mus_long_t beg, const char *fullname, bool with_tag, file_delete_t auto_delete, mix_sync_t all_chans, int *out_chans)
{
chan_info *cp;
@@ -222,7 +224,6 @@ int mix_complete_file(snd_info *sp, mus_long_t beg, const char *fullname, bool w
cps[0] = cp;
chans = 1;
}
- if (out_chans) (*out_chans) = chans;
id = mix_file(beg, len, chans, cps, fullname, auto_delete, NULL, with_tag, 0);
if (si)
@@ -234,9 +235,22 @@ int mix_complete_file(snd_info *sp, mus_long_t beg, const char *fullname, bool w
}
sp->sync = old_sync;
- if (mix_exists(id))
- mix_set_file_name(id, chans, fullname);
-
+ if (mix_exists(id)) /* bugfix thanks to Tito Latini, 18-Jan-17 */
+ {
+ if (chans > 1)
+ {
+ chans = mix_infos_ctr - id;
+ if (chans > 1)
+ {
+ int i, sync = GET_NEW_SYNC;
+ for (i = 0; i < chans; i++)
+ sync = mix_set_sync_from_id(id + i, sync);
+ }
+ }
+ if (out_chans) (*out_chans) = chans;
+ mix_set_file_name(id, chans, fullname);
+ }
+
return(id);
}
@@ -247,8 +261,6 @@ static const char *b2s(bool val)
}
-static int mix_infos_ctr = 0;
-
static char *tagged_mix_to_string(const char *mixinfile, mus_long_t beg, int file_channel, bool delete_file)
{
#if HAVE_FORTH
@@ -835,6 +847,66 @@ void delete_any_remaining_mix_temp_files_at_exit(chan_info *cp)
}
+void mix_info_to_file(FILE *fd, chan_info *cp)
+{
+ int i, n;
+ bool write_info = false;
+
+ for (i = 0, n = 0; i < mix_infos_ctr; i++)
+ {
+ mix_info *md;
+ md = mix_infos[i];
+ if ((md) && (md->cp == cp))
+ {
+ if ((!write_info) &&
+ ((md->sync > 0) ||
+#if (!USE_NO_GUI)
+ (md->tag_y > 0) ||
+ (md->color != ss->mix_color) ||
+#endif
+ (md->name)))
+ {
+ write_info = true;
+ fprintf(fd, " (let ((m (list->vector (mixes sfile %d))))\n"
+ " (when (> (length m) 0)",
+ cp->chan);
+ }
+ if (md->sync > 0)
+ fprintf(fd, "\n (set! (mix-sync (m %d)) %d)", n, md->sync);
+ if (md->name)
+ fprintf(fd, "\n (set! (mix-name (m %d)) \"%s\")", n, md->name);
+#if (!USE_NO_GUI)
+ if (md->tag_y > 0)
+ fprintf(fd, "\n (set! (mix-tag-y (m %d)) %d)", n, md->tag_y);
+ if (md->color != ss->mix_color)
+ {
+ float r, g, b;
+#if USE_MOTIF
+ XColor tmp_color;
+ Display *dpy;
+ dpy = XtDisplay(main_shell(ss));
+ tmp_color.flags = DoRed | DoGreen | DoBlue;
+ tmp_color.pixel = md->color;
+ XQueryColor(dpy, DefaultColormap(dpy, DefaultScreen(dpy)), &tmp_color);
+ r = rgb_to_float(tmp_color.red);
+ g = rgb_to_float(tmp_color.green);
+ b = rgb_to_float(tmp_color.blue);
+#else
+ color_t pix = md->color;
+ r = rgb_to_float(pix->red);
+ g = rgb_to_float(pix->green);
+ b = rgb_to_float(pix->blue);
+#endif
+ fprintf(fd, "\n (set! (mix-color (m %d)) (make-color %f %f %f))",
+ n, r, g, b);
+ }
+#endif
+ n++;
+ }
+ }
+ if (write_info) fprintf(fd, "))\n");
+}
+
static int compare_mix_positions(const void *umx1, const void *umx2)
{
diff --git a/snd-motif.c b/snd-motif.c
index 2ceefb8..503c913 100644
--- a/snd-motif.c
+++ b/snd-motif.c
@@ -5984,9 +5984,9 @@ static void get_fft_window_data(void)
mus_make_fft_window_with_window(fft_window(ss), GRAPH_SIZE,
fft_window_beta(ss) * fft_beta_max(fft_window(ss)),
fft_window_alpha(ss), graph_data);
- memset((void *)graph_fftr, 0, GRAPH_SIZE * 2 * sizeof(mus_float_t));
- memset((void *)graph_ffti, 0, GRAPH_SIZE * 2 * sizeof(mus_float_t));
- memcpy((void *)graph_fftr, (void *)graph_data, GRAPH_SIZE * sizeof(mus_float_t));
+ clear_floats(graph_fftr, GRAPH_SIZE * 2);
+ clear_floats(graph_ffti, GRAPH_SIZE * 2);
+ copy_floats(graph_fftr, graph_data, GRAPH_SIZE);
mus_spectrum(graph_fftr, graph_ffti, NULL, GRAPH_SIZE * 2, MUS_SPECTRUM_IN_DB);
for (i = 0; i < GRAPH_SIZE; i++)
graph_fftr[i] = (graph_fftr[i] + 80.0) / 80.0; /* min dB here is -80 */
@@ -6572,14 +6572,14 @@ void set_fft_with_phases(bool val)
static void alpha_drag_callback(Widget w, XtPointer context, XtPointer info)
{
- char alpha_number_buffer[11];
+ char alpha_number_buffer[512]; /* 11 before gcc 7.1 */
mus_float_t alpha;
alpha = (((XmScrollBarCallbackStruct *)info)->value) / 90.0;
in_set_fft_window_alpha(alpha);
chans_field(FCP_ALPHA, alpha);
- snprintf(alpha_number_buffer, 11, "alpha:%.3f", alpha);
+ snprintf(alpha_number_buffer, 512, "alpha:%.3f", alpha);
set_label(alpha_number, alpha_number_buffer);
if (fft_window_alpha_in_use(fft_window(ss)))
@@ -6593,9 +6593,9 @@ static void alpha_drag_callback(Widget w, XtPointer context, XtPointer info)
static void set_alpha_scale(mus_float_t val)
{
- char alpha_number_buffer[11];
+ char alpha_number_buffer[512];
XtVaSetValues(alpha_scale, XmNvalue, (int)(val * 90), NULL);
- snprintf(alpha_number_buffer, 11, "alpha:%.3f", val);
+ snprintf(alpha_number_buffer, 512, "alpha:%.3f", val);
set_label(alpha_number, alpha_number_buffer);
}
@@ -7736,7 +7736,7 @@ void reflect_regions_in_region_browser(void)
{
if (rsp)
{
- int i;
+ unsigned int i;
rsp->active = true;
if (rsp->chans)
for (i = 0; i < rsp->nchans; i++)
@@ -7749,7 +7749,7 @@ void reflect_no_regions_in_region_browser(void)
{
if (rsp)
{
- int i;
+ unsigned int i;
rsp->active = false;
if (rsp->chans)
for (i = 0; i < rsp->nchans; i++)
@@ -11305,7 +11305,7 @@ static void make_auto_comment(save_as_dialog_info *sd)
fd->saved_comment = NULL;
}
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
if (sp->chans[i]->edit_ctr != 0)
{
edits = true;
@@ -11333,7 +11333,7 @@ static void make_auto_comment(save_as_dialog_info *sd)
mus_strlen(original_sound_comment);
edit_strs = (char **)malloc(sp->nchans * sizeof(char *));
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
edit_strs[i] = edit_list_to_function(sp->chans[i], 1, sp->chans[i]->edit_ctr);
len += mus_strlen(edit_strs[i]);
@@ -11346,7 +11346,7 @@ static void make_auto_comment(save_as_dialog_info *sd)
snd_local_time(),
sp->filename);
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
if (sp->nchans > 1)
{
@@ -22162,7 +22162,7 @@ static void full_dur_callback(Widget w, XtPointer info, XtPointer context)
sp = any_selected_sound();
if (sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
set_x_axis_x0x1(sp->chans[i], 0.0, sp->chans[i]->axis->xmax);
}
@@ -22175,7 +22175,7 @@ static void zoom_out_callback(Widget w, XtPointer info, XtPointer context)
sp = any_selected_sound();
if (sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
zx_incremented(sp->chans[i], 2.0);
}
@@ -22188,7 +22188,7 @@ static void zoom_in_callback(Widget w, XtPointer info, XtPointer context)
sp = any_selected_sound();
if (sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
zx_incremented(sp->chans[i], 0.5);
}
@@ -22201,7 +22201,7 @@ static void goto_start_callback(Widget w, XtPointer info, XtPointer context)
sp = any_selected_sound();
if (sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
set_x_axis_x0x1(sp->chans[i], 0.0, sp->chans[i]->axis->x1 - sp->chans[i]->axis->x0);
}
@@ -22213,7 +22213,7 @@ static void go_back_callback(Widget w, XtPointer info, XtPointer context)
sp = any_selected_sound();
if (sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
sx_incremented(sp->chans[i], -1.0);
}
@@ -22226,7 +22226,7 @@ static void go_forward_callback(Widget w, XtPointer info, XtPointer context)
sp = any_selected_sound();
if (sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
sx_incremented(sp->chans[i], 1.0);
}
@@ -22238,7 +22238,7 @@ static void goto_end_callback(Widget w, XtPointer info, XtPointer context)
sp = any_selected_sound();
if (sp)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
set_x_axis_x0x1(sp->chans[i], sp->chans[i]->axis->xmax - sp->chans[i]->axis->x1 + sp->chans[i]->axis->x0, sp->chans[i]->axis->xmax);
}
@@ -24732,7 +24732,7 @@ static void make_listener_widget(int height)
XtVaSetValues(main_shell(ss), XmNallowShellResize, false, NULL);
XtManageChild(listener_text);
- XmTextSetCursorPosition(listener_text, 1);
+ XmTextSetCursorPosition(listener_text, ss->listener_prompt_length);
if (!transTable4)
transTable4 = XtParseTranslationTable(TextTrans4);
XtOverrideTranslations(listener_text, transTable4);
@@ -25551,7 +25551,8 @@ static void remake_edit_history(Widget lst, chan_info *cp, int from_graph)
if (sp->channel_style != CHANNELS_SEPARATE)
{
chan_info *ncp;
- int k, all_eds = 0, ed, filelen;
+ unsigned int k;
+ int all_eds = 0, ed, filelen;
char *title;
for (k = 0; k < sp->nchans; k++)
@@ -26338,7 +26339,7 @@ void change_channel_style(snd_info *sp, channel_style_t new_style)
if (new_style != old_style)
{
- int i, height;
+ unsigned int i, height;
#if WITH_RELATIVE_PANES
if ((new_style == CHANNELS_SEPARATE) || (old_style == CHANNELS_SEPARATE))
@@ -26382,7 +26383,7 @@ void change_channel_style(snd_info *sp, channel_style_t new_style)
for (i = 0; i < sp->nchans; i++)
{
- if (i != selected_cp->chan)
+ if ((int)i != selected_cp->chan)
{
chan_info *ncp;
ncp = sp->chans[i];
@@ -26411,7 +26412,7 @@ void change_channel_style(snd_info *sp, channel_style_t new_style)
for (i = 0; i < sp->nchans; i++)
{
- if (i != selected_cp->chan)
+ if ((int)i != selected_cp->chan)
set_axes(sp->chans[i], ap->x0, ap->x1, ap->y0, ap->y1);
if (i > 0)
cleanup_cw(sp->chans[i]);
@@ -27811,7 +27812,7 @@ static void watch_sash(Widget w, XtPointer closure, XtPointer info)
inner_sizes[outer_ctr] = (Dimension *)calloc(sp->nchans, sizeof(Dimension));
XtVaGetValues(child, XmNheight, &(outer_sizes[outer_ctr]), NULL);
- for (k = 0; k < sp->nchans; k++)
+ for (k = 0; k < (int)sp->nchans; k++)
XtVaGetValues(channel_main_pane(sp->chans[k]), XmNheight, &(inner_sizes[outer_ctr][k]), NULL);
outer_ctr++;
@@ -27840,23 +27841,23 @@ static void watch_sash(Widget w, XtPointer closure, XtPointer info)
XtVaGetValues(SND_PANE(sp), XmNheight, &cur_outer_size, NULL);
if ((cur_outer_size > 40) &&
- (abs(cur_outer_size - outer_sizes[outer_ctr]) > (sp->nchans * 2)))
+ (abs(cur_outer_size - outer_sizes[outer_ctr]) > (int)(sp->nchans * 2)))
{
/* this pane has multiple chans and its size has changed enough to matter */
Dimension total_inner = 0, diff;
float ratio;
- for (k = 0; k < sp->nchans; k++)
+ for (k = 0; k < (int)sp->nchans; k++)
total_inner += inner_sizes[outer_ctr][k];
diff = outer_sizes[outer_ctr] - total_inner; /* this is non-channel stuff */
- for (k = 0; k < sp->nchans; k++)
+ for (k = 0; k < (int)sp->nchans; k++)
XtUnmanageChild(channel_main_pane(sp->chans[k]));
ratio = (float)(cur_outer_size - diff) / (float)(outer_sizes[outer_ctr] - diff);
if (ratio > 0.0)
{
- for (k = 0; k < sp->nchans; k++)
+ for (k = 0; k < (int)sp->nchans; k++)
{
int size;
size = (int)(ratio * inner_sizes[outer_ctr][k]);
@@ -27865,9 +27866,9 @@ static void watch_sash(Widget w, XtPointer closure, XtPointer info)
XmNpaneMaximum, size + 1,
NULL);
}
- for (k = 0; k < sp->nchans; k++)
+ for (k = 0; k < (int)sp->nchans; k++)
XtManageChild(channel_main_pane(sp->chans[k]));
- for (k = 0; k < sp->nchans; k++)
+ for (k = 0; k < (int)sp->nchans; k++)
XtVaSetValues(channel_main_pane(sp->chans[k]),
XmNpaneMinimum, 1,
XmNpaneMaximum, LOTSA_PIXELS,
@@ -28446,7 +28447,7 @@ snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr
LOCK_OR_BOMB(sp) = XtCreateManagedWidget("", xmLabelWidgetClass, NAME_BOX(sp), args, n);
{
- int i;
+ unsigned int i;
Widget left_widget;
left_widget = LOCK_OR_BOMB(sp);
@@ -29974,7 +29975,6 @@ static Widget *iconify_active_dialogs = NULL;
static void minify_maxify_window(Widget w, XtPointer context, XEvent *event, Boolean *cont)
{
XMapEvent *ev = (XMapEvent *)event;
- int i;
if ((!ss) || (!(ss->dialogs)))
return;
@@ -30004,7 +30004,7 @@ static void minify_maxify_window(Widget w, XtPointer context, XEvent *event, Boo
{
Atom _NET_WM_STATE, _NET_WM_STATE_HIDDEN, actual_type;
int actual_format;
- unsigned long i, nitems, bytes_after;
+ unsigned long nitems, bytes_after;
unsigned char *prop = NULL;
/* this code thanks to Tito Latini */
@@ -30017,6 +30017,7 @@ static void minify_maxify_window(Widget w, XtPointer context, XEvent *event, Boo
{
Atom *atoms = (Atom *)prop;
bool iconified = false;
+ unsigned long i;
for (i = 0; i < nitems; i++)
{
if (atoms[i] == _NET_WM_STATE_HIDDEN)
@@ -30031,14 +30032,17 @@ static void minify_maxify_window(Widget w, XtPointer context, XEvent *event, Boo
if (iconify_active_dialogs) free(iconify_active_dialogs);
iconify_active_dialogs = (Widget *)calloc(ss->num_dialogs, sizeof(Widget));
-
- for (i = 0; i < ss->num_dialogs; i++)
- if (ss->dialogs[i])
- {
- if (XtIsManaged(ss->dialogs[i]))
- iconify_active_dialogs[i] = ss->dialogs[i];
- XtUnmanageChild(ss->dialogs[i]);
- }
+
+ {
+ int i;
+ for (i = 0; i < ss->num_dialogs; i++)
+ if (ss->dialogs[i])
+ {
+ if (XtIsManaged(ss->dialogs[i]))
+ iconify_active_dialogs[i] = ss->dialogs[i];
+ XtUnmanageChild(ss->dialogs[i]);
+ }
+ }
}
else
{
@@ -30046,6 +30050,7 @@ static void minify_maxify_window(Widget w, XtPointer context, XEvent *event, Boo
{
if (iconify_active_dialogs)
{
+ int i;
for (i = 0; i < ss->num_dialogs; i++)
if (iconify_active_dialogs[i])
XtManageChild(iconify_active_dialogs[i]);
diff --git a/snd-motif.scm b/snd-motif.scm
index 941f99d..be417dc 100644
--- a/snd-motif.scm
+++ b/snd-motif.scm
@@ -1754,7 +1754,7 @@
(define showing-disk-space #f) ; for prefs dialog
(define show-disk-space
- (let ((documentation "(show-disk-space snd) adds a label to snd's status-area area showing the current free space (for use with after-open-hook)")
+ (let ((documentation "(show-disk-space snd) adds a label to snd's status-area area showing the current free space (for use with after-open-hook: (set! (hook-functions after-open-hook) (list (*motif* 'show-disk-space))))")
(labelled-snds ())
(kmg (lambda (num)
@@ -1810,13 +1810,13 @@
;;; the max scrollbar value can change (it's now 10000), so ideally this code should notice it
(define add-amp-controls
- (let ((documentation "(add-amp-controls) adds amplitude sliders to the control panel for each channel in multi-channel sounds"))
+ (let ((documentation "(add-amp-controls) adds amplitude sliders to the control panel for each channel in multi-channel sounds")
+ (label-name (lambda (chan) (if (= chan 0) (copy "amp-label") (format #f "amp-label-~D" chan))))
+ (number-name (lambda (chan) (if (= chan 0) (copy "amp-number") (format #f "amp-number-~D" chan))))
+ (scroller-name (lambda (chan) (if (= chan 0) (copy "amp") (format #f "amp-~D" chan)))))
+
(lambda ()
- (define (label-name chan) (if (= chan 0) (copy "amp-label") (format #f "amp-label-~D" chan)))
- (define (number-name chan) (if (= chan 0) (copy "amp-number") (format #f "amp-number-~D" chan)))
- (define (scroller-name chan) (if (= chan 0) (copy "amp") (format #f "amp-~D" chan)))
-
(define amp-callback
;; c is (list number-widget snd chan)
(let ((scroll->amp
@@ -1850,120 +1850,122 @@
(XtSetValues number (list XmNlabelString ampstr))
(XmStringFree ampstr)))
- (define (amp-controls-reflect-chans snd)
+ (define amp-controls-reflect-chans
- (define (make-amp-control snd chan parent)
- (let* ((s1 (XmStringCreateLocalized "amp:"))
- (label (XtCreateManagedWidget (label-name chan) xmPushButtonWidgetClass parent
- (list XmNbackground *basic-color*
- XmNalignment XmALIGNMENT_BEGINNING
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_NONE
- XmNlabelString s1
- XmNmarginHeight 1
- XmNrecomputeSize #f
- XmNshadowThickness 0
- XmNhighlightThickness 0
- XmNfillOnArm #f)))
- (s2 (XmStringCreateLocalized "1.000 ")))
- (let* ((number (XtCreateManagedWidget (number-name chan) xmLabelWidgetClass parent
- (list XmNbackground *basic-color*
- XmNalignment XmALIGNMENT_BEGINNING
- XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
- XmNtopWidget label
- XmNbottomAttachment XmATTACH_NONE
- XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget label
- XmNrightAttachment XmATTACH_NONE
- XmNlabelString s2
- XmNmarginHeight 1
- XmNmarginRight 3
- XmNrecomputeSize #f)))
- (scroll (XtCreateManagedWidget (scroller-name chan) xmScrollBarWidgetClass parent
- (list XmNbackground *position-color*
- XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
- XmNtopWidget label
- XmNbottomAttachment XmATTACH_NONE
- XmNheight 16
- XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget number
- XmNrightAttachment XmATTACH_FORM
- XmNorientation XmHORIZONTAL
- XmNmaximum 10000
- XmNvalue 4500
- XmNdragCallback (list amp-callback (list number snd chan))
- XmNvalueChangedCallback (list amp-callback (list number snd chan))))))
- (XtOverrideTranslations scroll
- (XtParseTranslationTable "c<Btn1Down>: Select()
+ (let ((make-amp-control
+ (lambda (snd chan parent)
+ (let* ((s1 (XmStringCreateLocalized "amp:"))
+ (label (XtCreateManagedWidget (label-name chan) xmPushButtonWidgetClass parent
+ (list XmNbackground *basic-color*
+ XmNalignment XmALIGNMENT_BEGINNING
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_NONE
+ XmNlabelString s1
+ XmNmarginHeight 1
+ XmNrecomputeSize #f
+ XmNshadowThickness 0
+ XmNhighlightThickness 0
+ XmNfillOnArm #f)))
+ (s2 (XmStringCreateLocalized "1.000 ")))
+ (let* ((number (XtCreateManagedWidget (number-name chan) xmLabelWidgetClass parent
+ (list XmNbackground *basic-color*
+ XmNalignment XmALIGNMENT_BEGINNING
+ XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
+ XmNtopWidget label
+ XmNbottomAttachment XmATTACH_NONE
+ XmNleftAttachment XmATTACH_WIDGET
+ XmNleftWidget label
+ XmNrightAttachment XmATTACH_NONE
+ XmNlabelString s2
+ XmNmarginHeight 1
+ XmNmarginRight 3
+ XmNrecomputeSize #f)))
+ (scroll (XtCreateManagedWidget (scroller-name chan) xmScrollBarWidgetClass parent
+ (list XmNbackground *position-color*
+ XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
+ XmNtopWidget label
+ XmNbottomAttachment XmATTACH_NONE
+ XmNheight 16
+ XmNleftAttachment XmATTACH_WIDGET
+ XmNleftWidget number
+ XmNrightAttachment XmATTACH_FORM
+ XmNorientation XmHORIZONTAL
+ XmNmaximum 10000
+ XmNvalue 4500
+ XmNdragCallback (list amp-callback (list number snd chan))
+ XmNvalueChangedCallback (list amp-callback (list number snd chan))))))
+ (XtOverrideTranslations scroll
+ (XtParseTranslationTable "c<Btn1Down>: Select()
c<Btn1Motion>: Moved()
c<Btn1Up>: Release()"))
-
- (XtAddCallback label XmNactivateCallback (lambda (w c i)
- (reset-to-one scroll number))))
- (XmStringFree s1)
- (XmStringFree s2)
- label))
-
- (let* ((ctrls ((sound-widgets snd) 2))
- (snd-amp (find-child ctrls "snd-amp"))
- (chns (channels snd)))
+
+ (XtAddCallback label XmNactivateCallback (lambda (w c i)
+ (reset-to-one scroll number))))
+ (XmStringFree s1)
+ (XmStringFree s2)
+ label))))
- (when (Widget? snd-amp)
- (let ((height (cadr (XtGetValues ctrls (list XmNheight 0))))
- (panemin (cadr (XtGetValues ctrls (list XmNpaneMinimum 0))))
- (panemax (cadr (XtGetValues ctrls (list XmNpaneMaximum 0)))))
- (XtUnmanageChild ctrls)
+ (lambda (snd)
+ (let* ((ctrls ((sound-widgets snd) 2))
+ (snd-amp (find-child ctrls "snd-amp"))
+ (chns (channels snd)))
- (if (not (sound-property 'amp-controls snd))
- (let ((orig-amp (find-child snd-amp "amp")))
- (XtOverrideTranslations orig-amp
- (XtParseTranslationTable "c<Btn1Down>: Select()
+ (when (Widget? snd-amp)
+ (let ((height (cadr (XtGetValues ctrls (list XmNheight 0))))
+ (panemin (cadr (XtGetValues ctrls (list XmNpaneMinimum 0))))
+ (panemax (cadr (XtGetValues ctrls (list XmNpaneMaximum 0)))))
+ (XtUnmanageChild ctrls)
+
+ (if (not (sound-property 'amp-controls snd))
+ (let ((orig-amp (find-child snd-amp "amp")))
+ (XtOverrideTranslations orig-amp
+ (XtParseTranslationTable "c<Btn1Down>: Select()
c<Btn1Motion>: Moved()
c<Btn1Up>: Release()"))
- (XtAddCallback orig-amp XmNdragCallback
- (lambda (w c info)
- (if (and (.event info) (not (= (logand (.state (.event info)) ControlMask) 0)))
- (do ((i 1 (+ i 1)))
- ((= i chns))
- (let* ((ampscr (find-child snd-amp (scroller-name i)))
- (ampvals (cdr (XmScrollBarGetValues ampscr))))
- (XmScrollBarSetValues ampscr (.value info) (car ampvals) (cadr ampvals) (caddr ampvals) #t))))))))
- (let ((existing-controls (or (sound-property 'amp-controls snd) 1)))
- (if (< existing-controls chns)
- (begin
- (if (> height 20)
- (set! height (+ height (* 18 (- chns existing-controls)))))
- (do ((i existing-controls (+ i 1)))
- ((= i chns))
- (make-amp-control snd i snd-amp))
- (set! (sound-property 'amp-controls snd) chns)
- (set! existing-controls chns)))
- (do ((i 0 (+ i 1)))
- ((= i existing-controls))
- (let ((ampn (find-child snd-amp (number-name i)))
- (amp (find-child snd-amp (scroller-name i))))
- (XtUnmanageChild (find-child snd-amp (label-name i)))
- (XtUnmanageChild ampn)
- (XtUnmanageChild amp)))
- (do ((i 0 (+ i 1)))
- ((= i chns))
- (let ((ampc (find-child snd-amp (label-name i)))
- (ampn (find-child snd-amp (number-name i)))
- (amp (find-child snd-amp (scroller-name i))))
- (let ((next-amp (and (< i (- chns 1))
- (find-child snd-amp (label-name (+ i 1))))))
- (reset-to-one amp ampn)
- (XtSetValues ampc (list XmNtopAttachment
- (if next-amp (values XmATTACH_WIDGET XmNtopWidget next-amp) XmATTACH_FORM))))
- (XtManageChild ampc)
- (XtManageChild ampn)
- (XtManageChild amp))))
-
- (XtSetValues ctrls (list XmNpaneMinimum height XmNpaneMaximum height))
- (XtManageChild ctrls)
- (XtSetValues ctrls (list XmNpaneMinimum panemin XmNpaneMaximum panemax))))))
+ (XtAddCallback orig-amp XmNdragCallback
+ (lambda (w c info)
+ (if (and (.event info) (not (= (logand (.state (.event info)) ControlMask) 0)))
+ (do ((i 1 (+ i 1)))
+ ((= i chns))
+ (let* ((ampscr (find-child snd-amp (scroller-name i)))
+ (ampvals (cdr (XmScrollBarGetValues ampscr))))
+ (XmScrollBarSetValues ampscr (.value info) (car ampvals) (cadr ampvals) (caddr ampvals) #t))))))))
+ (let ((existing-controls (or (sound-property 'amp-controls snd) 1)))
+ (if (< existing-controls chns)
+ (begin
+ (if (> height 20)
+ (set! height (+ height (* 18 (- chns existing-controls)))))
+ (do ((i existing-controls (+ i 1)))
+ ((= i chns))
+ (make-amp-control snd i snd-amp))
+ (set! (sound-property 'amp-controls snd) chns)
+ (set! existing-controls chns)))
+ (do ((i 0 (+ i 1)))
+ ((= i existing-controls))
+ (let ((ampn (find-child snd-amp (number-name i)))
+ (amp (find-child snd-amp (scroller-name i))))
+ (XtUnmanageChild (find-child snd-amp (label-name i)))
+ (XtUnmanageChild ampn)
+ (XtUnmanageChild amp)))
+ (do ((i 0 (+ i 1)))
+ ((= i chns))
+ (let ((ampc (find-child snd-amp (label-name i)))
+ (ampn (find-child snd-amp (number-name i)))
+ (amp (find-child snd-amp (scroller-name i))))
+ (let ((next-amp (and (< i (- chns 1))
+ (find-child snd-amp (label-name (+ i 1))))))
+ (reset-to-one amp ampn)
+ (XtSetValues ampc (list XmNtopAttachment
+ (if next-amp (values XmATTACH_WIDGET XmNtopWidget next-amp) XmATTACH_FORM))))
+ (XtManageChild ampc)
+ (XtManageChild ampn)
+ (XtManageChild amp))))
+
+ (XtSetValues ctrls (list XmNpaneMinimum height XmNpaneMaximum height))
+ (XtManageChild ctrls)
+ (XtSetValues ctrls (list XmNpaneMinimum panemin XmNpaneMaximum panemax))))))))
(define (amp-controls-clear snd)
(if (> (channels snd) 1)
diff --git a/snd-nogui.c b/snd-nogui.c
index 152dfa0..5e898a2 100644
--- a/snd-nogui.c
+++ b/snd-nogui.c
@@ -252,7 +252,7 @@ snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr
nchans = hdr->chans;
if (nchans <= 0) nchans = 1;
- if (nchans > 256)
+ if (nchans > MUS_MAX_CHANS)
{
/* either a screwed up header, or Snd was built with wrong endianess */
/* this kind of error is trapped by raw_data_explanation in make_file_info in the motif/gtk cases */
diff --git a/snd-print.c b/snd-print.c
index 6935bfc..306e57d 100644
--- a/snd-print.c
+++ b/snd-print.c
@@ -533,11 +533,11 @@ static char *snd_print_or_error(const char *output)
sp = (si->cps[i])->sound;
if (!sp) break;
if (sp->channel_style == CHANNELS_COMBINED)
- for (j = i + 1; (j < i + sp->nchans) && (j < si->chans); j++)
+ for (j = i + 1; (j < i + (int)sp->nchans) && (j < si->chans); j++)
offsets[j] = offsets[i];
else
if (sp->channel_style == CHANNELS_SUPERIMPOSED)
- for (j = i; (j < i + sp->nchans - 1) && (j < si->chans); j++)
+ for (j = i; (j < i + (int)sp->nchans - 1) && (j < si->chans); j++)
offsets[j] = offsets[i + sp->nchans - 1];
i += sp->nchans;
}
diff --git a/snd-region.c b/snd-region.c
index 659aca4..eda5a16 100644
--- a/snd-region.c
+++ b/snd-region.c
@@ -827,7 +827,7 @@ static void deferred_region_to_temp_file(region *r)
sp0 = drp->cps[0]->sound;
copy_ok = ((mus_header_writable(MUS_NEXT, sp0->hdr->sample_type)) &&
- (r->chans == sp0->nchans) &&
+ (r->chans == (int)sp0->nchans) &&
(r->peak_envs) &&
((drp->len - 1) == r->ends[0]));
if (copy_ok)
@@ -1244,7 +1244,7 @@ void save_region_backpointer(snd_info *sp)
r->maxamp_position = -1;
r->framples = current_samples(sp->chans[0]);
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
mus_float_t val;
val = channel_maxamp(sp->chans[i], AT_CURRENT_EDIT_POSITION);
diff --git a/snd-select.c b/snd-select.c
index 2734157..49c4c33 100644
--- a/snd-select.c
+++ b/snd-select.c
@@ -13,11 +13,12 @@ static bool cp_has_selection(chan_info *cp)
static bool map_over_chans(bool (*func)(chan_info *ncp))
{
/* non-zero = abort map, skips inactive sounds */
- int i, j;
+ int i;
bool val = false;
for (i = 0; i < ss->max_sounds; i++)
{
+ unsigned int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -71,11 +72,12 @@ bool selection_is_visible_in_channel(chan_info *cp)
static mus_long_t mus_long_t_map_over_chans(mus_long_t (*func)(chan_info *, mus_long_t *), mus_long_t *userptr)
{
- int i, j;
+ int i;
mus_long_t val = 0;
for (i = 0; i < ss->max_sounds; i++)
{
+ unsigned int j;
snd_info *sp;
chan_info *cp;
@@ -617,7 +619,7 @@ static void redraw_selection(void)
{
if (sp->inuse == SOUND_NORMAL)
{
- int j;
+ unsigned int j;
for (j = 0; j < sp->nchans; j++)
{
chan_info *cp;
@@ -1137,7 +1139,7 @@ io_error_t save_selection(const char *ofile, int srate, mus_sample_t samp_type,
}
copy_ok = ((samp_type == sp->hdr->sample_type) &&
- (chans == sp->nchans) &&
+ (chans == (int)sp->nchans) &&
(chan == SAVE_ALL_CHANS));
if (copy_ok)
for (i = 0; i < chans; i++)
diff --git a/snd-sig.c b/snd-sig.c
index 0ad4e81..e1a0484 100644
--- a/snd-sig.c
+++ b/snd-sig.c
@@ -3160,7 +3160,7 @@ char *scale_and_src(char **files, int len, int max_chans, mus_float_t amp, mus_f
sps[i] = make_sound_readable(files[i], false);
sps[i]->short_filename = filename_without_directory(files[i]);
sps[i]->filename = NULL; /* why? squelch graphics perhaps? */
- for (chan = 0; chan < sps[i]->nchans; chan++)
+ for (chan = 0; chan < (int)sps[i]->nchans; chan++)
fds[i][chan] = init_sample_read(0, sps[i]->chans[chan], READ_FORWARD);
}
@@ -3244,7 +3244,7 @@ char *scale_and_src(char **files, int len, int max_chans, mus_float_t amp, mus_f
for (i = 0; i < len; i++)
{
- for (chan = 0; chan < sps[i]->nchans; chan++)
+ for (chan = 0; chan < (int)sps[i]->nchans; chan++)
free_snd_fd(fds[i][chan]);
free(fds[i]);
sps[i] = completely_free_snd_info(sps[i]);
@@ -3472,7 +3472,8 @@ static Xen map_channel_to_buffer(chan_info *cp, snd_fd *sf, Xen proc, mus_long_t
body = s7_closure_body(s7, proc);
if ((s7_is_pair(body)) &&
- (s7_is_pair(s7_closure_args(s7, proc))))
+ (s7_is_pair(s7_closure_args(s7, proc))) &&
+ (!s7_tree_memq(s7, s7_make_symbol(s7, "set!"), body)))
{
s7_pointer arg;
if (s7_is_null(s7, s7_cdr(body)))
@@ -3546,60 +3547,40 @@ static Xen map_channel_to_buffer(chan_info *cp, snd_fd *sf, Xen proc, mus_long_t
return(res);
}
- /* try rf mechanism */
- if (s7_is_symbol(s7_car(res)))
- {
- s7_pointer fcar;
- fcar = s7_symbol_value(s7, s7_car(res));
- if (s7_rf_function(s7, fcar))
- {
- s7_rf_t rf;
- s7_pointer yp, old_e, y;
-
- e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
- old_e = s7_set_curlet(s7, e); /* new env for map lambda */
- /* we need to connect to the lambda's closure so subsequent symbol lookups work right */
- y = s7_make_mutable_real(s7, 1.5); /* slot for the map lambda arg */
- yp = s7_make_slot(s7, e, arg, y);
-
- s7_xf_new(s7, e);
- rf = s7_rf_function(s7, fcar)(s7, res);
- if (rf)
- {
- s7_pointer *top, *p;
- data = (mus_float_t *)calloc(num, sizeof(mus_float_t));
- top = s7_xf_start(s7);
- if (tree_memq(s7, arg, res))
- {
- samples_to_vct_with_reader(num, data, sf);
- for (kp = 0; kp < num; kp++)
- {
- s7_slot_set_real_value(s7, yp, data[kp]);
- p = top;
- data[kp] = rf(s7, &p);
- }
- }
- else
- {
- for (kp = 0; kp < num; kp++)
- {
- p = top;
- data[kp] = rf(s7, &p);
- }
- }
- s7_xf_free(s7);
- free_snd_fd(sf);
- change_samples(beg, num, data, cp, caller, pos, -1.0);
- free(data);
- s7_set_curlet(s7, old_e);
- return(res);
- }
- s7_xf_free(s7);
- s7_set_curlet(s7, old_e);
- }
- }
- }
- /* (let ((rd (make-sampler 0))) (map-channel (lambda (y) (+ (next-sample rd) y)))) */
+ {
+ /* try s7_float_optimize */
+ s7_pointer e, yp, old_e;
+ s7_float_function opt_func;
+ e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
+ old_e = s7_set_curlet(s7, e);
+ yp = s7_make_slot(s7, e, arg, s7_make_mutable_real(s7, 1.5));
+
+ opt_func = s7_float_optimize(s7, body);
+ if (opt_func)
+ {
+ data = (mus_float_t *)calloc(num, sizeof(mus_float_t));
+ if (tree_memq(s7, arg, res))
+ {
+ samples_to_vct_with_reader(num, data, sf);
+ for (kp = 0; kp < num; kp++)
+ {
+ s7_slot_set_real_value(s7, yp, data[kp]);
+ data[kp] = opt_func(s7, res);
+ }
+ }
+ else
+ {
+ for (kp = 0; kp < num; kp++)
+ data[kp] = opt_func(s7, res);
+ }
+ free_snd_fd(sf);
+ change_samples(beg, num, data, cp, caller, pos, -1.0);
+ free(data);
+ s7_set_curlet(s7, old_e);
+ return(res);
+ }
+ }
+ } /* is one expr body */
arg = s7_car(s7_closure_args(s7, proc));
e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
@@ -3894,7 +3875,8 @@ static Xen g_sp_scan(Xen proc_and_list, Xen s_beg, Xen s_end, Xen snd, Xen chn,
body = s7_closure_body(s7, proc);
if ((s7_is_pair(body)) &&
- (s7_is_pair(s7_closure_args(s7, proc))))
+ (s7_is_pair(s7_closure_args(s7, proc))) &&
+ (!s7_tree_memq(s7, s7_make_symbol(s7, "set!"), body)))
{
s7_pointer arg, expr;
@@ -3913,67 +3895,48 @@ static Xen g_sp_scan(Xen proc_and_list, Xen s_beg, Xen s_end, Xen snd, Xen chn,
return(s_beg);
}
+ e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
+
if (s7_is_null(s7, s7_cdr(body)))
{
- s7_pointer res;
+ s7_pointer res, yp, old_e, y, val;
+ s7_function func;
res = s7_car(body);
- /* try pf mechanism */
- if (s7_is_symbol(s7_car(res)))
+ old_e = s7_set_curlet(s7, e); /* new env for scan lambda */
+ y = s7_make_mutable_real(s7, 1.5); /* slot for the scan lambda arg */
+ yp = s7_make_slot(s7, e, arg, y);
+ val = y;
+ func = s7_optimize(s7, body);
+ if (func)
{
- s7_pointer fcar;
- fcar = s7_symbol_value(s7, s7_car(res));
- if (s7_pf_function(s7, fcar))
+ for (kp = 0; kp < num; kp++)
{
- s7_pf_t pf;
- s7_pointer yp, old_e, y, val;
-
- e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
- old_e = s7_set_curlet(s7, e); /* new env for scan lambda */
- y = s7_make_mutable_real(s7, 1.5); /* slot for the scan lambda arg */
- yp = s7_make_slot(s7, e, arg, y);
- val = y;
-
- s7_xf_new(s7, e);
- pf = s7_pf_function(s7, fcar)(s7, res);
-
- if (pf)
+ s7_slot_set_real_value(s7, yp, read_sample(sf));
+ val = func(s7, res);
+
+ if (val != s7_f(s7))
{
- s7_pointer *top, *p;
- top = s7_xf_start(s7);
- for (kp = 0; kp < num; kp++)
+ if (counting)
+ counts++;
+ else
{
- s7_slot_set_real_value(s7, yp, read_sample(sf));
- p = top;
- val = pf(s7, &p);
- if (val != s7_f(s7))
- {
- if (counting)
- counts++;
- else
- {
- if (reporting) finish_progress_report(cp);
- free_snd_fd(sf);
- s7_xf_free(s7);
- s7_set_curlet(s7, old_e);
- return(C_llong_to_Xen_llong(kp + beg));
- }
- }
+ if (reporting) finish_progress_report(cp);
+ free_snd_fd(sf);
+ s7_set_curlet(s7, old_e);
+ return(C_llong_to_Xen_llong(kp + beg));
}
- s7_xf_free(s7);
- free_snd_fd(sf);
- s7_set_curlet(s7, old_e);
- if (counting)
- return(C_int_to_Xen_integer(counts));
- return(val);
}
- s7_xf_free(s7);
- s7_set_curlet(s7, old_e);
}
+ free_snd_fd(sf);
+ s7_set_curlet(s7, old_e);
+ if (counting)
+ return(C_int_to_Xen_integer(counts));
+ return(val);
}
+ s7_set_curlet(s7, old_e);
}
- e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
gc_loc = s7_gc_protect(s7, e);
slot = s7_make_slot(s7, e, arg, s7_make_real(s7, 0.0));
use_apply = false;
@@ -4107,7 +4070,19 @@ apply 'func' to samples in current channel (or the specified channel). \
if 'func' returns non-" PROC_FALSE ", the scan stops, and the current sample number is returned.\n " scan_chan_example
Snd_assert_channel(S_scan_chan, snd, chn, 4);
+
+#if HAVE_SCHEME
+ {
+ unsigned int gc_loc;
+ s7_pointer result;
+ gc_loc = s7_gc_protect(s7, proc);
+ result = g_sp_scan(proc, beg, end, snd, chn, S_scan_chan, false, edpos, 6, Xen_false);
+ s7_gc_unprotect_at(s7, gc_loc);
+ return(result);
+ }
+#else
return(g_sp_scan(proc, beg, end, snd, chn, S_scan_chan, false, edpos, 6, Xen_false));
+#endif
}
#endif
@@ -4129,7 +4104,19 @@ func is a function of one argument, the current sample. \
if func returns non-" PROC_FALSE ", the scan stops, and the current sample number is returned. \n " scan_channel_example
Snd_assert_channel(S_scan_channel, snd, chn, 4);
+
+#if HAVE_SCHEME
+ {
+ unsigned int gc_loc;
+ s7_pointer result;
+ gc_loc = s7_gc_protect(s7, proc);
+ result = g_sp_scan(proc, beg, Xen_false, snd, chn, S_scan_channel, false, edpos, 6, (Xen_is_bound(dur)) ? dur : Xen_false);
+ s7_gc_unprotect_at(s7, gc_loc);
+ return(result);
+ }
+#else
return(g_sp_scan(proc, beg, Xen_false, snd, chn, S_scan_channel, false, edpos, 6, (Xen_is_bound(dur)) ? dur : Xen_false));
+#endif
}
@@ -4149,7 +4136,18 @@ static Xen g_map_chan(Xen proc, Xen s_beg, Xen s_end, Xen org, Xen snd, Xen chn,
#define H_map_chan "(" S_map_chan " func :optional (start 0) (end len) edname snd chn edpos): \
apply func to samples in current channel; edname is the edit history name for this editing operation.\n " map_chan_example
+#if HAVE_SCHEME
+ {
+ unsigned int gc_loc;
+ s7_pointer result;
+ gc_loc = s7_gc_protect(s7, proc);
+ result = g_map_chan_1(proc, s_beg, s_end, org, snd, chn, edpos, Xen_false, S_map_chan);
+ s7_gc_unprotect_at(s7, gc_loc);
+ return(result);
+ }
+#else
return(g_map_chan_1(proc, s_beg, s_end, org, snd, chn, edpos, Xen_false, S_map_chan));
+#endif
}
#endif
@@ -4169,7 +4167,18 @@ static Xen g_map_channel(Xen proc, Xen s_beg, Xen s_dur, Xen snd, Xen chn, Xen e
#define H_map_channel "(" S_map_channel " func :optional (start 0) (dur len) snd chn edpos edname): \
apply func to samples in current channel; edname is the edit history name for this editing operation.\n " map_channel_example
+#if HAVE_SCHEME
+ {
+ unsigned int gc_loc;
+ s7_pointer result;
+ gc_loc = s7_gc_protect(s7, proc);
+ result = g_map_chan_1(proc, s_beg, Xen_false, org, snd, chn, edpos, (Xen_is_bound(s_dur)) ? s_dur : Xen_false, S_map_channel);
+ s7_gc_unprotect_at(s7, gc_loc);
+ return(result);
+ }
+#else
return(g_map_chan_1(proc, s_beg, Xen_false, org, snd, chn, edpos, (Xen_is_bound(s_dur)) ? s_dur : Xen_false, S_map_channel));
+#endif
}
@@ -4529,7 +4538,7 @@ swap the indicated channels"
return(snd_no_such_sound_error(S_swap_channels, snd1));
if (cp0->sound == sp)
{
- if ((cp0->chan + 1) < sp->nchans)
+ if ((cp0->chan + 1) < (int)sp->nchans)
cp1 = sp->chans[cp0->chan + 1];
else cp1 = sp->chans[0];
}
@@ -4603,7 +4612,7 @@ swap the indicated channels"
static mus_float_t *load_mus_float_ts(Xen scalers, int *result_len, const char *caller)
{
- int len = 0, i;
+ unsigned int len = 0, i;
mus_float_t *scls;
vct *v = NULL;
if (Xen_is_number(scalers))
@@ -4613,15 +4622,17 @@ static mus_float_t *load_mus_float_ts(Xen scalers, int *result_len, const char *
if (mus_is_vct(scalers))
{
v = Xen_to_vct(scalers);
- len = mus_vct_length(v);
+ len = (unsigned int)mus_vct_length(v);
}
else
{
if (Xen_is_list(scalers))
{
- len = Xen_list_length(scalers);
- if (len < 0)
+ int lst_len;
+ lst_len = Xen_list_length(scalers);
+ if (lst_len < 0)
Xen_wrong_type_arg_error(caller, 1, scalers, "a proper list");
+ len = (unsigned int)lst_len;
}
else Xen_wrong_type_arg_error(caller, 1, scalers, "a number, list, or " S_vct);
}
@@ -4634,7 +4645,7 @@ static mus_float_t *load_mus_float_ts(Xen scalers, int *result_len, const char *
scls = (mus_float_t *)calloc(len, sizeof(mus_float_t));
if (v)
- memcpy((void *)scls, (void *)(mus_vct_data(v)), len * sizeof(mus_float_t));
+ copy_floats(scls, mus_vct_data(v), len);
else
{
if (Xen_is_list(scalers))
@@ -5122,16 +5133,16 @@ If sign is -1, perform inverse fft. Incoming data is in " S_vct "s."
rl = (mus_float_t *)calloc(n2, sizeof(mus_float_t));
im = (mus_float_t *)calloc(n2, sizeof(mus_float_t));
need_free = true;
- memcpy((void *)rl, (void *)(mus_vct_data(v1)), n * sizeof(mus_float_t));
- memcpy((void *)im, (void *)(mus_vct_data(v2)), n * sizeof(mus_float_t));
+ copy_floats(rl, mus_vct_data(v1), n);
+ copy_floats(im, mus_vct_data(v2), n);
}
mus_fft(rl, im, n2, isign);
if (need_free)
{
- memcpy((void *)(mus_vct_data(v1)), (void *)rl, n * sizeof(mus_float_t));
- memcpy((void *)(mus_vct_data(v2)), (void *)im, n * sizeof(mus_float_t));
+ copy_floats(mus_vct_data(v1), rl, n);
+ copy_floats(mus_vct_data(v2), im, n);
free(rl);
free(im);
}
@@ -5182,7 +5193,7 @@ magnitude spectrum of data (a " S_vct "), in data if in-place, using fft-window
rdat = (mus_float_t *)malloc(n * sizeof(mus_float_t));
if (n < mus_vct_length(v))
for (i = 0; i < n; i++) rdat[i] = vdata[i];
- else memcpy((void *)rdat, (void *)vdata, mus_vct_length(v) * sizeof(mus_float_t));
+ else copy_floats(rdat, vdata, mus_vct_length(v));
}
else rdat = mus_vct_data(v);
@@ -5979,8 +5990,8 @@ static mus_float_t get_peak(int choice, int fft_size, int n, mus_float_t *phases
mus_float_t pi2, mx_sin, mx_cos;
pi2 = M_PI / 2.0;
- memset((void *)rl, 0, fft_size * sizeof(mus_float_t));
- memset((void *)im, 0, fft_size * sizeof(mus_float_t));
+ clear_floats(rl, fft_size);
+ clear_floats(im, fft_size);
for (m = 0; m < n; m++)
{
diff --git a/snd-snd.c b/snd-snd.c
index f9e66a1..0bf13ac 100644
--- a/snd-snd.c
+++ b/snd-snd.c
@@ -413,7 +413,11 @@ static bool tick_peak_env(chan_info *cp, env_state *es)
{
ssize_t bytes_read;
- bytes_read = read(es->fd, (char *)(es->direct_data), lm * es->bytes);
+ /* there might be trailing chunks, so we have to keep track of es->samples (Tito Latini 2-Feb-17) */
+ bytes_read = es->samples * mus_bytes_per_sample(es->format) * es->chans;
+ if (bytes_read > (lm * es->bytes))
+ bytes_read = lm * es->bytes;
+ bytes_read = read(es->fd, (char *)(es->direct_data), bytes_read);
if (bytes_read < lm * es->bytes)
{
int zero_byte;
@@ -634,8 +638,11 @@ int peak_env_graph(chan_info *cp, mus_float_t samples_per_pixel, int srate)
k = (int)xf;
xf += step;
kk = (int)xf;
- if (kk >= ep->peak_env_size)
- kk = ep->peak_env_size - 1;
+ if (kk >= ep->peak_env_size)
+ {
+ kk = ep->peak_env_size - 1;
+ if (k > kk) k = kk; /* make sure we get a value below */
+ }
for (; k <= kk; k++)
{
if (ep->data_min[k] < ymin) ymin = ep->data_min[k];
@@ -924,8 +931,8 @@ peak_env_info *copy_peak_env_info(peak_env_info *old_ep, bool reversed)
}
else
{
- memcpy((void *)new_ep->data_min, (void *)old_ep->data_min, sizeof(mus_float_t) * new_ep->peak_env_size);
- memcpy((void *)new_ep->data_max, (void *)old_ep->data_max, sizeof(mus_float_t) * new_ep->peak_env_size);
+ copy_floats(new_ep->data_min, old_ep->data_min, new_ep->peak_env_size);
+ copy_floats(new_ep->data_max, old_ep->data_max, new_ep->peak_env_size);
}
new_ep->completed = true;
@@ -1118,8 +1125,8 @@ void peak_env_insert_zeros(chan_info *cp, mus_long_t beg, mus_long_t num, int po
i = (int)ceil(end / new_ep->samps_per_bin);
bins = new_ep->peak_env_size - i;
if (old_ep->peak_env_size < bins) bins = old_ep->peak_env_size;
- memcpy((void *)(&(new_ep->data_min[i])), (void *)old_ep->data_min, sizeof(mus_float_t) * bins);
- memcpy((void *)(&(new_ep->data_max[i])), (void *)old_ep->data_max, sizeof(mus_float_t) * bins);
+ copy_floats(&(new_ep->data_min[i]), old_ep->data_min, bins);
+ copy_floats(&(new_ep->data_max[i]), old_ep->data_max, bins);
}
else
{
@@ -1128,16 +1135,16 @@ void peak_env_insert_zeros(chan_info *cp, mus_long_t beg, mus_long_t num, int po
/* copy start */
bins = (int)floor(beg / old_ep->samps_per_bin);
if (bins > old_ep->peak_env_size) bins = old_ep->peak_env_size;
- memcpy((void *)new_ep->data_min, (void *)old_ep->data_min, sizeof(mus_float_t) * bins);
- memcpy((void *)new_ep->data_max, (void *)old_ep->data_max, sizeof(mus_float_t) * bins);
+ copy_floats(new_ep->data_min, old_ep->data_min, bins);
+ copy_floats(new_ep->data_max, old_ep->data_max, bins);
}
else
{
i = (int)floor(beg / old_ep->samps_per_bin);
if (i > 0)
{
- memcpy((void *)new_ep->data_min, (void *)old_ep->data_min, sizeof(mus_float_t) * i);
- memcpy((void *)new_ep->data_max, (void *)old_ep->data_max, sizeof(mus_float_t) * i);
+ copy_floats(new_ep->data_min, old_ep->data_min, i);
+ copy_floats(new_ep->data_max, old_ep->data_max, i);
}
if (i < new_ep->peak_env_size)
{
@@ -1155,8 +1162,8 @@ void peak_env_insert_zeros(chan_info *cp, mus_long_t beg, mus_long_t num, int po
bins = new_ep->peak_env_size - j;
if ((i + bins) >= old_ep->peak_env_size)
bins = old_ep->peak_env_size - i;
- memcpy((void *)(&(new_ep->data_min[j])), (void *)(&(old_ep->data_min[i])), sizeof(mus_float_t) * bins);
- memcpy((void *)(&(new_ep->data_max[j])), (void *)(&(old_ep->data_max[i])), sizeof(mus_float_t) * bins);
+ copy_floats(&(new_ep->data_min[j]), &(old_ep->data_min[i]), bins);
+ copy_floats(&(new_ep->data_max[j]), &(old_ep->data_max[i]), bins);
}
}
}
@@ -1273,7 +1280,7 @@ char *shortname_indexed(snd_info *sp)
void add_sound_data(char *filename, snd_info *sp, channel_graph_t graphed)
{
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
add_channel_data(filename, sp->chans[i], graphed);
}
@@ -1826,7 +1833,7 @@ static bool apply_controls(apply_state *ap)
remember_temp(ap->ofile, sp->nchans);
if (apply_beg > 0)
{
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
if (file_change_samples(apply_beg, apply_dur, ap->ofile, sp->chans[i], i,
(sp->nchans > 1) ? MULTICHANNEL_DELETION : DELETE_ME,
@@ -1836,7 +1843,7 @@ static bool apply_controls(apply_state *ap)
}
else
{
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
if (file_override_samples(apply_dur, ap->ofile, sp->chans[i], i,
(sp->nchans > 1) ? MULTICHANNEL_DELETION : DELETE_ME,
@@ -1896,7 +1903,7 @@ static bool apply_controls(apply_state *ap)
if ((sp->expand_control_on) ||
(sp->speed_control_direction != 1) || (!(snd_feq(sp->speed_control, 1.0))))
{
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
cp = sp->chans[i];
if (cp->edits[cp->edit_ctr]->marks)
@@ -2253,7 +2260,7 @@ static Xen s7_xen_sound_fill(s7_scheme *sc, Xen args)
{
mus_float_t valf;
chan_info *cp;
- int i;
+ unsigned int i;
s7_pointer val;
val = s7_cadr(args);
@@ -2405,7 +2412,7 @@ channel for editing."
sp = any_selected_sound();
if ((sp) &&
(chan >= 0) &&
- (chan < sp->nchans))
+ (chan < (int)sp->nchans))
{
select_channel(sp, chan);
return(chn_n);
@@ -2787,7 +2794,7 @@ static Xen sound_set(Xen snd, Xen val, sp_field_t fld, const char *caller)
else
{
/* reset x axis bounds */
- int i;
+ unsigned int i;
for (i = 0; i < sp->nchans; i++)
set_x_axis_x0x1(sp->chans[i], 0.0, (double)(current_samples(sp->chans[i])) / (double)ival);
}
@@ -2798,7 +2805,7 @@ static Xen sound_set(Xen snd, Xen val, sp_field_t fld, const char *caller)
if (!(is_player_sound(sp)))
{
ival = Xen_integer_to_C_int(val);
- if ((ival <= 0) || (ival > 256))
+ if ((ival <= 0) || (ival > MUS_MAX_CHANS))
Xen_out_of_range_error(S_set S_channels, 1, val, "highly unlikely number of channels");
mus_sound_set_chans(sp->filename, ival);
sp->hdr->chans = ival;
@@ -2823,7 +2830,7 @@ static Xen sound_set(Xen snd, Xen val, sp_field_t fld, const char *caller)
mus_sound_set_samples(sp->filename, sp->hdr->samples);
}
/* clear peak amp envs, if any -- is this right? (snd-update below...) */
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
{
chan_info *cp;
cp = sp->chans[i];
@@ -3727,7 +3734,7 @@ static Xen g_set_selected_channel(Xen snd, Xen chn_n)
mus_long_t chan = 0;
if (Xen_is_integer(chn_n)) chan = Xen_integer_to_C_int(chn_n);
if ((chan >= 0) &&
- (chan < sp->nchans))
+ (chan < (int)sp->nchans))
{
select_channel(sp, (int)chan);
return(chn_n);
@@ -3879,7 +3886,7 @@ static Xen g_revert_sound(Xen index)
{
#define H_revert_sound "(" S_revert_sound " :optional snd): revert snd to its unedited state (undo all)"
snd_info *sp;
- int i;
+ unsigned int i;
Snd_assert_sound(S_revert_sound, index, 1);
@@ -4010,7 +4017,7 @@ open file assuming the data matches the attributes indicated unless the file act
file = mus_optkey_to_string(keys[0], S_open_raw_sound, orig_arg[0], NULL);
oc = mus_optkey_to_int(keys[1], S_open_raw_sound, orig_arg[1], oc);
if ((oc < 0) ||
- (oc > 256))
+ (oc > MUS_MAX_CHANS))
Xen_out_of_range_error(S_open_raw_sound, 2, args[orig_arg[1]], "too many channels requested");
if (!(Xen_is_keyword(keys[1]))) set_fallback_chans(oc);
os = mus_optkey_to_int(keys[2], S_open_raw_sound, orig_arg[2], os);
@@ -4215,13 +4222,13 @@ Omitted arguments take their value from the sound being saved.\n " save_as_exam
C_string_to_Xen_string(mus_sample_type_name(df)),
C_string_to_Xen_string(mus_header_type_name(ht))));
- if (chan >= sp->nchans)
+ if (chan >= (int)(sp->nchans))
return(snd_no_such_channel_error(S_save_sound_as, index, keys[5]));
if (got_edpos)
{
edit_position = to_c_edit_position(sp->chans[(chan >= 0) ? chan : 0], edpos, S_save_sound_as, 7);
- for (i = 0; i < sp->nchans; i++)
+ for (i = 0; i < (int)sp->nchans; i++)
if (edit_position > sp->chans[i]->edit_ctr)
Xen_error(Xen_make_error_type("no-such-edit"),
Xen_list_5(C_string_to_Xen_string(S_save_sound_as ": no such edit position: ~A (~S chan ~A has ~A edits)"),
@@ -5503,7 +5510,7 @@ If 'filename' is a sound index or a sound object, 'size' is interpreted as an ed
sp = find_sound(fullname, 0);
if (sp)
{
- if (chn < sp->nchans)
+ if (chn < (int)sp->nchans)
{
cp = sp->chans[chn];
if (cp->edits[0]->peak_env)
@@ -5577,7 +5584,7 @@ If 'filename' is a sound index or a sound object, 'size' is interpreted as an ed
if (fullname) free(fullname);
fullname = NULL;
if ((sp) &&
- (chn < sp->nchans))
+ (chn < (int)sp->nchans))
{
cp = sp->chans[chn];
if (cp)
diff --git a/snd-test.scm b/snd-test.scm
index cb15361..24f31b2 100644
--- a/snd-test.scm
+++ b/snd-test.scm
@@ -2337,11 +2337,10 @@
(if (not (string=? str "23-Nov 06:56 PST"))
(snd-display "mus-sound-write-date pistol.snd: ~A?" str)))
- (let ((long-file-name (do ((name "test")
+ (let ((long-file-name (do ((name "test" (string-append name "-test"))
(i 0 (+ i 1)))
((= i 10)
- (string-append name ".snd"))
- (set! name (string-append name "-test")))))
+ (string-append name ".snd")))))
(let ((index (open-sound "oboe.snd")))
(if (variable-graph? index) (snd-display "variable-graph thinks anything is a graph..."))
(if (player? index) (snd-display "player? thinks anything is a player..."))
@@ -2464,16 +2463,16 @@
(let ((ind (new-sound "fmv.snd" 1 22050 mus-ldouble mus-next "set-samples test" 100)))
(set! (samples 10 3) (make-float-vector 3 .1))
- (if (not (mus-arrays-equal? (channel->float-vector 0 20 ind 0) (float-vector 0 0 0 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 20 ind 0) #r(0 0 0 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
(snd-display "1 set samples 0 for .1: ~A" (channel->float-vector 0 20 ind 0)))
(set! (samples 20 3 ind 0) (make-float-vector 3 .1))
- (if (not (mus-arrays-equal? (channel->float-vector 10 20 ind 0) (float-vector .1 .1 .1 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 10 20 ind 0) #r(.1 .1 .1 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
(snd-display "2 set samples 10 for .1: ~A" (channel->float-vector 10 20 ind 0)))
(set! (samples 30 3 ind 0 #f "a name") (make-float-vector 3 .1))
- (if (not (mus-arrays-equal? (channel->float-vector 20 20 ind 0) (float-vector .1 .1 .1 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 20 20 ind 0) #r(.1 .1 .1 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
(snd-display "3 set samples 20 for .1: ~A" (channel->float-vector 20 20 ind 0)))
(set! (samples 0 3 ind 0 #f "a name" 0 1) (make-float-vector 3 .2))
- (if (not (mus-arrays-equal? (channel->float-vector 0 20 ind 0) (float-vector .2 .2 .2 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 20 ind 0) #r(.2 .2 .2 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
(snd-display "4 set samples 0 at 1 for .1: ~A" (channel->float-vector 0 20 ind 0)))
(if (not (mus-arrays-equal? (channel->float-vector 20 20 ind 0) (make-float-vector 20)))
(snd-display "5 set samples 20 at 1 for .1: ~A" (channel->float-vector 0 20 ind 0)))
@@ -2484,17 +2483,17 @@
(close-sound nd))
(if (not (file-exists? "fmv1.snd")) (snd-display "fmv1 not saved??"))
(set! (samples 0 10 ind 0 #f "another name" 1) "fmv1.snd")
- (if (not (mus-arrays-equal? (channel->float-vector 0 20 ind 0) (float-vector .3 .3 .3 .3 .3 .3 .3 .3 .3 .3 .1 .1 .1 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 20 ind 0) #r(.3 .3 .3 .3 .3 .3 .3 .3 .3 .3 .1 .1 .1 0 0 0 0 0 0 0)))
(snd-display "6 set samples 0 at 1 for .1: ~A" (channel->float-vector 0 20 ind 0)))
(set! (samples 5 6 ind 0 #f "another name 7" 0) "fmv1.snd")
- (if (not (mus-arrays-equal? (channel->float-vector 0 20 ind 0) (float-vector .3 .3 .3 .3 .3 .5 .5 .5 .5 .5 .5 .1 .1 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 20 ind 0) #r(.3 .3 .3 .3 .3 .5 .5 .5 .5 .5 .5 .1 .1 0 0 0 0 0 0 0)))
(snd-display "7 set samples 0 at 1 for .1: ~A" (channel->float-vector 0 20 ind 0)))
(revert-sound ind)
(set! (samples 0 10 ind 0 #f "another name 8" 1 0 #f) "fmv1.snd")
- (if (not (mus-arrays-equal? (channel->float-vector 0 20 ind 0) (float-vector .3 .3 .3 .3 .3 .3 .3 .3 .3 .3 0 0 0 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 20 ind 0) #r(.3 .3 .3 .3 .3 .3 .3 .3 .3 .3 0 0 0 0 0 0 0 0 0 0)))
(snd-display "8 set samples 0 at 1 for .1: ~A" (channel->float-vector 0 20 ind 0)))
(set! (samples 10 10 ind 0 #f "another name 9" 0 0) "fmv1.snd")
- (if (not (mus-arrays-equal? (channel->float-vector 0 20 ind 0) (float-vector 0 0 0 0 0 0 0 0 0 0 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 20 ind 0) #r(0 0 0 0 0 0 0 0 0 0 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5)))
(snd-display "9 set samples 0 at 1 for .1: ~A" (channel->float-vector 0 20 ind 0)))
(set! (samples 20 10) "fmv1.snd")
(if (not (mus-arrays-equal? (channel->float-vector 10 20 ind 0) (make-float-vector 20 .5)))
@@ -2536,7 +2535,7 @@
(for-each
(lambda (type allowed-diff)
(let ((v (make-float-vector len)))
- (copy #(0.999 -1.0 .1 -.1 .001 -.001 0.0) v)
+ (copy #r(0.999 -1.0 .1 -.1 .001 -.001 0.0) v)
(do ((i 7 (+ i 1)))
((= i len))
(let ((val (random 1.9999)))
@@ -3038,7 +3037,7 @@
(close-sound snd))
(let ((snd (open-sound "test.snd")))
(let ((data (channel->float-vector 0 10)))
- (if (not (mus-arrays-equal? data (float-vector 0.0 1.0 -1.0 1.0 0.0 0.0 -0.700 0.700 -0.200 0.200)))
+ (if (not (mus-arrays-equal? data #r(0.0 1.0 -1.0 1.0 0.0 0.0 -0.700 0.700 -0.200 0.200)))
(snd-display "unclipped 1: ~A" data)))
(close-sound snd))
(mus-sound-forget "test.snd")
@@ -3059,7 +3058,7 @@
(close-sound snd))
(let ((snd (open-sound "test.snd")))
(let ((data (channel->float-vector 0 10)))
- (if (not (mus-arrays-equal? data (float-vector 0.0 1.0 -1.0 1.0 1.0 -1.0 1.0 -1.0 1.0 -1.000)))
+ (if (not (mus-arrays-equal? data #r(0.0 1.0 -1.0 1.0 1.0 -1.0 1.0 -1.0 1.0 -1.000)))
(snd-display "clipped: ~A" data)))
(close-sound snd))
(set! *clipping* #f)
@@ -3073,43 +3072,43 @@
(snd-display "~A: ~A != ~A" file data ndata))
(close-sound ind)))
(lambda args args)))))
- (test-data (string-append sf-dir "next-dbl.snd") 10 10 (float-vector 0.475 0.491 0.499 0.499 0.492 0.476 0.453 0.423 0.387 0.344))
- (test-data (string-append sf-dir "oboe.ldbl") 1000 10 (float-vector 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004))
+ (test-data (string-append sf-dir "next-dbl.snd") 10 10 #r(0.475 0.491 0.499 0.499 0.492 0.476 0.453 0.423 0.387 0.344))
+ (test-data (string-append sf-dir "oboe.ldbl") 1000 10 #r(0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004))
- (test-data (string-append sf-dir "next-flt.snd") 10 10 (float-vector 0.475 0.491 0.499 0.499 0.492 0.476 0.453 0.423 0.387 0.344))
- (test-data (string-append sf-dir "clbonef.wav") 1000 10 (float-vector 0.111 0.101 0.070 0.032 -0.014 -0.060 -0.085 -0.108 -0.129 -0.152))
+ (test-data (string-append sf-dir "next-flt.snd") 10 10 #r(0.475 0.491 0.499 0.499 0.492 0.476 0.453 0.423 0.387 0.344))
+ (test-data (string-append sf-dir "clbonef.wav") 1000 10 #r(0.111 0.101 0.070 0.032 -0.014 -0.060 -0.085 -0.108 -0.129 -0.152))
- (test-data (string-append sf-dir "next-8.snd") 10 10 (float-vector 0.898 0.945 0.977 0.992 0.992 0.977 0.945 0.906 0.844 0.773))
- (test-data (string-append sf-dir "o2_u8.wave") 1000 10 (float-vector -0.164 -0.219 -0.258 -0.242 -0.180 -0.102 -0.047 0.0 0.039 0.055))
+ (test-data (string-append sf-dir "next-8.snd") 10 10 #r(0.898 0.945 0.977 0.992 0.992 0.977 0.945 0.906 0.844 0.773))
+ (test-data (string-append sf-dir "o2_u8.wave") 1000 10 #r(-0.164 -0.219 -0.258 -0.242 -0.180 -0.102 -0.047 0.0 0.039 0.055))
- (test-data (string-append sf-dir "next-16.snd") 1000 10 (float-vector -0.026 -0.022 -0.024 -0.030 -0.041 -0.048 -0.050 -0.055 -0.048 -0.033))
- (test-data (string-append sf-dir "o2.wave") 1000 10 (float-vector -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
+ (test-data (string-append sf-dir "next-16.snd") 1000 10 #r(-0.026 -0.022 -0.024 -0.030 -0.041 -0.048 -0.050 -0.055 -0.048 -0.033))
+ (test-data (string-append sf-dir "o2.wave") 1000 10 #r(-0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
- (test-data (string-append sf-dir "o2_18bit.aiff") 1000 10 (float-vector -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
- (test-data (string-append sf-dir "o2_12bit.aiff") 1000 10 (float-vector -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
+ (test-data (string-append sf-dir "o2_18bit.aiff") 1000 10 #r(-0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
+ (test-data (string-append sf-dir "o2_12bit.aiff") 1000 10 #r(-0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
- (test-data (string-append sf-dir "next24.snd") 1000 10 (float-vector -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
- (test-data (string-append sf-dir "mono24.wav") 1000 10 (float-vector 0.005 0.010 0.016 0.008 -0.007 -0.018 -0.025 -0.021 -0.005 0.001))
+ (test-data (string-append sf-dir "next24.snd") 1000 10 #r(-0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
+ (test-data (string-append sf-dir "mono24.wav") 1000 10 #r(0.005 0.010 0.016 0.008 -0.007 -0.018 -0.025 -0.021 -0.005 0.001))
- (test-data (string-append sf-dir "o2_711u.wave") 1000 10 (float-vector -0.164 -0.219 -0.254 -0.242 -0.172 -0.103 -0.042 0.005 0.042 0.060))
- (test-data (string-append sf-dir "alaw.wav") 1000 10 (float-vector -0.024 -0.048 -0.024 0.0 0.008 0.008 0.0 -0.040 -0.064 -0.024))
+ (test-data (string-append sf-dir "o2_711u.wave") 1000 10 #r(-0.164 -0.219 -0.254 -0.242 -0.172 -0.103 -0.042 0.005 0.042 0.060))
+ (test-data (string-append sf-dir "alaw.wav") 1000 10 #r(-0.024 -0.048 -0.024 0.0 0.008 0.008 0.0 -0.040 -0.064 -0.024))
;; it is not a bug if these don't match if MUS_SAMPLE_BITS is not 24
- (test-data (string-append sf-dir "b32.pvf") 1000 10 (float-vector -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
- (test-data (string-append sf-dir "b32.wave") 1000 10 (float-vector -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
- (test-data (string-append sf-dir "b32.snd") 1000 10 (float-vector -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
- (test-data (string-append sf-dir "32bit.sf") 1000 10 (float-vector 0.016 0.014 0.013 0.011 0.010 0.010 0.010 0.010 0.012 0.014))
-
- (test-data (string-append sf-dir "nist-shortpack.wav") 10000 10 (float-vector 0.021 0.018 0.014 0.009 0.004 -0.001 -0.004 -0.006 -0.007 -0.008))
- (test-data (string-append sf-dir "wood.sds") 1000 10 (float-vector -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
- (test-data (string-append sf-dir "mus10.snd") 10000 10 (float-vector 0.004 0.001 0.005 0.009 0.017 0.015 0.008 0.011 0.009 0.012))
- (test-data (string-append sf-dir "ieee-text-16.snd") 1000 10 (float-vector -0.052 -0.056 -0.069 -0.077 -0.065 -0.049 -0.054 -0.062 -0.066 -0.074))
- (test-data (string-append sf-dir "hcom-16.snd") 10000 10 (float-vector 0.0 0.0 0.0 0.008 0.0 -0.016 -0.016 -0.016 -0.008 0.000))
- (test-data (string-append sf-dir "ce-c3.w02") 1000 10 (float-vector 0.581 0.598 0.596 0.577 0.552 0.530 0.508 0.479 0.449 0.425))
- (test-data (string-append sf-dir "nasahal.avi") 20000 10 (float-vector 0.390 0.120 -0.399 -0.131 0.464 0.189 -0.458 -0.150 0.593 0.439))
- (test-data (string-append sf-dir "oki.wav") 100 10 (float-vector 0.396 0.564 0.677 0.779 0.761 0.540 0.209 -0.100 -0.301 -0.265))
-
- (test-data (string-append sf-dir "trumps22.adp") 5000 10 (float-vector 0.267 0.278 0.309 0.360 0.383 0.414 0.464 0.475 0.486 0.495)))
+ (test-data (string-append sf-dir "b32.pvf") 1000 10 #r(-0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
+ (test-data (string-append sf-dir "b32.wave") 1000 10 #r(-0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
+ (test-data (string-append sf-dir "b32.snd") 1000 10 #r(-0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
+ (test-data (string-append sf-dir "32bit.sf") 1000 10 #r(0.016 0.014 0.013 0.011 0.010 0.010 0.010 0.010 0.012 0.014))
+
+ (test-data (string-append sf-dir "nist-shortpack.wav") 10000 10 #r(0.021 0.018 0.014 0.009 0.004 -0.001 -0.004 -0.006 -0.007 -0.008))
+ (test-data (string-append sf-dir "wood.sds") 1000 10 #r(-0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
+ (test-data (string-append sf-dir "mus10.snd") 10000 10 #r(0.004 0.001 0.005 0.009 0.017 0.015 0.008 0.011 0.009 0.012))
+ (test-data (string-append sf-dir "ieee-text-16.snd") 1000 10 #r(-0.052 -0.056 -0.069 -0.077 -0.065 -0.049 -0.054 -0.062 -0.066 -0.074))
+ (test-data (string-append sf-dir "hcom-16.snd") 10000 10 #r(0.0 0.0 0.0 0.008 0.0 -0.016 -0.016 -0.016 -0.008 0.000))
+ (test-data (string-append sf-dir "ce-c3.w02") 1000 10 #r(0.581 0.598 0.596 0.577 0.552 0.530 0.508 0.479 0.449 0.425))
+ (test-data (string-append sf-dir "nasahal.avi") 20000 10 #r(0.390 0.120 -0.399 -0.131 0.464 0.189 -0.458 -0.150 0.593 0.439))
+ (test-data (string-append sf-dir "oki.wav") 100 10 #r(0.396 0.564 0.677 0.779 0.761 0.540 0.209 -0.100 -0.301 -0.265))
+
+ (test-data (string-append sf-dir "trumps22.adp") 5000 10 #r(0.267 0.278 0.309 0.360 0.383 0.414 0.464 0.475 0.486 0.495)))
(let ((errs (list "no error" "no frequency method" "no phase method" "null gen arg to method" "no length method"
"no describe method" "no data method" "no scaler method"
@@ -3352,7 +3351,7 @@
(let ((ind (new-sound "tmp.snd" 1 22050 mus-ldouble mus-next :size 10 :comment #f)))
(map-channel (lambda (y) 1.0))
(env-channel '(0 0 .1 .1 .2 .2 .3 .3 .4 .4 .5 .5 .6 .6 .7 .7 .8 .8 .9 .9))
- (if (not (mus-arrays-equal? (channel->float-vector) (float-vector 0.0 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
+ (if (not (mus-arrays-equal? (channel->float-vector) #r(0.0 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
(snd-display "ramp env by .1: ~A" (channel->float-vector)))
(close-sound ind)))
@@ -4029,17 +4028,17 @@
(float-vector->channel (make-float-vector 10 1.0))
(env-channel '(0 0 1 1 2 0))
(let ((data (channel->float-vector)))
- (if (not (mus-arrays-equal? data (float-vector 0.0 0.200 0.400 0.600 0.800 1.0 0.750 0.500 0.250 0.000)))
+ (if (not (mus-arrays-equal? data #r(0.0 0.200 0.400 0.600 0.800 1.0 0.750 0.500 0.250 0.000)))
(snd-display "pyr 10: ~A" data)))
(undo)
(env-channel '((0 0) (1 1) (2 0)))
(let ((data (channel->float-vector)))
- (if (not (mus-arrays-equal? data (float-vector 0.0 0.200 0.400 0.600 0.800 1.0 0.750 0.500 0.250 0.000)))
+ (if (not (mus-arrays-equal? data #r(0.0 0.200 0.400 0.600 0.800 1.0 0.750 0.500 0.250 0.000)))
(snd-display "pyr 10: ~A" data)))
(undo)
(env-channel (make-env '(0 0 1 1 2 0) :length 10))
(let ((data (channel->float-vector)))
- (if (not (mus-arrays-equal? data (float-vector 0.0 0.200 0.400 0.600 0.800 1.0 0.750 0.500 0.250 0.000)))
+ (if (not (mus-arrays-equal? data #r(0.0 0.200 0.400 0.600 0.800 1.0 0.750 0.500 0.250 0.000)))
(snd-display "pyr 10: ~A" data)))
(undo)
(close-sound ind))
@@ -5016,21 +5015,21 @@ EDITS: 5
(if (fneq (maxamp ind 0) 1.0)
(snd-display "float-vector->channel size mismatch maxamp: ~A" (maxamp ind 0)))
(if (not (mus-arrays-equal? (channel->float-vector 0 20 ind 0)
- (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
+ #r(0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
(snd-display "float-vector->channel size mismatch: ~A" (channel->float-vector 0 20 ind 0)))
(revert-sound ind)
(set! (samples 10 5) (make-float-vector 3 1.0))
(if (fneq (maxamp ind 0) 1.0)
(snd-display "set samples size mismatch maxamp: ~A" (maxamp ind 0)))
(if (not (mus-arrays-equal? (channel->float-vector 0 20 ind 0)
- (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
+ #r(0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
(snd-display "set samples size mismatch: ~A" (channel->float-vector 0 20 ind 0)))
(revert-sound ind)
(insert-samples 10 8 (make-float-vector 3 1.0) ind 0)
(if (fneq (maxamp ind 0) 1.0)
(snd-display "insert samples size mismatch maxamp: ~A" (maxamp ind 0)))
(if (not (mus-arrays-equal? (channel->float-vector 0 20 ind 0)
- (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
+ #r(0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
(snd-display "insert samples size mismatch: ~A" (channel->float-vector 0 20 ind 0)))
(close-sound ind))
@@ -5105,12 +5104,12 @@ EDITS: 5
(graph-data (make-float-vector 4) index 0 copy-context #f #f graph-lines cr)
(free-cairo cr)
(update-lisp-graph))
- (graph (float-vector 0 0 1 1 2 0))
+ (graph #r(0 0 1 1 2 0))
(do ((i 0 (+ i 1)))
((= i 32))
- (graph (float-vector 0 1 2))
- (graph (list (float-vector 0 1 2) (float-vector 3 2 1) (float-vector 1 2 3)))
- (graph (list (float-vector 0 1 2) (float-vector 3 2 1))))
+ (graph #r(0 1 2))
+ (graph (list #r(0 1 2) #r(3 2 1) #r(1 2 3)))
+ (graph (list #r(0 1 2) #r(3 2 1))))
(set! (x-bounds) (list 0.0 0.01))
(let ((data (make-graph-data)))
(if (float-vector? data)
@@ -5416,7 +5415,7 @@ EDITS: 5
(if (or (fneq (sample 60) .25) (fneq (sample 61) .25))
(snd-display "set-samples: ~A ~A ~A?" (sample 60) (sample 61) (sample 62))))
(set! (samples 10 3 index) (list 0.1 0.2 0.3))
- (if (not (mus-arrays-equal? (channel->float-vector 10 3 index) (float-vector 0.1 0.2 0.3)))
+ (if (not (mus-arrays-equal? (channel->float-vector 10 3 index) #r(0.1 0.2 0.3)))
(snd-display "set-samples via list: ~A" (channel->float-vector 10 3 index)))
(revert-sound index)
(save-sound-as "temporary.snd" index)
@@ -5643,7 +5642,7 @@ EDITS: 5
(let ((ind (open-sound "1a.snd")))
(scale-to 1.0 ind 0)
(make-selection 1000 2000 ind 0)
- (filter-selection-and-smooth .01 (float-vector .25 .5 .5 .5 .25))
+ (filter-selection-and-smooth .01 #r(.25 .5 .5 .5 .25))
(revert-sound ind)
(close-sound ind)))
@@ -6148,7 +6147,7 @@ EDITS: 5
(set! (hook-functions after-apply-controls-hook) ()))
(revert-sound ind)
(set! (sync ind) 1)
- (scale-to (float-vector .1 .2))
+ (scale-to #r(.1 .2))
(let ((mx (maxamp ind #t)))
(if (or (fneq (mx 0) .1)
(fneq (mx 1) .2)
@@ -6160,12 +6159,12 @@ EDITS: 5
(snd-display "set filter-control-envelope: ~A?" (filter-control-envelope ind)))
(set! (filter-control-order ind) 20)
(if (not (mus-arrays-equal? (filter-control-coeffs ind)
- (float-vector -0.007 0.010 -0.025 0.029 -0.050 0.055 -0.096 0.109 -0.268 0.241
+ #r(-0.007 0.010 -0.025 0.029 -0.050 0.055 -0.096 0.109 -0.268 0.241
0.241 -0.268 0.109 -0.096 0.055 -0.050 0.029 -0.025 0.010 -0.007)))
(snd-display "highpass coeffs: ~A" (filter-control-coeffs ind)))
(set! (filter-control-envelope ind) '(0 1 1 0))
(if (not (mus-arrays-equal? (filter-control-coeffs ind)
- (float-vector 0.003 0.002 0.004 0.002 0.007 0.003 0.014 0.012 0.059 0.394
+ #r(0.003 0.002 0.004 0.002 0.007 0.003 0.014 0.012 0.059 0.394
0.394 0.059 0.012 0.014 0.003 0.007 0.002 0.004 0.002 0.003)))
(snd-display "lowpass coeffs: ~A" (filter-control-coeffs ind)))
(close-sound ind))
@@ -6451,7 +6450,7 @@ EDITS: 5
(snd-display "cursor: ~A ~A?" (cursor ind1 0) (cursor ind1 1)))
(set! (sync ind1) 1)
(scale-by '(.5 .25) ind1)
- (scale-by (float-vector 2.0 4.0) ind1)
+ (scale-by #r(2.0 4.0) ind1)
(revert-sound ind1)
(let ((amps (maxamp ind1 #t)))
(swap-channels ind1 0 ind1)
@@ -6628,7 +6627,7 @@ EDITS: 5
(test-edpos-1 (lambda (snd pos) (reverse-sound snd 0 pos)) 'reverse-sound ind1)
(test-edpos-1 (lambda (snd pos) (env-sound '(0 0 1 1 2 0) 0 20000 1.0 snd 0 pos)) 'env-sound ind1)
(test-edpos-1 (lambda (snd pos) (src-sound 0.5 1.0 snd 0 pos)) 'src-sound ind1)
- (test-edpos-1 (lambda (snd pos) (filter-sound (make-fir-filter 6 (float-vector .1 .2 .3 .3 .2 .1)) 6 snd 0 pos)) 'filter-sound ind1)
+ (test-edpos-1 (lambda (snd pos) (filter-sound (make-fir-filter 6 #r(.1 .2 .3 .3 .2 .1)) 6 snd 0 pos)) 'filter-sound ind1)
(test-edpos-1 (lambda (snd pos) (convolve-with "pistol.snd" .5 snd 0 pos)) 'convolve-with ind1))
(let ((ind (new-sound "fmv.snd")))
@@ -7124,7 +7123,7 @@ EDITS: 5
(float-vector->channel v 0 10 index 1)
(float-vector->channel v 10 10 index 1)
(src-channel (make-env :envelope '(1 1 2 2) :length 21) 0 20 index 1)
- (if (not (mus-arrays-equal? (channel->float-vector 0 10 index 1) (float-vector 1.000 -0.000 -0.048 0.068 -0.059 0.022 0.030 -0.100 0.273 0.606)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 10 index 1) #r(1.000 -0.000 -0.048 0.068 -0.059 0.022 0.030 -0.100 0.273 0.606)))
(snd-display "src-channel env: ~A" (channel->float-vector 0 10 index 1)))
(if (not (mus-arrays-equal? (make-float-vector 10) (channel->float-vector 0 10 index 0)))
(snd-display "src-channel env leaks: ~A" (channel->float-vector 0 10 index 0)))
@@ -7132,7 +7131,7 @@ EDITS: 5
(float-vector->channel v 0 10 index 1)
(float-vector->channel v 10 10 index 1)
(src-channel '(1 1 2 2) 0 20 index 1) ; end is off above -- should be 19 I think
- (if (not (mus-arrays-equal? (channel->float-vector 0 10 index 1) (float-vector 1.000 -0.000 -0.051 0.069 -0.056 0.015 0.042 -0.117 0.320 0.568)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 10 index 1) #r(1.000 -0.000 -0.051 0.069 -0.056 0.015 0.042 -0.117 0.320 0.568)))
(snd-display "src-channel lst: ~A" (channel->float-vector 0 10 index 1)))
(if (not (mus-arrays-equal? (make-float-vector 10) (channel->float-vector 0 10 index 0)))
(snd-display "src-channel lst leaks: ~A" (channel->float-vector 0 10 index 0)))
@@ -7248,7 +7247,8 @@ EDITS: 5
(save-sound ind))
(lambda args args))))
(if (sound? val) (snd-display "save-sound read-only: ~A" val))
- (if (not (equal? (edits ind) '(1 0))) (snd-display "read-only ignored? ~A" (edits ind))))
+ ;(if (not (equal? (edits ind) '(1 0))) (snd-display "read-only ignored? ~A" (edits ind)))
+ )
(set! (read-only ind) #f)
(revert-sound ind)
(let ((tag (catch #t
@@ -7416,7 +7416,8 @@ EDITS: 5
(lambda () (save-sound ind))
(lambda args args))))
(if (integer? tag) (snd-display "save-viewed-sound: ~A" tag))
- (if (not (equal? (edits ind) '(1 0))) (snd-display "view read-only ignored? ~A" (edits ind))))
+ ;(if (not (equal? (edits ind) '(1 0))) (snd-display "view read-only ignored? ~A" (edits ind)))
+ )
(close-sound ind))
(let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next)))
@@ -7647,7 +7648,7 @@ EDITS: 5
(do ((i 0 (+ i 1)))
((= i 20))
(set! (data i) (hilbert-transform hlb (if (= i 0) 1.0 0.0))))
- (if (not (mus-arrays-equal? data (float-vector 0.0 -0.010 0.0 -0.046 0.0 -0.152 0.0 -0.614 0.0 0.614 0.0 0.152 0.0 0.046 0.0 0.010 0.0 0.0 0.0 0.0)))
+ (if (not (mus-arrays-equal? data #r(0.0 -0.010 0.0 -0.046 0.0 -0.152 0.0 -0.614 0.0 0.614 0.0 0.152 0.0 0.046 0.0 0.010 0.0 0.0 0.0 0.0)))
(snd-display "hilbert-transform 8 impulse response: ~A" data)))
(let ((hlb (make-hilbert-transform 7))
@@ -7655,7 +7656,7 @@ EDITS: 5
(do ((i 0 (+ i 1)))
((= i 20))
(set! (data i) (hilbert-transform hlb (if (= i 0) 1.0 0.0))))
- (if (not (mus-arrays-equal? data (float-vector -0.007 0.0 -0.032 0.0 -0.136 0.0 -0.608 0.0 0.608 0.0 0.136 0.0 0.032 0.0 0.007 0.0 0.0 0.0 0.0 0.0)))
+ (if (not (mus-arrays-equal? data #r(-0.007 0.0 -0.032 0.0 -0.136 0.0 -0.608 0.0 0.608 0.0 0.136 0.0 0.032 0.0 0.007 0.0 0.0 0.0 0.0 0.0)))
(snd-display "hilbert-transform 7 impulse response: ~A" data)))
(let ((ind (new-sound "test.snd")))
@@ -8087,22 +8088,22 @@ EDITS: 1
(let ((m1 #f))
(as-one-edit
(lambda ()
- (set! m1 (mix-float-vector (float-vector .1 .2 .3) 1234 ind 0))
+ (set! m1 (mix-float-vector #r(.1 .2 .3) 1234 ind 0))
(set! (sample 1236 ind 0) .6)
(as-one-edit
(lambda ()
(set! (sample 123 ind 0) .3)
- (set! m2 (mix-float-vector (float-vector .1 .2 .3) 1235 ind 0)))
+ (set! m2 (mix-float-vector #r(.1 .2 .3) 1235 ind 0)))
"as-one-edit inner 1")
(if (not (mix? m1)) (snd-display "as-one-edit stepped on m1: ~A" m1))
(if (not (mix? m2)) (snd-display "as-one-edit stepped on m2: ~A" m2))
(as-one-edit
(lambda ()
- (set! m3 (mix-float-vector (float-vector .1 .2 .3) 1238 ind 0))
+ (set! m3 (mix-float-vector #r(.1 .2 .3) 1238 ind 0))
(set! (sample 1238 ind 0) .8))
"as-one-edit inner 2")
(set! (sample 1239 ind 0) .9)
- (set! m4 (mix-float-vector (float-vector .1 .2 .3) 1237 ind 0)))
+ (set! m4 (mix-float-vector #r(.1 .2 .3) 1237 ind 0)))
"outer as-one-edit")
(if (not (mix? m1)) (snd-display "second as-one-edit stepped on mx1: ~A" m1)))
(if (not (mix? m2)) (snd-display "second as-one-edit stepped on mx2: ~A" m2)))
@@ -8193,12 +8194,7 @@ EDITS: 2
(lambda () (as-one-edit (lambda (oops) #f)))
(lambda args (car args)))))
(if (not (eq? tag 'bad-arity))
- (snd-display "as-one-edit arg? ~A" tag)))
- (let ((tag (catch #t
- (lambda () (as-one-edit (lambda* (oops) #f)))
- (lambda args (car args)))))
- (if (not (eq? tag 'bad-arity))
- (snd-display "as-one-edit arg? ~A" tag)))
+ (snd-display "lambda as-one-edit arg? ~A" tag)))
(close-sound ind))
(let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next "more tests" 10)))
;; offset-channel
@@ -8206,7 +8202,7 @@ EDITS: 2
(if (not (mus-arrays-equal? (channel->float-vector 0 10) (make-float-vector 10 .1)))
(snd-display "offset-channel (.1): ~A" (channel->float-vector 0 10)))
(offset-channel -.2 5 5)
- (if (not (mus-arrays-equal? (channel->float-vector 0 10) (float-vector .1 .1 .1 .1 .1 -.1 -.1 -.1 -.1 -.1)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 10) #r(.1 .1 .1 .1 .1 -.1 -.1 -.1 -.1 -.1)))
(snd-display "offset-channel (-.1): ~A" (channel->float-vector 0 10)))
(undo)
(offset-channel .9 0 10 ind 0)
@@ -8216,12 +8212,12 @@ EDITS: 2
(revert-sound ind)
(map-channel (lambda (y) 1.0))
(sine-ramp 0.0 1.0)
- (if (not (mus-arrays-equal? (channel->float-vector) (float-vector 0.000 0.024 0.095 0.206 0.345 0.500 0.655 0.794 0.905 0.976)))
+ (if (not (mus-arrays-equal? (channel->float-vector) #r(0.000 0.024 0.095 0.206 0.345 0.500 0.655 0.794 0.905 0.976)))
(snd-display "sine-ramp 0 1: ~A" (channel->float-vector)))
(revert-sound ind)
(offset-channel 1.0)
(sine-ramp 1.0 0.0)
- (if (not (mus-arrays-equal? (channel->float-vector) (float-vector 1.000 0.976 0.905 0.794 0.655 0.500 0.345 0.206 0.095 0.024)))
+ (if (not (mus-arrays-equal? (channel->float-vector) #r(1.000 0.976 0.905 0.794 0.655 0.500 0.345 0.206 0.095 0.024)))
(snd-display "sine-ramp 1 0: ~A" (channel->float-vector)))
(close-sound ind))
(let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next "sine-env tests" 100)))
@@ -8231,7 +8227,7 @@ EDITS: 2
(revert-sound ind)
(offset-channel -1.0)
(sine-env-channel '(0 0 1 1 2 1 3 0) 40 20)
- (if (not (and (mus-arrays-equal? (channel->float-vector 40 20) (float-vector -0.000 -0.050 -0.188 -0.389 -0.611 -0.812 -0.950 -1.000 -1.000 -1.000
+ (if (not (and (mus-arrays-equal? (channel->float-vector 40 20) #r(-0.000 -0.050 -0.188 -0.389 -0.611 -0.812 -0.950 -1.000 -1.000 -1.000
-1.000 -1.000 -1.000 -1.000 -1.000 -0.950 -0.812 -0.611 -0.389 -0.188))
(mus-arrays-equal? (channel->float-vector 30 10) (make-float-vector 10 -1.0))))
(snd-display "off+sine-env: ~A ~A" (channel->float-vector 40 20) (channel->float-vector 30 10)))
@@ -8243,7 +8239,7 @@ EDITS: 2
(snd-display "dithering: ~A" mx)))
(revert-sound ind)
(map-channel (ring-mod 10 (list 0 0 1 (hz->radians 100))))
- (osc-formants .99 (float-vector 400.0 800.0 1200.0) (float-vector 400.0 800.0 1200.0) (float-vector 4.0 2.0 3.0))
+ (osc-formants .99 #r(400.0 800.0 1200.0) #r(400.0 800.0 1200.0) #r(4.0 2.0 3.0))
(map-channel (zecho .5 .75 6 10.0))
(map-channel (flecho .5 .9))
(filtered-env '(0 0 1 1 2 0))
@@ -8287,7 +8283,7 @@ EDITS: 2
(snd-display "blackman4-env-channel/ramp 1: ~A ~A" vals new-vals))))
(undo)
(blackman4-env-channel '(0 0 1 1 2 -.5 3 0))
- (if (not (mus-arrays-equal? (channel->float-vector 60 10) (float-vector -0.109 -0.217 -0.313 -0.392 -0.451 -0.488 -0.499 -0.499 -0.499 -0.499)))
+ (if (not (mus-arrays-equal? (channel->float-vector 60 10) #r(-0.109 -0.217 -0.313 -0.392 -0.451 -0.488 -0.499 -0.499 -0.499 -0.499)))
(snd-display "blackman4 to -.5: ~A" (channel->float-vector 60 10)))
(undo)
@@ -8308,11 +8304,11 @@ EDITS: 2
(snd-display "env-squared/ramp 1: ~A ~A" vals new-vals))))
(undo)
(env-squared-channel '(0 0 1 1 2 -.5 3 0))
- (if (not (mus-arrays-equal? (channel->float-vector 60 10) (float-vector -0.450 -0.466 -0.478 -0.488 -0.494 -0.499 -0.500 -0.500 -0.498 -0.496)))
+ (if (not (mus-arrays-equal? (channel->float-vector 60 10) #r(-0.450 -0.466 -0.478 -0.488 -0.494 -0.499 -0.500 -0.500 -0.498 -0.496)))
(snd-display "env-squared to -.5: ~A" (channel->float-vector 60 10)))
(undo)
(env-squared-channel '(0 0 1 1 2 -.5 3 0) #f)
- (if (not (mus-arrays-equal? (channel->float-vector 60 10) (float-vector -0.004 -0.080 -0.158 -0.240 -0.324 -0.410 -0.500 -0.500 -0.498 -0.496)))
+ (if (not (mus-arrays-equal? (channel->float-vector 60 10) #r(-0.004 -0.080 -0.158 -0.240 -0.324 -0.410 -0.500 -0.500 -0.498 -0.496)))
(snd-display "env-squared unsymmetric to -.5: ~A" (channel->float-vector 60 10)))
(undo)
@@ -8367,11 +8363,11 @@ EDITS: 2
(undo)
(env-expt-channel '(0 0 1 1 2 -.5 3 0) 12.0)
- (if (not (mus-arrays-equal? (channel->float-vector 30 10) (float-vector 0.319 0.472 0.691 1.000 0.537 0.208 -0.022 -0.182 -0.291 -0.365)))
+ (if (not (mus-arrays-equal? (channel->float-vector 30 10) #r(0.319 0.472 0.691 1.000 0.537 0.208 -0.022 -0.182 -0.291 -0.365)))
(snd-display "env-expt to -.5 12.0: ~A" (channel->float-vector 30 10)))
(undo)
(env-expt-channel '(0 0 1 1 2 -.5 3 0) 12.0 #f)
- (if (not (mus-arrays-equal? (channel->float-vector 30 10) (float-vector 0.319 0.472 0.691 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
+ (if (not (mus-arrays-equal? (channel->float-vector 30 10) #r(0.319 0.472 0.691 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
(snd-display "env-expt to -.5 12.0 unsymmetric: ~A" (channel->float-vector 30 10)))
(undo)
(close-sound ind))
@@ -8618,14 +8614,14 @@ EDITS: 2
(if (not (string=? (float-vector->string (float-vector 1.0 2.0)) "(float-vector 1.000 2.000)"))
(snd-display "float-vector->string: ~A" (float-vector->string (float-vector 1.0 2.0))))
- (if (not (mus-arrays-equal? (float-vector 4 3 2 1) (reverse! (float-vector 1 2 3 4)))) (snd-display "float-vector-reverse: ~A" (reverse! (float-vector 1 2 3 4))))
- (if (not (mus-arrays-equal? (float-vector 3 2 1) (reverse! (float-vector 1 2 3)))) (snd-display "float-vector-reverse: ~A" (reverse! (float-vector 1 2 3))))
- (if (not (mus-arrays-equal? (float-vector 2 1) (reverse! (float-vector 1 2)))) (snd-display "float-vector-reverse: ~A" (reverse! (float-vector 1 2))))
- (if (not (mus-arrays-equal? (float-vector 1) (reverse! (float-vector 1)))) (snd-display "float-vector-reverse: ~A" (reverse! (float-vector 1))))
- (if (not (mus-arrays-equal? (float-vector 3 2 1) (reverse (float-vector 1 2 3)))) (snd-display "reverse(float-vector): ~A" (reverse (float-vector 1 2 3))))
- (let* ((v (float-vector 3 2 1))
+ (if (not (mus-arrays-equal? #r(4 3 2 1) (reverse! (float-vector 1 2 3 4)))) (snd-display "float-vector-reverse: ~A" (reverse! (float-vector 1 2 3 4))))
+ (if (not (mus-arrays-equal? #r(3 2 1) (reverse! (float-vector 1 2 3)))) (snd-display "float-vector-reverse: ~A" (reverse! (float-vector 1 2 3))))
+ (if (not (mus-arrays-equal? #r(2 1) (reverse! (float-vector 1 2)))) (snd-display "float-vector-reverse: ~A" (reverse! (float-vector 1 2))))
+ (if (not (mus-arrays-equal? #r(1) (reverse! (float-vector 1)))) (snd-display "float-vector-reverse: ~A" (reverse! (float-vector 1))))
+ (if (not (mus-arrays-equal? #r(3 2 1) (reverse #r(1 2 3)))) (snd-display "reverse(float-vector): ~A" (reverse #r(1 2 3))))
+ (let* ((v #r(3 2 1))
(rv (reverse v)))
- (if (not (mus-arrays-equal? rv (float-vector 1 2 3)))
+ (if (not (mus-arrays-equal? rv #r(1 2 3)))
(snd-display "reverse(float-vector) -> ~A ~A" v rv)))
(let ((v0 (make-float-vector 3)))
@@ -8648,15 +8644,15 @@ EDITS: 2
(if (not (eq? (car var) 'out-of-range))
(snd-display "float-vector-move! back high 2 index: ~A" var))))
- (let ((v (float-vector 0.0 1.0 -2.0 -3.0)))
- (if (not (mus-arrays-equal? (float-vector-abs! v) (float-vector 0.0 1.0 2.0 3.0)))
+ (let ((v #r(0.0 1.0 -2.0 -3.0)))
+ (if (not (mus-arrays-equal? (float-vector-abs! v) #r(0.0 1.0 2.0 3.0)))
(snd-display "float-vector-abs! ~A" v)))
;; float-vector-add! + shared-vector:
- (let* ((fv (float-vector 1 2 3 4 5))
+ (let* ((fv #r(1 2 3 4 5))
(sv (make-shared-vector fv '(4) 1)))
(float-vector-add! sv fv)
- (if (not (mus-arrays-equal? fv (float-vector 1.0 3.0 6.0 10.0 15.0)))
+ (if (not (mus-arrays-equal? fv #r(1.0 3.0 6.0 10.0 15.0)))
(snd-display "float-vector+shared-vector: ~A" fv)))
(do ((i 0 (+ i 1)))
@@ -8733,29 +8729,29 @@ EDITS: 2
(let ((v1 (make-float-vector 3 .1))
(v2 (make-float-vector 4 .2)))
(let ((val (float-vector+ (copy v1) v2)))
- (if (not (mus-arrays-equal? val (float-vector .3 .3 .3))) (snd-display "float-vector+ .1 .2: ~A" val)))
+ (if (not (mus-arrays-equal? val #r(.3 .3 .3))) (snd-display "float-vector+ .1 .2: ~A" val)))
(set! (v1 1) .3)
(let ((val (float-vector+ (copy v1) v2)))
- (if (not (mus-arrays-equal? val (float-vector .3 .5 .3))) (snd-display "float-vector+ .1 .2 (1): ~A" val)))
+ (if (not (mus-arrays-equal? val #r(.3 .5 .3))) (snd-display "float-vector+ .1 .2 (1): ~A" val)))
(let ((val (float-vector+ (copy v1) 2.0)))
- (if (not (mus-arrays-equal? val (float-vector 2.1 2.3 2.1))) (snd-display "float-vector+ .1 2.0: ~A" val)))
+ (if (not (mus-arrays-equal? val #r(2.1 2.3 2.1))) (snd-display "float-vector+ .1 2.0: ~A" val)))
(let ((val (float-vector+ 2.0 (copy v1))))
- (if (not (mus-arrays-equal? val (float-vector 2.1 2.3 2.1))) (snd-display "float-vector+ .1 2.0 (1): ~A" val)))
+ (if (not (mus-arrays-equal? val #r(2.1 2.3 2.1))) (snd-display "float-vector+ .1 2.0 (1): ~A" val)))
(let ((val (float-vector* 2.0 (copy v1))))
- (if (not (mus-arrays-equal? val (float-vector .2 .6 .2))) (snd-display "float-vector* 2.0: ~A" val)))
+ (if (not (mus-arrays-equal? val #r(.2 .6 .2))) (snd-display "float-vector* 2.0: ~A" val)))
(let ((val (float-vector* (copy v1) 2.0)))
- (if (not (mus-arrays-equal? val (float-vector .2 .6 .2))) (snd-display "float-vector* 2.0 (1): ~A" val)))
+ (if (not (mus-arrays-equal? val #r(.2 .6 .2))) (snd-display "float-vector* 2.0 (1): ~A" val)))
(let ((val (float-vector* (copy v1) v2)))
- (if (not (mus-arrays-equal? val (float-vector .02 .06 .02))) (snd-display "float-vector* v1 v2: ~A" val))))
+ (if (not (mus-arrays-equal? val #r(.02 .06 .02))) (snd-display "float-vector* v1 v2: ~A" val))))
(fill! v0 1.0)
(do ((i 0 (+ i 1)))
((= i 10))
(if (fneq (v0 i) 1.0) (snd-display "map v0[~D] = ~F?" i (v0 i)))))
- (if (fneq ((float-vector 1.0 2.0 3.0) 1) 2.0)
- (snd-display "(float-vector...) = ~A?" ((float-vector 1.0 2.0 3.0) 1)))
- (let ((v1 (float-vector 1 2 3 4)))
+ (if (fneq (#r(1.0 2.0 3.0) 1) 2.0)
+ (snd-display "(float-vector...) = ~A?" (#r(1.0 2.0 3.0) 1)))
+ (let ((v1 #r(1 2 3 4)))
(if (fneq (v1 1) 2.0)
(snd-display "(v1 1) = ~A?" (v1 1))))
@@ -8800,11 +8796,11 @@ EDITS: 2
(let ((v0 (make-float-vector 5 .1))
(v1 (make-float-vector 6 .2)))
(float-vector-add! v0 v1 2)
- (if (not (mus-arrays-equal? v0 (float-vector .1 .1 .3 .3 .3)))
+ (if (not (mus-arrays-equal? v0 #r(.1 .1 .3 .3 .3)))
(snd-display "float-vector-add + offset: ~A" v0)))
;; check s7 stuff with float-vectors
- (let ((v (float-vector 1.0 2.0 3.0)))
+ (let ((v #r(1.0 2.0 3.0)))
(if (not (string=? (format #f "~{~A~^-~}" v) "1.0-2.0-3.0"))
(snd-display "float-vector in format {}: ~S" (format #f "~{~A~^-~}" v)))
(if (not (= (length v) 3))
@@ -8820,28 +8816,28 @@ EDITS: 2
(if (not (eqv? val 6))
(snd-display "float-vector s7 for-each: ~A" val)))
(set! v (reverse v))
- (if (not (vmus-arrays-equal? v (float-vector 3.0 2.0 1.0)))
+ (if (not (vmus-arrays-equal? v #r(3.0 2.0 1.0)))
(snd-display "float-vector s7 reverse: ~A" v))
(fill! v 12.0)
- (if (not (vmus-arrays-equal? v (float-vector 12.0 12.0 12.0)))
+ (if (not (vmus-arrays-equal? v #r(12.0 12.0 12.0)))
(snd-display "float-vector s7 fill: ~A" (fill! v 12.0))))
(let ((sum 0))
- (for-each (lambda (n) (set! sum (+ sum n))) (float-vector 1 2 3))
+ (for-each (lambda (n) (set! sum (+ sum n))) #r(1 2 3))
(if (not (morally-equal? sum 6.0))
(snd-display "object for-each (float-vector): ~A" sum)))
- (do ((x (float-vector 0.0))
+ (do ((x #r(0.0))
(osc (make-oscil :frequency 440))
(e1 (make-env '(0 0 1 1 2 0) :length 100))
(i 0 (+ i 1)))
((= i 100))
(float-vector-set! x 0 (* (env e1) (oscil osc (float-vector-ref x 0)))))
- (if (fneq (float-vector-equal? (float-vector 1.0) (float-vector 1.1) .1) .0909)
- (snd-display "float-vector-equal? 0.0909: ~A" (float-vector-equal? (float-vector 1.0) (float-vector 1.1) .1)))
- (if (float-vector-equal? (float-vector 1.0) (float-vector 1.1) .01)
- (snd-display "float-vector-equal? #f: ~A" (float-vector-equal? (float-vector 1.0) (float-vector 1.1) .01))))))
+ (if (fneq (float-vector-equal? #r(1.0) #r(1.1) .1) .0909)
+ (snd-display "float-vector-equal? 0.0909: ~A" (float-vector-equal? #r(1.0) #r(1.1) .1)))
+ (if (float-vector-equal? #r(1.0) #r(1.1) .01)
+ (snd-display "float-vector-equal? #f: ~A" (float-vector-equal? #r(1.0) #r(1.1) .01))))))
;;; ---------------- test 7: colors ----------------
@@ -9249,12 +9245,14 @@ EDITS: 2
(eg (list 0 0 64 0 128 252 192 252 256 0))
(eb (list 0 80 128 252 192 0 256 80))
(i 0 (+ i 1))
- (x 0.0 (+ x incr)))
+ (x 0.0))
((= i size)
(list r g b))
(set! (r i) (/ (envelope-interp x er) 256.0))
(set! (g i) (/ (envelope-interp x eg) 256.0))
- (set! (b i) (/ (envelope-interp x eb) 256.0)))))
+ (set! (b i) (/ (envelope-interp x eb) 256.0))
+ (set! x (+ x incr)))))
+
(add-colormap "sin"
(lambda (size)
(do ((r (make-float-vector size))
@@ -9262,13 +9260,14 @@ EDITS: 2
(b (make-float-vector size))
(incr (/ (* 2 pi) size))
(i 0 (+ i 1))
- (x 0.0 (+ x incr)))
+ (x 0.0))
((= i size)
(list r g b))
(set! (r i) (abs (sin (* 1.5 x))))
(set! (g i) (abs (sin (* 3.5 x))))
- (set! (b i) (abs (sin (* 2.5 x)))))))
-
+ (set! (b i) (abs (sin (* 2.5 x))))
+ (set! x (+ x incr)))))
+
(add-colormap "another-sin"
(lambda (size)
(do ((r (make-float-vector size))
@@ -9276,12 +9275,13 @@ EDITS: 2
(b (make-float-vector size))
(incr (/ (* 2 pi) size))
(i 0 (+ i 1))
- (x 0.0 (+ x incr)))
+ (x 0.0))
((= i size)
(list r g b))
(set! (r i) (abs (sin (* 2.5 x))))
(set! (g i) (abs (sin (* 3.5 x))))
- (set! (b i) (abs (sin (* 4.5 x)))))))
+ (set! (b i) (abs (sin (* 4.5 x))))
+ (set! x (+ x incr)))))
(delete-colormap pink-colormap)
(if (colormap? pink-colormap)
@@ -9347,272 +9347,6 @@ EDITS: 2
(if (not (equal? o p))
(snd-display "mus-copy ~A != ~A~%" o p))))
- (define (osc-opt)
- (let ((g1 (make-oscil 1000))
- (g2 (make-oscil 1000))
- (g3 (make-oscil 1000))
- (g4 (make-oscil 1000))
- (g5 (make-oscil 1000))
- (g6 (make-oscil 1000))
- (x1 1.0)
- (x2 (hz->radians 100.0))
- (x4 (hz->radians 5.0)))
- (do ((x1x2 (* x1 x2))
- (x420 (* 20 x4))
- (i 0 (+ i 1)))
- ((= i 50))
- (let ((o1 (oscil g1 x2))
- (o2 (* 1.0 (oscil g2 x2)))
- (o3 (oscil g3 x420))
- (o4 (oscil g4 x420))
- (o5 (oscil g5 x1x2))
- (o6 (* 1.0 (oscil g6 x420))))
- (if (> (abs (- (+ o2 o3 o4 o5 o6) (* 5 o1))) 1e-6)
- (snd-display "~A: ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F" i o1 o2 o3 o4 o5 o6))))))
-
- (define (nrxysin-opt)
- (let ((g1 (make-nrxysin 1000 :n 10 :r .9))
- (g2 (make-nrxysin 1000 :n 10 :r .9))
- (g3 (make-nrxysin 1000 :n 10 :r .9))
- (g4 (make-nrxysin 1000 :n 10 :r .9))
- (g5 (make-nrxysin 1000 :n 10 :r .9))
- (g6 (make-nrxysin 1000 :n 10 :r .9))
- (x1 1.0)
- (x2 (hz->radians 100.0))
- (x4 (hz->radians 5.0)))
- (do ((x1x2 (* x1 x2))
- (x420 (* 20 x4))
- (i 0 (+ i 1)))
- ((= i 50))
- (let ((o1 (nrxysin g1 x2))
- (o2 (* 1.0 (nrxysin g2 x2)))
- (o3 (nrxysin g3 x420))
- (o4 (nrxysin g4 x420))
- (o5 (nrxysin g5 x1x2))
- (o6 (nrxysin g6 x420)))
- (if (> (abs (- (+ o2 o3 o4 o5 o6) (* 5 o1))) 1e-6)
- (format () "~A: ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F~%" i o1 o2 o3 o4 o5 o6))))))
-
- (define (polywave-opt)
- (let ((g1 (make-polywave 1000 '(1 .5 2 .5)))
- (g2 (make-polywave 1000 '(1 .5 2 .5)))
- (g3 (make-polywave 1000 '(1 .5 2 .5)))
- (g4 (make-polywave 1000 '(1 .5 2 .5)))
- (g5 (make-polywave 1000 '(1 .5 2 .5)))
- (g6 (make-polywave 1000 '(1 .5 2 .5)))
- (x1 1.0)
- (x2 (hz->radians 100.0))
- (x4 (hz->radians 5.0)))
- (do ((x1x2 (* x1 x2))
- (x420 (* 20 x4))
- (i 0 (+ i 1)))
- ((= i 50))
- (let ((o1 (polywave g1 x2))
- (o2 (* 1.0 (polywave g2 x2)))
- (o3 (polywave g3 x420))
- (o4 (polywave g4 x420))
- (o5 (polywave g5 x1x2))
- (o6 (* 1.0 (polywave g6 x420))))
- (if (> (abs (- (+ o2 o3 o4 o5 o6) (* 5 o1))) 1e-6)
- (format () "~A: ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F~%" i o1 o2 o3 o4 o5 o6))))))
-
- (define (test-simple-polywave n offset kind)
- (let ((p (do ((h (if offset (list offset 0) ()))
- (i 1 (+ i 1)))
- ((> i n)
- (make-polywave 400.0 (reverse h) kind))
- (set! h (cons (* i .1) (cons i h)))))
- (vp (make-float-vector 200))
- (vo (make-float-vector 200))
- (ob (make-oscil-bank
- (apply float-vector (do ((frqs (if offset (list 0.0) ()))
- (i 1 (+ i 1)))
- ((> i n)
- (reverse frqs))
- (set! frqs (cons (hz->radians (* i 400.0)) frqs))))
- (let ((phases (make-float-vector (if offset (+ n 1) n)
- (if (= kind mus-chebyshev-second-kind) 0.0 (/ pi 2)))))
- (if (and offset (= kind mus-chebyshev-second-kind))
- (set! (phases 0) (/ pi 2)))
- phases)
- (apply float-vector (do ((amps (if offset (list offset) ()))
- (i 1 (+ i 1)))
- ((> i n)
- (reverse amps))
- (set! amps (cons (* i .1) amps))))
- #t)))
- (do ((i 0 (+ i 1)))
- ((= i 200))
- (float-vector-set! vp i (polywave p)))
- (do ((i 0 (+ i 1)))
- ((= i 200))
- (float-vector-set! vo i (oscil-bank ob)))
- (if (not (mus-arrays-equal? vp vo))
- (format *stderr* ";simple polywave ~A ~A ~A: ~A~% ~A~% ~A~%~A ~A~%"
- n offset (if (= kind mus-chebyshev-first-kind) 'first 'second)
- (float-vector-peak (float-vector-subtract! (copy vp) vo))
- vp vo
- p ob))
-
- (let ((temp 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 200))
- (set! temp (polywave p))
- (vector-set! vp i temp)
- (set! (vo i) (oscil-bank ob)))
- (if (not (mus-arrays-equal? vp vo))
- (format *stderr* ";simple polywave (temps) ~A ~A ~A: ~A~% ~A~% ~A~%~A ~A~%"
- n offset (if (= kind mus-chebyshev-first-kind) 'first 'second)
- (float-vector-peak (float-vector-subtract! (copy vp) vo))
- vp vo
- p ob)))
-
- (let ((t1 (find-sound (with-sound ("test.snd")
- (do ((i 0 (+ i 1)))
- ((= i 200))
- (outa i (polywave p))))))
- (t2 (find-sound (with-sound ("tst.snd")
- (do ((i 0 (+ i 1)))
- ((= i 200))
- (outa i (oscil-bank ob)))))))
- (set! vp (channel->float-vector 0 200 t1 0))
- (set! vo (channel->float-vector 0 200 t2 0))
-
- (if (not (mus-arrays-equal? vp vo))
- (format *stderr* ";simple polywave (with-sound) n: ~A, offset: ~A, type: ~A (len: ~D ~D): dist: ~A~% ~A~% ~A~%~A ~A~%"
- n offset (if (= kind mus-chebyshev-first-kind) 'first 'second)
- (length vp) (length vo)
- (float-vector-peak (float-vector-subtract! (copy vp) vo))
- vp vo
- p ob))
- (close-sound t1)
- (close-sound t2))))
-
- (define (test-simple-nsin n)
- (let ((p (make-nsin 400.0 n))
- (vp (make-float-vector 200))
- (vo (make-float-vector 200))
- (parts (apply float-vector
- (do ((frqs ())
- (i 1 (+ i 1)))
- ((> i n)
- (reverse frqs))
- (set! frqs (cons (hz->radians (* i 400.0)) frqs))))))
- (let ((ob (make-oscil-bank parts (make-float-vector n) (make-float-vector n (mus-scaler p)) #t)))
- (do ((i 0 (+ i 1)))
- ((= i 200))
- (float-vector-set! vp i (nsin p)))
- (do ((i 0 (+ i 1)))
- ((= i 200))
- (float-vector-set! vo i (oscil-bank ob)))
- (if (not (mus-arrays-equal? vp vo))
- (format *stderr* ";simple nsin ~A: ~A~% ~A~% ~A~%~A ~A~%"
- n
- (float-vector-peak (float-vector-subtract! (copy vp) vo))
- vp vo
- p ob)))))
-
- (define (test-simple-ncos n)
- (let ((p (make-ncos 400.0 n))
- (vp (make-float-vector 200))
- (vo (make-float-vector 200)))
- (let ((ob (make-oscil-bank
- (apply float-vector (do ((frqs ())
- (i 1 (+ i 1)))
- ((> i n)
- (reverse frqs))
- (set! frqs (cons (hz->radians (* i 400.0)) frqs))))
- (make-float-vector n (/ pi 2.0))
- (make-float-vector n (mus-scaler p))
- #t)))
- (do ((i 0 (+ i 1)))
- ((= i 200))
- (float-vector-set! vp i (ncos p)))
- (do ((i 0 (+ i 1)))
- ((= i 200))
- (float-vector-set! vo i (oscil-bank ob)))
- (if (not (mus-arrays-equal? vp vo))
- (format *stderr* ";simple ncos ~A: ~A~% ~A~% ~A~%~A ~A~%"
- n
- (float-vector-peak (float-vector-subtract! (copy vp) vo))
- vp vo
- p ob)))))
-
- (define (snd-test-jc-reverb decay-dur low-pass volume amp-env)
- (let ((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))
- (comb2 (make-comb 0.733 4999))
- (comb3 (make-comb 0.715 5399))
- (comb4 (make-comb 0.697 5801))
- (dur (+ decay-dur (/ (framples) (srate))))
- (outdel (make-delay (seconds->samples .013))))
- (let ((combs (make-comb-bank (vector comb1 comb2 comb3 comb4)))
- (allpasses (make-all-pass-bank (vector allpass1 allpass2 allpass3))))
- (if (or amp-env low-pass)
- (let ((delf (let ((flt (and low-pass (make-fir-filter 3 (float-vector 0.25 0.5 0.25))))
- (envA (make-env :envelope (or amp-env '(0 1 1 1)) :scaler volume :duration dur)))
- (if low-pass
- (lambda (inval)
- (+ inval (delay outdel (* (env envA) (fir-filter flt (comb-bank combs (all-pass-bank allpasses inval)))))))
- (lambda (inval)
- (+ inval (delay outdel (* (env envA) (comb-bank combs (all-pass-bank allpasses inval))))))))))
- (map-channel delf 0 (round (* dur (srate)))))
- (map-channel
- (lambda (inval)
- (+ inval (delay outdel (* volume (comb-bank combs (all-pass-bank allpasses inval))))))
- 0 (round (* dur (srate))))))))
-
-
- ;; ----------------
- (define (bumpy)
- (let ((x 0.0)
- (xi (/ 1.0 (framples)))
- (start 0)
- (end 1))
- (let ((scl (exp (/ 4.0 (- end start))))) ; normalize it
- (map-channel (lambda (y)
- (let ((val (if (not (< start x end))
- 0.0
- (exp (+ (/ -1.0 (- x start))
- (/ -1.0 (- end x)))))))
- (set! x (+ x xi))
- (* scl val)))))))
-
- ;; ----------------
- (define test-scanned-synthesis
- ;; check out scanned-synthesis
- (lambda (amp dur mass xspring damp)
- (let ((size 256))
- (let ((x0 (make-float-vector size))
- (x1 (make-float-vector size))
- (x2 (make-float-vector size)))
- (do ((i 0 (+ i 1)))
- ((= i 12))
- (let ((val (sin (/ (* 2 pi i) 12.0))))
- (set! (x1 (- (+ i (/ size 4)) 6)) val)))
- (let ((data (make-float-vector dur)))
- (let ((recompute-samps 30) ;just a quick guess
- (gen1 (make-table-lookup 440.0 :wave x1))
- (gen2 (make-table-lookup 440.0 :wave x2)))
- (do ((i 0 (+ i 1))
- (k 0.0)
- (kincr (/ 1.0 recompute-samps)))
- ((= i dur))
- (if (>= k 1.0)
- (begin
- (set! k 0.0)
- (vibrating-uniform-circular-string size x0 x1 x2 mass xspring damp))
- (set! k (+ k kincr)))
- (let ((g1 (table-lookup gen1))
- (g2 (table-lookup gen2)))
- (set! (data i) (+ g2 (* k (- g1 g2)))))))
- (float-vector-scale! data (/ amp (float-vector-peak data)))
- (float-vector->channel data 0 dur))))))
-
- ;; (test-scanned-synthesis .1 10000 1.0 0.1 0.0)
-
;; ----------------
(define array-interp-sound-diff
(let ((envelope->float-vector
@@ -9687,54 +9421,56 @@ EDITS: 2
(do ((data (make-float-vector n))
(incr (/ (* 2.0 pi) n))
(i 0 (+ i 1))
- (x 0.0 (+ x incr)))
+ (x 0.0))
((= i n) data)
- (set! (data i) (sin x)))))
+ (set! (data i) (sin x))
+ (set! x (+ x incr)))))
(make-sines
(lambda (n)
(do ((data (make-float-vector n))
(incr (/ (* 2.0 pi) n))
(i 0 (+ i 1))
- (x 0.0 (+ x incr)))
+ (x 0.0))
((= i n) data)
(set! (data i) (+ (sin x)
(* .25 (sin (* 2.0 x)))
- (* .125 (sin (* 4.0 x)))))))))
+ (* .125 (sin (* 4.0 x)))))
+ (set! x (+ x incr))))))
(lambda ()
- (let ((vals (lpc-predict (float-vector 0 1 2 3 4 5 6 7) 8 (lpc-coeffs (float-vector 0 1 2 3 4 5 6 7) 8 4) 4 2)))
- (if (not (mus-arrays-equal? vals (float-vector 7.906 8.557)))
+ (let ((vals (lpc-predict #r(0 1 2 3 4 5 6 7) 8 (lpc-coeffs #r(0 1 2 3 4 5 6 7) 8 4) 4 2)))
+ (if (not (mus-arrays-equal? vals #r(7.906 8.557)))
(snd-display "predict ramp: ~A" vals)))
- (let ((vals (lpc-predict (float-vector 0 1 2 3 4 5 6 7) 8 (lpc-coeffs (float-vector 0 1 2 3 4 5 6 7) 8 7) 7 2)))
- (if (not (mus-arrays-equal? vals (float-vector 7.971 8.816)))
+ (let ((vals (lpc-predict #r(0 1 2 3 4 5 6 7) 8 (lpc-coeffs #r(0 1 2 3 4 5 6 7) 8 7) 7 2)))
+ (if (not (mus-arrays-equal? vals #r(7.971 8.816)))
(snd-display "predict ramp 1: ~A" vals)))
- (let ((vals (lpc-predict (float-vector 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15
- (lpc-coeffs (float-vector 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15 7) 7 5)))
- (if (not (mus-arrays-equal? vals (float-vector 14.999 15.995 16.980 17.940 18.851)))
+ (let ((vals (lpc-predict #r(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15
+ (lpc-coeffs #r(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15 7) 7 5)))
+ (if (not (mus-arrays-equal? vals #r(14.999 15.995 16.980 17.940 18.851)))
(snd-display "predict ramp 2: ~A" vals)))
- (let ((vals (lpc-predict (float-vector 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15
- (lpc-coeffs (float-vector 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15 14) 14 5)))
- (if (not (mus-arrays-equal? vals (float-vector 15.000 16.000 16.998 17.991 18.971)))
+ (let ((vals (lpc-predict #r(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15
+ (lpc-coeffs #r(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15 14) 14 5)))
+ (if (not (mus-arrays-equal? vals #r(15.000 16.000 16.998 17.991 18.971)))
(snd-display "predict ramp 3: ~A" vals)))
(let ((vals (lpc-predict (make-sine) 16 (lpc-coeffs (make-sine) 16 8) 8 2)))
- (if (not (mus-arrays-equal? vals (float-vector 0.000 0.383)))
+ (if (not (mus-arrays-equal? vals #r(0.000 0.383)))
(snd-display "predict sine: ~A" vals)))
(let ((vals (lpc-predict (make-sine) 16 (lpc-coeffs (make-sine) 16 8) 8 8)))
- (if (not (mus-arrays-equal? vals (float-vector 0.000 0.383 0.707 0.924 1.000 0.924 0.707 0.383)))
+ (if (not (mus-arrays-equal? vals #r(0.000 0.383 0.707 0.924 1.000 0.924 0.707 0.383)))
(snd-display "predict sine 1: ~A" vals)))
(let ((vals (lpc-predict (make-sines 32) 32 (lpc-coeffs (make-sines 32) 32 8) 8 8)))
- (if (not (mus-arrays-equal? vals (float-vector 0.000 0.379 0.686 0.880 0.970 1.001 1.022 1.053)))
+ (if (not (mus-arrays-equal? vals #r(0.000 0.379 0.686 0.880 0.970 1.001 1.022 1.053)))
(snd-display "predict sines: ~A" vals)))
(let ((vals (lpc-predict (make-sines 32) 32 (lpc-coeffs (make-sines 32) 32 16) 16 8)))
- (if (not (or (mus-arrays-equal? vals (float-vector 0.000 0.379 0.684 0.876 0.961 0.987 1.006 1.046))
- (mus-arrays-equal? vals (float-vector 0.000 0.379 0.685 0.876 0.961 0.985 0.998 1.029))))
+ (if (not (or (mus-arrays-equal? vals #r(0.000 0.379 0.684 0.876 0.961 0.987 1.006 1.046))
+ (mus-arrays-equal? vals #r(0.000 0.379 0.685 0.876 0.961 0.985 0.998 1.029))))
(snd-display "predict sines 1: ~A" vals)))
(let ((vals (lpc-predict (make-sines 32) 32 (lpc-coeffs (make-sines 32) 32 30) 30 4)))
- (if (not (or (mus-arrays-equal? vals (float-vector 0.000 0.379 0.685 0.878))
- (mus-arrays-equal? vals (float-vector 0.000 0.379 0.684 0.875)))) ; double float-vectors
+ (if (not (or (mus-arrays-equal? vals #r(0.000 0.379 0.685 0.878))
+ (mus-arrays-equal? vals #r(0.000 0.379 0.684 0.875)))) ; double float-vectors
(snd-display "predict sines 2: ~A" vals)))
(let ((vals (lpc-predict (make-sines 64) 64 (lpc-coeffs (make-sines 64) 64 32) 32 8)))
- (if (not (mus-arrays-equal? vals (float-vector 0.000 0.195 0.379 0.545 0.684 0.795 0.875 0.927)))
+ (if (not (mus-arrays-equal? vals #r(0.000 0.195 0.379 0.545 0.684 0.795 0.875 0.927)))
(snd-display "predict sines 3: ~A" vals))))))
;; ----------------
@@ -10015,11 +9751,11 @@ EDITS: 2
(lambda ()
;; ---------------- butterworth tests ----------------
- (do ((poles (vector (float-vector 1.000 1.414 1.000) ; numerous references provide these tables (y[0] is ignored)
- (float-vector 1.000 1.848 1.000 1.000 0.765 1.000)
- (float-vector 1.000 1.932 1.000 1.000 1.414 1.000 1.000 0.518 1.000)
- (float-vector 1.000 1.962 1.000 1.000 1.663 1.000 1.000 1.111 1.000 1.000 0.390 1.000)
- (float-vector 1.000 1.975 1.000 1.000 1.782 1.000 1.000 1.414 1.000 1.000 0.908 1.000 1.000 0.313 1.000)))
+ (do ((poles (vector #r(1.000 1.414 1.000) ; numerous references provide these tables (y[0] is ignored)
+ #r(1.000 1.848 1.000 1.000 0.765 1.000)
+ #r(1.000 1.932 1.000 1.000 1.414 1.000 1.000 0.518 1.000)
+ #r(1.000 1.962 1.000 1.000 1.663 1.000 1.000 1.111 1.000 1.000 0.390 1.000)
+ #r(1.000 1.975 1.000 1.000 1.782 1.000 1.000 1.414 1.000 1.000 0.908 1.000 1.000 0.313 1.000)))
(i 2 (+ i 2))
(k 0 (+ k 1)))
((>= i 12))
@@ -10071,16 +9807,16 @@ EDITS: 2
(let ((vals (sweep->bins (make-butterworth-lowpass 8 .1))))
(if (not.5 vals) (snd-display "butterworth lp 8 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.500 0.359 0.014 0.001 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.500 0.500 0.359 0.014 0.001 0.000 0.000 0.000 0.000 0.000)))
(snd-display "butterworth lp 8 .1 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-butterworth-lowpass 12 .25))))
(if (not.5 vals) (snd-display "butterworth lp 12 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.500 0.500 0.500 0.499 0.358 0.010 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.500 0.500 0.500 0.500 0.499 0.358 0.010 0.000 0.000 0.000)))
(snd-display "butterworth lp 12 .25 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-butterworth-lowpass 10 .4))))
(if (not.5 vals) (snd-display "butterworth lp 10 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.499 0.361 0.001))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.499 0.360 0.002))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.499 0.361 0.001))
+ (mus-arrays-equal?1 (cadr vals) #r(0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.499 0.360 0.002))))
(snd-display "butterworth lp 10 .4 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
@@ -10093,30 +9829,30 @@ EDITS: 2
(let ((vals (sweep->bins (make-butterworth-highpass 8 .1))))
(if (not.5 vals) (snd-display "butterworth hp 8 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.001 0.348 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.500)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.001 0.348 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.500)))
(snd-display "butterworth hp 8 .1 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-butterworth-highpass 12 .25))))
(if (not.5 vals) (snd-display "butterworth hp 12 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.011 0.348 0.500 0.500 0.500 0.500 0.500)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.011 0.348 0.500 0.500 0.500 0.500 0.500)))
(snd-display "butterworth hp 12 .25 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-butterworth-highpass 10 .4))))
(if (not.5 vals) (snd-display "butterworth hp 10 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.005 0.343 0.501 0.501)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.000 0.000 0.000 0.005 0.343 0.501 0.501)))
(snd-display "butterworth hp 10 .4 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-butterworth-bandpass 4 .1 .2))))
(if (beyond.5 vals) (snd-display "butterworth bp 4 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.028 0.350 0.481 0.479 0.346 0.132 0.038 0.009 0.002 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.028 0.350 0.481 0.479 0.346 0.132 0.038 0.009 0.002 0.000)))
(snd-display "butterworth bp 4 .1 .2 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-butterworth-bandpass 12 .1 .2))))
(if (beyond.5 vals) (snd-display "butterworth bp 12 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.006 0.317 0.501 0.500 0.358 0.009 0.000 0.000 0.000 0.000))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.012 0.319 0.501 0.500 0.358 0.009 0.000 0.000 0.000 0.000))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.323 0.501 0.500 0.358 0.009 0.000 0.000 0.000 0.000))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.006 0.317 0.501 0.500 0.358 0.009 0.000 0.000 0.000 0.000))
+ (mus-arrays-equal?1 (cadr vals) #r(0.012 0.319 0.501 0.500 0.358 0.009 0.000 0.000 0.000 0.000))
+ (mus-arrays-equal?1 (cadr vals) #r(0.000 0.323 0.501 0.500 0.358 0.009 0.000 0.000 0.000 0.000))))
(snd-display "butterworth bp 12 .1 .2 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-butterworth-bandpass 8 .3 .4))))
(if (beyond.5 vals) (snd-display "butterworth bp 8 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.003 0.034 0.344 0.499 0.499 0.353 0.002)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.003 0.034 0.344 0.499 0.499 0.353 0.002)))
(snd-display "butterworth bp 8 .3 .4 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
@@ -10129,17 +9865,17 @@ EDITS: 2
(let ((vals (sweep->bins (make-butterworth-bandstop 4 .1 .2))))
(if (beyond.5 vals) (snd-display "butterworth bs 4 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.500 0.347 0.339 0.481 0.499 0.500 0.500 0.500 0.500)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.500 0.500 0.347 0.339 0.481 0.499 0.500 0.500 0.500 0.500)))
(snd-display "butterworth bs 4 .1 .2 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-butterworth-bandstop 12 .1 .2))))
(if (beyond.5 vals) (snd-display "butterworth bs 12 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.503 0.503 0.364 0.334 0.500 0.500 0.500 0.500 0.500 0.500))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.502 0.503 0.365 0.334 0.500 0.500 0.500 0.500 0.500 0.500))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.500 0.365 0.334 0.500 0.500 0.500 0.500 0.500 0.500))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.503 0.503 0.364 0.334 0.500 0.500 0.500 0.500 0.500 0.500))
+ (mus-arrays-equal?1 (cadr vals) #r(0.502 0.503 0.365 0.334 0.500 0.500 0.500 0.500 0.500 0.500))
+ (mus-arrays-equal?1 (cadr vals) #r(0.500 0.500 0.365 0.334 0.500 0.500 0.500 0.500 0.500 0.500))))
(snd-display "butterworth bs 12 .1 .2 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-butterworth-bandstop 8 .3 .4))))
(if (beyond.5 vals) (snd-display "butterworth bs 8 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.500 0.500 0.500 0.500 0.498 0.354 0.332 0.500 0.500)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.500 0.500 0.500 0.500 0.500 0.498 0.354 0.332 0.500 0.500)))
(snd-display "butterworth bs 8 .3 .4 spect: ~A" (cadr vals))))
@@ -10147,26 +9883,26 @@ EDITS: 2
;; ripple .01 .1 1 for 2..10 even
- (do ((poles-01 (vector (float-vector 1.000 4.456 10.426)
- (float-vector 1.000 0.822 2.006 1.000 1.984 1.299)
- (float-vector 1.000 0.343 1.372 1.000 0.937 0.939 1.000 1.280 0.506)
- (float-vector 1.000 0.189 1.196 1.000 0.537 0.925 1.000 0.804 0.542 1.000 0.948 0.272)
- (float-vector 1.000 0.119 1.121 1.000 0.347 0.940 1.000 0.540 0.646 1.000 0.680 0.352 1.000 0.754 0.170)))
- (zeros (vector (float-vector 0.000 0.000 1.000)
- (float-vector 0.000 0.000 0.250 0.000 0.000 1.000)
- (float-vector 0.000 0.000 0.062 0.000 0.000 1.000 0.000 0.000 1.000)
- (float-vector 0.000 0.000 0.016 0.000 0.000 1.000 0.000 0.000 1.000 0.000 0.000 1.000)
- (float-vector 0.000 0.000 0.004 0.000 0.000 1.000 0.000 0.000 1.000 0.000 0.000 1.000 0.000 0.000 1.000)))
- (poles-1 (vector (float-vector 1.000 2.372 3.314)
- (float-vector 1.000 0.528 1.330 1.000 1.275 0.623)
- (float-vector 1.000 0.229 1.129 1.000 0.627 0.696 1.000 0.856 0.263)
- (float-vector 1.000 0.128 1.069 1.000 0.364 0.799 1.000 0.545 0.416 1.000 0.643 0.146)
- (float-vector 1.000 0.082 1.044 1.000 0.237 0.862 1.000 0.369 0.568 1.000 0.465 0.274 1.000 0.515 0.092)))
- (poles-10 (vector (float-vector 1.000 1.098 1.103)
- (float-vector 1.000 0.279 0.987 1.000 0.674 0.279)
- (float-vector 1.000 0.124 0.991 1.000 0.340 0.558 1.000 0.464 0.125)
- (float-vector 1.000 0.070 0.994 1.000 0.199 0.724 1.000 0.298 0.341 1.000 0.352 0.070)
- (float-vector 1.000 0.045 0.996 1.000 0.130 0.814 1.000 0.203 0.521 1.000 0.255 0.227 1.000 0.283 0.045)))
+ (do ((poles-01 (vector #r(1.000 4.456 10.426)
+ #r(1.000 0.822 2.006 1.000 1.984 1.299)
+ #r(1.000 0.343 1.372 1.000 0.937 0.939 1.000 1.280 0.506)
+ #r(1.000 0.189 1.196 1.000 0.537 0.925 1.000 0.804 0.542 1.000 0.948 0.272)
+ #r(1.000 0.119 1.121 1.000 0.347 0.940 1.000 0.540 0.646 1.000 0.680 0.352 1.000 0.754 0.170)))
+ (zeros (vector #r(0.000 0.000 1.000)
+ #r(0.000 0.000 0.250 0.000 0.000 1.000)
+ #r(0.000 0.000 0.062 0.000 0.000 1.000 0.000 0.000 1.000)
+ #r(0.000 0.000 0.016 0.000 0.000 1.000 0.000 0.000 1.000 0.000 0.000 1.000)
+ #r(0.000 0.000 0.004 0.000 0.000 1.000 0.000 0.000 1.000 0.000 0.000 1.000 0.000 0.000 1.000)))
+ (poles-1 (vector #r(1.000 2.372 3.314)
+ #r(1.000 0.528 1.330 1.000 1.275 0.623)
+ #r(1.000 0.229 1.129 1.000 0.627 0.696 1.000 0.856 0.263)
+ #r(1.000 0.128 1.069 1.000 0.364 0.799 1.000 0.545 0.416 1.000 0.643 0.146)
+ #r(1.000 0.082 1.044 1.000 0.237 0.862 1.000 0.369 0.568 1.000 0.465 0.274 1.000 0.515 0.092)))
+ (poles-10 (vector #r(1.000 1.098 1.103)
+ #r(1.000 0.279 0.987 1.000 0.674 0.279)
+ #r(1.000 0.124 0.991 1.000 0.340 0.558 1.000 0.464 0.125)
+ #r(1.000 0.070 0.994 1.000 0.199 0.724 1.000 0.298 0.341 1.000 0.352 0.070)
+ #r(1.000 0.045 0.996 1.000 0.130 0.814 1.000 0.203 0.521 1.000 0.255 0.227 1.000 0.283 0.045)))
(i 2 (+ i 2))
(k 0 (+ k 1)))
((>= i 12))
@@ -10184,18 +9920,18 @@ EDITS: 2
(let ((vals (sweep->bins (make-chebyshev-lowpass 8 .1))))
(if (ffneq (car vals) .51) (snd-display "chebyshev lp 8 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.508 0.512 0.468 0.001 0.000 0.000 0.000 0.000 0.000 0.000))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.507 0.512 0.467 0.001 0.000 0.000 0.000 0.000 0.000 0.000))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.508 0.513 0.469 0.001 0.000 0.000 0.000 0.000 0.000 0.000))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.509 0.508 0.465 0.001 0.000 0.000 0.000 0.000 0.000 0.000))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.508 0.512 0.468 0.001 0.000 0.000 0.000 0.000 0.000 0.000))
+ (mus-arrays-equal?1 (cadr vals) #r(0.507 0.512 0.467 0.001 0.000 0.000 0.000 0.000 0.000 0.000))
+ (mus-arrays-equal?1 (cadr vals) #r(0.508 0.513 0.469 0.001 0.000 0.000 0.000 0.000 0.000 0.000))
+ (mus-arrays-equal?1 (cadr vals) #r(0.509 0.508 0.465 0.001 0.000 0.000 0.000 0.000 0.000 0.000))))
(snd-display "chebyshev lp 8 .1 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-chebyshev-lowpass 12 .25))))
(if (ffneq (car vals) .51) (snd-display "chebyshev lp 12 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.509 0.500 0.508 0.508 0.507 0.413 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.509 0.500 0.508 0.508 0.507 0.413 0.000 0.000 0.000 0.000)))
(snd-display "chebyshev lp 12 .25 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-chebyshev-lowpass 10 .4))))
(if (ffneq (car vals) .51) (snd-display "chebyshev lp 10 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.465 0.493 0.509 0.508 0.477 0.507 0.508 0.507 0.431 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.465 0.493 0.509 0.508 0.477 0.507 0.508 0.507 0.431 0.000)))
(snd-display "chebyshev lp 10 .4 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
@@ -10208,45 +9944,45 @@ EDITS: 2
(let ((vals (sweep->bins (make-chebyshev-lowpass 8 .1 .01))))
(if (ffneq (car vals) .49) (snd-display "chebyshev lp 8 .1 .01 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.492 0.491 0.483 0.006 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.492 0.491 0.483 0.006 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "chebyshev lp 8 .1 .01 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-chebyshev-lowpass 12 .25 .1))))
(if (ffneq (car vals) .49) (snd-display "chebyshev lp 12 .1 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.488 0.488 0.488 0.488 0.487 0.403 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.488 0.488 0.488 0.488 0.487 0.403 0.000 0.000 0.000 0.000)))
(snd-display "chebyshev lp 12 .25 .1 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-chebyshev-lowpass 10 .4 .001))))
(if (ffneq (car vals) .49) (snd-display "chebyshev lp 10 .001 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.497 0.497 0.497 0.497 0.497 0.497 0.497 0.497 0.488 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.497 0.497 0.497 0.497 0.497 0.497 0.497 0.497 0.488 0.000)))
(snd-display "chebyshev lp 10 .4 .001 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-chebyshev-highpass 8 .1))))
(if (ffneq (car vals) .55) (snd-display "chebyshev hp 8 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.341 0.551 0.509 0.466 0.501 0.509 0.505 0.481 0.461)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.341 0.551 0.509 0.466 0.501 0.509 0.505 0.481 0.461)))
(snd-display "chebyshev hp 8 .1 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-chebyshev-highpass 12 .25))))
(if (ffneq (car vals) .55) (snd-display "chebyshev hp 12 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.299 0.554 0.509 0.509 0.500 0.509)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.000 0.299 0.554 0.509 0.509 0.500 0.509)))
(snd-display "chebyshev hp 12 .25 spect: ~A" (cadr vals))))
(let ((vals (cadr (sweep->bins (make-chebyshev-highpass 10 .4)))))
- (if (not (or (mus-arrays-equal?1 vals (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.297 0.786 0.677))
- (mus-arrays-equal?1 vals (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.301 0.788 0.660))
- (mus-arrays-equal?1 vals (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.322 0.861 0.724))
- (mus-arrays-equal?1 vals (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.262 0.571 0.509))))
+ (if (not (or (mus-arrays-equal?1 vals #r(0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.297 0.786 0.677))
+ (mus-arrays-equal?1 vals #r(0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.301 0.788 0.660))
+ (mus-arrays-equal?1 vals #r(0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.322 0.861 0.724))
+ (mus-arrays-equal?1 vals #r(0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.262 0.571 0.509))))
(snd-display "chebyshev hp 10 .4 spect: ~A" vals)))
(let ((vals (sweep->bins (make-chebyshev-highpass 8 .1 .01))))
(if (ffneq (car vals) .49) (snd-display "chebyshev hp 8 .1 .01 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.498 0.498 0.492 0.491 0.492 0.492 0.492 0.491 0.491)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.498 0.498 0.492 0.491 0.492 0.492 0.492 0.491 0.491)))
(snd-display "chebyshev hp 8 .1 .01 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-chebyshev-highpass 12 .25 .1))))
(if (ffneq (car vals) .51) (snd-display "chebyshev hp 12 .1 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.453 0.516 0.489 0.489 0.488 0.488)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.000 0.453 0.516 0.489 0.489 0.488 0.488)))
(snd-display "chebyshev hp 12 .25 .1 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-chebyshev-highpass 10 .4 .001))))
(if (ffneq (car vals) .5) (snd-display "chebyshev hp 10 .001 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.002 0.501 0.504 0.504))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.002 0.503 0.505 0.504))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.002 0.503 0.501 0.497))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.000 0.000 0.000 0.002 0.501 0.504 0.504))
+ (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.000 0.000 0.000 0.002 0.503 0.505 0.504))
+ (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.000 0.000 0.000 0.002 0.503 0.501 0.497))))
(snd-display "chebyshev hp 10 .4 .001 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
@@ -10259,35 +9995,35 @@ EDITS: 2
(let ((vals (sweep->bins (make-chebyshev-bandpass 4 .1 .2))))
(if (beyond.5 vals) (snd-display "chebyshev bp 4 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.009 0.449 0.509 0.505 0.442 0.065 0.013 0.003 0.000 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.009 0.449 0.509 0.505 0.442 0.065 0.013 0.003 0.000 0.000)))
(snd-display "chebyshev bp 4 .1 .2 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-chebyshev-bandpass 6 .1 .2))))
(if (beyond.5 vals) (snd-display "chebyshev bp 6 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.001 0.376 0.505 0.498 0.412 0.011 0.001 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.001 0.376 0.505 0.498 0.412 0.011 0.001 0.000 0.000 0.000)))
(snd-display "chebyshev bp 6 .1 .2 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-chebyshev-bandpass 8 .3 .4))))
(if (beyond.5 vals) (snd-display "chebyshev bp 8 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.002 0.363 0.517 0.513 0.433 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.000 0.002 0.363 0.517 0.513 0.433 0.000)))
(snd-display "chebyshev bp 8 .3 .4 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-chebyshev-bandpass 8 .2 .2 .01))))
(if (beyond.5 vals) (snd-display "chebyshev bp 10 .2 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.015 0.483 0.482 0.021 0.001 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.015 0.483 0.482 0.021 0.001 0.000 0.000 0.000)))
(snd-display "chebyshev bp 10 .2 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-chebyshev-bandstop 4 .1 .4))))
(if (beyond.5 vals) (snd-display "chebyshev bs 4 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.509 0.505 0.447 0.033 0.006 0.006 0.033 0.445 0.512 0.509)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.509 0.505 0.447 0.033 0.006 0.006 0.033 0.445 0.512 0.509)))
(snd-display "chebyshev bs 4 .1 .4 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-chebyshev-bandstop 8 .1 .4))))
(if (> (abs (- (car vals) .51)) .05) (snd-display "chebyshev bs 8 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.508 0.512 0.468 0.001 0.000 0.000 0.001 0.345 0.551 0.507))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.507 0.512 0.467 0.001 0.000 0.000 0.001 0.344 0.549 0.508))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.508 0.513 0.469 0.001 0.000 0.000 0.001 0.345 0.552 0.508))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.509 0.508 0.465 0.001 0.000 0.000 0.001 0.343 0.548 0.508))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.508 0.512 0.468 0.001 0.000 0.000 0.001 0.345 0.551 0.507))
+ (mus-arrays-equal?1 (cadr vals) #r(0.507 0.512 0.467 0.001 0.000 0.000 0.001 0.344 0.549 0.508))
+ (mus-arrays-equal?1 (cadr vals) #r(0.508 0.513 0.469 0.001 0.000 0.000 0.001 0.345 0.552 0.508))
+ (mus-arrays-equal?1 (cadr vals) #r(0.509 0.508 0.465 0.001 0.000 0.000 0.001 0.343 0.548 0.508))))
(snd-display "chebyshev bs 8 .1 .4 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-chebyshev-bandstop 8 .1 .4 .01))))
(if (beyond.5 vals) (snd-display "chebyshev bs 8 .01 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.492 0.491 0.483 0.006 0.000 0.000 0.006 0.494 0.495 0.492)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.492 0.491 0.483 0.006 0.000 0.000 0.006 0.494 0.495 0.492)))
(snd-display "chebyshev bs 8 .1 .4 .01 spect: ~A" (cadr vals))))
@@ -10295,21 +10031,21 @@ EDITS: 2
(let ((vals (sweep->bins (make-inverse-chebyshev-lowpass 8 .1))))
(if (ffneq (car vals) .51) (snd-display "inverse-chebyshev lp 8 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.501 0.496 0.001 0.000 0.001 0.000 0.000 0.000 0.000 0.001))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.498 0.001 0.000 0.001 0.000 0.000 0.000 0.000 0.001))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.501 0.496 0.001 0.000 0.001 0.000 0.000 0.000 0.000 0.001))
+ (mus-arrays-equal?1 (cadr vals) #r(0.500 0.498 0.001 0.000 0.001 0.000 0.000 0.000 0.000 0.001))))
(snd-display "inverse-chebyshev lp 8 .1 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-inverse-chebyshev-lowpass 12 .25))))
(if (ffneq (car vals) .51) (snd-display "inverse-chebyshev lp 12 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.500 0.500 0.500 0.496 0.001 0.001 0.001 0.001 0.001)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.500 0.500 0.500 0.500 0.496 0.001 0.001 0.001 0.001 0.001)))
(snd-display "inverse-chebyshev lp 12 .25 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-inverse-chebyshev-lowpass 10 .4))))
(if (ffneq (car vals) .51) (snd-display "inverse-chebyshev lp 10 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.497 0.001 0.001))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.497 0.002 0.002))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.497 0.001 0.001))
+ (mus-arrays-equal?1 (cadr vals) #r(0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.497 0.002 0.002))))
(snd-display "inverse-chebyshev lp 10 .4 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-inverse-chebyshev-lowpass 10 .4 120))))
(if (ffneq (car vals) .51) (snd-display "inverse-chebyshev lp 10 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.501 0.501 0.501 0.501 0.501 0.500 0.345 0.007 0.000 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.501 0.501 0.501 0.501 0.501 0.500 0.345 0.007 0.000 0.000)))
(snd-display "inverse-chebyshev lp 10 .4 120 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
@@ -10322,21 +10058,21 @@ EDITS: 2
(let ((vals (sweep->bins (make-inverse-chebyshev-highpass 8 .1))))
(if (ffneq (car vals) .51) (snd-display "inverse-chebyshev hp 8 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.001 0.001 0.440 0.505 0.505 0.503 0.502 0.501 0.501 0.501)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.001 0.001 0.440 0.505 0.505 0.503 0.502 0.501 0.501 0.501)))
(snd-display "inverse-chebyshev hp 8 .1 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-inverse-chebyshev-highpass 12 .25))))
(if (ffneq (car vals) .51) (snd-display "inverse-chebyshev hp 12 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.001 0.001 0.001 0.001 0.001 0.505 0.506 0.503 0.501 0.501)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.001 0.001 0.001 0.001 0.001 0.505 0.506 0.503 0.501 0.501)))
(snd-display "inverse-chebyshev hp 12 .25 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-inverse-chebyshev-highpass 10 .4))))
(if (ffneq (car vals) .51) (snd-display "inverse-chebyshev hp 10 .4 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.001 0.001 0.001 0.001 0.001 0.503 0.503))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.001 0.001 0.001 0.001 0.001 0.505 0.503))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.001 0.001 0.001 0.001 0.001 0.509 0.504))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.001 0.001 0.001 0.001 0.001 0.503 0.503))
+ (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.001 0.001 0.001 0.001 0.001 0.505 0.503))
+ (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.001 0.001 0.001 0.001 0.001 0.509 0.504))))
(snd-display "inverse-chebyshev hp 10 .4 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-inverse-chebyshev-highpass 10 .1 120))))
(if (ffneq (car vals) .51) (snd-display "inverse-chebyshev hp 10 .1 120 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.007 0.328 0.502 0.502 0.502 0.501 0.501 0.501)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.007 0.328 0.502 0.502 0.502 0.501 0.501 0.501)))
(snd-display "inverse-chebyshev hp 10 .1 120 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
@@ -10349,38 +10085,38 @@ EDITS: 2
(let ((vals (sweep->bins (make-inverse-chebyshev-bandpass 10 .1 .2))))
(if (beyond.5 vals) (snd-display "inverse-chebyshev bp 4 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.001 0.001 0.498 0.485 0.001 0.001 0.000 0.001 0.000 0.001)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.001 0.001 0.498 0.485 0.001 0.001 0.000 0.001 0.000 0.001)))
(snd-display "inverse-chebyshev bp 10 .1 .2 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-inverse-chebyshev-bandpass 10 .1 .2 30))))
(if (beyond.5 vals) (snd-display "inverse-chebyshev bp 6 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.026 0.025 0.509 0.505 0.020 0.016 0.012 0.016 0.011 0.016))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.030 0.042 0.511 0.505 0.020 0.016 0.012 0.016 0.011 0.016))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.022 0.017 0.511 0.505 0.020 0.016 0.012 0.016 0.011 0.016))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.026 0.025 0.509 0.505 0.020 0.016 0.012 0.016 0.011 0.016))
+ (mus-arrays-equal?1 (cadr vals) #r(0.030 0.042 0.511 0.505 0.020 0.016 0.012 0.016 0.011 0.016))
+ (mus-arrays-equal?1 (cadr vals) #r(0.022 0.017 0.511 0.505 0.020 0.016 0.012 0.016 0.011 0.016))))
(snd-display "inverse-chebyshev bp 10 .1 .2 30 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-inverse-chebyshev-bandpass 8 .1 .4))))
(if (beyond.5 vals) (snd-display "inverse-chebyshev bp 8 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.001 0.001 0.440 0.506 0.505 0.503 0.502 0.434 0.001 0.001)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.001 0.001 0.440 0.506 0.505 0.503 0.502 0.434 0.001 0.001)))
(snd-display "inverse-chebyshev bp 8 .1 .4 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-inverse-chebyshev-bandpass 8 .3 .4 40))))
(if (beyond.5 vals) (snd-display "inverse-chebyshev bp 10 .2 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.002 0.005 0.007 0.007 0.005 0.005 0.503 0.505 0.006 0.005)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.002 0.005 0.007 0.007 0.005 0.005 0.503 0.505 0.006 0.005)))
(snd-display "inverse-chebyshev bp 10 .2 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-inverse-chebyshev-bandstop 4 .1 .4))))
(if (beyond.5 vals) (snd-display "inverse-chebyshev bs 4 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.054 0.001 0.001 0.000 0.000 0.000 0.001 0.055 0.503)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.500 0.054 0.001 0.001 0.000 0.000 0.000 0.001 0.055 0.503)))
(snd-display "inverse-chebyshev bs 4 .1 .4 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-inverse-chebyshev-bandstop 8 .1 .4))))
(if (beyond.5 vals) (snd-display "inverse-chebyshev bs 8 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.501 0.496 0.001 0.001 0.000 0.000 0.000 0.001 0.507 0.506))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.506 0.328 0.000 0.000 0.000 0.000 0.000 0.000 0.268 0.511))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.498 0.001 0.001 0.000 0.000 0.000 0.001 0.507 0.506))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.501 0.496 0.001 0.001 0.000 0.000 0.000 0.001 0.507 0.506))
+ (mus-arrays-equal?1 (cadr vals) #r(0.506 0.328 0.000 0.000 0.000 0.000 0.000 0.000 0.268 0.511))
+ (mus-arrays-equal?1 (cadr vals) #r(0.500 0.498 0.001 0.001 0.000 0.000 0.000 0.001 0.507 0.506))))
(snd-display "inverse-chebyshev bs 8 .1 .4 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-inverse-chebyshev-bandstop 8 .1 .4 90))))
(if (beyond.5 vals) (snd-display "inverse-chebyshev bs 8 90 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.505 0.325 0.000 0.000 0.000 0.000 0.000 0.000 0.270 0.506))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.506 0.328 0.000 0.000 0.000 0.000 0.000 0.000 0.269 0.509))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.501 0.327 0.000 0.000 0.000 0.000 0.000 0.000 0.268 0.506))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.505 0.325 0.000 0.000 0.000 0.000 0.000 0.000 0.270 0.506))
+ (mus-arrays-equal?1 (cadr vals) #r(0.506 0.328 0.000 0.000 0.000 0.000 0.000 0.000 0.269 0.509))
+ (mus-arrays-equal?1 (cadr vals) #r(0.501 0.327 0.000 0.000 0.000 0.000 0.000 0.000 0.268 0.506))))
(snd-display "inverse-chebyshev bs 8 .1 .4 90 spect: ~A" (cadr vals))))
@@ -10391,20 +10127,20 @@ EDITS: 2
(when (provided? 'gsl)
(let ((vals (sweep->bins (make-bessel-lowpass 4 .1))))
(if (not.5 vals) (snd-display "bessel lp 4 .1 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.417 0.209 0.062 0.018 0.005 0.001 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.500 0.417 0.209 0.062 0.018 0.005 0.001 0.000 0.000 0.000)))
(snd-display "bessel lp 4 .1 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-bessel-lowpass 8 .1))))
(if (not.5 vals) (snd-display "bessel lp 8 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.499 0.365 0.116 0.010 0.001 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.499 0.365 0.116 0.010 0.001 0.000 0.000 0.000 0.000 0.000)))
(snd-display "bessel lp 8 .1 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-bessel-lowpass 12 .25))))
(if (not.5 vals) (snd-display "bessel lp 12 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.477 0.410 0.309 0.185 0.063 0.006 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.500 0.477 0.410 0.309 0.185 0.063 0.006 0.000 0.000 0.000)))
(snd-display "bessel lp 12 .25 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-bessel-lowpass 10 .4))))
(if (not.5 vals) (snd-display "bessel lp 10 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.498 0.491 0.479 0.458 0.423 0.364 0.259 0.086 0.001))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.498 0.491 0.479 0.458 0.423 0.364 0.259 0.086 0.002))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.500 0.498 0.491 0.479 0.458 0.423 0.364 0.259 0.086 0.001))
+ (mus-arrays-equal?1 (cadr vals) #r(0.500 0.498 0.491 0.479 0.458 0.423 0.364 0.259 0.086 0.002))))
(snd-display "bessel lp 10 .4 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
@@ -10417,26 +10153,26 @@ EDITS: 2
(let ((vals (sweep->bins (make-bessel-highpass 8 .1))))
(if (not.5 vals) (snd-display "bessel hp 8 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.001 0.115 0.290 0.386 0.435 0.465 0.483 0.493 0.498 0.500)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.001 0.115 0.290 0.386 0.435 0.465 0.483 0.493 0.498 0.500)))
(snd-display "bessel hp 8 .1 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-bessel-highpass 12 .25))))
(if (not.5 vals) (snd-display "bessel hp 12 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.006 0.063 0.181 0.309 0.410 0.477 0.500)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.006 0.063 0.181 0.309 0.410 0.477 0.500)))
(snd-display "bessel hp 12 .25 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-bessel-highpass 10 .4))))
(if (ffneq (car vals) .5) (snd-display "bessel hp 10 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.004 0.084 0.343 0.499)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.000 0.000 0.000 0.004 0.084 0.343 0.499)))
(snd-display "bessel hp 10 .4 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-bessel-bandpass 4 .1 .2))))
(if (> (abs (- (car vals) .245)) .05) (snd-display "bessel bp 4 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.023 0.176 0.245 0.244 0.179 0.085 0.031 0.008 0.001 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.023 0.176 0.245 0.244 0.179 0.085 0.031 0.008 0.001 0.000)))
(snd-display "bessel bp 4 .1 .2 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-bessel-bandstop 12 .1 .2))))
(if (beyond.5 vals) (snd-display "bessel bs 12 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.498 0.325 0.065 0.066 0.177 0.297 0.389 0.452 0.488 0.500))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.499 0.324 0.065 0.066 0.177 0.297 0.389 0.452 0.488 0.500))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.498 0.325 0.065 0.066 0.177 0.297 0.389 0.452 0.488 0.500))
+ (mus-arrays-equal?1 (cadr vals) #r(0.499 0.324 0.065 0.066 0.177 0.297 0.389 0.452 0.488 0.500))))
(snd-display "bessel bs 12 .1 .2 spect: ~A" (cadr vals))))
;; ---------------- elliptic ----------------
@@ -10444,80 +10180,80 @@ EDITS: 2
(let ((past.5 (lambda (vals) (> (abs (- (car vals) .5)) .1))))
(let ((vals (sweep->bins (make-elliptic-lowpass 8 .1))))
(if (past.5 vals) (snd-display "elliptic lp 8 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.515 0.379 0.000 0.000 0.000 0.000 0.000 0.000 0.000))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.509 0.385 0.000 0.000 0.000 0.000 0.000 0.000 0.000))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.499 0.498 0.373 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.500 0.515 0.379 0.000 0.000 0.000 0.000 0.000 0.000 0.000))
+ (mus-arrays-equal?1 (cadr vals) #r(0.500 0.509 0.385 0.000 0.000 0.000 0.000 0.000 0.000 0.000))
+ (mus-arrays-equal?1 (cadr vals) #r(0.499 0.498 0.373 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
(snd-display "elliptic lp 8 .1 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-elliptic-lowpass 12 .25))))
(if (past.5 vals) (snd-display "elliptic lp 12 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.476 0.500 0.491 0.499 0.494 0.412 0.003 0.001 0.000 0.000))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.476 0.500 0.491 0.499 0.494 0.561 0.004 0.000 0.000 0.000))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.476 0.500 0.491 0.499 0.493 0.299 0.006 0.001 0.000 0.000))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.476 0.500 0.491 0.499 0.494 0.412 0.003 0.001 0.000 0.000))
+ (mus-arrays-equal?1 (cadr vals) #r(0.476 0.500 0.491 0.499 0.494 0.561 0.004 0.000 0.000 0.000))
+ (mus-arrays-equal?1 (cadr vals) #r(0.476 0.500 0.491 0.499 0.493 0.299 0.006 0.001 0.000 0.000))))
(snd-display "elliptic lp 12 .25 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-elliptic-lowpass 4 .4))))
(if (past.5 vals) (snd-display "elliptic lp 4 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.447 0.453 0.462 0.477 0.494 0.500 0.497 0.496 0.445 0.003)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.447 0.453 0.462 0.477 0.494 0.500 0.497 0.496 0.445 0.003)))
(snd-display "elliptic lp 4 .4 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-elliptic-lowpass 8 .1 .1))))
(if (past.5 vals) (snd-display "elliptic lp 8 .1 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.499 0.475 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.500 0.499 0.475 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "elliptic lp 8 .1 .1 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-elliptic-lowpass 8 .1 .1 90))))
(if (past.5 vals) (snd-display "elliptic lp 8 .1 90 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.499 0.475 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.500 0.499 0.475 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "elliptic lp 8 .1 .1 90 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-elliptic-lowpass 8 .25 .01 90))))
(if (past.5 vals) (snd-display "elliptic lp 8 .25 90 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.500 0.500 0.500 0.499 0.495 0.001 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.500 0.500 0.500 0.500 0.499 0.495 0.001 0.000 0.000 0.000)))
(snd-display "elliptic lp 8 .25 .1 90 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-elliptic-highpass 4 .1))))
(if (past.5 vals) (snd-display "elliptic hp 4 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.004 0.438 0.516 0.499 0.502 0.495 0.478 0.463 0.453 0.447)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.004 0.438 0.516 0.499 0.502 0.495 0.478 0.463 0.453 0.447)))
(snd-display "elliptic hp 4 .1 spect: ~A" (cadr vals))))
(let ((vals (cadr (sweep->bins (make-elliptic-highpass 12 .25)))))
- (if (not (or (mus-arrays-equal?1 vals (float-vector 0.000 0.001 0.001 0.001 0.026 0.934 0.518 0.495 0.503 0.477))
- (mus-arrays-equal?1 vals (float-vector 0.000 0.001 0.001 0.001 0.033 1.185 0.519 0.495 0.503 0.477))
- (mus-arrays-equal?1 vals (float-vector 0.000 0.001 0.001 0.001 0.018 0.788 0.520 0.495 0.503 0.477))))
+ (if (not (or (mus-arrays-equal?1 vals #r(0.000 0.001 0.001 0.001 0.026 0.934 0.518 0.495 0.503 0.477))
+ (mus-arrays-equal?1 vals #r(0.000 0.001 0.001 0.001 0.033 1.185 0.519 0.495 0.503 0.477))
+ (mus-arrays-equal?1 vals #r(0.000 0.001 0.001 0.001 0.018 0.788 0.520 0.495 0.503 0.477))))
(snd-display "elliptic hp 12 .25 spect: ~A" vals)))
(let ((vals (sweep->bins (make-elliptic-highpass 12 .25 .01 90))))
(if (past.5 vals) (snd-display "elliptic hp 12 90 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.499 0.517 0.503 0.501 0.500 0.500)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.000 0.499 0.517 0.503 0.501 0.500 0.500)))
(snd-display "elliptic hp 12 .25 90 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-elliptic-highpass 4 .4))))
(if (past.5 vals) (snd-display "elliptic hp 4 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.001 0.001 0.002 0.023 0.447 0.515 0.502)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.001 0.001 0.002 0.023 0.447 0.515 0.502)))
(snd-display "elliptic hp 4 .4 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-elliptic-highpass 8 .1 .1))))
(if (past.5 vals) (snd-display "elliptic hp 8 .1 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.478 0.553 0.506 0.499 0.501 0.501 0.499 0.497 0.495)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.478 0.553 0.506 0.499 0.501 0.501 0.499 0.497 0.495)))
(snd-display "elliptic hp 8 .1 .1 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-elliptic-highpass 8 .1 .1 90))))
(if (past.5 vals) (snd-display "elliptic hp 8 .1 90 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.478 0.554 0.506 0.499 0.501 0.501 0.499 0.497 0.495)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.478 0.554 0.506 0.499 0.501 0.501 0.499 0.497 0.495)))
(snd-display "elliptic hp 8 .1 .1 90 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-elliptic-highpass 8 .25 .01 90))))
(if (past.5 vals) (snd-display "elliptic hp 8 .25 90 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.000 0.000 0.000 0.001 0.516 0.517 0.507 0.503 0.501 0.500)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.000 0.000 0.000 0.001 0.516 0.517 0.507 0.503 0.501 0.500)))
(snd-display "elliptic hp 8 .25 .1 90 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-elliptic-bandpass 4 .1 .2 .1))))
(if (past.5 vals) (snd-display "elliptic bp 4 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.036 0.546 0.550 0.510 0.501 0.032 0.024 0.009 0.021 0.024)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.036 0.546 0.550 0.510 0.501 0.032 0.024 0.009 0.021 0.024)))
(snd-display "elliptic bp 4 .1 .2 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-elliptic-bandpass 6 .1 .2 .1 90))))
(if (past.5 vals) (snd-display "elliptic bp 6 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.002 0.511 0.532 0.503 0.492 0.003 0.001 0.001 0.001 0.001)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.002 0.511 0.532 0.503 0.492 0.003 0.001 0.001 0.001 0.001)))
(snd-display "elliptic bp 6 .1 .2 90 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-elliptic-bandstop 4 .1 .3 .1))))
(if (past.5 vals) (snd-display "elliptic bs 4 max: ~A" (car vals)))
- (if (not (mus-arrays-equal?1 (cadr vals) (float-vector 0.499 0.502 0.498 0.037 0.050 0.540 0.544 0.527 0.526 0.521)))
+ (if (not (mus-arrays-equal?1 (cadr vals) #r(0.499 0.502 0.498 0.037 0.050 0.540 0.544 0.527 0.526 0.521)))
(snd-display "elliptic bs 4 .1 .2 spect: ~A" (cadr vals))))
(let ((vals (sweep->bins (make-elliptic-bandstop 8 .1 .3 .1 120))))
(if (past.5 vals) (snd-display "elliptic bs 8 max: ~A" (car vals)))
- (if (not (or (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.499 0.476 0.000 0.000 0.495 0.526 0.505 0.501 0.501))
- (mus-arrays-equal?1 (cadr vals) (float-vector 0.500 0.499 0.475 0.000 0.000 0.495 0.526 0.505 0.501 0.501))))
+ (if (not (or (mus-arrays-equal?1 (cadr vals) #r(0.500 0.499 0.476 0.000 0.000 0.495 0.526 0.505 0.501 0.501))
+ (mus-arrays-equal?1 (cadr vals) #r(0.500 0.499 0.475 0.000 0.000 0.495 0.526 0.505 0.501 0.501))))
(snd-display "elliptic bs 8 .1 .2 spect: ~A" (cadr vals))))
)))))))
@@ -10533,94 +10269,94 @@ EDITS: 2
(lambda ()
;; degree=0
- (let ((val (poly-roots (float-vector 0.0))))
+ (let ((val (poly-roots #r(0.0))))
(if (pair? val) (snd-display "poly-roots 0.0: ~A" val)))
- (let ((val (poly-roots (float-vector 12.3))))
+ (let ((val (poly-roots #r(12.3))))
(if (pair? val) (snd-display "poly-roots 12.3: ~A" val)))
;; degree 0 + x=0
- (let ((val (poly-roots (float-vector 0.0 1.0))))
+ (let ((val (poly-roots #r(0.0 1.0))))
(if (not (ceql val '(0.0))) (snd-display "poly-roots 0.0 1.0: ~A" val)))
- (let ((val (poly-roots (float-vector 0.0 0.0 0.0 121.0))))
+ (let ((val (poly-roots #r(0.0 0.0 0.0 121.0))))
(if (not (ceql val '(0.0 0.0 0.0))) (snd-display "poly-roots 0.0 0.0 0.0 121.0: ~A" val)))
;; degree=1
- (let ((val (poly-roots (float-vector -1.0 1.0))))
+ (let ((val (poly-roots #r(-1.0 1.0))))
(if (not (ceql val '(1.0))) (snd-display "poly-roots -1.0 1.0: ~A" val)))
- (let ((val (poly-roots (float-vector -2.0 4.0))))
+ (let ((val (poly-roots #r(-2.0 4.0))))
(if (not (ceql val '(0.5))) (snd-display "poly-roots -2.0 4.0: ~A" val)))
(let ((val (poly-as-vector-roots (vector 0.0-i 1))))
(if (not (ceql val '(-0.0+1.0i))) (snd-display "poly-roots: -i 1: ~A" val)))
;; linear x^n
- (let ((val (poly-roots (float-vector -1.0 0.0 0.0 0.0 1.0))))
+ (let ((val (poly-roots #r(-1.0 0.0 0.0 0.0 1.0))))
(if (not (or (ceql val '(0.0-1.0i -1.0 0.0+1.0i 1.0))
(ceql val '(1.0 -1.0 0.0+1.0i -0.0-1.0i))))
(snd-display "poly-roots -1.0 0.0 0.0 0.0 1.0: ~A" val)))
- (let ((val (poly-roots (float-vector -16.0 0.0 0.0 0.0 1.0))))
+ (let ((val (poly-roots #r(-16.0 0.0 0.0 0.0 1.0))))
(if (not (or (ceql val '(0.0-2.0i -2.0 0.0+2.0i 2.0))
(ceql val '(2.0 -2.0 0.0+2.0i -0.0-2.0i))))
(snd-display "poly-roots -16.0 0.0 0.0 0.0 1.0: ~A" val)))
- (let ((val (poly-roots (float-vector -32.0 0 0 0 0 0 0.5))))
+ (let ((val (poly-roots #r(-32.0 0 0 0 0 0 0.5))))
(if (not (ceql val '(1.0-1.7320i -1.0-1.7320i -2.0 -1.0+1.7320i 1.0+1.7320i 2.0))) (snd-display "poly-roots 32 0 0 0 0 0 0.5: ~A" val)))
;; linear + x=0
- (let ((val (poly-roots (float-vector 0.0 -2.0 4.0))))
+ (let ((val (poly-roots #r(0.0 -2.0 4.0))))
(if (not (ceql val '(0.0 0.5))) (snd-display "poly-roots 0.0 -2.0 4.0: ~A" val)))
;; degree=2
- (let ((val (poly-roots (float-vector -1.0 0.0 1.0))))
+ (let ((val (poly-roots #r(-1.0 0.0 1.0))))
(if (not (ceql val '(1.0 -1.0))) (snd-display "poly-roots -1.0 0.0 1.0: ~A" val)))
- (let ((val (poly-roots (float-vector 15.0 -8.0 1.0))))
+ (let ((val (poly-roots #r(15.0 -8.0 1.0))))
(if (not (ceql val '(5.0 3.0))) (snd-display "poly-roots 15.0 -8.0 1.0: ~A" val)))
- (let ((val (poly-roots (float-vector 1 -2 1))))
+ (let ((val (poly-roots #r(1 -2 1))))
(if (not (ceql val '(1.0 1.0))) (snd-display "poly-roots 1 -2 1: ~A" val)))
(let ((val (poly-as-vector-roots (vector -1 0.0+2i 1))))
(if (not (ceql val '(0.0-1.0i 0.0-1.0i))) (snd-display "poly-roots -1 2i 1: ~A" val)))
- (let ((val (poly-roots (float-vector 1 1 5))))
+ (let ((val (poly-roots #r(1 1 5))))
(if (not (ceql val '(-0.1+0.43589i -0.1-0.43589i))) (snd-display "poly-roots 1 1 5: ~A" val)))
;; 2 + x=0
- (let ((val (poly-roots (float-vector 0.0 0.0 -1.0 0.0 1.0))))
+ (let ((val (poly-roots #r(0.0 0.0 -1.0 0.0 1.0))))
(if (not (ceql val '(0.0 0.0 1.0 -1.0))) (snd-display "poly-roots 0.0 0.0 -1.0 0.0 1.0: ~A" val)))
;; quadratic in x^(n/2)
- (let ((vals (poly-roots (float-vector 1.0 0.0 -2.0 0.0 1.0))))
+ (let ((vals (poly-roots #r(1.0 0.0 -2.0 0.0 1.0))))
(if (not (or (ceql vals '(-1.0 1.0 -1.0 1.0))
(ceql vals '(1.0 1.0 -1.0 -1.0))))
(snd-display "poly-roots 1 0 -2 0 1: ~A" vals)))
- (let ((vals (poly-roots (float-vector 64.0 0.0 0.0 -16.0 0.0 0.0 1.0))))
+ (let ((vals (poly-roots #r(64.0 0.0 0.0 -16.0 0.0 0.0 1.0))))
(if (not (ceql vals '(-1.0-1.73205i -1.0+1.73205i 2.0 -1.0-1.73205i -1.0+1.73205i 2.0)))
(snd-display "poly-roots 64 0 0 -16 0 0 1: ~A" vals)))
;; degree=3
- (let ((val (poly-roots (float-vector -15.0 23.0 -9.0 1.0))))
+ (let ((val (poly-roots #r(-15.0 23.0 -9.0 1.0))))
(if (not (ceql val '(5.0 1.0 3.0))) (snd-display "poly-roots 5 1 3: ~A" val)))
- (let ((val (poly-roots (float-vector -126 -15 0 1))))
+ (let ((val (poly-roots #r(-126 -15 0 1))))
(if (not (ceql val '(6.0 -3.0+3.46410i -3.0-3.46410i))) (snd-display "poly-roots -126 -15 0 1: ~A" val)))
- (let ((val (poly-roots (float-vector -1 3 -3 1))))
+ (let ((val (poly-roots #r(-1 3 -3 1))))
(if (not (ceql val '(1.0 1.0 1.0))) (snd-display "poly-roots -1 3 -3 1: ~A" val)))
- (let ((val (poly-roots (float-vector 1 -1 -1 1))))
+ (let ((val (poly-roots #r(1 -1 -1 1))))
(if (not (or (ceql val '(1.0 -1.0 1.0))
(ceql val '(-1.0 1.0 1.0))))
(snd-display "poly-roots 1 -1 1: ~A" val)))
- (let ((val (poly-roots (float-vector 2 -2 -2 2))))
+ (let ((val (poly-roots #r(2 -2 -2 2))))
(if (not (or (ceql val '(1.0 -1.0 1.0))
(ceql val '(-1.0 1.0 1.0))))
(snd-display "poly-roots 2 -2 -2 2: ~A" val)))
- (let ((vals (poly-roots (float-vector -64 0 0 0 0 0 1))))
+ (let ((vals (poly-roots #r(-64 0 0 0 0 0 1))))
(if (not (ceql vals '(0.999999999999999-1.73205080756888i -1.0-1.73205080756888i -2.0 -1.0+1.73205080756888i 1.0+1.73205080756888i 2.0)))
(snd-display "poly-roots 64 6: ~A" vals)))
- (let ((vals (poly-roots (float-vector 64 0 0 -16 0 0 1))))
+ (let ((vals (poly-roots #r(64 0 0 -16 0 0 1))))
(if (not (ceql vals '(-1.0-1.73205080756888i -1.0+1.73205080756888i 2.0 -1.0-1.73205080756888i -1.0+1.73205080756888i 2.0)))
(snd-display "poly-roots 64 16 6: ~A" vals)))
(do ((i 0 (+ i 1))) ((= i 10)) (poly-roots (float-vector (random 1.0) (random 1.0) (random 1.0))))
(do ((i 0 (+ i 1))) ((= i 10)) (poly-roots (float-vector (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
- (let ((vals1 (convolution (float-vector 1 2 3 0 0 0 0 0) (float-vector 1 2 3 0 0 0 0 0) 8))
- (vals2 (poly* (float-vector 1 2 3 0) (float-vector 1 2 3 0))))
+ (let ((vals1 (convolution #r(1 2 3 0 0 0 0 0) #r(1 2 3 0 0 0 0 0) 8))
+ (vals2 (poly* #r(1 2 3 0) #r(1 2 3 0))))
(if (not (mus-arrays-equal? vals1 vals2))
(snd-display "poly* convolve: ~A ~A" vals1 vals2)))
@@ -10650,27 +10386,27 @@ EDITS: 2
(set! (v (/ (- i 1) 2)) 1.0)
(poly-roots v)))
- (let ((vals (poly-roots (float-vector 1 -1 -1 1))))
+ (let ((vals (poly-roots #r(1 -1 -1 1))))
(if (not (or (ceql vals '(1.0 -1.0 1.0))
(ceql vals '(-1.0 1.0 1.0))))
(snd-display "poly-roots 1-1-11: ~A" vals)))
- (let ((vals (poly-roots (float-vector 2 -1 -2 1))))
+ (let ((vals (poly-roots #r(2 -1 -2 1))))
(if (not (ceql vals '(2.0 -1.0 1.0))) (snd-display "poly-roots 2-1-21: ~A" vals)))
- (let ((vals (poly-roots (float-vector -1 1 1 1))))
+ (let ((vals (poly-roots #r(-1 1 1 1))))
(if (not (ceql vals '(0.543689012692076 -0.771844506346038+1.11514250803994i -0.771844506346038-1.11514250803994i)))
(snd-display "poly-roots -1111: ~A" vals)))
- (let ((vals (poly-roots (float-vector -1 3 -3 1))))
+ (let ((vals (poly-roots #r(-1 3 -3 1))))
(if (not (ceql vals '(1.0 1.0 1.0))) (snd-display "poly-roots -13-31: ~A" vals)))
- ; (let ((vals (poly-roots (float-vector 1 -4 6 -4 1))))
+ ; (let ((vals (poly-roots #r(1 -4 6 -4 1))))
; (if (not (ceql vals '(1.0 1.0 1.0 1.0))) (snd-display "poly-roots 1-46-41: ~A" vals)))
- (let ((vals (poly-roots (float-vector 0.5 0 0 1.0))))
+ (let ((vals (poly-roots #r(0.5 0 0 1.0))))
(if (not (or (ceql vals '(0.396850262992049-0.687364818499302i -0.7937005259841 0.39685026299205+0.687364818499301i))
(ceql vals '(0.39685026299205+0.687364818499301i 0.39685026299205-0.687364818499301i -0.7937005259841))
(ceql vals '(-7.9370052598409979172089E-1 3.968502629920498958E-1+6.873648184993013E-1i 3.96850262992049E-1-6.873648184993E-1i))))
(snd-display "poly-roots 0..5 3: ~A" vals)))
- (let ((vals (poly-roots (poly* (poly* (poly* (float-vector -1 1) (float-vector 1 1))
- (poly* (float-vector -2 1) (float-vector 2 1)))
- (poly* (float-vector -3 1) (float-vector 3 1))))))
+ (let ((vals (poly-roots (poly* (poly* (poly* #r(-1 1) #r(1 1))
+ (poly* #r(-2 1) #r(2 1)))
+ (poly* #r(-3 1) #r(3 1))))))
(if (not (ceql vals '(-3.0 3.0 -1.0 1.0 -2.0 2.0)))
(snd-display "cube in 2: ~A" vals))))))
@@ -10698,7 +10434,7 @@ EDITS: 2
(define fltit
(let ((documentation "(fltit) returns a time-varying filter: (map-channel (fltit))"))
(lambda ()
- (let ((flt (make-fir-filter 8 (float-vector .1 .2 .3 .4 .4 .3 .2 .1))))
+ (let ((flt (make-fir-filter 8 #r(.1 .2 .3 .4 .4 .3 .2 .1))))
(do ((xcof (mus-xcoeffs flt)) ; maybe a copy?
(es (make-float-vector 8))
(i 0 (+ i 1)))
@@ -11273,8 +11009,8 @@ EDITS: 2
(if (fneq (Si 1.0) 0.9460830708394717) (snd-display "Si: ~A" (Si 1.0)))
(if (fneq (Ci 1.0) 0.3374039233633503) (snd-display "Ci: ~A" (Ci 1.0)))
(if (fneq (bernoulli-poly 1 1.0) 0.5) (snd-display "bernoulli-poly: ~A" (bernoulli-poly 1 1.0)))
- (let ((val1 (sin-m*pi/n 1 (* 257 17)))
- (val2 (sin-m*pi/n 2 (* 3 5))))
+ (let ((val1 (sin-m*pi/n 1 4369)) ;(* 257 17)))
+ (val2 (sin-m*pi/n 2 15))) ;(* 3 5))))
(let ((num1 (eval val1))
(num2 (eval val2)))
(if (fneq num1 0.0007190644044087482) ; (sin (/ (* 1 pi) (* 257 17)))
@@ -11365,22 +11101,22 @@ EDITS: 2
(if (fneq (contrast-enhancement 0.1 0.75) (sin (+ (* 0.1 (/ pi 2)) (* .75 (sin (* 0.1 2.0 pi))))))
(snd-display "contrast-enhancement: ~F (0.562925306221587)" (contrast-enhancement 0.1 0.75)))
(if (fneq (contrast-enhancement 1.0) 1.0) (snd-display "contrast-enhancement opt: ~A" (contrast-enhancement 1.0)))
- (let ((lv0 (partials->polynomial (float-vector 1 1 2 1) mus-chebyshev-first-kind)))
- (if (not (mus-arrays-equal? lv0 (float-vector -1.000 1.000 2.000) .001)) (snd-display "partials->polynomial(1): ~A?" lv0)))
+ (let ((lv0 (partials->polynomial #r(1 1 2 1) mus-chebyshev-first-kind)))
+ (if (not (mus-arrays-equal? lv0 #r(-1.000 1.000 2.000) .001)) (snd-display "partials->polynomial(1): ~A?" lv0)))
(let ((lv1 (partials->polynomial '(1 1 2 1) mus-chebyshev-second-kind)))
- (if (not (mus-arrays-equal? lv1 (float-vector 1.000 2.000 0.0) .001)) (snd-display "partials->polynomial(2): ~A?" lv1)))
+ (if (not (mus-arrays-equal? lv1 #r(1.000 2.000 0.0) .001)) (snd-display "partials->polynomial(2): ~A?" lv1)))
(let ((lv2 (partials->polynomial '(1 1 2 1 3 1 5 1) mus-chebyshev-first-kind)))
- (if (not (mus-arrays-equal? lv2 (float-vector -1.000 3.000 2.000 -16.000 0.000 16.000) .001)) (snd-display "partials->polynomial(3): ~A?" lv2)))
+ (if (not (mus-arrays-equal? lv2 #r(-1.000 3.000 2.000 -16.000 0.000 16.000) .001)) (snd-display "partials->polynomial(3): ~A?" lv2)))
(let ((lv3 (partials->polynomial '(1 1 2 1 3 1 5 1) mus-chebyshev-second-kind)))
- (if (not (mus-arrays-equal? lv3 (float-vector 1.000 2.000 -8.000 0.000 16.000 0.000) .001)) (snd-display "partials->polynomial(4): ~A?" lv3)))
+ (if (not (mus-arrays-equal? lv3 #r(1.000 2.000 -8.000 0.000 16.000 0.000) .001)) (snd-display "partials->polynomial(4): ~A?" lv3)))
(let ((lv4 (partials->polynomial '(1 1 2 .5 3 .1 6 .01) mus-chebyshev-first-kind)))
- (if (not (mus-arrays-equal? lv4 (float-vector -0.510 0.700 1.180 0.400 -0.480 0.000 0.320) .001)) (snd-display "partials->polynomial(5): ~A?" lv4)))
+ (if (not (mus-arrays-equal? lv4 #r(-0.510 0.700 1.180 0.400 -0.480 0.000 0.320) .001)) (snd-display "partials->polynomial(5): ~A?" lv4)))
(let ((lv5 (partials->polynomial '(1 1 2 .5 3 .1 6 .01) mus-chebyshev-second-kind)))
- (if (not (mus-arrays-equal? lv5 (float-vector 0.900 1.060 0.400 -0.320 0.000 0.320 0.000) .001)) (snd-display "partials->polynomial(6): ~A?" lv5)))
- (let ((lv6 (partials->polynomial (float-vector 1 9 2 3 3 5 4 7 5 1))))
- (if (not (mus-arrays-equal? lv6 (float-vector 4.000 -1.000 -50.000 0.000 56.000 16.000))) (snd-display "partials->polynomial(7): ~A?" lv6)))
+ (if (not (mus-arrays-equal? lv5 #r(0.900 1.060 0.400 -0.320 0.000 0.320 0.000) .001)) (snd-display "partials->polynomial(6): ~A?" lv5)))
+ (let ((lv6 (partials->polynomial #r(1 9 2 3 3 5 4 7 5 1))))
+ (if (not (mus-arrays-equal? lv6 #r(4.000 -1.000 -50.000 0.000 56.000 16.000))) (snd-display "partials->polynomial(7): ~A?" lv6)))
(let ((lv7 (partials->polynomial '(7 1))))
- (if (not (mus-arrays-equal? lv7 (float-vector 0.000 -7.000 0.000 56.000 0.000 -112.000 0.000 64.000))) (snd-display "partials->polynomial(8): ~A?" lv7))
+ (if (not (mus-arrays-equal? lv7 #r(0.000 -7.000 0.000 56.000 0.000 -112.000 0.000 64.000))) (snd-display "partials->polynomial(8): ~A?" lv7))
(let ((lv7a (partials->polynomial '(7 1) mus-chebyshev-first-kind)))
(if (not (mus-arrays-equal? lv7 lv7a)) (snd-display "partials->polynomial kind=1? ~A ~A" lv7 lv7a)))
(if (fneq (polynomial lv7 1.0) (cosh (* 7 (acosh 1.0))))
@@ -11400,28 +11136,28 @@ EDITS: 2
(snd-display "cos cheb 7 ~A: ~A ~A" val (polynomial lv7 val) (cos (* 7 aval))))
(if (fneq (polynomial lv8 val) (/ (sin (* 7 aval)) (sin aval)))
(snd-display "acos cheb 7 ~A: ~A ~A" val (polynomial lv8 val) (/ (sin (* 7 aval)) (sin aval)))))
- (if (not (mus-arrays-equal? lv8 (float-vector -1.000 0.000 24.000 0.000 -80.000 0.000 64.000 0.000))) (snd-display "partials->polynomial(9): ~A?" lv8))
+ (if (not (mus-arrays-equal? lv8 #r(-1.000 0.000 24.000 0.000 -80.000 0.000 64.000 0.000))) (snd-display "partials->polynomial(9): ~A?" lv8))
(if (fneq (polynomial lv8 0.5) (/ ca sa))
(snd-display "acos cheb 7 1.0: ~A ~A" (polynomial lv8 0.5) (/ ca sa)))))
;; G&R 8.943 p 984 uses n+1 where we use n in Un? (our numbering keeps harmonics aligned between Tn and Un)
- (if (not (mus-arrays-equal? (normalize-partials (list 1 1 2 1)) (float-vector 1.000 0.500 2.000 0.500)))
+ (if (not (mus-arrays-equal? (normalize-partials (list 1 1 2 1)) #r(1.000 0.500 2.000 0.500)))
(snd-display "normalize-partials 1: ~A" (normalize-partials (list 1 1 2 1))))
- (if (not (mus-arrays-equal? (normalize-partials (float-vector 1 1 2 1)) (float-vector 1.000 0.500 2.000 0.500)))
- (snd-display "normalize-partials 2: ~A" (normalize-partials (float-vector 1 1 2 1))))
- (if (not (mus-arrays-equal? (normalize-partials (float-vector 1 1 2 -1)) (float-vector 1.000 0.500 2.000 -0.500)))
- (snd-display "normalize-partials 3: ~A" (normalize-partials (float-vector 1 1 2 -1))))
- (if (not (mus-arrays-equal? (normalize-partials (float-vector 1 -.1 2 -.1)) (float-vector 1.000 -0.500 2.000 -0.500)))
- (snd-display "normalize-partials 4: ~A" (normalize-partials (float-vector 1 -.1 2 -.1))))
- (if (not (mus-arrays-equal? (normalize-partials (float-vector 0 2 1 1 4 1)) (float-vector 0.000 0.500 1.000 0.250 4.000 0.250)))
- (snd-display "normalize-partials 4: ~A" (normalize-partials (float-vector 0 2 1 1 4 1))))
+ (if (not (mus-arrays-equal? (normalize-partials #r(1 1 2 1)) #r(1.000 0.500 2.000 0.500)))
+ (snd-display "normalize-partials 2: ~A" (normalize-partials #r(1 1 2 1))))
+ (if (not (mus-arrays-equal? (normalize-partials #r(1 1 2 -1)) #r(1.000 0.500 2.000 -0.500)))
+ (snd-display "normalize-partials 3: ~A" (normalize-partials #r(1 1 2 -1))))
+ (if (not (mus-arrays-equal? (normalize-partials #r(1 -.1 2 -.1)) #r(1.000 -0.500 2.000 -0.500)))
+ (snd-display "normalize-partials 4: ~A" (normalize-partials #r(1 -.1 2 -.1))))
+ (if (not (mus-arrays-equal? (normalize-partials #r(0 2 1 1 4 1)) #r(0.000 0.500 1.000 0.250 4.000 0.250)))
+ (snd-display "normalize-partials 4: ~A" (normalize-partials #r(0 2 1 1 4 1))))
;; check phase-quadrature cancellations
(do ((cos-coeffs (partials->polynomial '(1 1 2 1) mus-chebyshev-first-kind))
- (sin-coeffs (partials->polynomial (float-vector 1 1 2 1) mus-chebyshev-second-kind))
+ (sin-coeffs (partials->polynomial #r(1 1 2 1) mus-chebyshev-second-kind))
(incr (/ (* 2 pi 440.0) 22050.0))
(i 0 (+ i 1))
- (a 0.0 (+ a incr)))
+ (a 0.0))
((= i 1100))
(let ((x (cos a)))
(let ((y (sin a))
@@ -11433,7 +11169,8 @@ EDITS: 2
(lower2 (+ 1.0 (cos a))))
(if (or (fneq upper upper2)
(fneq lower lower2))
- (snd-display "~A ~A, ~A ~A" upper upper2 lower lower2))))))
+ (snd-display "~A ~A, ~A ~A" upper upper2 lower lower2)))))
+ (set! a (+ a incr)))
(let ((tag (catch #t (lambda () (harmonicizer 550.0 '(.5 .3 .2) 10)) (lambda args (car args)))))
(if (not (eq? tag 'no-data)) (snd-display "odd length arg to partials->polynomial: ~A" tag)))
@@ -11542,7 +11279,7 @@ EDITS: 2
(v1 (make-float-vector 8)))
(do ((i 0 (+ i 1))) ((= i 8)) (set! (v0 i) i) (set! (v1 i) (/ (+ i 1))))
(rectangular->magnitudes v0 v1)
- (if (not (mus-arrays-equal? v0 (float-vector 1.000 1.118 2.028 3.010 4.005 5.003 6.002 7.001)))
+ (if (not (mus-arrays-equal? v0 #r(1.000 1.118 2.028 3.010 4.005 5.003 6.002 7.001)))
(snd-display "rectangular->magnitudes v0: ~A" v0)))
(do ((v0 (make-float-vector 8))
@@ -11617,8 +11354,8 @@ EDITS: 2
(polynomial v0 0.0)
(polynomial v0 1.0)
(polynomial v0 2.0))))
- (if (fneq (polynomial (float-vector 0.0 2.0) 0.5) 1.0)
- (snd-display "polynomial 2.0 * 0.5: ~A" (polynomial (float-vector 2.0) 0.5)))
+ (if (fneq (polynomial #r(0.0 2.0) 0.5) 1.0)
+ (snd-display "polynomial 2.0 * 0.5: ~A" (polynomial #r(2.0) 0.5)))
(let ((var (catch #t (lambda () (polynomial #f 1.0)) (lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
(snd-display "polynomial empty coeffs: ~A" var)))
@@ -11634,7 +11371,7 @@ EDITS: 2
(snd-display "poly ~A ~A: ~A ~A -> ~A~%" arg1 arg2 val1 val2 (abs (- val1 val2)))))))
(let ((err 0.0)
- (coeffs (float-vector 1.0 0.0 -.4999999963 0.0 .0416666418 0.0 -.0013888397 0.0 .0000247609 0.0 -.0000002605))
+ (coeffs #r(1.0 0.0 -.4999999963 0.0 .0416666418 0.0 -.0013888397 0.0 .0000247609 0.0 -.0000002605))
(pi2 (* pi 0.5)))
(let ((new-cos
(lambda (x)
@@ -11652,71 +11389,71 @@ EDITS: 2
(set! err (max err (abs (- (cos x) (new-cos x))))))
(if (> err 1.1e-7) (snd-display "new-cos poly err: ~A" err))))
- (let ((val (poly+ (float-vector .1 .2 .3) (float-vector 0.0 1.0 2.0 3.0 4.0))))
- (if (not (mus-arrays-equal? val (float-vector 0.100 1.200 2.300 3.000 4.000))) (snd-display "poly+ 1: ~A" val)))
-
- (let ((val (poly+ (float-vector .1 .2 .3) .5)))
- (if (not (mus-arrays-equal? val (float-vector 0.600 0.200 0.300))) (snd-display "poly+ 2: ~A" val)))
- (let ((val (poly+ .5 (float-vector .1 .2 .3))))
- (if (not (mus-arrays-equal? val (float-vector 0.600 0.200 0.300))) (snd-display "poly+ 3: ~A" val)))
-
- (let ((val (poly* (float-vector 1 1) (float-vector -1 1))))
- (if (not (mus-arrays-equal? val (float-vector -1.000 0.000 1.000 0.000))) (snd-display "poly* 1: ~A" val)))
- (let ((val (poly* (float-vector -5 1) (float-vector 3 7 2))))
- (if (not (mus-arrays-equal? val (float-vector -15.000 -32.000 -3.000 2.000 0.000))) (snd-display "poly* 2: ~A" val)))
- (let ((val (poly* (float-vector -30 -4 2) (float-vector 0.5 1))))
- (if (not (mus-arrays-equal? val (float-vector -15.000 -32.000 -3.000 2.000 0.000))) (snd-display "poly* 3: ~A" val)))
- (let ((val (poly* (float-vector -30 -4 2) 0.5)))
- (if (not (mus-arrays-equal? val (float-vector -15.000 -2.000 1.000))) (snd-display "poly* 4: ~A" val)))
- (let ((val (poly* 2.0 (float-vector -30 -4 2))))
- (if (not (mus-arrays-equal? val (float-vector -60.000 -8.000 4.000))) (snd-display "poly* 5: ~A" val)))
-
- (let ((val (poly/ (float-vector -1.0 0.0 1.0) (float-vector 1.0 1.0))))
- (if (not (and (mus-arrays-equal? (car val) (float-vector -1.000 1.000 0.000))
+ (let ((val (poly+ #r(.1 .2 .3) #r(0.0 1.0 2.0 3.0 4.0))))
+ (if (not (mus-arrays-equal? val #r(0.100 1.200 2.300 3.000 4.000))) (snd-display "poly+ 1: ~A" val)))
+
+ (let ((val (poly+ #r(.1 .2 .3) .5)))
+ (if (not (mus-arrays-equal? val #r(0.600 0.200 0.300))) (snd-display "poly+ 2: ~A" val)))
+ (let ((val (poly+ .5 #r(.1 .2 .3))))
+ (if (not (mus-arrays-equal? val #r(0.600 0.200 0.300))) (snd-display "poly+ 3: ~A" val)))
+
+ (let ((val (poly* #r(1 1) #r(-1 1))))
+ (if (not (mus-arrays-equal? val #r(-1.000 0.000 1.000 0.000))) (snd-display "poly* 1: ~A" val)))
+ (let ((val (poly* #r(-5 1) #r(3 7 2))))
+ (if (not (mus-arrays-equal? val #r(-15.000 -32.000 -3.000 2.000 0.000))) (snd-display "poly* 2: ~A" val)))
+ (let ((val (poly* #r(-30 -4 2) #r(0.5 1))))
+ (if (not (mus-arrays-equal? val #r(-15.000 -32.000 -3.000 2.000 0.000))) (snd-display "poly* 3: ~A" val)))
+ (let ((val (poly* #r(-30 -4 2) 0.5)))
+ (if (not (mus-arrays-equal? val #r(-15.000 -2.000 1.000))) (snd-display "poly* 4: ~A" val)))
+ (let ((val (poly* 2.0 #r(-30 -4 2))))
+ (if (not (mus-arrays-equal? val #r(-60.000 -8.000 4.000))) (snd-display "poly* 5: ~A" val)))
+
+ (let ((val (poly/ #r(-1.0 0.0 1.0) #r(1.0 1.0))))
+ (if (not (and (mus-arrays-equal? (car val) #r(-1.000 1.000 0.000))
(mus-arrays-equal? (cadr val) (make-float-vector 3))))
(snd-display "poly/ 1: ~A" val)))
- (let ((val (poly/ (float-vector -15 -32 -3 2) (float-vector -5 1))))
- (if (not (and (mus-arrays-equal? (car val) (float-vector 3.000 7.000 2.000 0.000))
+ (let ((val (poly/ #r(-15 -32 -3 2) #r(-5 1))))
+ (if (not (and (mus-arrays-equal? (car val) #r(3.000 7.000 2.000 0.000))
(mus-arrays-equal? (cadr val) (make-float-vector 4))))
(snd-display "poly/ 2: ~A" val)))
- (let ((val (poly/ (float-vector -15 -32 -3 2) (float-vector 3 1))))
- (if (not (and (mus-arrays-equal? (car val) (float-vector -5.000 -9.000 2.000 0.000))
+ (let ((val (poly/ #r(-15 -32 -3 2) #r(3 1))))
+ (if (not (and (mus-arrays-equal? (car val) #r(-5.000 -9.000 2.000 0.000))
(mus-arrays-equal? (cadr val) (make-float-vector 4))))
(snd-display "poly/ 3: ~A" val)))
- (let ((val (poly/ (float-vector -15 -32 -3 2) (float-vector .5 1))))
- (if (not (and (mus-arrays-equal? (car val) (float-vector -30.000 -4.000 2.000 0.000))
+ (let ((val (poly/ #r(-15 -32 -3 2) #r(.5 1))))
+ (if (not (and (mus-arrays-equal? (car val) #r(-30.000 -4.000 2.000 0.000))
(mus-arrays-equal? (cadr val) (make-float-vector 4))))
(snd-display "poly/ 4: ~A" val)))
- (let ((val (poly/ (float-vector -15 -32 -3 2) (float-vector 3 7 2))))
- (if (not (and (mus-arrays-equal? (car val) (float-vector -5.000 1.000 0.000 0.000))
+ (let ((val (poly/ #r(-15 -32 -3 2) #r(3 7 2))))
+ (if (not (and (mus-arrays-equal? (car val) #r(-5.000 1.000 0.000 0.000))
(mus-arrays-equal? (cadr val) (make-float-vector 4))))
(snd-display "poly/ 5: ~A" val)))
- (let ((val (poly/ (float-vector -15 -32 -3 2) 2.0)))
- (if (not (mus-arrays-equal? (car val) (float-vector -7.500 -16.000 -1.500 1.000)))
+ (let ((val (poly/ #r(-15 -32 -3 2) 2.0)))
+ (if (not (mus-arrays-equal? (car val) #r(-7.500 -16.000 -1.500 1.000)))
(snd-display "poly/ 6: ~A" val)))
- (let ((val (poly/ (float-vector -1.0 0.0 0.0 0.0 1.0) (float-vector 1.0 0.0 1.0))))
- (if (not (and (mus-arrays-equal? (car val) (float-vector -1.0 0.0 1.0 0.0 0.0))
+ (let ((val (poly/ #r(-1.0 0.0 0.0 0.0 1.0) #r(1.0 0.0 1.0))))
+ (if (not (and (mus-arrays-equal? (car val) #r(-1.0 0.0 1.0 0.0 0.0))
(mus-arrays-equal? (cadr val) (make-float-vector 5))))
(snd-display "poly/ 7: ~A" val)))
- (let ((val (poly/ (float-vector -1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0) (float-vector 1.0 0.0 0.0 0.0 1.0))))
- (if (not (and (mus-arrays-equal? (car val) (float-vector -1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0))
+ (let ((val (poly/ #r(-1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0) #r(1.0 0.0 0.0 0.0 1.0))))
+ (if (not (and (mus-arrays-equal? (car val) #r(-1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0))
(mus-arrays-equal? (cadr val) (make-float-vector 9))))
(snd-display "poly/ 8: ~A" val)))
- (let ((val (poly/ (float-vector -1.0 0.0 1.0) (float-vector -1.0 0.0 1.0))))
- (if (not (and (mus-arrays-equal? (car val) (float-vector 1.0 0.0 0.0))
+ (let ((val (poly/ #r(-1.0 0.0 1.0) #r(-1.0 0.0 1.0))))
+ (if (not (and (mus-arrays-equal? (car val) #r(1.0 0.0 0.0))
(mus-arrays-equal? (cadr val) (make-float-vector 3))))
(snd-display "poly/ 9: ~A" val)))
- (let ((val (poly/ (float-vector -1.0 0.0 1.0) (float-vector 2.0 1.0))))
- (if (not (and (mus-arrays-equal? (car val) (float-vector -2.000 1.000 0.000))
- (mus-arrays-equal? (cadr val) (float-vector 3.000 0.000 0.000))))
+ (let ((val (poly/ #r(-1.0 0.0 1.0) #r(2.0 1.0))))
+ (if (not (and (mus-arrays-equal? (car val) #r(-2.000 1.000 0.000))
+ (mus-arrays-equal? (cadr val) #r(3.000 0.000 0.000))))
(snd-display "poly/ 10: ~A" val)))
- (let ((val (poly/ (float-vector 2 1) (float-vector -1.0 0.0 1.0))))
- (if (not (and (mus-arrays-equal? (car val) (float-vector 0.0))
- (mus-arrays-equal? (cadr val) (float-vector -1.000 0.000 1.000))))
+ (let ((val (poly/ #r(2 1) #r(-1.0 0.0 1.0))))
+ (if (not (and (mus-arrays-equal? (car val) #r(0.0))
+ (mus-arrays-equal? (cadr val) #r(-1.000 0.000 1.000))))
(snd-display "poly/ 11: ~A" val)))
- (let ((val (poly/ (float-vector 1 2 3 0 1) (float-vector 0 0 0 1))))
- (if (not (and (mus-arrays-equal? (car val) (float-vector 0.000 1.000 0.000 0.000 0.000))
- (mus-arrays-equal? (cadr val) (float-vector 1.000 2.000 3.000 0.000 0.000))))
+ (let ((val (poly/ #r(1 2 3 0 1) #r(0 0 0 1))))
+ (if (not (and (mus-arrays-equal? (car val) #r(0.000 1.000 0.000 0.000 0.000))
+ (mus-arrays-equal? (cadr val) #r(1.000 2.000 3.000 0.000 0.000))))
(snd-display "poly/ 12: ~A" val)))
(let ((ind (open-sound "1a.snd")))
@@ -11729,32 +11466,32 @@ EDITS: 2
(snd-display "poly1 1a: ~A" vals))))
(close-sound ind))
- (let ((val (poly-derivative (float-vector 0.5 1.0 2.0 4.0))))
- (if (not (mus-arrays-equal? val (float-vector 1.000 4.000 12.000))) (snd-display "poly-derivative: ~A" val)))
-
- (let ((val (poly-reduce (float-vector 1 2 3))))
- (if (not (mus-arrays-equal? val (float-vector 1.000 2.000 3.000))) (snd-display "poly-reduce 1: ~A" val)))
- (let ((val (poly-reduce (float-vector 1 2 3 0 0 0))))
- (if (not (mus-arrays-equal? val (float-vector 1.000 2.000 3.000))) (snd-display "poly-reduce 2: ~A" val)))
- (let ((val (poly-reduce (float-vector 0 0 0 0 1 0))))
- (if (not (mus-arrays-equal? val (float-vector 0.000 0.000 0.000 0.000 1.000))) (snd-display "poly-reduce 3: ~A" val)))
-
- (let ((vals (poly-gcd (poly-reduce (poly* (float-vector 2 1) (float-vector -3 1))) (float-vector 2 1))))
- (if (not (mus-arrays-equal? vals (float-vector 2.000 1.000))) (snd-display "poly-gcd 1: ~A" vals)))
- (let ((vals (poly-gcd (poly-reduce (poly* (float-vector 2 1) (float-vector -3 1))) (float-vector 3 1))))
- (if (not (mus-arrays-equal? vals (float-vector 0.000))) (snd-display "poly-gcd 2: ~A" vals)))
- (let ((vals (poly-gcd (poly-reduce (poly* (float-vector 2 1) (float-vector -3 1))) (float-vector -3 1))))
- (if (not (mus-arrays-equal? vals (float-vector -3.000 1.000))) (snd-display "poly-gcd 2: ~A" vals)))
- (let ((vals (poly-gcd (poly-reduce (poly* (float-vector 8 1) (poly* (float-vector 2 1) (float-vector -3 1)))) (float-vector -3 1))))
- (if (not (mus-arrays-equal? vals (float-vector -3.000 1.000))) (snd-display "poly-gcd 3: ~A" vals)))
- (let ((vals (poly-gcd (poly-reduce (poly* (float-vector 8 1) (poly* (float-vector 2 1) (float-vector -3 1)))) (poly-reduce (poly* (float-vector 8 1) (float-vector -3 1))))))
- (if (not (mus-arrays-equal? vals (float-vector -24.000 5.000 1.000))) (snd-display "poly-gcd 4: ~A" vals)))
- (let ((vals (poly-gcd (float-vector -1 0 1) (float-vector 2 -2 -1 1))))
- (if (not (mus-arrays-equal? vals (float-vector 0.000))) (snd-display "poly-gcd 5: ~A" vals)))
- (let ((vals (poly-gcd (float-vector 2 -2 -1 1) (float-vector -1 0 1))))
- (if (not (mus-arrays-equal? vals (float-vector 1.000 -1.000))) (snd-display "poly-gcd 6: ~A" vals)))
- (let ((vals (poly-gcd (float-vector 2 -2 -1 1) (float-vector -2.5 1))))
- (if (not (mus-arrays-equal? vals (float-vector 0.000))) (snd-display "poly-gcd 7: ~A" vals)))
+ (let ((val (poly-derivative #r(0.5 1.0 2.0 4.0))))
+ (if (not (mus-arrays-equal? val #r(1.000 4.000 12.000))) (snd-display "poly-derivative: ~A" val)))
+
+ (let ((val (poly-reduce #r(1 2 3))))
+ (if (not (mus-arrays-equal? val #r(1.000 2.000 3.000))) (snd-display "poly-reduce 1: ~A" val)))
+ (let ((val (poly-reduce #r(1 2 3 0 0 0))))
+ (if (not (mus-arrays-equal? val #r(1.000 2.000 3.000))) (snd-display "poly-reduce 2: ~A" val)))
+ (let ((val (poly-reduce #r(0 0 0 0 1 0))))
+ (if (not (mus-arrays-equal? val #r(0.000 0.000 0.000 0.000 1.000))) (snd-display "poly-reduce 3: ~A" val)))
+
+ (let ((vals (poly-gcd (poly-reduce (poly* #r(2 1) #r(-3 1))) #r(2 1))))
+ (if (not (mus-arrays-equal? vals #r(2.000 1.000))) (snd-display "poly-gcd 1: ~A" vals)))
+ (let ((vals (poly-gcd (poly-reduce (poly* #r(2 1) #r(-3 1))) #r(3 1))))
+ (if (not (mus-arrays-equal? vals #r(0.000))) (snd-display "poly-gcd 2: ~A" vals)))
+ (let ((vals (poly-gcd (poly-reduce (poly* #r(2 1) #r(-3 1))) #r(-3 1))))
+ (if (not (mus-arrays-equal? vals #r(-3.000 1.000))) (snd-display "poly-gcd 2: ~A" vals)))
+ (let ((vals (poly-gcd (poly-reduce (poly* #r(8 1) (poly* #r(2 1) #r(-3 1)))) #r(-3 1))))
+ (if (not (mus-arrays-equal? vals #r(-3.000 1.000))) (snd-display "poly-gcd 3: ~A" vals)))
+ (let ((vals (poly-gcd (poly-reduce (poly* #r(8 1) (poly* #r(2 1) #r(-3 1)))) (poly-reduce (poly* #r(8 1) #r(-3 1))))))
+ (if (not (mus-arrays-equal? vals #r(-24.000 5.000 1.000))) (snd-display "poly-gcd 4: ~A" vals)))
+ (let ((vals (poly-gcd #r(-1 0 1) #r(2 -2 -1 1))))
+ (if (not (mus-arrays-equal? vals #r(0.000))) (snd-display "poly-gcd 5: ~A" vals)))
+ (let ((vals (poly-gcd #r(2 -2 -1 1) #r(-1 0 1))))
+ (if (not (mus-arrays-equal? vals #r(1.000 -1.000))) (snd-display "poly-gcd 6: ~A" vals)))
+ (let ((vals (poly-gcd #r(2 -2 -1 1) #r(-2.5 1))))
+ (if (not (mus-arrays-equal? vals #r(0.000))) (snd-display "poly-gcd 7: ~A" vals)))
(poly-roots-tests)
@@ -11766,20 +11503,20 @@ EDITS: 2
(if (fneq val 0.0) (snd-display "poly-resultant 2: ~A" val)))
(let ((val (poly-as-vector-resultant (vector -1 0 1) (vector 2 1))))
(if (fneq val 3.0) (snd-display "poly-resultant 3: ~A" val)))
- (let ((val (poly-resultant (float-vector -1 0 1) (float-vector 1 -2 1))))
+ (let ((val (poly-resultant #r(-1 0 1) #r(1 -2 1))))
(if (fneq val 0.0) (snd-display "poly-resultant 0: ~A" val)))
(let ((val (poly-as-vector-discriminant (vector -1 0 1))))
(if (fneq val -4.0) (snd-display "poly-discriminant 0: ~A" val)))
(let ((val (poly-as-vector-discriminant (vector 1 -2 1))))
(if (fneq val 0.0) (snd-display "poly-discriminant 1: ~A" val)))
- (let ((val (poly-discriminant (poly-reduce (poly* (poly* (float-vector -1 1) (float-vector -1 1)) (float-vector 3 1))))))
+ (let ((val (poly-discriminant (poly-reduce (poly* (poly* #r(-1 1) #r(-1 1)) #r(3 1))))))
(if (fneq val 0.0) (snd-display "poly-discriminant 2: ~A" val)))
- (let ((val (poly-discriminant (poly-reduce (poly* (poly* (poly* (float-vector -1 1) (float-vector -1 1)) (float-vector 3 1)) (float-vector 2 1))))))
+ (let ((val (poly-discriminant (poly-reduce (poly* (poly* (poly* #r(-1 1) #r(-1 1)) #r(3 1)) #r(2 1))))))
(if (fneq val 0.0) (snd-display "poly-discriminant 3: ~A" val)))
- (let ((val (poly-discriminant (poly-reduce (poly* (poly* (poly* (float-vector 1 1) (float-vector -1 1)) (float-vector 3 1)) (float-vector 2 1))))))
+ (let ((val (poly-discriminant (poly-reduce (poly* (poly* (poly* #r(1 1) #r(-1 1)) #r(3 1)) #r(2 1))))))
(if (fneq val 2304.0) (snd-display "poly-discriminant 4: ~A" val)))
- (let ((val (poly-discriminant (poly-reduce (poly* (poly* (poly* (float-vector 1 1) (float-vector -1 1)) (float-vector 3 1)) (float-vector 3 1))))))
+ (let ((val (poly-discriminant (poly-reduce (poly* (poly* (poly* #r(1 1) #r(-1 1)) #r(3 1)) #r(3 1))))))
(if (fneq val 0.0) (snd-display "poly-discriminant 5: ~A" val)))
@@ -11848,22 +11585,22 @@ EDITS: 2
(do ((i 0 (+ 1 i)))
((= i 10))
(delay d i))
- (if (not (mus-arrays-equal? (mus-data d) (float-vector 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0)))
+ (if (not (mus-arrays-equal? (mus-data d) #r(0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0)))
(snd-display "delay data (0..9): ~A~%" (mus-data d)))
(let ((vals (make-float-vector 10)))
(do ((i 0 (+ i 1)))
((= i 10))
(set! (vals i) (tap d (- i))))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0)))
+ (if (not (mus-arrays-equal? vals #r(0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0)))
(snd-display "delay tapped backwards: ~A~%" vals))
(do ((i 0 (+ i 1)))
((= i 10))
(set! (vals i) (tap d i)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 9.0 8.0 7.0 6.0 5.0 4.0 3.0 2.0 1.0)))
+ (if (not (mus-arrays-equal? vals #r(0.0 9.0 8.0 7.0 6.0 5.0 4.0 3.0 2.0 1.0)))
(snd-display "delay tapped forwards: ~A~%" vals))))
(let ((gen1 (make-delay 4 :initial-contents '(1.0 0.5 0.25 0.0)))
- (gen3 (make-delay 4 :initial-contents (float-vector 1.0 0.5 0.25 0.0))))
+ (gen3 (make-delay 4 :initial-contents #r(1.0 0.5 0.25 0.0))))
(let ((gen (make-delay 3)))
(print-and-check gen
"delay"
@@ -11937,7 +11674,7 @@ EDITS: 2
(do ((v0 (make-float-vector 5))
(i 0 (+ i 1)))
((= i 5)
- (if (not (mus-arrays-equal? v0 (float-vector 0.600 0.400 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? v0 #r(0.600 0.400 0.000 0.000 0.000)))
(snd-display "zdelay: ~A" v0)))
(set! (v0 i) (delay del 0.0 0.4)))
(delay del 1.0)
@@ -11955,7 +11692,7 @@ EDITS: 2
(fill-float-vector v (let ((res (delay dly (+ inval (* (one-zero flt (tap dly)) .6)))))
(set! inval 0.0)
res)))
- (if (not (mus-arrays-equal? v (float-vector 0.0 0.0 0.0 1.0 0.0 0.0 0.300 0.240 0.0 0.090 0.144 0.058 0.027 0.065 0.052 0.022 0.026 0.031 0.019 0.013)))
+ (if (not (mus-arrays-equal? v #r(0.0 0.0 0.0 1.0 0.0 0.0 0.300 0.240 0.0 0.090 0.144 0.058 0.027 0.065 0.052 0.022 0.026 0.031 0.019 0.013)))
(snd-display "tap with low pass: ~A" v)))
(let ((dly (make-delay 3))
@@ -11964,7 +11701,7 @@ EDITS: 2
(fill-float-vector v (let ((res (delay dly (+ inval (tap dly)))))
(set! inval 0.0)
res)))
- (if (not (mus-arrays-equal? v (float-vector 0.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0)))
+ (if (not (mus-arrays-equal? v #r(0.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0)))
(snd-display "simple tap: ~A" v)))
(let ((dly (make-delay 6))
@@ -11975,20 +11712,18 @@ EDITS: 2
(set! inval 0.0)
res)))
(set! *print-length* (max 20 *print-length*))
- (if (not (mus-arrays-equal? v (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0 0.0)))
+ (if (not (mus-arrays-equal? v #r(0.0 0.0 0.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0 0.0)))
(snd-display "tap back 2: ~A" v)))
- (let ((dly (make-delay 3))
- (flt (make-one-zero .5 .4))
- (v (make-float-vector 20)))
- (do ((inval 1.0)
- (i 0 (+ i 1)))
- ((= i 20))
- (set! (v i) (let ((res (delay dly (+ inval (* (one-zero flt (tap dly)) .6)))))
- (set! inval 0.0)
- res)))
- (if (not (mus-arrays-equal? v (float-vector 0.0 0.0 0.0 1.0 0.0 0.0 0.300 0.240 0.0 0.090 0.144 0.058 0.027 0.065 0.052 0.022 0.026 0.031 0.019 0.013)))
- (snd-display "tap with low pass: ~A" v)))
+ (do ((dly (make-delay 3))
+ (flt (make-one-zero .5 .4))
+ (v (make-float-vector 20))
+ (inval 1.0 0.0)
+ (i 0 (+ i 1)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v #r(0.0 0.0 0.0 1.0 0.0 0.0 0.300 0.240 0.0 0.090 0.144 0.058 0.027 0.065 0.052 0.022 0.026 0.031 0.019 0.013)))
+ (snd-display "tap with low pass: ~A" v)))
+ (set! (v i) (delay dly (+ inval (* (one-zero flt (tap dly)) .6)))))
(let* ((dly (make-delay 3 :initial-element 32.0))
(ddata (mus-data dly)))
@@ -12053,21 +11788,21 @@ EDITS: 2
(set! (v6 i) (tap d6 j))
(set! (v7 i) (tap d7 j)))
(set! *print-length* (max 20 *print-length*))
- (if (not (or (mus-arrays-equal? v1 (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0))
- (mus-arrays-equal? v1 (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0))))
+ (if (not (or (mus-arrays-equal? v1 #r(0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0))
+ (mus-arrays-equal? v1 #r(0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0))))
(snd-display "delay interp none (1): ~A" v1))
- (if (not (mus-arrays-equal? v2 (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.200 0.400 0.600 0.800 1.0 0.800 0.600 0.400 0.200 0.0 0.0 0.0 0.0 0.0)))
+ (if (not (mus-arrays-equal? v2 #r(0.0 0.0 0.0 0.0 0.0 0.0 0.200 0.400 0.600 0.800 1.0 0.800 0.600 0.400 0.200 0.0 0.0 0.0 0.0 0.0)))
(snd-display "delay interp linear (2): ~A" v2))
- (if (not (mus-arrays-equal? v3 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.600 0.160 0.168 -0.168 0.334 0.199 0.520 0.696 -0.696 0.557 -0.334 0.134 -0.027)))
+ (if (not (mus-arrays-equal? v3 #r(0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.600 0.160 0.168 -0.168 0.334 0.199 0.520 0.696 -0.696 0.557 -0.334 0.134 -0.027)))
(snd-display "delay interp all-pass (3): ~A" v3))
- (if (not (or (mus-arrays-equal? v4 (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0))
- (mus-arrays-equal? v4 (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0))))
+ (if (not (or (mus-arrays-equal? v4 #r(0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0))
+ (mus-arrays-equal? v4 #r(0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0))))
(snd-display "delay interp none (4): ~A" v4))
- (if (not (mus-arrays-equal? v5 (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.120 0.280 0.480 0.720 1.000 0.960 0.840 0.640 0.360 0.000 -0.080 -0.120 -0.120 -0.080)))
+ (if (not (mus-arrays-equal? v5 #r(0.0 0.0 0.0 0.0 0.0 0.0 0.120 0.280 0.480 0.720 1.000 0.960 0.840 0.640 0.360 0.000 -0.080 -0.120 -0.120 -0.080)))
(snd-display "delay interp lagrange (5): ~A" v5))
- (if (not (mus-arrays-equal? v6 (float-vector 0.0 -0.016 -0.048 -0.072 -0.064 0.0 0.168 0.424 0.696 0.912 1.0 0.912 0.696 0.424 0.168 0.0 -0.064 -0.072 -0.048 -0.016)))
+ (if (not (mus-arrays-equal? v6 #r(0.0 -0.016 -0.048 -0.072 -0.064 0.0 0.168 0.424 0.696 0.912 1.0 0.912 0.696 0.424 0.168 0.0 -0.064 -0.072 -0.048 -0.016)))
(snd-display "delay interp hermite (6): ~A" v6))
- (if (not (mus-arrays-equal? v7 (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.200 0.400 0.600 0.800 1.0 0.800 0.600 0.400 0.200 0.0 0.0 0.0 0.0 0.0)))
+ (if (not (mus-arrays-equal? v7 #r(0.0 0.0 0.0 0.0 0.0 0.0 0.200 0.400 0.600 0.800 1.0 0.800 0.600 0.400 0.200 0.0 0.0 0.0 0.0 0.0)))
(snd-display "delay interp linear (7): ~A" v7)))
(let ((dly1 (make-delay :size 2 :max-size 3))
@@ -12077,7 +11812,7 @@ EDITS: 2
((= i 5))
(set! (data i) (delay dly1 impulse 0.4)) ; longer line
(set! impulse 0.0))
- (if (not (mus-arrays-equal? data (float-vector 0.0 0.0 0.6 0.4 0.0)))
+ (if (not (mus-arrays-equal? data #r(0.0 0.0 0.6 0.4 0.0)))
(snd-display "delay size 2, max 3, off 0.4: ~A" data))
(set! dly1 (make-delay :size 2 :max-size 3))
@@ -12086,7 +11821,7 @@ EDITS: 2
((= i 5))
(set! (data i) (delay dly1 impulse -0.4)) ; shorter line
(set! impulse 0.0))
- (if (not (mus-arrays-equal? data (float-vector 0.0 0.4 0.6 0.0 0.0)))
+ (if (not (mus-arrays-equal? data #r(0.0 0.4 0.6 0.0 0.0)))
(snd-display "delay size 2, max 3, off -0.4: ~A" data))
(set! dly1 (make-delay :size 1 :max-size 2))
@@ -12095,7 +11830,7 @@ EDITS: 2
((= i 5))
(set! (data i) (delay dly1 impulse 0.4))
(set! impulse 0.0))
- (if (not (mus-arrays-equal? data (float-vector 0.0 0.6 0.4 0.0 0.0)))
+ (if (not (mus-arrays-equal? data #r(0.0 0.6 0.4 0.0 0.0)))
(snd-display "delay size 1, max 2, off 0.4: ~A" data))
(set! dly1 (make-delay :size 0 :max-size 1))
@@ -12104,7 +11839,7 @@ EDITS: 2
((= i 5))
(set! (data i) (delay dly1 impulse 0.4))
(set! impulse 0.0))
- (if (not (mus-arrays-equal? data (float-vector 0.6 0.4 0.0 0.0 0.0)))
+ (if (not (mus-arrays-equal? data #r(0.6 0.4 0.0 0.0 0.0)))
(snd-display "delay size 0, max 1, off 0.4: ~A" data))
(set! dly1 (make-delay :size 0 :max-size 1))
@@ -12117,7 +11852,7 @@ EDITS: 2
((= i 5))
(set! (data i) (delay dly1 impulse -0.4)) ; shorter than 0? should this be an error?
(set! impulse 0.0))
- (if (not (mus-arrays-equal? data (float-vector 1.4 -0.4 0.0 0.0 0.0))) ; hmmm -- they're asking for undefined values here
+ (if (not (mus-arrays-equal? data #r(1.4 -0.4 0.0 0.0 0.0))) ; hmmm -- they're asking for undefined values here
(snd-display "delay size 0, max 1, off -0.4: ~A" data))
(set! dly1 (make-delay 0))
@@ -12126,7 +11861,7 @@ EDITS: 2
((= i 5))
(set! (data i) (delay dly1 impulse))
(set! impulse 0.0))
- (if (not (mus-arrays-equal? data (float-vector 1 0 0 0 0)))
+ (if (not (mus-arrays-equal? data #r(1 0 0 0 0)))
(snd-display "delay size 0: ~A" data))
(let ((x (delay dly1 0.5)))
(if (fneq x 0.5)
@@ -12138,7 +11873,7 @@ EDITS: 2
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (delay gen 0.5 i)))
- (if (not (mus-arrays-equal? v (float-vector 0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? v #r(0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "delay 0 -> 100: ~A" v))
(do ((i 9 (- i 1)))
((< i 0))
@@ -12151,13 +11886,13 @@ EDITS: 2
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (delay gen (if (odd? i) 1.0 0.0) (* i .1))))
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.900 0.000 0.700 0.000 0.500 0.000 0.300 0.000 0.100)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.900 0.000 0.700 0.000 0.500 0.000 0.300 0.000 0.100)))
(snd-display "delay 0 -> 100 .1: ~A (~A)" v gen))
(mus-reset gen)
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (delay gen (if (odd? i) 1.0 0.0) (+ 1.0 (* i .1)))))
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.000 0.800 0.300 0.600 0.500 0.400 0.700 0.200 0.900)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.000 0.800 0.300 0.600 0.500 0.400 0.700 0.200 0.900)))
(snd-display "delay 0 -> 100 1.1: ~A" v)))
@@ -12243,7 +11978,7 @@ EDITS: 2
(if (fneq val 1.0) (snd-display "average initial-contents: ~A" val)))
(test-gen-equal (let ((d1 (make-moving-average 3 :initial-contents '(0.7 0.5 3)))) (moving-average d1 1.0) d1)
- (let ((d2 (make-moving-average 3 :initial-contents (float-vector 0.7 0.5 3)))) (moving-average d2 1.0) d2)
+ (let ((d2 (make-moving-average 3 :initial-contents #r(0.7 0.5 3)))) (moving-average d2 1.0) d2)
(let ((d3 (make-moving-average 4 :initial-contents '(0.7 0.5 0.1 4)))) (moving-average d3 1.0) d3))
(test-gen-equal (make-moving-average 3 :initial-element 1.0)
(make-moving-average 3 :initial-element 1.0)
@@ -12303,7 +12038,7 @@ EDITS: 2
(if (fneq val 1.0) (snd-display "max initial-contents: ~A" val)))
(test-gen-equal (let ((d1 (make-moving-max 3 :initial-contents '(0.7 0.5 3)))) (moving-max d1 1.0) d1)
- (let ((d2 (make-moving-max 3 :initial-contents (float-vector 0.7 0.5 3)))) (moving-max d2 1.0) d2)
+ (let ((d2 (make-moving-max 3 :initial-contents #r(0.7 0.5 3)))) (moving-max d2 1.0) d2)
(let ((d3 (make-moving-max 4 :initial-contents '(0.7 0.5 0.1 4)))) (moving-max d3 1.0) d3))
(test-gen-equal (make-moving-max 3 :initial-element 1.0)
(make-moving-max 3 :initial-element 1.0)
@@ -12412,7 +12147,7 @@ EDITS: 2
(do ((v0 (make-float-vector 5))
(i 0 (+ i 1)))
((= i 5)
- (if (not (mus-arrays-equal? v0 (float-vector 0.600 0.400 0.000 0.000 0.000))) ; this is assuming interpolation in the delay...
+ (if (not (mus-arrays-equal? v0 #r(0.600 0.400 0.000 0.000 0.000))) ; this is assuming interpolation in the delay...
(snd-display "zcomb: ~A" v0)))
(set! (v0 i) (comb del 0.0 0.4)))
(comb del 1.0)
@@ -12423,19 +12158,17 @@ EDITS: 2
(if (fneq (mus-feedback del) 1.0)
(snd-display "comb feedback set: ~A" (mus-feedback del))))
-
(let ((gen (make-filtered-comb .4 5 :filter (make-one-zero .3 .7))))
(print-and-check gen
"filtered-comb"
"filtered-comb scaler: 0.400, line[5, step]: [0 0 0 0 0], filter: [one-zero a0: 0.300, a1: 0.700, x1: 0.000]")
- (let ((v0 (make-float-vector 20)))
- (do ((val 1.0)
- (i 0 (+ i 1)))
- ((= i 20))
- (set! (v0 i) (filtered-comb gen val))
- (set! val 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.120 0.280 0.000 0.000 0.000 0.014 0.067 0.078 0.000 0.000)))
- (snd-display "filtered-comb: ~A" v0)))
+ (do ((v0 (make-float-vector 20))
+ (val 1.0 0.0)
+ (i 0 (+ i 1)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.120 0.280 0.000 0.000 0.000 0.014 0.067 0.078 0.000 0.000)))
+ (snd-display "filtered-comb: ~A" v0)))
+ (set! (v0 i) (filtered-comb gen val)))
(if (not (filtered-comb? gen)) (snd-display "~A not filtered-comb?" gen))
(if (not (= (mus-length gen) 5)) (snd-display "filtered-comb length: ~D?" (mus-length gen)))
(if (not (= (mus-order gen) 5)) (snd-display "filtered-comb order: ~D?" (mus-order gen)))
@@ -12446,25 +12179,23 @@ EDITS: 2
(print-and-check gen
"filtered-comb"
"filtered-comb scaler: 0.900, line[5, step]: [0 0 0 0 0], filter: [one-zero a0: 0.500, a1: 0.500, x1: 0.000]")
- (do ((val 1.0)
+ (do ((val 1.0 0.0)
(i 0 (+ i 1)))
((= i 20))
- (set! (v0 i) (filtered-comb gen val))
- (set! val 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.450 0.450 0.000 0.000 0.000 0.202 0.405 0.202 0.000 0.000)))
+ (set! (v0 i) (filtered-comb gen val)))
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.450 0.450 0.000 0.000 0.000 0.202 0.405 0.202 0.000 0.000)))
(snd-display "filtered-comb .5 .5: ~A" v0)))
- (let ((gen (make-filtered-comb .9 5 :filter (make-fir-filter 5 (float-vector .1 .2 .3 .2 .1))))
+ (let ((gen (make-filtered-comb .9 5 :filter (make-fir-filter 5 #r(.1 .2 .3 .2 .1))))
(v0 (make-float-vector 20)))
(print-and-check gen
"filtered-comb"
"filtered-comb scaler: 0.900, line[5, step]: [0 0 0 0 0], filter: [fir-filter order: 5, xs: [0.1 0.2 0.3 0.2 0.1]]")
- (do ((val 1.0)
+ (do ((val 1.0 0.0)
(i 0 (+ i 1)))
((= i 20))
- (set! (v0 i) (filtered-comb gen val))
- (set! val 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.090 0.180 0.270 0.180 0.090 0.008 0.032 0.081 0.130 0.154)))
+ (set! (v0 i) (filtered-comb gen val)))
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.090 0.180 0.270 0.180 0.090 0.008 0.032 0.081 0.130 0.154)))
(snd-display "filtered-comb fir: ~A" v0)))
(test-gen-equal (let ((d1 (make-filtered-comb 0.7 3 :filter (make-one-pole .3 .7)))) (filtered-comb d1 1.0) d1)
@@ -12486,7 +12217,7 @@ EDITS: 2
(do ((v0 (make-float-vector 5))
(i 0 (+ i 1)))
((= i 5)
- (if (not (mus-arrays-equal? v0 (float-vector 0.600 0.400 0.000 0.000 0.000))) ; this is assuming interpolation in the delay...
+ (if (not (mus-arrays-equal? v0 #r(0.600 0.400 0.000 0.000 0.000))) ; this is assuming interpolation in the delay...
(snd-display "zfiltered-comb: ~A" v0)))
(set! (v0 i) (filtered-comb del 0.0 0.4)))
(filtered-comb del 1.0)
@@ -12498,7 +12229,6 @@ EDITS: 2
(if (fneq (mus-feedback del) 1.0)
(snd-display "filtered-comb feedback set: ~A" (mus-feedback del))))
-
(let ((gen (make-notch .4 3))
(v0 (make-float-vector 10)))
(print-and-check gen "notch" "notch scaler: 0.400, line[3, step]: [0 0 0]")
@@ -12534,379 +12264,342 @@ EDITS: 2
;; make sure all-pass is the same as comb/notch given the appropriate feedback/forward settings
- (let ((gen (make-comb 0.5 5))
- (v0 (make-float-vector 11))
- (in1 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 11))
- (set! (v0 i) (comb gen in1))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
- (snd-display "comb (5 .5): ~A" v0)))
-
- (let ((gen (make-all-pass 0.5 0.0 5))
- (v0 (make-float-vector 11))
- (in1 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 11))
- (set! (v0 i) (all-pass gen in1))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
- (snd-display "all-pass (5 0 .5): ~A" v0)))
-
- (let ((gen (make-notch 0.5 5))
- (v0 (make-float-vector 11))
- (in1 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 11))
- (set! (v0 i) (notch gen in1))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display "notch (5 .5): ~A" v0)))
-
- (let ((gen (make-all-pass 0.0 0.5 5))
- (v0 (make-float-vector 11))
- (in1 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 11))
- (set! (v0 i) (all-pass gen in1))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display "all-pass (5 .5 0): ~A" v0)))
+ (do ((gen (make-comb 0.5 5))
+ (v0 (make-float-vector 11))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1)))
+ ((= i 11)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
+ (snd-display "comb (5 .5): ~A" v0)))
+ (set! (v0 i) (comb gen in1)))
- ;; make sure zall-pass is the same as zcomb/znotch given the appropriate feedback/forward and "pm" settings
+ (do ((gen (make-all-pass 0.5 0.0 5))
+ (v0 (make-float-vector 11))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1)))
+ ((= i 11)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
+ (snd-display "all-pass (5 0 .5): ~A" v0)))
+ (set! (v0 i) (all-pass gen in1)))
- (let ((gen (make-comb 0.5 5 :max-size 20))
- (v0 (make-float-vector 11))
- (in1 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 11))
- (set! (v0 i) (comb gen in1))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
- (snd-display "1comb (5 .5): ~A" v0)))
-
- (let ((gen (make-all-pass 0.5 0.0 5 :max-size 20))
- (v0 (make-float-vector 11))
- (in1 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 11))
- (set! (v0 i) (all-pass gen in1))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
- (snd-display "1all-pass (5 0 .5): ~A" v0)))
-
- (let ((gen (make-notch 0.5 5 :max-size 20))
- (v0 (make-float-vector 11))
- (in1 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 11))
- (set! (v0 i) (notch gen in1))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display "1notch (5 .5): ~A" v0)))
-
- (let ((gen (make-all-pass 0.0 0.5 5 :max-size 20))
- (v0 (make-float-vector 11))
- (in1 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 11))
- (set! (v0 i) (all-pass gen in1))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display "1all-pass (5 .5 0): ~A" v0)))
+ (do ((gen (make-notch 0.5 5))
+ (v0 (make-float-vector 11))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1)))
+ ((= i 11)
+ (if (not (mus-arrays-equal? v0 #r(0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display "notch (5 .5): ~A" v0)))
+ (set! (v0 i) (notch gen in1)))
- ;; now actually use the size difference
+ (do ((gen (make-all-pass 0.0 0.5 5))
+ (v0 (make-float-vector 11))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1)))
+ ((= i 11)
+ (if (not (mus-arrays-equal? v0 #r(0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display "all-pass (5 .5 0): ~A" v0)))
+ (set! (v0 i) (all-pass gen in1)))
- (let ((gen (make-comb 0.5 5 :max-size 20))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (phase 0.0 (+ phase .2)))
- ((= i 20))
- (set! (v0 i) (comb gen in1 phase))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.160 0.360 0.200 0.040 0.000 0.000 0.000)))
- (snd-display "2comb (5 .5): ~A" v0)))
-
- (let ((gen (make-all-pass 0.5 0.0 5 :max-size 20))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (+ angle .2)))
- ((= i 20))
- (set! (v0 i) (all-pass gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.160 0.360 0.200 0.040 0.000 0.000 0.000)))
- (snd-display "2all-pass (5 0 .5): ~A" v0)))
-
- (let ((gen (make-notch 0.5 5 :max-size 20))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (+ angle .2)))
- ((= i 20))
- (set! (v0 i) (notch gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.500 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display "2notch (5 .5): ~A" v0)))
-
- (let ((gen (make-all-pass 0.0 0.5 5 :max-size 20))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (+ angle .2)))
- ((= i 20))
- (set! (v0 i) (all-pass gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.500 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display "2all-pass (5 .5 0): ~A" v0)))
-
- (let ((gen (make-comb 0.5 5 :max-size 20))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (- angle .2)))
- ((= i 20))
- (set! (v0 i) (comb gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.800 0.000 0.000 0.160 0.160 0.000 0.080 0.064 0.016 0.035 0.013 0.018 0.007 0.007 0.003 0.002)))
- (snd-display "3comb (5 .5): ~A" v0)))
-
- (let ((gen (make-all-pass 0.5 0.0 5 :max-size 20))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (- angle .2)))
- ((= i 20))
- (set! (v0 i) (all-pass gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.800 0.000 0.000 0.160 0.160 0.000 0.080 0.064 0.016 0.035 0.013 0.018 0.007 0.007 0.003 0.002)))
- (snd-display "3all-pass (5 0 .5): ~A" v0)))
-
- (let ((gen (make-notch 0.5 5 :max-size 20))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (- angle .2)))
- ((= i 20))
- (set! (v0 i) (notch gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.500 0.000 0.000 0.000 0.800 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display "3notch (5 .5): ~A" v0)))
-
- (let ((gen (make-all-pass 0.0 0.5 5 :max-size 20))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (- angle .2)))
- ((= i 20))
- (set! (v0 i) (all-pass gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.500 0.000 0.000 0.000 0.800 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display "3all-pass (5 .5 0): ~A" v0)))
-
- (let ((gen (make-comb 0.5 5 :max-size 20))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (+ angle .01)))
- ((= i 20))
- (set! (v0 i) (comb gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.428 0.079 0.004 0.000 0.000 0.182 0.067 0.008 0.000 0.000)))
- (snd-display "4comb (5 .5): ~A" v0)))
-
- (let ((gen (make-all-pass 0.5 0.0 5 :max-size 20))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (+ angle .01)))
- ((= i 20))
- (set! (v0 i) (all-pass gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.428 0.079 0.004 0.000 0.000 0.182 0.067 0.008 0.000 0.000)))
- (snd-display "4all-pass (5 0 .5): ~A" v0)))
-
- (let ((gen (make-notch 0.5 5 :max-size 20))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (+ angle .01)))
- ((= i 20))
- (set! (v0 i) (notch gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.500 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display "4notch (5 .5): ~A" v0)))
-
- (let ((gen (make-all-pass 0.0 0.5 5 :max-size 20))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (+ angle .01)))
- ((= i 20))
- (set! (v0 i) (all-pass gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.500 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display "4all-pass (5 .5 0): ~A" v0)))
+ ;; make sure zall-pass is the same as zcomb/znotch given the appropriate feedback/forward and "pm" settings
- ;; now run off either end of the delay line "by accident"
+ (do ((gen (make-comb 0.5 5 :max-size 20))
+ (v0 (make-float-vector 11))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1)))
+ ((= i 11)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
+ (snd-display "1comb (5 .5): ~A" v0)))
+ (set! (v0 i) (comb gen in1)))
- (let ((gen (make-comb 0.5 5 :max-size 10))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (+ angle .5)))
- ((= i 20))
- (set! (v0 i) (comb gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.250 0.125 0.094 0.062 0.055 0.047 0.039 0.031 0.029)))
- (snd-display "5comb (5 .5): ~A" v0)))
-
- (let ((gen (make-all-pass 0.5 0.0 5 :max-size 10))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (+ angle .5)))
- ((= i 20))
- (set! (v0 i) (all-pass gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.250 0.125 0.094 0.062 0.055 0.047 0.039 0.031 0.029)))
- (snd-display "5all-pass (5 0 .5): ~A" v0)))
-
- (let ((gen (make-notch 0.5 5 :max-size 10))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (+ angle .5)))
- ((= i 20))
- (set! (v0 i) (notch gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display "5notch (5 .5): ~A" v0)))
-
- (let ((gen (make-all-pass 0.0 0.5 5 :max-size 10))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (+ angle .5)))
- ((= i 20))
- (set! (v0 i) (all-pass gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display "5all-pass (5 .5 0): ~A" v0)))
+ (do ((gen (make-all-pass 0.5 0.0 5 :max-size 20))
+ (v0 (make-float-vector 11))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1)))
+ ((= i 11)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
+ (snd-display "1all-pass (5 0 .5): ~A" v0)))
+ (set! (v0 i) (all-pass gen in1)))
+ (do ((gen (make-notch 0.5 5 :max-size 20))
+ (v0 (make-float-vector 11))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1)))
+ ((= i 11)
+ (if (not (mus-arrays-equal? v0 #r(0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display "1notch (5 .5): ~A" v0)))
+ (set! (v0 i) (notch gen in1)))
- (let ((gen (make-comb 0.5 5 :max-size 10))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (- angle .5)))
- ((= i 20))
- (set! (v0 i) (comb gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.500 0.000 0.125 0.000 0.031 0.016 0.004 1.000 0.000 0.250 0.031 0.000 0.012 0.002 0.250 0.125 0.008)))
- (snd-display "6comb (5 .5): ~A" v0)))
-
- (let ((gen (make-all-pass 0.5 0.0 5 :max-size 10))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (- angle .5)))
- ((= i 20))
- (set! (v0 i) (all-pass gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.500 0.000 0.125 0.000 0.031 0.016 0.004 1.000 0.000 0.250 0.031 0.000 0.012 0.002 0.250 0.125 0.008)))
- (snd-display "6all-pass (5 0 .5): ~A" v0)))
-
- (let ((gen (make-notch 0.5 5 :max-size 10))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (- angle .5)))
- ((= i 20))
- (set! (v0 i) (notch gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.500 0.000 0.000 0.500 0.000 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display "6notch (5 .5): ~A" v0)))
-
- (let ((gen (make-all-pass 0.0 0.5 5 :max-size 10))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (- angle .5)))
- ((= i 20))
- (set! (v0 i) (all-pass gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.500 0.000 0.000 0.500 0.000 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display "6all-pass (5 .5 0): ~A" v0)))
-
- (let ((gen (make-filtered-comb 0.5 5 :filter (make-one-zero .5 .5)))
- (v0 (make-float-vector 21))
- (in1 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 21))
- (set! (v0 i) (filtered-comb gen in1))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.250 0.250
- 0.000 0.000 0.000 0.062 0.125 0.062 0.000 0.000 0.016)))
- (snd-display "filtered-comb (5 .5): ~A" v0)))
-
- (let ((gen (make-filtered-comb 0.5 5 :filter (make-one-zero .25 .75)))
- (v0 (make-float-vector 21))
- (in1 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 21))
- (set! (v0 i) (filtered-comb gen in1))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.125 0.375
- 0.000 0.000 0.000 0.016 0.094 0.141 0.000 0.000 0.002)))
- (snd-display "1filtered-comb (5 .5): ~A" v0)))
-
- (let ((gen (make-filtered-comb 0.5 5 :filter (make-one-zero .25 .75)))
- (v0 (make-float-vector 21))
- (in1 1.0))
- (do ((i 0 (+ i 1)))
- ((= i 21))
- (set! (v0 i) (filtered-comb gen in1))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.125 0.375
- 0.000 0.000 0.000 0.016 0.094 0.141 0.000 0.000 0.002)))
- (snd-display "1run-filtered-comb (5 .5): ~A" v0)))
-
- (let ((gen (make-filtered-comb 0.5 5 :max-size 20 :filter (make-one-zero .5 .5)))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (+ angle .2)))
- ((= i 20))
- (set! (v0 i) (filtered-comb gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.080 0.220 0.300 0.140 0.040 0.000 0.000)))
- (snd-display "2filtered-comb (5 .5): ~A" v0)))
-
- (let ((gen (make-filtered-comb 0.5 5 :max-size 20 :filter (make-one-zero .5 .5)))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (- angle .2)))
- ((= i 20))
- (set! (v0 i) (filtered-comb gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.800 0.000 0.000 0.080 0.200 0.040 0.020 0.068 0.042 0.019 0.026 0.015 0.011 0.009 0.006 0.004)))
- (snd-display "3filtered-comb (5 .5): ~A" v0)))
-
- (let ((gen (make-filtered-comb 0.5 5 :max-size 20 :filter (make-one-zero .5 .5)))
- (v0 (make-float-vector 20))
- (in1 1.0))
- (do ((i 0 (+ i 1))
- (angle 0.0 (+ angle .01)))
- ((= i 20))
- (set! (v0 i) (filtered-comb gen in1 angle))
- (set! in1 0.0))
- (if (not (mus-arrays-equal? v0 (float-vector 0.000 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.214 0.251 0.043 0.002 0.000 0.045 0.106 0.081 0.023 0.003)))
- (snd-display "4filtered-comb (5 .5): ~A" v0)))
+ (do ((gen (make-all-pass 0.0 0.5 5 :max-size 20))
+ (v0 (make-float-vector 11))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1)))
+ ((= i 11)
+ (if (not (mus-arrays-equal? v0 #r(0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display "1all-pass (5 .5 0): ~A" v0)))
+ (set! (v0 i) (all-pass gen in1)) )
+ ;; now actually use the size difference
+
+ (do ((gen (make-comb 0.5 5 :max-size 20))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (phase 0.0 (+ phase .2)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.160 0.360 0.200 0.040 0.000 0.000 0.000)))
+ (snd-display "2comb (5 .5): ~A" v0)))
+ (set! (v0 i) (comb gen in1 phase)))
+
+ (do ((gen (make-all-pass 0.5 0.0 5 :max-size 20))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (+ angle .2)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.160 0.360 0.200 0.040 0.000 0.000 0.000)))
+ (snd-display "2all-pass (5 0 .5): ~A" v0)))
+ (set! (v0 i) (all-pass gen in1 angle)))
+
+ (do ((gen (make-notch 0.5 5 :max-size 20))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (+ angle .2)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.500 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display "2notch (5 .5): ~A" v0)))
+ (set! (v0 i) (notch gen in1 angle)))
+
+ (do ((gen (make-all-pass 0.0 0.5 5 :max-size 20))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (+ angle .2)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.500 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display "2all-pass (5 .5 0): ~A" v0)))
+ (set! (v0 i) (all-pass gen in1 angle)))
+
+ (do ((gen (make-comb 0.5 5 :max-size 20))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (- angle .2)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.800 0.000 0.000 0.160 0.160 0.000 0.080 0.064 0.016 0.035 0.013 0.018 0.007 0.007 0.003 0.002)))
+ (snd-display "3comb (5 .5): ~A" v0)))
+ (set! (v0 i) (comb gen in1 angle)))
+
+ (do ((gen (make-all-pass 0.5 0.0 5 :max-size 20))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (- angle .2)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.800 0.000 0.000 0.160 0.160 0.000 0.080 0.064 0.016 0.035 0.013 0.018 0.007 0.007 0.003 0.002)))
+ (snd-display "3all-pass (5 0 .5): ~A" v0)))
+ (set! (v0 i) (all-pass gen in1 angle)))
+
+ (do ((gen (make-notch 0.5 5 :max-size 20))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (- angle .2)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.500 0.000 0.000 0.000 0.800 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display "3notch (5 .5): ~A" v0)))
+ (set! (v0 i) (notch gen in1 angle)))
+
+ (do ((gen (make-all-pass 0.0 0.5 5 :max-size 20))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (- angle .2)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.500 0.000 0.000 0.000 0.800 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display "3all-pass (5 .5 0): ~A" v0)))
+ (set! (v0 i) (all-pass gen in1 angle)))
+
+ (do ((gen (make-comb 0.5 5 :max-size 20))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (+ angle .01)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.428 0.079 0.004 0.000 0.000 0.182 0.067 0.008 0.000 0.000)))
+ (snd-display "4comb (5 .5): ~A" v0)))
+ (set! (v0 i) (comb gen in1 angle)))
+
+ (do ((gen (make-all-pass 0.5 0.0 5 :max-size 20))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (+ angle .01)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.428 0.079 0.004 0.000 0.000 0.182 0.067 0.008 0.000 0.000)))
+ (snd-display "4all-pass (5 0 .5): ~A" v0)))
+ (set! (v0 i) (all-pass gen in1 angle)))
+
+ (do ((gen (make-notch 0.5 5 :max-size 20))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (+ angle .01)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.500 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display "4notch (5 .5): ~A" v0)))
+ (set! (v0 i) (notch gen in1 angle)))
+
+ (do ((gen (make-all-pass 0.0 0.5 5 :max-size 20))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (+ angle .01)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.500 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display "4all-pass (5 .5 0): ~A" v0)))
+ (set! (v0 i) (all-pass gen in1 angle)))
+ ;; now run off either end of the delay line "by accident"
+
+ (do ((gen (make-comb 0.5 5 :max-size 10))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (+ angle .5)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.250 0.125 0.094 0.062 0.055 0.047 0.039 0.031 0.029)))
+ (snd-display "5comb (5 .5): ~A" v0)))
+ (set! (v0 i) (comb gen in1 angle)))
+
+ (do ((gen (make-all-pass 0.5 0.0 5 :max-size 10))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (+ angle .5)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.250 0.125 0.094 0.062 0.055 0.047 0.039 0.031 0.029)))
+ (snd-display "5all-pass (5 0 .5): ~A" v0)))
+ (set! (v0 i) (all-pass gen in1 angle)))
+
+ (do ((gen (make-notch 0.5 5 :max-size 10))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (+ angle .5)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display "5notch (5 .5): ~A" v0)))
+ (set! (v0 i) (notch gen in1 angle)))
+
+ (do ((gen (make-all-pass 0.0 0.5 5 :max-size 10))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (+ angle .5)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display "5all-pass (5 .5 0): ~A" v0)))
+ (set! (v0 i) (all-pass gen in1 angle)))
+
+ (do ((gen (make-comb 0.5 5 :max-size 10))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (- angle .5)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.500 0.000 0.125 0.000 0.031 0.016 0.004 1.000 0.000 0.250 0.031 0.000 0.012 0.002 0.250 0.125 0.008)))
+ (snd-display "6comb (5 .5): ~A" v0)))
+ (set! (v0 i) (comb gen in1 angle)))
+
+ (do ((gen (make-all-pass 0.5 0.0 5 :max-size 10))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (- angle .5)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.500 0.000 0.125 0.000 0.031 0.016 0.004 1.000 0.000 0.250 0.031 0.000 0.012 0.002 0.250 0.125 0.008)))
+ (snd-display "6all-pass (5 0 .5): ~A" v0)))
+ (set! (v0 i) (all-pass gen in1 angle)))
+
+ (do ((gen (make-notch 0.5 5 :max-size 10))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (- angle .5)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.500 0.000 0.000 0.500 0.000 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display "6notch (5 .5): ~A" v0)))
+ (set! (v0 i) (notch gen in1 angle)))
+
+ (do ((gen (make-all-pass 0.0 0.5 5 :max-size 10))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (- angle .5)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.500 0.000 0.000 0.500 0.000 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display "6all-pass (5 .5 0): ~A" v0)))
+ (set! (v0 i) (all-pass gen in1 angle)))
+
+ (do ((gen (make-filtered-comb 0.5 5 :filter (make-one-zero .5 .5)))
+ (v0 (make-float-vector 21))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1)))
+ ((= i 21)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.250 0.250
+ 0.000 0.000 0.000 0.062 0.125 0.062 0.000 0.000 0.016)))
+ (snd-display "filtered-comb (5 .5): ~A" v0)))
+ (set! (v0 i) (filtered-comb gen in1)))
+
+ (do ((gen (make-filtered-comb 0.5 5 :filter (make-one-zero .25 .75)))
+ (v0 (make-float-vector 21))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1)))
+ ((= i 21)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.125 0.375
+ 0.000 0.000 0.000 0.016 0.094 0.141 0.000 0.000 0.002)))
+ (snd-display "1filtered-comb (5 .5): ~A" v0)))
+ (set! (v0 i) (filtered-comb gen in1)))
+
+ (do ((gen (make-filtered-comb 0.5 5 :filter (make-one-zero .25 .75)))
+ (v0 (make-float-vector 21))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1)))
+ ((= i 21)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.125 0.375
+ 0.000 0.000 0.000 0.016 0.094 0.141 0.000 0.000 0.002)))
+ (snd-display "1run-filtered-comb (5 .5): ~A" v0)))
+ (set! (v0 i) (filtered-comb gen in1)))
+
+ (do ((gen (make-filtered-comb 0.5 5 :max-size 20 :filter (make-one-zero .5 .5)))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (+ angle .2)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.080 0.220 0.300 0.140 0.040 0.000 0.000)))
+ (snd-display "2filtered-comb (5 .5): ~A" v0)))
+ (set! (v0 i) (filtered-comb gen in1 angle)))
+
+ (do ((gen (make-filtered-comb 0.5 5 :max-size 20 :filter (make-one-zero .5 .5)))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (- angle .2)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.800 0.000 0.000 0.080 0.200 0.040 0.020 0.068 0.042 0.019 0.026 0.015 0.011 0.009 0.006 0.004)))
+ (snd-display "3filtered-comb (5 .5): ~A" v0)))
+ (set! (v0 i) (filtered-comb gen in1 angle)))
+
+ (do ((gen (make-filtered-comb 0.5 5 :max-size 20 :filter (make-one-zero .5 .5)))
+ (v0 (make-float-vector 20))
+ (in1 1.0 0.0)
+ (i 0 (+ i 1))
+ (angle 0.0 (+ angle .01)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.000 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.214 0.251 0.043 0.002 0.000 0.045 0.106 0.081 0.023 0.003)))
+ (snd-display "4filtered-comb (5 .5): ~A" v0)))
+ (set! (v0 i) (filtered-comb gen in1 angle)))
(let ((gen (make-one-pole .4 .7))
(v0 (make-float-vector 10)))
@@ -13108,15 +12801,155 @@ EDITS: 2
(mus-arrays-equal? v2 v1)))
(format *stderr* ":orig: ~A~%; v1: ~A~%; v2: ~A~%" v v1 v2))))))
(test-fm-components)
- (osc-opt)
- (nrxysin-opt)
- (polywave-opt)
- (do ((i 1 (+ i 1)))
- ((= i 6))
- (test-simple-polywave i #f mus-chebyshev-first-kind)
- (test-simple-polywave i .1 mus-chebyshev-first-kind)
- (test-simple-polywave i #f mus-chebyshev-second-kind)
- (test-simple-polywave i .1 mus-chebyshev-second-kind))
+
+ ;; osc-opt
+ (let ((g1 (make-oscil 1000))
+ (g2 (make-oscil 1000))
+ (g3 (make-oscil 1000))
+ (g4 (make-oscil 1000))
+ (g5 (make-oscil 1000))
+ (g6 (make-oscil 1000))
+ (x1 1.0)
+ (x2 (hz->radians 100.0))
+ (x4 (hz->radians 5.0)))
+ (do ((x1x2 (* x1 x2))
+ (x420 (* 20 x4))
+ (i 0 (+ i 1)))
+ ((= i 50))
+ (let ((o1 (oscil g1 x2))
+ (o2 (* 1.0 (oscil g2 x2)))
+ (o3 (oscil g3 x420))
+ (o4 (oscil g4 x420))
+ (o5 (oscil g5 x1x2))
+ (o6 (* 1.0 (oscil g6 x420))))
+ (if (> (abs (- (+ o2 o3 o4 o5 o6) (* 5 o1))) 1e-6)
+ (snd-display "~A: ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F" i o1 o2 o3 o4 o5 o6)))))
+
+ ;; nrxysin-opt)
+ (let ((g1 (make-nrxysin 1000 :n 10 :r .9))
+ (g2 (make-nrxysin 1000 :n 10 :r .9))
+ (g3 (make-nrxysin 1000 :n 10 :r .9))
+ (g4 (make-nrxysin 1000 :n 10 :r .9))
+ (g5 (make-nrxysin 1000 :n 10 :r .9))
+ (g6 (make-nrxysin 1000 :n 10 :r .9))
+ (x1 1.0)
+ (x2 (hz->radians 100.0))
+ (x4 (hz->radians 5.0)))
+ (do ((x1x2 (* x1 x2))
+ (x420 (* 20 x4))
+ (i 0 (+ i 1)))
+ ((= i 50))
+ (let ((o1 (nrxysin g1 x2))
+ (o2 (* 1.0 (nrxysin g2 x2)))
+ (o3 (nrxysin g3 x420))
+ (o4 (nrxysin g4 x420))
+ (o5 (nrxysin g5 x1x2))
+ (o6 (nrxysin g6 x420)))
+ (if (> (abs (- (+ o2 o3 o4 o5 o6) (* 5 o1))) 1e-6)
+ (format () "~A: ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F~%" i o1 o2 o3 o4 o5 o6)))))
+
+ ;; polywave-opt
+ (let ((g1 (make-polywave 1000 '(1 .5 2 .5)))
+ (g2 (make-polywave 1000 '(1 .5 2 .5)))
+ (g3 (make-polywave 1000 '(1 .5 2 .5)))
+ (g4 (make-polywave 1000 '(1 .5 2 .5)))
+ (g5 (make-polywave 1000 '(1 .5 2 .5)))
+ (g6 (make-polywave 1000 '(1 .5 2 .5)))
+ (x1 1.0)
+ (x2 (hz->radians 100.0))
+ (x4 (hz->radians 5.0)))
+ (do ((x1x2 (* x1 x2))
+ (x420 (* 20 x4))
+ (i 0 (+ i 1)))
+ ((= i 50))
+ (let ((o1 (polywave g1 x2))
+ (o2 (* 1.0 (polywave g2 x2)))
+ (o3 (polywave g3 x420))
+ (o4 (polywave g4 x420))
+ (o5 (polywave g5 x1x2))
+ (o6 (* 1.0 (polywave g6 x420))))
+ (if (> (abs (- (+ o2 o3 o4 o5 o6) (* 5 o1))) 1e-6)
+ (format () "~A: ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F~%" i o1 o2 o3 o4 o5 o6)))))
+
+ (let ((test-simple-polywave
+ (lambda (n offset kind)
+ (let ((p (do ((h (if offset (list offset 0) ()))
+ (i 1 (+ i 1)))
+ ((> i n)
+ (make-polywave 400.0 (reverse h) kind))
+ (set! h (cons (* i .1) (cons i h)))))
+ (vp (make-float-vector 200))
+ (vo (make-float-vector 200))
+ (ob (make-oscil-bank
+ (apply float-vector (do ((frqs (if offset (list 0.0) ()))
+ (i 1 (+ i 1)))
+ ((> i n)
+ (reverse frqs))
+ (set! frqs (cons (hz->radians (* i 400.0)) frqs))))
+ (let ((phases (make-float-vector (if offset (+ n 1) n)
+ (if (= kind mus-chebyshev-second-kind) 0.0 (/ pi 2)))))
+ (if (and offset (= kind mus-chebyshev-second-kind))
+ (set! (phases 0) (/ pi 2)))
+ phases)
+ (apply float-vector (do ((amps (if offset (list offset) ()))
+ (i 1 (+ i 1)))
+ ((> i n)
+ (reverse amps))
+ (set! amps (cons (* i .1) amps))))
+ #t)))
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (float-vector-set! vp i (polywave p)))
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (float-vector-set! vo i (oscil-bank ob)))
+ (if (not (mus-arrays-equal? vp vo))
+ (format *stderr* ";simple polywave ~A ~A ~A: ~A~% ~A~% ~A~%~A ~A~%"
+ n offset (if (= kind mus-chebyshev-first-kind) 'first 'second)
+ (float-vector-peak (float-vector-subtract! (copy vp) vo))
+ vp vo
+ p ob))
+
+ (let ((temp 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (set! temp (polywave p))
+ (vector-set! vp i temp)
+ (set! (vo i) (oscil-bank ob)))
+ (if (not (mus-arrays-equal? vp vo))
+ (format *stderr* ";simple polywave (temps) ~A ~A ~A: ~A~% ~A~% ~A~%~A ~A~%"
+ n offset (if (= kind mus-chebyshev-first-kind) 'first 'second)
+ (float-vector-peak (float-vector-subtract! (copy vp) vo))
+ vp vo
+ p ob)))
+
+ (let ((t1 (find-sound (with-sound ("test.snd")
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (outa i (polywave p))))))
+ (t2 (find-sound (with-sound ("tst.snd")
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (outa i (oscil-bank ob)))))))
+ (set! vp (channel->float-vector 0 200 t1 0))
+ (set! vo (channel->float-vector 0 200 t2 0))
+
+ (if (not (mus-arrays-equal? vp vo))
+ (format *stderr* ";simple polywave (with-sound) n: ~A, offset: ~A, type: ~A (len: ~D ~D): dist: ~A~% ~A~% ~A~%~A ~A~%"
+ n offset (if (= kind mus-chebyshev-first-kind) 'first 'second)
+ (length vp) (length vo)
+ (float-vector-peak (float-vector-subtract! (copy vp) vo))
+ vp vo
+ p ob))
+ (close-sound t1)
+ (close-sound t2))))))
+
+ (do ((i 1 (+ i 1)))
+ ((= i 6))
+ (test-simple-polywave i #f mus-chebyshev-first-kind)
+ (test-simple-polywave i .1 mus-chebyshev-first-kind)
+ (test-simple-polywave i #f mus-chebyshev-second-kind)
+ (test-simple-polywave i .1 mus-chebyshev-second-kind)))
(do ((gen1 (make-oscil 100.0))
(gen2 (make-oscil -100.0))
@@ -13136,9 +12969,9 @@ EDITS: 2
(snd-display "cosil +-: ~A" mx)))
(set! mx (max mx (abs (- (gen1) (gen2))))))
- (let ((frqs (float-vector 0.0 0.0))
- (amps (float-vector 0.0 0.0))
- (phs (float-vector 0.0 0.0)))
+ (let ((frqs #r(0.0 0.0))
+ (amps #r(0.0 0.0))
+ (phs #r(0.0 0.0)))
(let ((ob (make-oscil-bank frqs phs amps)))
(if (not (oscil-bank? ob)) (snd-display "oscil-bank? ~A" ob))
(if (not (morally-equal? (mus-data ob) phs)) (snd-display "oscil-bank data: ~A ~A" (mus-data ob) phs))
@@ -13208,37 +13041,40 @@ EDITS: 2
(do ((gen (make-oscil 440.0 :initial-phase (* pi 0.5)))
(incr (/ (* 2 pi 440.0) 22050.0))
(i 0 (+ i 1))
- (a 0.0 (+ a incr)))
+ (a 0.0))
((= i 900))
(let ((val1 (cos a))
(val2 (gen 0.0)))
(if (fneq val1 val2)
- (snd-display "oscil (cos): ~A: ~A ~A" i val1 val2))))
+ (snd-display "oscil (cos): ~A: ~A ~A" i val1 val2)))
+ (set! a (+ a incr)))
(do ((gen (make-oscil 0.0))
(gen1 (make-oscil 40.0))
(incr (/ (* 2 pi 40.0) 22050.0))
(i 0 (+ i 1))
- (a 0.0 (+ a incr)))
+ (a 0.0))
((= i 1100))
(let ((val1 (sin (sin a)))
(val2 (oscil gen 0.0 (oscil gen1 0.0))))
(if (fneq val1 val2)
- (snd-display "oscil pm: ~A: ~A ~A" i val1 val2))))
+ (snd-display "oscil pm: ~A: ~A ~A" i val1 val2)))
+ (set! a (+ a incr)))
(do ((gen (make-oscil 0.0))
(gen1 (make-oscil 40.0))
(incr (/ (* 2 pi 40.0) 22050.0))
(a1 0.0)
(i 0 (+ i 1))
- (a 0.0 (+ a incr)))
+ (a 0.0))
((= i 100))
(let ((fm (sin a))
(val1 (sin a1))
(val2 (oscil gen (oscil gen1 0.0))))
(set! a1 (+ a1 fm))
(if (fneq val1 val2)
- (snd-display "oscil fm: ~A: ~A ~A" i val1 val2))))
+ (snd-display "oscil fm: ~A: ~A ~A" i val1 val2))
+ (set! a (+ a incr))))
(let ()
(define (oscil-1-1)
@@ -13409,10 +13245,32 @@ EDITS: 2
(snd-display "ncos +-: ~A" mx)))
(set! mx (max mx (abs (- (gen1) (gen2))))))
- (test-simple-ncos 1)
- (test-simple-ncos 3)
- (test-simple-ncos 10)
-
+ (for-each (lambda (n)
+ (let ((p (make-ncos 400.0 n))
+ (vp (make-float-vector 200))
+ (vo (make-float-vector 200)))
+ (let ((ob (make-oscil-bank
+ (apply float-vector (do ((frqs ())
+ (i 1 (+ i 1)))
+ ((> i n)
+ (reverse frqs))
+ (set! frqs (cons (hz->radians (* i 400.0)) frqs))))
+ (make-float-vector n (/ pi 2.0))
+ (make-float-vector n (mus-scaler p))
+ #t)))
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (float-vector-set! vp i (ncos p)))
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (float-vector-set! vo i (oscil-bank ob)))
+ (if (not (mus-arrays-equal? vp vo))
+ (format *stderr* ";simple ncos ~A: ~A~% ~A~% ~A~%~A ~A~%"
+ n
+ (float-vector-peak (float-vector-subtract! (copy vp) vo))
+ vp vo
+ p ob)))))
+ '(1 3 10))
(let ((gen (make-nsin 440.0 10))
(v0 (make-float-vector 10)))
@@ -13448,11 +13306,31 @@ EDITS: 2
(if (fneq mx 0.0)
(snd-display "nsin +-: ~A" mx)))
(set! mx (max mx (abs (+ (gen1) (gen2))))))
-
- (test-simple-nsin 1)
- (test-simple-nsin 3)
- (test-simple-nsin 10)
+ (for-each (lambda (n)
+ (let ((p (make-nsin 400.0 n))
+ (vp (make-float-vector 200))
+ (vo (make-float-vector 200))
+ (parts (apply float-vector
+ (do ((frqs ())
+ (i 1 (+ i 1)))
+ ((> i n)
+ (reverse frqs))
+ (set! frqs (cons (hz->radians (* i 400.0)) frqs))))))
+ (let ((ob (make-oscil-bank parts (make-float-vector n) (make-float-vector n (mus-scaler p)) #t)))
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (float-vector-set! vp i (nsin p)))
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (float-vector-set! vo i (oscil-bank ob)))
+ (if (not (mus-arrays-equal? vp vo))
+ (format *stderr* ";simple nsin ~A: ~A~% ~A~% ~A~%~A ~A~%"
+ n
+ (float-vector-peak (float-vector-subtract! (copy vp) vo))
+ vp vo
+ p ob)))))
+ '(1 3 10))
(let ((gen (make-nrxysin 440.0)))
(print-and-check gen
@@ -13485,7 +13363,7 @@ EDITS: 2
(i 0 (+ i 1)))
((= i 10))
(outa i (nrxysin gen))))
- (if (not (mus-arrays-equal? v1 (float-vector 0.000 0.671 0.637 0.186 0.017 0.169 0.202 0.048 0.007 0.105)))
+ (if (not (mus-arrays-equal? v1 #r(0.000 0.671 0.637 0.186 0.017 0.169 0.202 0.048 0.007 0.105)))
(snd-display "ws nrxysin output: ~A" v1)))
@@ -13519,7 +13397,7 @@ EDITS: 2
(i 0 (+ i 1)))
((= i 10))
(outa i (nrxycos gen))))))
- (if (not (mus-arrays-equal? v1 (float-vector 1.000 0.602 -0.067 -0.242 -0.007 0.071 -0.087 -0.128 -0.007 0.012)))
+ (if (not (mus-arrays-equal? v1 #r(1.000 0.602 -0.067 -0.242 -0.007 0.071 -0.087 -0.128 -0.007 0.012)))
(snd-display "ws nrxycos output: ~A" v1)))
(let ((gen (make-asymmetric-fm 440.0))
@@ -13674,7 +13552,7 @@ EDITS: 2
(if (> (abs (- val exval)) 1e-12)
(format *stderr* ";for-filter ~D at ~D: ~A ~A~%" i k val exval))))))
- (let ((f (make-fir-filter 3 (float-vector 1.0 .5 .25)))
+ (let ((f (make-fir-filter 3 #r(1.0 .5 .25)))
(v (make-float-vector 10)))
(set! (v 0) (f 1.0))
(do ((i 1 (+ i 1)))
@@ -13684,20 +13562,20 @@ EDITS: 2
(do ((i 6 (+ i 1)))
((= i 10))
(set! (v i) (f 0.0)))
- (if (not (mus-arrays-equal? v (float-vector 1.0 0.5 .25 0.0 0.0 1.0 0.5 .25 0.0 0.0)))
+ (if (not (mus-arrays-equal? v #r(1.0 0.5 .25 0.0 0.0 1.0 0.5 .25 0.0 0.0)))
(format *stderr* ";f3: ~A~%" v)))
- (let ((f (make-fir-filter 7 (float-vector .7 .6 .5 .4 .3 .2 .1)))
+ (let ((f (make-fir-filter 7 #r(.7 .6 .5 .4 .3 .2 .1)))
(v (make-float-vector 10)))
(set! (v 0) (f 1.0))
(do ((i 1 (+ i 1)))
((= i 10))
(set! (v i) (f 0.0)))
- (if (not (mus-arrays-equal? v (float-vector .7 .6 .5 .4 .3 .2 .1 0.0 0.0 0.0)))
+ (if (not (mus-arrays-equal? v #r(.7 .6 .5 .4 .3 .2 .1 0.0 0.0 0.0)))
(format *stderr* ";f7: ~A~%" v)))
- (let ((f (make-iir-filter 3 (float-vector 1.0 .5 .25)))
+ (let ((f (make-iir-filter 3 #r(1.0 .5 .25)))
(v (make-float-vector 10)))
(set! (v 0) (f 1.0))
(do ((i 1 (+ i 1)))
@@ -13707,17 +13585,17 @@ EDITS: 2
(do ((i 6 (+ i 1)))
((= i 10))
(set! (v i) (f 0.0)))
- (if (not (mus-arrays-equal? v (float-vector 1.0 -0.5 0.0 0.125 -0.0625 1.0 -0.484375 -0.0078125 0.125 -0.060546875)))
+ (if (not (mus-arrays-equal? v #r(1.0 -0.5 0.0 0.125 -0.0625 1.0 -0.484375 -0.0078125 0.125 -0.060546875)))
(format *stderr* ";i3: ~A~%" v)))
- (let ((f (make-iir-filter 7 (float-vector .7 .6 .5 .4 .3 .2 .1)))
+ (let ((f (make-iir-filter 7 #r(.7 .6 .5 .4 .3 .2 .1)))
(v (make-float-vector 30)))
(set! (v 0) (f 1.0))
(do ((i 1 (+ i 1)))
((= i 30))
(set! (v i) (f 0.0)))
- (unless (mus-arrays-equal? v (float-vector 1.000000 -0.600000 -0.140000 -0.016000 0.019600 0.032240 0.039256 0.045286
+ (unless (mus-arrays-equal? v #r(1.000000 -0.600000 -0.140000 -0.016000 0.019600 0.032240 0.039256 0.045286
-0.048376 -0.021312 -0.001324 0.006140 0.007033 0.004780 0.000657 -0.005043
-0.002420 0.000256 0.001217 0.001013 0.000350 -0.000292 -0.000579 -0.000219
0.000109 0.000192 0.000115 0.000002 -0.000067 -0.000065))
@@ -13740,7 +13618,7 @@ EDITS: 2
(do ((i 1 (+ i 1)))
((= i 10))
(set! (v i) (f 0.0)))
- (unless (mus-arrays-equal? v (float-vector 1.000000 0.166667 0.138889 -0.166667 0.049383 0.041152 -0.049383 0.014632 0.012193 -0.014632))
+ (unless (mus-arrays-equal? v #r(1.000000 0.166667 0.138889 -0.166667 0.049383 0.041152 -0.049383 0.014632 0.012193 -0.014632))
(format *stderr* ";g3: ")
(do ((i 0 (+ i 1)))
((= i 10))
@@ -13760,7 +13638,7 @@ EDITS: 2
(do ((i 1 (+ i 1)))
((= i 30))
(set! (v i) (f 0.0)))
- (unless (mus-arrays-equal? v (float-vector 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
+ (unless (mus-arrays-equal? v #r(1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0))
(format *stderr* ";g9: ")
(do ((i 0 (+ i 1)))
@@ -13781,7 +13659,7 @@ EDITS: 2
(do ((i 1 (+ i 1)))
((= i 30))
(set! (v i) (f 0.0)))
- (unless (mus-arrays-equal? v (float-vector 1.000000 0.166667 0.138889 0.115741 0.096451 0.080376 0.066980 0.055816 0.046514
+ (unless (mus-arrays-equal? v #r(1.000000 0.166667 0.138889 0.115741 0.096451 0.080376 0.066980 0.055816 0.046514
-0.129033 0.004335 0.003613 0.003011 0.002509 0.002091 0.001742 0.001452 0.001210
-0.003356 0.000113 0.000094 0.000078 0.000065 0.000054 0.000045 0.000038 0.000031
-0.000087 0.000003 0.000002))
@@ -13804,7 +13682,7 @@ EDITS: 2
(do ((i 1 (+ i 1)))
((= i 30))
(set! (v i) (f 0.0)))
- (unless (mus-arrays-equal? v (float-vector 1.000000 -0.166667 -0.111111 -0.074074 -0.049383 -0.032922 -0.021948 -0.014632
+ (unless (mus-arrays-equal? v #r(1.000000 -0.166667 -0.111111 -0.074074 -0.049383 -0.032922 -0.021948 -0.014632
0.183795 -0.038761 -0.025841 -0.017227 -0.011485 -0.007657 -0.005104 -0.003403
0.042745 -0.009015 -0.006010 -0.004007 -0.002671 -0.001781 -0.001187 -0.000791
0.009941 -0.002097 -0.001398 -0.000932 -0.000621 -0.000414))
@@ -13827,7 +13705,7 @@ EDITS: 2
(do ((i 1 (+ i 1)))
((= i 30))
(set! (v i) (f 0.0)))
- (unless (mus-arrays-equal? v (float-vector 1.000000 -0.166667 -0.111111 -0.074074 -0.049383 -0.032922 -0.021948 -0.014632 -0.009755
+ (unless (mus-arrays-equal? v #r(1.000000 -0.166667 -0.111111 -0.074074 -0.049383 -0.032922 -0.021948 -0.014632 -0.009755
-0.006503 -0.004335 -0.002890 -0.001927 -0.001285 -0.000856 -0.000571 -0.000381 -0.000254
0.036715 -0.006260 -0.004173 -0.002782 -0.001855 -0.001237 -0.000824 -0.000550 -0.000366
-0.000244 -0.000163 -0.000109))
@@ -13850,7 +13728,7 @@ EDITS: 2
(do ((i 1 (+ i 1)))
((= i 30))
(set! (v i) (f 0.0)))
- (unless (mus-arrays-equal? v (float-vector 1.000000 -0.166667 -0.111111 -0.074074 -0.049383 -0.032922
+ (unless (mus-arrays-equal? v #r(1.000000 -0.166667 -0.111111 -0.074074 -0.049383 -0.032922
-0.021948 -0.014632 -0.009755 0.161291 -0.032301 -0.021534
-0.014356 -0.009571 -0.006380 -0.004254 -0.002836 -0.001891
0.031259 -0.006260 -0.004173 -0.002782 -0.001855 -0.001237
@@ -13862,7 +13740,7 @@ EDITS: 2
(format *stderr* "~%"))))
- (let ((gen (make-fir-filter 3 (float-vector .5 .25 .125)))
+ (let ((gen (make-fir-filter 3 #r(.5 .25 .125)))
(v0 (make-float-vector 10)))
(print-and-check gen
"fir-filter"
@@ -13874,7 +13752,7 @@ EDITS: 2
(set! (v0 i) (fir-filter gen 0.0)))
(let ((v1 (make-float-vector 10)))
(let ((inp 1.0)
- (gen1 (make-fir-filter 3 (float-vector .5 .25 .125))))
+ (gen1 (make-fir-filter 3 #r(.5 .25 .125))))
(fill-float-vector v1 (let ((val (if (fir-filter? gen1) (fir-filter gen1 inp) -1.0)))
(set! inp 0.0)
val)))
@@ -13891,14 +13769,14 @@ EDITS: 2
(if (not (eq? tag 'mus-error))
(snd-display "fir ycoeff 123: ~A" tag))))
- (test-gen-equal (let ((f1 (make-fir-filter 3 (float-vector .5 .25 .125)) )) (fir-filter f1 1.0) f1)
- (let ((f2 (make-fir-filter 3 (float-vector .5 .25 .125)) )) (fir-filter f2 1.0) f2)
- (let ((f3 (make-fir-filter 3 (float-vector .75 .25 .125)))) (fir-filter f3 1.0) f3))
- (test-gen-equal (let ((f1 (make-fir-filter 3 (float-vector .5 .25 .125)) )) (fir-filter f1 1.0) f1)
- (let ((f2 (make-fir-filter 3 (float-vector .5 .25 .125)) )) (fir-filter f2 1.0) f2)
- (let ((f3 (make-fir-filter 2 (float-vector .5 .25)))) (fir-filter f3 1.0) f3))
+ (test-gen-equal (let ((f1 (make-fir-filter 3 #r(.5 .25 .125)) )) (fir-filter f1 1.0) f1)
+ (let ((f2 (make-fir-filter 3 #r(.5 .25 .125)) )) (fir-filter f2 1.0) f2)
+ (let ((f3 (make-fir-filter 3 #r(.75 .25 .125)))) (fir-filter f3 1.0) f3))
+ (test-gen-equal (let ((f1 (make-fir-filter 3 #r(.5 .25 .125)) )) (fir-filter f1 1.0) f1)
+ (let ((f2 (make-fir-filter 3 #r(.5 .25 .125)) )) (fir-filter f2 1.0) f2)
+ (let ((f3 (make-fir-filter 2 #r(.5 .25)))) (fir-filter f3 1.0) f3))
- (let* ((coeffs (float-vector .1 .2 .3 .4 .4 .3 .2 .1))
+ (let* ((coeffs #r(.1 .2 .3 .4 .4 .3 .2 .1))
(flt (make-fir-filter 8 coeffs)))
(let ((xcof (mus-xcoeffs flt))
(es (make-vector 8)))
@@ -13928,8 +13806,8 @@ EDITS: 2
(float-vector-move! xs (- xlen 1) (- xlen 2) #t)
(set! (xs 0) x)
(dot-product coeffs xs xlen))))))
- (do ((fir1 (make-fir-filter 3 (float-vector 1.0 0.4 0.1)))
- (fir2 (make-f-filter (float-vector 1.0 0.4 0.1)))
+ (do ((fir1 (make-fir-filter 3 #r(1.0 0.4 0.1)))
+ (fir2 (make-f-filter #r(1.0 0.4 0.1)))
(x 1.0)
(happy #t)
(i 0 (+ i 1)))
@@ -13946,25 +13824,25 @@ EDITS: 2
(snd-display "make-spencer-filter returns ~A?" gen)
(begin
(if (not (= (mus-order gen) 15)) (snd-display "make-spencer-filter order ~A?" (mus-order gen)))
- (if (not (mus-arrays-equal? (mus-xcoeffs gen) (float-vector -0.009 -0.019 -0.016 0.009 0.066 0.144 0.209 0.231 0.209 0.144 0.066 0.009 -0.016 -0.019 -0.009)))
+ (if (not (mus-arrays-equal? (mus-xcoeffs gen) #r(-0.009 -0.019 -0.016 0.009 0.066 0.144 0.209 0.231 0.209 0.144 0.066 0.009 -0.016 -0.019 -0.009)))
(snd-display "make-spencer-filter coeffs: ~A" (mus-xcoeffs gen))))))
(let ((flt (mus-xcoeffs (make-savitzky-golay-filter 5 2))))
- (if (not (mus-arrays-equal? flt (float-vector -0.086 0.343 0.486 0.343 -0.086)))
+ (if (not (mus-arrays-equal? flt #r(-0.086 0.343 0.486 0.343 -0.086)))
(snd-display "sg 5 2: ~A" flt)))
(let ((flt (mus-xcoeffs (make-savitzky-golay-filter 11 2))))
- (if (not (mus-arrays-equal? flt (float-vector -0.084 0.021 0.103 0.161 0.196 0.207 0.196 0.161 0.103 0.021 -0.084)))
+ (if (not (mus-arrays-equal? flt #r(-0.084 0.021 0.103 0.161 0.196 0.207 0.196 0.161 0.103 0.021 -0.084)))
(snd-display "sg 11 2: ~A" flt)))
(let ((flt (mus-xcoeffs (make-savitzky-golay-filter 11 4))))
- (if (not (mus-arrays-equal? flt (float-vector 0.042 -0.105 -0.023 0.140 0.280 0.333 0.280 0.140 -0.023 -0.105 0.042)))
+ (if (not (mus-arrays-equal? flt #r(0.042 -0.105 -0.023 0.140 0.280 0.333 0.280 0.140 -0.023 -0.105 0.042)))
(snd-display "sg 11 4: ~A" flt)))
(let ((flt (mus-xcoeffs (make-savitzky-golay-filter 25 2))))
- (if (not (mus-arrays-equal? flt (float-vector -0.049 -0.027 -0.006 0.012 0.028 0.043 0.055 0.066 0.075 0.082 0.086
+ (if (not (mus-arrays-equal? flt #r(-0.049 -0.027 -0.006 0.012 0.028 0.043 0.055 0.066 0.075 0.082 0.086
0.089 0.090 0.089 0.086 0.082 0.075 0.066 0.055 0.043
0.028 0.012 -0.006 -0.027 -0.049)))
(snd-display "sg 25 2: ~A" flt)))
- (let ((gen (make-iir-filter 3 (float-vector .5 .25 .125)))
+ (let ((gen (make-iir-filter 3 #r(.5 .25 .125)))
(v0 (make-float-vector 10)))
(print-and-check gen
"iir-filter"
@@ -13976,7 +13854,7 @@ EDITS: 2
(set! (v0 i) (iir-filter gen 0.0)))
(let ((v1 (make-float-vector 10)))
(let ((inp 1.0)
- (gen1 (make-iir-filter 3 (float-vector .5 .25 .125))))
+ (gen1 (make-iir-filter 3 #r(.5 .25 .125))))
(fill-float-vector v1 (let ((val (if (iir-filter? gen1) (iir-filter gen1 inp) -1.0)))
(set! inp 0.0)
val)))
@@ -13993,14 +13871,14 @@ EDITS: 2
(if (not (eq? tag 'mus-error))
(snd-display "iir xcoeff 123: ~A" tag))))
- (test-gen-equal (let ((f1 (make-iir-filter 3 (float-vector .5 .25 .125)))) (iir-filter f1 1.0) f1)
- (let ((f2 (make-iir-filter 3 (float-vector .5 .25 .125)) )) (iir-filter f2 1.0) f2)
- (let ((f3 (make-iir-filter 3 (float-vector .75 .25 .125)))) (iir-filter f3 1.0) f3))
- (test-gen-equal (let ((f1 (make-iir-filter 3 (float-vector .5 .25 .125)) )) (iir-filter f1 1.0) f1)
- (let ((f2 (make-iir-filter 3 (float-vector .5 .25 .125)) )) (iir-filter f2 1.0) f2)
- (let ((f3 (make-iir-filter 2 (float-vector .5 .25)))) (iir-filter f3 1.0) f3))
+ (test-gen-equal (let ((f1 (make-iir-filter 3 #r(.5 .25 .125)))) (iir-filter f1 1.0) f1)
+ (let ((f2 (make-iir-filter 3 #r(.5 .25 .125)) )) (iir-filter f2 1.0) f2)
+ (let ((f3 (make-iir-filter 3 #r(.75 .25 .125)))) (iir-filter f3 1.0) f3))
+ (test-gen-equal (let ((f1 (make-iir-filter 3 #r(.5 .25 .125)) )) (iir-filter f1 1.0) f1)
+ (let ((f2 (make-iir-filter 3 #r(.5 .25 .125)) )) (iir-filter f2 1.0) f2)
+ (let ((f3 (make-iir-filter 2 #r(.5 .25)))) (iir-filter f3 1.0) f3))
- (let ((gen (make-filter 3 (float-vector .5 .25 .125) (float-vector .5 .25 .125))))
+ (let ((gen (make-filter 3 #r(.5 .25 .125) #r(.5 .25 .125))))
(print-and-check gen
"filter"
"filter order: 3, xs: [0.5 0.25 0.125], ys: [0.5 0.25 0.125]")
@@ -14011,7 +13889,7 @@ EDITS: 2
((= i 10))
(set! (v0 i) (filter gen 0.0)))
(let ((v1 (make-float-vector 10))
- (gen1 (make-filter 3 (float-vector .5 .25 .125) (float-vector .5 .25 .125)))
+ (gen1 (make-filter 3 #r(.5 .25 .125) #r(.5 .25 .125)))
(inp 1.0))
(fill-float-vector v1 (let ((val (if (filter? gen1) (filter gen1 inp) -1.0)))
(set! inp 0.0)
@@ -14023,59 +13901,59 @@ EDITS: 2
(if (not (filter? gen2)) (snd-display "make-biquad: ~A" gen2)))
(let ((xs (mus-xcoeffs gen))
(ys (mus-ycoeffs gen)))
- (if (not (and (equal? xs (float-vector .5 .25 .125))
+ (if (not (and (equal? xs #r(.5 .25 .125))
(equal? xs ys)))
(snd-display "mus-xcoeffs: ~A ~A?" xs ys))))
- (let ((var (catch #t (lambda () (make-filter :order 2 :xcoeffs (float-vector 1.0 0.5) :ycoeffs (float-vector 2.0 1.0 0.5))) (lambda args args))))
+ (let ((var (catch #t (lambda () (make-filter :order 2 :xcoeffs #r(1.0 0.5) :ycoeffs #r(2.0 1.0 0.5))) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
(snd-display "make-filter bad coeffs: ~A" var)))
- (let ((var (catch #t (lambda () (make-filter :order 0 :xcoeffs (float-vector 1.0 0.5))) (lambda args args))))
+ (let ((var (catch #t (lambda () (make-filter :order 0 :xcoeffs #r(1.0 0.5))) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
(snd-display "make-filter bad order: ~A" var)))
- (let ((var (catch #t (lambda () (make-fir-filter :order 22 :xcoeffs (float-vector 1.0 0.5))) (lambda args args))))
+ (let ((var (catch #t (lambda () (make-fir-filter :order 22 :xcoeffs #r(1.0 0.5))) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
(snd-display "make-fir-filter bad coeffs: ~A" var)))
- (let ((var (catch #t (lambda () (make-iir-filter :order 22 :ycoeffs (float-vector 1.0 0.5))) (lambda args args))))
+ (let ((var (catch #t (lambda () (make-iir-filter :order 22 :ycoeffs #r(1.0 0.5))) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
(snd-display "make-iir-filter bad coeffs: ~A" var)))
(let ((var (catch #t (lambda () (make-fir-filter -1)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
(snd-display "make-fir-filter bad order: ~A" var)))
- (let ((var (make-filter :order 2 :ycoeffs (float-vector 1.0 0.5))))
+ (let ((var (make-filter :order 2 :ycoeffs #r(1.0 0.5))))
(if (not (iir-filter? var))
(snd-display "make-filter with only y: ~A" var)))
- (test-gen-equal (let ((f1 (make-filter 3 (float-vector .5 .25 .125) (float-vector .5 .25 .125)))) (filter f1 1.0) f1)
- (let ((f2 (make-filter 3 (float-vector .5 .25 .125) (float-vector .5 .25 .125)))) (filter f2 1.0) f2)
- (let ((f3 (make-filter 3 (float-vector .5 .25 .125) (float-vector .5 .5 .5)))) (filter f3 1.0) f3))
- (test-gen-equal (let ((f1 (make-filter 3 (float-vector .5 .25 .125) (float-vector .5 .25 .125)))) (filter f1 1.0) f1)
- (let ((f2 (make-filter 3 (float-vector .5 .25 .125) (float-vector .5 .25 .125)))) (filter f2 1.0) f2)
- (let ((f3 (make-filter 3 (float-vector .5 .5 .125) (float-vector .5 .25 .0625)))) (filter f3 1.0) f3))
+ (test-gen-equal (let ((f1 (make-filter 3 #r(.5 .25 .125) #r(.5 .25 .125)))) (filter f1 1.0) f1)
+ (let ((f2 (make-filter 3 #r(.5 .25 .125) #r(.5 .25 .125)))) (filter f2 1.0) f2)
+ (let ((f3 (make-filter 3 #r(.5 .25 .125) #r(.5 .5 .5)))) (filter f3 1.0) f3))
+ (test-gen-equal (let ((f1 (make-filter 3 #r(.5 .25 .125) #r(.5 .25 .125)))) (filter f1 1.0) f1)
+ (let ((f2 (make-filter 3 #r(.5 .25 .125) #r(.5 .25 .125)))) (filter f2 1.0) f2)
+ (let ((f3 (make-filter 3 #r(.5 .5 .125) #r(.5 .25 .0625)))) (filter f3 1.0) f3))
- (let ((fr (mus-length (make-fir-filter 6 (float-vector 0 1 2 3 4 5)))))
+ (let ((fr (mus-length (make-fir-filter 6 #r(0 1 2 3 4 5)))))
(if (not (= fr 6)) (snd-display "filter-length: ~A" fr)))
- (let ((val (cascade->canonical (list (float-vector 1.0 0.0 0.0) (float-vector 1.0 0.5 0.25)))))
- (if (not (mus-arrays-equal? val (float-vector 1.000 0.500 0.250 0.000 0.000)))
+ (let ((val (cascade->canonical (list #r(1.0 0.0 0.0) #r(1.0 0.5 0.25)))))
+ (if (not (mus-arrays-equal? val #r(1.000 0.500 0.250 0.000 0.000)))
(snd-display "cas2can 0: ~A" val)))
- (let ((val (cascade->canonical (list (float-vector 1.0 1.0 0.0) (float-vector 1.0 0.5 0.25)))))
- (if (not (mus-arrays-equal? val (float-vector 1.000 1.500 0.750 0.250 0.000)))
+ (let ((val (cascade->canonical (list #r(1.0 1.0 0.0) #r(1.0 0.5 0.25)))))
+ (if (not (mus-arrays-equal? val #r(1.000 1.500 0.750 0.250 0.000)))
(snd-display "cas2can 1: ~A" val)))
- (let ((val (cascade->canonical (list (float-vector 1 0.8 0) (float-vector 1 1.4 0.65) (float-vector 1 0 0)))))
- (if (not (mus-arrays-equal? val (float-vector 1.000 2.200 1.770 0.520 0.000 0.000 0.000)))
+ (let ((val (cascade->canonical (list #r(1 0.8 0) #r(1 1.4 0.65) #r(1 0 0)))))
+ (if (not (mus-arrays-equal? val #r(1.000 2.200 1.770 0.520 0.000 0.000 0.000)))
(snd-display "cascade->canonical: ~A" val)))
- (let ((val (cascade->canonical (list (float-vector 1 -0.9 0) (float-vector 1 1 0.74) (float-vector 1 -1.6 0.8)))))
- (if (not (mus-arrays-equal? val (float-vector 1.000 -1.500 0.480 -0.330 0.938 -0.533 0.000)))
+ (let ((val (cascade->canonical (list #r(1 -0.9 0) #r(1 1 0.74) #r(1 -1.6 0.8)))))
+ (if (not (mus-arrays-equal? val #r(1.000 -1.500 0.480 -0.330 0.938 -0.533 0.000)))
(snd-display "cascade->canonical 1: ~A" val)))
(let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next)))
(pad-channel 0 10000)
(freq-sweep .45)
(let ((sp (rough-spectrum ind)))
- (if (not (or (mus-arrays-equal? sp (float-vector 0.962 0.998 0.998 0.998 0.998 0.999 0.999 0.998 0.997 1.000))
- (mus-arrays-equal? sp (float-vector 0.963 0.999 0.999 0.999 0.999 0.999 1.000 1.000 0.998 0.997))))
+ (if (not (or (mus-arrays-equal? sp #r(0.962 0.998 0.998 0.998 0.998 0.999 0.999 0.998 0.997 1.000))
+ (mus-arrays-equal? sp #r(0.963 0.999 0.999 0.999 0.999 0.999 1.000 1.000 0.998 0.997))))
(snd-display "initial rough spectrum: ~A" sp)))
(let ((b (make-butter-high-pass 440.0)))
@@ -14083,13 +13961,13 @@ EDITS: 2
(d (make-delay 1)))
(delay d (filter b 1.0))
(fill-float-vector v (delay d (filter b 0.0)))
- (if (not (mus-arrays-equal? v (float-vector 0.915 -0.162 -0.146 -0.131 -0.117 -0.103 -0.090 -0.078 -0.066 -0.056)))
+ (if (not (mus-arrays-equal? v #r(0.915 -0.162 -0.146 -0.131 -0.117 -0.103 -0.090 -0.078 -0.066 -0.056)))
(snd-display "butter high: ~A" v)))
(set! b (make-butter-high-pass 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (or (mus-arrays-equal? sp (float-vector 0.150 0.833 0.980 0.994 0.997 0.998 0.999 0.998 0.997 1.000))
- (mus-arrays-equal? sp (float-vector 0.150 0.833 0.981 0.995 0.998 0.999 1.000 1.000 0.998 0.997))))
+ (if (not (or (mus-arrays-equal? sp #r(0.150 0.833 0.980 0.994 0.997 0.998 0.999 0.998 0.997 1.000))
+ (mus-arrays-equal? sp #r(0.150 0.833 0.981 0.995 0.998 0.999 1.000 1.000 0.998 0.997))))
(snd-display "hp rough spectrum: ~A" sp)))
(undo))
@@ -14098,12 +13976,12 @@ EDITS: 2
(d (make-delay 1)))
(delay d (filter b 1.0))
(fill-float-vector v (delay d (filter b 0.0)))
- (if (not (mus-arrays-equal? v (float-vector 0.004 0.014 0.026 0.035 0.043 0.049 0.053 0.055 0.057 0.057)))
+ (if (not (mus-arrays-equal? v #r(0.004 0.014 0.026 0.035 0.043 0.049 0.053 0.055 0.057 0.057)))
(snd-display "butter low: ~A" v)))
(set! b (make-butter-low-pass 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (mus-arrays-equal? sp (float-vector 1.000 0.212 0.024 0.005 0.001 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? sp #r(1.000 0.212 0.024 0.005 0.001 0.000 0.000 0.000 0.000 0.000)))
(snd-display "lp rough spectrum: ~A" sp)))
(undo))
@@ -14112,12 +13990,12 @@ EDITS: 2
(d (make-delay 1)))
(delay d (filter b 1.0))
(fill-float-vector v (delay d (filter b 0.0)))
- (if (not (mus-arrays-equal? v (float-vector 0.007 0.014 0.013 0.013 0.012 0.011 0.009 0.008 0.007 0.005)))
+ (if (not (mus-arrays-equal? v #r(0.007 0.014 0.013 0.013 0.012 0.011 0.009 0.008 0.007 0.005)))
(snd-display "butter bandpass: ~A" v)))
(set! b (make-butter-band-pass 1000.0 500.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (mus-arrays-equal? sp (float-vector 0.888 1.000 0.144 0.056 0.027 0.014 0.008 0.004 0.002 0.000)))
+ (if (not (mus-arrays-equal? sp #r(0.888 1.000 0.144 0.056 0.027 0.014 0.008 0.004 0.002 0.000)))
(snd-display "bp rough spectrum: ~A" sp)))
(undo))
@@ -14126,13 +14004,13 @@ EDITS: 2
(d (make-delay 1)))
(delay d (filter b 1.0))
(fill-float-vector v (delay d (filter b 0.0)))
- (if (not (mus-arrays-equal? v (float-vector 0.993 -0.014 -0.013 -0.013 -0.012 -0.011 -0.009 -0.008 -0.007 -0.005)))
+ (if (not (mus-arrays-equal? v #r(0.993 -0.014 -0.013 -0.013 -0.012 -0.011 -0.009 -0.008 -0.007 -0.005)))
(snd-display "butter bandstop: ~A" v)))
(set! b (make-butter-band-reject 1000.0 500.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (or (mus-arrays-equal? sp (float-vector 0.662 0.687 0.953 0.980 0.989 0.994 0.997 0.997 0.997 1.000))
- (mus-arrays-equal? sp (float-vector 0.664 0.689 0.955 0.982 0.992 0.996 0.999 1.000 0.999 0.998))))
+ (if (not (or (mus-arrays-equal? sp #r(0.662 0.687 0.953 0.980 0.989 0.994 0.997 0.997 0.997 1.000))
+ (mus-arrays-equal? sp #r(0.664 0.689 0.955 0.982 0.992 0.996 0.999 1.000 0.999 0.998))))
(snd-display "bs rough spectrum: ~A" sp)))
(undo))
@@ -14140,9 +14018,9 @@ EDITS: 2
(test-lpc)
(test-unclip-channel)
- (let ((v (spectrum->coeffs 10 (float-vector 0 1.0 0 0 0 0 0 0 1.0 0)))
- (v1 (make-fir-coeffs 10 (float-vector 0 1.0 0 0 0 0 0 0 1.0 0))))
- (if (not (mus-arrays-equal? v (float-vector -0.190 -0.118 0.000 0.118 0.190 0.190 0.118 0.000 -0.118 -0.190)))
+ (let ((v (spectrum->coeffs 10 #r(0 1.0 0 0 0 0 0 0 1.0 0)))
+ (v1 (make-fir-coeffs 10 #r(0 1.0 0 0 0 0 0 0 1.0 0))))
+ (if (not (mus-arrays-equal? v #r(-0.190 -0.118 0.000 0.118 0.190 0.190 0.118 0.000 -0.118 -0.190)))
(snd-display "spectrum->coeffs: ~A" v))
(if (not (mus-arrays-equal? v v1))
(snd-display "spectrum->coeffs v make-fir-coeffs: ~A ~A" v v1)))
@@ -14151,7 +14029,7 @@ EDITS: 2
(set! (notched-spectr 2) 1.0)
(let ((v (spectrum->coeffs 20 notched-spectr))
(v1 (make-fir-coeffs 20 notched-spectr)))
- (if (not (mus-arrays-equal? v (float-vector 0.095 0.059 -0.000 -0.059 -0.095 -0.095 -0.059 0.000 0.059 0.095
+ (if (not (mus-arrays-equal? v #r(0.095 0.059 -0.000 -0.059 -0.095 -0.095 -0.059 0.000 0.059 0.095
0.095 0.059 0.000 -0.059 -0.095 -0.095 -0.059 -0.000 0.059 0.095)))
(snd-display "spectrum->coeffs (notch): ~A" v))
(if (not (mus-arrays-equal? v v1))
@@ -14159,7 +14037,7 @@ EDITS: 2
(let ((flt (make-fir-filter 20 v)))
(map-channel (lambda (y) (fir-filter flt y))))))
(let ((sp (rough-spectrum ind)))
- (if (not (mus-arrays-equal? sp (float-vector 0.007 0.493 1.000 0.068 0.030 0.019 0.014 0.011 0.009 0.009)))
+ (if (not (mus-arrays-equal? sp #r(0.007 0.493 1.000 0.068 0.030 0.019 0.014 0.011 0.009 0.009)))
(snd-display "sp->coeff rough spectrum: ~A" sp)))
(undo)
@@ -14177,14 +14055,14 @@ EDITS: 2
(let ((d (make-delay 1)))
(delay d (fir-filter b 1.0))
(fill-float-vector v (delay d (fir-filter b 0.0))))
- (if (not (mus-arrays-equal? v (float-vector -0.001 -0.002 -0.005 -0.011 -0.021 -0.034 -0.049 -0.065 -0.078 -0.087
+ (if (not (mus-arrays-equal? v #r(-0.001 -0.002 -0.005 -0.011 -0.021 -0.034 -0.049 -0.065 -0.078 -0.087
0.909 -0.087 -0.078 -0.065 -0.049 -0.034 -0.021 -0.011 -0.005 -0.002)))
(snd-display "dsp.scm high: ~A" v)))
(set! b (make-highpass (hz->radians 1000.0) 20))
(map-channel (lambda (y) (fir-filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (or (mus-arrays-equal? sp (float-vector 0.053 0.774 0.998 0.997 0.997 0.996 0.996 0.996 0.997 1.000))
- (mus-arrays-equal? sp (float-vector 0.053 0.776 1.000 0.998 0.998 0.998 0.998 0.998 0.998 1.000))))
+ (if (not (or (mus-arrays-equal? sp #r(0.053 0.774 0.998 0.997 0.997 0.996 0.996 0.996 0.997 1.000))
+ (mus-arrays-equal? sp #r(0.053 0.776 1.000 0.998 0.998 0.998 0.998 0.998 0.998 1.000))))
(snd-display "dsp hp rough spectrum: ~A" sp)))
(undo))
@@ -14193,13 +14071,13 @@ EDITS: 2
(let ((d (make-delay 1)))
(delay d (fir-filter b 1.0))
(fill-float-vector v (delay d (fir-filter b 0.0))))
- (if (not (mus-arrays-equal? v (float-vector 0.001 0.002 0.005 0.011 0.021 0.034 0.049 0.065 0.078 0.087 0.091 0.087 0.078 0.065
+ (if (not (mus-arrays-equal? v #r(0.001 0.002 0.005 0.011 0.021 0.034 0.049 0.065 0.078 0.087 0.091 0.087 0.078 0.065
0.049 0.034 0.021 0.011 0.005 0.002)))
(snd-display "dsp.scm low: ~A" v)))
(set! b (make-lowpass (hz->radians 1000.0) 20))
(map-channel (lambda (y) (fir-filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (mus-arrays-equal? sp (float-vector 1.000 0.054 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? sp #r(1.000 0.054 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "dsp lp rough spectrum: ~A" sp)))
(undo))
@@ -14208,13 +14086,13 @@ EDITS: 2
(let ((d (make-delay 1)))
(delay d (fir-filter b 1.0))
(fill-float-vector v (delay d (fir-filter b 0.0))))
- (if (not (mus-arrays-equal? v (float-vector 0.001 -0.001 -0.005 -0.011 -0.017 -0.019 -0.013 0.003 0.022 0.039 0.045
+ (if (not (mus-arrays-equal? v #r(0.001 -0.001 -0.005 -0.011 -0.017 -0.019 -0.013 0.003 0.022 0.039 0.045
0.039 0.022 0.003 -0.013 -0.019 -0.017 -0.011 -0.005 -0.001)))
(snd-display "dsp.scm bp: ~A" v)))
(set! b (make-bandpass (hz->radians 1500.0) (hz->radians 2000.0) 20))
(map-channel (lambda (y) (fir-filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (mus-arrays-equal? sp (float-vector 0.010 1.000 0.154 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? sp #r(0.010 1.000 0.154 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "dsp bp rough spectrum: ~A" sp)))
(undo))
@@ -14223,14 +14101,14 @@ EDITS: 2
(let ((d (make-delay 1)))
(delay d (fir-filter b 1.0))
(fill-float-vector v (delay d (fir-filter b 0.0))))
- (if (not (mus-arrays-equal? v (float-vector -0.001 0.001 0.005 0.011 0.017 0.019 0.013 -0.003 -0.022 -0.039 0.955
+ (if (not (mus-arrays-equal? v #r(-0.001 0.001 0.005 0.011 0.017 0.019 0.013 -0.003 -0.022 -0.039 0.955
-0.039 -0.022 -0.003 0.013 0.019 0.017 0.011 0.005 0.001)))
(snd-display "dsp.scm bs: ~A" v)))
(set! b (make-bandstop (hz->radians 1500.0) (hz->radians 2000.0) 20))
(map-channel (lambda (y) (fir-filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (or (mus-arrays-equal? sp (float-vector 0.904 0.425 0.821 0.998 0.997 0.996 0.996 0.996 0.997 1.000))
- (mus-arrays-equal? sp (float-vector 0.906 0.425 0.822 1.000 0.999 0.998 0.998 0.998 0.998 1.000))))
+ (if (not (or (mus-arrays-equal? sp #r(0.904 0.425 0.821 0.998 0.997 0.996 0.996 0.996 0.997 1.000))
+ (mus-arrays-equal? sp #r(0.906 0.425 0.822 1.000 0.999 0.998 0.998 0.998 0.998 1.000))))
(snd-display "dsp bs rough spectrum: ~A" sp)))
(undo))
@@ -14239,13 +14117,13 @@ EDITS: 2
(let ((d (make-delay 1)))
(delay d (fir-filter b 1.0))
(fill-float-vector v (delay d (fir-filter b 0.0))))
- (if (not (mus-arrays-equal? v (float-vector -0.008 0.011 -0.021 0.039 -0.066 0.108 -0.171 0.270 -0.456 0.977
+ (if (not (mus-arrays-equal? v #r(-0.008 0.011 -0.021 0.039 -0.066 0.108 -0.171 0.270 -0.456 0.977
0.000 -0.977 0.456 -0.270 0.171 -0.108 0.066 -0.039 0.021 -0.011)))
(snd-display "dsp.scm df: ~A" v)))
(set! b (make-differentiator 20))
(map-channel (lambda (y) (fir-filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (mus-arrays-equal? sp (float-vector 0.004 0.027 0.075 0.147 0.242 0.362 0.506 0.674 0.864 1.000)))
+ (if (not (mus-arrays-equal? sp #r(0.004 0.027 0.075 0.147 0.242 0.362 0.506 0.674 0.864 1.000)))
(snd-display "dsp df rough spectrum: ~A" sp)))
(undo))
@@ -14254,13 +14132,13 @@ EDITS: 2
(let ((d (make-delay 1)))
(delay d (filter b 1.0))
(fill-float-vector v (delay d (filter b 0.0))))
- (if (not (mus-arrays-equal? v (float-vector 0.915 -0.162 -0.146 -0.131 -0.117 -0.103 -0.090 -0.078 -0.066 -0.056)))
+ (if (not (mus-arrays-equal? v #r(0.915 -0.162 -0.146 -0.131 -0.117 -0.103 -0.090 -0.078 -0.066 -0.056)))
(snd-display "iir-2 high: ~A" v)))
(set! b (make-iir-high-pass-2 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (or (mus-arrays-equal? sp (float-vector 0.150 0.833 0.980 0.994 0.997 0.998 0.999 0.998 0.997 1.000))
- (mus-arrays-equal? sp (float-vector 0.150 0.833 0.981 0.995 0.998 0.999 1.000 1.000 0.998 0.997))))
+ (if (not (or (mus-arrays-equal? sp #r(0.150 0.833 0.980 0.994 0.997 0.998 0.999 0.998 0.997 1.000))
+ (mus-arrays-equal? sp #r(0.150 0.833 0.981 0.995 0.998 0.999 1.000 1.000 0.998 0.997))))
(snd-display "iir-2 hp rough spectrum: ~A" sp)))
(undo))
@@ -14269,12 +14147,12 @@ EDITS: 2
(let ((d (make-delay 1)))
(delay d (filter b 1.0))
(fill-float-vector v (delay d (filter b 0.0))))
- (if (not (mus-arrays-equal? v (float-vector 0.004 0.014 0.026 0.035 0.043 0.049 0.053 0.055 0.057 0.057)))
+ (if (not (mus-arrays-equal? v #r(0.004 0.014 0.026 0.035 0.043 0.049 0.053 0.055 0.057 0.057)))
(snd-display "iir-2 low: ~A" v)))
(set! b (make-iir-low-pass-2 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (mus-arrays-equal? sp (float-vector 1.000 0.212 0.024 0.005 0.001 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? sp #r(1.000 0.212 0.024 0.005 0.001 0.000 0.000 0.000 0.000 0.000)))
(snd-display "iir-2 lp rough spectrum: ~A" sp)))
(undo))
@@ -14283,12 +14161,12 @@ EDITS: 2
(let ((d (make-delay 1)))
(delay d (filter b 1.0))
(fill-float-vector v (delay d (filter b 0.0))))
- (if (not (mus-arrays-equal? v (float-vector 0.007 0.014 0.013 0.013 0.012 0.010 0.009 0.008 0.006 0.004)))
+ (if (not (mus-arrays-equal? v #r(0.007 0.014 0.013 0.013 0.012 0.010 0.009 0.008 0.006 0.004)))
(snd-display "iir bp-2 bandpass: ~A" v)))
(set! b (make-iir-band-pass-2 1000.0 1500.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (mus-arrays-equal? sp (float-vector 0.239 1.000 0.117 0.041 0.019 0.010 0.005 0.003 0.001 0.000)))
+ (if (not (mus-arrays-equal? sp #r(0.239 1.000 0.117 0.041 0.019 0.010 0.005 0.003 0.001 0.000)))
(snd-display "iir bp-2 rough spectrum: ~A" sp)))
(undo))
@@ -14297,13 +14175,13 @@ EDITS: 2
(let ((d (make-delay 1)))
(delay d (filter b 1.0))
(fill-float-vector v (delay d (filter b 0.0))))
- (if (not (mus-arrays-equal? v (float-vector 0.992 -0.017 -0.016 -0.015 -0.014 -0.012 -0.011 -0.009 -0.007 -0.005)))
+ (if (not (mus-arrays-equal? v #r(0.992 -0.017 -0.016 -0.015 -0.014 -0.012 -0.011 -0.009 -0.007 -0.005)))
(snd-display "iir-2 bandstop: ~A" v)))
(set! b (make-iir-band-stop-2 1000.0 1500.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (or (mus-arrays-equal? sp (float-vector 0.836 0.525 0.943 0.979 0.989 0.994 0.997 0.997 0.997 1.000))
- (mus-arrays-equal? sp (float-vector 0.838 0.527 0.945 0.981 0.991 0.996 0.999 1.000 0.999 0.998))))
+ (if (not (or (mus-arrays-equal? sp #r(0.836 0.525 0.943 0.979 0.989 0.994 0.997 0.997 0.997 1.000))
+ (mus-arrays-equal? sp #r(0.838 0.527 0.945 0.981 0.991 0.996 0.999 1.000 0.999 0.998))))
(snd-display "iir bs-2 rough spectrum: ~A" sp)))
(undo))
@@ -14312,18 +14190,18 @@ EDITS: 2
(let ((d (make-delay 1)))
(delay d (filter b 1.0))
(fill-float-vector v (delay d (filter b 0.0))))
- (if (not (or (mus-arrays-equal? v (float-vector 0.725 -0.466 -0.315 -0.196 -0.104 -0.036 0.014 0.047 0.0685 0.0775))
- (mus-arrays-equal? v (float-vector 0.725 -0.466 -0.315 -0.196 -0.104 -0.035 0.015 0.049 0.070 0.081))
- (mus-arrays-equal? v (float-vector 0.725 -0.466 -0.315 -0.196 -0.104 -0.035 0.014 0.049 0.069 0.079))))
+ (if (not (or (mus-arrays-equal? v #r(0.725 -0.466 -0.315 -0.196 -0.104 -0.036 0.014 0.047 0.0685 0.0775))
+ (mus-arrays-equal? v #r(0.725 -0.466 -0.315 -0.196 -0.104 -0.035 0.015 0.049 0.070 0.081))
+ (mus-arrays-equal? v #r(0.725 -0.466 -0.315 -0.196 -0.104 -0.035 0.014 0.049 0.069 0.079))))
(snd-display "butter hp: ~A" v)))
(set! b (make-butter-hp 4 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (or (mus-arrays-equal? sp (float-vector 0.0505 0.982 1.000 1.000 0.998 0.998 0.999 0.998 0.996 0.999))
- (mus-arrays-equal? sp (float-vector 0.051 0.982 1.000 1.000 0.998 0.998 0.998 0.999 0.997 0.995))
- (mus-arrays-equal? sp (float-vector 0.051 0.991 1.000 1.000 0.998 0.998 0.999 0.999 0.997 0.995))
- (mus-arrays-equal? sp (float-vector 0.045 0.970 1.000 1.000 0.998 0.998 0.999 0.999 0.997 0.995))
- (mus-arrays-equal? sp (float-vector 0.052 0.971 1.000 1.000 0.998 0.998 0.999 0.999 0.997 0.995))))
+ (if (not (or (mus-arrays-equal? sp #r(0.0505 0.982 1.000 1.000 0.998 0.998 0.999 0.998 0.996 0.999))
+ (mus-arrays-equal? sp #r(0.051 0.982 1.000 1.000 0.998 0.998 0.998 0.999 0.997 0.995))
+ (mus-arrays-equal? sp #r(0.051 0.991 1.000 1.000 0.998 0.998 0.999 0.999 0.997 0.995))
+ (mus-arrays-equal? sp #r(0.045 0.970 1.000 1.000 0.998 0.998 0.999 0.999 0.997 0.995))
+ (mus-arrays-equal? sp #r(0.052 0.971 1.000 1.000 0.998 0.998 0.999 0.999 0.997 0.995))))
(snd-display "bhp rough spectrum: ~A" sp)))
(undo))
@@ -14337,8 +14215,8 @@ EDITS: 2
(set! b (make-butter-lp 4 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (or (mus-arrays-equal? sp (float-vector 1.000 0.035 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))
- (mus-arrays-equal? sp (float-vector 1.000 0.038 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
+ (if (not (or (mus-arrays-equal? sp #r(1.000 0.035 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))
+ (mus-arrays-equal? sp #r(1.000 0.038 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
(snd-display "blp rough spectrum: ~A" sp)))
(undo))
@@ -14358,16 +14236,48 @@ EDITS: 2
(let ((d (make-delay 1)))
(delay d (filter b 1.0))
(fill-float-vector v (delay d (filter b 0.0))))
- (if (not (or (mus-arrays-equal? v (float-vector 0.978 -0.043 -0.041 -0.038 -0.035 -0.031 -0.026 -0.0225 -0.015 -0.0085))
- (mus-arrays-equal? v (float-vector 0.978 -0.043 -0.041 -0.038 -0.035 -0.031 -0.027 -0.022 -0.017 -0.011))
- (mus-arrays-equal? v (float-vector 0.978 -0.043 -0.041 -0.038 -0.035 -0.031 -0.027 -0.021 -0.014 -0.011))))
+ (if (not (or (mus-arrays-equal? v #r(0.978 -0.043 -0.041 -0.038 -0.035 -0.031 -0.026 -0.0225 -0.015 -0.0085))
+ (mus-arrays-equal? v #r(0.978 -0.043 -0.041 -0.038 -0.035 -0.031 -0.027 -0.022 -0.017 -0.011))
+ (mus-arrays-equal? v #r(0.978 -0.043 -0.041 -0.038 -0.035 -0.031 -0.027 -0.021 -0.014 -0.011))))
(snd-display "butter bs: ~A" v)))
(set! b (make-butter-bs 4 1000.0 1500.0))
(map-channel (lambda (y) (filter b y)))
(undo))
(revert-sound)
- (test-scanned-synthesis .1 10000 1.0 0.1 0.0)
+
+ (let ((size 256))
+ (let ((x0 (make-float-vector size))
+ (x1 (make-float-vector size))
+ (x2 (make-float-vector size))
+ (dur 10000))
+ (do ((i 0 (+ i 1)))
+ ((= i 12))
+ (let ((val (sin (/ (* 2 pi i) 12.0))))
+ (set! (x1 (- (+ i (/ size 4)) 6)) val)))
+ (let ((data (make-float-vector dur))
+ (amp 0.1000))
+ (let ((recompute-samps 30) ;just a quick guess
+ (gen1 (make-table-lookup 440.0 :wave x1))
+ (gen2 (make-table-lookup 440.0 :wave x2)))
+ (do ((i 0 (+ i 1))
+ (k 0.0)
+ (mass 1.0000)
+ (xspring 0.1000)
+ (damp 0.0000)
+ (kincr (/ 1.0 recompute-samps)))
+ ((= i dur))
+ (if (>= k 1.0)
+ (begin
+ (set! k 0.0)
+ (vibrating-uniform-circular-string size x0 x1 x2 mass xspring damp))
+ (set! k (+ k kincr)))
+ (let ((g1 (table-lookup gen1))
+ (g2 (table-lookup gen2)))
+ (set! (data i) (+ g2 (* k (- g1 g2)))))))
+ (float-vector-scale! data (/ amp (float-vector-peak data)))
+ (float-vector->channel data 0 dur))))
+
(close-sound ind))
(let ((gen (make-sawtooth-wave 440.0)))
@@ -14437,13 +14347,13 @@ EDITS: 2
(test-gen-equal (make-square-wave 440.0) (make-square-wave 440.0) (make-square-wave 440.0 0.5))
(let-temporarily ((*clm-srate* 500.0))
- (let ((gen (make-square-wave 100.0 -0.5 (* pi 0.5)))
- (v0 (make-float-vector 20)))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (set! (v0 i) (gen)))
- (if (not (mus-arrays-equal? v0 (float-vector -0.5 -0.5 0.0 0.0 -0.5 -0.5 -0.5 0.0 0.0 -0.5 -0.5 -0.5 0.0 0.0 -0.5 -0.5 -0.5 0.0 0.0 -0.5)))
- (snd-display "square-wave -.5: ~A " v0))))
+ (do ((gen (make-square-wave 100.0 -0.5 (* pi 0.5)))
+ (v0 (make-float-vector 20))
+ (i 0 (+ i 1)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(-0.5 -0.5 0.0 0.0 -0.5 -0.5 -0.5 0.0 0.0 -0.5 -0.5 -0.5 0.0 0.0 -0.5 -0.5 -0.5 0.0 0.0 -0.5)))
+ (snd-display "square-wave -.5: ~A " v0)))
+ (set! (v0 i) (gen))))
(let ((gen (make-triangle-wave 440.0))
(v0 (make-float-vector 10)))
@@ -14505,13 +14415,13 @@ EDITS: 2
(test-gen-equal (make-pulse-train 440.0) (make-pulse-train 440.0) (make-pulse-train 440.0 0.5))
(let-temporarily ((*clm-srate* 500.0))
- (let ((gen (make-pulse-train 100.0 -0.5 (* pi 0.5)))
- (v0 (make-float-vector 20)))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (set! (v0 i) (gen)))
- (if (not (mus-arrays-equal? v0 (float-vector 0.0 0.0 0.0 0.0 -0.5 0.0 0.0 0.0 0.0 -0.5 0.0 0.0 0.0 0.0 -0.5 0.0 0.0 0.0 0.0 -0.5)))
- (snd-display "pulse-train -.5: ~A " v0))))
+ (do ((gen (make-pulse-train 100.0 -0.5 (* pi 0.5)))
+ (v0 (make-float-vector 20))
+ (i 0 (+ i 1)))
+ ((= i 20)
+ (if (not (mus-arrays-equal? v0 #r(0.0 0.0 0.0 0.0 -0.5 0.0 0.0 0.0 0.0 -0.5 0.0 0.0 0.0 0.0 -0.5 0.0 0.0 0.0 0.0 -0.5)))
+ (snd-display "pulse-train -.5: ~A " v0)))
+ (set! (v0 i) (gen))))
(let ((gen (make-two-pole 1200.0 .1)))
(if (not (two-pole? gen)) (snd-display "~A not 2-polar?" gen))
@@ -14595,12 +14505,11 @@ EDITS: 2
(set! fs (make-formant-bank fs amps))
(set! (amps 0) 0.5)
(set! (amps 1) 0.25)
- (do ((val 1.0)
+ (do ((val 1.0 0.0)
(i 0 (+ i 1)))
((= i 10))
(set! (v0 i) (+ (* 0.5 (formant f0 val)) (* 0.25 (formant f1 val))))
- (set! (v1 i) (formant-bank fs val))
- (set! val 0.0))
+ (set! (v1 i) (formant-bank fs val)))
(if (not (mus-arrays-equal? v0 v1)) (snd-display "formant bank 1: ~A ~A" v0 v1)))
(let ((fs (make-vector 2))
@@ -14613,7 +14522,7 @@ EDITS: 2
(set! (amps 1) 0.25)
(let ((val 1.0))
(fill-float-vector v (let ((res (formant-bank fs val))) (set! val 0.0) res))
- (if (not (mus-arrays-equal? v (float-vector 0.368 0.095 -0.346 -0.091 -0.020))) (snd-display "run formant-bank: ~A" v))))
+ (if (not (mus-arrays-equal? v #r(0.368 0.095 -0.346 -0.091 -0.020))) (snd-display "run formant-bank: ~A" v))))
(let ((ob (open-sound "oboe.snd")))
;; test courtesy of Anders Vinjar
@@ -14669,90 +14578,90 @@ EDITS: 2
(let ((f3 (make-firmant 1200.0 0.5))) (firmant f3 1.0) f3))
(let ((gen (make-fft-window hamming-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.080 0.115 0.215 0.364 0.540 0.716 0.865 1.000 1.000 0.865 0.716 0.540 0.364 0.215 0.115 0.080)))
+ (if (not (mus-arrays-equal? gen #r(0.080 0.115 0.215 0.364 0.540 0.716 0.865 1.000 1.000 0.865 0.716 0.540 0.364 0.215 0.115 0.080)))
(snd-display "hamming window: ~A" gen)))
(let ((gen (make-fft-window rectangular-window 16)))
(if (not (mus-arrays-equal? gen (make-float-vector 16 1.0)))
(snd-display "rectangular window: ~A" gen)))
(let ((gen (make-fft-window hann-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.038 0.146 0.309 0.500 0.691 0.854 1.000 1.000 0.854 0.691 0.500 0.309 0.146 0.038 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.038 0.146 0.309 0.500 0.691 0.854 1.000 1.000 0.854 0.691 0.500 0.309 0.146 0.038 0.000)))
(snd-display "hann window: ~A" gen)))
(let ((gen (make-fft-window welch-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.234 0.438 0.609 0.750 0.859 0.938 1.000 1.000 0.938 0.859 0.750 0.609 0.438 0.234 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.234 0.438 0.609 0.750 0.859 0.938 1.000 1.000 0.938 0.859 0.750 0.609 0.438 0.234 0.000)))
(snd-display "welch window: ~A" gen)))
(let ((gen (make-fft-window connes-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.055 0.191 0.371 0.562 0.739 0.879 1.000 1.000 0.879 0.739 0.562 0.371 0.191 0.055 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.055 0.191 0.371 0.562 0.739 0.879 1.000 1.000 0.879 0.739 0.562 0.371 0.191 0.055 0.000)))
(snd-display "connes window: ~A" gen)))
(let ((gen (make-fft-window parzen-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.125 0.250 0.375 0.500 0.625 0.750 1.000 1.000 0.750 0.625 0.500 0.375 0.250 0.125 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.125 0.250 0.375 0.500 0.625 0.750 1.000 1.000 0.750 0.625 0.500 0.375 0.250 0.125 0.000)))
(snd-display "parzen window: ~A" gen)))
(let ((gen (make-fft-window bartlett-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.125 0.250 0.375 0.500 0.625 0.750 1.000 1.000 0.750 0.625 0.500 0.375 0.250 0.125 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.125 0.250 0.375 0.500 0.625 0.750 1.000 1.000 0.750 0.625 0.500 0.375 0.250 0.125 0.000)))
(snd-display "bartlett window: ~A" gen)))
(let ((gen (make-fft-window blackman2-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.005 0.020 0.071 0.177 0.344 0.558 0.775 1.000 1.000 0.775 0.558 0.344 0.177 0.071 0.020 0.005)))
+ (if (not (mus-arrays-equal? gen #r(0.005 0.020 0.071 0.177 0.344 0.558 0.775 1.000 1.000 0.775 0.558 0.344 0.177 0.071 0.020 0.005)))
(snd-display "blackman2 window: ~A" gen)))
(let ((gen (make-fft-window blackman3-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.003 0.022 0.083 0.217 0.435 0.696 1.000 1.000 0.696 0.435 0.217 0.083 0.022 0.003 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.003 0.022 0.083 0.217 0.435 0.696 1.000 1.000 0.696 0.435 0.217 0.083 0.022 0.003 0.000)))
(snd-display "blackman3 window: ~A" gen)))
(let ((gen (make-fft-window blackman4-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.002 0.002 0.003 0.017 0.084 0.263 0.562 1.000 1.000 0.562 0.263 0.084 0.017 0.003 0.002 0.002)))
+ (if (not (mus-arrays-equal? gen #r(0.002 0.002 0.003 0.017 0.084 0.263 0.562 1.000 1.000 0.562 0.263 0.084 0.017 0.003 0.002 0.002)))
(snd-display "blackman4 window: ~A" gen)))
(let ((gen (make-fft-window blackman5-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.000 0.003 0.022 0.097 0.280 0.574 1.000 1.000 0.574 0.280 0.097 0.022 0.003 0.000 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.000 0.003 0.022 0.097 0.280 0.574 1.000 1.000 0.574 0.280 0.097 0.022 0.003 0.000 0.000)))
(snd-display "blackman5 window: ~A" gen)))
(let ((gen (make-fft-window blackman6-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.000 0.001 0.011 0.064 0.223 0.520 1.000 1.000 0.520 0.223 0.064 0.011 0.001 0.000 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.000 0.001 0.011 0.064 0.223 0.520 1.000 1.000 0.520 0.223 0.064 0.011 0.001 0.000 0.000)))
(snd-display "blackman6 window: ~A" gen)))
(let ((gen (make-fft-window blackman7-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.000 0.000 0.006 0.042 0.177 0.471 1.000 1.000 0.471 0.177 0.042 0.006 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.000 0.000 0.006 0.042 0.177 0.471 1.000 1.000 0.471 0.177 0.042 0.006 0.000 0.000 0.000)))
(snd-display "blackman7 window: ~A" gen)))
(let ((gen (make-fft-window blackman8-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.000 0.000 0.003 0.028 0.141 0.426 1.000 1.000 0.426 0.141 0.028 0.003 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.000 0.000 0.003 0.028 0.141 0.426 1.000 1.000 0.426 0.141 0.028 0.003 0.000 0.000 0.000)))
(snd-display "blackman8 window: ~A" gen)))
(let ((gen (make-fft-window blackman9-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.000 0.000 0.001 0.018 0.112 0.385 1.000 1.000 0.385 0.112 0.018 0.001 0.000 0.000 -0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.000 0.000 0.001 0.018 0.112 0.385 1.000 1.000 0.385 0.112 0.018 0.001 0.000 0.000 -0.000)))
(snd-display "blackman9 window: ~A" gen)))
(let ((gen (make-fft-window blackman10-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.000 0.000 0.001 0.012 0.089 0.349 1.000 1.000 0.349 0.089 0.012 0.001 0.000 0.000 -0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.000 0.000 0.001 0.012 0.089 0.349 1.000 1.000 0.349 0.089 0.012 0.001 0.000 0.000 -0.000)))
(snd-display "blackman10 window: ~A" gen)))
(let ((gen (make-fft-window rv2-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.001 0.021 0.095 0.250 0.478 0.729 1.000 1.000 0.729 0.478 0.250 0.095 0.021 0.001 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.001 0.021 0.095 0.250 0.478 0.729 1.000 1.000 0.729 0.478 0.250 0.095 0.021 0.001 0.000)))
(snd-display "rv2 window: ~A" gen)))
(let ((gen (make-fft-window rv3-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.000 0.003 0.029 0.125 0.330 0.622 1.000 1.000 0.622 0.330 0.125 0.029 0.003 0.000 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.000 0.003 0.029 0.125 0.330 0.622 1.000 1.000 0.622 0.330 0.125 0.029 0.003 0.000 0.000)))
(snd-display "rv3 window: ~A" gen)))
(let ((gen (make-fft-window rv4-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.000 0.000 0.009 0.062 0.228 0.531 1.000 1.000 0.531 0.228 0.062 0.009 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.000 0.000 0.009 0.062 0.228 0.531 1.000 1.000 0.531 0.228 0.062 0.009 0.000 0.000 0.000)))
(snd-display "rv4 window: ~A" gen)))
(let ((gen (make-fft-window exponential-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.087 0.181 0.283 0.394 0.515 0.646 0.944 0.944 0.646 0.515 0.394 0.283 0.181 0.087 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.087 0.181 0.283 0.394 0.515 0.646 0.944 0.944 0.646 0.515 0.394 0.283 0.181 0.087 0.000)))
(snd-display "exponential window: ~A" gen)))
(let ((gen (make-fft-window riemann-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.139 0.300 0.471 0.637 0.784 0.900 1.000 1.000 0.900 0.784 0.637 0.471 0.300 0.139 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.139 0.300 0.471 0.637 0.784 0.900 1.000 1.000 0.900 0.784 0.637 0.471 0.300 0.139 0.000)))
(snd-display "riemann window: ~A" gen)))
(let ((gen (make-fft-window kaiser-window 16 2.5)))
- (if (not (mus-arrays-equal? gen (float-vector 0.304 0.426 0.550 0.670 0.779 0.871 0.941 1.000 1.000 0.941 0.871 0.779 0.670 0.550 0.426 0.304)))
+ (if (not (mus-arrays-equal? gen #r(0.304 0.426 0.550 0.670 0.779 0.871 0.941 1.000 1.000 0.941 0.871 0.779 0.670 0.550 0.426 0.304)))
(snd-display "kaiser window: ~A" gen)))
(let ((gen (make-fft-window cauchy-window 16 2.5)))
- (if (not (mus-arrays-equal? gen (float-vector 0.138 0.173 0.221 0.291 0.390 0.532 0.719 1.000 1.000 0.719 0.532 0.390 0.291 0.221 0.173 0.138)))
+ (if (not (mus-arrays-equal? gen #r(0.138 0.173 0.221 0.291 0.390 0.532 0.719 1.000 1.000 0.719 0.532 0.390 0.291 0.221 0.173 0.138)))
(snd-display "cauchy window: ~A" gen)))
(let ((gen (make-fft-window poisson-window 16 2.5)))
- (if (not (mus-arrays-equal? gen (float-vector 0.082 0.112 0.153 0.210 0.287 0.392 0.535 1.000 1.000 0.535 0.392 0.287 0.210 0.153 0.112 0.082)))
+ (if (not (mus-arrays-equal? gen #r(0.082 0.112 0.153 0.210 0.287 0.392 0.535 1.000 1.000 0.535 0.392 0.287 0.210 0.153 0.112 0.082)))
(snd-display "poisson window: ~A" gen)))
(let ((gen (make-fft-window gaussian-window 16 1.0)))
- (if (not (mus-arrays-equal? gen (float-vector 0.607 0.682 0.755 0.823 0.882 0.932 0.969 1.000 1.000 0.969 0.932 0.882 0.823 0.755 0.682 0.607)))
+ (if (not (mus-arrays-equal? gen #r(0.607 0.682 0.755 0.823 0.882 0.932 0.969 1.000 1.000 0.969 0.932 0.882 0.823 0.755 0.682 0.607)))
(snd-display "gaussian window: ~A" gen)))
(let ((gen (make-fft-window tukey-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.038 0.146 0.309 0.500 0.691 0.854 1.000 1.000 0.854 0.691 0.500 0.309 0.146 0.038 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.038 0.146 0.309 0.500 0.691 0.854 1.000 1.000 0.854 0.691 0.500 0.309 0.146 0.038 0.000)))
(snd-display "tukey window: ~A" gen)))
(let ((gen (make-fft-window hann-poisson-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.038 0.146 0.309 0.500 0.691 0.854 1.000 1.000 0.854 0.691 0.500 0.309 0.146 0.038 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.038 0.146 0.309 0.500 0.691 0.854 1.000 1.000 0.854 0.691 0.500 0.309 0.146 0.038 0.000)))
(snd-display "tukey window: ~A" gen)))
(let ((gen (make-fft-window bohman-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 0.000 0.006 0.048 0.151 0.318 0.533 0.755 1.000 1.000 0.755 0.533 0.318 0.151 0.048 0.006 0.000)))
+ (if (not (mus-arrays-equal? gen #r(0.000 0.006 0.048 0.151 0.318 0.533 0.755 1.000 1.000 0.755 0.533 0.318 0.151 0.048 0.006 0.000)))
(snd-display "bohman window: ~A" gen)))
(for-each
@@ -14765,14 +14674,14 @@ EDITS: 2
(incr (/ (* 2 pi) 16.0))
(i 0 (+ i 1))
(j 15 (- j 1))
- (ang 0.0 (+ ang incr)))
+ (ang 0.0))
((> i 8) ; yikes -- even size + smallness = questionable code...
(if (not (mus-arrays-equal? v1 v2))
(snd-display "~A by hand:~%; mus: ~A~%; loc: ~A" name v1 v2)))
(let ((val (func ang)))
(set! (v2 i) val)
- (set! (v2 j) val)))))
-
+ (set! (v2 j) val))
+ (set! ang (+ ang incr)))))
(list
(list hann-window "hann" (lambda (ang)
(- 0.5
@@ -14969,18 +14878,18 @@ EDITS: 2
(catch #t
(lambda ()
(let ((gen (make-fft-window samaraki-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 1.000 0.531 0.559 0.583 0.604 0.620 0.631 0.638 0.640 0.638 0.631 0.620 0.604 0.583 0.559 0.531)))
+ (if (not (mus-arrays-equal? gen #r(1.000 0.531 0.559 0.583 0.604 0.620 0.631 0.638 0.640 0.638 0.631 0.620 0.604 0.583 0.559 0.531)))
(snd-display "samaraki window: ~A" gen)))
(let ((gen (make-fft-window ultraspherical-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 1.000 0.033 0.034 0.035 0.036 0.036 0.037 0.037 0.037 0.037 0.037 0.036 0.036 0.035 0.034 0.033)))
+ (if (not (mus-arrays-equal? gen #r(1.000 0.033 0.034 0.035 0.036 0.036 0.037 0.037 0.037 0.037 0.037 0.036 0.036 0.035 0.034 0.033)))
(snd-display "ultraspherical window: ~A" gen)))
(let ((gen (make-fft-window dolph-chebyshev-window 16)))
- (if (not (mus-arrays-equal? gen (float-vector 1.000 0.033 0.034 0.035 0.036 0.036 0.037 0.037 0.037 0.037 0.037 0.036 0.036 0.035 0.034 0.033)))
+ (if (not (mus-arrays-equal? gen #r(1.000 0.033 0.034 0.035 0.036 0.036 0.037 0.037 0.037 0.037 0.037 0.036 0.036 0.035 0.034 0.033)))
(snd-display "dolph-chebyshev window: ~A" gen)))
(without-errors
(let ((gen (make-fft-window dolph-chebyshev-window 16 1.0)))
- (if (not (mus-arrays-equal? gen (float-vector 1.000 0.274 0.334 0.393 0.446 0.491 0.525 0.546 0.553 0.546 0.525 0.491 0.446 0.393 0.334 0.274)))
+ (if (not (mus-arrays-equal? gen #r(1.000 0.274 0.334 0.393 0.446 0.491 0.525 0.546 0.553 0.546 0.525 0.491 0.446 0.393 0.334 0.274)))
(snd-display "dolph-chebyshev window: ~A" gen))))
(let ((val1 (make-fft-window ultraspherical-window 16 0.0 0.0))
@@ -15002,13 +14911,13 @@ EDITS: 2
(when (defined? 'gsl-eigenvectors)
(let ((win (make-dpss-window 16 .01)))
- (if (not (mus-arrays-equal? win (float-vector 0.964 0.973 0.981 0.987 0.992 0.996 0.999 1.000 1.000 0.999 0.996 0.992 0.987 0.981 0.973 0.964)))
+ (if (not (mus-arrays-equal? win #r(0.964 0.973 0.981 0.987 0.992 0.996 0.999 1.000 1.000 0.999 0.996 0.992 0.987 0.981 0.973 0.964)))
(snd-display "make-dpss-window 16 .01: ~A" win)))
(let ((win (make-dpss-window 16 .1)))
- (if (not (mus-arrays-equal? win (float-vector 0.090 0.193 0.332 0.494 0.664 0.818 0.936 1.000 1.000 0.936 0.818 0.664 0.494 0.332 0.193 0.090)))
+ (if (not (mus-arrays-equal? win #r(0.090 0.193 0.332 0.494 0.664 0.818 0.936 1.000 1.000 0.936 0.818 0.664 0.494 0.332 0.193 0.090)))
(snd-display "make-dpss-window 16 .1: ~A" win)))
(let ((win (make-dpss-window 32 .09)))
- (if (not (mus-arrays-equal? win (float-vector 0.004 0.011 0.025 0.050 0.086 0.138 0.206 0.290 0.388 0.496 0.610 0.722 0.823 0.908 0.968 1.000
+ (if (not (mus-arrays-equal? win #r(0.004 0.011 0.025 0.050 0.086 0.138 0.206 0.290 0.388 0.496 0.610 0.722 0.823 0.908 0.968 1.000
1.000 0.968 0.908 0.823 0.722 0.610 0.496 0.388 0.290 0.206 0.138 0.086 0.050 0.025 0.011 0.004)))
(snd-display "make-dpss-window 32 .09: ~A" win)))
@@ -15024,7 +14933,7 @@ EDITS: 2
'(16 32)))
(let ((win (make-papoulis-window 32)))
- (if (not (mus-arrays-equal? win (float-vector 0.000 0.001 0.006 0.021 0.048 0.091 0.151 0.227 0.318 0.422 0.533 0.647 0.755 0.852 0.930 0.982
+ (if (not (mus-arrays-equal? win #r(0.000 0.001 0.006 0.021 0.048 0.091 0.151 0.227 0.318 0.422 0.533 0.647 0.755 0.852 0.930 0.982
1.000 0.982 0.930 0.852 0.755 0.647 0.533 0.422 0.318 0.227 0.151 0.091 0.048 0.021 0.006 0.001)))
(snd-display "make-papoulis-window 32: ~A" win)))
@@ -15103,7 +15012,7 @@ EDITS: 2
(let ((val (env gen)))
(if (fneq val (- (/ i 5.0) 1.0)) (snd-display "neg env: ~D ~A" (+ i 5) val)))))
(do ((gen (make-env '(0 0 1 -1 2 0) :length 11 :base 0.5))
- (v (float-vector 0.0 -0.14869 -0.31950 -0.51571 -0.74110 -1.0 -0.74110 -0.51571 -0.31950 -0.14869))
+ (v #r(0.0 -0.14869 -0.31950 -0.51571 -0.74110 -1.0 -0.74110 -0.51571 -0.31950 -0.14869))
(i 0 (+ i 1)))
((= i 10)
(mus-apply gen))
@@ -15118,109 +15027,109 @@ EDITS: 2
(let ((v (make-float-vector 10)))
(let ((e (make-env '(0 0 1 1) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
(snd-display "simple ramp: ~A" v)))
(let ((v (make-float-vector 10))
(e (make-env '(0 0 1 1) :base 0 :length 8)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000)))
(snd-display "simple ramp, base 0: ~A" v)))
(let ((v (make-float-vector 10))
(e (make-env '(0 0 1 1 2 .5) :base 0 :length 8)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 0.500 0.500)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 0.500 0.500)))
(snd-display "two-step, base 0: ~A" v)))
(let ((e (make-env '((0 0) (1 1)) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
(snd-display "simple ramp embedded: ~A" v)))
(let ((e (make-env '(0 1 1 0) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 1.000 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.000)))
+ (if (not (mus-arrays-equal? v #r(1.000 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.000)))
(snd-display "simple ramp down: ~A" v)))
(let ((e (make-env '(0 0 1 1 2 0) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
(snd-display "simple pyr: ~A" v)))
(let ((e (make-env '((0 0) (1 1) (2 0)) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
(snd-display "simple pyr embedded: ~A" v)))
(let ((e (make-env '(0 0 1 1 2 -.5) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
(snd-display "simple pyr -.5: ~A" v)))
(let ((e (make-env '((0 0) (1 1) (2 -.5)) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
(snd-display "simple pyr -.5 embedded: ~A" v)))
(let ((e (make-env '(0 0 1 1 2 -.5) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
(snd-display "simple pyr -.5: ~A" v))))
(let ((v (make-float-vector 10)))
- (let ((e (make-env (float-vector 0 0 1 1) :length 10)))
+ (let ((e (make-env #r(0 0 1 1) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
(snd-display "simple ramp: ~A" v)))
(let ((v (make-float-vector 10))
- (e (make-env (float-vector 0 0 1 1) :base 0 :length 8)))
+ (e (make-env #r(0 0 1 1) :base 0 :length 8)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000)))
(snd-display "simple ramp, base 0: ~A" v)))
(let ((v (make-float-vector 10))
- (e (make-env (float-vector 0 0 1 1 2 .5) :base 0 :length 8)))
+ (e (make-env #r(0 0 1 1 2 .5) :base 0 :length 8)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 0.500 0.500)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 0.500 0.500)))
(snd-display "two-step, base 0: ~A" v)))
- (let ((e (make-env (float-vector 0 1 1 0) :length 10)))
+ (let ((e (make-env #r(0 1 1 0) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 1.000 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.000)))
+ (if (not (mus-arrays-equal? v #r(1.000 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.000)))
(snd-display "simple ramp down: ~A" v)))
- (let ((e (make-env (float-vector 0 0 1 1 2 0) :length 10)))
+ (let ((e (make-env #r(0 0 1 1 2 0) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
(snd-display "simple pyr: ~A" v)))
- (let ((e (make-env (float-vector 0 0 1 1 2 -.5) :length 10)))
+ (let ((e (make-env #r(0 0 1 1 2 -.5) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
(snd-display "simple pyr -.5: ~A" v)))
- (let ((e (make-env (float-vector 0 0 1 1 2 -.5) :length 10)))
+ (let ((e (make-env #r(0 0 1 1 2 -.5) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
(snd-display "simple pyr -.5: ~A" v))))
(let ((v (make-float-vector 10)))
- (let ((e (make-env #(0 0 1 1) :length 10)))
+ (let ((e (make-env #r(0 0 1 1) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
(snd-display "simple ramp: ~A" v)))
(let ((v (make-float-vector 10))
- (e (make-env #(0 0 1 1) :base 0 :length 8)))
+ (e (make-env #r(0 0 1 1) :base 0 :length 8)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000)))
(snd-display "simple ramp, base 0: ~A" v)))
(let ((v (make-float-vector 10))
- (e (make-env #(0 0 1 1 2 .5) :base 0 :length 8)))
+ (e (make-env #r(0 0 1 1 2 .5) :base 0 :length 8)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 0.500 0.500)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 0.500 0.500)))
(snd-display "two-step, base 0: ~A" v)))
- (let ((e (make-env #(0 1 1 0) :length 10)))
+ (let ((e (make-env #r(0 1 1 0) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 1.000 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.000)))
+ (if (not (mus-arrays-equal? v #r(1.000 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.000)))
(snd-display "simple ramp down: ~A" v)))
- (let ((e (make-env #(0 0 1 1 2 0) :length 10)))
+ (let ((e (make-env #r(0 0 1 1 2 0) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
(snd-display "simple pyr: ~A" v)))
- (let ((e (make-env #(0 0 1 1 2 -.5) :length 10)))
+ (let ((e (make-env #r(0 0 1 1 2 -.5) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
(snd-display "simple pyr -.5: ~A" v)))
- (let ((e (make-env #(0 0 1 1 2 -.5) :length 10)))
+ (let ((e (make-env #r(0 0 1 1 2 -.5) :length 10)))
(env-fill v e)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
(snd-display "simple pyr -.5: ~A" v)))))
(let ((e (make-env '(0 0 1 1) :length 10)))
@@ -15234,28 +15143,28 @@ EDITS: 2
(let ((val (env e)))
(if (fneq val (* i .111111)) (snd-display "ramp env over 10: ~A at ~A" val i)))))
(do ((e (make-env '(0 0 .5 .5 1 1) :base 32 :length 10))
- (v (float-vector 0.0 0.0243 0.0667 0.1412 0.2716 0.5000 0.5958 0.7090 0.8425 1.0))
+ (v #r(0.0 0.0243 0.0667 0.1412 0.2716 0.5000 0.5958 0.7090 0.8425 1.0))
(i 0 (+ i 1))
(x 0.0 (+ x 0.11111)))
((= i 10))
(let ((val (env-interp x e)))
(if (fneq val (v i)) (snd-display "(0 .5 1) env-interp over 10: ~A at ~A (~A)" val i (v i)))))
(do ((e (make-env '(0 -1.0 1 1) :base 32 :length 10))
- (v (float-vector -1.0 -0.9697 -0.9252 -0.8597 -0.7635 -0.6221 -0.4142 -0.1088 0.34017 1.0))
+ (v #r(-1.0 -0.9697 -0.9252 -0.8597 -0.7635 -0.6221 -0.4142 -0.1088 0.34017 1.0))
(i 0 (+ i 1))
(x 0.0 (+ x 0.11111)))
((= i 10))
(let ((val (env-interp x e)))
(if (fneq val (v i)) (snd-display "(-1 1) env-interp over 10: ~A at ~A (~A)" val i (v i)))))
(do ((e (make-env '(0 -1.0 .5 .5 1 0) :base 32 :length 10))
- (v (float-vector -1.0 -0.952 -0.855 -0.661 -0.274 0.5 0.356 0.226 0.107 0.0))
+ (v #r(-1.0 -0.952 -0.855 -0.661 -0.274 0.5 0.356 0.226 0.107 0.0))
(i 0 (+ i 1))
(x 0.0 (+ x 0.11111)))
((= i 10))
(let ((val (env-interp x e)))
(if (fneq val (v i)) (snd-display "(-1 .5 0) env-interp over 10: ~A at ~A (~A)" val i (v i)))))
(do ((e (make-env '(0 0.0 .5 .5 1 -1.0) :base 32 :length 10))
- (v (float-vector 0.0 0.085 0.177 0.276 0.384 0.5 -0.397 -0.775 -0.933 -1.0))
+ (v #r(0.0 0.085 0.177 0.276 0.384 0.5 -0.397 -0.775 -0.933 -1.0))
(i 0 (+ i 1))
(x 0.0 (+ x 0.11111)))
((= i 10))
@@ -15278,7 +15187,7 @@ EDITS: 2
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (env e)))
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
(snd-display "e set off 0: ~A" v))
(if (not (= (mus-length e) 10)) (snd-display "e set off 0 len: ~A" (mus-length e)))
(if (fneq (mus-scaler e) 1.0) (snd-display "e set off 0 scl: ~A" (mus-scaler e)))
@@ -15287,7 +15196,7 @@ EDITS: 2
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (env e)))
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.400 0.800 1.200 1.600 2.000 1.500 1.000 0.500 0.000)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.400 0.800 1.200 1.600 2.000 1.500 1.000 0.500 0.000)))
(snd-display "e set off 1: ~A" v))
(if (not (= (mus-length e) 10)) (snd-display "e set off 1 len: ~A" (mus-length e)))
(if (fneq (mus-scaler e) 2.0) (snd-display "e set off 1 scl: ~A" (mus-scaler e)))
@@ -15296,7 +15205,7 @@ EDITS: 2
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (env e)))
- (if (not (mus-arrays-equal? v (float-vector 1.000 1.400 1.800 2.200 2.600 3.000 2.500 2.000 1.500 1.000)))
+ (if (not (mus-arrays-equal? v #r(1.000 1.400 1.800 2.200 2.600 3.000 2.500 2.000 1.500 1.000)))
(snd-display "e set off 2: ~A" v))
(if (not (= (mus-length e) 10)) (snd-display "e set off 2 len: ~A" (mus-length e)))
(if (fneq (mus-scaler e) 2.0) (snd-display "e set off 2 scl: ~A" (mus-scaler e)))
@@ -15305,22 +15214,22 @@ EDITS: 2
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (env e)))
- (if (not (mus-arrays-equal? v (float-vector 1.000 1.222 1.444 1.667 1.889 2.111 2.333 2.556 2.778 3.000)))
+ (if (not (mus-arrays-equal? v #r(1.000 1.222 1.444 1.667 1.889 2.111 2.333 2.556 2.778 3.000)))
(snd-display "e set off 3: ~A" v))
(if (not (= (mus-length e) 19)) (snd-display "e set off 3 len: ~A" (mus-length e)))
(if (fneq (mus-scaler e) 2.0) (snd-display "e set off 3 scl: ~A" (mus-scaler e)))
(if (fneq (mus-offset e) 1.0) (snd-display "e set off 3 off: ~A" (mus-offset e))))
- (do ((e (make-env (float-vector 0 0 1 1 2 0) :length 10))
+ (do ((e (make-env #r(0 0 1 1 2 0) :length 10))
(v (make-float-vector 10))
(i 0 (+ i 1)))
((= i 10)
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (if (not (mus-arrays-equal? v #r(0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
(snd-display "e from float-vector: ~A" v)))
(set! (v i) (env e)))
(do ((e1 (make-env '(0 0 1 1) :base 32.0 :length 11))
- (v (float-vector 0.000 0.013 0.032 0.059 0.097 0.150 0.226 0.333 0.484 0.698 1.00))
+ (v #r(0.000 0.013 0.032 0.059 0.097 0.150 0.226 0.333 0.484 0.698 1.00))
(i 0 (+ i 1)))
((> i 10))
(let ((val (env e1)))
@@ -15328,21 +15237,21 @@ EDITS: 2
(snd-display "exp env direct (32.0): ~A ~A" val (v i)))))
(do ((e1 (make-env '(0 1 1 2) :base 32.0 :length 11))
- (v (float-vector 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00))
+ (v #r(1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00))
(i 0 (+ i 1)))
((> i 10))
(let ((val (env e1)))
(if (fneq val (v i))
(snd-display "exp env direct (32.0) offset: ~A ~A" val (v i)))))
(do ((e1 (make-env '((0 1) (1 2)) :base 32.0 :length 11))
- (v (float-vector 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00))
+ (v #r(1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00))
(i 0 (+ i 1)))
((> i 10))
(let ((val (env e1)))
(if (fneq val (v i))
(snd-display "exp env direct (32.0) offset embedded: ~A ~A" val (v i)))))
(do ((e1 (make-env '(0 1 1 2) :base 32.0 :length 11))
- (v (float-vector 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00))
+ (v #r(1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00))
(i 0 (+ i 1)))
((> i 10))
(let ((val (env e1)))
@@ -15350,7 +15259,7 @@ EDITS: 2
(snd-display "exp env direct (32.0) offset (and dur): ~A ~A" val (v i)))))
(do ((e1 (make-env '(0 0 1 1) :base 0.032 :length 11))
- (v (float-vector 0.000 0.301 0.514 0.665 0.772 0.848 0.902 0.940 0.967 0.986 1.0))
+ (v #r(0.000 0.301 0.514 0.665 0.772 0.848 0.902 0.940 0.967 0.986 1.0))
(i 0 (+ i 1)))
((> i 10))
(let ((val (env e1)))
@@ -15537,21 +15446,21 @@ EDITS: 2
(let ((val1 (with-sound ((make-float-vector 20))
(do ((e (make-env env-any-env :length 20))
- (bases (float-vector 32.0 0.3 1.5))
+ (bases #r(32.0 0.3 1.5))
(i 0 (+ i 1)))
((= i 20))
(outa i (multi-expt-env e bases)))))
(val2 (with-sound ((make-float-vector 20))
(do ((e (make-env env-any-env :length 20))
- (bases (float-vector 32.0 0.3 1.5))
+ (bases #r(32.0 0.3 1.5))
(i 0 (+ i 1)))
((= i 20))
(outa i (multi-expt-env e bases)))))
(val3 (with-sound ((make-float-vector 20))
(do ((e (make-env env-any-env :length 20))
- (bases (float-vector 32.0 0.3 1.5))
+ (bases #r(32.0 0.3 1.5))
(i 0 (+ i 1)))
((= i 20))
(outa i (multi-expt-env-1 e bases))))))
@@ -15586,15 +15495,28 @@ EDITS: 2
(let ((ind (new-sound :size 20)))
(select-sound ind)
(map-channel (lambda (y) 1.0))
- (bumpy)
- (let ((vals (channel->float-vector)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.0 0.001 0.021 0.105 0.264 0.467 0.673 0.846 0.960 1.000 0.960 0.846 0.673 0.467 0.264 0.105 0.021 0.001 0.0)))
- (snd-display "bumpy: ~A" vals)))
+ (let ((bumpy (lambda ()
+ (let ((x 0.0)
+ (xi (/ 1.0 (framples)))
+ (start 0)
+ (end 1))
+ (let ((scl (exp (/ 4.0 (- end start))))) ; normalize it
+ (map-channel (lambda (y)
+ (let ((val (if (not (< start x end))
+ 0.0
+ (exp (+ (/ -1.0 (- x start))
+ (/ -1.0 (- end x)))))))
+ (set! x (+ x xi))
+ (* scl val)))))))))
+ (bumpy)
+ (let ((vals (channel->float-vector)))
+ (if (not (mus-arrays-equal? vals #r(0.0 0.0 0.001 0.021 0.105 0.264 0.467 0.673 0.846 0.960 1.000 0.960 0.846 0.673 0.467 0.264 0.105 0.021 0.001 0.0)))
+ (snd-display "bumpy: ~A" vals))))
(if (fneq (channel-lp-inf) 1.0) ; just a fancy name for maxamp
(snd-display "channel-lp-inf: ~A" (channel-lp-inf)))
(linear-src-channel 2.0)
(let ((vals (channel->float-vector)))
- (if (not (mus-arrays-equal? vals (float-vector 0.000 0.001 0.105 0.467 0.846 1.000 0.846 0.467 0.105 0.001)))
+ (if (not (mus-arrays-equal? vals #r(0.000 0.001 0.105 0.467 0.846 1.000 0.846 0.467 0.105 0.001)))
(snd-display "linear-src-channel: ~A" vals)))
(let-temporarily ((*clipping* #t))
(save-sound-as "tst.snd")
@@ -15641,7 +15563,7 @@ EDITS: 2
(let ((gen4 (make-table-lookup 440.0 :wave (partials->wave '(1 1 2 1)))))
(fill-float-vector v2 (if (table-lookup? gen4) (table-lookup gen4 0.0) -1.0))
(if (not (mus-arrays-equal? v0 v2)) (snd-display "map table-lookup: ~A ~A" v0 v2))
- (set! gen4 (make-table-lookup 440.0 :wave (partials->wave (float-vector 1 1 2 1))))
+ (set! gen4 (make-table-lookup 440.0 :wave (partials->wave #r(1 1 2 1))))
(fill-float-vector v2 (table-lookup gen4)))
(if (not (mus-arrays-equal? v0 v2)) (snd-display "map table-lookup (no fm): ~A ~A" v0 v2)))
(if (not (table-lookup? gen)) (snd-display "~A not table-lookup?" gen))
@@ -15689,7 +15611,7 @@ EDITS: 2
(if (fneq (vals i) (sin (+ (* .25 pi) (/ (* 2 pi i) 16))))
(snd-display "phase-partials->wave 1 1 .25 at ~D: ~A ~A" i (vals i) (sin (+ (* .25 pi) (/ (* 2 pi i) 16))))))
- (do ((vals (phase-partials->wave (float-vector 1 1 0 2 1 0) (make-float-vector 16) #f))
+ (do ((vals (phase-partials->wave #r(1 1 0 2 1 0) (make-float-vector 16) #f))
(i 0 (+ i 1)))
((= i 16))
(if (fneq (vals i) (+ (sin (/ (* 2 pi i) 16)) (sin (/ (* 4 pi i) 16))))
@@ -15703,7 +15625,7 @@ EDITS: 2
(snd-display "phase-partials->wave 1 1 0 2 1 .5 at ~D: ~A ~A" i (vals i)
(+ (sin (/ (* 2 pi i) 16)) (sin (+ (* .5 pi) (/ (* 4 pi i) 16)))))))
- (test-gen-equal (make-table-lookup 440.0 :wave (partials->wave (float-vector 1 1 2 1)))
+ (test-gen-equal (make-table-lookup 440.0 :wave (partials->wave #r(1 1 2 1)))
(make-table-lookup 440.0 :wave (partials->wave '(1 1 2 1)))
(make-table-lookup 100.0 :wave (partials->wave '(1 1 2 1))))
(test-gen-equal (make-table-lookup 440.0 :wave (partials->wave '(1 1 2 1)))
@@ -15723,46 +15645,50 @@ EDITS: 2
(do ((gen (make-table-lookup 440.0 :wave (partials->wave '(1 1))))
(incr (/ (* 2 pi 440.0) 22050.0))
(i 0 (+ i 1))
- (a 0.0 (+ a incr)))
+ (a 0.0))
((= i 1100))
(let ((val1 (sin a))
(val2 (gen 0.0)))
(if (fneq val1 val2)
- (snd-display "table lookup (1 1): ~A: ~A ~A" i val1 val2))))
+ (snd-display "table lookup (1 1): ~A: ~A ~A" i val1 val2)))
+ (set! a (+ a incr)))
(do ((gen (make-table-lookup 4.0 :wave (partials->wave '(1 1))))
(incr (/ (* 2 pi 4.0) 22050.0))
(i 0 (+ i 1))
- (a 0.0 (+ a incr)))
+ (a 0.0))
((= i 1100))
(let ((val1 (sin a))
(val2 (gen 0.0)))
(if (fneq val1 val2)
- (snd-display "table lookup (1 1) 4: ~A: ~A ~A" i val1 val2))))
+ (snd-display "table lookup (1 1) 4: ~A: ~A ~A" i val1 val2)))
+ (set! a (+ a incr)))
(do ((gen (make-table-lookup 440.0 :wave (partials->wave '(1 .75 3 .25))))
(incr (/ (* 2 pi 440.0) 22050.0))
(i 0 (+ i 1))
- (a 0.0 (+ a incr)))
+ (a 0.0))
((= i 1100))
(let ((val1 (+ (* .75 (sin a)) (* .25 (sin (* 3 a)))))
(val2 (gen 0.0)))
(if (fneq val1 val2)
- (snd-display "table lookup (1 .75 3 .25): ~A: ~A ~A" i val1 val2))))
+ (snd-display "table lookup (1 .75 3 .25): ~A: ~A ~A" i val1 val2)))
+ (set! a (+ a incr)))
(do ((gen (make-table-lookup 0.0 :wave (partials->wave '(1 1))))
(gen1 (make-table-lookup 40.0 :wave (partials->wave '(1 1))))
(incr (/ (* 2 pi 40.0) 22050.0))
(a1 0.0)
(i 0 (+ i 1))
- (a 0.0 (+ a incr)))
+ (a 0.0))
((= i 100))
(let ((fm (sin a))
(val1 (sin a1))
(val2 (table-lookup gen (table-lookup gen1 0.0))))
(set! a1 (+ a1 fm))
(if (fneq val1 val2)
- (snd-display "lookup/lookup fm: ~A: ~A ~A" i val1 val2))))
+ (snd-display "lookup/lookup fm: ~A: ~A ~A" i val1 val2)))
+ (set! a (+ a incr)))
(for-each
(lambda (args)
@@ -15777,15 +15703,15 @@ EDITS: 2
(if (not (or (mus-arrays-equal? v vals)
(= type mus-interp-all-pass)
(and (= type mus-interp-none)
- (mus-arrays-equal? v (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000)))))
+ (mus-arrays-equal? v #r(0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000)))))
(snd-display "tbl interp ~A: ~A" type v))
(if (not (= (mus-interp-type tbl1) type)) (snd-display "tbl interp-type (~A): ~A" type (mus-interp-type tbl1)))))))
(list
- (list mus-interp-none (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 1.000))
- (list mus-interp-linear (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.800 0.600 0.400 0.200))
- (list mus-interp-lagrange (float-vector 0.000 0.120 0.280 0.480 0.720 1.000 0.960 0.840 0.640 0.360))
- (list mus-interp-all-pass (float-vector 1.000 0.000 0.429 0.143 0.095 0.905 0.397 0.830 0.793 0.912))
- (list mus-interp-hermite (float-vector 0.000 0.168 0.424 0.696 0.912 1.000 0.912 0.696 0.424 0.168))))
+ (list mus-interp-none #r(0.000 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 1.000))
+ (list mus-interp-linear #r(0.000 0.200 0.400 0.600 0.800 1.000 0.800 0.600 0.400 0.200))
+ (list mus-interp-lagrange #r(0.000 0.120 0.280 0.480 0.720 1.000 0.960 0.840 0.640 0.360))
+ (list mus-interp-all-pass #r(1.000 0.000 0.429 0.143 0.095 0.905 0.397 0.830 0.793 0.912))
+ (list mus-interp-hermite #r(0.000 0.168 0.424 0.696 0.912 1.000 0.912 0.696 0.424 0.168))))
;; this is different if doubles -- not sure whether it's a bug or not
(let ((size 1000)
@@ -15794,9 +15720,10 @@ EDITS: 2
(do ((v (make-float-vector tbl-size))
(xp (/ (* 2 pi) tbl-size))
(i 0 (+ i 1))
- (x 0.0 (+ x xp)))
+ (x 0.0))
((= i tbl-size) v)
- (set! (v i) (sin x))))))
+ (set! (v i) (sin x))
+ (set! x (+ x xp))))))
(do ((fm (make-table-lookup (* mc-ratio freq) :wave sine))
(carrier (make-table-lookup freq :wave sine))
(i beg (+ i 1)))
@@ -15867,10 +15794,10 @@ EDITS: 2
(make-polyshape 440.0)
(make-polyshape 440.0 :partials '(1 1 2 .5)))
(test-gen-equal (make-polyshape 440.0 :partials '(1 1))
- (make-polyshape 440.0 :partials (float-vector 1 1))
+ (make-polyshape 440.0 :partials #r(1 1))
(make-polyshape 440.0 :partials '(1 .5)))
(test-gen-equal (make-polyshape 440.0 :partials '(1 .1 2 1 3 .5))
- (make-polyshape 440.0 :partials (float-vector 1 .1 2 1 3 .5))
+ (make-polyshape 440.0 :partials #r(1 .1 2 1 3 .5))
(make-polyshape 440.0 :partials '(1 .1 2 .1 3 .5)))
(do ((gen (make-polyshape 440.0 :partials '(1 1)))
@@ -15894,7 +15821,7 @@ EDITS: 2
(snd-display "polyshaper default: '(1 1) ~A: ~A ~A" i val1 val2)
(set! happy #f))))
- (do ((gen (make-polyshape 440.0 :partials (float-vector 1 1)))
+ (do ((gen (make-polyshape 440.0 :partials #r(1 1)))
(happy #t)
(i 0 (+ i 1)))
((or (not happy) (= i 1100)))
@@ -15914,7 +15841,7 @@ EDITS: 2
(incr (/ (* 2 pi 40.0) 22050.0))
(happy #t)
(i 0 (+ i 1))
- (a 0.0 (+ a incr)))
+ (a 0.0))
((or (not happy) (= i 400)))
(let ((fm (cos a))
(val1 (cos a1))
@@ -15922,7 +15849,8 @@ EDITS: 2
(set! a1 (+ a1 fm))
(when (> (abs (- val1 val2)) .002)
(snd-display "polyshape fm: ~A: ~A ~A" i val1 val2)
- (set! happy #f))))
+ (set! happy #f)))
+ (set! a (+ a incr)))
(for-each
(lambda (amps name)
@@ -15950,8 +15878,8 @@ EDITS: 2
(if (not (mus-arrays-equal? data1 data2))
(snd-display "~A: ~A~%~A~%" name data1 data2)))))
- (list (float-vector 0.0 1.0)
- (float-vector 0.0 0.5 0.25 0.25)
+ (list #r(0.0 1.0)
+ #r(0.0 0.5 0.25 0.25)
(make-float-vector 100 0.01)
(make-float-vector 1000 0.001))
'(one-cos
@@ -15985,8 +15913,8 @@ EDITS: 2
(if (not (mus-arrays-equal? data1 data2))
(snd-display "~A: ~A~%~A~%" name data1 data2)))))
- (list (float-vector 0.0 1.0)
- (float-vector 0.0 0.5 0.25 0.25)
+ (list #r(0.0 1.0)
+ #r(0.0 0.5 0.25 0.25)
(make-float-vector 100 0.01)
(make-float-vector 1000 0.001))
'(one-sin
@@ -16026,12 +15954,12 @@ EDITS: 2
(if (not (mus-arrays-equal? data1 data2))
(snd-display "~A: ~A~%~A~%" name data1 data2)))))
- (list (float-vector 0.0 1.0)
- (float-vector 0.0 0.25 0.0 0.25)
+ (list #r(0.0 1.0)
+ #r(0.0 0.25 0.0 0.25)
(make-float-vector 100 .004)
(make-float-vector 1000 0.0005))
- (list (float-vector 0.0 0.0)
- (float-vector 0.0 0.25 0.25 0.0)
+ (list #r(0.0 0.0)
+ #r(0.0 0.25 0.25 0.0)
(make-float-vector 100 .006)
(make-float-vector 1000 0.0005))
'(one-tu
@@ -16058,7 +15986,7 @@ EDITS: 2
(v1 (make-float-vector 10)))
(fill-float-vector v1 (if (polywave? gen1) (polywave gen1 0.0) -1.0))
(if (not (mus-arrays-equal? v0 v1)) (snd-display "map polywave: ~A ~A" v0 v1))
- (set! gen1 (make-polywave 440.0 (float-vector 1 1)))
+ (set! gen1 (make-polywave 440.0 #r(1 1)))
(fill-float-vector v1 (polywave gen1))
(if (not (mus-arrays-equal? v0 v1)) (snd-display "1 map polywave: ~A ~A" v0 v1)))
(if (not (polywave? gen)) (snd-display "~A not polywave?" gen))
@@ -16078,10 +16006,10 @@ EDITS: 2
(make-polywave 440.0)
(make-polywave 440.0 '(1 1 2 .5)))
(test-gen-equal (make-polywave 440.0 '(1 1))
- (make-polywave 440.0 (float-vector 1 1))
+ (make-polywave 440.0 #r(1 1))
(make-polywave 440.0 '(1 .5)))
(test-gen-equal (make-polywave 440.0 '(1 .1 2 1 3 .5))
- (make-polywave 440.0 (float-vector 1 .1 2 1 3 .5))
+ (make-polywave 440.0 #r(1 .1 2 1 3 .5))
(make-polywave 440.0 '(1 .1 2 .1 3 .5)))
(do ((gen (make-polywave 440.0 '(1 1)))
@@ -16104,7 +16032,7 @@ EDITS: 2
(snd-display "polywaver default: '(1 1) ~A: ~A ~A" i val1 val2)
(set! happy #f))))
- (let ((gen (make-polywave 440.0 (float-vector 1 1)))
+ (let ((gen (make-polywave 440.0 #r(1 1)))
(happy #t))
(set! (mus-scaler gen) 0.5)
(do ((i 0 (+ i 1)))
@@ -16251,7 +16179,7 @@ EDITS: 2
(let* ((gen (make-polywave 100.0 '(1 .9 3 .1 4 0.0)))
(vals (mus-data gen)))
(if (not (and (float-vector? vals)
- (mus-arrays-equal? vals (float-vector 0.000 0.900 0.000 0.100 0.00))))
+ (mus-arrays-equal? vals #r(0.000 0.900 0.000 0.100 0.00))))
(snd-display "polywave mus-data: ~A" vals)
(begin
(float-vector-set! (mus-data gen) 2 .1)
@@ -16351,10 +16279,10 @@ EDITS: 2
(snd-display "wt tbl interp ~A: ~A ~A" type v (mus-describe tbl1)))
(if (not (= (mus-interp-type tbl1) type)) (snd-display "wt tbl interp-type (~A): ~A" type (mus-interp-type tbl1)))))))
(list
- (list mus-interp-none (float-vector 0.000 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000))
- (list mus-interp-linear (float-vector 0.200 0.800 0.000 0.000 0.000 0.000 0.000 0.000 0.200 0.800))
- (list mus-interp-lagrange (float-vector 0.120 0.960 -0.080 0.000 0.000 0.000 0.000 0.000 0.120 0.960))
- (list mus-interp-hermite (float-vector 0.168 0.912 -0.064 -0.016 0.000 0.000 0.000 0.000 0.168 0.912))))
+ (list mus-interp-none #r(0.000 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000))
+ (list mus-interp-linear #r(0.200 0.800 0.000 0.000 0.000 0.000 0.000 0.000 0.200 0.800))
+ (list mus-interp-lagrange #r(0.120 0.960 -0.080 0.000 0.000 0.000 0.000 0.000 0.120 0.960))
+ (list mus-interp-hermite #r(0.168 0.912 -0.064 -0.016 0.000 0.000 0.000 0.000 0.168 0.912))))
(let ((tag (catch #t (lambda () (make-wave-train :size 0)) (lambda args (car args)))))
(if (not (eq? tag 'out-of-range)) (snd-display "wave-train size 0: ~A" tag)))
@@ -16382,16 +16310,16 @@ EDITS: 2
(clean-up-sound ind))
(let ((ind (new-sound :size 1000))
- (gen (make-wave-train 1000.0 :wave (float-vector 0.0 .1 .2 .3 .4 .5 .6))))
+ (gen (make-wave-train 1000.0 :wave #r(0.0 .1 .2 .3 .4 .5 .6))))
(map-channel (lambda (y) (wave-train gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.6) (snd-display "wt 0 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
+ #r(0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.600)))
(snd-display "wt 0 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 85 30)
- (float-vector 0.000 0.000 0.000 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.000 0.000 0.000 0.000
+ #r(0.000 0.000 0.000 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.100 0.200 0.300)))
(snd-display "wt 0 data 85: ~A" (channel->float-vector 85 30)))
(undo)
@@ -16401,7 +16329,7 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display "wt 1 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
+ #r(0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000)))
(let-temporarily ((*print-length* 32))
(snd-display "wt 1 data: ~A" (channel->float-vector 0 30))))
@@ -16412,15 +16340,15 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display "wt 2 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.100 0.100 0.100
+ #r(0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.100 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100)))
(snd-display "wt 2 data: ~A" (channel->float-vector 0 30)))
(if (not (or (mus-arrays-equal? (channel->float-vector 440 30)
- (float-vector 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.100 0.100
+ #r(0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100 0.100 0.100 0.100 0.100 0.100))
;; if double, round off is just enough different to cause an off-by-1 problem here (and below)
(mus-arrays-equal? (channel->float-vector 440 30)
- (float-vector 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100 0.100
+ #r(0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100 0.100 0.100 0.100 0.100 0.100))))
(snd-display "wt 2 data 440: ~A" (channel->float-vector 440 30)))
(undo)
@@ -16430,11 +16358,11 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.2) (snd-display "wt 3 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.100 0.100 0.100 0.100 0.100
+ #r(0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.100 0.100 0.100 0.100 0.100
0.200 0.200 0.200 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.100 0.100 0.100 0.100 0.100)))
(snd-display "wt 3 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 440 30)
- (float-vector 0.100 0.200 0.200 0.200 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.100 0.100 0.100 0.100
+ #r(0.100 0.200 0.200 0.200 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.100 0.100 0.100 0.100
0.100 0.200 0.200 0.200 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.100 0.100 0.100 0.100)))
(snd-display "wt 3 data 440: ~A" (channel->float-vector 440 30)))
(undo)
@@ -16444,11 +16372,11 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.3) (snd-display "wt 4 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.200 0.300
+ #r(0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.200 0.300
0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.300 0.200 0.200)))
(snd-display "wt 4 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 440 30)
- (float-vector 0.200 0.200 0.300 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.300 0.300 0.200 0.200 0.200
+ #r(0.200 0.200 0.300 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.300 0.300 0.200 0.200 0.200
0.300 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.300 0.200)))
(snd-display "wt 4 data 440: ~A" (channel->float-vector 440 30)))
(undo)
@@ -16464,15 +16392,15 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display "wt 5 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000
+ #r(0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100)))
(snd-display "wt 5 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 440 30)
- (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.100
+ #r(0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.100)))
(snd-display "wt 5 data 440: ~A" (channel->float-vector 440 30)))
(if (not (mus-arrays-equal? (channel->float-vector 900 30)
- (float-vector 0.100 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100
+ #r(0.100 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.100 0.100 0.100 0.100)))
(snd-display "wt 5 data 900: ~A" (channel->float-vector 900 30)))
(undo)
@@ -16491,18 +16419,18 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.704) (snd-display "wt 6 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000
+ #r(0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "wt 6 data: ~A" (channel->float-vector 0 30)))
(if (not (or (mus-arrays-equal? (channel->float-vector 440 30)
- (float-vector 0.000 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.000 0.000 0.000 0.000
+ #r(0.000 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))
(mus-arrays-equal? (channel->float-vector 440 30)
- (float-vector 0.000 0.000 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.000 0.000 0.000 0.000
+ #r(0.000 0.000 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
(snd-display "wt 6 data 440: ~A" (channel->float-vector 440 30)))
(if (not (mus-arrays-equal? (channel->float-vector 900 30)
- (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
+ #r(0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.639 0.639 0.639)))
(snd-display "wt 6 data 900: ~A" (channel->float-vector 900 30)))
(undo)
@@ -16626,7 +16554,7 @@ EDITS: 2
(let ((gen (make-file->frample "oboe.snd"))
(v0 (make-float-vector 10))
- (g1 (float-vector 0.0)))
+ (g1 #r(0.0)))
(print-and-check gen
"file->frample"
"file->frample \"oboe.snd\""
@@ -16688,13 +16616,13 @@ EDITS: 2
(x 0.0 (+ x 0.1)))
((= i 10))
(outa i x gen))
- (if (not (mus-arrays-equal? gen (float-vector 0 .1 .2 .3 .4 .5 .6 .7 .8 .9)))
+ (if (not (mus-arrays-equal? gen #r(0 .1 .2 .3 .4 .5 .6 .7 .8 .9)))
(snd-display "outa->float-vector ramp: ~A" gen))
(do ((i 0 (+ i 1))
(x 0.0 (+ x 0.1)))
((= i 10))
(outa i x gen))
- (if (not (mus-arrays-equal? gen (float-vector-scale! (float-vector 0 .1 .2 .3 .4 .5 .6 .7 .8 .9) 2.0)))
+ (if (not (mus-arrays-equal? gen (float-vector-scale! #r(0 .1 .2 .3 .4 .5 .6 .7 .8 .9) 2.0)))
(snd-display "outa->float-vector ramp 2: ~A" gen))
(if (not (= (mus-channels gen) 1)) (snd-display "mus-channels float-vector: ~A" (mus-channels gen))))
@@ -16817,7 +16745,7 @@ EDITS: 2
(v1 (make-float-vector 5))
(i 0 (+ i 1)))
((= i 5)
- (if (not (mus-arrays-equal? v1 (float-vector 1.0 0.5 0.25 0.125 0.0)))
+ (if (not (mus-arrays-equal? v1 #r(1.0 0.5 0.25 0.125 0.0)))
(snd-display "vector in-any -> ~A?" v1)))
(set! (v1 i) (in-any i 0 v)))
@@ -16829,7 +16757,7 @@ EDITS: 2
(do ((i 0 (+ i 1)))
((= i 10))
(outa i (ina i invals))))))
- (if (not (mus-arrays-equal? result (float-vector 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
+ (if (not (mus-arrays-equal? result #r(0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
(snd-display "ina from float-vector: ~A" result))))
(let ((invals (make-float-vector 10)))
@@ -16840,7 +16768,7 @@ EDITS: 2
(do ((i 0 (+ i 1)))
((= i 10))
(outa i (ina i invals))))))
- (if (not (mus-arrays-equal? result (float-vector 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
+ (if (not (mus-arrays-equal? result #r(0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
(snd-display "run ina from float-vector: ~A" result))))
(for-each close-sound (sounds))
@@ -16943,26 +16871,26 @@ EDITS: 2
(let ((ind (open-sound "fmv.snd")))
(let ((c0 (channel->float-vector 0 15 ind 0))
(c1 (channel->float-vector 0 15 ind 1)))
- (if (not (mus-arrays-equal? c0 (float-vector 0.0 0.1 0.2 0.3 0.4 0.5 0.58 0.66 0.74 0.82 -0.1 -0.12 -0.14 -0.16 -0.18)))
+ (if (not (mus-arrays-equal? c0 #r(0.0 0.1 0.2 0.3 0.4 0.5 0.58 0.66 0.74 0.82 -0.1 -0.12 -0.14 -0.16 -0.18)))
(snd-display "continue-sample->file (0): ~A" c0))
- (if (not (mus-arrays-equal? c1 (float-vector 0.0 0.01 0.02 0.03 0.04 0.05 0.05 0.05 0.05 0.05 -0.05 -0.06 -0.07 -0.08 -0.09)))
+ (if (not (mus-arrays-equal? c1 #r(0.0 0.01 0.02 0.03 0.04 0.05 0.05 0.05 0.05 0.05 -0.05 -0.06 -0.07 -0.08 -0.09)))
(snd-display "continue-sample->file (1): ~A" c1)))
(close-sound ind))
(delete-file "fmv.snd")
(mus-sound-forget "fmv.snd")
- (let ((f1 (float-vector 1.0 1.0))
- (f2 (float-vector 0.0 0.0))
- (m1 (float-vector .5 .25 .125 1.0)))
+ (let ((f1 #r(1.0 1.0))
+ (f2 #r(0.0 0.0))
+ (m1 #r(.5 .25 .125 1.0)))
(let ((result (frample->frample m1 f1 2 f2 2)))
- (if (not (equal? result (float-vector 0.625 1.25)))
+ (if (not (equal? result #r(0.625 1.25)))
(snd-display "frample->frample: ~A" result))))
- (let ((f1 (float-vector 1.0 2.0 3.0))
- (f2 (float-vector 0.0 0.0 0.0))
- (m1 (float-vector 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0)))
+ (let ((f1 #r(1.0 2.0 3.0))
+ (f2 #r(0.0 0.0 0.0))
+ (m1 #r(1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0)))
(let ((result (frample->frample m1 f1 3 f2 3)))
- (if (not (equal? result (float-vector 30.0 36.0 42.0)))
+ (if (not (equal? result #r(30.0 36.0 42.0)))
(snd-display "frample->frample 1: ~A" result))))
(let ((sf (make-frample->file "fmv.snd" 2 mus-lfloat mus-riff "this is a comment")))
@@ -16983,7 +16911,7 @@ EDITS: 2
(if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
(snd-display "frample->file comment: ~A" (mus-sound-comment "fmv.snd")))
(let ((rd (make-file->frample "fmv.snd"))
- (f0 (float-vector 0.0 0.0))
+ (f0 #r(0.0 0.0))
(happy #t))
(do ((i 0 (+ i 1)))
((or (not happy) (= i 10)))
@@ -17015,9 +16943,9 @@ EDITS: 2
(let ((ind (open-sound "fmv.snd")))
(let ((c0 (channel->float-vector 0 15 ind 0))
(c1 (channel->float-vector 0 15 ind 1)))
- (if (not (mus-arrays-equal? c0 (float-vector 0.0 0.1 0.2 0.3 0.4 0.5 0.58 0.66 0.74 0.82 -0.1 -0.12 -0.14 -0.16 -0.18)))
+ (if (not (mus-arrays-equal? c0 #r(0.0 0.1 0.2 0.3 0.4 0.5 0.58 0.66 0.74 0.82 -0.1 -0.12 -0.14 -0.16 -0.18)))
(snd-display "continue-frample->file (0): ~A" c0))
- (if (not (mus-arrays-equal? c1 (float-vector 0.0 0.01 0.02 0.03 0.04 0.05 0.05 0.05 0.05 0.05 -0.05 -0.06 -0.07 -0.08 -0.09)))
+ (if (not (mus-arrays-equal? c1 #r(0.0 0.01 0.02 0.03 0.04 0.05 0.05 0.05 0.05 0.05 -0.05 -0.06 -0.07 -0.08 -0.09)))
(snd-display "continue-frample->file (1): ~A" c1)))
(close-sound ind))
(delete-file "fmv.snd")
@@ -17059,7 +16987,10 @@ EDITS: 2
(if (fneq (mus-frequency gen) 10000.0) (snd-display "rand frequency: ~F?" (mus-frequency gen)))
(set! (mus-scaler gen) 0.5)
(if (fneq (mus-scaler gen) 0.5) (snd-display "set! mus-scaler rand: ~A" (mus-scaler gen)))
- (if (= (v0 1) (v0 8)) (snd-display "rand output: ~A" v0)))
+ (if (= (v0 1) (v0 8)) (snd-display "rand output: ~A" v0))
+ (mus-reset gen)
+ (let ((val (rand gen)))
+ (if (zero? val) (snd-display "mus-reset rand: ~A" val))))
(let ((gen (make-rand 10000.0 :envelope '(0 0 1 1)))
(v0 (make-float-vector 10)))
@@ -17242,7 +17173,7 @@ EDITS: 2
(snd-display "mus-random: ~A" val1))))
(if (or (< maxp .9)
(> minp -.9))
- (snd-display "mus-random: ~A ~A" minp maxp))
+ (snd-display "mus-random min/max: ~A ~A" minp maxp))
(set! minp 12.0)
(set! maxp -12.0)
(do ((i 0 (+ i 1)))
@@ -17254,7 +17185,7 @@ EDITS: 2
(snd-display "mus-random (12): ~A" val1))))
(if (or (< maxp 11.0)
(> minp -11.0))
- (snd-display "mus-random (12): ~A ~A" minp maxp)))
+ (snd-display "mus-random (12) min/max: ~A ~A" minp maxp)))
(let ((n 1000) ; chi^2 or mus-random
(hits (make-vector 10 0)))
@@ -17336,46 +17267,46 @@ EDITS: 2
(if (equal? gen gen2) (snd-display "locsig 3 equal? ~A ~A" gen gen2))
(if (or (fneq (locsig-ref gen 0) .667) (fneq (locsig-ref gen 1) .333))
(snd-display "locsig ref: ~F ~F?" (locsig-ref gen 0) (locsig-ref gen 1)))
- (if (not (mus-arrays-equal? (mus-data gen) (float-vector 0.667 0.333)))
+ (if (not (mus-arrays-equal? (mus-data gen) #r(0.667 0.333)))
(snd-display "locsig gen outn: ~A" (mus-data gen)))
- (if (not (mus-arrays-equal? (mus-data gen1) (float-vector 0.333 0.667)))
+ (if (not (mus-arrays-equal? (mus-data gen1) #r(0.333 0.667)))
(snd-display "locsig gen2 outn: ~A" (mus-data gen1)))
- (if (not (mus-arrays-equal? (mus-data gen2) (float-vector 0.333 0.667 0.000 0.000)))
+ (if (not (mus-arrays-equal? (mus-data gen2) #r(0.333 0.667 0.000 0.000)))
(snd-display "locsig gen2 outn: ~A" (mus-data gen2))))
(let ((gen200 (mus-data (make-locsig 200.0 :channels 4))))
- (if (not (mus-arrays-equal? gen200 (float-vector 0.000 0.000 0.778 0.222)))
+ (if (not (mus-arrays-equal? gen200 #r(0.000 0.000 0.778 0.222)))
(snd-display "locsig gen200 outn: ~A" gen200)))
(locsig-set! gen 0 .25)
- (if (not (mus-arrays-equal? (mus-data gen) (float-vector 0.250 0.333)))
+ (if (not (mus-arrays-equal? (mus-data gen) #r(0.250 0.333)))
(snd-display "locsig gen .25 outn: ~A" (mus-data gen)))
(locsig gen 0 1.0)
(locsig-set! gen 0 .5)
- (if (not (mus-arrays-equal? (mus-data gen) (float-vector 0.500 0.333)))
+ (if (not (mus-arrays-equal? (mus-data gen) #r(0.500 0.333)))
(snd-display "locsig gen .5 outn: ~A" (mus-data gen)))
(locsig gen 0 1.0))
(let ((gen (make-locsig 120.0 2.0 .1 :channels 4)))
- (if (not (mus-arrays-equal? (mus-data gen) (float-vector 0.000 0.333 0.167 0.000)))
+ (if (not (mus-arrays-equal? (mus-data gen) #r(0.000 0.333 0.167 0.000)))
(snd-display "locsig gen 120 outn: ~A" (mus-data gen)))
(locsig gen 0 1.0))
(let ((gen (make-locsig 300.0 2.0 .1 :channels 4)))
- (if (not (mus-arrays-equal? (mus-data gen) (float-vector 0.167 0.000 0.000 0.333)))
+ (if (not (mus-arrays-equal? (mus-data gen) #r(0.167 0.000 0.000 0.333)))
(snd-display "locsig gen 300 outn: ~A" (mus-data gen)))
(locsig gen 0 1.0))
(move-locsig gen1 90.0 1.0)
- (if (not (mus-arrays-equal? (mus-data gen1) (float-vector 0.000 1.000)))
+ (if (not (mus-arrays-equal? (mus-data gen1) #r(0.000 1.000)))
(snd-display "locsig gen1 90 outn: ~A" (mus-data gen1)))
(move-locsig gen1 0.0 1.0)
- (if (not (mus-arrays-equal? (mus-data gen1) (float-vector 1.000 0.000)))
+ (if (not (mus-arrays-equal? (mus-data gen1) #r(1.000 0.000)))
(snd-display "locsig gen1 0 outn: ~A" (mus-data gen1)))
(move-locsig gen1 45.0 1.0)
- (if (not (mus-arrays-equal? (mus-data gen1) (float-vector 0.500 0.500)))
+ (if (not (mus-arrays-equal? (mus-data gen1) #r(0.500 0.500)))
(snd-display "locsig gen1 45 outn: ~A" (mus-data gen1)))
(move-locsig gen1 135.0 2.0)
- (if (not (mus-arrays-equal? (mus-data gen1) (float-vector 0.000 0.500)))
+ (if (not (mus-arrays-equal? (mus-data gen1) #r(0.000 0.500)))
(snd-display "locsig gen1 135 outn: ~A" (mus-data gen1)))
(move-locsig gen1 -270.0 3.0)
- (if (not (mus-arrays-equal? (mus-data gen1) (float-vector 0.333 0.0)))
+ (if (not (mus-arrays-equal? (mus-data gen1) #r(0.333 0.0)))
(snd-display "locsig gen1 -270 outn: ~A" (mus-data gen1))))
(for-each
@@ -17449,38 +17380,38 @@ EDITS: 2
(let ((locs (make-locsig :channels 8 :degree 0)))
(move-locsig locs 180 1.0)
(if (fneq (locsig-ref locs 0) 0.0) (snd-display "move-locsig by jump: ~A" (mus-data locs)))
- (if (not (mus-arrays-equal? (mus-data locs) (float-vector 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? (mus-data locs) #r(0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000)))
(snd-display "move-locsig by jump data: ~A" (mus-data locs)))
(move-locsig locs 120.0 1.0)
- (if (not (mus-arrays-equal? (mus-data locs) (float-vector 0.000 0.000 0.333 0.667 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? (mus-data locs) #r(0.000 0.000 0.333 0.667 0.000 0.000 0.000 0.000)))
(snd-display "move-locsig by jump 120 data: ~A" (mus-data locs)))
(move-locsig locs -20.0 1.0)
- (if (not (mus-arrays-equal? (mus-data locs) (float-vector 0.556 0.000 0.000 0.000 0.000 0.000 0.000 0.444)))
+ (if (not (mus-arrays-equal? (mus-data locs) #r(0.556 0.000 0.000 0.000 0.000 0.000 0.000 0.444)))
(snd-display "move-locsig by jump -20 data: ~A" (mus-data locs))))
(let ((sf (make-sample->file "fmv4.snd" 8 mus-bshort mus-next "this is a comment"))
(sfrev (make-sample->file "fmv4.reverb" 8 mus-bshort mus-next "this is a comment")))
(let ((locs (make-locsig :channels 8 :degree 0 :distance 1.0 :reverb 0.1
:output sf :revout sfrev :type mus-interp-linear)))
- (if (not (mus-arrays-equal? (mus-data locs) (float-vector 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? (mus-data locs) #r(1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "ws not move-locsig by jump data: ~A" (mus-data locs)))
- (if (not (mus-arrays-equal? (mus-xcoeffs locs) (float-vector 0.100 0.000 0.000 0.000 0.0 0.0 0.0 0.0)))
+ (if (not (mus-arrays-equal? (mus-xcoeffs locs) #r(0.100 0.000 0.000 0.000 0.0 0.0 0.0 0.0)))
(snd-display "ws not move-locsig by jump rev data: ~A" (mus-xcoeffs locs)))
(move-locsig locs 180 2.0)
(if (fneq (locsig-ref locs 0) 0.0) (snd-display "ws move-locsig by jump: ~A" (mus-data locs)))
- (if (not (mus-arrays-equal? (mus-data locs) (float-vector 0.000 0.000 0.000 0.000 0.500 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? (mus-data locs) #r(0.000 0.000 0.000 0.000 0.500 0.000 0.000 0.000)))
(snd-display "ws move-locsig by jump data: ~A" (mus-data locs)))
- (if (not (mus-arrays-equal? (mus-xcoeffs locs) (float-vector 0.000 0.000 0.000 0.000 0.071 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? (mus-xcoeffs locs) #r(0.000 0.000 0.000 0.000 0.071 0.000 0.000 0.000)))
(snd-display "ws move-locsig by jump rev data: ~A" (mus-xcoeffs locs)))
(move-locsig locs 120.0 3.0)
- (if (not (mus-arrays-equal? (mus-data locs) (float-vector 0.000 0.000 0.111 0.222 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? (mus-data locs) #r(0.000 0.000 0.111 0.222 0.000 0.000 0.000 0.000)))
(snd-display "ws move-locsig by jump 120 data: ~A" (mus-data locs)))
- (if (not (mus-arrays-equal? (mus-xcoeffs locs) (float-vector 0.000 0.000 0.019 0.038 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? (mus-xcoeffs locs) #r(0.000 0.000 0.019 0.038 0.000 0.000 0.000 0.000)))
(snd-display "ws move-locsig by jump 120 rev data: ~A" (mus-xcoeffs locs)))
(move-locsig locs -20.0 4.0)
- (if (not (mus-arrays-equal? (mus-data locs) (float-vector 0.139 0.000 0.000 0.000 0.000 0.000 0.000 0.111)))
+ (if (not (mus-arrays-equal? (mus-data locs) #r(0.139 0.000 0.000 0.000 0.000 0.000 0.000 0.111)))
(snd-display "ws move-locsig by jump -20 data: ~A" (mus-data locs)))
- (if (not (mus-arrays-equal? (mus-xcoeffs locs) (float-vector 0.028 0.000 0.000 0.000 0.000 0.000 0.000 0.022)))
+ (if (not (mus-arrays-equal? (mus-xcoeffs locs) #r(0.028 0.000 0.000 0.000 0.000 0.000 0.000 0.022)))
(snd-display "ws move-locsig by jump -20 rev data: ~A" (mus-xcoeffs locs))))
(mus-close sf)
(mus-close sfrev))
@@ -17587,37 +17518,37 @@ EDITS: 2
((= i chans) dat)
(set! (dat i) (locsig-ref gen i))))))
(gen (make-locsig -.1 :channels 8)))
- (if (not (mus-arrays-equal? (locsig-data gen) (float-vector 0.998 0.000 0.000 0.000 0.000 0.000 0.000 0.002)))
+ (if (not (mus-arrays-equal? (locsig-data gen) #r(0.998 0.000 0.000 0.000 0.000 0.000 0.000 0.002)))
(snd-display "locsig -.1(8): ~A" (locsig-data gen)))
(set! gen (make-locsig -359.9 :channels 8))
- (if (not (mus-arrays-equal? (locsig-data gen) (float-vector 0.998 0.002 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? (locsig-data gen) #r(0.998 0.002 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "locsig -359.9(8): ~A" (locsig-data gen)))
(set! gen (make-locsig -359.9 :channels 4))
- (if (not (mus-arrays-equal? (locsig-data gen) (float-vector 0.999 0.001 0.000 0.000)))
+ (if (not (mus-arrays-equal? (locsig-data gen) #r(0.999 0.001 0.000 0.000)))
(snd-display "locsig -359.9(4): ~A" (locsig-data gen)))
(set! gen (make-locsig -360.1 :channels 8))
- (if (not (mus-arrays-equal? (locsig-data gen) (float-vector 0.998 0.000 0.000 0.000 0.000 0.000 0.000 0.002)))
+ (if (not (mus-arrays-equal? (locsig-data gen) #r(0.998 0.000 0.000 0.000 0.000 0.000 0.000 0.002)))
(snd-display "locsig -360.1(8): ~A" (locsig-data gen)))
(set! gen (make-locsig -700 :channels 8))
- (if (not (mus-arrays-equal? (locsig-data gen) (float-vector 0.556 0.444 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? (locsig-data gen) #r(0.556 0.444 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "locsig -700(8): ~A" (locsig-data gen)))
(set! gen (make-locsig -700 :channels 2))
- (if (not (mus-arrays-equal? (locsig-data gen) (float-vector 1.000 0.000)))
+ (if (not (mus-arrays-equal? (locsig-data gen) #r(1.000 0.000)))
(snd-display "locsig -700(2): ~A" (locsig-data gen)))
(set! gen (make-locsig 20 :channels 2))
- (if (not (mus-arrays-equal? (locsig-data gen) (float-vector 0.778 0.222)))
+ (if (not (mus-arrays-equal? (locsig-data gen) #r(0.778 0.222)))
(snd-display "locsig 20(2): ~A" (locsig-data gen)))
(set! gen (make-locsig 123456.0 :channels 8))
- (if (not (mus-arrays-equal? (locsig-data gen) (float-vector 0.467 0.000 0.000 0.000 0.000 0.000 0.000 0.533)))
+ (if (not (mus-arrays-equal? (locsig-data gen) #r(0.467 0.000 0.000 0.000 0.000 0.000 0.000 0.533)))
(snd-display "locsig 123456(8): ~A" (locsig-data gen)))
(set! gen (make-locsig 336.0 :channels 8))
- (if (not (mus-arrays-equal? (locsig-data gen) (float-vector 0.467 0.000 0.000 0.000 0.000 0.000 0.000 0.533)))
+ (if (not (mus-arrays-equal? (locsig-data gen) #r(0.467 0.000 0.000 0.000 0.000 0.000 0.000 0.533)))
(snd-display "locsig 336(8): ~A" (locsig-data gen)))
(set! gen (make-locsig -123456.0 :channels 8))
- (if (not (mus-arrays-equal? (locsig-data gen) (float-vector 0.467 0.533 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? (locsig-data gen) #r(0.467 0.533 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "locsig -123456(8): ~A" (locsig-data gen)))
(set! gen (make-locsig 24.0 :channels 8))
- (if (not (mus-arrays-equal? (locsig-data gen) (float-vector 0.467 0.533 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? (locsig-data gen) #r(0.467 0.533 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "locsig 24(8): ~A" (locsig-data gen))))
(for-each
@@ -17626,7 +17557,7 @@ EDITS: 2
(- a (* (floor (/ a b)) b)))))
(lambda (chans degree type)
(if (= chans 1)
- (float-vector 1.0)
+ #r(1.0)
(let* ((pos (let ((deg (if (= chans 2)
(max 0.0 (min 90.0 degree))
(xmodulo degree 360.0)))
@@ -18238,11 +18169,11 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.06) (snd-display "gran 0 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060 0.060 0.060 0.060 0.053
+ #r(0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060 0.060 0.060 0.060 0.053
0.047 0.040 0.033 0.027 0.020 0.013 0.007 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "gran 0 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 85 30)
- (float-vector 0.000 0.000 0.000 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060 0.060
+ #r(0.000 0.000 0.000 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060 0.060
0.060 0.060 0.053 0.047 0.040 0.033 0.027 0.020 0.013 0.007 0.000 0.000 0.000 0.000)))
(snd-display "gran 0 data 85: ~A" (channel->float-vector 85 30)))
(undo)
@@ -18252,11 +18183,11 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.06) (snd-display "gran 1 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060 0.060 0.060 0.060 0.053
+ #r(0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060 0.060 0.060 0.060 0.053
0.047 0.040 0.033 0.027 0.020 0.013 0.007 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "gran 1 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 40 30)
- (float-vector 0.000 0.000 0.000 0.000 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060
+ #r(0.000 0.000 0.000 0.000 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060
0.060 0.060 0.060 0.053 0.047 0.040 0.033 0.027 0.020 0.013 0.007 0.000 0.000 0.000)))
(snd-display "gran 1 data 40: ~A" (channel->float-vector 85 30)))
(undo)
@@ -18266,11 +18197,11 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.06) (snd-display "gran 2 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.000 0.030 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ #r(0.000 0.030 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.030 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "gran 2 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 40 30)
- (float-vector 0.000 0.000 0.000 0.000 0.000 0.030 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ #r(0.000 0.000 0.000 0.000 0.000 0.030 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.030 0.000 0.000 0.000)))
(snd-display "gran 2 data 40: ~A" (channel->float-vector 40 30)))
(undo)
@@ -18280,11 +18211,11 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.06) (snd-display "gran 3 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.000 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060 0.055 0.049 0.044
+ #r(0.000 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060 0.055 0.049 0.044
0.038 0.033 0.027 0.022 0.016 0.011 0.005 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "gran 3 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 85 30)
- (float-vector 0.000 0.000 0.000 0.000 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060
+ #r(0.000 0.000 0.000 0.000 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060
0.055 0.049 0.044 0.038 0.033 0.027 0.022 0.016 0.011 0.005 0.000 0.000 0.000 0.000)))
(snd-display "gran 3 data 85: ~A" (channel->float-vector 85 30)))
(undo)
@@ -18294,11 +18225,11 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.06) (snd-display "gran 4 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.000 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060 0.055 0.049 0.044
+ #r(0.000 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060 0.055 0.049 0.044
0.038 0.033 0.027 0.022 0.016 0.011 0.005 0.005 0.011 0.016 0.022 0.027 0.033 0.038)))
(snd-display "gran 4 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 85 30)
- (float-vector 0.022 0.016 0.011 0.005 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060
+ #r(0.022 0.016 0.011 0.005 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060
0.055 0.049 0.044 0.038 0.033 0.027 0.022 0.016 0.011 0.005 0.005 0.011 0.016 0.022)))
(snd-display "gran 4 data 85: ~A" (channel->float-vector 85 30)))
(undo)
@@ -18308,11 +18239,11 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display "gran 5 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.000 0.020 0.040 0.060 0.080 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
+ #r(0.000 0.020 0.040 0.060 0.080 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
0.100 0.100 0.100 0.080 0.060 0.040 0.020 0.020 0.040 0.060 0.080 0.100 0.100 0.100)))
(snd-display "gran 5 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 85 30)
- (float-vector 0.080 0.060 0.040 0.020 0.020 0.040 0.060 0.080 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
+ #r(0.080 0.060 0.040 0.020 0.020 0.040 0.060 0.080 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.080 0.060 0.040 0.020 0.020 0.040 0.060 0.080)))
(snd-display "gran 5 data 85: ~A" (channel->float-vector 85 30)))
(undo)
@@ -18322,7 +18253,7 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.105) (snd-display "gran 6 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.000 0.005 0.009 0.014 0.018 0.023 0.027 0.032 0.036 0.041 0.045 0.050 0.055 0.059 0.064 0.068
+ #r(0.000 0.005 0.009 0.014 0.018 0.023 0.027 0.032 0.036 0.041 0.045 0.050 0.055 0.059 0.064 0.068
0.073 0.077 0.082 0.086 0.091 0.095 0.100 0.105 0.105 0.105 0.105 0.105 0.105 0.105)))
(snd-display "gran 6 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 85 30) (make-float-vector 30 0.105)))
@@ -18334,11 +18265,11 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.264) (snd-display "gran 7 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.000 0.002 0.004 0.005 0.007 0.009 0.011 0.013 0.015 0.016 0.018 0.020 0.022 0.024 0.025 0.027
+ #r(0.000 0.002 0.004 0.005 0.007 0.009 0.011 0.013 0.015 0.016 0.018 0.020 0.022 0.024 0.025 0.027
0.029 0.031 0.033 0.035 0.036 0.038 0.040 0.044 0.047 0.051 0.055 0.058 0.062 0.065)))
(snd-display "gran 7 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 85 30)
- (float-vector 0.244 0.244 0.244 0.244 0.245 0.247 0.249 0.251 0.253 0.255 0.256 0.258 0.260 0.262 0.264 0.264
+ #r(0.244 0.244 0.244 0.244 0.245 0.247 0.249 0.251 0.253 0.255 0.256 0.258 0.260 0.262 0.264 0.264
0.262 0.260 0.258 0.256 0.255 0.253 0.251 0.249 0.247 0.245 0.245 0.247 0.249 0.251)))
(snd-display "gran 7 data 85: ~A" (channel->float-vector 85 30)))
(undo)
@@ -18348,11 +18279,11 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display "gran 8 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
+ #r(0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
0.064 0.055 0.045 0.036 0.027 0.018 0.009 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "gran 8 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 220 30)
- (float-vector 0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
+ #r(0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
0.064 0.055 0.045 0.036 0.027 0.018 0.009 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "gran 8 data 220: ~A" (channel->float-vector 220 30)))
(undo)
@@ -18362,11 +18293,11 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display "gran 9 max: ~A" mx))) ; same as 8 because expansion hits the input counter
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
+ #r(0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
0.064 0.055 0.045 0.036 0.027 0.018 0.009 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "gran 9 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 220 30)
- (float-vector 0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
+ #r(0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
0.064 0.055 0.045 0.036 0.027 0.018 0.009 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "gran 9 data 220: ~A" (channel->float-vector 220 30)))
(undo)
@@ -18380,11 +18311,11 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx (* 2 0.264)) (snd-display "gran 10 max: ~A" mx)))
(if (not (mus-arrays-equal? (float-vector-scale! (channel->float-vector 0 30) 0.5)
- (float-vector 0.000 0.002 0.004 0.005 0.007 0.009 0.011 0.013 0.015 0.016 0.018 0.020 0.022 0.024 0.025 0.027
+ #r(0.000 0.002 0.004 0.005 0.007 0.009 0.011 0.013 0.015 0.016 0.018 0.020 0.022 0.024 0.025 0.027
0.029 0.031 0.033 0.035 0.036 0.038 0.040 0.044 0.047 0.051 0.055 0.058 0.062 0.065)))
(snd-display "gran 10 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (float-vector-scale! (channel->float-vector 85 30) 0.5)
- (float-vector 0.244 0.244 0.244 0.244 0.245 0.247 0.249 0.251 0.253 0.255 0.256 0.258 0.260 0.262 0.264 0.264
+ #r(0.244 0.244 0.244 0.244 0.245 0.247 0.249 0.251 0.253 0.255 0.256 0.258 0.260 0.262 0.264 0.264
0.262 0.260 0.258 0.256 0.255 0.253 0.251 0.249 0.247 0.245 0.245 0.247 0.249 0.251)))
(snd-display "gran 10 data 85: ~A" (channel->float-vector 85 30)))
(undo)
@@ -18406,11 +18337,11 @@ EDITS: 2
(let ((mx (maxamp)))
(if (> mx 0.6) (snd-display "gran 11 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector -0.499 -0.498 -0.497 -0.496 -0.495 -0.494 -0.493 -0.492 -0.491 -0.490 -0.489 -0.488 -0.487 -0.486
+ #r(-0.499 -0.498 -0.497 -0.496 -0.495 -0.494 -0.493 -0.492 -0.491 -0.490 -0.489 -0.488 -0.487 -0.486
-0.485 -0.484 -0.483 -0.482 -0.481 -0.480 -0.479 -0.478 -0.477 -0.476 -0.475 -0.474 -0.473 -0.472 -0.471 -0.470)))
(snd-display "gran 11 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 100 30)
- (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 -0.345 -0.346 -0.347 -0.348 -0.349
+ #r(0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 -0.345 -0.346 -0.347 -0.348 -0.349
-0.350 -0.351 -0.352 -0.353 -0.354 -0.355 -0.356 -0.357 -0.358 -0.359 -0.360 -0.361 -0.362 -0.363 -0.364)))
(snd-display "gran 11 data 100: ~A" (channel->float-vector 100 30)))
(undo)
@@ -18423,11 +18354,11 @@ EDITS: 2
(let ((mx (maxamp)))
(if (> mx 0.6) (snd-display "gran 12 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector -0.499 -0.498 -0.497 -0.496 -0.495 -0.494 -0.493 -0.492 -0.491 -0.490 -0.489 -0.488 -0.487 -0.486
+ #r(-0.499 -0.498 -0.497 -0.496 -0.495 -0.494 -0.493 -0.492 -0.491 -0.490 -0.489 -0.488 -0.487 -0.486
-0.485 -0.484 -0.483 -0.482 -0.481 -0.480 -0.479 -0.478 -0.477 -0.476 -0.475 -0.474 -0.473 -0.472 -0.471 -0.470)))
(snd-display "gran 12 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 100 30)
- (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 -0.389 -0.388 -0.387 -0.386 -0.385
+ #r(0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 -0.389 -0.388 -0.387 -0.386 -0.385
-0.384 -0.383 -0.382 -0.381 -0.380 -0.379 -0.378 -0.377 -0.376 -0.375 -0.374 -0.373 -0.372 -0.371 -0.370)))
(snd-display "gran 12 data 100: ~A" (channel->float-vector 100 30)))
(undo)
@@ -18441,11 +18372,11 @@ EDITS: 2
(let ((mx (maxamp)))
(if (> mx .6) (snd-display "gran 13 max: ~A" mx)))
(if (not (mus-arrays-equal? (float-vector-scale! (channel->float-vector 0 30) 0.5)
- (float-vector 0.000 0.002 0.004 0.005 0.007 0.009 0.011 0.013 0.015 0.016 0.018 0.020 0.022 0.024 0.025 0.027
+ #r(0.000 0.002 0.004 0.005 0.007 0.009 0.011 0.013 0.015 0.016 0.018 0.020 0.022 0.024 0.025 0.027
0.029 0.031 0.033 0.035 0.036 0.038 0.040 0.044 0.047 0.051 0.055 0.058 0.062 0.065)))
(snd-display "gran 13 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (float-vector-scale! (channel->float-vector 85 30) 0.5)
- (float-vector 0.244 0.244 0.244 0.244 0.245 0.247 0.249 0.251 0.253 0.255 0.256 0.258 0.260 0.262 0.264 0.264
+ #r(0.244 0.244 0.244 0.244 0.245 0.247 0.249 0.251 0.253 0.255 0.256 0.258 0.260 0.262 0.264 0.264
0.262 0.260 0.258 0.256 0.255 0.253 0.251 0.249 0.247 0.245 0.245 0.247 0.249 0.251)))
(snd-display "gran 13 data 85: ~A" (channel->float-vector 85 30)))
(undo)
@@ -18466,11 +18397,11 @@ EDITS: 2
(let ((mx (maxamp)))
(if (> mx 0.6) (snd-display "gran 14 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector -0.499 -0.498 -0.497 -0.496 -0.495 -0.494 -0.493 -0.492 -0.491 -0.490 -0.489 -0.488 -0.487 -0.486
+ #r(-0.499 -0.498 -0.497 -0.496 -0.495 -0.494 -0.493 -0.492 -0.491 -0.490 -0.489 -0.488 -0.487 -0.486
-0.485 -0.484 -0.483 -0.482 -0.481 -0.480 -0.479 -0.478 -0.477 -0.476 -0.475 -0.474 -0.473 -0.472 -0.471 -0.470)))
(snd-display "gran 14 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 100 30)
- (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 -0.345 -0.346 -0.347 -0.348 -0.349
+ #r(0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 -0.345 -0.346 -0.347 -0.348 -0.349
-0.350 -0.351 -0.352 -0.353 -0.354 -0.355 -0.356 -0.357 -0.358 -0.359 -0.360 -0.361 -0.362 -0.363 -0.364)))
(snd-display "gran 14 data 100: ~A" (channel->float-vector 100 30)))
(undo)
@@ -18488,15 +18419,15 @@ EDITS: 2
(if (> (abs (- (mus-ramp gen) (* .5 (mus-length gen)))) 1)
(snd-display "granf 0 ramp: ~A ~A" (mus-ramp gen) (mus-length gen))))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ #r(0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "granf 0 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 440 30)
- (float-vector 0.000 0.012 0.024 0.036 0.048 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ #r(0.000 0.012 0.024 0.036 0.048 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.048 0.036 0.024 0.012 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "granf 0 data 440: ~A" (channel->float-vector 440 30)))
(if (not (mus-arrays-equal? (channel->float-vector 880 30)
- (float-vector 0.000 0.006 0.012 0.018 0.024 0.030 0.036 0.042 0.048 0.054 0.060 0.060 0.060 0.060
+ #r(0.000 0.006 0.012 0.018 0.024 0.030 0.036 0.042 0.048 0.054 0.060 0.060 0.060 0.060
0.054 0.048 0.042 0.036 0.030 0.024 0.018 0.012 0.006 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "granf 0 data 880: ~A" (channel->float-vector 880 30)))
(undo)
@@ -18514,11 +18445,11 @@ EDITS: 2
(if (> (abs (- (mus-hop gen) (* .001 *clm-srate*))) 1)
(snd-display "granf 1 hop: ~A ~A, ~A ~A" (mus-hop gen) (abs (- (mus-hop gen) (* .001 (srate)))) (srate) *clm-srate*)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ #r(0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "granf 1 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 900 30)
- (float-vector 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000
+ #r(0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000
0.000 0.000 0.000 0.000 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060)))
(snd-display "granf 1 data 900: ~A" (channel->float-vector 900 30)))
(undo)
@@ -18536,11 +18467,11 @@ EDITS: 2
(if (> (abs (- (mus-hop gen) (* .001 *clm-srate*))) 1)
(snd-display "granf 2 hop: ~A" (mus-hop gen))))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ #r(0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "granf 2 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 900 30)
- (float-vector 0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.060 0.060 0.060
+ #r(0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060)))
(snd-display "granf 2 data 900: ~A" (channel->float-vector 900 30)))
(undo)
@@ -18550,7 +18481,7 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display "granf 3 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
+ #r(0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "gran 3 data: ~A" (channel->float-vector 0 30)))
(undo)
@@ -18565,15 +18496,15 @@ EDITS: 2
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display "granf 4 max: ~A" mx)))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
+ #r(0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "granf 4 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 440 30)
- (float-vector 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056
+ #r(0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056
0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "granf 4 data 440: ~A" (channel->float-vector 440 30)))
(if (not (mus-arrays-equal? (channel->float-vector 900 30)
- (float-vector 0.012 0.012 0.012 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
+ #r(0.012 0.012 0.012 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "granf 4 data 900: ~A" (channel->float-vector 900 30)))
(undo)
@@ -18591,11 +18522,11 @@ EDITS: 2
(if (> (abs (- (mus-length gen) (* 5 base-len))) 10)
(snd-display "granf 5 length: ~A ~A" (mus-length gen) (* 5 base-len)))))
(if (not (mus-arrays-equal? (channel->float-vector 0 30)
- (float-vector 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ #r(0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "granf 5 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 440 30)
- (float-vector 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ #r(0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "granf 5 data 440: ~A" (channel->float-vector 440 30)))
(if (not (mus-arrays-equal? (channel->float-vector 800 30) (make-float-vector 30 0.060)))
@@ -18617,7 +18548,7 @@ EDITS: 2
(if (not (mus-arrays-equal? (channel->float-vector 0 30) (make-float-vector 30 0.060)))
(snd-display "granf 6 data: ~A" (channel->float-vector 0 30)))
(if (not (mus-arrays-equal? (channel->float-vector 820 30)
- (float-vector 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000
+ #r(0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display "granf 6 data 820: ~A" (channel->float-vector 820 30)))
(undo)
@@ -18736,9 +18667,9 @@ EDITS: 2
(let ((vals (count-matches (lambda (y) (> (abs y) 0.0)))))
(if (> (abs (- vals 1104)) 10) (snd-display "granulate ramped 4 not 0.0: ~A" vals)))
(if (not (and (mus-arrays-equal? (channel->float-vector 2203 10)
- (float-vector 0.000 0.000 0.110 0.110 0.110 0.111 0.111 0.111 0.111 0.111))
+ #r(0.000 0.000 0.110 0.110 0.110 0.111 0.111 0.111 0.111 0.111))
(mus-arrays-equal? (channel->float-vector 4523 10)
- (float-vector 0.232 0.232 0.232 0.232 0.232 0.232 0.232 0.232 0.233 0.233))
+ #r(0.232 0.232 0.232 0.232 0.232 0.232 0.232 0.232 0.233 0.233))
(mus-arrays-equal? (channel->float-vector 8928 10) (make-float-vector 10 0.452))))
(snd-display "granulate ramped 4 data off: ~A ~A ~A"
(channel->float-vector 2203 10) (channel->float-vector 4523 10) (channel->float-vector 8928 10)))
@@ -18776,9 +18707,9 @@ EDITS: 2
(clm-channel gen))
(if (fneq (maxamp) .495) (snd-display "granulate ramped 6: ~A" (maxamp)))
(if (not (and (mus-arrays-equal? (channel->float-vector 2000 10)
- (float-vector 0.018 0.019 0.020 0.021 0.022 0.023 0.024 0.025 0.026 0.027))
+ #r(0.018 0.019 0.020 0.021 0.022 0.023 0.024 0.025 0.026 0.027))
(mus-arrays-equal? (channel->float-vector 8000 10)
- (float-vector 0.294 0.298 0.301 0.305 0.309 0.313 0.316 0.320 0.324 0.328))))
+ #r(0.294 0.298 0.301 0.305 0.309 0.313 0.316 0.320 0.324 0.328))))
(snd-display "granulate ramped 6 data: ~A ~A"
(channel->float-vector 2000 10) (channel->float-vector 8000 10)))
(undo)
@@ -18794,9 +18725,9 @@ EDITS: 2
(clm-channel gen))
(if (fneq (maxamp) .505) (snd-display "granulate ramped 7: ~A" (maxamp)))
(if (not (and (mus-arrays-equal? (channel->float-vector 2000 10)
- (float-vector 0.037 0.039 0.040 0.042 0.044 0.046 0.048 0.050 0.052 0.054))
+ #r(0.037 0.039 0.040 0.042 0.044 0.046 0.048 0.050 0.052 0.054))
(mus-arrays-equal? (channel->float-vector 8000 10)
- (float-vector 0.404 0.404 0.404 0.404 0.404 0.405 0.405 0.405 0.405 0.405))))
+ #r(0.404 0.404 0.404 0.404 0.404 0.405 0.405 0.405 0.405 0.405))))
(snd-display "granulate ramped 7 data: ~A ~A"
(channel->float-vector 2000 10) (channel->float-vector 8000 10)))
(undo)
@@ -18895,8 +18826,8 @@ EDITS: 2
(snd-display "convolve-files: ~A is not .5?" (cadr (mus-sound-maxamp "fmv.snd"))))
))
- (let ((flt (float-vector 1.0 0.5 0.1 0.2 0.3 0.4 0.5 1.0))
- (data (float-vector 0.0 1.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0))
+ (let ((flt #r(1.0 0.5 0.1 0.2 0.3 0.4 0.5 1.0))
+ (data #r(0.0 1.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0))
(ctr -1))
(let ((res (make-float-vector 16))
(g (make-convolve :filter flt
@@ -18906,7 +18837,7 @@ EDITS: 2
(do ((i 0 (+ i 1)))
((= i 16))
(set! (res i) (convolve g)))
- (if (not (mus-arrays-equal? res (float-vector 0.0 1.0 0.5 0.1 1.2 0.8 0.5 0.7 1.3 0.4 0.5 1.0 0.0 0.0 0.0 0.0)))
+ (if (not (mus-arrays-equal? res #r(0.0 1.0 0.5 0.1 1.2 0.8 0.5 0.7 1.3 0.4 0.5 1.0 0.0 0.0 0.0 0.0)))
(snd-display "convolve: ~A~%" res))))
(let ((ind (new-sound "fmv.snd")))
@@ -18987,7 +18918,36 @@ EDITS: 2
(select-channel 0)
(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)))
- (snd-test-jc-reverb 1.0 #f .1 #f)
+
+ (let ((decay-dur 1.0000)
+ (low-pass #f)
+ (volume 0.1000)
+ (amp-env #f))
+ (let ((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))
+ (comb2 (make-comb 0.733 4999))
+ (comb3 (make-comb 0.715 5399))
+ (comb4 (make-comb 0.697 5801))
+ (dur (+ decay-dur (/ (framples) (srate))))
+ (outdel (make-delay (seconds->samples .013))))
+ (let ((combs (make-comb-bank (vector comb1 comb2 comb3 comb4)))
+ (allpasses (make-all-pass-bank (vector allpass1 allpass2 allpass3))))
+ (if (or amp-env low-pass)
+ (let ((delf (let ((flt (and low-pass (make-fir-filter 3 #r(0.25 0.5 0.25))))
+ (envA (make-env :envelope (or amp-env '(0 1 1 1)) :scaler volume :duration dur)))
+ (if low-pass
+ (lambda (inval)
+ (+ inval (delay outdel (* (env envA) (fir-filter flt (comb-bank combs (all-pass-bank allpasses inval)))))))
+ (lambda (inval)
+ (+ inval (delay outdel (* (env envA) (comb-bank combs (all-pass-bank allpasses inval))))))))))
+ (map-channel delf 0 (round (* dur (srate)))))
+ (map-channel
+ (lambda (inval)
+ (+ inval (delay outdel (* volume (comb-bank combs (all-pass-bank allpasses inval))))))
+ 0 (round (* dur (srate))))))))
+
(play nind :wait #t)
(voiced->unvoiced 1.0 256 2.0 2.0)
(pulse-voice 80 20.0 1.0 1024 0.01)
@@ -19144,7 +19104,7 @@ EDITS: 2
(snd-display "~D mus-file-mix(1->1): ~A?" k v0)
(set! happy #f)))
- (mus-file-mix-1 k (make-mix-input "fmv2.snd" k) 3 9 0 (float-vector 0.3 0.0 0.7 0.0))
+ (mus-file-mix-1 k (make-mix-input "fmv2.snd" k) 3 9 0 #r(0.3 0.0 0.7 0.0))
(file->array "fmv.snd" 0 0 12 v0)
;; v0: #(0.1 0.11 0.12 0.33 0.34 0.35 0.36 0.37 0.38 0.19 0.2 0.21)
@@ -19159,7 +19119,7 @@ EDITS: 2
(vf1 (make-vector 1)))
(set! (vf 0) vf1)
(set! (vf1 0) e0))
- (mus-file-mix-1 k (make-mix-input "fmv1.snd" k) 0 12 0 (float-vector 1.0) vf)
+ (mus-file-mix-1 k (make-mix-input "fmv1.snd" k) 0 12 0 #r(1.0) vf)
(file->array "fmv.snd" 0 0 12 v0)
;; ?? v0: #(0.4 0.42 0.44000000 0.36 0.38 0.4 0.42 0.44 0.46 0.28 0.3 0.31)
@@ -19199,7 +19159,7 @@ EDITS: 2
;; v0: #(0.1 0.14 0.18 0.03 0.04 0.05 0.06 0.070000000 0.08 0.09 0.1 0.11)
(if (or (fneq (v0 0) .1) (fneq (v0 2) .18)) (snd-display "~D mus-file-mix(1->4): ~A?" k v0))
- (mus-file-mix-1 k (make-mix-input "fmv2.snd" k) 0 3 0 (float-vector 0.3 0.0 0.7 0.0))
+ (mus-file-mix-1 k (make-mix-input "fmv2.snd" k) 0 3 0 #r(0.3 0.0 0.7 0.0))
(file->array "fmv.snd" 0 0 3 v0)
;; v0: #(0.3 0.34 0.38 0.03 0.04 0.05 0.06 0.070000000 0.08 0.09 0.1 0.11)
@@ -19214,14 +19174,14 @@ EDITS: 2
(let ((len (mus-sound-framples "oboe.snd")))
(array->file "fmv.snd" (make-float-vector 12) 12 22050 1)
(mus-file-mix-1 k (make-mix-input "oboe.snd" k))
- (mus-file-mix-1 k (make-mix-input "oboe.snd" k) 0 len 0 (float-vector 0.5))
+ (mus-file-mix-1 k (make-mix-input "oboe.snd" k) 0 len 0 #r(0.5))
(let ((egen (make-vector 1))
(outv (make-vector 1)))
(set! (outv 0) egen)
(set! (egen 0) (make-env :envelope '(0 0 1 1) :length len))
(mus-file-mix-1 k (make-mix-input "oboe.snd" k) 0 len 0 #f outv)
(set! (egen 0) (make-env :envelope '(0 1 1 0) :length len))
- (mus-file-mix-1 k (make-mix-input "oboe.snd" k) 0 len 0 (float-vector 1.0) outv))
+ (mus-file-mix-1 k (make-mix-input "oboe.snd" k) 0 len 0 #r(1.0) outv))
(let ((ind-oboe (open-sound "oboe.snd"))
(ind-mix (open-sound "fmv.snd")))
(if (not (mus-arrays-equal? (channel->float-vector 1000 10 ind-oboe)
@@ -19237,7 +19197,7 @@ EDITS: 2
(if (not (= (mus-sound-chans "fmv.snd") 2))
(snd-display "~D array->file chans? ~A" k (mus-sound-chans "fmv.snd")))
(mus-file-mix-1 k (make-mix-input "2.snd" k))
- (mus-file-mix-1 k (make-mix-input "2.snd" k) 0 len 0 (float-vector 0.5 0.0 0.0 0.5))
+ (mus-file-mix-1 k (make-mix-input "2.snd" k) 0 len 0 #r(0.5 0.0 0.0 0.5))
(let ((egen0 (make-vector 2))
(egen1 (make-vector 2))
(outv (make-vector 2)))
@@ -19250,7 +19210,7 @@ EDITS: 2
(if (not (= (channels ind-mix) 2))
(snd-display "~D fmv re-read chans? ~A ~A" k (mus-sound-chans "fmv.snd") (channels ind-mix)))
(if (not (mus-arrays-equal? (channel->float-vector 1000 10 ind-mix 0)
- (float-vector 0.003 0.010 0.012 0.011 0.008 0.004 0.002 0.002 0.007 0.017)))
+ #r(0.003 0.010 0.012 0.011 0.008 0.004 0.002 0.002 0.007 0.017)))
(snd-display "~D mus-file-mix 2 chan (2.snd written: ~A): ~A ~A" k
(strftime "%d-%b %H:%M %Z" (localtime (mus-sound-write-date "2.snd")))
(channel->float-vector 1000 10 ind-mix 0)
@@ -19274,7 +19234,7 @@ EDITS: 2
(outa i 1.0)))
(with-sound ("mix.snd")
- (mus-file-mix-with-envs (vector (make-readin "flat.snd")) 0 1000 (float-vector 0.5) #f #f #f #f))
+ (mus-file-mix-with-envs (vector (make-readin "flat.snd")) 0 1000 #r(0.5) #f #f #f #f))
(let ((ind (find-sound "mix.snd")))
(if (sound? ind)
@@ -19284,7 +19244,7 @@ EDITS: 2
(with-sound ("mix.snd")
(mus-file-mix-with-envs (vector (make-readin "flat.snd")) 0 1000
- (float-vector 0.0) #f
+ #r(0.0) #f
(vector (make-env '(0 0 1 1) :length 1000))
#f #f))
@@ -19348,14 +19308,14 @@ EDITS: 2
(require snd-jcrev.scm)
(with-sound ("mix.snd" :reverb jc-reverb)
- (mus-file-mix-with-envs (vector (make-readin "flat.snd")) 0 1000 (float-vector 0.5) (float-vector 0.1) #f #f #f))
+ (mus-file-mix-with-envs (vector (make-readin "flat.snd")) 0 1000 #r(0.5) #r(0.1) #f #f #f))
(with-sound ("mix.snd" :reverb jc-reverb)
(let* ((rd (vector (make-readin "flat.snd")
(make-readin "flat.snd")))
(srcs (vector (make-src :input (vector-ref rd 0) :srate 2.0)
(make-src :input (vector-ref rd 1) :srate 0.5))))
- (mus-file-mix-with-envs rd 0 1000 (float-vector 1.0 1.0 0.5 0.5) (float-vector 0.1) #f srcs #f)))
+ (mus-file-mix-with-envs rd 0 1000 #r(1.0 1.0 0.5 0.5) #r(0.1) #f srcs #f)))
(let ((ind (find-sound "mix.snd")))
(if (sound? ind)
@@ -19426,9 +19386,10 @@ EDITS: 2
(pscl (/ 1.0 D))
(kscl (/ pi2 N))
(k 0 (+ k 1))
- (kx 0.0 (+ kx kscl)))
+ (kx 0.0))
((= k N2))
- (float-vector-set! freqs k (* 0.5 (+ (* pscl (remainder (float-vector-ref diffs k) pi2)) kx))))
+ (float-vector-set! freqs k (* 0.5 (+ (* pscl (remainder (float-vector-ref diffs k) pi2)) kx)))
+ (set! kx (+ kx kscl)))
#f)))))
(set! pv (make-phase-vocoder (lambda (dir) (next-sample reader))
512 4 128 1.0
@@ -19459,8 +19420,7 @@ EDITS: 2
(set! pv (make-phase-vocoder (lambda (dir) (next-sample reader))
512 4 256 1.0
(lambda (v infunc)
- (set! incalls (+ incalls 1))
- #t)
+ (set! incalls (+ incalls 1)))
#f ;no change to edits
(lambda (v)
(set! outcalls (+ outcalls 1))
@@ -19510,7 +19470,7 @@ EDITS: 2
128 4 32 1.0 #f #f #f)))
(map-channel (lambda (y) (phase-vocoder pv)))
(let ((v (channel->float-vector 0 50))
- (v0 (float-vector 0.00022 0.00130 0.00382 0.00810 0.01381 0.01960 0.02301 0.02143 0.01421 0.00481 0.0 0.00396 0.01168 0.01231 0.00413 0.00018 0.00704 0.00984 0.00189 0.00197 0.00881 0.00290 0.00151 0.00781 0.00091 0.00404 0.00498 0.00047 0.00641 -0.00017 0.00590 0.00006 0.00492 0.00031 0.00380 0.00052 0.00290 0.00066 0.00219 0.00074 0.00164 0.00076 0.00123 0.00074 0.00092 0.00067 0.00069 0.00058 0.00052 0.00048)))
+ (v0 #r(0.00022 0.00130 0.00382 0.00810 0.01381 0.01960 0.02301 0.02143 0.01421 0.00481 0.0 0.00396 0.01168 0.01231 0.00413 0.00018 0.00704 0.00984 0.00189 0.00197 0.00881 0.00290 0.00151 0.00781 0.00091 0.00404 0.00498 0.00047 0.00641 -0.00017 0.00590 0.00006 0.00492 0.00031 0.00380 0.00052 0.00290 0.00066 0.00219 0.00074 0.00164 0.00076 0.00123 0.00074 0.00092 0.00067 0.00069 0.00058 0.00052 0.00048)))
(if (not (or (mus-arrays-equal? v v0)
(mus-arrays-equal? (float-vector-scale! v -1.0) v0)))
(snd-display "pv 1 diff: ~A" (float-vector-peak (float-vector-subtract! v v0)))))
@@ -19521,7 +19481,7 @@ EDITS: 2
128 4 32 2.0 #f #f #f)))
(map-channel (lambda (y) (phase-vocoder pv)))
(let ((v (channel->float-vector 0 50))
- (v0 (float-vector 0.00044 0.00255 0.00705 0.01285 0.01595 0.01177 0.00281 0.00069 0.00782 0.00702 0.00001 0.00584 0.00385 0.00138 0.00547 0.00035 0.00494 0.00082 0.00305 0.00310 0.00003 0.00380 0.00245 -0.00019 0.00159 0.00348 0.00268 0.00087 -0.00020 -0.00036 -0.00010 0.00012 0.00036 0.00057 0.00075 0.00089 0.00099 0.00105 0.00108 0.00107 0.00104 0.00099 0.00094 0.00087 0.00080 0.00073 0.00066 0.00059 0.00053 0.00047)))
+ (v0 #r(0.00044 0.00255 0.00705 0.01285 0.01595 0.01177 0.00281 0.00069 0.00782 0.00702 0.00001 0.00584 0.00385 0.00138 0.00547 0.00035 0.00494 0.00082 0.00305 0.00310 0.00003 0.00380 0.00245 -0.00019 0.00159 0.00348 0.00268 0.00087 -0.00020 -0.00036 -0.00010 0.00012 0.00036 0.00057 0.00075 0.00089 0.00099 0.00105 0.00108 0.00107 0.00104 0.00099 0.00094 0.00087 0.00080 0.00073 0.00066 0.00059 0.00053 0.00047)))
(if (not (mus-arrays-equal? v v0))
(snd-display "pv 2 diff: ~A" (float-vector-peak (float-vector-subtract! v v0)))))
(undo))
@@ -19531,7 +19491,7 @@ EDITS: 2
128 4 32 0.5 #f #f #f)))
(map-channel (lambda (y) (phase-vocoder pv)))
(let ((v (channel->float-vector 0 50))
- (v0 (float-vector 0.00011 0.00065 0.00195 0.00428 0.00785 0.01266 0.01845 0.02456 0.02989 0.03305 0.03267 0.02803 0.01970 0.00993 0.00228 0.00009 0.00441 0.01250 0.01858 0.01759 0.00975 0.00160 0.00079 0.00795 0.01454 0.01201 0.00325 0.00024 0.00716 0.01261 0.00704 0.00003 0.00384 0.00962 0.00620 0.00027 0.00196 0.00655 0.00492 0.00040 0.00101 0.00448 0.00375 0.00041 0.00053 0.00305 0.00273 0.00033 0.00029 0.00204)))
+ (v0 #r(0.00011 0.00065 0.00195 0.00428 0.00785 0.01266 0.01845 0.02456 0.02989 0.03305 0.03267 0.02803 0.01970 0.00993 0.00228 0.00009 0.00441 0.01250 0.01858 0.01759 0.00975 0.00160 0.00079 0.00795 0.01454 0.01201 0.00325 0.00024 0.00716 0.01261 0.00704 0.00003 0.00384 0.00962 0.00620 0.00027 0.00196 0.00655 0.00492 0.00040 0.00101 0.00448 0.00375 0.00041 0.00053 0.00305 0.00273 0.00033 0.00029 0.00204)))
(if (not (mus-arrays-equal? v v0))
(snd-display "pv 3 diff: ~A" (float-vector-peak (float-vector-subtract! v v0)))))
(undo))
@@ -19541,7 +19501,7 @@ EDITS: 2
128 4 64 1.0 #f #f #f)))
(map-channel (lambda (y) (phase-vocoder pv)))
(let ((v (channel->float-vector 0 100))
- (v0 (float-vector 0.00005 0.00033 0.00098 0.00214 0.00392 0.00633 0.00923 0.01228 0.01495 0.01652 0.01633 0.01401 0.00985 0.00497 0.00114 0.00004 0.00221 0.00625 0.00929 0.00880 0.00488 0.00080 0.00040 0.00397 0.00727 0.00601 0.00162 0.00012 0.00358 0.00630 0.00352 0.00002 0.00217 0.00552 0.00300 -0.00008 0.00299 0.00479 0.00083 0.00098 0.00457 0.00175 0.00033 0.00412 0.00172 0.00039 0.00399 0.00087 0.00118 0.00356 -0.00016 0.00280 0.00169 0.00051 0.00326 -0.00030 0.00301 0.00040 0.00184 0.00144 0.00078 0.00213 0.00015 0.00242 -0.00017 0.00240 -0.00038 0.00230 -0.00049 0.00214 -0.00053 0.00194 -0.00051 0.00172 -0.00047 0.00150 -0.00040 0.00127 -0.00033 0.00106 -0.00025 0.00086 -0.00019 0.00068 -0.00013 0.00052 -0.00008 0.00039 -0.00005 0.00027 -0.00002 0.00017 -0.00001 0.00009 0.0 0.00003 0.0 -0.00002 -0.00001 -0.00006)))
+ (v0 #r(0.00005 0.00033 0.00098 0.00214 0.00392 0.00633 0.00923 0.01228 0.01495 0.01652 0.01633 0.01401 0.00985 0.00497 0.00114 0.00004 0.00221 0.00625 0.00929 0.00880 0.00488 0.00080 0.00040 0.00397 0.00727 0.00601 0.00162 0.00012 0.00358 0.00630 0.00352 0.00002 0.00217 0.00552 0.00300 -0.00008 0.00299 0.00479 0.00083 0.00098 0.00457 0.00175 0.00033 0.00412 0.00172 0.00039 0.00399 0.00087 0.00118 0.00356 -0.00016 0.00280 0.00169 0.00051 0.00326 -0.00030 0.00301 0.00040 0.00184 0.00144 0.00078 0.00213 0.00015 0.00242 -0.00017 0.00240 -0.00038 0.00230 -0.00049 0.00214 -0.00053 0.00194 -0.00051 0.00172 -0.00047 0.00150 -0.00040 0.00127 -0.00033 0.00106 -0.00025 0.00086 -0.00019 0.00068 -0.00013 0.00052 -0.00008 0.00039 -0.00005 0.00027 -0.00002 0.00017 -0.00001 0.00009 0.0 0.00003 0.0 -0.00002 -0.00001 -0.00006)))
(if (not (mus-arrays-equal? v v0))
(snd-display "pv 4 diff: ~A" (float-vector-peak (float-vector-subtract! v v0)))))
(undo))
@@ -19553,7 +19513,7 @@ EDITS: 2
128 4 32 1.0 #f #f #f)))
(map-channel (lambda (y) (phase-vocoder pv)))
(let ((v (channel->float-vector 0 100))
- (v0 (float-vector 0.00100 0.00598 0.01756 0.03708 0.06286 0.08826 0.10172 0.09163 0.05680 0.01564 -0.00075 0.02124 0.05164 0.04457 0.00861 0.00529 0.03648 0.02747 -0.00875 0.00936 0.02402 -0.00553 -0.00090 -0.02262 -0.00221 0.06633 -0.03229 0.01861 0.05228 0.00672 0.00885 0.01442 -0.00484 -0.02293 -0.01893 -0.02256 -0.10229 -0.22474 0.31110 0.07597 0.07127 0.03670 0.02583 0.03173 0.02260 0.01550 0.01485 0.03212 -0.00966 0.00779 -0.00964 0.00698 0.01100 0.00468 0.00107 0.00517 0.00469 0.00131 0.00058 0.00530 0.00582 -0.00652 0.00011 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.00000)))
+ (v0 #r(0.00100 0.00598 0.01756 0.03708 0.06286 0.08826 0.10172 0.09163 0.05680 0.01564 -0.00075 0.02124 0.05164 0.04457 0.00861 0.00529 0.03648 0.02747 -0.00875 0.00936 0.02402 -0.00553 -0.00090 -0.02262 -0.00221 0.06633 -0.03229 0.01861 0.05228 0.00672 0.00885 0.01442 -0.00484 -0.02293 -0.01893 -0.02256 -0.10229 -0.22474 0.31110 0.07597 0.07127 0.03670 0.02583 0.03173 0.02260 0.01550 0.01485 0.03212 -0.00966 0.00779 -0.00964 0.00698 0.01100 0.00468 0.00107 0.00517 0.00469 0.00131 0.00058 0.00530 0.00582 -0.00652 0.00011 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.00000)))
(if (not (mus-arrays-equal? v v0))
(snd-display "pv 5 diff: ~A" (float-vector-peak (float-vector-subtract! v v0)))))
(undo))
@@ -19565,7 +19525,7 @@ EDITS: 2
128 4 32 1.0 #f #f #f)))
(map-channel (lambda (y) (phase-vocoder pv)))
(let ((v (channel->float-vector 0 100))
- (v0 (float-vector 0.00332 0.01977 0.05805 0.12252 0.20738 0.29035 0.33291 0.29696 0.18017 0.04637 -0.00003 0.08250 0.18618 0.15495 0.02775 0.02252 0.13597 0.09767 -0.03116 0.05301 0.10256 -0.05005 0.01966 0.06176 -0.04418 0.04118 -0.11409 -0.04115 -0.05157 -0.11409 0.07815 -0.08155 -0.00536 0.02090 -0.18804 -0.10686 -0.11931 -0.42989 0.39009 0.03157 0.14253 0.05984 0.05439 0.00764 0.02636 -0.02799 -0.01346 -0.01011 -0.04925 -0.02896 -0.07812 -0.07880 -0.11338 -0.13133 -0.41421 0.38140 0.08676 0.07712 0.00983 0.03731 0.01585 0.00108 0.00101 0.00282 -0.01106 -0.00403 -0.02165 -0.02054 -0.02452 -0.02382 -0.03213 -0.02693 -0.03734 -0.03978 -0.04879 -0.07504 -0.09597 -0.31426 0.32995 0.13460 0.04120 0.05029 0.01900 0.02517 0.01163 0.01294 0.00827 0.00576 0.00640 0.00141 0.00489 -0.00057 0.00301 -0.00089 0.00099 0.0 0.0 0.0 0.0 -0.00000)))
+ (v0 #r(0.00332 0.01977 0.05805 0.12252 0.20738 0.29035 0.33291 0.29696 0.18017 0.04637 -0.00003 0.08250 0.18618 0.15495 0.02775 0.02252 0.13597 0.09767 -0.03116 0.05301 0.10256 -0.05005 0.01966 0.06176 -0.04418 0.04118 -0.11409 -0.04115 -0.05157 -0.11409 0.07815 -0.08155 -0.00536 0.02090 -0.18804 -0.10686 -0.11931 -0.42989 0.39009 0.03157 0.14253 0.05984 0.05439 0.00764 0.02636 -0.02799 -0.01346 -0.01011 -0.04925 -0.02896 -0.07812 -0.07880 -0.11338 -0.13133 -0.41421 0.38140 0.08676 0.07712 0.00983 0.03731 0.01585 0.00108 0.00101 0.00282 -0.01106 -0.00403 -0.02165 -0.02054 -0.02452 -0.02382 -0.03213 -0.02693 -0.03734 -0.03978 -0.04879 -0.07504 -0.09597 -0.31426 0.32995 0.13460 0.04120 0.05029 0.01900 0.02517 0.01163 0.01294 0.00827 0.00576 0.00640 0.00141 0.00489 -0.00057 0.00301 -0.00089 0.00099 0.0 0.0 0.0 0.0 -0.00000)))
(if (not (mus-arrays-equal? v v0))
(snd-display "pv 6 diff: ~A" (float-vector-peak (float-vector-subtract! v v0)))))
(close-sound ind))))
@@ -19584,14 +19544,15 @@ EDITS: 2
(do ((pscl (/ 1.0 (floor (/ size 4)))) ; overlap = 4
(kscl (/ two-pi size))
(k 0 (+ k 1))
- (ks 0.0 (+ ks kscl)))
+ (ks 0.0))
((= k N2) #f)
(let* ((freq (freqs k))
(diff (- freq (lastphases k))))
(set! (lastphases k) freq)
(if (> diff pi) (set! diff (- diff two-pi)))
(if (< diff (- pi)) (set! diff (+ diff two-pi)))
- (set! (freqs k) (+ (* diff pscl) ks)))))))
+ (set! (freqs k) (+ (* diff pscl) ks)))
+ (set! ks (+ ks kscl))))))
(sfunc (lambda (c)
(float-vector-add! amps paincrs)
@@ -19642,7 +19603,7 @@ EDITS: 2
(do ((i 1 (+ i 1)))
((= i 20))
(set! (vals i) (moog-filter gen 0.0)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.0 0.0025 0.0062 0.0120 0.0198 0.0292 0.0398 0.0510 0.0625
+ (if (not (mus-arrays-equal? vals #r(0.0 0.0 0.0025 0.0062 0.0120 0.0198 0.0292 0.0398 0.0510 0.0625
0.0739 0.0847 0.0946 0.1036 0.1113 0.1177 0.1228 0.1266 0.1290 0.1301)))
(snd-display "moog output: ~A" vals))))
(close-sound ind))
@@ -19745,17 +19706,17 @@ EDITS: 2
(let ((make-procs (vector
make-all-pass make-asymmetric-fm make-moving-average make-moving-max make-moving-norm
- make-comb (lambda () (make-convolve :filter (float-vector 0 1 2))) make-delay (lambda () (make-env '(0 1 1 0) :length 10))
- (lambda () (make-filter :xcoeffs (float-vector 0 1 2))) (lambda () (make-fir-filter :xcoeffs (float-vector 0 1 2)))
+ make-comb (lambda () (make-convolve :filter #r(0 1 2))) make-delay (lambda () (make-env '(0 1 1 0) :length 10))
+ (lambda () (make-filter :xcoeffs #r(0 1 2))) (lambda () (make-fir-filter :xcoeffs #r(0 1 2)))
(lambda () (make-filtered-comb :filter (make-one-zero .5 .5)))
make-formant make-granulate
- (lambda () (make-iir-filter :xcoeffs (float-vector 0 1 2))) make-locsig
+ (lambda () (make-iir-filter :xcoeffs #r(0 1 2))) make-locsig
make-notch make-one-pole (lambda () (make-one-pole-all-pass 1 .5)) make-one-zero make-oscil
make-pulse-train make-rand make-rand-interp make-sawtooth-wave
make-square-wave make-src make-table-lookup make-triangle-wave
make-two-pole make-two-zero make-wave-train make-polyshape make-phase-vocoder make-ssb-am
- (lambda () (make-filter :ycoeffs (float-vector 0 1 2)))
- (lambda () (make-filter :xcoeffs (float-vector 1 2 3) :ycoeffs (float-vector 0 1 2)))))
+ (lambda () (make-filter :ycoeffs #r(0 1 2)))
+ (lambda () (make-filter :xcoeffs #r(1 2 3) :ycoeffs #r(0 1 2)))))
(gen-procs (vector all-pass asymmetric-fm moving-average moving-max moving-norm
comb convolve delay env
filter fir-filter filtered-comb formant granulate
@@ -19837,14 +19798,14 @@ EDITS: 2
make-all-pass make-asymmetric-fm make-moving-average make-moving-max
make-comb
(lambda () (make-filtered-comb :filter (make-one-zero .5 .5)))
- (lambda () (make-convolve :filter (float-vector 0 1 2) :input (lambda (dir) 1.0)))
+ (lambda () (make-convolve :filter #r(0 1 2) :input (lambda (dir) 1.0)))
make-delay
(lambda () (make-env :length 11 :envelope '(0 1 1 0)))
- (lambda () (make-filter :xcoeffs (float-vector 0 1 2)))
- (lambda () (make-fir-filter :xcoeffs (float-vector 0 1 2)))
+ (lambda () (make-filter :xcoeffs #r(0 1 2)))
+ (lambda () (make-fir-filter :xcoeffs #r(0 1 2)))
(lambda () (make-formant :radius .1 :frequency 440.0))
(lambda () (make-granulate (lambda (dir) 1.0)))
- (lambda () (make-iir-filter :xcoeffs (float-vector 0 1 2)))
+ (lambda () (make-iir-filter :xcoeffs #r(0 1 2)))
make-locsig
make-notch
(lambda () (make-one-pole .3 .7))
@@ -19859,8 +19820,8 @@ EDITS: 2
(lambda () (make-polyshape 440.0 :partials '(1 1)))
(lambda () (make-phase-vocoder (lambda (dir) 1.0)))
make-ssb-am
- (lambda () (make-filter :ycoeffs (float-vector 0 1 2)))
- (lambda () (make-filter :xcoeffs (float-vector 1 2 3) :ycoeffs (float-vector 0 1 2)))))
+ (lambda () (make-filter :ycoeffs #r(0 1 2)))
+ (lambda () (make-filter :xcoeffs #r(1 2 3) :ycoeffs #r(0 1 2)))))
(gen-procs (list all-pass asymmetric-fm moving-average moving-max
comb filtered-comb convolve delay
(lambda (gen ignored) (env gen))
@@ -19927,12 +19888,12 @@ EDITS: 2
(for-each
(lambda (arg2)
(catch #t (lambda () (runp gen arg1 arg2)) (lambda args (car args))))
- (list 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .95 .95 .95) #(0 1) 3/4 'mus-error 0+i (make-delay 32)
- (lambda () #t) (curlet) (make-float-vector '(2 3)) :order 0 1 -1 #f #t #\c 0.0 1.0 -1.0
+ (list 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .95 .95 .95) #i(0 1) 3/4 'mus-error 0+i (make-delay 32)
+ (lambda () #t) (curlet) (make-float-vector '(2 3)) :order 0 1 -1 #f #t #\c 0.0 1.0 -1.0 (vector 0 2)
() 3 4 2 8 16 32 64 #() '(1 . 2) (expt 2.0 21.5) (expt 2.0 -18.0)
)))
- (list 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .95 .95 .95) #(0 1) 3/4 'mus-error 0+i (make-delay 32)
- (lambda () #t) (curlet) (make-float-vector '(2 3)) :order 0 1 -1 #f #t #\c 0.0 1.0 -1.0
+ (list 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .95 .95 .95) #i(0 1) 3/4 'mus-error 0+i (make-delay 32)
+ (lambda () #t) (curlet) (make-float-vector '(2 3)) :order 0 1 -1 #f #t #\c 0.0 1.0 -1.0 (vector 0 1)
() 3 4 2 8 16 32 64 #() '(1 . 2) (expt 2.0 21.5) (expt 2.0 -18.0)
))
@@ -19949,7 +19910,7 @@ EDITS: 2
(func gen)
(set! (func gen) arg1))
(lambda args #f)))
- (list 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) #(0 1) 3/4 'mus-error 0+i
+ (list 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) #i(0 1) 3/4 'mus-error 0+i
(lambda () #t) (make-float-vector '(2 3)) :order 0 1 -1 #f #t #\c 0.0 1.0 -1.0
() 3 4 64 -64 #() '(1 . 2) (expt 2.0 21.5) (expt 2.0 -18.0)
(lambda (a) a)))
@@ -19983,7 +19944,7 @@ EDITS: 2
(let ((random-args (vector
(expt 2.0 21.5) (expt 2.0 -18.0)
- 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .1 .2 .3) #(0 1) 3/4 0+i (make-delay 32)
+ 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .1 .2 .3) #i(0 1) 3/4 0+i (make-delay 32)
(lambda () 0.0) (lambda (dir) 1.0) (lambda (a b c) 1.0) 0 1 -1 #f #t #\c 0.0 1.0 -1.0 () 32 '(1 . 2))))
(define (random-gen args)
(let ((gen-make-procs (list make-all-pass make-asymmetric-fm make-moving-average make-moving-max make-moving-norm
@@ -20029,9 +19990,9 @@ EDITS: 2
random-args))))
(do ((ov (make-float-vector 10))
- (tv (float-vector .1 .1 .2 .2 1.5 1.5 1.5 1.5 0.1 0.01))
+ (tv #r(.1 .1 .2 .2 1.5 1.5 1.5 1.5 0.1 0.01))
(gen (make-moving-max 4))
- (iv (float-vector .1 .05 -.2 .15 -1.5 0.1 0.01 0.001 0.0 0.0))
+ (iv #r(.1 .05 -.2 .15 -1.5 0.1 0.01 0.001 0.0 0.0))
(i 0 (+ i 1)))
((= i 10)
(if (not (mus-arrays-equal? tv ov))
@@ -20047,31 +20008,31 @@ EDITS: 2
(snd-display "moving-max ~A ~A" pk val))))
(let ((odata (make-float-vector 15))
- (data (float-vector 1.0 0.0 -1.1 1.1001 0.1 -1.1 1.0 1.0 0.5 -0.01 0.02 0.0 0.0 0.0 0.0))
+ (data #r(1.0 0.0 -1.1 1.1001 0.1 -1.1 1.0 1.0 0.5 -0.01 0.02 0.0 0.0 0.0 0.0))
(g (make-moving-max 3)))
(do ((i 0 (+ i 1))) ((= i 15)) (set! (odata i) (moving-max g (data i))))
- (if (not (mus-arrays-equal? odata (float-vector 1.000 1.000 1.100 1.100 1.100 1.100 1.100 1.100 1.000 1.000 0.500 0.020 0.020 0.000 0.000)))
+ (if (not (mus-arrays-equal? odata #r(1.000 1.000 1.100 1.100 1.100 1.100 1.100 1.100 1.000 1.000 0.500 0.020 0.020 0.000 0.000)))
(snd-display "moving max odata: ~A" odata))
(if (= (odata 4) (odata 7))
(snd-display "moving-max .0001 offset?")))
- (let ((data (float-vector 0.1 -0.2 0.3 0.4 -0.5 0.6 0.7 0.8 -0.9 1.0 0.0 0.0)))
+ (let ((data #r(0.1 -0.2 0.3 0.4 -0.5 0.6 0.7 0.8 -0.9 1.0 0.0 0.0)))
(let ((odata (make-float-vector 15))
(g (make-moving-sum 3)))
(do ((i 0 (+ i 1))) ((= i 12)) (set! (odata i) (moving-sum g (data i))))
- (if (not (mus-arrays-equal? odata (float-vector 0.100 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700 1.900 1.000 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? odata #r(0.100 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700 1.900 1.000 0.000 0.000 0.000)))
(snd-display "moving-sum odata: ~A" odata)))
(let ((odata (make-float-vector 15))
(g (make-moving-rms 4)))
(do ((i 0 (+ i 1))) ((= i 12)) (set! (odata i) (moving-rms g (data i))))
- (if (not (mus-arrays-equal? odata (float-vector 0.050 0.112 0.187 0.274 0.367 0.464 0.561 0.660 0.758 0.857 0.783 0.673 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? odata #r(0.050 0.112 0.187 0.274 0.367 0.464 0.561 0.660 0.758 0.857 0.783 0.673 0.000 0.000 0.000)))
(snd-display "moving-rms odata: ~A" odata)))
(let ((odata (make-float-vector 15))
(g (make-moving-length 4)))
(do ((i 0 (+ i 1))) ((= i 12)) (set! (odata i) (moving-length g (data i))))
- (if (not (mus-arrays-equal? odata (float-vector 0.100 0.224 0.374 0.548 0.735 0.927 1.122 1.319 1.517 1.715 1.565 1.345 0.000 0.000 0.000)))
+ (if (not (mus-arrays-equal? odata #r(0.100 0.224 0.374 0.548 0.735 0.927 1.122 1.319 1.517 1.715 1.565 1.345 0.000 0.000 0.000)))
(snd-display "moving-length odata: ~A" odata)))
(let ((ind (new-sound "test.snd" :size 20)))
@@ -20079,7 +20040,7 @@ EDITS: 2
(let ((gen1 (make-weighted-moving-average 4)))
(map-channel (lambda (y) (weighted-moving-average gen1 y))))
(let ((data1 (channel->float-vector))
- (gen2 (make-fir-filter 4 (float-vector 0.4 0.3 0.2 0.1))))
+ (gen2 (make-fir-filter 4 #r(0.4 0.3 0.2 0.1))))
(undo)
(map-channel (lambda (y) (fir-filter gen2 y)))
(let ((data2 (channel->float-vector)))
@@ -20481,7 +20442,7 @@ EDITS: 2
(c4 (make-formant-bank (vector (make-formant 440.0 .5)
(make-formant 1000.0 .2)
(make-formant 34.0 .1))
- (float-vector .5 .3 .4)))
+ #r(.5 .3 .4)))
(i 0 (+ i 1))
(x 1.0 0.0))
((= i 40))
@@ -20496,7 +20457,7 @@ EDITS: 2
(c4 (make-formant-bank (vector (make-formant 440.0 .9)
(make-formant 1000.0 .9)
(make-formant 34.0 .9))
- (float-vector .5 .3 .4)))
+ #r(.5 .3 .4)))
(i 0 (+ i 1))
(x 1.0 0.0))
((= i 40))
@@ -20545,7 +20506,7 @@ EDITS: 2
(c4 (make-formant-bank (vector (make-formant 440.0 .5)
(make-formant 1000.0 .2)
(make-formant 34.0 .1))
- (float-vector .5 .3 .4)))
+ #r(.5 .3 .4)))
(i 0 (+ i 1))
(x 1.0 0.0))
((= i 40))
@@ -20562,7 +20523,7 @@ EDITS: 2
(c4 (make-formant-bank (vector (make-formant 440.0 .9)
(make-formant 1000.0 .9)
(make-formant 34.0 .9))
- (float-vector .5 .3 .4)))
+ #r(.5 .3 .4)))
(i 0 (+ i 1))
(x 1.0 0.0))
((= i 40))
@@ -20579,7 +20540,7 @@ EDITS: 2
(c4 (make-formant-bank (vector (make-formant 440.0 .9)
(make-formant 1000.0 .9)
(make-formant 34.0 .9))
- (float-vector .5 .3 .4)))
+ #r(.5 .3 .4)))
(i 0 (+ i 1))
(x 1.0 0.0)
(y 1.0 0.0)
@@ -20895,17 +20856,17 @@ EDITS: 2
)
(let-temporarily ((*clm-srate* 44100))
- (let ((pe (make-pulsed-env '(0 0 1 1 2 0) .0004 2205))
- (v (make-float-vector 100)))
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (set! (v i) (pulsed-env pe)))
- (if (not (mus-arrays-equal? v (float-vector 0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000
- 0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000
- 0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000
- 0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000
- 0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000)))
- (snd-display "pulsed-env: ~A" v))))
+ (do ((pe (make-pulsed-env '(0 0 1 1 2 0) .0004 2205))
+ (v (make-float-vector 100))
+ (i 0 (+ i 1)))
+ ((= i 100)
+ (if (not (mus-arrays-equal? v #r(0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000
+ 0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000
+ 0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000
+ 0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000
+ 0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000)))
+ (snd-display "pulsed-env: ~A" v)))
+ (set! (v i) (pulsed-env pe))))
(for-each copy-test
(vector (make-oscil 330.0)
@@ -20925,7 +20886,7 @@ EDITS: 2
(make-two-pole .9 .1 .2)
(make-polywave 440.0 '(1 .5 2 .5))
(make-polyshape 440.0 :coeffs (partials->polynomial '(1 1.0)))
- (make-oscil-bank (float-vector 100 200 300) (float-vector 0.0 1.0 2.0) (float-vector 0.5 0.25 0.125))
+ (make-oscil-bank #r(100 200 300) #r(0.0 1.0 2.0) #r(0.5 0.25 0.125))
(make-delay 10)
(make-comb .7 10)
(make-notch .7 10)
@@ -20939,9 +20900,9 @@ EDITS: 2
(make-filtered-comb-bank (vector (make-filtered-comb .5 3) (make-filtered-comb .2 10) (make-filtered-comb -.7 11)))
(make-formant 1200.0 0.9)
(make-firmant 1200.0 0.9)
- (make-fir-filter 4 (float-vector 0.4 0.3 0.2 0.1))
- (make-iir-filter 4 (float-vector 0.4 0.3 0.2 0.1))
- (make-filter 4 (float-vector 0.4 0.3 0.2 0.1))
+ (make-fir-filter 4 #r(0.4 0.3 0.2 0.1))
+ (make-iir-filter 4 #r(0.4 0.3 0.2 0.1))
+ (make-filter 4 #r(0.4 0.3 0.2 0.1))
(make-one-pole-all-pass 8 .5)
(make-readin "oboe.snd")
(make-env '(0 0 1 1) :length 10)
@@ -20978,12 +20939,12 @@ EDITS: 2
(if (equal? o p)
(snd-display "nssb copy/run ~A == ~A~%" o p)))
- (let* ((o (make-wave-train 100 :wave (float-vector 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9)))
+ (let* ((o (make-wave-train 100 :wave #r(0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9)))
(p (copy o)))
(if (not (equal? o p))
(snd-display "wave-train copy ~A != ~A~%" o p)))
- (let* ((o (make-table-lookup 440.0 :wave (float-vector 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9)))
+ (let* ((o (make-table-lookup 440.0 :wave #r(0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9)))
(p (copy o)))
(if (not (equal? o p))
(snd-display "table-lookup copy ~A != ~A~%" o p))
@@ -21003,10 +20964,10 @@ EDITS: 2
((= test-ctr tests))
(let ((ind (new-sound "test.snd" :size 10)))
- (let ((v (float-vector .1 .2 .3)))
+ (let ((v #r(.1 .2 .3)))
(let ((id (mix-float-vector v 0)))
(let ((nv (channel->float-vector)))
- (if (not (mus-arrays-equal? nv (float-vector .1 .2 .3 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? nv #r(.1 .2 .3 0 0 0 0 0 0 0)))
(snd-display "mix v at 0: ~A" nv)))
(let ((eds (edit-tree ind 0)))
(if (not (feql eds '((0 0 0 2 0.0 0.0 0.0 3) (3 0 3 9 0.0 0.0 0.0 2) (10 -2 0 0 0.0 0.0 0.0 0))))
@@ -21038,13 +20999,13 @@ EDITS: 2
(mix-float-vector v 8)
(if (not (= (framples ind 0) 11)) (snd-display "mix v at 8 new len: ~A" (framples ind 0)))
(let ((nv (channel->float-vector)))
- (if (not (mus-arrays-equal? nv (float-vector 0 0 0 0 0 0 0 0 .1 .2 .3)))
+ (if (not (mus-arrays-equal? nv #r(0 0 0 0 0 0 0 0 .1 .2 .3)))
(snd-display "mix v at 8: ~A" nv)))
(undo)
(mix-float-vector v 3)
(if (not (= (framples ind 0) 10)) (snd-display "mix v at 3 new len: ~A" (framples ind 0)))
(let ((nv (channel->float-vector)))
- (if (not (mus-arrays-equal? nv (float-vector 0 0 0 .1 .2 .3 0 0 0 0)))
+ (if (not (mus-arrays-equal? nv #r(0 0 0 .1 .2 .3 0 0 0 0)))
(snd-display "mix v at 3: ~A" nv)))
(undo))
(let ((v (make-float-vector 20 .5)))
@@ -21077,19 +21038,19 @@ EDITS: 2
(close-sound ind))
(let ((ind (new-sound "test.snd" :size 10))
- (v (float-vector .1 .2 .3)))
+ (v #r(.1 .2 .3)))
(let ((id (mix-float-vector v 0)))
(scale-by 2.0)
(if (not (mix? id)) (snd-display "scaled (2) mix not active?"))
(let ((nv (channel->float-vector)))
- (if (not (mus-arrays-equal? nv (float-vector-scale! (float-vector .1 .2 .3 0 0 0 0 0 0 0) 2.0)))
+ (if (not (mus-arrays-equal? nv (float-vector-scale! #r(.1 .2 .3 0 0 0 0 0 0 0) 2.0)))
(snd-display "mix v at 0 scale-by 2: ~A" nv)))
(if (fneq (mix-amp id) 2.0) (snd-display "mix then scale mix amp: ~A" (mix-amp id)))
(undo)
(delete-sample 1)
(if (not (mix? id)) (snd-display "delete hit mix: ~A" (mix? id)))
(let ((nv (channel->float-vector)))
- (if (not (mus-arrays-equal? nv (float-vector .1 .3 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? nv #r(.1 .3 0 0 0 0 0 0 0)))
(snd-display "mix v at 0 delete .2: ~A" nv)))
(revert-sound ind))
(let ((id (mix-float-vector v 0)))
@@ -21109,20 +21070,20 @@ EDITS: 2
(scale-by 3.0)
(if (not (mix? id)) (snd-display "scaled (3) mix not active?"))
(let ((nv (channel->float-vector)))
- (if (not (mus-arrays-equal? nv (float-vector-scale! (float-vector-add! (make-float-vector 9 .2) (float-vector .1 .2 .3)) 3.0)))
+ (if (not (mus-arrays-equal? nv (float-vector-scale! (float-vector-add! (make-float-vector 9 .2) #r(.1 .2 .3)) 3.0)))
(snd-display "mix v at 0 scale-by 2 and 3: ~A" nv))))
(revert-sound ind)
(map-channel (lambda (y) 1.0))
(env-channel '(0 0 1 1 2 0) 0 11)
- (let ((v (float-vector .1 .2 .3)))
+ (let ((v #r(.1 .2 .3)))
(mix-float-vector v 3)
(let ((nv (channel->float-vector)))
- (if (not (mus-arrays-equal? nv (float-vector 0.0 0.200 0.400 0.700 1.000 1.300 0.800 0.600 0.400 0.200)))
+ (if (not (mus-arrays-equal? nv #r(0.0 0.200 0.400 0.700 1.000 1.300 0.800 0.600 0.400 0.200)))
(snd-display "mix v at 3 after env: ~A" nv))))
(close-sound ind)))
(let* ((ind (new-sound "test.snd" :size 100))
- (v (float-vector .1 .2 .3))
+ (v #r(.1 .2 .3))
(id (mix-float-vector v 10)))
(pad-channel 0 10)
(if (not (mix? id)) (snd-display "padded mix not active?"))
@@ -21137,25 +21098,25 @@ EDITS: 2
(let ((id1 (mix-float-vector v 22))
(id2 (mix-float-vector v 21)))
(let ((vals (channel->float-vector 18 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.0 0.100 0.300 0.600 0.500 0.300 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? vals #r(0.0 0.0 0.100 0.300 0.600 0.500 0.300 0.0 0.0 0.000)))
(snd-display "mix 3 vs: ~A" vals)))
(if (not (mix? id)) (snd-display "mix 3vs 1 not active?"))
(if (not (mix? id1)) (snd-display "mix 3vs 2 not active?"))
(if (not (mix? id2)) (snd-display "mix 3vs 3 not active?"))
(set! (mix-position id) 10)
(let ((vals (channel->float-vector 18 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.0 0.0 0.100 0.300 0.500 0.300 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? vals #r(0.0 0.0 0.0 0.100 0.300 0.500 0.300 0.0 0.0 0.000)))
(snd-display "mix 3 vs then move first: ~A" vals))
(set! (mix-position id2) 30))
(let ((vals (channel->float-vector 18 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.0 0.0 0.0 0.100 0.200 0.300 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? vals #r(0.0 0.0 0.0 0.0 0.100 0.200 0.300 0.0 0.0 0.000)))
(snd-display "mix 3 vs then move 2: ~A" vals)))
(scale-by 2.0)
(if (not (mix? id)) (snd-display "mix 3vs 1 scl not active?"))
(if (not (mix? id1)) (snd-display "mix 3vs 2 scl not active?"))
(if (not (mix? id2)) (snd-display "mix 3vs 3 scl not active?"))
(let ((vals (channel->float-vector 18 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.0 0.0 0.0 0.200 0.400 0.600 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? vals #r(0.0 0.0 0.0 0.0 0.200 0.400 0.600 0.0 0.0 0.000)))
(snd-display "mix 3 vs then move 2 scl: ~A" vals)))
(delete-sample 15)
(if (not (mix? id)) (snd-display "mix 3vs 1 scl del not active?"))
@@ -21170,7 +21131,7 @@ EDITS: 2
(id (mix-float-vector (make-float-vector 11 1.0) 2)))
(set! (mix-amp-env id) '(0 0 1 1))
(let ((vals (channel->float-vector)))
- (if (not (mus-arrays-equal? vals (float-vector 0 0 0 .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0 0 0)))
+ (if (not (mus-arrays-equal? vals #r(0 0 0 .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0 0 0)))
(snd-display "ramp mix amp env: ~A" vals)))
(set! (mix-amp-env id) #f)
(if (pair? (mix-amp-env id)) (snd-display "set mix-amp-env to null: ~A" (mix-amp-env id)))
@@ -21178,14 +21139,14 @@ EDITS: 2
(if (not (= (framples) 24)) (snd-display "mix speed lengthens 24: ~A" (framples)))
(set! (mix-speed id) 1.0)
(let ((vals (channel->float-vector)))
- (if (not (mus-arrays-equal? vals (float-vector 0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? vals #r(0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0)))
(snd-display "return to mix original index: ~A" vals)))
(set! (mix-amp-env id) '(0 0 1 1 2 1 3 0))
(set! (mix-speed id) 0.5)
(set! (mix-amp-env id) #f)
(set! (mix-speed id) 1.0)
(let ((vals (channel->float-vector)))
- (if (not (mus-arrays-equal? vals (float-vector 0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? vals #r(0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0)))
(snd-display "return again to mix original index: ~A" vals)))
(close-sound ind))
@@ -21550,7 +21511,7 @@ EDITS: 2
(let* ((ind (new-sound "test.snd" :size 100))
(id (mix-float-vector (make-float-vector 5 .5) 11))
- (fv5 (float-vector 0 0.5 0.5 0.5 0.5 0.5 0 0 0 0)))
+ (fv5 #r(0 0.5 0.5 0.5 0.5 0.5 0 0 0 0)))
;; pad-channel
(if (not (mus-arrays-equal? (channel->float-vector 10 10) fv5))
@@ -21588,7 +21549,7 @@ EDITS: 2
(pad-channel 32 3)
; (if (mix? id) (snd-display "pad within mix but exists?: ~A" (mix? id)))
(if (not (mix? id)) (snd-display "pad within mix but no mix?: ~A" (mix? id)))
- (if (not (mus-arrays-equal? (channel->float-vector 30 10) (float-vector 0 .5 0 0 0 .5 .5 .5 .5 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 30 10) #r(0 .5 0 0 0 .5 .5 .5 .5 0)))
(snd-display "float-vector .5 at 31 pad at 32: ~A" (channel->float-vector 30 10)))
(set! (edit-position) 1)
@@ -21615,7 +21576,7 @@ EDITS: 2
(delete-samples 3 3)
; (if (mix? id) (snd-display "delete within mix but exists?: ~A" (mix? id)))
(if (not (mix? id)) (snd-display "delete within mix but no mix?: ~A" (mix? id)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 10) (float-vector 0 .5 .5 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 10) #r(0 .5 .5 0 0 0 0 0 0 0)))
(snd-display "float-vector .5 at 1 del at 3: ~A" (channel->float-vector 0 10)))
(set! (edit-position) 1)
@@ -21639,10 +21600,10 @@ EDITS: 2
(snd-display "float-vector .5 at 11 set 20 position: ~A" (mix-position id)))
(if (not (mus-arrays-equal? (channel->float-vector 10 10) fv5))
(snd-display "float-vector .5 at 11 set 20: ~A" (channel->float-vector 10 10)))
- (set! (samples 12 2) (float-vector -.5 .8))
+ (set! (samples 12 2) #r(-.5 .8))
; (if (mix? id) (snd-display "set within mix but exists?: ~A" (mix? id)))
(if (not (mix? id)) (snd-display "set within mix but no mix?: ~A" (mix? id)))
- (if (not (mus-arrays-equal? (channel->float-vector 10 10) (float-vector 0 .5 -.5 .8 .5 .5 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 10 10) #r(0 .5 -.5 .8 .5 .5 0 0 0 0)))
(snd-display "float-vector .5 at 11 set at 12: ~A" (channel->float-vector 10 10)))
(set! (edit-position) 1)
@@ -21657,7 +21618,7 @@ EDITS: 2
(snd-display "scale locked mix? ~A" (mix? id)))
(if (not (= (mix-position id) 11))
(snd-display "float-vector .5 at 11 scale position: ~A" (mix-position id)))
- (if (not (mus-arrays-equal? (channel->float-vector 10 10) (float-vector 0 1 1 1 1 1 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 10 10) #r(0 1 1 1 1 1 0 0 0 0)))
(snd-display "float-vector 1 at 11 scale: ~A" (channel->float-vector 10 10)))
(scale-channel 0.5)
(if (not (mix? id))
@@ -21683,7 +21644,7 @@ EDITS: 2
(scale-channel 2.0 12 2)
; (if (mix? id) (snd-display "scale within mix but exists?: ~A" (mix? id)))
(if (not (mix? id)) (snd-display "scale within mix but no mix?: ~A" (mix? id)))
- (if (not (mus-arrays-equal? (channel->float-vector 10 10) (float-vector 0 .5 1 1 .5 .5 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 10 10) #r(0 .5 1 1 .5 .5 0 0 0 0)))
(snd-display "float-vector .5 at 11 scale at 12: ~A" (channel->float-vector 10 10)))
(set! (edit-position) 1)
@@ -21710,7 +21671,7 @@ EDITS: 2
(env-channel '(0 0 1 1))
; (if (mix? id) (snd-display "env over mix but exists?: ~A" (mix? id)))
(if (not (mix? id)) (snd-display "env over mix but no mix?: ~A" (mix? id)))
- (if (not (mus-arrays-equal? (channel->float-vector 10 10) (float-vector 0.0 0.056 0.061 0.066 0.071 0.076 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? (channel->float-vector 10 10) #r(0.0 0.056 0.061 0.066 0.071 0.076 0.0 0.0 0.0 0.000)))
(snd-display "float-vector .5 at 11 over env: ~A" (channel->float-vector 10 10)))
(set! (edit-position) 1)
@@ -21730,7 +21691,7 @@ EDITS: 2
((= i 5))
(set! ids (cons (mix-float-vector (make-float-vector 5 .1) (+ i 10)) ids)))
(let ((vals (channel->float-vector 8 14)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.0 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? vals #r(0.0 0.0 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.0 0.0 0.000)))
(snd-display "pile up mixes: ~A" vals)))
(let ((mx (mixes-maxamp ids)))
(if (fneq mx .1)
@@ -21745,7 +21706,7 @@ EDITS: 2
(scale-mixes ids -2.0)
(for-each (lambda (m) (if (fneq (mix-amp m) -2.0) (snd-display "scale-mixes ~A: ~A" m (mix-amp m)))) ids)
(let ((vals (channel->float-vector 8 14)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.0 -0.200 -0.400 -0.600 -0.800 -1.000 -0.800 -0.600 -0.400 -0.200 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? vals #r(0.0 0.0 -0.200 -0.400 -0.600 -0.800 -1.000 -0.800 -0.600 -0.400 -0.200 0.0 0.0 0.000)))
(snd-display "scale piled up mixes: ~A" vals)))
(silence-mixes ids)
(let ((vals (channel->float-vector 8 14)))
@@ -21753,7 +21714,7 @@ EDITS: 2
(snd-display "silence piled up mixes: ~A" vals)))
(undo 2)
(let ((vals (channel->float-vector 8 14)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.0 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? vals #r(0.0 0.0 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.0 0.0 0.000)))
(snd-display "undo 2 to pile up mixes: ~A" vals)))
(play-mixes ids)
(set-mixes-tag-y ids 100)
@@ -21761,14 +21722,14 @@ EDITS: 2
(set-mixes-tag-y ids 0)
(move-mixes ids 10)
(let ((vals (channel->float-vector 18 14)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.0 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? vals #r(0.0 0.0 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.0 0.0 0.000)))
(snd-display "move piled up mixes: ~A" vals)))
(let ((vals (channel->float-vector 8 8)))
(if (not (mus-arrays-equal? vals (make-float-vector 8)))
(snd-display "move piled up mixes original: ~A" vals)))
(move-mixes ids -10)
(let ((vals (channel->float-vector 8 14)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.0 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? vals #r(0.0 0.0 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.0 0.0 0.000)))
(snd-display "move piled up mixes -10: ~A" vals)))
(let ((vals (channel->float-vector 23 8)))
(if (not (mus-arrays-equal? vals (make-float-vector 8)))
@@ -21781,11 +21742,11 @@ EDITS: 2
(sync-all-mixes 0)
(env-mixes ids '(0 0 1 1 2 0))
(let ((vals (channel->float-vector 10 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.045 0.137 0.278 0.460 0.360 0.203 0.087 0.020 0.000)))
+ (if (not (mus-arrays-equal? vals #r(0.0 0.045 0.137 0.278 0.460 0.360 0.203 0.087 0.020 0.000)))
(snd-display "env-mixes: ~A" vals)))
(undo 3)
(let ((vals (channel->float-vector 8 14)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.0 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? vals #r(0.0 0.0 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.0 0.0 0.000)))
(snd-display "undo 3 mixes envd: ~A" vals)))
(color-mixes ids (make-color 0 1 0))
(scale-tempo ids 2.0)
@@ -21793,21 +21754,21 @@ EDITS: 2
(if (not (equal? begs '(18 16 14 12 10)))
(snd-display "scale-tempo by 2: ~A" begs)))
(let ((vals (channel->float-vector 10 15)))
- (if (not (mus-arrays-equal? vals (float-vector 0.100 0.100 0.200 0.200 0.300 0.200 0.300 0.200 0.300 0.200 0.200 0.100 0.100 0.0 0.000)))
+ (if (not (mus-arrays-equal? vals #r(0.100 0.100 0.200 0.200 0.300 0.200 0.300 0.200 0.300 0.200 0.200 0.100 0.100 0.0 0.000)))
(snd-display "scale-tempo 2 vals: ~A" vals)))
(scale-tempo ids 0.5)
(let ((begs (map mix-position ids)))
(if (not (equal? begs '(14 13 12 11 10)))
(snd-display "scale-tempo by 0.5: ~A" begs)))
(let ((vals (channel->float-vector 10 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000)))
+ (if (not (mus-arrays-equal? vals #r(0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000)))
(snd-display "scale-tempo back 0.5: ~A" vals)))
(scale-tempo ids -1.0)
(let ((begs (map mix-position ids)))
(if (not (equal? begs '(6 7 8 9 10)))
(snd-display "scale-tempo by -1: ~A" begs)))
(let ((vals (channel->float-vector 0 15)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100)))
+ (if (not (mus-arrays-equal? vals #r(0.0 0.0 0.0 0.0 0.0 0.0 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100)))
(snd-display "scale-tempo -1 vals: ~A" vals)))
(undo 3)
(set! *sinc-width* 10)
@@ -21817,7 +21778,7 @@ EDITS: 2
(if (not (= (mixes-length ids) 15))
(snd-display "src-mixes length: ~A" (mixes-length ids)))
(let ((vals (channel->float-vector 10 15)))
- (if (not (mus-arrays-equal? vals (float-vector 0.100 0.211 0.311 0.408 0.508 0.505 0.495 0.505 0.508 0.460 0.362 0.262 0.152 0.052 0.000)))
+ (if (not (mus-arrays-equal? vals #r(0.100 0.211 0.311 0.408 0.508 0.505 0.495 0.505 0.508 0.460 0.362 0.262 0.152 0.052 0.000)))
(snd-display "src-mixes 0.5 vals: ~A" vals)))
(if (not (mus-arrays-equal? (mix->float-vector (car ids)) (mix->float-vector (cadr ids))))
(snd-display "src-mixes vals don't match: ~A ~A" (mix->float-vector (car ids)) (mix->float-vector (cadr ids))))
@@ -21828,7 +21789,7 @@ EDITS: 2
(if (not (= (mixes-length ids) 15))
(snd-display "transpose-mixes length: ~A" (mixes-length ids)))
(let ((vals (channel->float-vector 10 15)))
- (if (not (mus-arrays-equal? vals (float-vector 0.100 0.211 0.311 0.408 0.508 0.505 0.495 0.505 0.508 0.460 0.362 0.262 0.152 0.052 0.000)))
+ (if (not (mus-arrays-equal? vals #r(0.100 0.211 0.311 0.408 0.508 0.505 0.495 0.505 0.508 0.460 0.362 0.262 0.152 0.052 0.000)))
(snd-display "transpose-mixes 0.5 vals: ~A" vals)))
(if (not (mus-arrays-equal? (mix->float-vector (car ids)) (mix->float-vector (cadr ids))))
(snd-display "transpose-mixes vals don't match: ~A ~A" (mix->float-vector (car ids)) (mix->float-vector (cadr ids))))
@@ -21837,7 +21798,7 @@ EDITS: 2
;; check locks
(let* ((ind (new-sound "test.snd" :size 100))
- (id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (id (mix-float-vector #r(.1 .2 .3) 50)))
(if (not (mix? id))
(snd-display "mix lock 0: ~A ~A" id (mix? id)))
(ramp-channel 0.0 1.0 0 20)
@@ -21856,11 +21817,11 @@ EDITS: 2
(if (not (mix? id))
(snd-display "mix lock 8: ~A ~A" id (mix? id)))
(undo)
- (insert-samples 51 2 (float-vector .1 .2))
+ (insert-samples 51 2 #r(.1 .2))
(if (not (mix? id))
(snd-display "mix lock 9: ~A ~A" id (mix? id)))
(undo)
- (insert-samples 1 2 (float-vector .1 .2))
+ (insert-samples 1 2 #r(.1 .2))
(if (not (mix? id))
(snd-display "mix lock 10: ~A ~A" id (mix? id)))
(undo)
@@ -21894,7 +21855,7 @@ EDITS: 2
;; check various mix ops briefly
(map-channel (lambda (y) 1.0))
(env-channel '(0 0 1 1))
- (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((id (mix-float-vector #r(.1 .2 .3) 50)))
(let ((vals (channel->float-vector 48 10)))
(if (not (mus-arrays-equal? vals (float-vector 0.485 0.495 0.605 0.715 0.825 0.535 0.545 0.556 0.566 0.576)))
(snd-display "mix on env: ~A" vals)))
@@ -21910,9 +21871,9 @@ EDITS: 2
(undo)
(env-channel '(0 0 1 1))
- (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((id (mix-float-vector #r(.1 .2 .3) 50)))
(let ((vals (channel->float-vector 48 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.235 0.245 0.355 0.465 0.576 0.287 0.298 0.309 0.320 0.331)))
+ (if (not (mus-arrays-equal? vals #r(0.235 0.245 0.355 0.465 0.576 0.287 0.298 0.309 0.320 0.331)))
(snd-display "mix on env 1: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display "mix on env 1: ~A ~A" id (mix? id))))
@@ -21926,9 +21887,9 @@ EDITS: 2
(undo)
(env-channel '(0 0 1 1))
- (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((id (mix-float-vector #r(.1 .2 .3) 50)))
(let ((vals (channel->float-vector 48 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.114 0.121 0.229 0.337 0.445 0.153 0.162 0.171 0.181 0.191)))
+ (if (not (mus-arrays-equal? vals #r(0.114 0.121 0.229 0.337 0.445 0.153 0.162 0.171 0.181 0.191)))
(snd-display "mix on env 2: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display "mix on env 2: ~A ~A" id (mix? id))))
@@ -21942,9 +21903,9 @@ EDITS: 2
(undo)
(env-channel '(0 0 1 1))
- (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((id (mix-float-vector #r(.1 .2 .3) 50)))
(let ((vals (channel->float-vector 48 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.055 0.060 0.165 0.270 0.376 0.082 0.089 0.095 0.102 0.110)))
+ (if (not (mus-arrays-equal? vals #r(0.055 0.060 0.165 0.270 0.376 0.082 0.089 0.095 0.102 0.110)))
(snd-display "mix on env 3: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display "mix on env 3: ~A ~A" id (mix? id))))
@@ -21958,9 +21919,9 @@ EDITS: 2
(undo)
(env-channel '(0 0 1 1))
- (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((id (mix-float-vector #r(.1 .2 .3) 50)))
(let ((vals (channel->float-vector 48 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.027 0.030 0.133 0.236 0.340 0.044 0.048 0.053 0.058 0.063)))
+ (if (not (mus-arrays-equal? vals #r(0.027 0.030 0.133 0.236 0.340 0.044 0.048 0.053 0.058 0.063)))
(snd-display "mix on env 4: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display "mix on env 4: ~A ~A" id (mix? id))))
@@ -21975,9 +21936,9 @@ EDITS: 2
(set! (edit-position ind 0) 1)
(xramp-channel 1 0 32.0)
- (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((id (mix-float-vector #r(.1 .2 .3) 50)))
(let ((vals (channel->float-vector 48 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.160 0.153 0.247 0.341 0.435 0.129 0.124 0.118 0.113 0.108)))
+ (if (not (mus-arrays-equal? vals #r(0.160 0.153 0.247 0.341 0.435 0.129 0.124 0.118 0.113 0.108)))
(snd-display "mix on xramp: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display "mix on xramp: ~A ~A" id (mix? id))))
@@ -21992,9 +21953,9 @@ EDITS: 2
(set! (edit-position ind 0) 1)
(xramp-channel 1 0 32.0)
(xramp-channel 1 0 32.0)
- (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((id (mix-float-vector #r(.1 .2 .3) 50)))
(let ((vals (channel->float-vector 48 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.026 0.024 0.122 0.220 0.318 0.017 0.015 0.014 0.013 0.012)))
+ (if (not (mus-arrays-equal? vals #r(0.026 0.024 0.122 0.220 0.318 0.017 0.015 0.014 0.013 0.012)))
(snd-display "mix on xramp2: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display "mix on xramp2: ~A ~A" id (mix? id))))
@@ -22010,9 +21971,9 @@ EDITS: 2
(xramp-channel 1 0 32.0)
(xramp-channel 1 0 32.0)
(ramp-channel 1 0)
- (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((id (mix-float-vector #r(.1 .2 .3) 50)))
(let ((vals (channel->float-vector 48 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.013 0.012 0.111 0.210 0.309 0.008 0.007 0.006 0.006 0.005)))
+ (if (not (mus-arrays-equal? vals #r(0.013 0.012 0.111 0.210 0.309 0.008 0.007 0.006 0.006 0.005)))
(snd-display "mix on xramp2_ramp: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display "mix on xramp2_ramp: ~A ~A" id (mix? id))))
@@ -22029,9 +21990,9 @@ EDITS: 2
(xramp-channel 1 0 32.0)
(ramp-channel 1 0)
(ramp-channel 1 0)
- (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((id (mix-float-vector #r(.1 .2 .3) 50)))
(let ((vals (channel->float-vector 48 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.007 0.006 0.105 0.205 0.304 0.004 0.003 0.003 0.002 0.002)))
+ (if (not (mus-arrays-equal? vals #r(0.007 0.006 0.105 0.205 0.304 0.004 0.003 0.003 0.002 0.002)))
(snd-display "mix on xramp2_ramp2: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display "mix on xramp2_ramp2: ~A ~A" id (mix? id))))
@@ -22046,9 +22007,9 @@ EDITS: 2
(set! (edit-position ind 0) 1)
(xramp-channel 1 0 32.0)
(ramp-channel 1 0)
- (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((id (mix-float-vector #r(.1 .2 .3) 50)))
(let ((vals (channel->float-vector 48 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.082 0.077 0.173 0.268 0.364 0.060 0.056 0.053 0.049 0.046)))
+ (if (not (mus-arrays-equal? vals #r(0.082 0.077 0.173 0.268 0.364 0.060 0.056 0.053 0.049 0.046)))
(snd-display "mix on xramp_ramp: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display "mix on xramp_ramp: ~A ~A" id (mix? id))))
@@ -22064,9 +22025,9 @@ EDITS: 2
(xramp-channel 1 0 32.0)
(ramp-channel 1 0)
(ramp-channel 1 0)
- (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((id (mix-float-vector #r(.1 .2 .3) 50)))
(let ((vals (channel->float-vector 48 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.042 0.039 0.136 0.233 0.330 0.028 0.026 0.023 0.021 0.019)))
+ (if (not (mus-arrays-equal? vals #r(0.042 0.039 0.136 0.233 0.330 0.028 0.026 0.023 0.021 0.019)))
(snd-display "mix on xramp_ramp2: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display "mix on xramp_ramp2: ~A ~A" id (mix? id))))
@@ -22083,9 +22044,9 @@ EDITS: 2
(ramp-channel 1 0)
(ramp-channel 1 0)
(ramp-channel 1 0)
- (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((id (mix-float-vector #r(.1 .2 .3) 50)))
(let ((vals (channel->float-vector 48 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.022 0.020 0.118 0.216 0.314 0.013 0.012 0.010 0.009 0.008)))
+ (if (not (mus-arrays-equal? vals #r(0.022 0.020 0.118 0.216 0.314 0.013 0.012 0.010 0.009 0.008)))
(snd-display "mix on xramp_ramp3: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display "mix on xramp_ramp3: ~A ~A" id (mix? id))))
@@ -22099,10 +22060,10 @@ EDITS: 2
(set! *with-mix-tags* #t)
(revert-sound)
- (mix-float-vector (float-vector .1 .2 .3) 50)
+ (mix-float-vector #r(.1 .2 .3) 50)
(reverse-sound)
(let ((vals (channel->float-vector 45 8)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.0 0.300 0.200 0.100 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? vals #r(0.0 0.0 0.300 0.200 0.100 0.0 0.0 0.000)))
(snd-display "reversed mix vals: ~A" vals)))
(close-sound ind))
@@ -22454,6 +22415,13 @@ EDITS: 2
(set! happy #f)
(snd-display "copy mix at ~A: ~A ~A ~A" i x1 x2 (* i .001)))))))
(close-sound snd))
+
+ (let ((ind (new-sound "mix-test.snd" :channels 4 :size 100)))
+ (let ((mx (mix "2a.snd" 0 #t)))
+ (if (not (and (= (length mx) 2)
+ (= (length (car (mixes))) 4)))
+ (snd-display "mixes 4+2: ~A ~A" mx (mixes))))
+ (close-sound ind))
(when all-args
;; waltz
@@ -22824,7 +22792,7 @@ EDITS: 2
(undo)
(filter-sound '(0 1 1 0) 1024)
(undo)
- (filter-sound (make-fir-filter 6 (float-vector .1 .2 .3 .3 .2 .1)))
+ (filter-sound (make-fir-filter 6 #r(.1 .2 .3 .3 .2 .1)))
(undo)
(filter-sound (make-delay 120))
(undo)
@@ -23416,8 +23384,7 @@ EDITS: 2
(if (find-mark 12345) (snd-display "find-mark when no marks: ~A" (find-mark 12345)))
(add-mark 123 ind 0)
(delete-sample 0)
- (let ((m1 (add-mark 23 ind 0)))
- (set! (mark-name m1) "23"))
+ (set! (mark-name (add-mark 23 ind 0)) "23")
(delete-sample 0)
(if (not (find-mark 123 ind 0 0))
(snd-display "can't find 00th mark"))
@@ -23950,11 +23917,9 @@ EDITS: 2
(rd22 (copy-sampler rd2)))
(if (not (and (region-sampler? rd11) (region-sampler? rd22)))
(snd-display "copy-sampler (region): ~A ~A" rd11 rd22))
- (if (or (mix-sampler? rd11) (mix-sampler? rd22)
- (sampler? rd11) (sampler? rd22))
- (snd-display "copy (region) sampler-p trouble: ~A ~A ~A ~A"
- (mix-sampler? rd11) (mix-sampler? rd22)
- (sampler? rd11) (sampler? rd22)))
+ (if (or (mix-sampler? rd11) (mix-sampler? rd22))
+ (snd-display "copy (region) sampler-p trouble: ~A ~A"
+ (mix-sampler? rd11) (mix-sampler? rd22)))
(if (not (and (equal? (sampler-home rd11) (list reg 0))
(equal? (sampler-home rd22) (list reg 1))))
(snd-display "copy region reader home: ~A ~A" (sampler-home rd11) (sampler-home rd22)))
@@ -23974,8 +23939,6 @@ EDITS: 2
(rd (make-region-sampler reg 0)))
(if (mix-sampler? rd) (snd-display "region sampler: mix ~A" rd))
(if (not (region-sampler? rd)) (snd-display "region sampler: region ~A" rd))
- (if (sampler? rd) (snd-display "region sampler: normal ~A" rd))
- ;(if (not (= (sampler-position rd) 0)) (snd-display "region sampler position: ~A" (sampler-position rd)))
(if (not (equal? (sampler-home rd) (list reg 0))) (snd-display "region sampler home: ~A" (sampler-home rd)))
(if (sampler-at-end? rd) (snd-display "region sampler at end?: ~A" (sampler-at-end? rd)))
(let ((val (rd)))
@@ -24160,8 +24123,8 @@ EDITS: 2
(set! (hook-functions help-hook) ())
(let ((hi (snd-help 'cursor-position)))
(hook-push help-hook (lambda (hook)
- (let ((a (hook (list-ref (hook 'args) 0)))
- (b (hook (list-ref (hook 'args) 1))))
+ (let ((a (hook (list-ref (hook 'hook-args) 0))) ; this is a bad idea! we're depending on the make-hook arg name
+ (b (hook (list-ref (hook 'hook-args) 1))))
(if (not (string=? a "cursor-position"))
(snd-display "help-hook subject: ~A" a))
(if (not (string=? b "(cursor-position :optional snd chn): current cursor position (x y in pixels) in snd's channel chn"))
@@ -24250,7 +24213,7 @@ EDITS: 2
(set! (selection-position fd i) 1000)
(set! (selection-framples fd i) 10)
(set! (selection-member? fd i) #t))
- (scale-selection-to (float-vector .5 .25))
+ (scale-selection-to #r(.5 .25))
(if (or (fneq (maxamp fd 0) .5)
(fneq (maxamp fd 1) .25))
(snd-display "scale-selection-to with vector: ~A" (maxamp fd #t)))
@@ -24427,7 +24390,7 @@ EDITS: 2
(key (char->integer #\z) 4 ind)
(if (not (equal? (edit-fragment) '("smooth-channel 2000 100" "set" 2000 100)))
(snd-display "C-x C-z fragment: ~A" (edit-fragment)))
- (if (not (mus-arrays-equal? (channel->float-vector 2010 10) (float-vector 0.064 0.063 0.063 0.062 0.062 0.061 0.060 0.059 0.059 0.058)))
+ (if (not (mus-arrays-equal? (channel->float-vector 2010 10) #r(0.064 0.063 0.063 0.062 0.062 0.061 0.060 0.059 0.059 0.058)))
(snd-display "C-x C-z samps: ~A" (channel->float-vector 2010 10)))
(set! (cursor) 0)
(select-all)
@@ -25394,7 +25357,7 @@ EDITS: 2
(lambda ()
(hook-push after-open-hook (lambda (hook)
(set! (hook 'result) (make-player (hook 'snd) 0))))
- (do ((open-files ())
+ (do ((open-files () ())
(cur-dir-files (test-remove-if
(lambda (file)
(catch #t
@@ -25946,8 +25909,8 @@ EDITS: 2
(hook-push lisp-graph-hook
(lambda (hook)
(graph (if (> (random 1.0) .5)
- (float-vector 0 1 2)
- (list (float-vector 0 1 2) (float-vector 3 2 0))))))
+ #r(0 1 2)
+ (list #r(0 1 2) #r(3 2 0))))))
(for-each
(lambda (snd)
@@ -26109,8 +26072,7 @@ EDITS: 2
(set! *transform-size* (min *transform-size* 128))))
(set! *sinc-width* 10)
(if (pair? open-files) (for-each close-sound open-files))
- (set! *sync-style* sync-none)
- (set! open-files ()))
+ (set! *sync-style* sync-none))
(set! (mus-rand-seed) 1234)
(if (not (= (mus-rand-seed) 1234)) (snd-display "mus-rand-seed: ~A (1234)!" (mus-rand-seed)))
(let ((val (mus-random 1.0))
@@ -26527,7 +26489,7 @@ EDITS: 2
(len (- (framples ind 0) 1)))
(map-channel (lambda (val)
(sound-interp reader (* len (+ 0.5 (* 0.5 (oscil osc)))))))
- (if (not (mus-arrays-equal? (channel->float-vector) (float-vector 0.0 0.020 0.079 0.172 0.291 0.427 0.569 0.706 0.825 0.919
+ (if (not (mus-arrays-equal? (channel->float-vector) #r(0.0 0.020 0.079 0.172 0.291 0.427 0.569 0.706 0.825 0.919
0.979 1.000 0.981 0.923 0.831 0.712 0.576 0.434 0.298 0.177)))
(snd-display "sound-interp: ~A" (channel->float-vector))))
(undo)
@@ -26540,12 +26502,12 @@ EDITS: 2
(undo)
(env-sound-interp '(0 0 1 1))
- (if (not (mus-arrays-equal? (channel->float-vector) (float-vector 0.0 0.053 0.105 0.158 0.211 0.263 0.316 0.368 0.421 0.474
+ (if (not (mus-arrays-equal? (channel->float-vector) #r(0.0 0.053 0.105 0.158 0.211 0.263 0.316 0.368 0.421 0.474
0.526 0.579 0.632 0.684 0.737 0.789 0.842 0.895 0.947 1.000)))
(snd-display "env-sound-interp no change: ~A" (channel->float-vector)))
(undo)
(env-sound-interp '(0 0 1 .95 2 0) 2.0)
- (if (not (mus-arrays-equal? (channel->float-vector) (float-vector 0.0 0.050 0.100 0.150 0.200 0.250 0.300 0.350 0.400 0.450
+ (if (not (mus-arrays-equal? (channel->float-vector) #r(0.0 0.050 0.100 0.150 0.200 0.250 0.300 0.350 0.400 0.450
0.500 0.550 0.600 0.650 0.700 0.750 0.800 0.850 0.900 0.950
1.000 0.950 0.900 0.850 0.800 0.750 0.700 0.650 0.600 0.550
0.500 0.450 0.400 0.350 0.300 0.250 0.200 0.150 0.100 0.050)))
@@ -26567,7 +26529,7 @@ EDITS: 2
(select-sound ind1)
(sound-via-sound ind1 ind2)
(let ((vals (channel->float-vector 0 20 ind1)))
- (if (not (mus-arrays-equal? vals (float-vector 0.95 0.90 0.85 0.80 0.75 0.70 0.65 0.60 0.55 0.50 0.45 0.40 0.35 0.30 0.25 0.20 0.15 0.10 0.05 0.00)))
+ (if (not (mus-arrays-equal? vals #r(0.95 0.90 0.85 0.80 0.75 0.70 0.65 0.60 0.55 0.50 0.45 0.40 0.35 0.30 0.25 0.20 0.15 0.10 0.05 0.00)))
(snd-display "sound-via-sound: ~A" vals)))
(clean-up-sound ind2)
(revert-sound ind1)
@@ -26626,10 +26588,10 @@ EDITS: 2
(if (fneq (y-zoom-slider id 0) .5) (snd-display "set y-zoom-slider: ~A?" (y-zoom-slider id 0)))
(let ((vals (channel-amp-envs "oboe.snd" 0 10)))
(if (not (and (mus-arrays-equal? (car vals)
- (float-vector -4.8828125e-4 -0.104156494140625 -0.125213623046875 -0.1356201171875 -0.138916015625
+ #r(-4.8828125e-4 -0.104156494140625 -0.125213623046875 -0.1356201171875 -0.138916015625
-0.14093017578125 -0.14093017578125 -0.131439208984375 -0.11248779296875 -0.080047607421875))
(mus-arrays-equal? (cadr vals)
- (float-vector 0.0 0.10955810546875 0.130706787109375 0.14068603515625 0.141204833984375 0.147247314453125
+ #r(0.0 0.10955810546875 0.130706787109375 0.14068603515625 0.141204833984375 0.147247314453125
0.145904541015625 0.140289306640625 0.126861572265625 0.08172607421875))))
(snd-display "channel-amp-envs: ~A?" vals)))
@@ -27022,14 +26984,14 @@ EDITS: 2
(if (fneq (fm-parallel-component 500 100.0 '(100.0 300.0 400.0) '(1.0 0.5 0.25) () () #t) 0.17047)
(snd-display "fm-parallel-component 500: ~A" (fm-parallel-component 500 100.0 '(100.0 300.0 400.0) '(1.0 0.5 0.25) () () #t)))
- (if (fneq (cheby-hka 3 0.25 (float-vector 0 0 0 0 1.0 1.0)) -0.0732421875)
- (snd-display "cheby-hka 0: ~A" (cheby-hka 3 0.25 (float-vector 0 0 0 0 1.0 1.0))))
- (if (fneq (cheby-hka 2 0.25 (float-vector 0 0 0 0 1.0 1.0)) -0.234375)
- (snd-display "cheby-hka 1: ~A" (cheby-hka 2 0.25 (float-vector 0 0 0 0 1.0 1.0))))
- (if (fneq (cheby-hka 1 0.25 (float-vector 0 0 0 0 1.0 1.0)) 1.025390625)
- (snd-display "cheby-hka 2: ~A" (cheby-hka 1 0.25 (float-vector 0 0 0 0 1.0 1.0))))
- (if (fneq (cheby-hka 0 0.25 (float-vector 0 0 0 0 1.0 1.0)) 1.5234375)
- (snd-display "cheby-hka 3: ~A" (cheby-hka 0 0.25 (float-vector 0 0 0 0 1.0 1.0))))
+ (if (fneq (cheby-hka 3 0.25 #r(0 0 0 0 1.0 1.0)) -0.0732421875)
+ (snd-display "cheby-hka 0: ~A" (cheby-hka 3 0.25 #r(0 0 0 0 1.0 1.0))))
+ (if (fneq (cheby-hka 2 0.25 #r(0 0 0 0 1.0 1.0)) -0.234375)
+ (snd-display "cheby-hka 1: ~A" (cheby-hka 2 0.25 #r(0 0 0 0 1.0 1.0))))
+ (if (fneq (cheby-hka 1 0.25 #r(0 0 0 0 1.0 1.0)) 1.025390625)
+ (snd-display "cheby-hka 2: ~A" (cheby-hka 1 0.25 #r(0 0 0 0 1.0 1.0))))
+ (if (fneq (cheby-hka 0 0.25 #r(0 0 0 0 1.0 1.0)) 1.5234375)
+ (snd-display "cheby-hka 3: ~A" (cheby-hka 0 0.25 #r(0 0 0 0 1.0 1.0))))
(map-channel (lambda (y) (* .5 (oscil osc))))
(let ((vals (freq-peak 0 ind 8192)))
@@ -27608,12 +27570,12 @@ EDITS: 2
(scale-selection-to 0.5)
(insert-selection 15 ind)
(if (not (= (framples ind) 25)) (snd-display "insert-selection 5: ~A" (framples ind)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 25) (float-vector 1.0 1.0 1.0 1.0 1.0 0.5 0.5 0.5 0.5 0.5
+ (if (not (mus-arrays-equal? (channel->float-vector 0 25) #r(1.0 1.0 1.0 1.0 1.0 0.5 0.5 0.5 0.5 0.5
1.0 1.0 1.0 1.0 1.0 0.5 0.5 0.5 0.5 0.5
1.0 1.0 1.0 1.0 1.0)))
(snd-display "insert-selection: ~A" (channel->float-vector 0 25)))
(mix-selection 1 ind 0) ; this is being confused by clipping settings
- (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 0) (float-vector 1.000 1.500 1.500 1.500 1.500 1.000 0.500 0.500 0.500 0.500)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 0) #r(1.000 1.500 1.500 1.500 1.500 1.000 0.500 0.500 0.500 0.500)))
(snd-display "mix-selection vals: ~A" (channel->float-vector 0 10 ind 0)))
(close-sound ind))
@@ -27656,7 +27618,7 @@ EDITS: 2
(close-sound ind)))
(let ((ind (open-sound "storm.snd"))
- (maxes (float-vector 0.8387 0.5169 0.3318 0.2564 0.1982 0.1532)))
+ (maxes #r(0.8387 0.5169 0.3318 0.2564 0.1982 0.1532)))
(do ((i 0 (+ i 1)))
((= i 5))
(if (fneq (maxamp) (maxes i)) (snd-display "enving storm ~D: ~A ~A" i (maxes i) (maxamp)))
@@ -27698,7 +27660,7 @@ EDITS: 2
;; channels as generic: mus-sound-chans region-chans chans mus-channels mix/etc
(let ((snd (open-sound "oboe.snd"))
- (v (float-vector .1 .2 .3))
+ (v #r(.1 .2 .3))
(sd (channels (make-float-vector '(2 10)))))
(let ((mxv (channels (mix-float-vector v 1000)))
(reg (channels (make-region 0 100)))
@@ -27716,7 +27678,7 @@ EDITS: 2
;; framples as generic
(let ((snd (open-sound "oboe.snd"))
- (v (float-vector .1 .2 .3))
+ (v #r(.1 .2 .3))
(sd (framples (make-float-vector '(1 10)))))
(let ((mxv (framples (mix-float-vector v 1000)))
(reg (framples (make-region 0 100)))
@@ -27755,7 +27717,7 @@ EDITS: 2
(let ((snd (open-sound "oboe.snd")))
(let ((mrk (add-mark 123))
- (mx (mix-float-vector (float-vector .1 .2 .3))))
+ (mx (mix-float-vector #r(.1 .2 .3))))
(if (not (= (sync snd) 0)) (snd-display "sync of sound (0): ~A" (sync snd)))
(if (not (= (sync mrk) 0)) (snd-display "sync of mark (0): ~A" (sync mrk)))
(if (not (= (sync mx) 0)) (snd-display "sync of mx (0): ~A" (sync mx)))
@@ -27772,14 +27734,14 @@ EDITS: 2
;; maxamp as generic
(let ((snd (open-sound "oboe.snd"))
- (v (float-vector .1 .2 .3)))
+ (v #r(.1 .2 .3)))
(let ((mxv (maxamp (mix-float-vector v 1000)))
(reg (maxamp (make-region 0 900))))
(if (fneq (maxamp snd) .334) (snd-display "maxamp of sound: ~A" (maxamp snd)))
(if (fneq (maxamp snd 0) .334) (snd-display "maxamp of sound (0): ~A" (maxamp snd)))
(if (fneq (maxamp snd 0 0) .14724) (snd-display "maxamp of sound (0 0): ~A" (maxamp snd)))
(if (fneq (maxamp v) .3) (snd-display "maxamp of float-vector: ~A" (maxamp v)))
- (let ((vc (maxamp #(.1 .2 .3 .4))))
+ (let ((vc (maxamp #r(.1 .2 .3 .4))))
(if (fneq vc .4) (snd-display "maxamp of vector: ~A" vc)))
(let ((str (maxamp "pistol.snd"))) ; can't use oboe.snd since we messed with mus-sound-maxamp above
(if (fneq str .49267) (snd-display "maxamp of string: ~A" str)))
@@ -28016,7 +27978,7 @@ EDITS: 2
(set! cur-edit (edit-position cursnd curchn))
(set! cur-frame (framples cursnd curchn)))
(let ((e (do ((e1 ())
- (x 0.0)
+ (x 0.0 (+ x .01 (random 1.0)))
(y 0.0)
(i 0 (+ i 1)))
((= i pts)
@@ -28024,8 +27986,7 @@ EDITS: 2
(set! e1 (cons x e1))
(if (> (random 3) 0)
(set! y (mus-random 1.0)))
- (set! e1 (cons y e1))
- (set! x (+ x .01 (random 1.0))))))
+ (set! e1 (cons y e1)))))
(env-channel e 0 (framples cursnd curchn) cursnd curchn))) ; can be a no-op
(if (not (or (= (edit-position cursnd curchn) (+ 1 cur-edit))
(= (edit-position cursnd curchn) cur-edit)))
@@ -28052,7 +28013,7 @@ EDITS: 2
((3) (let* ((pts (+ 1 (random 6)))
(recalc #f)
(e (do ((e1 ())
- (x 0.0)
+ (x 0.0 (+ x .01 (random 1.0)))
(y 0.0)
(i 0 (+ i 1)))
((= i pts)
@@ -28060,8 +28021,7 @@ EDITS: 2
(set! e1 (cons x e1))
(if (> (random 3) 0)
(set! y (mus-random 1.0)))
- (set! e1 (cons y e1))
- (set! x (+ x .01 (random 1.0)))))
+ (set! e1 (cons y e1))))
(end (apply min cur-framples)) ; env-sound can lengthen a shorter sound if syncd+multichannel
(beg (random (floor (/ end 2)))))
(for-each
@@ -28404,7 +28364,7 @@ EDITS: 2
(let ((sr (make-convolve :input (let ((rd (make-sampler 0)))
(lambda (dir)
(read-sample rd)))
- :filter (float-vector 1.0 0.0 0.0 0.0))))
+ :filter #r(1.0 0.0 0.0 0.0))))
(clm-channel sr 0 12345 oboe 0)
(if (not (= (edit-position oboe) 13))
(snd-display "oboe clm-channel convolve? ~A ~A" (edit-position oboe) (edit-fragment))))
@@ -28470,7 +28430,7 @@ EDITS: 2
(snd-display "mix-channel returned a mix: ~A?" val)))
(if (not (mus-arrays-equal? (channel->float-vector 0 #f ind 1) (make-float-vector 10)))
(snd-display "mix-channel mixed channel 1: ~A?" (channel->float-vector 0 #f ind 1)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 #f ind 0) (float-vector 0 0 0 .5 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 #f ind 0) #r(0 0 0 .5 0 0 0 0 0 0)))
(snd-display "mix-channel chan 0: ~A" (channel->float-vector 0 #f ind 0)))
(revert-sound ind)
(let ((val (mix-channel (list "fmv.snd" 2 1) 0 #f ind 0)))
@@ -28478,16 +28438,16 @@ EDITS: 2
(snd-display "mix-channel 2 returned a mix: ~A?" val)))
(if (not (mus-arrays-equal? (channel->float-vector 0 #f ind 1) (make-float-vector 10)))
(snd-display "mix-channel mixed channel 1a: ~A?" (channel->float-vector 0 #f ind 1)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 #f ind 0) (float-vector -.4 0 0 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 #f ind 0) #r(-.4 0 0 0 0 0 0 0 0 0)))
(snd-display "mix-channel chan 0a: ~A" (channel->float-vector 0 #f ind 0)))
(revert-sound ind)
(set! (sample 2 ind 1) -.4)
(let ((val (mix-channel (list ind 2 1) 0 #f ind 0 -1 #t)))
(if (not (mix? val))
(snd-display "mix-channel with-tag: ~A" val)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 #f ind 1) (float-vector 0 0 -.4 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 #f ind 1) #r(0 0 -.4 0 0 0 0 0 0 0)))
(snd-display "mix-channel mixed channel 1b: ~A?" (channel->float-vector 0 #f ind 1)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 #f ind 0) (float-vector -.4 0 0 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 #f ind 0) #r(-.4 0 0 0 0 0 0 0 0 0)))
(snd-display "mix-channel chan 0b: ~A" (channel->float-vector 0 #f ind 0)))
(revert-sound ind)
(let ((val (car (mix-channel (list "fmv.snd" 2 1) 0 #f ind 0 -1 #t))))
@@ -28495,7 +28455,7 @@ EDITS: 2
(snd-display "mix-channel file with-tag: ~A" val)))
(if (not (mus-arrays-equal? (channel->float-vector 0 #f ind 1) (make-float-vector 10)))
(snd-display "mix-channel mixed channel 1c: ~A?" (channel->float-vector 0 #f ind 1)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 #f ind 0) (float-vector -.4 0 0 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 #f ind 0) #r(-.4 0 0 0 0 0 0 0 0 0)))
(snd-display "mix-channel chan 0c: ~A" (channel->float-vector 0 #f ind 0)))
(revert-sound ind)
(let ((val (car (mix-channel (list "fmv.snd") 0 #f ind 1 -1 #t))))
@@ -28503,7 +28463,7 @@ EDITS: 2
(snd-display "mix-channel file 1 with-tag: ~A" val)))
(if (not (mus-arrays-equal? (channel->float-vector 0 #f ind 0) (make-float-vector 10)))
(snd-display "mix-channel mixed channel 0d: ~A?" (channel->float-vector 0 #f ind 1)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 #f ind 1) (float-vector 0 0 0 .5 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 #f ind 1) #r(0 0 0 .5 0 0 0 0 0 0)))
(snd-display "mix-channel chan 1d: ~A" (channel->float-vector 0 #f ind 1)))
(revert-sound ind)
(if (file-exists? "fmv.snd") (delete-file "fmv.snd"))
@@ -28517,41 +28477,41 @@ EDITS: 2
(env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 20))
(let ((v1 (channel->float-vector)))
- (if (not (mus-arrays-equal? v1 (float-vector 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1)))
+ (if (not (mus-arrays-equal? v1 #r(0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1)))
(snd-display "env-channel step 1: ~A" v1)))
(undo)
(env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 20) 8)
(let ((v1 (channel->float-vector)))
- (if (not (mus-arrays-equal? v1 (float-vector 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1)))
+ (if (not (mus-arrays-equal? v1 #r(1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1)))
(snd-display "env-channel step 1 at 8: ~A" v1)))
(undo)
(env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 12))
(let ((v1 (channel->float-vector)))
- (if (not (mus-arrays-equal? v1 (float-vector 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1)))
+ (if (not (mus-arrays-equal? v1 #r(0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1)))
(snd-display "env-channel step 1 at 0: ~A" v1)))
(undo)
(env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 12) 4)
(let ((v1 (channel->float-vector)))
- (if (not (mus-arrays-equal? v1 (float-vector 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1)))
+ (if (not (mus-arrays-equal? v1 #r(1 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1)))
(snd-display "env-channel step 1 at 4: ~A" v1)))
(undo)
(env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 12) 4 3)
(let ((v1 (channel->float-vector)))
- (if (not (mus-arrays-equal? v1 (float-vector 1 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1)))
+ (if (not (mus-arrays-equal? v1 #r(1 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1)))
(snd-display "env-channel step 1 at 4 by 3: ~A" v1)))
(undo)
(env-channel (make-env '(0 1 1 0 2 0) :base 0 :length 8) 0 12)
(let ((v1 (channel->float-vector)))
- (if (not (mus-arrays-equal? v1 (float-vector 1 1 1 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)))
+ (if (not (mus-arrays-equal? v1 #r(1 1 1 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)))
(snd-display "env-channel step 1 at 0 for 7: ~A" v1)))
(undo)
(env-channel (make-env '(0 0 1 1 2 1 3 0 4 0) :base 0 :length 20))
(let ((v1 (channel->float-vector)))
- (if (not (mus-arrays-equal? v1 (float-vector 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? v1 #r(0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0)))
(snd-display "env-channel step 1: ~A" v1)))
(env-channel (make-env '(0 0 1 .5 2 .25 3 0 4 0) :base 0 :length 21))
(let ((v1 (channel->float-vector)))
- (if (not (mus-arrays-equal? v1 (float-vector 0 0 0 0 0 0 .5 .5 .5 .5 .5 .25 .25 .25 .25 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? v1 #r(0 0 0 0 0 0 .5 .5 .5 .5 .5 .25 .25 .25 .25 0 0 0 0 0)))
(snd-display "env-channel step 1 (.5): ~A" v1)))
(close-sound ind))
@@ -28705,10 +28665,10 @@ EDITS: 2
(list
(lambda (posfunc)
(let ((chn (min (random (+ 1 out-chans)) (- out-chans 1))))
- (if (not (mus-arrays-equal? (channel->float-vector 0 (framples ind chn) ind chn 0) (float-vector 0.0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 (framples ind chn) ind chn 0) #r(0.0)))
(snd-display "start bad: ~A" (channel->float-vector 0 (framples ind chn) ind chn 0)))
(set! (sample 0 ind chn) .1)
- (if (not (mus-arrays-equal? (channel->float-vector 0 (framples ind chn) ind chn) (float-vector 0.1)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 (framples ind chn) ind chn) #r(0.1)))
(snd-display "set bad: ~A" (channel->float-vector 0 (framples ind chn) ind chn)))
(pad-channel 0 1 ind chn (posfunc))
(let ((pos (posfunc)))
@@ -28716,12 +28676,12 @@ EDITS: 2
(set! pos (pos ind chn)))
(let ((data (channel->float-vector 0 (framples ind chn) ind chn)))
(if (or (and (= pos 0)
- (not (mus-arrays-equal? data (float-vector 0.0 0.0))))
+ (not (mus-arrays-equal? data #r(0.0 0.0))))
(and (or (= pos current-edit-position)
(= pos (edit-position ind chn)))
- (not (mus-arrays-equal? data (float-vector 0.0 0.1))))
+ (not (mus-arrays-equal? data #r(0.0 0.1))))
(and (= pos (- (edit-position ind chn) 1))
- (not (mus-arrays-equal? data (float-vector 0.0 0.0)))))
+ (not (mus-arrays-equal? data #r(0.0 0.0)))))
(snd-display "pos[~A]: edpos ~A of ~A, pad result[~A, ~A]: ~A"
chn pos (edit-position ind chn) (framples ind chn pos) (framples ind chn) data))
(if (> (chans ind) 1)
@@ -28729,7 +28689,7 @@ EDITS: 2
((= i (chans ind)))
(if (not (= i chn))
(let ((data (channel->float-vector 0 (framples ind i) ind i)))
- (if (not (mus-arrays-equal? data (float-vector 0.0)))
+ (if (not (mus-arrays-equal? data #r(0.0)))
(snd-display "pad[~A / ~A] empty: ~A" i chn data))))))))))
(lambda (posfunc)
(let ((chn (min (random (+ 1 out-chans)) (- out-chans 1))))
@@ -28739,12 +28699,12 @@ EDITS: 2
(if (procedure? pos) (set! pos (pos ind chn)))
(let ((data (channel->float-vector 0 (framples ind chn) ind chn)))
(if (or (and (= pos 0)
- (not (mus-arrays-equal? data (float-vector 0.0))))
+ (not (mus-arrays-equal? data #r(0.0))))
(and (or (= pos current-edit-position)
(= pos (edit-position ind chn)))
- (not (mus-arrays-equal? data (float-vector 0.2))))
+ (not (mus-arrays-equal? data #r(0.2))))
(and (= pos (- (edit-position ind chn) 1))
- (not (mus-arrays-equal? data (float-vector 0.0)))))
+ (not (mus-arrays-equal? data #r(0.0)))))
(snd-display "pos[~A]: edpos ~A of ~A, set *2 result[~A, ~A]: ~A"
chn pos (edit-position ind chn) (framples ind chn pos) (framples ind chn) data))
(if (> (chans ind) 1)
@@ -28752,7 +28712,7 @@ EDITS: 2
((= i (chans ind)))
(if (not (= i chn))
(let ((data (channel->float-vector 0 (framples ind i) ind i)))
- (if (not (mus-arrays-equal? data (float-vector 0.0)))
+ (if (not (mus-arrays-equal? data #r(0.0)))
(snd-display "scale[~A / ~A] empty: ~A" i chn data)))))))))))))
'("2a.snd" "1a.snd" "4a.snd"))
(close-sound ind)))
@@ -29267,13 +29227,13 @@ EDITS: 2
(begin
(float-vector->channel v1 3 3)
(let ((vals (channel->float-vector 0 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 .2 .4 1 1 1 .75 .5 .25 0)))
+ (if (not (mus-arrays-equal? vals #r(0.0 .2 .4 1 1 1 .75 .5 .25 0)))
(snd-display " 4 vals (~A): ~A" dur vals))))
(begin
(fill! v1 0.0)
(float-vector->channel v1 4998 3)
(let ((vals (channel->float-vector 4995 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.999 0.999 1.000 0.0 0.0 0.0 1.000 0.999 0.999 0.999)))
+ (if (not (mus-arrays-equal? vals #r(0.999 0.999 1.000 0.0 0.0 0.0 1.000 0.999 0.999 0.999)))
(snd-display " 4 vals big: ~A" vals))))))
(undo 2)
(when (= dur 10)
@@ -29282,21 +29242,21 @@ EDITS: 2
(delete-samples 3 3)
(insert-samples 3 3 v1)
(let ((vals (channel->float-vector 0 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 .2 .4 1 1 1 .75 .5 .25 0)))
+ (if (not (mus-arrays-equal? vals #r(0.0 .2 .4 1 1 1 .75 .5 .25 0)))
(snd-display " 2 vals: ~A" vals))))
(undo 3)
(env-sound '(0 0 1 1 2 0))
(let ((v1 (make-float-vector 3 1.0)))
(float-vector->channel v1 0 3)
(let ((vals (channel->float-vector 0 10)))
- (if (not (mus-arrays-equal? vals (float-vector 1.000 1.000 1.000 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (if (not (mus-arrays-equal? vals #r(1.000 1.000 1.000 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
(snd-display " 4 vals: ~A" vals))))
(undo 2)
(env-sound '(0 0 1 1 2 0))
(let ((v1 (make-float-vector 3 1.0)))
(float-vector->channel v1 7 3)
(let ((vals (channel->float-vector 0 10)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.200 0.400 0.600 0.800 1.000 0.750 1.000 1.000 1.000)))
+ (if (not (mus-arrays-equal? vals #r(0.0 0.200 0.400 0.600 0.800 1.000 0.750 1.000 1.000 1.000)))
(snd-display " 5 vals: ~A" vals))))
(undo 2))
(clean-up-sound i1)))
@@ -29643,12 +29603,12 @@ EDITS: 2
(let ((away (string-append home-dir "/test/sound/away.snd")))
(list "1a.snd" "oboe.snd" "storm.snd" (if (file-exists? away) away "lola.snd"))))))
- (snd-display " scl rev env map scn pad wrt clm mix src del")
- (snd-display "1a: ~{~A ~}" (map (lambda (a) (if (< a .005) (copy " 0.0") (format #f "~6,2F" a))) (car data)))
- (snd-display "oboe: ~{~A ~}" (map (lambda (a) (if (< a .005) (copy " 0.0") (format #f "~6,2F" a))) (cdar data)))
- (snd-display "storm:~{~A ~}" (map (lambda (a) (if (< a .005) (copy " 0.0") (format #f "~6,2F" a))) (caddr data)))
+ (snd-display " scl rev env map scn pad wrt clm mix src del")
+ (snd-display "1a: ~{~A ~}" (map (lambda (a) (if (< a .005) (copy " 0.0") (format #f "~5,2F" a))) (car data)))
+ (snd-display "oboe: ~{~A ~}" (map (lambda (a) (if (< a .005) (copy " 0.0") (format #f "~5,2F" a))) (cdar data)))
+ (snd-display "storm:~{~A ~}" (map (lambda (a) (if (< a .005) (copy " 0.0") (format #f "~5,2F" a))) (caddr data)))
(if (pair? (cadddr data))
- (snd-display "away: ~{~A ~}" (map (lambda (a) (if (< a .005) (copy " 0.0") (format #f "~6,2F" a))) (cadddr data)))))
+ (snd-display "away: ~{~A ~}" (map (lambda (a) (if (< a .005) (copy " 0.0") (format #f "~5,2F" a))) (cadddr data)))))
(when with-big-file
(when all-args
@@ -29748,12 +29708,12 @@ EDITS: 2
(do ((i 0 (+ i 1)))
((= i 10))
(set! (v i) (read-sample r)))
- (if (not (mus-arrays-equal? v (float-vector -0.021 -0.020 -0.020 -0.019 -0.018 -0.017 -0.016 -0.016 -0.015 -0.014)))
+ (if (not (mus-arrays-equal? v #r(-0.021 -0.020 -0.020 -0.019 -0.018 -0.017 -0.016 -0.016 -0.015 -0.014)))
(snd-display "bigger short env vals: ~A" v)))
(revert-sound)
(let ((v (channel->float-vector (+ 75 (* (floor *clm-srate*) 50000)) 10)))
- (if (not (mus-arrays-equal? v (float-vector -0.042 -0.043 -0.044 -0.045 -0.045 -0.045 -0.045 -0.045 -0.045 -0.046)))
+ (if (not (mus-arrays-equal? v #r(-0.042 -0.043 -0.044 -0.045 -0.045 -0.045 -0.045 -0.045 -0.045 -0.046)))
(snd-display "bigger no env vals: ~A" v)))
(scale-to 1.0)
(if (fneq (maxamp) 1.0) (snd-display "bigger scale-to 1.0 maxamp: ~A" (maxamp)))
@@ -29823,7 +29783,7 @@ EDITS: 2
(let* ((flt (make-one-zero 0.5 0.5))
(lvals (channel->float-vector (+ 1000 (* (floor *clm-srate*) 65000)) 10 ind 0 0)))
- (if (not (mus-arrays-equal? lvals (float-vector -0.006 0.052 0.103 0.146 0.182 0.210 0.232 0.249 0.262 0.272)))
+ (if (not (mus-arrays-equal? lvals #r(-0.006 0.052 0.103 0.146 0.182 0.210 0.232 0.249 0.262 0.272)))
(snd-display "bigger (orig) vals: ~A" lvals))
(clm-channel flt (+ (* (floor *clm-srate*) 65000) 1000) 10)
(if (not (fieql (edit-tree) (list (list 0 0 0 2204999999 1.0 0.0 0.0 0)
@@ -29835,7 +29795,7 @@ EDITS: 2
(list (+ big-file-framples 100) -2 0 0 0.0 0.0 0.0 0))))
(snd-display "bigger clm: ~A" (edit-tree)))
(if (not (mus-arrays-equal? (channel->float-vector (+ 1000 (* (floor *clm-srate*) 65000)) 10)
- (float-vector -0.006 0.015 0.065 0.107 0.142 0.169 0.190 0.205 0.216 0.222)))
+ #r(-0.006 0.015 0.065 0.107 0.142 0.169 0.190 0.205 0.216 0.222)))
(snd-display "bigger clm vals: ~A" (channel->float-vector (+ 1000 (* (floor *clm-srate*) 65000)) 10)))
(let ((r (make-readin big-file-name :start (+ 1000 (* (floor *clm-srate*) 65000))))
@@ -29863,7 +29823,7 @@ EDITS: 2
(if (fneq mx 0.5) (snd-display "src-channel max .5: ~A" mx)))
(if (fneq (sample 200) 0.5) (snd-display "src-channel 0.5 200: ~A" (sample 200)))
(if (not (mus-arrays-equal? (channel->float-vector 180 40 ind 0)
- (float-vector 0.0 0.0 0.0 0.001 0.0 -0.003 0.0 0.007 0.0 -0.012
+ #r(0.0 0.0 0.0 0.001 0.0 -0.003 0.0 0.007 0.0 -0.012
0.0 0.020 0.0 -0.033 0.0 0.054 0.0 -0.100 0.0 0.316
0.500 0.316 0.0 -0.100 0.0 0.054 0.0 -0.033 0.0 0.020
0.0 -0.012 0.0 0.007 0.0 -0.003 0.0 0.001 0.0 -0.000)))
@@ -29874,7 +29834,7 @@ EDITS: 2
(if (fneq mx 0.5) (snd-display "src-channel max .25: ~A" mx)))
(if (fneq (sample 400) 0.5) (snd-display "src-channel 0.25 400: ~A" (sample 400)))
(if (not (mus-arrays-equal? (channel->float-vector 360 80 ind 0)
- (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.001 0.001 0.0 -0.002
+ #r(0.0 0.0 0.0 0.0 0.0 0.0 0.001 0.001 0.0 -0.002
-0.003 -0.003 0.0 0.004 0.007 0.006 0.0 -0.008 -0.012 -0.010
0.0 0.013 0.020 0.016 0.0 -0.021 -0.033 -0.026 0.0 0.034
0.054 0.044 0.0 -0.060 -0.100 -0.087 0.0 0.148 0.316 0.449
@@ -29964,7 +29924,7 @@ EDITS: 2
(let ((hi (make-float-vector 3)))
(fill-float-vector hi (if (scan-channel (lambda (y) (> y .1)))
1.0 0.0))
- (if (not (mus-arrays-equal? hi (float-vector 1.0 1.0 1.0))) (snd-display "fill-float-vector with scan-channel (opt ~A): ~A" n hi)))
+ (if (not (mus-arrays-equal? hi #r(1.0 1.0 1.0))) (snd-display "fill-float-vector with scan-channel (opt ~A): ~A" n hi)))
(let ((val (scan-channel (lambda (y) (scan-channel (lambda (n6) (> n6 .1)))))))
(if (not (= val 0)) (snd-display "find with find: ~A" val)))
(let ((val (scan-channel (lambda (y) (scan-channel (lambda (n7) (> n7 .1)))))))
@@ -30342,33 +30302,33 @@ EDITS: 1
;; -------- ramp+ramp
(ramp-channel 0.0 1.0)
- (check-back-and-forth ind "ramp 1" (float-vector 0.0 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000))
+ (check-back-and-forth ind "ramp 1" #r(0.0 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000))
(ramp-channel 0.0 1.0)
- (check-back-and-forth ind "ramp 2" (float-vector 0.0 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000))
+ (check-back-and-forth ind "ramp 2" #r(0.0 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000))
(undo)
(ramp-channel 1.0 0.0)
- (check-back-and-forth ind "ramp 3" (float-vector 0.0 0.090 0.160 0.210 0.240 0.250 0.240 0.210 0.160 0.090 0.000))
+ (check-back-and-forth ind "ramp 3" #r(0.0 0.090 0.160 0.210 0.240 0.250 0.240 0.210 0.160 0.090 0.000))
(undo)
(env-channel '(0 0 1 1 2 0))
- (check-back-and-forth ind "ramp 4" (float-vector 0.0 0.020 0.080 0.180 0.320 0.500 0.480 0.420 0.320 0.180 0.000))
+ (check-back-and-forth ind "ramp 4" #r(0.0 0.020 0.080 0.180 0.320 0.500 0.480 0.420 0.320 0.180 0.000))
(undo 2)
(env-channel '(0 0 1 1 2 0))
- (check-back-and-forth ind "ramp 5" (float-vector 0.0 0.200 0.400 0.600 0.800 1.000 0.800 0.600 0.400 0.200 0.000))
+ (check-back-and-forth ind "ramp 5" #r(0.0 0.200 0.400 0.600 0.800 1.000 0.800 0.600 0.400 0.200 0.000))
(ramp-channel 0.0 1.0)
- (check-back-and-forth ind "ramp 6" (float-vector 0.0 0.020 0.080 0.180 0.320 0.500 0.480 0.420 0.320 0.180 0.000))
+ (check-back-and-forth ind "ramp 6" #r(0.0 0.020 0.080 0.180 0.320 0.500 0.480 0.420 0.320 0.180 0.000))
(scale-channel 0.5)
- (check-back-and-forth ind "ramp 7" (float-vector 0.0 0.010 0.040 0.090 0.160 0.250 0.240 0.210 0.160 0.090 0.000))
+ (check-back-and-forth ind "ramp 7" #r(0.0 0.010 0.040 0.090 0.160 0.250 0.240 0.210 0.160 0.090 0.000))
(undo 3)
(scale-channel 0.5)
(env-channel '(0 0 1 1 2 0))
- (check-back-and-forth ind "ramp 8" (float-vector 0.0 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000))
+ (check-back-and-forth ind "ramp 8" #r(0.0 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000))
(ramp-channel 0.0 1.0)
- (check-back-and-forth ind "ramp 9" (float-vector 0.0 0.010 0.040 0.090 0.160 0.250 0.240 0.210 0.160 0.090 0.000))
+ (check-back-and-forth ind "ramp 9" #r(0.0 0.010 0.040 0.090 0.160 0.250 0.240 0.210 0.160 0.090 0.000))
(undo 3)
(ramp-channel 0.0 1.0)
(ramp-channel 0.0 1.0)
(ramp-channel 0.0 1.0)
- (check-back-and-forth ind "ramp 10" (float-vector 0.0 0.001 0.008 0.027 0.064 0.125 0.216 0.343 0.512 0.729 1.000))
+ (check-back-and-forth ind "ramp 10" #r(0.0 0.001 0.008 0.027 0.064 0.125 0.216 0.343 0.512 0.729 1.000))
(undo 3)
@@ -30379,98 +30339,103 @@ EDITS: 1
(lambda (func)
(ramp-channel 0.0 1.0 0 5)
(let ((edpos (edit-position ind 0)))
- (check-back-and-forth ind "ramp+scl setup" (float-vector 0.0 0.250 0.500 0.750 1.000 1.000 1.000 1.000 1.000 1.000 1.000))
+ (check-back-and-forth ind "ramp+scl setup" #r(0.0 0.250 0.500 0.750 1.000 1.000 1.000 1.000 1.000 1.000 1.000))
(do ((happy #t)
(start 0 (+ 1 start)))
((or (not happy)
(= start 10)))
- (do ((len 1 (+ 1 len)))
+ (do ((len 1 (+ 1 len))
+ (v #f))
((or (not happy)
(= (+ start len) 11)))
- (let ((v (float-vector 0.0 0.250 0.500 0.750 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
- (func 0.5 start len)
- (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1 [~A ~A] with ~A" start len func) v))
- (set! (edit-position ind 0) edpos)))))
+ (set! v (float-vector 0.0 0.250 0.500 0.750 1.000 1.000 1.000 1.000 1.000 1.000 1.000))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
+ (func 0.5 start len)
+ (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1 [~A ~A] with ~A" start len func) v))
+ (set! (edit-position ind 0) edpos))))
(set! (edit-position ind 0) start-pos)
(ramp-channel 1.0 0.0 5 5)
(let ((edpos (edit-position ind 0)))
- (check-back-and-forth ind "ramp+scl 2 setup" (float-vector 1.000 1.000 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.0 1.000))
+ (check-back-and-forth ind "ramp+scl 2 setup" #r(1.000 1.000 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.0 1.000))
(do ((happy #t)
(start 0 (+ 1 start)))
((or (not happy)
(= start 10)))
- (do ((len 1 (+ 1 len)))
+ (do ((len 1 (+ 1 len))
+ (v #f))
((or (not happy)
(= (+ start len) 11)))
- (let ((v (float-vector 1.000 1.000 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.0 1.000)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
- (func 0.5 start len)
- (set! happy (check-back-and-forth ind (format #f "ramp+scl 1-0 [~A ~A] with ~A" start len func) v))
- (set! (edit-position ind 0) edpos)))))
+ (set! v (float-vector 1.000 1.000 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.0 1.000))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
+ (func 0.5 start len)
+ (set! happy (check-back-and-forth ind (format #f "ramp+scl 1-0 [~A ~A] with ~A" start len func) v))
+ (set! (edit-position ind 0) edpos))))
(set! (edit-position ind 0) start-pos)
(ramp-channel 0.0 1.0 0 5)
(ramp-channel 1.0 0.0 5 5)
(let ((edpos (edit-position ind 0)))
- (check-back-and-forth ind "ramp+scl 3 setup" (float-vector 0.0 0.250 0.500 0.750 1.000 1.000 0.750 0.500 0.250 0.0 1.000))
+ (check-back-and-forth ind "ramp+scl 3 setup" #r(0.0 0.250 0.500 0.750 1.000 1.000 0.750 0.500 0.250 0.0 1.000))
(do ((happy #t)
(start 0 (+ 1 start)))
((or (not happy)
(= start 10)))
- (do ((len 1 (+ 1 len)))
+ (do ((len 1 (+ 1 len))
+ (v #f))
((or (not happy)
(= (+ start len) 11)))
- (let ((v (float-vector 0.0 0.250 0.500 0.750 1.000 1.000 0.750 0.500 0.250 0.0 1.000)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
- (func 0.5 start len)
- (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1-1-0 [~A ~A] with ~A" start len func) v))
- (set! (edit-position ind 0) edpos)))))
+ (set! v (float-vector 0.0 0.250 0.500 0.750 1.000 1.000 0.750 0.500 0.250 0.0 1.000))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
+ (func 0.5 start len)
+ (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1-1-0 [~A ~A] with ~A" start len func) v))
+ (set! (edit-position ind 0) edpos))))
(set! (edit-position ind 0) start-pos)
(ramp-channel 1.0 0.0 3 5)
(let ((edpos (edit-position ind 0)))
- (check-back-and-forth ind "ramp+scl 4 setup" (float-vector 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.0 1.000 1.000 1.000))
+ (check-back-and-forth ind "ramp+scl 4 setup" #r(1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.0 1.000 1.000 1.000))
(do ((happy #t)
(start 0 (+ 1 start)))
((or (not happy)
(= start 10)))
- (do ((len 1 (+ 1 len)))
+ (do ((len 1 (+ 1 len))
+ (v #f))
((or (not happy)
(= (+ start len) 11)))
- (let ((v (float-vector 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.0 1.000 1.000 1.000)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
- (func 0.5 start len)
- (set! happy (check-back-and-forth ind (format #f "ramp+scl mid 1-0 [~A ~A] with ~A" start len func) v))
- (set! (edit-position ind 0) edpos)))))
+ (set! v (float-vector 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.0 1.000 1.000 1.000))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
+ (func 0.5 start len)
+ (set! happy (check-back-and-forth ind (format #f "ramp+scl mid 1-0 [~A ~A] with ~A" start len func) v))
+ (set! (edit-position ind 0) edpos))))
(set! (edit-position ind 0) start-pos)
(env-channel '(0 1 1 0 2 0 3 1))
(let ((edpos (edit-position ind 0)))
- (check-back-and-forth ind "ramp+scl setup" (float-vector 1.000 0.667 0.333 0.0 0.0 0.0 0.0 0.0 0.333 0.667 1.000))
+ (check-back-and-forth ind "ramp+scl setup" #r(1.000 0.667 0.333 0.0 0.0 0.0 0.0 0.0 0.333 0.667 1.000))
(do ((happy #t)
(start 0 (+ 1 start)))
((or (not happy)
(= start 10)))
- (do ((len 1 (+ 1 len)))
+ (do ((len 1 (+ 1 len))
+ (v #f))
((or (not happy)
(= (+ start len) 11)))
- (let ((v (float-vector 1.000 0.667 0.333 0.0 0.0 0.0 0.0 0.0 0.333 0.667 1.000)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
- (func 0.5 start len)
- (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1-0-1 [~A ~A] with ~A" start len func) v))
- (set! (edit-position ind 0) edpos)))))
+ (set! v (float-vector 1.000 0.667 0.333 0.0 0.0 0.0 0.0 0.0 0.333 0.667 1.000))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
+ (func 0.5 start len)
+ (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1-0-1 [~A ~A] with ~A" start len func) v))
+ (set! (edit-position ind 0) edpos))))
(set! (edit-position ind 0) start-pos))
(list
@@ -30571,11 +30536,11 @@ EDITS: 1
(src-sound 2.01)
(undo))
(lambda (snd i)
- (filter-channel (float-vector .25 .5 .25 .1) 4))
+ (filter-channel #r(.25 .5 .25 .1) 4))
(lambda (snd i)
- (filter-channel (float-vector .25 .5 .5 .25) 4))
+ (filter-channel #r(.25 .5 .5 .25) 4))
(lambda (snd i)
- (filter-channel (float-vector .1 .2 .1 .1 .1 .1 .1 .2 .1 .1) 10))
+ (filter-channel #r(.1 .2 .1 .1 .1 .1 .1 .2 .1 .1) 10))
(lambda (snd i)
(filter-channel (make-float-vector 10 .1) 10))
(lambda (snd i)
@@ -30597,7 +30562,7 @@ EDITS: 1
(src-selection 1)
(if (not (= (edit-position ind 0) edpos)) (snd-display "src-selection 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
- (filter-channel (float-vector 1.0))
+ (filter-channel #r(1.0))
(if (not (= (edit-position ind 0) edpos)) (snd-display "filter-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
(env-channel '(0 1 1 1))
@@ -30622,7 +30587,7 @@ EDITS: 1
(set! (edit-position ind 0) edpos)
(scale-by 2)
- (filter-channel (float-vector 2) 1 0 #f ind 0 edpos)
+ (filter-channel #r(2) 1 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 (+ 1 edpos) (+ edpos 2))))
(if diff (snd-display "scale and filter 2 diff: ~A" diff)))
@@ -30635,7 +30600,7 @@ EDITS: 1
(snd-display "edpos scl copy opted out?")
(undo))
- (filter-channel (float-vector 1) 1 0 #f ind 0 edpos)
+ (filter-channel #r(1) 1 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
(if diff (snd-display "edpos flt 1 diff: ~A" diff)))
(if (= (edit-position ind 0) (+ edpos 2))
@@ -30667,7 +30632,7 @@ EDITS: 1
(snd-display "scl len edpos: ~A ~A" len (framples ind 0)))
(undo)
- (filter-channel (float-vector 1) 1 0 #f ind 0 edpos)
+ (filter-channel #r(1) 1 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
(if diff (snd-display "1 edpos flt 1 diff: ~A" diff)))
(if (not (= (framples ind 0) len))
@@ -30773,7 +30738,7 @@ EDITS: 1
(if (fneq (maxamp ind 0) .09) (snd-display "rev edpos max: ~A" (maxamp ind 0)))
(undo)
- (filter-channel (float-vector .1 .2 .1) 3 0 5 ind 0 edpos #t) ; truncate
+ (filter-channel #r(.1 .2 .1) 3 0 5 ind 0 edpos #t) ; truncate
(if (not (= (framples ind 0) 10)) (snd-display "flt edpos len: ~A" (framples ind 0)))
(if (fneq (maxamp ind 0) .09) (snd-display "flt edpos max: ~A" (maxamp ind 0)))
(undo)
@@ -30794,13 +30759,13 @@ EDITS: 1
(undo)
(float-vector->channel (make-float-vector 5 0.5) 15 5 ind 0 edpos)
(if (not (= (framples ind 0) 20)) (snd-display "delete-samples edpos len: ~A" (framples ind 0)))
- (if (not (mus-arrays-equal? (channel->float-vector 10 10) (float-vector 1.0 1.0 1.0 1.0 1.0 0.5 0.5 0.5 0.5 0.5)))
+ (if (not (mus-arrays-equal? (channel->float-vector 10 10) #r(1.0 1.0 1.0 1.0 1.0 0.5 0.5 0.5 0.5 0.5)))
(snd-display "set samples edpos: ~A" (channel->float-vector 10 10)))
(undo)
(env-channel '(0 0 1 1) 0 #f ind 0 edpos)
(if (not (= (framples ind 0) 20)) (snd-display "env edpos len: ~A" (framples ind 0)))
(if (not (mus-arrays-equal? (channel->float-vector 0 20)
- (float-vector 0.0 0.053 0.105 0.158 0.211 0.263 0.316 0.368 0.421 0.474 0.526 0.579 0.632 0.684 0.737 0.789 0.842 0.895 0.947 1.000)))
+ #r(0.0 0.053 0.105 0.158 0.211 0.263 0.316 0.368 0.421 0.474 0.526 0.579 0.632 0.684 0.737 0.789 0.842 0.895 0.947 1.000)))
(snd-display "env edpos: ~A" (channel->float-vector 0 20)))
(undo)
(close-sound ind)))
@@ -30808,11 +30773,11 @@ EDITS: 1
(let ((ind (new-sound "fmv.snd" :size 20)))
(set! (sample 5) 1.0)
- (filter-channel (float-vector 1.0 0.5))
- (filter-channel (float-vector 1.0 0.5))
+ (filter-channel #r(1.0 0.5))
+ (filter-channel #r(1.0 0.5))
(let ((data (channel->float-vector 0 20)))
(undo 2)
- (filter-channel (convolve-coeffs (float-vector 1.0 0.5) (float-vector 1.0 0.5)))
+ (filter-channel (convolve-coeffs #r(1.0 0.5) #r(1.0 0.5)))
(let ((vdata (channel->float-vector 0 20)))
(if (not (mus-arrays-equal? data vdata))
(snd-display "filter convolved: ~% standard: ~A~% virtual: ~A~%" data vdata)))
@@ -30902,7 +30867,7 @@ EDITS: 1
(make-selection 3 7) ; beg end just for confusion
(env-selection '(0 0.5 1 0.5))
(let ((data (channel->float-vector)))
- (if (not (mus-arrays-equal? data (float-vector .4 .4 .4 .2 .2 .2 .2 .2 .4 .4)))
+ (if (not (mus-arrays-equal? data #r(.4 .4 .4 .2 .2 .2 .2 .2 .4 .4)))
(snd-display "env-selection constant: ~A" data)))
(undo)
(let ((edpos (edit-position ind 0)))
@@ -30914,7 +30879,7 @@ EDITS: 1
(map-channel (lambda (y) (set! ctr (+ ctr 1)) (or (> ctr 3) (* y 2)))))
(if (not (= (framples ind 0) 3))
(snd-display "map-channel -> #t at 3: ~A" (framples ind 0))
- (if (not (mus-arrays-equal? (channel->float-vector) (float-vector 0.8 0.8 0.8)))
+ (if (not (mus-arrays-equal? (channel->float-vector) #r(0.8 0.8 0.8)))
(snd-display "map-channel #t result: ~A" (channel->float-vector))))
(undo)
@@ -30922,7 +30887,7 @@ EDITS: 1
(map-channel (lambda (y) (set! ctr (+ ctr 1)) (if (= ctr 3) (make-float-vector 5 .1) (* y .5)))))
(if (not (= (framples ind 0) 14))
(snd-display "map-channel -> float-vector at 3: ~A" (framples ind 0))
- (if (not (mus-arrays-equal? (channel->float-vector) (float-vector 0.200 0.200 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.200 0.200 0.200 0.200 0.200)))
+ (if (not (mus-arrays-equal? (channel->float-vector) #r(0.200 0.200 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.200 0.200 0.200 0.200 0.200)))
(snd-display "map-channel float-vector result: ~A" (channel->float-vector))))
(undo)
@@ -30931,7 +30896,7 @@ EDITS: 1
(if (not (= (framples ind 0) 20))
(snd-display "map-channel -> float-vector: ~A" (framples ind 0))
(if (not (mus-arrays-equal? (channel->float-vector)
- (float-vector 0.400 0.0 0.400 0.0 0.400 0.0 0.400 0.0 0.400 0.0 0.400 0.0 0.400 0.0 0.400 0.0 0.400 0.0 0.400 0.000)))
+ #r(0.400 0.0 0.400 0.0 0.400 0.0 0.400 0.0 0.400 0.0 0.400 0.0 0.400 0.0 0.400 0.0 0.400 0.0 0.400 0.000)))
(snd-display "map-channel float-vector result: ~A" (channel->float-vector))))
(undo)
@@ -30963,7 +30928,7 @@ EDITS: 1
(map-channel (lambda (y) (or (> (set! ctr (+ ctr 1)) 3) (* y 2)))))
(if (not (= (framples ind 0) 3))
(snd-display "map-channel oboe -> #t at 3: ~A" (framples ind 0))
- (if (not (mus-arrays-equal? (channel->float-vector) (float-vector 0.0 -.001 -.001)))
+ (if (not (mus-arrays-equal? (channel->float-vector) #r(0.0 -.001 -.001)))
(snd-display "map-channel #t oboe result: ~A" (channel->float-vector))))
(undo)
@@ -30971,7 +30936,7 @@ EDITS: 1
(map-channel (lambda (y) (if (= (set! ctr (+ ctr 1)) 3) (make-float-vector 5 .1) (* y .5)))))
(if (not (= (framples ind 0) 50832))
(snd-display "map-channel oboe -> float-vector at 3: ~A" (framples ind 0))
- (if (not (mus-arrays-equal? (channel->float-vector 0 10) (float-vector 0.0 0.0 0.100 0.100 0.100 0.100 0.100 0.0 0.0 -0.000)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 10) #r(0.0 0.0 0.100 0.100 0.100 0.100 0.100 0.0 0.0 -0.000)))
(snd-display "map-channel float-vector result: ~A" (channel->float-vector 0 10))))
(undo)
@@ -30989,7 +30954,7 @@ EDITS: 1
(ramp-channel 0.9 1.0)
(xramp-channel 0.9 1.0 32.0)
(xramp-channel 0.9 1.0 32.0)
- (mix-float-vector (float-vector .01 .02) 10000 ind 0 #t)
+ (mix-float-vector #r(.01 .02) 10000 ind 0 #t)
(set! (sync ind) 1)
(let ((mxs (maxamp ind #t)))
(env-sound '(0 .25 1 0.5))
@@ -31007,7 +30972,7 @@ EDITS: 1
(ramp-channel 0.9 1.0)
(xramp-channel 0.9 1.0 32.0)
(xramp-channel 0.9 1.0 32.0)
- (mix-float-vector (float-vector .1 .2) 1 ind 0 #t)
+ (mix-float-vector #r(.1 .2) 1 ind 0 #t)
(set! (sync ind) 1)
(let ((mxs (maxamp ind #t)))
(env-sound '(0 .25 1 0.5))
@@ -31045,7 +31010,7 @@ EDITS: 1
(set! (sample 3) .5)
(src-channel 2.0)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector -0.05016523320247118 0.1581800948824515 0.1581800948824515
+ (if (not (vmus-arrays-equal? v #r(-0.05016523320247118 0.1581800948824515 0.1581800948824515
-0.05016523320247118 0.02716944826115516 -0.01652926966015632)))
(snd-display "src 2, 10 3 10: ~A" v)))
(close-sound res))
@@ -31054,7 +31019,7 @@ EDITS: 1
(set! (sample 2) .5)
(src-channel 2.0)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector 0.0 0.25 0.0 0.0 0.0 0.0)))
+ (if (not (vmus-arrays-equal? v #r(0.0 0.25 0.0 0.0 0.0 0.0)))
(snd-display "src 2, 10 2 10: ~A" v)))
(close-sound res))
@@ -31062,7 +31027,7 @@ EDITS: 1
(set! (sample 0) .5)
(src-channel 2.0)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector 0.25 0.0 0.0 0.0 0.0 0.0)))
+ (if (not (vmus-arrays-equal? v #r(0.25 0.0 0.0 0.0 0.0 0.0)))
(snd-display "src 2, 10 0 10: ~A" v)))
(close-sound res))
@@ -31070,7 +31035,7 @@ EDITS: 1
(set! (sample 3) .5)
(src-channel 2.0)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector -0.05016523320247118 0.1581800948824515 0.1581800948824515
+ (if (not (vmus-arrays-equal? v #r(-0.05016523320247118 0.1581800948824515 0.1581800948824515
-0.05016523320247118 0.02716944826115516 -0.01652926966015632 0.01022512563738671)))
(snd-display "src 2, 11 3 10: ~A" v)))
(close-sound res))
@@ -31079,7 +31044,7 @@ EDITS: 1
(set! (sample 2) .5)
(src-channel 2.0)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector 0.0 0.25 0.0 0.0 0.0 0.0 0.0)))
+ (if (not (vmus-arrays-equal? v #r(0.0 0.25 0.0 0.0 0.0 0.0 0.0)))
(snd-display "src 2, 11 2 10: ~A" v)))
(close-sound res))
@@ -31087,7 +31052,7 @@ EDITS: 1
(set! (sample 0) .5)
(src-channel 2.0)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector 0.25 0.0 0.0 0.0 0.0 0.0 0.0)))
+ (if (not (vmus-arrays-equal? v #r(0.25 0.0 0.0 0.0 0.0 0.0 0.0)))
(snd-display "src 2, 11 0 10: ~A" v)))
(close-sound res))
@@ -31098,7 +31063,7 @@ EDITS: 1
(set! (sample (- 39 i)) (* i .05)))
(src-channel 2.0)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector 0.01198528796961999 0.1035793306415383 0.2059748594814547 0.3060708098272395 0.4072307780331241
+ (if (not (vmus-arrays-equal? v #r(0.01198528796961999 0.1035793306415383 0.2059748594814547 0.3060708098272395 0.4072307780331241
0.5077603318367317 0.6062448605128621 0.7086656575233007 0.8045885470214085 0.9128440616541418
0.9536620711423869 0.8562080426776515 0.7579855746854125 0.6566287955350736 0.5575138524566664
0.4569842986530586 0.3574772574131896 0.2546643622412894 0.1572853567216201 0.04987330456145658
@@ -31112,7 +31077,7 @@ EDITS: 1
(set! (sample 3) .5)
(src-channel 2.0)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector -0.05103248958541851 0.1584755057631961 0.1584755057631961
+ (if (not (vmus-arrays-equal? v #r(-0.05103248958541851 0.1584755057631961 0.1584755057631961
-0.05103248958541851 0.02854464095499105 -0.01828991864619797 0.01222560572178551 -0.008180460967128276 0.0)))
(snd-display "src 2, 15 3 11: ~A" v)))
(close-sound res))
@@ -31121,7 +31086,7 @@ EDITS: 1
(set! (sample 0) .5)
(src-channel 2.0)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector 0.25 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
+ (if (not (vmus-arrays-equal? v #r(0.25 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
(snd-display "src 2, 15 0 11: ~A" v)))
(close-sound res)))
@@ -31131,7 +31096,7 @@ EDITS: 1
(set! (sample 3) .5)
(src-channel 0.5)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector 0.0 0.05433889652231032 0.0 -0.1003304664049424 0.0 0.316360189764903 0.5
+ (if (not (vmus-arrays-equal? v #r(0.0 0.05433889652231032 0.0 -0.1003304664049424 0.0 0.316360189764903 0.5
0.316360189764903 0.0 -0.1003304664049424 0.0 0.05433889652231032 0.0 -0.03305853932031265 0.0
0.02045025127477342 0.0 -0.01220523861007159 0.0 0.006688908032246622 0.0)))
(format *stderr* "src 1/2, 10 3 10: ~A~%" v)))
@@ -31141,7 +31106,7 @@ EDITS: 1
(set! (sample 2) .5)
(src-channel 0.5)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector 0.0 -0.1003304664049424 0.0 0.316360189764903 0.5 0.316360189764903 0.0 -0.1003304664049424
+ (if (not (vmus-arrays-equal? v #r(0.0 -0.1003304664049424 0.0 0.316360189764903 0.5 0.316360189764903 0.0 -0.1003304664049424
0.0 0.05433889652231032 0.0 -0.03305853932031265 0.0 0.02045025127477342 0.0
-0.01220523861007159 0.0 0.006688908032246622 0.0 -0.003110640428161881 0.0)))
(format *stderr* "src 1/2, 10 2 10: ~A~%" v)))
@@ -31151,7 +31116,7 @@ EDITS: 1
(set! (sample 0) .5)
(src-channel 0.5)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector 0.5 0.316360189764903 0.0 -0.1003304664049424 0.0 0.05433889652231032 0.0 -0.03305853932031265
+ (if (not (vmus-arrays-equal? v #r(0.5 0.316360189764903 0.0 -0.1003304664049424 0.0 0.05433889652231032 0.0 -0.03305853932031265
0.0 0.02045025127477342 0.0 -0.01220523861007159 0.0 0.006688908032246622 0.0
-0.003110640428161881 0.0 0.001022072692939124 0.0 -0.000103644775079492 0.0)))
(format *stderr* "src 1/2, 10 0 10: ~A~%" v)))
@@ -31162,7 +31127,7 @@ EDITS: 1
(set! (sample 3) .5)
(src-channel 0.5)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector 0.0 0.05433889652231032 0.0 -0.1003304664049424 0.0 0.316360189764903 0.5 0.316360189764903
+ (if (not (vmus-arrays-equal? v #r(0.0 0.05433889652231032 0.0 -0.1003304664049424 0.0 0.316360189764903 0.5 0.316360189764903
0.0 -0.1003304664049424 0.0 0.05433889652231032 0.0 -0.03305853932031265 0.0 0.02045025127477342
0.0 -0.01220523861007159 0.0 0.006688908032246622 0.0 -0.003110640428161881 0.0)))
(format *stderr* "src 1/2, 11 3 10: ~A~%" v)))
@@ -31172,7 +31137,7 @@ EDITS: 1
(set! (sample 2) .5)
(src-channel 0.5)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector 0.0 -0.1003304664049424 0.0 0.316360189764903 0.5 0.316360189764903 0.0 -0.1003304664049424
+ (if (not (vmus-arrays-equal? v #r(0.0 -0.1003304664049424 0.0 0.316360189764903 0.5 0.316360189764903 0.0 -0.1003304664049424
0.0 0.05433889652231032 0.0 -0.03305853932031265 0.0 0.02045025127477342 0.0 -0.01220523861007159
0.0 0.006688908032246622 0.0 -0.003110640428161881 0.0 0.001022072692939124 0.0)))
(format *stderr* "src 1/2, 11 2 10: ~A~%" v)))
@@ -31182,7 +31147,7 @@ EDITS: 1
(set! (sample 0) .5)
(src-channel 0.5)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector 0.5 0.316360189764903 0.0 -0.1003304664049424 0.0 0.05433889652231032 0.0 -0.03305853932031265
+ (if (not (vmus-arrays-equal? v #r(0.5 0.316360189764903 0.0 -0.1003304664049424 0.0 0.05433889652231032 0.0 -0.03305853932031265
0.0 0.02045025127477342 0.0 -0.01220523861007159 0.0 0.006688908032246622 0.0
-0.003110640428161881 0.0 0.001022072692939124 0.0 -0.000103644775079492 0.0 0.0 0.0)))
(format *stderr* "src 1/2, 11 0 10: ~A~%" v)))
@@ -31196,7 +31161,7 @@ EDITS: 1
(set! (sample (- 39 i)) (* i .05)))
(src-channel 0.5)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector 0.0 0.02056010532402247 0.05 0.07720130317537323 0.1 0.1238094543862298 0.15 0.1758514952493174
+ (if (not (vmus-arrays-equal? v #r(0.0 0.02056010532402247 0.05 0.07720130317537323 0.1 0.1238094543862298 0.15 0.1758514952493174
0.2 0.2245876821803736 0.25 0.2753688942389073 0.3 0.3249295824364337 0.35 0.3751591614371849
0.4 0.4250776763951197 0.45 0.4750983986223486 0.5 0.5251191208495776 0.55 0.5750480002850203
0.60000000 0.6251857364939857 0.65 0.6749656459425423 0.70000000 0.7252971884488815
@@ -31217,7 +31182,7 @@ EDITS: 1
(set! (sample 3) .5)
(src-channel 0.5)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector 0.0 0.05588873297652781 0.0 -0.1013169884822853 0.0 0.3166955736757819 0.5 0.3166955736757819
+ (if (not (vmus-arrays-equal? v #r(0.0 0.05588873297652781 0.0 -0.1013169884822853 0.0 0.3166955736757819 0.5 0.3166955736757819
0.0 -0.1013169884822853 0.0 0.05588873297652781 0.0 -0.03503207135776369 0.0 0.02267085373675465
0.0 -0.01446863119016991 0.0 0.008794782253203336 0.0 -0.004875864375201019 0.0 0.002288656235197179
0.0 -0.0007570986863940245 0.0 7.729542250127452e-05 0.0 0.0 0.0)))
@@ -31228,7 +31193,7 @@ EDITS: 1
(set! (sample 0) .5)
(src-channel 0.5)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector 0.5 0.3166955736757819 0.0 -0.1013169884822853 0.0 0.05588873297652781 0.0 -0.03503207135776369 0.0
+ (if (not (vmus-arrays-equal? v #r(0.5 0.3166955736757819 0.0 -0.1013169884822853 0.0 0.05588873297652781 0.0 -0.03503207135776369 0.0
0.02267085373675465 0.0 -0.01446863119016991 0.0 0.008794782253203336 0.0 -0.004875864375201019 0.0
0.002288656235197179 0.0 -0.0007570986863940245 0.0 7.729542250127452e-05 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
(format *stderr* "src 1/2, 15 0 11: ~A~%" v)))
@@ -31240,7 +31205,7 @@ EDITS: 1
(set! (sample 2) .5)
(src-channel 1.5)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector -0.0659173000292574 0.2750218141864232 0.1361775290259087 -0.05140008051946586 0.02873817799080515
+ (if (not (vmus-arrays-equal? v #r(-0.0659173000292574 0.2750218141864232 0.1361775290259087 -0.05140008051946586 0.02873817799080515
-0.01761592377597271 0.01086818222156537 -0.006418849681280971)))
(format *stderr* "src 1.5, 10 0 10: ~A~%" v)))
(close-sound res))
@@ -31249,7 +31214,7 @@ EDITS: 1
(set! (sample 2) .5)
(src-channel 0.3)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector -2.309626927862667e-14 -0.07046687722856798 -0.1029821798386912 -0.04339187529883121
+ (if (not (vmus-arrays-equal? v #r(-2.309626927862667e-14 -0.07046687722856798 -0.1029821798386912 -0.04339187529883121
0.1151049838606023 0.316360189764903 0.4672831482919799 0.4916944808321784 0.3769307110649516
0.1817344234767786 1.953289539319582e-14 -0.09498013189693179 -0.08875244041152466
-0.0236470298331755 0.03764309466867966 0.05433889652231032 0.02735343920407904
@@ -31267,7 +31232,7 @@ EDITS: 1
(set! (sample 8) .5)
(src-channel e)
(let ((v (channel->float-vector)))
- (if (not (vmus-arrays-equal? v (float-vector 3.511360236100833e-14 0.499999999999969 0.03245693012152732 -0.04426423670248926
+ (if (not (vmus-arrays-equal? v #r(3.511360236100833e-14 0.499999999999969 0.03245693012152732 -0.04426423670248926
0.05693627592759216 -0.06869987735399859 0.1364034106143399 0.2654607053632132 -0.04771168369895742)))
(format *stderr* "src e, 10 0 10: ~A~%" v)))
(close-sound res)))
@@ -31349,7 +31314,7 @@ EDITS: 1
(draw-line 100 100 200 200 ind 0 time-graph cr)
(draw-dot 300 300 10 ind 0 time-graph cr)
(draw-string "hiho" 20 20 ind 0 time-graph cr)
- (draw-dots #(25 25 50 50 100 100) 10 ind 0 time-graph cr)
+ (draw-dots #i(25 25 50 50 100 100) 10 ind 0 time-graph cr)
(-> 100 50 10 ind 0 cr)
(fill-rectangle 20 20 100 100 ind 0 time-graph #f cr)
(free-cairo cr))
@@ -31360,11 +31325,11 @@ EDITS: 1
(let ((ind (open-sound "oboe.snd")))
(set! (time-graph? ind 0) #f)
- (graph (list (float-vector 0 1 2) (float-vector 3 2 1) (float-vector 1 2 3) (float-vector 1 1 1) (float-vector 0 1 0) (float-vector 3 1 2)))
+ (graph (list #r(0 1 2) #r(3 2 1) #r(1 2 3) #r(1 1 1) #r(0 1 0) #r(3 1 2)))
(update-lisp-graph)
(hook-push lisp-graph-hook (lambda (hook)
(set! (hook 'result) (list *basic-color* *zoom-color* *data-color* *selected-data-color* *mix-color*))))
- (graph (list (float-vector 0 1 2) (float-vector 3 2 1) (float-vector 1 2 3) (float-vector 1 1 1) (float-vector 0 1 0) (float-vector 3 1 2)))
+ (graph (list #r(0 1 2) #r(3 2 1) #r(1 2 3) #r(1 1 1) #r(0 1 0) #r(3 1 2)))
(update-lisp-graph)
(set! (hook-functions lisp-graph-hook) ())
(close-sound ind))
@@ -31788,21 +31753,21 @@ EDITS: 1
;; change
(as-one-edit
(lambda ()
- (float-vector->channel (float-vector .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) 0 10 ind 0)
- (float-vector->channel (float-vector .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) 20 10 ind 0))))
+ (float-vector->channel #r(.1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) 0 10 ind 0)
+ (float-vector->channel #r(.1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) 20 10 ind 0))))
(lambda (ind)
;; scale
(as-one-edit
(lambda ()
- (float-vector->channel (float-vector .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) 0 10 ind 0)
+ (float-vector->channel #r(.1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) 0 10 ind 0)
(scale-by .5))))
(lambda (ind)
;; delete
(as-one-edit
(lambda ()
- (float-vector->channel (float-vector .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) 0 10 ind 0)
+ (float-vector->channel #r(.1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) 0 10 ind 0)
(delete-samples 5 5))))
(lambda (ind)
@@ -31810,7 +31775,7 @@ EDITS: 1
(as-one-edit
(lambda ()
(delete-samples 5 5)
- (insert-samples 5 2 (float-vector .1 .2))))))
+ (insert-samples 5 2 #r(.1 .2))))))
(list
;; basic cases
@@ -31830,12 +31795,12 @@ EDITS: 1
(lambda (ind)
(if (not (= (framples ind 0) 105)) (snd-display "pad sample save-state len: ~A" (framples ind 0)))
(if (not (= (edit-position ind 0) 2)) (snd-display "pad sample save-state edpos: ~A" (edit-position ind 0)))
- (if (not (mus-arrays-equal? (float-vector .5 .5 0 0 0 0 0 .5 .5 .5) (channel->float-vector 10 10 ind 0)))
+ (if (not (mus-arrays-equal? #r(.5 .5 0 0 0 0 0 .5 .5 .5) (channel->float-vector 10 10 ind 0)))
(snd-display "pad sample save-state: ~A" (channel->float-vector 10 10 ind 0))))
(lambda (ind)
(if (not (= (framples ind 0) 100)) (snd-display "env sample save-state len: ~A" (framples ind 0)))
(if (not (= (edit-position ind 0) 2)) (snd-display "env sample save-state edpos: ~A" (edit-position ind 0)))
- (if (not (mus-arrays-equal? (float-vector 0 .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0 1.0 1.0 1.0 1.0) (channel->float-vector 0 15 ind 0)))
+ (if (not (mus-arrays-equal? #r(0 .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0 1.0 1.0 1.0 1.0) (channel->float-vector 0 15 ind 0)))
(snd-display "env sample save-state: ~A" (channel->float-vector 0 15 ind 0))))
(lambda (ind)
(if (not (= (framples ind 0) 100)) (snd-display " sample save-state len: ~A" (framples ind 0)))
@@ -31853,24 +31818,24 @@ EDITS: 1
;; as-one-edit
(lambda (ind)
(if (not (= (edit-position ind 0) 1)) (snd-display "save-state backup 2 float-vectors edpos: ~A" (edit-position ind 0)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 0) (float-vector .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 0) #r(.1 .2 .3 .4 .5 .6 .7 .8 .9 1.0)))
(snd-display "as-one-edit save-state 1: ~A" (channel->float-vector 0 10 ind 0)))
- (if (not (mus-arrays-equal? (channel->float-vector 20 10 ind 0) (float-vector .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 20 10 ind 0) #r(.1 .2 .3 .4 .5 .6 .7 .8 .9 1.0)))
(snd-display "as-one-edit save-state 2: ~A" (channel->float-vector 0 10 ind 0))))
(lambda (ind)
(if (not (= (edit-position ind 0) 1)) (snd-display "save-state backup float-vector+scl edpos: ~A" (edit-position ind 0)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 0) (float-vector-scale! (float-vector .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) .5)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 0) (float-vector-scale! #r(.1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) .5)))
(snd-display "as-one-edit save-state 3: ~A" (channel->float-vector 0 10 ind 0))))
(lambda (ind)
(if (not (= (edit-position ind 0) 1)) (snd-display "save-state backup float-vector+del edpos: ~A" (edit-position ind 0)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 0) (float-vector .1 .2 .3 .4 .5 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 0) #r(.1 .2 .3 .4 .5 0 0 0 0 0)))
(snd-display "as-one-edit save-state 4: ~A" (channel->float-vector 0 10 ind 0))))
(lambda (ind)
(if (not (= (edit-position ind 0) 1)) (snd-display "save-state backup del+insert edpos: ~A" (edit-position ind 0)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 0) (float-vector 0 0 0 0 0 .1 .2 0 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 0) #r(0 0 0 0 0 .1 .2 0 0 0)))
(snd-display "as-one-edit save-state 5: ~A" (channel->float-vector 0 10 ind 0)))
(if (not (= (framples ind 0) 97)) (snd-display "save-state backup del+insert len: ~A" (framples ind 0)))))))
@@ -32109,7 +32074,7 @@ EDITS: 1
(if (not (equal? (procedure-source func) '(lambda (snd chn) (insert-sample 100 0.1 snd chn))))
(snd-display "edit-list->function 9: ~A" (procedure-source func)))
(func ind 0)
- (if (not (mus-arrays-equal? (channel->float-vector 99 4) (float-vector 0.0 0.1 0.1 0.0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 99 4) #r(0.0 0.1 0.1 0.0)))
(snd-display "edit-list->function func 9: ~A" (channel->float-vector 99 4)))
(if (not (= (framples) (+ frs 2))) (snd-display "edit-list->function called (9): ~A ~A" frs (framples))))
(revert-sound ind)
@@ -32151,7 +32116,7 @@ EDITS: 1
(if (not (equal? (procedure-source func) '(lambda (snd chn) (set-sample 100 0.1 snd chn))))
(snd-display "edit-list->function 10: ~A" (procedure-source func)))
(func ind 0)
- (if (not (mus-arrays-equal? (channel->float-vector 99 4) (float-vector 0.0 0.1 0.0 0.0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 99 4) #r(0.0 0.1 0.0 0.0)))
(snd-display "edit-list->function func 10: ~A" (channel->float-vector 99 4)))))
(revert-sound ind)
@@ -32283,7 +32248,7 @@ EDITS: 1
(map-channel (lambda (y) 1.0))
(func ind 0)
(let ((data (channel->float-vector)))
- (if (not (mus-arrays-equal? data (float-vector 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.0)))
+ (if (not (mus-arrays-equal? data #r(0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.0)))
(snd-display "edit-list->function env reapply: ~A" data)))
(close-sound ind)
(set! ind (open-sound "oboe.snd")))
@@ -32410,7 +32375,7 @@ EDITS: 1
val))))
(let ((vals (fft-env-data '(0 0 .3 0 .4 1 1 1))))
(float-vector->channel vals)
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.500 0.0 -0.500 0.0 0.500 0.0 -0.500 0.0 0.500 0.0
+ (if (not (mus-arrays-equal? vals #r(0.0 0.500 0.0 -0.500 0.0 0.500 0.0 -0.500 0.0 0.500 0.0
-0.500 0.0 0.500 0.0 -0.500 0.0 0.500 0.0 -0.500 0.0 0.500
0.0 -0.500 0.0 0.500 0.0 -0.500 0.0 0.500 0.0 -0.500)))
(snd-display "fft-env-data: ~A" vals)))
@@ -32438,7 +32403,7 @@ EDITS: 1
(float-vector->channel rl 0 len snd chn #f "hilbert-transform-via-fft")))))))
(hilbert-transform-via-fft))
(let ((vals (channel->float-vector))
- (nvals (float-vector -0.500 0.0 0.500 0.0 -0.500 0.0 0.500 0.0 -0.500 0.0 0.500
+ (nvals #r(-0.500 0.0 0.500 0.0 -0.500 0.0 0.500 0.0 -0.500 0.0 0.500
0.0 -0.500 0.0 0.500 0.0 -0.500 0.0 0.500 0.0 -0.500 0.0
0.500 0.0 -0.500 0.0 0.500 0.0 -0.500 0.0 0.500 -0.000)))
(if (not (mus-arrays-equal? vals nvals))
@@ -32448,7 +32413,7 @@ EDITS: 1
(powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))
(let ((vals (channel->float-vector)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.107 0.206 0.298 0.384 0.463 0.536 0.605 0.668 0.727 0.781 0.832 0.879
+ (if (not (mus-arrays-equal? vals #r(0.0 0.107 0.206 0.298 0.384 0.463 0.536 0.605 0.668 0.727 0.781 0.832 0.879
0.922 0.963 1.000 1.000 0.787 0.618 0.484 0.377 0.293 0.226 0.173 0.130 0.097
0.070 0.049 0.032 0.019 0.008 0.000)))
(snd-display "powenv-channel: ~A" vals)))
@@ -32463,14 +32428,14 @@ EDITS: 1
(begin
(replace-with-selection)
(let ((vals (channel->float-vector)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.032 0.065 0.097 0.129 0.161 0.194 0.226 0.258 0.290 0.0 0.032 0.065
+ (if (not (mus-arrays-equal? vals #r(0.0 0.032 0.065 0.097 0.129 0.161 0.194 0.226 0.258 0.290 0.0 0.032 0.065
0.097 0.129 0.161 0.194 0.226 0.581 0.613 0.645 0.677 0.710 0.742 0.774 0.806
0.839 0.871 0.903 0.935 0.968 1.000)))
(snd-display "replace-with-selection: ~A" vals)))))
(set! (cursor ind 0) 2)
(replace-with-selection)
(let ((vals (channel->float-vector)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.032 0.0 0.032 0.065 0.097 0.129 0.161 0.194 0.226 0.0 0.032 0.065
+ (if (not (mus-arrays-equal? vals #r(0.0 0.032 0.0 0.032 0.065 0.097 0.129 0.161 0.194 0.226 0.0 0.032 0.065
0.097 0.129 0.161 0.194 0.226 0.581 0.613 0.645 0.677 0.710 0.742 0.774 0.806
0.839 0.871 0.903 0.935 0.968 1.000)))
(snd-display "replace-with-selection (at 2): ~A" vals)))
@@ -32483,7 +32448,7 @@ EDITS: 1
(make-selection 0 9)
(fit-selection-between-marks m1 m2)
(let ((vals (channel->float-vector)))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.032 0.065 0.097 0.129 0.161 0.194 0.226 0.258 0.290 0.323 0.387 0.452
+ (if (not (mus-arrays-equal? vals #r(0.0 0.032 0.065 0.097 0.129 0.161 0.194 0.226 0.258 0.290 0.323 0.387 0.452
0.516 0.581 0.645 0.710 0.774 0.839 0.903 0.645 0.677 0.710 0.742 0.774 0.806
0.839 0.871 0.903 0.935 0.968 1.000)))
(snd-display "fit-selection-between-marks: ~A" vals))))
@@ -32494,7 +32459,7 @@ EDITS: 1
(let ((ramper (make-ramp 10)))
(map-channel (lambda (y) (ramp ramper y)))
(let ((vals (channel->float-vector 0 20)))
- (if (not (mus-arrays-equal? vals (float-vector 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000 1.0
+ (if (not (mus-arrays-equal? vals #r(0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000 1.0
1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
(snd-display "make-ramp: ~A" vals))))
(revert-sound ind)
@@ -32505,7 +32470,7 @@ EDITS: 1
(clean-up-sound ind))
(let ((vals (apply float-vector (rms-envelope "oboe.snd" :rfreq 4))))
- (if (not (mus-arrays-equal? vals (float-vector 0.0 0.0430 0.25 0.0642 0.5 0.0695 0.75 0.0722 1.0 0.0738 1.25 0.0713
+ (if (not (mus-arrays-equal? vals #r(0.0 0.0430 0.25 0.0642 0.5 0.0695 0.75 0.0722 1.0 0.0738 1.25 0.0713
1.5 0.065 1.75 0.0439 2.0 0.01275 2.25 0.007)))
(snd-display "rms-envelope: ~A" vals)))
@@ -32543,9 +32508,9 @@ EDITS: 1
(map-channel (lambda (y) 0.5))
(map-channel (vibro 1000.0 .5))
(let ((vals (channel->float-vector 0 20)))
- (if (not (or (mus-arrays-equal? vals (float-vector 0.375 0.410 0.442 0.469 0.489 0.499 0.499 0.489 0.470 0.443 0.411 0.376
+ (if (not (or (mus-arrays-equal? vals #r(0.375 0.410 0.442 0.469 0.489 0.499 0.499 0.489 0.470 0.443 0.411 0.376
0.341 0.308 0.281 0.262 0.251 0.251 0.261 0.280))
- (mus-arrays-equal? vals (float-vector 0.375 0.393 0.410 0.427 0.442 0.457 0.469 0.480 0.489 0.495 0.499 0.500
+ (mus-arrays-equal? vals #r(0.375 0.393 0.410 0.427 0.442 0.457 0.469 0.480 0.489 0.495 0.499 0.500
0.499 0.495 0.489 0.480 0.470 0.457 0.443 0.428))))
(snd-display "no vibro? ~A" vals)))
(clean-up-sound ind))
@@ -32672,7 +32637,7 @@ EDITS: 1
(set! ctr (+ ctr 1))
(revert-sound ind))
(list
- (lambda () (insert-float-vector (float-vector 1.0 0.5) 0 2))
+ (lambda () (insert-float-vector #r(1.0 0.5) 0 2))
clm-channel-test
;; examp.scm
@@ -32715,8 +32680,8 @@ EDITS: 1
(lambda () (rotate-phase (lambda (x) (random pi))))
(lambda () (brighten-slightly .5))
(lambda () (shift-channel-pitch 100))
- (lambda () (channel-polynomial (float-vector 0.0 0.5)))
- (lambda () (spectral-polynomial (float-vector 0.0 1.0)))
+ (lambda () (channel-polynomial #r(0.0 0.5)))
+ (lambda () (spectral-polynomial #r(0.0 1.0)))
(lambda () (notch-channel (list 60.0 120.0 240.0) #f #f #f))
;; ---- new-effects.scm
@@ -32738,7 +32703,7 @@ EDITS: 1
(lambda () (effects-fp 1.0 0.3 20.0 0 #f))
(lambda () (effects-flange 5.0 2.0 0.001 0 #f))
(lambda () (effects-jc-reverb-1 0.1 0 #f)))
- '((lambda (snd chn) (insert-float-vector (float-vector 1.0 0.5) 0 2 snd chn))
+ '((lambda (snd chn) (insert-float-vector #r(1.0 0.5) 0 2 snd chn))
(lambda (snd chn) (clm-channel-test snd chn))
(lambda (snd chn) (fft-edit 1000 3000 snd chn))
@@ -32778,8 +32743,8 @@ EDITS: 1
(lambda (snd chn) (rotate-phase (lambda (x) (random pi)) snd chn))
(lambda (snd chn) (brighten-slightly 0.5 snd chn))
(lambda (snd chn) (shift-channel-pitch 100 40 0 #f snd chn))
- (lambda (snd chn) (channel-polynomial (float-vector 0.0 0.5) snd chn))
- (lambda (snd chn) (spectral-polynomial (float-vector 0.0 1.0) snd chn))
+ (lambda (snd chn) (channel-polynomial #r(0.0 0.5) snd chn))
+ (lambda (snd chn) (spectral-polynomial #r(0.0 1.0) snd chn))
(lambda (snd chn) (notch-channel '(60.0 120.0 240.0) #f #f #f snd chn))
(lambda (snd chn) (effects-squelch-channel 0.1 128 snd chn))
@@ -33642,11 +33607,10 @@ EDITS: 1
(let ((temp (data j)))
(set! (data j) (data i))
(set! (data i) temp)))
- (do ((m (/ n 2)))
+ (do ((m (/ n 2) (/ m 2)))
((not (<= 2 m j))
(set! j (+ j m)))
- (set! j (- j m))
- (set! m (/ m 2))))
+ (set! j (- j m))))
(do ((ipow (floor (log n 2)))
(prev 1)
(lg 0 (+ lg 1))
@@ -33684,11 +33648,10 @@ EDITS: 1
(set! (im j) (im i))
(set! (rl i) tempr)
(set! (im i) tempi)))
- (do ((m (/ n 2)))
+ (do ((m (/ n 2) (/ m 2)))
((not (<= 2 m j))
(set! j (+ j m)))
- (set! j (- j m))
- (set! m (/ m 2))))
+ (set! j (- j m))))
(do ((ipow (floor (log n 2)))
(prev 1)
(lg 0 (+ lg 1))
@@ -33814,18 +33777,18 @@ EDITS: 1
(d1 (make-float-vector 8)))
(set! (d0 2) 1.0)
(mus-fft d0 d1 8 1)
- (if (not (and (mus-arrays-equal? d0 (float-vector 1.000 0.0 -1.000 0.0 1.000 0.0 -1.000 0.000))
- (mus-arrays-equal? d1 (float-vector 0.0 1.000 0.0 -1.000 0.0 1.000 0.0 -1.000))))
+ (if (not (and (mus-arrays-equal? d0 #r(1.000 0.0 -1.000 0.0 1.000 0.0 -1.000 0.000))
+ (mus-arrays-equal? d1 #r(0.0 1.000 0.0 -1.000 0.0 1.000 0.0 -1.000))))
(snd-display "mus-fft 1: ~A ~A?" d0 d1))
(mus-fft d0 d1 8 -1)
- (if (not (and (mus-arrays-equal? d0 (float-vector 0.0 0.0 8.000 0.0 0.0 0.0 0.0 0.000))
+ (if (not (and (mus-arrays-equal? d0 #r(0.0 0.0 8.000 0.0 0.0 0.0 0.0 0.000))
(mus-arrays-equal? d1 (make-float-vector 8))))
(snd-display "mus-fft -1: ~A ~A?" d0 d1))
(fill! d0 1.0)
(fill! d1 0.0)
(mus-fft d0 d1 8)
- (if (not (and (mus-arrays-equal? d0 (float-vector 8.000 0.0 0.0 0.0 0.0 0.0 0.0 0.000))
+ (if (not (and (mus-arrays-equal? d0 #r(8.000 0.0 0.0 0.0 0.0 0.0 0.0 0.000))
(mus-arrays-equal? d1 (make-float-vector 8))))
(snd-display "mus-fft 2: ~A ~A?" d0 d1))
(mus-fft d0 d1 8 -1)
@@ -33955,18 +33918,18 @@ EDITS: 1
(set! happy #f))))
(let ((d1 (snd-spectrum (make-float-vector size 1.0) blackman2-window size)))
- (if (not (or (mus-arrays-equal? d1 (float-vector 1.000 0.721 0.293 0.091))
- (mus-arrays-equal? d1 (float-vector 1.000 0.647 0.173 0.037 0.024 0.016 0.011 0.005))))
+ (if (not (or (mus-arrays-equal? d1 #r(1.000 0.721 0.293 0.091))
+ (mus-arrays-equal? d1 #r(1.000 0.647 0.173 0.037 0.024 0.016 0.011 0.005))))
(snd-display "blackman2 snd-spectrum: ~A~%" d1)))
(let ((d1 (snd-spectrum (make-float-vector size 1.0) gaussian-window size #t 0.5)))
- (if (not (or (mus-arrays-equal? d1 (float-vector 1.000 0.900 0.646 0.328))
- (mus-arrays-equal? d1 (float-vector 1.000 0.870 0.585 0.329 0.177 0.101 0.059 0.028))))
+ (if (not (or (mus-arrays-equal? d1 #r(1.000 0.900 0.646 0.328))
+ (mus-arrays-equal? d1 #r(1.000 0.870 0.585 0.329 0.177 0.101 0.059 0.028))))
(snd-display "gaussian 0.5 snd-spectrum: ~A~%" d1)))
(let ((d1 (snd-spectrum (make-float-vector size 1.0) gaussian-window size #t 0.85)))
- (if (not (or (mus-arrays-equal? d1 (float-vector 1.000 0.924 0.707 0.383))
- (mus-arrays-equal? d1 (float-vector 1.000 0.964 0.865 0.725 0.566 0.409 0.263 0.128))))
+ (if (not (or (mus-arrays-equal? d1 #r(1.000 0.924 0.707 0.383))
+ (mus-arrays-equal? d1 #r(1.000 0.964 0.865 0.725 0.566 0.409 0.263 0.128))))
(snd-display "gaussian 0.85 snd-spectrum: ~A~%" d1))))
'(8 16))
@@ -34045,21 +34008,21 @@ EDITS: 1
(let ((rl (make-float-vector 16)))
(set! (rl 0) 1.0)
(autocorrelate rl)
- (if (not (mus-arrays-equal? rl (float-vector 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? rl #r(1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
(snd-display "autocorrelate 1: ~A" rl)))
(let ((rl (make-float-vector 16)))
(set! (rl 0) 1.0)
(set! (rl 1) -1.0)
(autocorrelate rl)
- (if (not (mus-arrays-equal? rl (float-vector 2 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? rl #r(2 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
(snd-display "autocorrelate 1 -1: ~A" rl)))
(let ((rl (make-float-vector 16)))
(set! (rl 0) 1.0)
(set! (rl 4) -1.0)
(autocorrelate rl)
- (if (not (mus-arrays-equal? rl (float-vector 2 0 0 0 -1 0 0 0 0 0 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? rl #r(2 0 0 0 -1 0 0 0 0 0 0 0 0 0 0 0)))
(snd-display "autocorrelate 1 0 0 0 -1: ~A" rl)))
(let ((rl (make-float-vector 16))
@@ -34228,21 +34191,24 @@ EDITS: 1
;; -------- cepstrum
;; these values from Octave real(ifft(log(abs(fft(x)))))
- (let ((rl (make-float-vector 16))
- (lst '( 0.423618 0.259318 -0.048365 1.140571 -0.811856 -0.994098 -0.998613 -2.453642
- -0.438549 -1.520463 -0.312065 -0.724707 1.154010 1.466936 0.110463 -1.520854)))
- (do ((i 0 (+ i 1))) ((= i 16)) (set! (rl i) (lst i)))
- (let ((nrl (float-vector-scale! (snd-transform cepstrum rl 0) 1.399)))
- (if (not (mus-arrays-equal? nrl (float-vector 1.3994950 0.1416877 0.0952407 0.0052814 -0.0613192 0.0082986 -0.0233993
- -0.0476585 0.0259498 -0.0476585 -0.0233993 0.0082986 -0.0613192 0.0052814
- 0.0952407 0.1416877)))
- (snd-display "cepstrum 16: ~A" nrl))))
-
- (let ((rl (make-float-vector 16)))
- (do ((i 0 (+ i 1))) ((= i 16)) (set! (rl i) i))
- (let ((nrl (float-vector-scale! (snd-transform cepstrum rl 0) 2.72)))
- (if (not (mus-arrays-equal? nrl (float-vector 2.720 0.452 0.203 0.122 0.082 0.061 0.048 0.041 0.039 0.041 0.048 0.061 0.082 0.122 0.203 0.452)))
- (snd-display "cepstrum 16 by ones: ~A" nrl))))
+ (do ((rl (make-float-vector 16))
+ (lst '(0.423618 0.259318 -0.048365 1.140571 -0.811856 -0.994098 -0.998613 -2.453642
+ -0.438549 -1.520463 -0.312065 -0.724707 1.154010 1.466936 0.110463 -1.520854))
+ (i 0 (+ i 1)))
+ ((= i 16)
+ (let ((nrl (float-vector-scale! (snd-transform cepstrum rl 0) 1.399)))
+ (if (not (mus-arrays-equal? nrl #r(1.3994950 0.1416877 0.0952407 0.0052814 -0.0613192 0.0082986 -0.0233993
+ -0.0476585 0.0259498 -0.0476585 -0.0233993 0.0082986 -0.0613192 0.0052814 0.0952407 0.1416877)))
+ (snd-display "cepstrum 16: ~A" nrl))))
+ (set! (rl i) (lst i)))
+
+ (do ((rl (make-float-vector 16))
+ (i 0 (+ i 1)))
+ ((= i 16)
+ (let ((nrl (float-vector-scale! (snd-transform cepstrum rl 0) 2.72)))
+ (if (not (mus-arrays-equal? nrl #r(2.720 0.452 0.203 0.122 0.082 0.061 0.048 0.041 0.039 0.041 0.048 0.061 0.082 0.122 0.203 0.452)))
+ (snd-display "cepstrum 16 by ones: ~A" nrl))))
+ (set! (rl i) i))
(for-each
(lambda (len)
@@ -34275,26 +34241,26 @@ EDITS: 1
(if (not (mus-arrays-equal? d0 (make-float-vector 8 1.0)))
(snd-display "walsh 1: ~A" d0))
(snd-transform walsh-transform d0)
- (if (not (mus-arrays-equal? d0 (float-vector 8.000 0.0 0.0 0.0 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? d0 #r(8.000 0.0 0.0 0.0 0.0 0.0 0.0 0.000)))
(snd-display "walsh -1: ~A" d0)))
(let ((d0 (make-float-vector 8)))
(set! (d0 1) 1.0)
(snd-transform walsh-transform d0)
- (if (not (mus-arrays-equal? d0 (float-vector 1.000 -1.000 1.000 -1.000 1.000 -1.000 1.000 -1.000)))
+ (if (not (mus-arrays-equal? d0 #r(1.000 -1.000 1.000 -1.000 1.000 -1.000 1.000 -1.000)))
(snd-display "walsh 2: ~A" d0))
(snd-transform walsh-transform d0)
- (if (not (mus-arrays-equal? d0 (float-vector 0.0 8.000 0.0 0.0 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? d0 #r(0.0 8.000 0.0 0.0 0.0 0.0 0.0 0.000)))
(snd-display "walsh -2: ~A" d0)))
(let ((d0 (make-float-vector 8)))
(set! (d0 1) 1.0)
(set! (d0 0) 0.5)
(snd-transform walsh-transform d0)
- (if (not (mus-arrays-equal? d0 (float-vector 1.500 -0.500 1.500 -0.500 1.500 -0.500 1.500 -0.500)))
+ (if (not (mus-arrays-equal? d0 #r(1.500 -0.500 1.500 -0.500 1.500 -0.500 1.500 -0.500)))
(snd-display "walsh 3: ~A" d0))
(snd-transform walsh-transform d0)
- (if (not (mus-arrays-equal? d0 (float-vector 4.000 8.000 0.0 0.0 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? d0 #r(4.000 8.000 0.0 0.0 0.0 0.0 0.0 0.000)))
(snd-display "walsh -3: ~A" d0)))
(let ((d0 (make-float-vector 8)))
@@ -34306,17 +34272,17 @@ EDITS: 1
(if (not (mus-arrays-equal? d0 d1))
(snd-display "walsh 4: ~A ~A" d0 d1))))
- (let ((d1 (snd-transform walsh-transform (float-vector 1 1 1 -1 1 1 1 -1 1 1 1 -1 -1 -1 -1 1))))
- (if (not (mus-arrays-equal? d1 (float-vector 4.00 4.00 4.00 -4.00 4.00 4.00 4.00 -4.00 4.00 4.00 4.00 -4.00 -4.00 -4.00 -4.00 4.00)))
+ (let ((d1 (snd-transform walsh-transform #r(1 1 1 -1 1 1 1 -1 1 1 1 -1 -1 -1 -1 1))))
+ (if (not (mus-arrays-equal? d1 #r(4.00 4.00 4.00 -4.00 4.00 4.00 4.00 -4.00 4.00 4.00 4.00 -4.00 -4.00 -4.00 -4.00 4.00)))
(snd-display "walsh 5: ~A" d1)))
- (let ((d1 (snd-transform walsh-transform (float-vector 1 0 0 -1 0 0 0 0 0 0 0 0 0 0 0 0))))
- (if (not (mus-arrays-equal? d1 (float-vector 0.0 2.000 2.000 0.0 0.0 2.000 2.000 0.0 0.0 2.000 2.000 0.0 0.0 2.000 2.000 0.000)))
+ (let ((d1 (snd-transform walsh-transform #r(1 0 0 -1 0 0 0 0 0 0 0 0 0 0 0 0))))
+ (if (not (mus-arrays-equal? d1 #r(0.0 2.000 2.000 0.0 0.0 2.000 2.000 0.0 0.0 2.000 2.000 0.0 0.0 2.000 2.000 0.000)))
(snd-display "walsh 6: ~A" d1)))
(let ((d1 (snd-transform walsh-transform
- (float-vector 0.174 -0.880 -0.555 -0.879 0.038 0.696 -0.612 0.006 -0.613 0.334 -0.111 -0.821 0.130 0.030 -0.229 0.170))))
- (if (not (mus-arrays-equal? d1 (float-vector -3.122 -0.434 2.940 -0.468 -3.580 2.716 -0.178 -1.386 -0.902 0.638 1.196 1.848 -0.956 2.592 -1.046 2.926)))
+ #r(0.174 -0.880 -0.555 -0.879 0.038 0.696 -0.612 0.006 -0.613 0.334 -0.111 -0.821 0.130 0.030 -0.229 0.170))))
+ (if (not (mus-arrays-equal? d1 #r(-3.122 -0.434 2.940 -0.468 -3.580 2.716 -0.178 -1.386 -0.902 0.638 1.196 1.848 -0.956 2.592 -1.046 2.926)))
(snd-display "walsh 7: ~A" d1)))
@@ -34325,32 +34291,32 @@ EDITS: 1
(let ((d0 (make-float-vector 8)))
(set! (d0 2) 1.0)
(snd-transform haar-transform d0)
- (if (not (mus-arrays-equal? d0 (float-vector 0.354 0.354 -0.500 0.0 0.0 0.707 0.0 0.000)))
+ (if (not (mus-arrays-equal? d0 #r(0.354 0.354 -0.500 0.0 0.0 0.707 0.0 0.000)))
(snd-display "haar 1: ~A" d0))
(inverse-haar d0)
- (if (not (mus-arrays-equal? d0 (float-vector 0.0 0.0 1.000 0.0 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? d0 #r(0.0 0.0 1.000 0.0 0.0 0.0 0.0 0.000)))
(snd-display "inverse haar 1: ~A" d0)))
(let ((d0 (make-float-vector 8)))
(set! (d0 0) 1.0)
(snd-transform haar-transform d0)
- (if (not (mus-arrays-equal? d0 (float-vector 0.354 0.354 0.500 0.0 0.707 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? d0 #r(0.354 0.354 0.500 0.0 0.707 0.0 0.0 0.000)))
(snd-display "haar 2: ~A" d0))
(inverse-haar d0)
- (if (not (mus-arrays-equal? d0 (float-vector 1.000 0.0 0.0 0.0 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? d0 #r(1.000 0.0 0.0 0.0 0.0 0.0 0.0 0.000)))
(snd-display "inverse haar 2: ~A" d0)))
- (let ((d0 (snd-transform haar-transform (float-vector -0.483 0.174 -0.880 -0.555 -0.879 0.038 0.696 -0.612))))
- (if (not (mus-arrays-equal? d0 (float-vector -0.884 -0.349 0.563 -0.462 -0.465 -0.230 -0.648 0.925)))
+ (let ((d0 (snd-transform haar-transform #r(-0.483 0.174 -0.880 -0.555 -0.879 0.038 0.696 -0.612))))
+ (if (not (mus-arrays-equal? d0 #r(-0.884 -0.349 0.563 -0.462 -0.465 -0.230 -0.648 0.925)))
(snd-display "haar 3: ~A" d0)))
;; from "A Primer on Wavelets"
(let ((sq2 (sqrt 2.0))
- (d0 (snd-transform haar-transform (float-vector 4 6 10 12 8 6 5 5))))
+ (d0 (snd-transform haar-transform #r(4 6 10 12 8 6 5 5))))
(if (not (mus-arrays-equal? d0 (float-vector (* 14 sq2) (* 2 sq2) -6 2 (- sq2) (- sq2) sq2 0)))
(snd-display "haar 4: ~A" d0))
- (set! d0 (snd-transform haar-transform (float-vector 2 4 6 8 10 12 14 16)))
+ (set! d0 (snd-transform haar-transform #r(2 4 6 8 10 12 14 16)))
(if (not (mus-arrays-equal? d0 (float-vector (* 18 sq2) (* -8 sq2) -4 -4 (- sq2) (- sq2) (- sq2) (- sq2))))
(snd-display "haar 5: ~A" d0)))
@@ -34368,24 +34334,24 @@ EDITS: 1
(let* ((SQRT2 1.41421356237309504880168872420969808)
(SQRT2*3 (* SQRT2 3)))
- (let ((daub4 (float-vector 0.4829629131445341 0.8365163037378079 0.2241438680420134 -0.1294095225512604))
- (daub6 (float-vector 0.332670552950 0.806891509311 0.459877502118 -0.135011020010 -0.085441273882 0.035226291886))
- (daub8 (float-vector 0.230377813309 0.714846570553 0.630880767930 -0.027983769417 -0.187034811719 0.030841381836
+ (let ((daub4 #r(0.4829629131445341 0.8365163037378079 0.2241438680420134 -0.1294095225512604))
+ (daub6 #r(0.332670552950 0.806891509311 0.459877502118 -0.135011020010 -0.085441273882 0.035226291886))
+ (daub8 #r(0.230377813309 0.714846570553 0.630880767930 -0.027983769417 -0.187034811719 0.030841381836
0.032883011667 -0.010597401785))
- (daub10 (float-vector 0.160102397974 0.603829269797 0.724308528438 0.138428145901 -0.242294887066 -0.032244869585
+ (daub10 #r(0.160102397974 0.603829269797 0.724308528438 0.138428145901 -0.242294887066 -0.032244869585
0.077571493840 -0.006241490213 -0.012580751999 0.003335725285))
- (daub12 (float-vector 0.111540743350 0.494623890398 0.751133908021 0.315250351709 -0.226264693965 -0.129766867567
+ (daub12 #r(0.111540743350 0.494623890398 0.751133908021 0.315250351709 -0.226264693965 -0.129766867567
0.097501605587 0.027522865530 -0.031582039317 0.000553842201 0.004777257511 -0.001077301085))
- (daub14 (float-vector 0.077852054085 0.396539319482 0.729132090846 0.469782287405 -0.143906003929 -0.224036184994
+ (daub14 #r(0.077852054085 0.396539319482 0.729132090846 0.469782287405 -0.143906003929 -0.224036184994
0.071309219267 0.080612609151 -0.038029936935 -0.016574541631 0.012550998556 0.000429577973
-0.001801640704 0.000353713800))
- (daub16 (float-vector 0.054415842243 0.312871590914 0.675630736297 0.585354683654 -0.015829105256 -0.284015542962
+ (daub16 #r(0.054415842243 0.312871590914 0.675630736297 0.585354683654 -0.015829105256 -0.284015542962
0.000472484574 0.128747426620 -0.017369301002 -0.044088253931 0.013981027917 0.008746094047
-0.004870352993 -0.000391740373 0.000675449406 -0.000117476784))
- (daub18 (float-vector 0.038077947364 0.243834674613 0.604823123690 0.657288078051 0.133197385825 -0.293273783279
+ (daub18 #r(0.038077947364 0.243834674613 0.604823123690 0.657288078051 0.133197385825 -0.293273783279
-0.096840783223 0.148540749338 0.030725681479 -0.067632829061 0.000250947115 0.022361662124
-0.004723204758 -0.004281503682 0.001847646883 0.000230385764 -0.000251963189 0.000039347320))
- (daub20 (float-vector 0.026670057901 0.188176800077 0.527201188931 0.688459039453 0.281172343661 -0.249846424327
+ (daub20 #r(0.026670057901 0.188176800077 0.527201188931 0.688459039453 0.281172343661 -0.249846424327
-0.195946274377 0.127369340336 0.093057364604 -0.071394147166 -0.029457536822 0.033212674059
0.003606553567 -0.010733175483 0.001395351747 0.001992405295 -0.000685856695 -0.000116466855
0.000093588670 -0.000013264203))
@@ -34396,7 +34362,7 @@ EDITS: 1
(* SQRT2 0.006) (* SQRT2 -0.003) (* SQRT2 -0.002) 0.0))
(Burt-Adelson (float-vector (* SQRT2 (/ -1.0 20.0)) (* SQRT2 (/ 5.0 20.0)) (* SQRT2 (/ 12.0 20.0))
(* SQRT2 (/ 5.0 20.0)) (* SQRT2 (/ -1.0 20.0)) 0.0))
- (Beylkin (float-vector 0.099305765374353 0.424215360812961 0.699825214056600 0.449718251149468
+ (Beylkin #r(0.099305765374353 0.424215360812961 0.699825214056600 0.449718251149468
-.110927598348234 -.264497231446384 0.026900308803690 0.155538731877093
-.017520746266529 -.088543630622924 0.019679866044322 0.042916387274192
-.017460408696028 -.014365807968852 0.010040411844631 .0014842347824723
@@ -34404,10 +34370,10 @@ EDITS: 1
(coif2 (let ((SQRT15 3.87298334620741688517927))
(float-vector (/ (* SQRT2 (- SQRT15 3)) 32.0) (/ (* SQRT2 (- 1 SQRT15)) 32.0) (/ (* SQRT2 (- 6 (* 2 SQRT15))) 32.0)
(/ (* SQRT2 (+ (* 2 SQRT15) 6)) 32.0) (/ (* SQRT2 (+ SQRT15 13)) 32.0) (/ (* SQRT2 (- 9 SQRT15)) 32.0))))
- (coif4 (float-vector 0.0011945726958388 -0.01284557955324 0.024804330519353 0.050023519962135 -0.15535722285996
+ (coif4 #r(0.0011945726958388 -0.01284557955324 0.024804330519353 0.050023519962135 -0.15535722285996
-0.071638282295294 0.57046500145033 0.75033630585287 0.28061165190244 -0.0074103835186718
-0.014611552521451 -0.0013587990591632))
- (coif6 (float-vector -0.0016918510194918 -0.00348787621998426 0.019191160680044 0.021671094636352 -0.098507213321468
+ (coif6 #r(-0.0016918510194918 -0.00348787621998426 0.019191160680044 0.021671094636352 -0.098507213321468
-0.056997424478478 0.45678712217269 0.78931940900416 0.38055713085151 -0.070438748794943
-0.056514193868065 0.036409962612716 0.0087601307091635 -0.011194759273835 -0.0019213354141368
0.0020413809772660 0.00044583039753204 -0.00021625727664696))
@@ -34427,8 +34393,8 @@ EDITS: 1
;; --------- wavelet
;; test against fxt output
- (let ((d0 (snd-transform wavelet-transform (float-vector 1 1 0 0 0 0 0 0) 0))) ;"daub4"
- (if (not (mus-arrays-equal? d0 (float-vector 0.625 0.375 -0.217 1.083 -0.354 0.0 0.0 0.354)))
+ (let ((d0 (snd-transform wavelet-transform #r(1 1 0 0 0 0 0 0) 0))) ;"daub4"
+ (if (not (mus-arrays-equal? d0 #r(0.625 0.375 -0.217 1.083 -0.354 0.0 0.0 0.354)))
(snd-display "fxt wavelet 1: ~A" d0)))
(let ((wts (vector daub4 daub6 daub8 daub10 daub12 daub14 daub16 daub18 daub20
@@ -34436,41 +34402,41 @@ EDITS: 1
sym2 sym3 sym4 sym5 sym6)))
(for-each
(lambda (size)
- (do ((i 0 (+ i 1)))
+ (do ((i 0 (+ i 1))
+ (d1 (make-float-vector size) (make-float-vector size))
+ (d2 (make-float-vector size) (make-float-vector size)))
((= i 20))
- (let ((d1 (make-float-vector size))
- (d2 (make-float-vector size)))
- (set! (d1 2) 1.0)
- (set! (d2 2) 1.0)
- (wavelet d1 size 0 pwt (wts i))
- (snd-transform wavelet-transform d2 i)
- (if (not (mus-arrays-equal? d1 d2))
- (snd-display "wavelet ~D: ~A ~A" i d1 d2))
- (wavelet d2 size -1 pwt (wts i))
- (fill! d1 0.0)
- (set! (d1 2) 1.0)
- (if (not (mus-arrays-equal? d1 d2))
- (if (memv i '(9 10))
- (begin
- (set! (d2 2) 0.0)
- (if (> (float-vector-peak d2) .1)
- (snd-display "inverse wavelet ~D: ~A ~A" i d1 d2)))
- (if (> i 14)
- (let ((pk (d2 2)))
- (set! (d2 2) 0.0)
- (if (> (float-vector-peak d2) pk)
- (snd-display "inverse wavelet ~D: ~A ~A" i d1 d2)))
- (snd-display "inverse wavelet ~D: ~A ~A" i d1 d2))))))
- (do ((i 0 (+ i 1)))
+ (set! (d1 2) 1.0)
+ (set! (d2 2) 1.0)
+ (wavelet d1 size 0 pwt (wts i))
+ (snd-transform wavelet-transform d2 i)
+ (if (not (mus-arrays-equal? d1 d2))
+ (snd-display "wavelet ~D: ~A ~A" i d1 d2))
+ (wavelet d2 size -1 pwt (wts i))
+ (fill! d1 0.0)
+ (set! (d1 2) 1.0)
+ (if (not (mus-arrays-equal? d1 d2))
+ (if (memv i '(9 10))
+ (begin
+ (set! (d2 2) 0.0)
+ (if (> (float-vector-peak d2) .1)
+ (snd-display "inverse wavelet ~D: ~A ~A" i d1 d2)))
+ (if (> i 14)
+ (let ((pk (d2 2)))
+ (set! (d2 2) 0.0)
+ (if (> (float-vector-peak d2) pk)
+ (snd-display "inverse wavelet ~D: ~A ~A" i d1 d2)))
+ (snd-display "inverse wavelet ~D: ~A ~A" i d1 d2)))))
+ (do ((i 0 (+ i 1))
+ (d1 #f)
+ (d2 (make-float-vector size)))
((= i 9))
- (let ((d1 #f)
- (d2 (make-float-vector size)))
- (fill-float-vector d2 (random 1.0))
- (set! d1 (copy d2))
- (snd-transform wavelet-transform d2 i)
- (wavelet d2 size -1 pwt (wts i))
- (if (not (mus-arrays-equal? d1 d2))
- (snd-display "random wavelet ~D: ~A ~A" i d1 d2)))))
+ (fill-float-vector d2 (random 1.0))
+ (set! d1 (copy d2))
+ (snd-transform wavelet-transform d2 i)
+ (wavelet d2 size -1 pwt (wts i))
+ (if (not (mus-arrays-equal? d1 d2))
+ (snd-display "random wavelet ~D: ~A ~A" i d1 d2))))
'(16 64)))))
(set! *max-transform-peaks* 100)
@@ -34733,7 +34699,7 @@ EDITS: 1
(close-sound ind))
(let ((v (dolph 16 2.5)))
- (if (not (mus-arrays-equal? v (float-vector 0.097 0.113 0.221 0.366 0.536 0.709 0.860 0.963 1.000 0.963 0.860 0.709 0.536 0.366 0.221 0.113)))
+ (if (not (mus-arrays-equal? v #r(0.097 0.113 0.221 0.366 0.536 0.709 0.860 0.963 1.000 0.963 0.860 0.709 0.536 0.366 0.221 0.113)))
(snd-display "dolph 16 2.5 (dsp.scm): ~A" v)))
(let ((v (make-float-vector 8)))
@@ -34748,7 +34714,7 @@ EDITS: 1
(fill! v 0.0)
(set! (v 1) 1.0)
(set! v (dht v))
- (if (not (mus-arrays-equal? v (float-vector 1.000 1.414 1.000 0.0 -1.000 -1.414 -1.000 0.000)))
+ (if (not (mus-arrays-equal? v #r(1.000 1.414 1.000 0.0 -1.000 -1.414 -1.000 0.000)))
(snd-display "dht of pulse: ~A" v)))
(let ((ind (open-sound "oboe.snd")))
@@ -34790,53 +34756,53 @@ EDITS: 1
(if (fneq valf3 valg3) (snd-display "goertzel 3: ~A ~A" valf3 valg3))
(close-sound ind))
- (let ((v (float-vector-polynomial (float-vector 0.0 2.0) (float-vector 1.0 2.0))))
- (if (not (mus-arrays-equal? v (float-vector 1.0 5.0)))
+ (let ((v (float-vector-polynomial #r(0.0 2.0) #r(1.0 2.0))))
+ (if (not (mus-arrays-equal? v #r(1.0 5.0)))
(snd-display "float-vector-polynomial 0: ~A" v)))
- (let ((v (float-vector-polynomial (float-vector 0 1 2) (float-vector 0 2 1))))
- (if (not (mus-arrays-equal? v (float-vector 0.0 3.000 8.000)))
+ (let ((v (float-vector-polynomial #r(0 1 2) #r(0 2 1))))
+ (if (not (mus-arrays-equal? v #r(0.0 3.000 8.000)))
(snd-display "float-vector-polynomial 1: ~A" v)))
- (let ((v (float-vector-polynomial (float-vector 0 1 2) (float-vector 0 2 1 .5))))
- (if (not (mus-arrays-equal? v (float-vector 0.0 3.500 12.000)))
+ (let ((v (float-vector-polynomial #r(0 1 2) #r(0 2 1 .5))))
+ (if (not (mus-arrays-equal? v #r(0.0 3.500 12.000)))
(snd-display "float-vector-polynomial 2: ~A" v)))
- (let ((v (float-vector-polynomial (float-vector 0 1 2) (float-vector 1))))
- (if (not (mus-arrays-equal? v (float-vector 1 1 1)))
+ (let ((v (float-vector-polynomial #r(0 1 2) #r(1))))
+ (if (not (mus-arrays-equal? v #r(1 1 1)))
(snd-display "float-vector-polynomial 3: ~A" v)))
(let ((ind (open-sound "pistol.snd")))
(let ((mx (maxamp ind 0)))
- (channel-polynomial (float-vector 0.0 2.0) ind 0)
+ (channel-polynomial #r(0.0 2.0) ind 0)
(if (fneq (maxamp) (* mx 2))
(snd-display "channel-polynomial 2: ~A" (maxamp))))
(undo)
- (channel-polynomial (float-vector 0.0 0.5 0.25 0.25) ind 0)
+ (channel-polynomial #r(0.0 0.5 0.25 0.25) ind 0)
(if (fneq (maxamp) .222)
(snd-display "channel-polynomial 3: ~A" (maxamp)))
(undo)
- (channel-polynomial (float-vector 0.0 0.0 1.0) ind 0)
+ (channel-polynomial #r(0.0 0.0 1.0) ind 0)
(let ((pos (scan-channel (lambda (y) (< y 0.0)))))
(if pos
(snd-display "channel-polynomial squares: ~A" pos)))
(undo)
- (channel-polynomial (float-vector 0.5 1.0) ind 0)
+ (channel-polynomial #r(0.5 1.0) ind 0)
(let ((pos (scan-channel (lambda (y) (< y 0.0)))))
(if pos
(snd-display "channel-polynomial offset: ~A" pos)))
(if (fneq (maxamp) .8575)
(snd-display "channel-polynomial off mx: ~A" (maxamp)))
(undo)
- (spectral-polynomial (float-vector 0.0 1.0) ind 0)
+ (spectral-polynomial #r(0.0 1.0) ind 0)
(if (fneq (maxamp) .493)
(snd-display "spectral-polynomial 0 mx: ~A" (maxamp)))
(if (not (= (framples ind 0) 41623))
(snd-display "spectral-polynomial 0 len: ~A" (framples)))
(undo)
- (spectral-polynomial (float-vector 0.0 0.5 0.5) ind 0)
+ (spectral-polynomial #r(0.0 0.5 0.5) ind 0)
(if (fneq (maxamp) .493)
(snd-display "spectral-polynomial 1: ~A" (maxamp)))
(if (not (= (framples ind 0) 83246)) ;(* 2 41623)
(snd-display "spectral-polynomial 1 len: ~A" (framples)))
(undo)
- (spectral-polynomial (float-vector 0.0 0.0 0.0 1.0) ind 0)
+ (spectral-polynomial #r(0.0 0.0 0.0 1.0) ind 0)
(if (fneq (maxamp) .493)
(snd-display "spectral-polynomial 2: ~A" (maxamp)))
(if (not (= (framples ind 0) 124869)) ;(* 3 41623)
@@ -34847,14 +34813,14 @@ EDITS: 1
(if (or (fneq (vals 0) 1876.085) (fneq (vals 1) 1447.004))
(snd-display "scentroid: ~A" vals)))
- (let ((flt (make-fir-filter 3 (float-vector 0.5 0.25 0.125)))
+ (let ((flt (make-fir-filter 3 #r(0.5 0.25 0.125)))
(data (make-float-vector 10))
(undata (make-float-vector 10)))
(set! (data 0) 1.0)
(do ((i 0 (+ i 1)))
((= i 10))
(set! (undata i) (fir-filter flt (data i))))
- (let ((fdata (invert-filter (float-vector 0.5 0.25 0.125))))
+ (let ((fdata (invert-filter #r(0.5 0.25 0.125))))
(set! flt (make-fir-filter (length fdata) fdata))
(do ((i 0 (+ i 1)))
((= i 10))
@@ -34882,50 +34848,50 @@ EDITS: 1
(if (not (mus-arrays-equal? undata data))
(snd-display "invert-filter (6): ~A" undata)))))
- (let ((flt (make-volterra-filter (float-vector 1.0 .4) (float-vector .3 .2 .1)))
+ (let ((flt (make-volterra-filter #r(1.0 .4) #r(.3 .2 .1)))
(data (make-float-vector 10))
(x 0.0))
(do ((i 0 (+ i 1)))
((= i 10))
(set! (data i) (volterra-filter flt x))
(set! x (if (= i 0) 0.5 0.0)))
- (if (not (mus-arrays-equal? data (float-vector 0.0 0.575 0.250 0.025 0.0 0.0 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? data #r(0.0 0.575 0.250 0.025 0.0 0.0 0.0 0.0 0.0 0.000)))
(snd-display "volterra-filter: ~A" data)))
- (let ((flt (make-volterra-filter (float-vector 1.0) (float-vector 1.0)))
+ (let ((flt (make-volterra-filter #r(1.0) #r(1.0)))
(data (make-float-vector 10)))
(do ((i 0 (+ i 1))
(x 1.0 0.0))
((= i 10))
(set! (data i) (volterra-filter flt x)))
- (if (not (mus-arrays-equal? data (float-vector 2.000 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? data #r(2.000 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.000)))
(snd-display "volterra-filter x + x^2: ~A" data)))
- (let ((flt (make-volterra-filter (float-vector 1.0) (float-vector 1.0)))
+ (let ((flt (make-volterra-filter #r(1.0) #r(1.0)))
(data (make-float-vector 10)))
(do ((i 0 (+ i 1))
(x 1.0 (- x 0.1)))
((= i 10))
(set! (data i) (volterra-filter flt x)))
- (if (not (mus-arrays-equal? data (float-vector 2.000 1.710 1.440 1.190 0.960 0.750 0.560 0.390 0.240 0.110)))
+ (if (not (mus-arrays-equal? data #r(2.000 1.710 1.440 1.190 0.960 0.750 0.560 0.390 0.240 0.110)))
(snd-display "volterra-filter x + x^2 by -0.1: ~A" data)))
- (let ((flt (make-volterra-filter (float-vector 1.0 0.5) (float-vector 1.0)))
+ (let ((flt (make-volterra-filter #r(1.0 0.5) #r(1.0)))
(data (make-float-vector 10)))
(do ((i 0 (+ i 1))
(x 1.0 0.0))
((= i 10))
(set! (data i) (volterra-filter flt x)))
- (if (not (mus-arrays-equal? data (float-vector 2.000 0.500 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? data #r(2.000 0.500 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.000)))
(snd-display "volterra-filter x + .5x(n-1) + x^2: ~A" data)))
- (let ((flt (make-volterra-filter (float-vector 1.0 0.5) (float-vector 1.0 0.6)))
+ (let ((flt (make-volterra-filter #r(1.0 0.5) #r(1.0 0.6)))
(data (make-float-vector 10)))
(do ((i 0 (+ i 1))
(x 0.9 0.0))
((= i 10))
(set! (data i) (volterra-filter flt x)))
- (if (not (mus-arrays-equal? data (float-vector 1.710 0.936 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? data #r(1.710 0.936 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.000)))
(snd-display "volterra-filter x + .5x(n-1) + x^2 + 0.6: ~A" data)))
@@ -34953,8 +34919,8 @@ EDITS: 1
(d1 (make-float-vector 8)))
(set! (d0 2) 1.0)
(let ((vals (fractional-fourier-transform d0 d1 8 1.0)))
- (if (not (and (mus-arrays-equal? (car vals) (float-vector 1.000 0.0 -1.000 0.0 1.000 0.0 -1.000 -0.000))
- (mus-arrays-equal? (cadr vals) (float-vector 0.0 1.000 0.0 -1.000 0.0 1.000 0.0 -1.000))))
+ (if (not (and (mus-arrays-equal? (car vals) #r(1.000 0.0 -1.000 0.0 1.000 0.0 -1.000 -0.000))
+ (mus-arrays-equal? (cadr vals) #r(0.0 1.000 0.0 -1.000 0.0 1.000 0.0 -1.000))))
(snd-display "fractional-fft: ~A?" vals))))
(let ((d0 (make-float-vector 8))
@@ -34964,8 +34930,8 @@ EDITS: 1
((= i 8))
(set! (d0 i) (real-part (vector-ref val i)))
(set! (d1 i) (imag-part (vector-ref val i))))
- (if (not (and (mus-arrays-equal? d0 (float-vector 1.000 0.0 -1.000 0.0 1.000 0.0 -1.000 -0.000))
- (mus-arrays-equal? d1 (float-vector 0.0 1.000 0.0 -1.000 0.0 1.000 0.0 -1.000))))
+ (if (not (and (mus-arrays-equal? d0 #r(1.000 0.0 -1.000 0.0 1.000 0.0 -1.000 -0.000))
+ (mus-arrays-equal? d1 #r(0.0 1.000 0.0 -1.000 0.0 1.000 0.0 -1.000))))
(snd-display "z-transform: ~A ~A?" d0 d1))))
(let ((v1 (make-float-vector 16)))
@@ -34979,18 +34945,18 @@ EDITS: 1
(set! (v1 0) 0.0)
(set! (v1 1) 1.0)
(let ((res (z-transform v1 16 0.5)))
- (if (not (mus-arrays-equal? res (float-vector 1.000 0.500 0.250 0.125 0.062 0.031 0.016 0.008 0.004 0.002 0.001 0.0 0.0 0.0 0.0 0.0)))
+ (if (not (mus-arrays-equal? res #r(1.000 0.500 0.250 0.125 0.062 0.031 0.016 0.008 0.004 0.002 0.001 0.0 0.0 0.0 0.0 0.0)))
(snd-display "z 0.5 1=1: ~A" res)))
(let ((res (z-transform v1 16 2.0)))
- (if (not (mus-arrays-equal? res (float-vector 1.0 2.0 4.0 8.0 16.0 32.0 64.0 128.0 256.0 512.0 1024.0
+ (if (not (mus-arrays-equal? res #r(1.0 2.0 4.0 8.0 16.0 32.0 64.0 128.0 256.0 512.0 1024.0
2048.0 4096.0 8192.0 16384.0 32768.0)))
(snd-display "z 2.0 1=1: ~A" res)))
(set! (v1 2) 1.0)
(let ((res (z-transform v1 16 0.5)))
- (if (not (mus-arrays-equal? res (float-vector 2.0 0.75 0.3125 0.140 0.0664 0.0322 0.0158 0.00787 0.0039 0.0019 0 0 0 0 0 0)))
+ (if (not (mus-arrays-equal? res #r(2.0 0.75 0.3125 0.140 0.0664 0.0322 0.0158 0.00787 0.0039 0.0019 0 0 0 0 0 0)))
(snd-display "z 0.5 1=1 2=1: ~A" res)))
(let ((res (z-transform v1 16 2.0)))
- (if (not (mus-arrays-equal? res (float-vector 2.0 6.0 20.0 72.0 272.0 1056.0 4160.0 16512.0 65792.0
+ (if (not (mus-arrays-equal? res #r(2.0 6.0 20.0 72.0 272.0 1056.0 4160.0 16512.0 65792.0
262656.0 1049600.0 4196352.0 16781312.0 67117056.0 268451840.0 1073774592.0)))
(snd-display "z 2.0 1=1 2=1: ~A" res)))
(do ((i 0 (+ i 1))
@@ -35275,11 +35241,11 @@ EDITS: 1
(let ((pe (make-power-env '(0 0 32.0 1 1 0.0312 2 0 1) :duration (/ 34.0 22050.0))))
(map-channel (lambda (y) (* y (power-env pe))))
(if (not (or (mus-arrays-equal?1 (channel->float-vector)
- (float-vector 0.0 0.008 0.017 0.030 0.044 0.063 0.086 0.115 0.150 0.194 0.249
+ #r(0.0 0.008 0.017 0.030 0.044 0.063 0.086 0.115 0.150 0.194 0.249
0.317 0.402 0.507 0.637 0.799 1.000 0.992 0.983 0.971 0.956 0.937
0.914 0.885 0.850 0.806 0.751 0.683 0.598 0.493 0.363 0.201 0.000))
(mus-arrays-equal?1 (channel->float-vector)
- (float-vector 0.0 0.008 0.019 0.032 0.049 0.070 0.097 0.130 0.173 0.226 0.293
+ #r(0.0 0.008 0.019 0.032 0.049 0.070 0.097 0.130 0.173 0.226 0.293
0.377 0.484 0.618 0.787 1.000 0.992 0.981 0.968 0.951 0.930 0.903
0.870 0.828 0.774 0.707 0.623 0.516 0.382 0.213 0.0 0.0 0.000))))
(snd-display "power-env: ~A" (channel->float-vector))))
@@ -35287,7 +35253,7 @@ EDITS: 1
(let ((pe (make-power-env '(0 0 1.0 1 1 0.0 2 0 1 3 0 1) :duration (/ 34.0 22050.0))))
(map-channel (lambda (y) (* y (power-env pe))))
(if (not (mus-arrays-equal?1 (channel->float-vector)
- (float-vector 0.0 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000
+ #r(0.0 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000
1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 0.0 0.0
0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.000)))
(snd-display "power-env 0 and 1: ~A" (channel->float-vector))))
@@ -35295,11 +35261,11 @@ EDITS: 1
(let ((pe (make-power-env '(0 0 .01 1 1 1) :duration (/ 34.0 22050.0))))
(map-channel (lambda (y) (* y (power-env pe))))
(if (not (or (mus-arrays-equal?1 (channel->float-vector)
- (float-vector 0.0 0.132 0.246 0.346 0.432 0.507 0.573 0.630 0.679 0.722 0.760
+ #r(0.0 0.132 0.246 0.346 0.432 0.507 0.573 0.630 0.679 0.722 0.760
0.792 0.821 0.845 0.867 0.886 0.902 0.916 0.928 0.939 0.948 0.956
0.963 0.969 0.975 0.979 0.983 0.987 0.990 0.992 0.995 0.997 0.998))
(mus-arrays-equal?1 (channel->float-vector)
- (float-vector 0.0 0.135 0.253 0.354 0.442 0.518 0.584 0.641 0.691 0.733 0.771
+ #r(0.0 0.135 0.253 0.354 0.442 0.518 0.584 0.641 0.691 0.733 0.771
0.803 0.830 0.855 0.875 0.893 0.909 0.923 0.934 0.945 0.953 0.961
0.968 0.973 0.978 0.982 0.986 0.987 0.990 0.992 0.995 0.997 0.998))))
(snd-display "power-env .01: ~A" (channel->float-vector))))
@@ -35307,36 +35273,36 @@ EDITS: 1
(let ((ind (new-sound "tmp.snd" 1 22050 mus-ldouble mus-next :size 50)))
(set! (sample 3) 1.0)
- (filter-channel (float-vector .5 1.0 .5) 3)
+ (filter-channel #r(.5 1.0 .5) 3)
(let ((data (channel->float-vector 0 10)))
- (if (not (mus-arrays-equal? data (float-vector 0.0 0.0 0.0 0.500 1.000 0.500 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? data #r(0.0 0.0 0.0 0.500 1.000 0.500 0.0 0.0 0.0 0.000)))
(snd-display "filter (sym 3): ~A" data)))
(undo)
- (filter-channel (float-vector .5 1.0 .25) 3)
+ (filter-channel #r(.5 1.0 .25) 3)
(let ((data (channel->float-vector 0 10)))
- (if (not (mus-arrays-equal? data (float-vector 0.0 0.0 0.0 0.500 1.000 0.250 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? data #r(0.0 0.0 0.0 0.500 1.000 0.250 0.0 0.0 0.0 0.000)))
(snd-display "filter (3): ~A" data)))
(undo)
- (filter-channel (float-vector .5 1.0 1.0 .5) 4)
+ (filter-channel #r(.5 1.0 1.0 .5) 4)
(let ((data (channel->float-vector 0 10)))
- (if (not (mus-arrays-equal? data (float-vector 0.0 0.0 0.0 0.500 1.000 1.000 0.500 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? data #r(0.0 0.0 0.0 0.500 1.000 1.000 0.500 0.0 0.0 0.000)))
(snd-display "filter (sym 4): ~A" data)))
(undo)
- (filter-channel (float-vector .5 1.0 1.0 .25) 4)
+ (filter-channel #r(.5 1.0 1.0 .25) 4)
(let ((data (channel->float-vector 0 10)))
- (if (not (mus-arrays-equal? data (float-vector 0.0 0.0 0.0 0.500 1.000 1.000 0.250 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? data #r(0.0 0.0 0.0 0.500 1.000 1.000 0.250 0.0 0.0 0.000)))
(snd-display "filter (4): ~A" data)))
(undo)
(close-sound ind))
(new-sound "tmp.snd" 1 22050 mus-ldouble mus-next #f 100)
(set! (sample 10) 0.5)
- (filter-sound (float-vector 1.0 0.0 1.0) 3)
- (if (not (mus-arrays-equal? (channel->float-vector 5 10) (float-vector 0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.500 0.0 0.000)))
+ (filter-sound #r(1.0 0.0 1.0) 3)
+ (if (not (mus-arrays-equal? (channel->float-vector 5 10) #r(0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.500 0.0 0.000)))
(snd-display "filter-sound 1 0 1: ~A" (channel->float-vector 5 10)))
(undo)
- (filter-channel (float-vector 1.0 0.0 1.0) 3)
- (if (not (mus-arrays-equal? (channel->float-vector 5 10) (float-vector 0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.500 0.0 0.000)))
+ (filter-channel #r(1.0 0.0 1.0) 3)
+ (if (not (mus-arrays-equal? (channel->float-vector 5 10) #r(0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.500 0.0 0.000)))
(snd-display "filter-channel (v) 1 0 1: ~A" (channel->float-vector 5 10)))
(undo)
(filter-sound '(0 1 1 1) 100)
@@ -35350,7 +35316,7 @@ EDITS: 1
(set! happy #f))))
(undo)
(filter-sound '(0 1 1 1) 1000)
- (if (not (mus-arrays-equal? (channel->float-vector 5 10) (float-vector 0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? (channel->float-vector 5 10) #r(0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.0 0.0 0.000)))
(snd-display "filter-sound 1 (1000): ~A" (channel->float-vector 5 10)))
(undo)
(make-selection 5 15)
@@ -35363,7 +35329,7 @@ EDITS: 1
(filter-selection '(0 1 1 1) 100 #f)
(if (not (equal? (edit-fragment 2) '("filter-selection '(0.000 1.000 1.000 1.000) 100" "set" 5 111)))
(snd-display "filter-selection not truncated: ~S" (edit-fragment 2)))
- (if (not (mus-arrays-equal? (channel->float-vector 50 10) (float-vector -0.016 0.018 -0.021 0.024 -0.029 0.035 -0.045 0.064 -0.106 0.318)))
+ (if (not (mus-arrays-equal? (channel->float-vector 50 10) #r(-0.016 0.018 -0.021 0.024 -0.029 0.035 -0.045 0.064 -0.106 0.318)))
(snd-display "filter-selection no trunc: ~A" (channel->float-vector 50 10)))
(undo)
(filter-selection '(0 1 1 1) 1024 #t)
@@ -35375,26 +35341,26 @@ EDITS: 1
(if (not (equal? (edit-fragment 2) '("filter-selection '(0.000 1.000 1.000 1.000) 1024" "set" 5 1035)))
(snd-display "filter-selection not truncated (1000): ~S" (edit-fragment 2)))
(if (fneq (maxamp) 0.318) (snd-display "filter-selection 1000 no trunc? ~A" (maxamp)))
- (if (not (mus-arrays-equal? (channel->float-vector 517 10) (float-vector 0.035 -0.045 0.064 -0.106 0.318 0.318 -0.106 0.064 -0.045 0.035)))
+ (if (not (mus-arrays-equal? (channel->float-vector 517 10) #r(0.035 -0.045 0.064 -0.106 0.318 0.318 -0.106 0.064 -0.045 0.035)))
(snd-display "filter-selection 1000 no trunc: ~A" (channel->float-vector 505 10)))
(undo)
(filter-channel '(0 1 1 1) 10)
- (if (not (mus-arrays-equal? (channel->float-vector 10 10) (float-vector 0.008 -0.025 0.050 -0.098 0.316 0.316 -0.098 0.050 -0.025 0.008)))
+ (if (not (mus-arrays-equal? (channel->float-vector 10 10) #r(0.008 -0.025 0.050 -0.098 0.316 0.316 -0.098 0.050 -0.025 0.008)))
(snd-display "filter-channel 10: ~A" (channel->float-vector 10 10)))
(undo)
(filter-channel '(0 1 1 1) 1000)
- (if (not (mus-arrays-equal? (channel->float-vector 5 10) (float-vector 0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? (channel->float-vector 5 10) #r(0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.0 0.0 0.000)))
(snd-display "filter-channel 1 (1000): ~A" (channel->float-vector 5 10)))
(undo)
(filter-channel '(0 1 1 0) 10)
- (if (not (mus-arrays-equal? (channel->float-vector 0 30) (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.000
+ (if (not (mus-arrays-equal? (channel->float-vector 0 30) #r(0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.000
0.005 0.010 0.006 0.038 0.192 0.192 0.038 0.006 0.010 0.005
0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.000)))
(snd-display "filter-channel lp: ~A ~A ~A" (channel->float-vector 0 10) (channel->float-vector 10 10) (channel->float-vector 20 10)))
(undo)
(filter-channel '(0 1 1 0) 10 0 20 #f #f #f #f)
- (if (not (mus-arrays-equal? (channel->float-vector 0 30) (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.000
+ (if (not (mus-arrays-equal? (channel->float-vector 0 30) #r(0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.000
0.005 0.010 0.006 0.038 0.192 0.192 0.038 0.006 0.010 0.005
0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.000)))
(snd-display "filter-channel lp no trunc: ~A ~A ~A" (channel->float-vector 0 10) (channel->float-vector 10 10) (channel->float-vector 20 10)))
@@ -35405,43 +35371,43 @@ EDITS: 1
(set! (sample 10) 0.5)
(set! (sample 5 ind 1) -0.5)
(set! (sync ind) 1)
- (filter-sound (float-vector 1.0 0.0 1.0) 3)
- (if (not (mus-arrays-equal? (channel->float-vector 5 10 ind 0) (float-vector 0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.500 0.0 0.000)))
+ (filter-sound #r(1.0 0.0 1.0) 3)
+ (if (not (mus-arrays-equal? (channel->float-vector 5 10 ind 0) #r(0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.500 0.0 0.000)))
(snd-display "(2) filter-sound 1 0 1: ~A" (channel->float-vector 5 10)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 1) (float-vector 0.0 0.0 0.0 0.0 0.0 -0.500 0.0 -0.500 0.0 0.000)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 1) #r(0.0 0.0 0.0 0.0 0.0 -0.500 0.0 -0.500 0.0 0.000)))
(snd-display "(2) filter-sound 1 0 2: ~A" (channel->float-vector 0 10 ind 1)))
(undo)
(filter-sound '(0 1 1 1) 1000)
- (if (not (mus-arrays-equal? (channel->float-vector 5 10 ind 0) (float-vector 0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? (channel->float-vector 5 10 ind 0) #r(0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.0 0.0 0.000)))
(snd-display "(2) filter-sound 1 (1000): ~A" (channel->float-vector 5 10)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 1) (float-vector 0.0 0.0 0.0 0.0 0.0 -0.500 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 1) #r(0.0 0.0 0.0 0.0 0.0 -0.500 0.0 0.0 0.0 0.000)))
(snd-display "(2) filter-sound 2 (1000): ~A" (channel->float-vector 0 10)))
(undo)
(make-selection 0 20)
- (filter-selection (float-vector 1.0 0.0 1.0) 3)
- (if (not (mus-arrays-equal? (channel->float-vector 5 10 ind 0) (float-vector 0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.500 0.0 0.000)))
+ (filter-selection #r(1.0 0.0 1.0) 3)
+ (if (not (mus-arrays-equal? (channel->float-vector 5 10 ind 0) #r(0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.500 0.0 0.000)))
(snd-display "(2) filter-selection 1 0 1: ~A" (channel->float-vector 5 10)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 1) (float-vector 0.0 0.0 0.0 0.0 0.0 -0.500 0.0 -0.500 0.0 0.000)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 1) #r(0.0 0.0 0.0 0.0 0.0 -0.500 0.0 -0.500 0.0 0.000)))
(snd-display "(2) filter-selection 1 0 2: ~A" (channel->float-vector 0 10 ind 1)))
(undo)
(set! (sync ind) 0)
- (filter-selection (float-vector 1.0 0.0 1.0) 3)
- (if (not (mus-arrays-equal? (channel->float-vector 5 10 ind 0) (float-vector 0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.500 0.0 0.000)))
+ (filter-selection #r(1.0 0.0 1.0) 3)
+ (if (not (mus-arrays-equal? (channel->float-vector 5 10 ind 0) #r(0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.500 0.0 0.000)))
(snd-display "(2) filter-selection 1 0 1 (no sync): ~A" (channel->float-vector 5 10)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 1) (float-vector 0.0 0.0 0.0 0.0 0.0 -0.500 0.0 -0.500 0.0 0.000)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 1) #r(0.0 0.0 0.0 0.0 0.0 -0.500 0.0 -0.500 0.0 0.000)))
(snd-display "(2) filter-selection 1 0 2 (no sync): ~A" (channel->float-vector 0 10 ind 1)))
(undo 1 ind 0)
(undo 1 ind 1)
(if (not (= (edit-position ind 0) 1)) (snd-display "edpos filter-sel undo: ~A" (edit-position ind 0)))
(if (not (= (edit-position ind 1) 1)) (snd-display "edpos filter-sel undo 1: ~A" (edit-position ind 1)))
- (filter-sound (float-vector 1.0 0.0 1.0) 3)
- (if (not (mus-arrays-equal? (channel->float-vector 5 10 ind 0) (float-vector 0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.500 0.0 0.000)))
+ (filter-sound #r(1.0 0.0 1.0) 3)
+ (if (not (mus-arrays-equal? (channel->float-vector 5 10 ind 0) #r(0.0 0.0 0.0 0.0 0.0 0.500 0.0 0.500 0.0 0.000)))
(snd-display "(2) filter-sound 1 0 1 no sync: ~A" (channel->float-vector 5 10)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 1) (float-vector 0.0 0.0 0.0 0.0 0.0 -0.500 0.0 0.0 0.0 0.000)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 10 ind 1) #r(0.0 0.0 0.0 0.0 0.0 -0.500 0.0 0.0 0.0 0.000)))
(snd-display "(2) filter-sound 1 0 2 no sync: ~A" (channel->float-vector 0 10 ind 1)))
(undo 1 ind 0)
(filter-channel '(0 1 1 0) 10 #f #f ind 1)
- (if (not (mus-arrays-equal? (channel->float-vector 0 30 ind 1) (float-vector 0.0 0.0 0.0 0.0 0.000; 0.0 0.0 0.0 0.0 0.000
+ (if (not (mus-arrays-equal? (channel->float-vector 0 30 ind 1) #r(0.0 0.0 0.0 0.0 0.000; 0.0 0.0 0.0 0.0 0.000
-0.005 -0.010 -0.006 -0.038 -0.192 -0.192 -0.038 -0.006 -0.010 -0.005
0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.000
0 0 0 0 0)))
@@ -35749,7 +35715,7 @@ EDITS: 1
(list
(list filter-control-in-dB 'filter-control-in-dB ind-1 ind-2 #t eq? equal?)
(list filter-control-in-hz 'filter-control-in-hz ind-1 ind-2 #t eq? equal?)
- (list show-controls 'show-controls ind-1 ind-2 #t eq? equal?)
+ ;(list show-controls 'show-controls ind-1 ind-2 #t eq? equal?)
(list speed-control-tones 'speed-control-tones ind-1 ind-2 14 = equal?)
(list speed-control-style 'speed-control-style ind-1 ind-2 speed-control-as-semitone = equal?)
@@ -35815,45 +35781,45 @@ EDITS: 1
(map-channel (lambda (y) 1.0))
(env-channel-with-base '(0 0 1 1) 1.0)
(let ((data (channel->float-vector 0 20)))
- (if (not (mus-arrays-equal? data (float-vector 0.0 0.05 0.10 0.15 0.20 0.25 0.30 0.35 0.40 0.45 0.50 0.55 0.60 0.65 0.70 0.75 0.80 0.85 0.90 0.95)))
+ (if (not (mus-arrays-equal? data #r(0.0 0.05 0.10 0.15 0.20 0.25 0.30 0.35 0.40 0.45 0.50 0.55 0.60 0.65 0.70 0.75 0.80 0.85 0.90 0.95)))
(snd-display "env-chan 1.0: ~A" data)))
(undo)
(env-channel-with-base '(0 0 1 1 2 1 3 0) 0.0)
(let ((data (channel->float-vector 0 20)))
- (if (not (mus-arrays-equal? data (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0)))
+ (if (not (mus-arrays-equal? data #r(0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0)))
(snd-display "env-chan 0.0: ~A" data)))
(undo)
(env-channel-with-base '(0 0 1 1) 100.0)
(let ((data (channel->float-vector 0 20)))
- (if (not (mus-arrays-equal? data (float-vector 0.0 0.003 0.006 0.010 0.015 0.022 0.030 0.041 0.054 0.070
+ (if (not (mus-arrays-equal? data #r(0.0 0.003 0.006 0.010 0.015 0.022 0.030 0.041 0.054 0.070
0.091 0.117 0.150 0.191 0.244 0.309 0.392 0.496 0.627 0.792)))
(snd-display "env-chan 100.0: ~A" data)))
(undo)
(env-channel-with-base '(0 0 1 1) 0.01)
(let ((data (channel->float-vector 0 20)))
- (if (not (mus-arrays-equal? data (float-vector 0.0 0.208 0.373 0.504 0.608 0.691 0.756 0.809 0.850 0.883
+ (if (not (mus-arrays-equal? data #r(0.0 0.208 0.373 0.504 0.608 0.691 0.756 0.809 0.850 0.883
0.909 0.930 0.946 0.959 0.970 0.978 0.985 0.990 0.994 0.997)))
(snd-display "env-chan 0.01: ~A" data)))
(undo)
(env-channel-with-base '(0 0 1 1) 1.0 5 10)
(let ((data (channel->float-vector 0 20)))
- (if (not (mus-arrays-equal? data (float-vector 1.0 1.0 1.0 1.0 1.0 0.0 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.0 1.0 1.0 1.0 1.0 1.0)))
+ (if (not (mus-arrays-equal? data #r(1.0 1.0 1.0 1.0 1.0 0.0 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.0 1.0 1.0 1.0 1.0 1.0)))
(snd-display "env-chan 1.0 seg: ~A" data)))
(undo)
(env-channel-with-base '(0 0 1 1 2 1 3 0) 0.0 5 10)
(let ((data (channel->float-vector 0 20)))
- (if (not (mus-arrays-equal? data (float-vector 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0)))
+ (if (not (mus-arrays-equal? data #r(1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0)))
(snd-display "env-chan 0.0 seg: ~A" data)))
(undo)
(env-channel-with-base '(0 0 1 1) 100.0 5 10)
(let ((data (channel->float-vector 0 20)))
- (if (not (mus-arrays-equal? data (float-vector 1.0 1.0 1.0 1.0 1.0 0.0 0.007 0.018 0.037 0.068 0.120 0.208 0.353 0.595 1.0 1.0 1.0 1.0 1.0 1.0)))
+ (if (not (mus-arrays-equal? data #r(1.0 1.0 1.0 1.0 1.0 0.0 0.007 0.018 0.037 0.068 0.120 0.208 0.353 0.595 1.0 1.0 1.0 1.0 1.0 1.0)))
(snd-display "env-chan 100.0 seg: ~A" data)))
(undo)
(env-channel-with-base '(0 0 1 1) 0.01 5 10)
(let ((data (channel->float-vector 0 20)))
- (if (not (mus-arrays-equal? data (float-vector 1.0 1.0 1.0 1.0 1.0 0.0 0.405 0.647 0.792 0.880 0.932 0.963 0.982 0.993 1.0 1.0 1.0 1.0 1.0 1.0)))
+ (if (not (mus-arrays-equal? data #r(1.0 1.0 1.0 1.0 1.0 0.0 0.405 0.647 0.792 0.880 0.932 0.963 0.982 0.993 1.0 1.0 1.0 1.0 1.0 1.0)))
(snd-display "env-chan 0.01 seg: ~A" data)))
(undo)
(close-sound snd))
@@ -36017,7 +35983,7 @@ EDITS: 1
(list 'env-sound (lambda () (env-sound '(0 2 1 2))))
(list 'env-channel (lambda () (env-channel (make-env '(0 1 1 1) :scaler 2.0 :length (framples)))))
(list 'clm-channel (lambda () (clm-channel (make-one-zero :a0 2.0 :a1 0.0))))
- (list 'filter-channel (lambda () (filter-channel (float-vector 2.0) 1)))
+ (list 'filter-channel (lambda () (filter-channel #r(2.0) 1)))
(list 'float-vector->channel (lambda () (float-vector->channel (float-vector-scale! (channel->float-vector) 2.0) 0)))
(list 'mix-selection (lambda () (select-all) (mix-selection 0)))
(list 'scale-selection (lambda () (select-all) (scale-selection-by 2.0)))
@@ -36094,7 +36060,7 @@ EDITS: 1
(insert-float-vector (make-float-vector 5 .1) 2)
(if (not (= (framples ind) 15)) (snd-display "insert-float-vector len: ~A" (framples ind)))
(let ((vals (channel->float-vector 0 #f ind 0)))
- (if (not (mus-arrays-equal? vals (float-vector 1 1 .1 .1 .1 .1 .1 1 1 1 1 1 1 1 1)))
+ (if (not (mus-arrays-equal? vals #r(1 1 .1 .1 .1 .1 .1 1 1 1 1 1 1 1 1)))
(snd-display "insert-float-vector vals: ~A" vals)))
(let ((tag (catch #t (lambda () (insert-float-vector 32)) (lambda args (car args)))))
@@ -36103,7 +36069,7 @@ EDITS: 1
(insert-float-vector (make-float-vector 1 1.5) 0 1 ind 0)
(if (not (= (framples ind) 16)) (snd-display "insert-float-vector 1 len: ~A" (framples ind)))
(let ((vals (channel->float-vector 0 #f ind 0)))
- (if (not (mus-arrays-equal? vals (float-vector 1.5 1 1 .1 .1 .1 .1 .1 1 1 1 1 1 1 1 1)))
+ (if (not (mus-arrays-equal? vals #r(1.5 1 1 .1 .1 .1 .1 .1 1 1 1 1 1 1 1 1)))
(snd-display "insert-float-vector 1 vals: ~A" vals)))
(close-sound ind))
@@ -36116,26 +36082,26 @@ EDITS: 1
(insert-float-vector (make-float-vector 20 .1) 2 2 ind 2)
(if (not (= (framples ind 0) 5)) (snd-display "4chn insert-float-vector (0) len: ~A" (framples ind 0)))
(if (not (= (framples ind 2) 7)) (snd-display "4chn insert-float-vector (2) len: ~A" (framples ind 2)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 7 ind 0) (float-vector .4 .4 .4 .4 .4 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 7 ind 0) #r(.4 .4 .4 .4 .4 0 0)))
(snd-display "4chn insert-float-vector 0: ~A" (channel->float-vector 0 7 ind 0)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 7 ind 1) (float-vector .5 .5 .5 .5 .5 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 7 ind 1) #r(.5 .5 .5 .5 .5 0 0)))
(snd-display "4chn insert-float-vector 1: ~A" (channel->float-vector 0 7 ind 1)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 7 ind 2) (float-vector .6 .6 .1 .1 .6 .6 .6)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 7 ind 2) #r(.6 .6 .1 .1 .6 .6 .6)))
(snd-display "4chn insert-float-vector 2: ~A" (channel->float-vector 0 7 ind 2)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 7 ind 3) (float-vector .7 .7 .7 .7 .7 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 7 ind 3) #r(.7 .7 .7 .7 .7 0 0)))
(snd-display "4chn insert-float-vector 3: ~A" (channel->float-vector 0 7 ind 3)))
(insert-float-vector (make-float-vector 20 .2) 0 2 ind 0)
(if (not (= (framples ind 0) 7)) (snd-display "4chn insert-float-vector (0 0) len: ~A" (framples ind 0)))
(if (not (= (framples ind 1) 5)) (snd-display "4chn insert-float-vector (0 1) len: ~A" (framples ind 1)))
(if (not (= (framples ind 2) 7)) (snd-display "4chn insert-float-vector (2 2) len: ~A" (framples ind 2)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 7 ind 0) (float-vector .2 .2 .4 .4 .4 .4 .4)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 7 ind 0) #r(.2 .2 .4 .4 .4 .4 .4)))
(snd-display "4chn insert-float-vector 1 0: ~A" (channel->float-vector 0 7 ind 0)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 7 ind 1) (float-vector .5 .5 .5 .5 .5 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 7 ind 1) #r(.5 .5 .5 .5 .5 0 0)))
(snd-display "4chn insert-float-vector 1 1: ~A" (channel->float-vector 0 7 ind 1)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 7 ind 2) (float-vector .6 .6 .1 .1 .6 .6 .6)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 7 ind 2) #r(.6 .6 .1 .1 .6 .6 .6)))
(snd-display "4chn insert-float-vector 1 2: ~A" (channel->float-vector 0 7 ind 2)))
- (if (not (mus-arrays-equal? (channel->float-vector 0 7 ind 3) (float-vector .7 .7 .7 .7 .7 0 0)))
+ (if (not (mus-arrays-equal? (channel->float-vector 0 7 ind 3) #r(.7 .7 .7 .7 .7 0 0)))
(snd-display "4chn insert-float-vector 1 3: ~A" (channel->float-vector 0 7 ind 3)))
(revert-sound ind)
@@ -36210,17 +36176,18 @@ EDITS: 1
(snd-display "snddiff change sample 100: ~A" diff)))
(revert-sound ind0)
(pad-channel 0 100 ind0 0)
- (let ((diff (snddiff ind0 0 ind1 0)))
- (if (or (not (and (eq? (diff 0) 'lag)
- (= (diff 1) 100)
- (eq? (diff 2) 'no-difference)))
+ (let* ((diff (snddiff ind0 0 ind1 0))
+ (lag-diff (and (eq? (diff 0) 'lag)
+ (= (diff 1) 100)
+ (eq? (diff 2) 'no-difference))))
+ (if (or (not lag-diff)
(fneq (diff 3) 0.0)
(diff 4)
(diff 5)
(diff 6))
(snd-display "snddiff + lag: ~A" diff)))
(revert-sound ind0)
- (filter-channel (float-vector 1.0 0.5 0.25) 3 0 #f ind1 0)
+ (filter-channel #r(1.0 0.5 0.25) 3 0 #f ind1 0)
(let* ((diff (snddiff ind0 0 ind1 0))
(info (and (cadr diff) (= (length (cadr diff)) 3) (cadr diff))))
(if (or (not (and (list? info)
@@ -36254,14 +36221,14 @@ EDITS: 1
(define (pinner cur nvals len)
(if (= len 1)
(apply func (car nvals) cur)
- (do ((i 0 (+ i 1))) ; I suppose a named let would be more Schemish
+ (do ((i 0 (+ i 1)) ; I suppose a named let would be more Schemish
+ (start nvals nvals))
((= i len))
- (let ((start nvals))
- (set! nvals (cdr nvals))
- (let ((cur1 (cons (car nvals) cur))) ; add (car nvals) to our arg list
- (set! (cdr start) (cdr nvals)) ; splice out that element and
- (pinner cur1 (cdr start) (- len 1)) ; pass a smaller circle on down
- (set! (cdr start) nvals)))))) ; restore original circle
+ (set! nvals (cdr nvals))
+ (let ((cur1 (cons (car nvals) cur))) ; add (car nvals) to our arg list
+ (set! (cdr start) (cdr nvals)) ; splice out that element and
+ (pinner cur1 (cdr start) (- len 1)) ; pass a smaller circle on down
+ (set! (cdr start) nvals))))) ; restore original circle
(let ((len (length vals)))
(set-cdr! (list-tail vals (- len 1)) vals) ; make vals into a circle
(pinner () vals len)
@@ -36289,7 +36256,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 3) fv)
(float-vector-set! fv i (oscil g))))
- (test (fv0) (float-vector 0.0 0.1419943179576268 0.2811111133316549))
+ (test (fv0) #r(0.0 0.1419943179576268 0.2811111133316549))
(define (fv00)
(do ((fv (make-float-vector 3))
@@ -36297,7 +36264,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 3) fv)
(set! (fv i) (oscil g))))
- (test (fv00) (float-vector 0.0 0.1419943179576268 0.2811111133316549))
+ (test (fv00) #r(0.0 0.1419943179576268 0.2811111133316549))
(define (fv01)
(do ((fv (make-float-vector 3))
@@ -36370,7 +36337,9 @@ EDITS: 1
((= i 3) fv)
(float-vector-set! fv i (oscil g))))))
- (test (fv3) (float-vector 0.0 0.9916648104524686 -0.9589242746631385))
+ (test (fv3) #r(0.0 0.9916648104524686 -0.9589242746631385))
+ ;; (oscil (make-oscil 200 1.7)): 0.9916648104524686
+ ;; (oscil (make-oscil 300 5.0)): -0.9589242746631385
(define (fv4)
(do ((fv-a (make-float-vector 4))
@@ -36380,8 +36349,8 @@ EDITS: 1
((= i 4) (list fv-a fv-b))
(float-vector-set! fv-a i (float-vector-set! fv-b i (oscil g)))))
- (test (fv4) (list (float-vector 0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953)
- (float-vector 0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953)))
+ (test (fv4) (list #r(0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953)
+ #r(0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953)))
(define (fv5)
(do ((fv-a (make-float-vector 4))
@@ -36391,7 +36360,7 @@ EDITS: 1
((= i 4) fv-a)
(float-vector-set! fv-a i (oscil g1 (oscil g2)))))
- (test (fv5) (float-vector 0.0 0.1419943179576268 0.4140929109323406 0.7516320715399403))
+ (test (fv5) #r(0.0 0.1419943179576268 0.4140929109323406 0.7516320715399403))
(define (fv6)
(let ((g1 (make-oscil 1000))
@@ -36414,7 +36383,7 @@ EDITS: 1
(float-vector-set! fv i (oscil g1 x)))
fv))
- (test (fv7) (float-vector 0.0 0.2401067896488338 0.4661656420314379 0.0 0.2401067896488338 0.4661656420314379))
+ (test (fv7) #r(0.0 0.2401067896488338 0.4661656420314379 0.0 0.2401067896488338 0.4661656420314379))
(define (fv8)
(do ((g (make-oscil 1000))
@@ -36439,7 +36408,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (* i i))))
- (test (fv10) (float-vector 0.0 1.0 4.0 9.0))
+ (test (fv10) #r(0.0 1.0 4.0 9.0))
(define (fv11)
(do ((fv (make-float-vector 4))
@@ -36448,7 +36417,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (* (oscil g0) (oscil g1)))))
- (test (fv11) (float-vector 0.0 0.02016238633225161 0.07902345803856255 0.1718360964482408))
+ (test (fv11) #r(0.0 0.02016238633225161 0.07902345803856255 0.1718360964482408))
(define (fv12)
(do ((fv (make-float-vector 4))
@@ -36456,7 +36425,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (* 2.0 (oscil g0)))))
- (test (fv12) (float-vector 0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906))
+ (test (fv12) #r(0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906))
(define (fv13)
(do ((fv (make-float-vector 4))
@@ -36465,7 +36434,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (* (oscil g0) x))))
- (test (fv13) (float-vector 0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906))
+ (test (fv13) #r(0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906))
(define (fv14)
(do ((fv (make-float-vector 4))
@@ -36476,14 +36445,14 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (* s0 (oscil g0 (* s1 (oscil g1)))))))
- (test (fv14) (float-vector 0.0 0.2839886359152535 1.305084606281564 1.984158175327229))
+ (test (fv14) #r(0.0 0.2839886359152535 1.305084606281564 1.984158175327229))
(define (fv15)
(do ((fv (make-float-vector 4))
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (+ i i))))
- (test (fv15) (float-vector 0.0 2.0 4.0 6.0))
+ (test (fv15) #r(0.0 2.0 4.0 6.0))
(define (fv16)
(do ((fv (make-float-vector 4))
@@ -36492,7 +36461,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (+ (oscil g0) (oscil g1)))))
- (test (fv16) (float-vector 0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906))
+ (test (fv16) #r(0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906))
(define (fv17)
(do ((fv (make-float-vector 4))
@@ -36500,7 +36469,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (+ 2.0 (oscil g0)))))
- (test (fv17) (float-vector 2.0 2.141994317957627 2.281111113331655 2.414531176690295))
+ (test (fv17) #r(2.0 2.141994317957627 2.281111113331655 2.414531176690295))
(define (fv18)
(do ((fv (make-float-vector 4))
@@ -36509,7 +36478,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (+ (oscil g0) x))))
- (test (fv18) (float-vector 2.0 2.141994317957627 2.281111113331655 2.414531176690295))
+ (test (fv18) #r(2.0 2.141994317957627 2.281111113331655 2.414531176690295))
(define (fv19)
(do ((fv (make-float-vector 4))
@@ -36520,7 +36489,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (+ s0 (oscil g0 (* s1 (oscil g1)))))))
- (test (fv19) (float-vector 2.0 2.141994317957627 2.652542303140782 2.992079087663615))
+ (test (fv19) #r(2.0 2.141994317957627 2.652542303140782 2.992079087663615))
(define (fv20)
(do ((fv (make-float-vector 4))
@@ -36530,7 +36499,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (+ (oscil g0) (oscil g1) (oscil g2)))))
- (test (fv20) (float-vector 0.0 0.4259829538728803 0.8433333399949648 1.243593530070886))
+ (test (fv20) #r(0.0 0.4259829538728803 0.8433333399949648 1.243593530070886))
(define (fv21)
(do ((fv (make-float-vector 4))
@@ -36540,7 +36509,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (+ (oscil g0) (oscil g1) s1))))
- (test (fv21) (float-vector 1.0 1.283988635915253 1.56222222666331 1.829062353380591))
+ (test (fv21) #r(1.0 1.283988635915253 1.56222222666331 1.829062353380591))
(define (fv22)
(do ((fv (make-float-vector 4))
@@ -36549,7 +36518,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (+ (oscil g0) 1.0 (oscil g1)))))
- (test (fv22) (float-vector 1.0 1.283988635915253 1.56222222666331 1.829062353380591))
+ (test (fv22) #r(1.0 1.283988635915253 1.56222222666331 1.829062353380591))
(define (fv23)
(do ((fv (make-float-vector 4))
@@ -36558,7 +36527,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (+ s1 1.0 (oscil g0)))))
- (test (fv23) (float-vector 2.0 2.141994317957627 2.281111113331655 2.414531176690295))
+ (test (fv23) #r(2.0 2.141994317957627 2.281111113331655 2.414531176690295))
(define (fv24)
(do ((fv (make-float-vector 4))
@@ -36568,7 +36537,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (+ s1 (oscil g0) s2))))
- (test (fv24) (float-vector 3.0 3.141994317957627 3.281111113331655 3.414531176690295))
+ (test (fv24) #r(3.0 3.141994317957627 3.281111113331655 3.414531176690295))
(define (fv25)
(do ((fv (make-float-vector 4))
@@ -36578,7 +36547,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (+ s1 s2 (oscil g0)))))
- (test (fv25) (float-vector 3.0 3.141994317957627 3.281111113331655 3.414531176690295))
+ (test (fv25) #r(3.0 3.141994317957627 3.281111113331655 3.414531176690295))
(define (fv26)
(do ((fv (make-float-vector 4))
@@ -36588,7 +36557,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (+ (oscil g0) s1 s2))))
- (test (fv26) (float-vector 3.0 3.141994317957627 3.281111113331655 3.414531176690295))
+ (test (fv26) #r(3.0 3.141994317957627 3.281111113331655 3.414531176690295))
(define (fv27)
(do ((fv (make-float-vector 4))
@@ -36626,7 +36595,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (* (oscil g0) (oscil g1) (oscil g2)))))
- (test (fv30) (float-vector 0.0 0.002862944295646243 0.02221437226853764 0.07123141925855635))
+ (test (fv30) #r(0.0 0.002862944295646243 0.02221437226853764 0.07123141925855635))
(define (fv31)
(do ((fv (make-float-vector 4))
@@ -36634,7 +36603,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (abs (oscil g0)))))
- (test (fv31) (float-vector 0.7568024953079282 0.8419478535558946 0.9100310927158114 0.9596725022396432))
+ (test (fv31) #r(0.7568024953079282 0.8419478535558946 0.9100310927158114 0.9596725022396432))
(define (fv32)
(do ((fv (make-float-vector 4))
@@ -36652,7 +36621,7 @@ EDITS: 1
((= i 4) fv)
(let ((x (oscil g0)))
(float-vector-set! fv i (oscil g1 x)))))
- (test (fv31a) (float-vector 0.0 0.1419943179576268 0.4140929109323406 0.7516320715399403))
+ (test (fv31a) #r(0.0 0.1419943179576268 0.4140929109323406 0.7516320715399403))
(define (fv33)
(do ((g0 (make-oscil 1000))
@@ -36663,7 +36632,7 @@ EDITS: 1
(let ((x (oscil g0))
(y (oscil g0)))
(float-vector-set! fv i (* y (oscil g1 x))))))
- (test (fv33) (float-vector 0.0 0.05886107170631096 0.3505537450231597 0.7966641560805439))
+ (test (fv33) #r(0.0 0.05886107170631096 0.3505537450231597 0.7966641560805439))
(define (fv34)
(do ((g0 (make-oscil 1000))
@@ -36674,7 +36643,7 @@ EDITS: 1
(let* ((x (oscil g0))
(y (oscil g0)))
(float-vector-set! fv i (* y (oscil g1 x))))))
- (test (fv34) (float-vector 0.0 0.05886107170631096 0.3505537450231597 0.7966641560805439))
+ (test (fv34) #r(0.0 0.05886107170631096 0.3505537450231597 0.7966641560805439))
(define (fv35)
(do ((g0 (make-oscil 1000))
@@ -36684,7 +36653,7 @@ EDITS: 1
((= i 4) fv)
(let ((y (oscil g0)))
(float-vector-set! fv i (+ y (oscil g1))))))
- (test (fv35) (float-vector 0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906))
+ (test (fv35) #r(0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906))
(define (fv37)
(do ((g0 (make-oscil 1000))
@@ -36693,7 +36662,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (odd-weight (+ x0 (oscil g0))))))
- (test (fv37) (float-vector 1.0 0.8580056820423732 0.7188888866683452 0.5854688233097047))
+ (test (fv37) #r(1.0 0.8580056820423732 0.7188888866683452 0.5854688233097047))
(define (fv38)
(do ((g0 (make-oscil 1000))
@@ -36702,7 +36671,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (even-weight (+ x0 (oscil g0))))))
- (test (fv38) (float-vector 0.0 0.1419943179576268 0.2811111133316548 0.4145311766902953))
+ (test (fv38) #r(0.0 0.1419943179576268 0.2811111133316548 0.4145311766902953))
(define (fv39)
(do ((g0 (make-oscil 1000))
@@ -36710,7 +36679,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (max (oscil g0) 0.25))))
- (test (fv39) (float-vector 0.25 0.25 0.2811111133316549 0.4145311766902953))
+ (test (fv39) #r(0.25 0.25 0.2811111133316549 0.4145311766902953))
(define (fv40)
(do ((g0 (make-file->sample "oboe.snd"))
@@ -36718,7 +36687,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (ina i g0))))
- (test (fv40) (float-vector 0.0 -0.00030517578125 -0.00030517578125 -0.000274658203125))
+ (test (fv40) #r(0.0 -0.00030517578125 -0.00030517578125 -0.000274658203125))
(define (fv41)
(do ((g0 (make-float-vector 3 0.5))
@@ -36726,7 +36695,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (ina i g0))))
- (test (fv41) (float-vector 0.5 0.5 0.5 0.0))
+ (test (fv41) #r(0.5 0.5 0.5 0.0))
(define (fv42)
(do ((g0 (make-float-vector 3 0.5))
@@ -36734,17 +36703,17 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (- (ina i g0)))))
- (test (fv42) (float-vector -0.5 -0.5 -0.5 0.0))
+ (test (fv42) #r(-0.5 -0.5 -0.5 0.0))
(define (fv43)
(do ((fv (make-float-vector 4))
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (- i))))
- (test (fv43) (float-vector 0 -1 -2 -3))
+ (test (fv43) #r(0 -1 -2 -3))
(define (permute op . args)
- (eval (copy `(let ()
+ (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)))
@@ -36758,8 +36727,12 @@ EDITS: 1
(let ((v1 (t1))
(v2 (copy (t2) (make-float-vector 4))))
(if (not (morally-equal? v1 v2))
- (format *stderr* "~D: ~A -> ~A ~A~%" args v1 v2))))
- :readable)))
+ (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))))
(set! (*s7* 'morally-equal-float-epsilon) 1e-12)
(for-each
@@ -36771,6 +36744,7 @@ EDITS: 1
(list 'x '(oscil g0) 2.0 '(oscil g1) 'y)))
'(+ * -))
+ (set! (*s7* 'morally-equal-float-epsilon) 5e-12)
(for-each-subset
(lambda s-args
(if (pair? s-args)
@@ -36793,7 +36767,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (polynomial g0 (* 2.0 (oscil x))))))
- (test (fv45) (float-vector 1.0 1.36463818124426 1.87831605881756 2.516406739173554))
+ (test (fv45) #r(1.0 1.36463818124426 1.87831605881756 2.516406739173554))
(define (fv47)
(do ((g0 (make-oscil 1000))
@@ -36802,7 +36776,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (amplitude-modulate 1.0 x (oscil g0)))))
- (test (fv47) (float-vector 1.0 1.141994317957627 1.281111113331655 1.414531176690295))
+ (test (fv47) #r(1.0 1.141994317957627 1.281111113331655 1.414531176690295))
(define (fv48)
(do ((g0 (make-oscil 1000))
@@ -36811,15 +36785,15 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) (and (zero? (log x)) fv))
(float-vector-set! fv i (remainder (* 10 (oscil g0)) 1.0))))
- (test (fv48) (float-vector 0.0 0.4199431795762676 0.8111111333165493 0.1453117669029531))
+ (test (fv48) #r(0.0 0.4199431795762676 0.8111111333165493 0.1453117669029531))
(define (fv49)
- (do ((g0 (float-vector 1 2 3 4 5 6))
+ (do ((g0 #r(1 2 3 4 5 6))
(fv (make-float-vector 4))
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (float-vector-ref g0 (+ i 2)))))
- (test (fv49) (float-vector 3 4 5 6))
+ (test (fv49) #r(3 4 5 6))
(define (fv49a)
(do ((fv (make-float-vector 4))
@@ -36830,7 +36804,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (+ (oscil g0) (oscil g1) (oscil g2) (oscil g3)))))
- (test (fv49a) (float-vector 0.0 0.5679772718305071 1.12444445332662 1.658124706761181))
+ (test (fv49a) #r(0.0 0.5679772718305071 1.12444445332662 1.658124706761181))
(define (fv51)
(do ((fv (make-float-vector 4))
@@ -36891,7 +36865,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (* (env e) (oscil g)))))
- (test (fv57) (float-vector 0.0 0.03549857948940669 0.1405555566658275 0.3108983825177215))
+ (test (fv57) #r(0.0 0.03549857948940669 0.1405555566658275 0.3108983825177215))
(define (fv59)
(do ((fv (make-float-vector 4))
@@ -36900,17 +36874,17 @@ EDITS: 1
((= i 4) fv)
(let ((j (abs i))) ; j is not an integer! so is_fv_set_rf rejects it -- yow
(float-vector-set! fv j (oscil g)))))
- (test (fv59) (float-vector 0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953))
+ (test (fv59) #r(0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953))
(define (fv60)
- (do ((xv (float-vector 0 1 2 3 4))
+ (do ((xv #r(0 1 2 3 4))
(fv (make-float-vector 4))
(g (make-oscil 1000))
(len 5)
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (array-interp xv (* 4 (abs (oscil g))) len))))
- (test (fv60) (float-vector 0.0 0.5679772718305071 1.12444445332662 1.658124706761181))
+ (test (fv60) #r(0.0 0.5679772718305071 1.12444445332662 1.658124706761181))
(define (fv61)
(do ((fv (make-float-vector 4))
@@ -36918,7 +36892,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (+ (oscil g) (oscil g)))))
- (test (fv61) (float-vector 0.1419943179576268 0.6956422900219503 1.193187027684375 1.594501774071586))
+ (test (fv61) #r(0.1419943179576268 0.6956422900219503 1.193187027684375 1.594501774071586))
(define (fv62)
(do ((fv (make-float-vector 4))
@@ -36927,7 +36901,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (+ (oscil g) (oscil g x)))))
- (test (fv62) (float-vector 0.1419943179576268 0.8788265473477139 1.4870276868047 1.877577239959861))
+ (test (fv62) #r(0.1419943179576268 0.8788265473477139 1.4870276868047 1.877577239959861))
(define (fv63)
(do ((fv (make-float-vector 4))
@@ -36936,7 +36910,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (+ (oscil g x) (oscil g)))))
- (test (fv63) (float-vector 0.2401067896488338 0.962578603769539 1.544160801705073 1.899729018207357))
+ (test (fv63) #r(0.2401067896488338 0.962578603769539 1.544160801705073 1.899729018207357))
(define (fv64)
(set! (mus-rand-seed) 1234)
@@ -36946,8 +36920,8 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 10) fv)
(float-vector-set! fv i (+ (env e) (rand-interp r)))))
- (test (fv64) (float-vector -0.001775140394296145 0.1075608303225188 0.2168968010393338 0.3262327717561487
- 0.4355687424729637 0.5449047131897787 0.6542406839065937 0.7635766546234087 0.8729126253402237 0.9822485960570387))
+ (test (fv64) #r(-0.07828369138846 0.03260625378213546 0.1434961989527309 0.2543861441233264 0.3652760892939219 0.4761660344645173
+ 0.5870559796351129 0.6979459248057084 0.8088358699763039 0.9197258151468994))
(define (fv65)
(set! (mus-rand-seed) 1234)
@@ -36957,8 +36931,27 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 10) fv)
(float-vector-set! fv i (+ (triangle-wave e) (rand-interp r)))))
- (test (fv65) (float-vector -0.001775140394296145 0.0418011931343102 0.08537752666291655 0.1289538601915229
- 0.1725301937201293 0.2161065272487356 0.2596828607773419 0.3032591943059482 0.3468355278345545 0.3904118613631609))
+ (test (fv65) #r(-0.07828369138846 -0.03315338340607316 0.01197692457631369 0.05710723255870052 0.1022375405410874 0.1473678485234742
+ 0.1924981565058611 0.2376284644882479 0.2827587724706346 0.3278890804530215))
+
+ ;; from Tito Latini
+ (define (rand-test constr fn seed rep)
+ (set! (mus-rand-seed) seed)
+ (let ((r (constr (/ *clm-srate* 4))))
+ (do ((i 0 (+ i 1))
+ (j (fn r) (fn r))
+ (acc ()))
+ ((= i rep) (reverse! acc))
+ (when (= (logand i 3) 0)
+ ;; Skip duplicated or interpolated values.
+ (set! acc (cons j acc))))))
+
+ (test (rand-test make-rand rand 12345 32)
+ '(0.3103027354484 -0.3903808588755999 0.3499145518871001 -0.7864990232626 0.0331420906901001 -0.02069091716649996 0.2048950205183 -0.2601318353313999))
+
+ (test (rand-test make-rand-interp rand-interp 12345 32)
+ '(0.3103027354484 -0.3903808588755999 0.3499145518871001 -0.7864990232625999 0.0331420906901001 -0.02069091716649996 0.2048950205183 -0.2601318353313999))
+
(define (fv66)
(let ((fv (make-float-vector 8))
@@ -36972,7 +36965,7 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 8) fv)
(float-vector-set! fv i (oscil (vector-ref gv i))))))
- (test (fv66) (float-vector 0.0 0.0 0.1419943179576268 0.1419943179576268 0.2811111133316549 0.2811111133316549 0.4145311766902953 0.4145311766902953))
+ (test (fv66) #r(0.0 0.0 0.1419943179576268 0.1419943179576268 0.2811111133316549 0.2811111133316549 0.4145311766902953 0.4145311766902953))
(define (fv67)
(let ((fv (make-float-vector 8))
@@ -36982,7 +36975,7 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 8) fv)
(float-vector-set! fv i (oscil (vector-ref v i))))))
- (test (fv67) (float-vector 0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953 0.5395507431861811 0.6536362844981936 0.7544758509208143 0.8400259231507713))
+ (test (fv67) #r(0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953 0.5395507431861811 0.6536362844981936 0.7544758509208143 0.8400259231507713))
(define (fv68)
(let ((fv (make-float-vector 8))
@@ -36997,7 +36990,7 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 8) fv)
(float-vector-set! fv i (oscil (vector-ref gv i) x)))))
- (test (fv68) (float-vector 0.0 0.0 0.2401067896488338 0.2401067896488338 0.4661656420314379 0.4661656420314379 0.6649505230927522 0.6649505230927522))
+ (test (fv68) #r(0.0 0.0 0.2401067896488338 0.2401067896488338 0.4661656420314379 0.4661656420314379 0.6649505230927522 0.6649505230927522))
(define (fv69)
(do ((fv (make-float-vector 4))
@@ -37006,7 +36999,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (mus-set-formant-frequency g (env e)))))
- (test (fv69) (float-vector 440.0 488.8888888888889 537.7777777777778 586.6666666666667))
+ (test (fv69) #r(440.0 488.8888888888889 537.7777777777778 586.6666666666667))
(define (fv70)
(do ((fv1 (make-float-vector 4))
@@ -37019,8 +37012,8 @@ EDITS: 1
(let ((x (env e)))
(float-vector-set! fv1 i (oscil g1))
(float-vector-set! fv2 i (* x (oscil g2))))))
- (test (fv70) (list (float-vector 0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953)
- (float-vector 0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906)))
+ (test (fv70) (list #r(0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953)
+ #r(0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906)))
(define (fv71)
(let ((fv (make-float-vector 8))
@@ -37034,7 +37027,7 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 8) fv)
(float-vector-set! fv i (env (vector-ref gv i))))))
- (test (fv71) (float-vector 0.0 0.0 0.25 0.25 0.5 0.5 0.75 0.75))
+ (test (fv71) #r(0.0 0.0 0.25 0.25 0.5 0.5 0.75 0.75))
(define (fv72)
(let ((fv (make-float-vector 10))
@@ -37050,7 +37043,7 @@ EDITS: 1
(list-set! ls i (+ (square-wave g) (square-wave g x))))
(list fv ls)))
- (test (fv72) (list (float-vector 2.0 2.0 2.0 2.0 2.0 0.0 0.0 0.0 0.0 0.0)
+ (test (fv72) (list #r(2.0 2.0 2.0 2.0 2.0 0.0 0.0 0.0 0.0 0.0)
(list 2.0 2.0 2.0 2.0 2.0 0.0 0.0 0.0 0.0 0.0)))
(define (fv73)
@@ -37068,7 +37061,7 @@ EDITS: 1
(list-set! ls i (+ (square-wave g) (square-wave g x))))
(list fv ls)))
- (test (fv73) (list (float-vector 2.0 2.0 2.0 0.0 0.0 0.0 2.0 2.0 2.0 0.0)
+ (test (fv73) (list #r(2.0 2.0 2.0 0.0 0.0 0.0 2.0 2.0 2.0 0.0)
(list 2.0 2.0 2.0 0.0 0.0 0.0 2.0 2.0 2.0 0.0)))
(define (fv74)
@@ -37077,7 +37070,7 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (r2k!cos g)))))
- (test (fv74) (float-vector 0.008 0.01148666785741709 0.01717900881454179 0.02679348967895129))
+ (test (fv74) #r(0.008 0.01148666785741709 0.01717900881454179 0.02679348967895129))
(define (fv75)
(do ((fv (make-float-vector 4))
@@ -37085,7 +37078,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (r2k!cos g .1))))
- (test (fv75) (float-vector 0.008 0.01517028252035849 0.03244495213443228 0.07802652038780451))
+ (test (fv75) #r(0.008 0.01517028252035849 0.03244495213443228 0.07802652038780451))
(define (fv76)
(do ((fv (make-float-vector 4))
@@ -37094,7 +37087,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (r2k!cos g x))))
- (test (fv76) (float-vector 0.008 0.01517028252035849 0.03244495213443228 0.07802652038780451))
+ (test (fv76) #r(0.008 0.01517028252035849 0.03244495213443228 0.07802652038780451))
(define (fv77)
(do ((fv (make-float-vector 4))
@@ -37103,7 +37096,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i (r2k!cos g (env x)))))
- (test (fv77) (float-vector 0.008 0.01517028252035849 0.03244495213443228 0.07802652038780451))
+ (test (fv77) #r(0.008 0.01517028252035849 0.03244495213443228 0.07802652038780451))
(define (fv81) (do ((x 0.0) (i 0 (+ i 1)) (y .1 .1)) ((= i 4) x) (set! x y))) (test (fv81) .1)
(define (fv82) (do ((x 0.0) (y 0.1) (i 0 (+ i 1))) ((= i 4) x) (set! x y))) (test (fv82) .1)
@@ -37133,7 +37126,7 @@ EDITS: 1
((= i 4) fv2)
(float-vector-add! fv2 fv1)
(float-vector-set! fv1 j 2.5)))
- (test (fv87) (float-vector 9 8 7 6))
+ (test (fv87) #r(9 8 7 6))
(define (fv88)
(do ((fv (make-float-vector 4))
@@ -37144,7 +37137,7 @@ EDITS: 1
((= i 4) fv)
(file->frample g j ifv)
(float-vector-set! fv i (ifv 0))))
- (test (fv88) (float-vector 0.0328369140625 0.0347900390625 0.0340576171875 0.031036376953125))
+ (test (fv88) #r(0.0328369140625 0.0347900390625 0.0340576171875 0.031036376953125))
(define (fv89)
(do ((fv0 (make-float-vector 4))
@@ -37157,8 +37150,8 @@ EDITS: 1
(file->frample g j ifv)
(float-vector-set! fv0 i (ifv 0))
(float-vector-set! fv1 i (ifv 1))))
- (test (fv89) (list (float-vector 0.002227783203125 0.00634765625 0.00787353515625 0.007293701171875)
- (float-vector 0.004425048828125 0.012664794921875 0.015777587890625 0.014556884765625)))
+ (test (fv89) (list #r(0.002227783203125 0.00634765625 0.00787353515625 0.007293701171875)
+ #r(0.004425048828125 0.012664794921875 0.015777587890625 0.014556884765625)))
(define (fv90)
(do ((fv (make-float-vector 4))
@@ -37166,23 +37159,23 @@ EDITS: 1
(x 1.0 (+ x 0.5)))
((= i 4) fv)
(set! (fv i) x)))
- (test (fv90) (float-vector 1.0 1.5 2.0 2.5))
+ (test (fv90) #r(1.0 1.5 2.0 2.5))
(define (fv91)
- (do ((f1 (float-vector 1.0 2.0 3.0))
- (f2 (float-vector 0.0 0.0 0.0))
- (m1 (float-vector 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0))
+ (do ((f1 #r(1.0 2.0 3.0))
+ (f2 #r(0.0 0.0 0.0))
+ (m1 #r(1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0))
(f1-len 3)
(f2-len 3)
(i 0 (+ i 1))
(x 0 (+ x 2))) ; currently needed to trigger optimizer
((= i 1) (and (positive? x) f2))
(frample->frample m1 f1 f1-len f2 f2-len)))
- (test (fv91) (float-vector 30.0 36.0 42.0))
+ (test (fv91) #r(30.0 36.0 42.0))
(define (fv92)
(let ((sf (make-frample->file "fmv.snd" 2 mus-lfloat mus-riff "this is a comment"))
- (fv (float-vector .1 .2))
+ (fv #r(.1 .2))
(fv1 (make-float-vector 4))
(fv2 (make-float-vector 4)))
(do ((i 0 (+ i 1)))
@@ -37196,7 +37189,7 @@ EDITS: 1
(define (fv93)
(let ((sf (make-frample->file "fmv.snd" 2 mus-lfloat mus-riff "this is a comment"))
- (fv (float-vector .01 .02))
+ (fv #r(.01 .02))
(fv1 (make-float-vector 4))
(fv2 (make-float-vector 4)))
(do ((i 0 (+ i 1)))
@@ -37206,26 +37199,26 @@ EDITS: 1
(list (file->array "fmv.snd" 0 0 4 fv1)
(file->array "fmv.snd" 1 0 4 fv2))))
(let-temporarily (((*s7* 'morally-equal-float-epsilon) 1e-5))
- (test (fv93) (list (float-vector .02 .04 .08 .16)
- (float-vector .04 .08 .16 .32))))
+ (test (fv93) (list #r(.02 .04 .08 .16)
+ #r(.04 .08 .16 .32))))
(define (fv94)
- (do ((fv0 (float-vector 0 1 2 3 4 5))
+ (do ((fv0 #r(0 1 2 3 4 5))
(fv (make-float-vector 4))
(i 0 (+ i 1))
(x 0.4 (+ x 0.7)))
((= i 4) fv)
(float-vector-set! fv i (float-vector-ref fv0 (floor x)))))
- (test (fv94) (float-vector 0.0 1.0 1.0 2.0))
+ (test (fv94) #r(0.0 1.0 1.0 2.0))
(define (fv94a)
- (do ((fv0 (float-vector 0 1 2 3 4 5))
+ (do ((fv0 #r(0 1 2 3 4 5))
(fv (make-float-vector 4))
(i 0 (+ i 1))
(x 0.4 (+ x 0.7)))
((= i 4) fv)
(float-vector-set! fv i (float-vector-ref fv0 (ceiling x)))))
- (test (fv94a) (float-vector 1.0 2.0 2.0 3.0))
+ (test (fv94a) #r(1.0 2.0 2.0 3.0))
(define (fv95)
(do ((fv (make-float-vector 4))
@@ -37233,7 +37226,7 @@ EDITS: 1
(x 0 (+ x 1)))
((= i 4) (and (positive? x) fv))
(float-vector-set! fv i ((if (even? i) + -) i 10.0))))
- (test (fv95) (float-vector 10.0 -9.0 12.0 -7.0))
+ (test (fv95) #r(10.0 -9.0 12.0 -7.0))
(define (fv95a)
(do ((fv (make-float-vector 4))
@@ -37241,7 +37234,7 @@ EDITS: 1
(x 0 (+ x 1)))
((= i 4) (and (positive? x) fv))
(float-vector-set! fv i ((if (odd? i) + -) i 10.0))))
- (test (fv95a) (float-vector -10.0 11.0 -8.0 13.0))
+ (test (fv95a) #r(-10.0 11.0 -8.0 13.0))
(define (fv96)
(do ((fv (make-float-vector 4))
@@ -37252,7 +37245,7 @@ EDITS: 1
(float-vector-set! fv1 i 3.0)
(float-vector-set! fv i ((if (even? i) + -) i 10.0))
(float-vector-set! fv1 i (+ (float-vector-ref fv1 i) 1.0))))
- (test (fv96) (list (float-vector 10.0 -9.0 12.0 -7.0)
+ (test (fv96) (list #r(10.0 -9.0 12.0 -7.0)
(make-float-vector 4 4.0)))
(define (fv97)
@@ -37263,7 +37256,7 @@ EDITS: 1
((= i 4) fv)
(set! j (floor x))
(float-vector-set! fv i (* j 2.0))))
- (test (fv97) (float-vector 0.0 2.0 2.0 4.0))
+ (test (fv97) #r(0.0 2.0 2.0 4.0))
(define (fv98)
(do ((fv (make-float-vector 4))
@@ -37283,7 +37276,7 @@ EDITS: 1
(x 0 (+ x 1)))
((= i 4) (and (positive? x) fv))
(float-vector-set! fv i ((if (zero? i) + -) i 10.0))))
- (test (fv99) (float-vector 10.0 -9.0 -8.0 -7.0))
+ (test (fv99) #r(10.0 -9.0 -8.0 -7.0))
(define (fv100)
(do ((fv (make-float-vector 4))
@@ -37291,7 +37284,7 @@ EDITS: 1
(x 0 (+ x 1)))
((= i 4) (and (positive? x) fv))
(float-vector-set! fv i ((if (zero? (modulo i 2)) + -) i 10.0))))
- (test (fv100) (float-vector 10.0 -9.0 12.0 -7.0))
+ (test (fv100) #r(10.0 -9.0 12.0 -7.0))
(define (fv101)
(do ((ctr 0)
@@ -37308,11 +37301,11 @@ EDITS: 1
((= i 10) fv)
(do ((j 0 (+ j 1))) ((= j i))
(float-vector-set! fv i (+ (float-vector-ref fv j) 1.0)))))
- (test (fv104) (float-vector 0 1 2 3 4 5 6 7 8 9))
+ (test (fv104) #r(0 1 2 3 4 5 6 7 8 9))
(when all-args
(define (do-permute init step end)
- (eval (copy `(let ()
+ (let ((form `(let ()
(define (t1)
(let ((fv (make-float-vector 4)))
(if (<= ,step 0) (error 'out-of-range "step > 0"))
@@ -37330,8 +37323,8 @@ EDITS: 1
(let ((v1 (catch #t t1 (lambda args 'error)))
(v2 (catch #t (lambda () (copy (t2) (make-float-vector 4))) (lambda args 'error))))
(if (not (morally-equal? v1 v2))
- (format *stderr* "~D: permute ~A, ~A -> ~A ~A, ~A~%" op args v1 v2 (float-vector-peak (float-vector-subtract! v1 v2))))))
- :readable)))
+ (format *stderr* "~D: permute ~A, ~A -> ~A ~A, ~A~%" op args v1 v2 (float-vector-peak (float-vector-subtract! v1 v2))))))))
+ (eval (copy form :readable))))
(set! (*s7* 'morally-equal-float-epsilon) 1e-12)
@@ -37358,17 +37351,16 @@ EDITS: 1
((= i -10) fv)
(set! k (abs i))
(locsig locs k (* .1 i)))))
- (test (fv108) (float-vector 0 -.1 -.2 -.3 -.4 -.5 -.6 -.7 -.8 -.9))
+ (test (fv108) #r(0 -.1 -.2 -.3 -.4 -.5 -.6 -.7 -.8 -.9))
(define (fv109)
(let ((fv (make-float-vector 10)))
(do ((locs (make-locsig :output fv))
- (k 0)
+ (k 0 (+ k 1))
(i 0 (+ i 1)))
((= i 10) fv)
- (locsig locs k (* .1 i))
- (set! k (+ k 1)))))
- (test (fv109) (float-vector 0 .1 .2 .3 .4 .5 .6 .7 .8 .9))
+ (locsig locs k (* .1 i)))))
+ (test (fv109) #r(0 .1 .2 .3 .4 .5 .6 .7 .8 .9))
(define (fv110)
(let ((fv (make-float-vector 10))
@@ -37378,7 +37370,7 @@ EDITS: 1
((= i 10) fv)
(outa k (* .1 i))
(set! k (+ k 1)))))
- (test (fv110) (float-vector 0 .1 .2 .3 .4 .5 .6 .7 .8 .9))
+ (test (fv110) #r(0 .1 .2 .3 .4 .5 .6 .7 .8 .9))
(define (fv111)
(let ((fv (make-float-vector 10))
@@ -37389,7 +37381,7 @@ EDITS: 1
((= i 10) fv)
(outa k x)
(set! k (+ k 1)))))
- (test (fv111) (float-vector 0 .1 .2 .3 .4 .5 .6 .7 .8 .9))
+ (test (fv111) #r(0 .1 .2 .3 .4 .5 .6 .7 .8 .9))
(define (fv112)
(let ((fv (make-float-vector 10))
@@ -37439,7 +37431,7 @@ EDITS: 1
(x 0 (+ x 1)))
((= i 4) (and (positive? x) fv))
(float-vector-set! fv i ((if (oscil? g) + -) i 10.0))))
- (test (fv116) (float-vector 10.0 11.0 12.0 13.0))
+ (test (fv116) #r(10.0 11.0 12.0 13.0))
(define (fv117)
(do ((fv (make-float-vector 4))
@@ -37447,7 +37439,7 @@ EDITS: 1
(x 0 (+ x 1)))
((= i 4) (and (positive? x) fv))
(float-vector-set! fv i ((if (even? (round i)) + -) i 10.0))))
- (test (fv117) (float-vector 10.0 -9.0 12.0 -7.0))
+ (test (fv117) #r(10.0 -9.0 12.0 -7.0))
(define (fv118)
(do ((fv (make-float-vector 4))
@@ -37456,7 +37448,7 @@ EDITS: 1
(x 0 (+ x 1)))
((= i 4) (and (positive? x) fv))
(float-vector-set! fv i ((if (even? (car lst)) + -) i 10.0))))
- (test (fv118) (float-vector -10.0 -9.0 -8.0 -7.0))
+ (test (fv118) #r(-10.0 -9.0 -8.0 -7.0))
(define (fv119)
(do ((fv (make-float-vector 4))
@@ -37465,7 +37457,7 @@ EDITS: 1
(x 0 (+ x 1)))
((= i 4) (and (positive? x) fv))
(float-vector-set! fv i ((if (eqv? i (car lst)) + -) i 10.0))))
- (test (fv119) (float-vector -10.0 11.0 -8.0 -7.0))
+ (test (fv119) #r(-10.0 11.0 -8.0 -7.0))
(define (fv120)
(do ((fv (make-float-vector 4))
@@ -37474,7 +37466,7 @@ EDITS: 1
(x 0 (+ x 1)))
((= i 4) (and (positive? x) fv))
(float-vector-set! fv i ((if (= i j) + -) i 10.0))))
- (test (fv120) (float-vector -10.0 -9.0 12.0 -7.0))
+ (test (fv120) #r(-10.0 -9.0 12.0 -7.0))
(define (fv121)
(do ((fv (make-float-vector 4))
@@ -37483,7 +37475,7 @@ EDITS: 1
(x 0 (+ x 1)))
((= i 4) (and (positive? x) fv))
(float-vector-set! fv i ((if (< i j) + -) i 10.0))))
- (test (fv121) (float-vector 10.0 11.0 -8.0 -7.0))
+ (test (fv121) #r(10.0 11.0 -8.0 -7.0))
(define (fv122)
(do ((fv (make-float-vector 4))
@@ -37492,7 +37484,7 @@ EDITS: 1
(x 0 (+ x 1)))
((= i 4) (and (positive? x) fv))
(float-vector-set! fv i ((if (<= i j) + -) i 10.0))))
- (test (fv122) (float-vector 10.0 11.0 12.0 -7.0))
+ (test (fv122) #r(10.0 11.0 12.0 -7.0))
(define (fv123)
(do ((fv (make-float-vector 4))
@@ -37501,7 +37493,7 @@ EDITS: 1
(x 0 (+ x 1)))
((= i 4) (and (positive? x) fv))
(float-vector-set! fv i ((if (>= i j) + -) i 10.0))))
- (test (fv123) (float-vector -10.0 -9.0 12.0 13.0))
+ (test (fv123) #r(-10.0 -9.0 12.0 13.0))
(define (fv124)
(do ((fv (make-float-vector 4))
@@ -37510,12 +37502,12 @@ EDITS: 1
(x 0 (+ x 1)))
((= i 4) (and (positive? x) fv))
(float-vector-set! fv i ((if (> i j) + -) i 10.0))))
- (test (fv124) (float-vector -10.0 -9.0 -8.0 13.0))
+ (test (fv124) #r(-10.0 -9.0 -8.0 13.0))
(define (fv126)
- (let ((d0 (float-vector 1 0 -1 0 1 0 -1 0))
- (d1 (float-vector 0 1 0 -1 0 1 0 -1))
- (e0 (float-vector 0 0 8 0 0 0 0 0))
+ (let ((d0 #r(1 0 -1 0 1 0 -1 0))
+ (d1 #r(0 1 0 -1 0 1 0 -1))
+ (e0 #r(0 0 8 0 0 0 0 0))
(e1 (make-float-vector 8))
(rl (make-float-vector 8))
(im (make-float-vector 8)))
@@ -37553,7 +37545,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i ((if (or (> i j) (= i 3)) + -) i 10.0))))
- (test (fv127) (float-vector -10.0 -9.0 -8.0 13.0))
+ (test (fv127) #r(-10.0 -9.0 -8.0 13.0))
(define (fv129)
(do ((fv (make-float-vector 4))
@@ -37561,7 +37553,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i ((if (and (= i j) (< i 3)) + -) i 10.0))))
- (test (fv129) (float-vector -10.0 -9.0 12.0 -7.0))
+ (test (fv129) #r(-10.0 -9.0 12.0 -7.0))
(define (fv130)
(do ((fv (make-float-vector 4))
@@ -37569,10 +37561,10 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(float-vector-set! fv i ((if (char=? j #\a) + -) i 10.0))))
- (test (fv130) (float-vector 10.0 11.0 12.0 13.0))
+ (test (fv130) #r(10.0 11.0 12.0 13.0))
(define (char-permute op . args)
- (eval (copy `(let ()
+ (let ((form `(let ()
(define (t1)
(let ((x #\a) (y #\A) (fv (make-float-vector 4)))
(do ((i 0 (+ i 1))
@@ -37592,8 +37584,8 @@ EDITS: 1
(let ((v1 (t1))
(v2 (t2)))
(if (not (morally-equal? v1 v2))
- (format *stderr* "char-permute ~A, ~A -> ~A ~A~%" op args v1 v2))))
- :readable)))
+ (format *stderr* "char-permute ~A, ~A -> ~A ~A~%" op args v1 v2))))))
+ (eval (copy form :readable))))
(for-each
(lambda (op)
@@ -37651,7 +37643,7 @@ EDITS: 1
(define (fv131)
(let ((fv1 (make-float-vector 10))
(fv2 #f)
- (coeffs (float-vector 0.0 0.5 0.25 0.125)))
+ (coeffs #r(0.0 0.5 0.25 0.125)))
(do ((i 0 (+ i 1))
(x 0.0 (+ x 0.1)))
((= i 10))
@@ -37668,8 +37660,8 @@ EDITS: 1
(define (fv132)
(let ((fv1 (make-float-vector 10))
(fv2 #f)
- (t-coeffs (float-vector 0.0 0.5 0.25 0.125))
- (u-coeffs (float-vector 0.0 0.2 0.1 0.05)))
+ (t-coeffs #r(0.0 0.5 0.25 0.125))
+ (u-coeffs #r(0.0 0.2 0.1 0.05)))
(do ((i 0 (+ i 1))
(x 0.0 (+ x 0.1)))
((= i 10))
@@ -37712,7 +37704,7 @@ EDITS: 1
(polywave (if (zero? (modulo i 2)) p3 p4)))
(sawtooth-wave (if (odd? i) s3 s4)))))))
- (test (fv132a) (float-vector 0.0 0.0 0.2754865742400099 0.2754865742400099 0.5330915108442034 0.5330915108442034
+ (test (fv132a) #r(0.0 0.0 0.2754865742400099 0.2754865742400099 0.5330915108442034 0.5330915108442034
0.7567925994733748 0.7567925994733748 0.9340879688376413 0.9340879688376413))
(define (fv136)
@@ -37866,7 +37858,7 @@ EDITS: 1
(test (fv149) (vector #\0 #\1 #\2 #\3))
(define (fv150)
- (do ((g0 (int-vector 0 1 2 3 4))
+ (do ((g0 #i(0 1 2 3 4))
(v (make-vector 4))
(i 0 (+ i 1)))
((= i 4) v)
@@ -37874,7 +37866,7 @@ EDITS: 1
(test (fv150) (vector 0 1 2 3))
(define (fv151)
- (do ((g0 (float-vector 0 1 2 3 4))
+ (do ((g0 #r(0 1 2 3 4))
(v (make-vector 4))
(i 0 (+ i 1)))
((= i 4) v)
@@ -37907,20 +37899,20 @@ EDITS: 1
(test (fv154) "0123")
(define (fv155)
- (do ((g0 (int-vector 0 1 2 3 4))
+ (do ((g0 #i(0 1 2 3 4))
(v (make-int-vector 4 -1))
(i 0 (+ i 1)))
((= i 4) v)
(set! (v i) (g0 i))))
- (test (fv155) (int-vector 0 1 2 3))
+ (test (fv155) #i(0 1 2 3))
(define (fv156)
- (do ((g0 (float-vector 0 1 2 3 4))
+ (do ((g0 #r(0 1 2 3 4))
(v (make-float-vector 4 pi))
(i 0 (+ i 1)))
((= i 4) v)
(set! (v i) (g0 i))))
- (test (fv156) (float-vector 0 1 2 3))
+ (test (fv156) #r(0 1 2 3))
(define (fv157)
(do ((g0 (inlet 'a 0 'b 1 'c 2 'd 3))
@@ -37956,7 +37948,7 @@ EDITS: 1
(i 0 (+ i 1)))
((= i 4) fv)
(int-vector-set! fv i (iterate iter))))
- (test (fv162) (int-vector 1 2 3 4))
+ (test (fv162) #i(1 2 3 4))
(define (fv163)
(do ((fv (make-float-vector 4))
@@ -38173,11 +38165,6 @@ EDITS: 1
(do ((i 0 (+ i 1)) (x 0.0 (+ x .01))) ((= i 100)) (float-vector-set! v-1 i x))
(define v0 (make-float-vector 10))
- (define args1 (list 1.5 '(oscil o1) '(env e1) 'x 'i '(oscil o) '(- 1.0 x) '(oscil (vector-ref oscs k))))
- (define args2 (list 1.5 '(oscil o2) '(env e2) 'y 'i '(float-vector-ref v-1 i)))
- (define args3 (list 1.5 '(oscil o3) '(env e3) 'z 'i '(cos x)))
- ;(define args4 (list 1.5 '(oscil o4) '(env e4) 'x 'i))
-
(define (try str)
(eval-string
(call-with-output-string
@@ -38485,8 +38472,10 @@ EDITS: 1
`(" (format *stderr* \"env let ~A:~~% ~~A~~% ~~A~~%\" v9 v10))~%~%" ,str)
`(" (if (not (mus-arrays-equal? v11 v12))~%")
`(" (format *stderr* \"letx ~A:~~% ~~A~~% ~~A~~%\" v11 v12))))~%~%" ,str)))))))
-
- (define (out-args)
+
+ (let ((args1 #(1.5 (oscil o1) (env e1) x i (oscil o) (- 1.0 x) (oscil (vector-ref oscs k))))
+ (args2 #(1.5 (oscil o2) (env e2) y i (float-vector-ref v-1 i)))
+ (args3 #(1.5 (oscil o3) (env e3) z i (cos x))))
(for-each
(lambda (a)
@@ -38570,9 +38559,7 @@ EDITS: 1
(format #f "(+ (sin (oscil o ~A ~A)) ~A)" a b c))))
args3))
args2))
- args1))
- (out-args)
- )))
+ args1)))))
@@ -38971,7 +38958,7 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 3))
(let ((gen (make-oscil 440.0))
- (e (make-env (float-vector 0.0 0.0 1.0 1.0 2.0 0.0) 0.1 1.0))
+ (e (make-env #r(0.0 0.0 1.0 1.0 2.0 0.0) 0.1 1.0))
(beg (* i 50000))
(end (+ 44100 (* i 50000))))
(do ((k beg (+ k 1)))
@@ -39028,7 +39015,7 @@ EDITS: 1
(if (not (= (gad 'i) 0))
(snd-display "grab-bag-i: ~A" (gad 'i)))
(set! (gad 'flt) 123.0)
- (set! (gad 'v) (float-vector .1 .2 .3))
+ (set! (gad 'v) #r(.1 .2 .3))
(set! (gad 'fvect) (vector .1 .2 .3))
(set! (gad 'ivect) (make-vector 3 1))
(set! (gad 'cvect) (make-vector 3 #f))
@@ -39499,7 +39486,7 @@ EDITS: 1
:grain-duration '(0 0.02 1 0.1)
:grain-duration-spread '(0 0 0.5 0.1 1 0)
:where-to grani-to-grain-duration ; from grani.scm
- :where-bins (float-vector 0 0.05 1))
+ :where-bins #r(0 0.05 1))
(grani 0 2 1 "oboe.snd"
:grain-start 0.1 :grain-start-spread 0.01
:amp-envelope '(0 1 1 1) :grain-density 40
@@ -39944,12 +39931,12 @@ EDITS: 1
((= i c) v)
(set! (v i) (sample n ind i)))))
(with-sound (:channels 5 :reverb freeverb :reverb-channels 5 :srate 44100 :reverb-data '(:decay-time .1))
- (frample->file *reverb* 0 (float-vector .2 .1 .05 .025 .0125)))
+ (frample->file *reverb* 0 #r(.2 .1 .05 .025 .0125)))
(if (not (vmus-arrays-equal? (frample 2438) (make-float-vector 5)))
(snd-display "freeverb 2438: ~A" (frample 2438)))
- (if (not (vmus-arrays-equal? (frample 2439) (float-vector 0.04276562482118607 -0.0009843750158324838 0.00995312537997961 -0.0009843750158324838 0.001750000054016709)))
+ (if (not (vmus-arrays-equal? (frample 2439) #r(0.04276562482118607 -0.0009843750158324838 0.00995312537997961 -0.0009843750158324838 0.001750000054016709)))
(format *stderr* ";freeverb 2439: ~A" (frample 2439)))
- (if (not (vmus-arrays-equal? (frample 4305) (float-vector 0.03010422177612782 -0.00203015236184001 0.007028832100331783 -0.001004761666990817 0.00125998433213681)))
+ (if (not (vmus-arrays-equal? (frample 4305) #r(0.03010422177612782 -0.00203015236184001 0.007028832100331783 -0.001004761666990817 0.00125998433213681)))
(format *stderr* ";freeverb 4305: ~A" (frample 4305)))
(close-sound))
@@ -40250,7 +40237,7 @@ EDITS: 1
(with-sound (v1 :revfile v2 :reverb jc-reverb)
(fm-violin 0 .1 440 .1 :degree 0 :reverb-amount 0.9)
(fm-violin 0 .1 440 .1 :degree 0 :reverb-amount 0.9))
- (if (< (maxamp v1) .55)
+ (if (< (maxamp v1) .5)
(snd-display "3 rev with-sound -> vector2 fm-violin maxamp (opt 2): ~A" (maxamp v1)))))
(for-each
@@ -40323,7 +40310,7 @@ EDITS: 1
(snd-display "can't find mixed with-sound output")
(let ((mx (maxamp ind 0)))
(if (< mx .35) (snd-display "mixed with-sound max: ~A" mx))
- (if (not (mus-arrays-equal? (channel->float-vector 1000 10) (float-vector 0.255 0.275 0.316 0.364 0.391 0.379 0.337 0.283 0.228 0.170)))
+ (if (not (mus-arrays-equal? (channel->float-vector 1000 10) #r(0.255 0.275 0.316 0.364 0.391 0.379 0.337 0.283 0.228 0.170)))
(snd-display "mixed with-sound: ~A" (channel->float-vector 1000 10)))
(close-sound ind))))
@@ -40345,7 +40332,7 @@ EDITS: 1
(snd-display "can't find mixed with-sound sound-let output")
(let ((mx (maxamp ind 0)))
(if (< mx .375) (snd-display "mixed with-sound max: ~A" mx))
- (if (not (mus-arrays-equal? (channel->float-vector 1000 10) (float-vector 0.349 0.370 0.412 0.461 0.489 0.478 0.436 0.383 0.328 0.270)))
+ (if (not (mus-arrays-equal? (channel->float-vector 1000 10) #r(0.349 0.370 0.412 0.461 0.489 0.478 0.436 0.383 0.328 0.270)))
(snd-display "mixed with-sound via sound-let: ~A" (channel->float-vector 1000 10)))
(close-sound ind)))))
@@ -41201,10 +41188,10 @@ EDITS: 1
(let ((v (make-vector 2 #f)))
(set! (v 0) (make-nrcos 440 10 .5))
(set! (v 1) (make-nrcos 440 10 .5))
- (do ((i 0 (+ i 1)))
+ (do ((i 0 (+ i 1))
+ (gen (vector-ref v 0)))
((= i base-length))
- (let ((gen (vector-ref v 0)))
- (outa i (nrcos gen)))))))))
+ (outa i (nrcos gen))))))))
(if (not (sound? snd)) (snd-display "vect let nrcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display "vect let nrcos max: ~A" (maxamp snd))))
@@ -42772,7 +42759,7 @@ EDITS: 1
((not happy))
(let ((type (XmStringGetNextTriple c)))
(if (= (car type) XmSTRING_COMPONENT_TEXT)
- (if (not (and (= (cadr type) (#(0 0 2 0 0 0 4 0 0 0 3 0 0 0 4) i))
+ (if (not (and (= (cadr type) (#i(0 0 2 0 0 0 4 0 0 0 3 0 0 0 4) i))
(string=? (caddr type)
(#("o" "o" "go" "o" "o" "o" "well" "o" "o" "o" "and" "o" "o" "o" "then") i))))
(snd-display "component ~A -> ~A" i (cdr type)))
@@ -44710,7 +44697,7 @@ EDITS: 1
(lambda () (n arg))
(lambda args (car args))))
xm-procs1))
- (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .95 .95 .95) #(0 1) 3/4 'mus-error 0+i (make-delay 32)
+ (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (vector 0 1) (make-color-with-catch .95 .95 .95) #i(0 1) 3/4 'mus-error 0+i (make-delay 32)
(lambda () #t) (curlet) (make-float-vector '(2 3)) :order 0 1 -1 #f #t () #()))
;; ---------------- 2 Args
@@ -44724,31 +44711,31 @@ EDITS: 1
(lambda () (n arg1 arg2))
(lambda args (car args))))
xm-procs2))
- (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .95 .95 .95) #(0 1) 3/4
+ (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .95 .95 .95) #i(0 1) 3/4 (vector 0 1)
0+i (make-delay 32) :feedback -1 0 #f #t () #())))
- (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .95 .95 .95) #(0 1) 3/4
+ (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .95 .95 .95) #i(0 1) 3/4 (vector 0 1)
0+i (make-delay 32) :frequency -1 0 #f #t () #()))
- (if all-args
- ;; ---------------- 3 Args
- (for-each
- (lambda (arg1)
- (for-each
- (lambda (arg2)
- (for-each
- (lambda (arg3)
- (for-each
- (lambda (n)
- (catch #t
- (lambda () (n arg1 arg2 arg3))
- (lambda args (car args))))
- xm-procs3))
- (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) #(0 1) 0+i (make-delay 32)
- :start -1 0 #f #t () #())))
- (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) #(0 1) 0+i (make-delay 32)
- :phase -1 0 #f #t () #())))
- (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) #(0 1) 0+i (make-delay 32)
- :channels -1 0 #f #t () #())))
+ (when all-args
+ ;; ---------------- 3 Args
+ (for-each
+ (lambda (arg1)
+ (for-each
+ (lambda (arg2)
+ (for-each
+ (lambda (arg3)
+ (for-each
+ (lambda (n)
+ (catch #t
+ (lambda () (n arg1 arg2 arg3))
+ (lambda args (car args))))
+ xm-procs3))
+ (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) #i(0 1) 0+i (make-delay 32) (vector 0 1)
+ :start -1 0 #f #t () #())))
+ (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) #i(0 1) 0+i (make-delay 32) (vector 0 1)
+ :phase -1 0 #f #t () #())))
+ (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) #i(0 1) 0+i (make-delay 32) (vector 0 1)
+ :channels -1 0 #f #t () #())))
(let ((struct-accessors #(.pixel .red .green .blue .flags .pad .x .y .width .height .angle1 .angle2 .ptr
.x1 .y1 .x2 .y2 .dashes .dash_offset .clip_mask .clip_y_origin .clip_x_origin .graphics_exposures
@@ -45243,11 +45230,11 @@ EDITS: 1
(set! float-vector-3 (make-polyshape :frequency 300 :partials '(1 1 2 1)))
(set! car-main (make-oscil))
(set! cadr-main (vector 1 2 3))
- (set! a-hook (float-vector 0.2 0.1)))
+ (set! a-hook #r(0.2 0.1)))
((4)
- (set! delay-32 (make-filter 3 (float-vector 3 1 2 3) (float-vector 3 1 2 3)))
+ (set! delay-32 (make-filter 3 #r(3 1 2 3) #r(3 1 2 3)))
(set! color-95 (make-float-vector '(2 1)))
- (set! vector-0 (make-iir-filter 3 (float-vector 1 2 3)))
+ (set! vector-0 (make-iir-filter 3 #r(1 2 3)))
(set! float-vector-3 (make-ncos))
(set! car-main (make-env '(0 0 1 1) :length 101))
(set! cadr-main (make-nsin 100 4))
@@ -45258,7 +45245,7 @@ EDITS: 1
(set! vector-0 (make-vector 1))
(set! car-main (make-moving-average 3))
(set! cadr-main (make-oscil 440))
- (set! a-hook (make-shared-vector (float-vector 0.1 0.2 0.1 0.2) (list 2 2)))))
+ (set! a-hook (make-shared-vector #r(0.1 0.2 0.1 0.2) (list 2 2)))))
(for-each (lambda (n)
(let ((tag
@@ -45353,7 +45340,7 @@ EDITS: 1
(if (not (eq? tag 'wrong-type-arg))
(snd-display "float-vector 0 wrong-type-arg ~A: ~A ~A" n tag arg))))
(list make-float-vector float-vector-peak float-vector-max float-vector-min)))
- (list (make-vector 1) "hiho" 0+i 1.5 #(0 1) delay-32))
+ (list (make-vector 1) "hiho" 0+i 1.5 #i(0 1) delay-32))
(for-each (lambda (arg1)
(for-each (lambda (arg2)
@@ -45366,8 +45353,8 @@ EDITS: 1
(if (not (memq tag '(wrong-type-arg wrong-number-of-args mus-error)))
(snd-display "float-vector 1 wrong-whatever ~A: ~A ~A ~A" n tag arg1 arg2))))
(list float-vector-add! float-vector-subtract! float-vector-multiply! float-vector-ref float-vector-scale!)))
- (list float-vector-5 "hiho" 0+i 1.5 (list 1 0) #(0 1) delay-32)))
- (list (make-vector 1) "hiho" 0+i 1.5 (list 1 0) #(0 1) delay-32))
+ (list float-vector-5 "hiho" 0+i 1.5 (list 1 0) #i(0 1) delay-32)))
+ (list (make-vector 1) "hiho" 0+i 1.5 (list 1 0) #i(0 1) delay-32))
(for-each (lambda (arg)
(for-each (lambda (n)
@@ -45379,7 +45366,7 @@ EDITS: 1
(if (not (eq? tag 'wrong-type-arg))
(snd-display "float-vector arg 2 (scaler) wrong-type-arg ~A: ~A ~A" n arg tag))))
(list float-vector-add! float-vector-subtract! float-vector-multiply! float-vector-ref float-vector-scale!)))
- (list (make-vector 1) "hiho" 0+i (list 1 0) #(0 1) delay-32))
+ (list (make-vector 1) "hiho" 0+i (list 1 0) #i(0 1) delay-32))
(let ((tag (catch #t
(lambda ()
@@ -45404,7 +45391,7 @@ EDITS: 1
square-wave? src? ncos? nsin? tap? table-lookup?
triangle-wave? two-pole? two-zero? wave-train? color? mix-sampler? moving-average? moving-max? moving-norm? ssb-am?
sampler? region-sampler? float-vector? )))
- (list (make-vector 1) "hiho" 0+i 1.5 (list 1 0) #(0 1)))
+ (list (make-vector 1) "hiho" 0+i 1.5 (list 1 0) #i(0 1)))
(for-each (lambda (n)
@@ -45780,7 +45767,7 @@ EDITS: 1
(list region-chans region-home region-framples
region-position region-maxamp region-maxamp-position region-sample
region->float-vector region-srate forget-region)))
- (list float-vector-5 #(0 1) 0+i "hiho" (list 0 1)))
+ (list float-vector-5 #i(0 1) 0+i "hiho" (list 0 1)))
(for-each (lambda (n)
(let ((tag
@@ -45847,7 +45834,7 @@ EDITS: 1
(lambda () (new-sound "fmv.snd" 2 22050 mus-bfloat mus-nist "this is a comment"))
(lambda () (new-sound "hiho" :header-type mus-nist :sample-type mus-bfloat))))
(check-error-tag 'bad-type (lambda () (normalize-partials '(1 2 3))))
- (check-error-tag 'bad-type (lambda () (normalize-partials (float-vector 3))))
+ (check-error-tag 'bad-type (lambda () (normalize-partials #r(3))))
(check-error-tag 'cannot-print graph->ps)
(check-error-tag 'cannot-save (lambda () (mus-sound-report-cache "/bad/baddy")))
(check-error-tag 'cannot-save (lambda () (save-envelopes "/bad/baddy")))
@@ -45871,7 +45858,7 @@ EDITS: 1
(lambda () (set! (mus-offset (make-oscil)) 1))
(lambda () (set! (mus-xcoeff (make-filter 3 :xcoeffs float-vector-3 :ycoeffs float-vector-3) 4) 1.0))
(lambda () (set! (mus-ycoeff (make-filter 3 :xcoeffs float-vector-3 :ycoeffs float-vector-3) 4) 1.0))))
- (check-error-tag 'no-data (lambda () (make-polyshape 440.0 :partials (float-vector 1 1 -2 1))))
+ (check-error-tag 'no-data (lambda () (make-polyshape 440.0 :partials #r(1 1 -2 1))))
(check-error-tag 'no-data (lambda () (make-polyshape 440.0 :partials '(1 1 -2 1))))
(check-error-tag 'no-data (lambda () (make-polyshape 440.0 :partials ())))
(check-error-tag 'no-such-channel (lambda () (make-sampler 0 "oboe.snd" -1)))
@@ -45895,8 +45882,8 @@ EDITS: 1
(vector (lambda () (dot-product (make-float-vector 3) (make-float-vector 3) -1))
(lambda () (make-color -0.5 0.0 0.0))
(lambda () (make-color 1.5 0.0 0.0))
- (lambda () (make-delay 3 :initial-element 0.0 :initial-contents (float-vector .1 .2 .3)))
- (lambda () (make-delay 3 :max-size 100 :initial-contents (float-vector .1 .2 .3)))
+ (lambda () (make-delay 3 :initial-element 0.0 :initial-contents #r(.1 .2 .3)))
+ (lambda () (make-delay 3 :max-size 100 :initial-contents #r(.1 .2 .3)))
(lambda () (make-file->frample "oboe.snd" -1))
(lambda () (make-file->frample "oboe.snd" 0))
(lambda () (make-file->sample "oboe.snd" -1))
@@ -46006,7 +45993,7 @@ EDITS: 1
(check-error-tag 'no-such-graphics-context (lambda () (draw-line 0 0 1 1 ind 0 1234)))
(check-error-tag 'no-such-graphics-context (lambda () (foreground-color ind 0 1234)))
(check-error-tag 'no-such-graphics-context (lambda () (graph-data (list float-vector-3 float-vector-3) ind 0 1234 0 1 0)))
- (check-error-tag 'no-such-sample (lambda () (mix-float-vector (float-vector 0.1 0.2 0.3) -1 ind 0 #t)))
+ (check-error-tag 'no-such-sample (lambda () (mix-float-vector #r(0.1 0.2 0.3) -1 ind 0 #t)))
(check-error-tag 'no-such-sample (lambda () (sample -1)))
(check-error-tag 'no-such-sample (lambda () (set! (sample -1) -1)))
(check-error-tag 'no-such-sound (lambda () (axis-info 1234)))
@@ -46068,10 +46055,10 @@ EDITS: 1
(check-error-tag 'cannot-save (lambda () (save-sound-as "/bad/baddy.snd")))
(check-error-tag 'no-such-sound (lambda () (transform-sample 0 1 1234)))
(check-error-tag 'no-such-channel (lambda () (transform-sample 0 1 ind 1234)))
- (check-error-tag 'no-such-sound (lambda () (graph (float-vector 0 1) "hi" 0 1 0 1 1234)))
- (check-error-tag 'no-such-channel (lambda () (graph (float-vector 0 1) "hi" 0 1 0 1 ind 1234)))
+ (check-error-tag 'no-such-sound (lambda () (graph #r(0 1) "hi" 0 1 0 1 1234)))
+ (check-error-tag 'no-such-channel (lambda () (graph #r(0 1) "hi" 0 1 0 1 ind 1234)))
(set! (selection-member? #t) #f)
- (check-error-tag 'no-active-selection (lambda () (filter-selection (float-vector 0 0 1 1) 4)))
+ (check-error-tag 'no-active-selection (lambda () (filter-selection #r(0 0 1 1) 4)))
(check-error-tag 'no-active-selection (lambda () (save-selection "/bad/baddy.snd")))
(check-error-tag 'no-active-selection (lambda () (env-selection '(0 0 1 1))))
(make-region 0 100 ind 0)
@@ -46085,7 +46072,7 @@ EDITS: 1
(check-error-tag 'no-data (lambda () (scale-to ())))
(check-error-tag 'no-such-auto-delete-choice (lambda () (insert-sound "1a.snd" 0 0 ind 0 0 123)))
(check-error-tag 'no-such-channel (lambda () (filter-channel '(0 0 1 1) 100 #f #f ind 1)))
- (check-error-tag 'no-such-channel (lambda () (filter-channel (float-vector 0 0 1 1) 4 #f #f ind 1)))
+ (check-error-tag 'no-such-channel (lambda () (filter-channel #r(0 0 1 1) 4 #f #f ind 1)))
(check-error-tag 'no-such-direction (lambda () (make-sampler 0 ind 0 -2)))
(check-error-tag 'no-such-direction (lambda () (make-sampler 0 ind 0 0)))
(check-error-tag 'no-such-direction (lambda () (make-sampler 0 ind 0 123)))
@@ -46108,8 +46095,8 @@ EDITS: 1
(for-each (lambda (arg)
(check-error-tag 'out-of-range arg))
(vector (lambda () (env-sound '(0 0 1 1) 0 #f -1.5))
- (lambda () (filter-sound (float-vector 0 0 1 1) 0))
- (lambda () (filter-sound (float-vector 0 0 1 1) 10))
+ (lambda () (filter-sound #r(0 0 1 1) 0))
+ (lambda () (filter-sound #r(0 0 1 1) 10))
(lambda () (set! (graph-style ind 0) -123))
(lambda () (set! (graph-style ind 0) 123))
(lambda () (set! (reverb-control-length-bounds ind) (list .1 .01)))
@@ -46233,7 +46220,7 @@ EDITS: 1
(dismiss-all-dialogs)
(for-each close-sound (sounds))
- (let* ((main-args (list 1.5 str-3 (list 0 1) 12 float-vector-3 color-95 #(0 1) 3/4 'mus-error 0+i delay-32
+ (let* ((main-args (list 1.5 str-3 (list 0 1) 12 float-vector-3 color-95 #i(0 1) 3/4 'mus-error 0+i delay-32
(lambda () #t) float-vector-5 :order 0 1 -1 a-hook #f #t #\c 0.0 -1.0
() 3 64 -64 vector-0 '(1 . 2) (expt 2.0 21.5) (expt 2.0 -18.0) car-main cadr-main
(lambda (a) #f) abs
@@ -46245,7 +46232,7 @@ EDITS: 1
(random-state 12) (float-vector) (vector)))
(less-args (if all-args
main-args
- (list 1.5 str-3 (list 0 1) 12 float-vector-3 color-95 #(0 1) 3/4 -1.0 (float-vector) (vector) () ""
+ (list 1.5 str-3 (list 0 1) 12 float-vector-3 color-95 #i(0 1) 3/4 -1.0 (float-vector) (vector) () ""
0+i delay-32 :feedback -1 0 1 'hi (lambda (a) (+ a 1)) -64 #f #t vector-0))))
;; ---------------- 1 Arg
@@ -46509,30 +46496,19 @@ EDITS: 1
;; #(59 58 114 95 2244 5373 613 134 11680 2892 609 743 868 976 815 1288 3020 197 168 2952 758 1925 4997 6567 846 183 0 242 6696 0))) ; 571
;;
+;; fatty4
;; 19-Dec-12: #(1 1 2 2 69 240 6 1 583 1 23 1 1 17 70 1 233 1 1 271 89 119 1 1877 0 0 0 1 1 73) ; 37
-;; 23-Dec-12: #(1 1 2 1 67 243 7 1 586 1 16 1 2 18 63 1 223 1 1 270 92 115 1 1821 0 0 0 1 1 80) ; 36
-;; 26-Dec-12: #(1 1 2 1 65 199 6 1 556 1 15 1 1 12 26 1 229 1 1 276 52 108 1 1777 0 0 0 1 2 75) ; 34
;; 1-Jan-13: #(1 1 2 2 64 200 7 1 575 1 17 1 2 12 84 1 246 1 1 215 45 111 1 1552 0 0 0 1 2 77) ; 32
-;; 3-Jan-13: #(1 1 2 1 65 185 6 1 564 1 20 1 2 11 26 1 202 1 1 213 45 109 1 1545 0 0 0 1 1 80) ; 31
-;; 9-Jan-13: #(1 1 2 1 63 181 7 1 540 1 19 1 2 11 22 1 201 1 1 207 44 107 1 1504 0 0 0 1 1 79) ; 30
-;; 25-Jan-13: #(1 1 2 1 58 178 6 1 505 1 13 1 2 10 20 1 205 1 1 198 44 111 1 1487 0 0 0 1 1 75) ; 29
;; 11-Feb-13: #(1 1 3 2 49 170 5 1 463 1 15 1 1 11 46 1 216 1 2 158 42 110 1 1456 0 0 0 1 1 80) ; 28
-;; 15-Feb-13: #(1 1 2 2 42 160 5 1 450 1 18 1 1 10 21 1 196 1 1 158 42 107 1 1407 0 0 0 1 1 79) ; 27
-;; 21-Feb-13: #(1 1 2 2 43 159 6 1 448 1 12 1 2 10 20 1 189 1 2 156 41 106 1 1331 0 0 0 1 1 76) ; 26
-;; 26-Feb-13: #(1 1 2 2 42 118 5 1 450 1 16 1 2 11 19 1 97 1 1 161 42 105 1 1323 0 0 0 1 2 74) ; 25
;; 1-Mar-13: #(1 1 3 1 40 117 5 1 439 1 16 1 2 11 20 1 109 1 2 159 43 100 1 1263 0 0 0 1 2 78) ; 24
-;; 7-Mar-13: #(1 1 2 2 41 119 6 1 396 1 16 1 2 10 23 1 103 1 1 144 41 85 1 1215 0 0 0 1 1 80) ; 23
-;; 8-Mar-13: #(1 1 3 2 32 102 5 1 363 1 15 1 2 10 21 1 90 1 1 144 41 87 1 1219 0 0 0 1 2 78) ; 22
-;; 14-Mar-13: #(1 1 2 2 31 92 4 1 316 1 19 1 2 12 17 1 80 1 1 121 40 81 1 1174 0 0 0 1 1 75) ; 21
-;; 20-Mar-13: #(1 1 2 2 30 90 4 1 317 1 12 1 1 10 22 1 79 1 1 115 40 78 1 1131 0 0 0 1 2 79) ; 20
;; 3-Apr-13: #(1 1 2 2 30 89 4 1 297 1 11 1 2 10 9 1 81 1 1 110 41 73 1 1048 0 0 0 1 2 80) ; 19
-;; 14-Apr-13: #(1 1 2 2 31 88 4 1 288 1 16 1 2 10 17 1 77 1 1 110 39 73 1 975 0 0 0 1 2 75) ; 18
-;; 21-Apr-13: #(1 1 2 2 27 88 4 1 266 1 15 1 2 10 15 1 78 1 1 97 39 69 1 917 0 0 0 1 2 77) ; 17
;; 24-Feb-14: #(1 1 2 1 22 74 2 1 162 2 9 1 3 8 9 2 54 2 70 33 24 2 791 0 0 1 82) ; 14
;; 15-Mar-14: #(1 2 3 2 25 71 3 2 129 1 8 1 2 8 14 2 45 2 74 32 25 1 781 0 0 2 81) ; 13
;; 1-Oct-14: #(1 2 2 2 22 68 2 2 114 2 9 1 3 8 50 1 45 2 70 32 26 2 749 0 0 2 113) ; 13
;; 9-Mar-15: #(1 1 3 2 86 69 3 3 131 1 8 2 2 8 8 3 43 2 71 30 33 2 697 0 0 3 130) ; 13
;; 29-May-15: #(2 3 3 3 22 79 3 3 130 3 8 3 4 9 9 3 49 3 75 30 28 3 708 0 0 3 144) ; 13
+;; fatty10
+;; 30-Jan-17: #(0 0 1 0 6 45 1 1 101 1 4 1 1 3 4 1 29 1 48 12 9 3 389 0 0 1 181) ; 8
;;; -------- cleanup temp files
@@ -46649,8 +46625,8 @@ EDITS: 1
|#
(gc) (gc)
-(s7-version)
+(s7-version)
(if with-exit (exit))
;;; ---------------- test the end
@@ -46801,4 +46777,30 @@ callgrind_annotate --auto=yes callgrind.out.<pid> > hi
339,193,555 clm.c:filter_ge_10 [/home/bil/motif-snd/snd]
337,020,228 clm.c:mus_src_to_buffer [/home/bil/motif-snd/snd]
330,406,288 clm.c:fb_many_with_amps_c1_c2 [/home/bil/motif-snd/snd]
+
+4-Jan-17:
+40,444,112,752
+5,554,262,169 s7.c:eval'2 [/home/bil/motif-snd/snd]
+2,847,440,755 ???:sin [/lib64/libm-2.12.so]
+2,008,826,659 ???:cos [/lib64/libm-2.12.so]
+1,267,013,962 clm.c:fir_ge_20 [/home/bil/motif-snd/snd]
+1,131,280,306 s7.c:eval [/home/bil/motif-snd/snd]
+1,046,123,928 clm.c:mus_src [/home/bil/motif-snd/snd]
+ 985,044,773 s7.c:gc [/home/bil/motif-snd/snd]
+ 901,961,680 ???:t2_32 [/home/bil/motif-snd/snd]
+ 803,333,049 ???:t2_64 [/home/bil/motif-snd/snd]
+ 627,021,459 clm.c:mus_phase_vocoder_with_editors [/home/bil/motif-snd/snd]
+ 608,930,865 snd-edits.c:channel_local_maxamp [/home/bil/motif-snd/snd]
+ 594,199,460 clm.c:fb_one_with_amps_c1_c2 [/home/bil/motif-snd/snd]
+ 489,290,304 io.c:mus_read_any_1 [/home/bil/motif-snd/snd]
+ 459,835,320 ???:n1_64 [/home/bil/motif-snd/snd]
+ 412,138,226 clm2xen.c:outa_x_rf_to_mus_xen [/home/bil/motif-snd/snd]
+ 394,019,684 vct.c:vct_add [/home/bil/motif-snd/snd]
+ 371,153,394 clm.c:mus_env_linear [/home/bil/motif-snd/snd]
+ 350,476,620 ???:memcpy [/lib64/ld-2.12.so]
+ 345,704,896 clm.c:run_hilbert [/home/bil/motif-snd/snd]
+ 339,193,555 clm.c:filter_ge_10 [/home/bil/motif-snd/snd]
+ 337,020,228 clm.c:mus_src_to_buffer [/home/bil/motif-snd/snd]
+ 330,406,288 clm.c:fb_many_with_amps_c1_c2 [/home/bil/motif-snd/snd]
+
|#
diff --git a/snd-xen.c b/snd-xen.c
index 33ed4bb..19ab903 100644
--- a/snd-xen.c
+++ b/snd-xen.c
@@ -645,7 +645,6 @@ char *procedure_ok(Xen proc, int args, const char *caller, const char *arg_name,
{
int rargs;
/* if string returned, needs to be freed */
- /* 0 args is special => "thunk" meaning in this case that optional args are not ok (applies to as-one-edit and two menu callbacks) */
if (!(Xen_is_procedure(proc)))
{
@@ -2717,7 +2716,7 @@ void g_xen_initialize(void)
#if HAVE_GSL_EIGEN_NONSYMMV_WORKSPACE
s7_pointer pl_pf;
#endif
-#if HAVE_GSL
+#if HAVE_GSL || HAVE_GL
s7_pointer pl_prr, p;
p = s7_make_symbol(s7, "pair?");
#endif
diff --git a/snd-xref.c b/snd-xref.c
index fa45c31..f17f38e 100644
--- a/snd-xref.c
+++ b/snd-xref.c
@@ -1,5 +1,5 @@
/* Snd help index (generated by make-index.scm) */
-#define HELP_NAMES_SIZE 1612
+#define HELP_NAMES_SIZE 1584
#if HAVE_SCHEME || HAVE_FORTH
static const char *help_names[HELP_NAMES_SIZE] = {
"*#readers*", "abcos", "abcos?", "abort", "absin", "absin?",
@@ -21,7 +21,7 @@ static const char *help_names[HELP_NAMES_SIZE] = {
"bold-peaks-font", "break", "brown-noise", "brown-noise?", "butterworth filters", "byte-vector",
"byte-vector-ref", "byte-vector-set!", "byte-vector?", "c-define", "c-g?", "c-object?",
"c-pointer", "c-pointer?", "call-with-exit", "canter", "cascade->canonical", "catch",
- "cellon", "chain-dsps", "channel->vct", "channel-amp-envs", "channel-data", "channel-envelope",
+ "cellon", "chain-dsps", "channel->float-vector", "channel-amp-envs", "channel-data", "channel-envelope",
"channel-polynomial", "channel-properties", "channel-property", "channel-rms", "channel-style", "channel-sync",
"channel-widgets", "channels", "channels-equal?", "channels=?", "chans", "char-position",
"cheby-hka", "chebyshev filters", "check-mix-tags", "chordalize", "chorus", "clean-channel",
@@ -33,42 +33,42 @@ static const char *help_names[HELP_NAMES_SIZE] = {
"constant?", "continuation?", "continue-frample->file", "continue-sample->file", "contrast-channel", "contrast-control",
"contrast-control-amp", "contrast-control-bounds", "contrast-control?", "contrast-enhancement", "contrast-sound", "controls->channel",
"convolution", "convolution reverb", "convolve", "convolve-files", "convolve-selection-with", "convolve-with",
- "convolve?", "copy", "copy-context", "copy-sampler", "correlate", "coverlet",
- "cross-fade (amplitude)", "cross-fade (frequency domain)", "cross-synthesis", "curlet", "current-font", "cursor",
- "cursor-color", "cursor-context", "cursor-location-offset", "cursor-position", "cursor-size", "cursor-style",
- "cursor-update-interval", "cutlet", "cyclic-sequences", "dac-combines-channels", "dac-size", "data-color",
- "data-location", "data-size", "db->linear", "default-output-chans", "default-output-header-type", "default-output-sample-type",
- "default-output-srate", "defgenerator", "define*", "define-constant", "define-envelope", "define-expansion",
- "define-macro", "define-macro*", "define-selection-via-marks", "defined?", "degrees->radians", "delay",
- "delay-channel-mixes", "delay-tick", "delay?", "delete-colormap", "delete-file-filter", "delete-file-sorter",
- "delete-mark", "delete-marks", "delete-sample", "delete-samples", "delete-samples-and-smooth", "delete-selection",
- "delete-selection-and-smooth", "delete-transform", "describe-hook", "describe-mark", "dht", "dialog-widgets",
- "dilambda", "disable-control-panel", "display-bark-fft", "display-correlation", "display-db", "display-edits",
- "display-energy", "dissolve-fade", "dither-channel", "dither-sound", "dolph", "dot-product",
- "dot-size", "down-oct", "draw-axes", "draw-dot", "draw-dots", "draw-line",
- "draw-lines", "draw-mark-hook", "draw-mix-hook", "draw-string", "drone", "drop sites",
- "drop-hook", "during-open-hook", "edit-fragment", "edit-header-dialog", "edit-hook", "edit-list->function",
- "edit-position", "edit-properties", "edit-property", "edit-tree", "edits", "edot-product",
- "effects-hook", "elliptic filters", "env", "env-any", "env-channel", "env-channel-with-base",
- "env-expt-channel", "env-interp", "env-mixes", "env-selection", "env-sound", "env-sound-interp",
- "env-squared-channel", "env?", "enved-base", "enved-clip?", "enved-dialog", "enved-envelope",
- "enved-filter", "enved-filter-order", "enved-hook", "enved-in-dB", "enved-power", "enved-style",
- "enved-target", "enved-wave?", "enved-waveform-color", "envelope-interp", "enveloped-mix", "eoddcos",
- "eoddcos?", "eps-bottom-margin", "eps-file", "eps-left-margin", "eps-size", "ercos",
- "ercos?", "*error-hook*", "erssb", "erssb?", "even-multiple", "even-weight",
- "every-sample?", "exit", "exit-hook", "expand-control", "expand-control-bounds", "expand-control-hop",
- "expand-control-jitter", "expand-control-length", "expand-control-ramp", "expand-control?", "explode-sf2", "exponentially-weighted-moving-average",
- "expsnd", "expsrc", "*features*", "feedback fm", "fft", "fft-cancel",
- "fft-edit", "fft-env-edit", "fft-env-interp", "fft-log-frequency", "fft-log-magnitude", "fft-smoother",
- "fft-squelch", "fft-window", "fft-window-alpha", "fft-window-beta", "fft-with-phases", "file database",
- "file->array", "file->frample", "file->frample?", "file->sample", "file->sample?", "file-name",
- "fill!", "fill-polygon", "fill-rectangle", "filter", "filter-channel", "filter-control-coeffs",
- "filter-control-envelope", "filter-control-in-dB", "filter-control-in-hz", "filter-control-order", "filter-control-waveform-color", "filter-control?",
- "filter-fft", "filter-selection", "filter-selection-and-smooth", "filter-sound", "filter?", "filtered-comb",
- "filtered-comb-bank", "filtered-comb-bank?", "filtered-comb?", "find-dialog", "find-mark", "find-mix",
- "find-sound", "finfo", "finish-progress-report", "fir-filter", "fir-filter?", "firmant",
- "firmant?", "fit-selection-between-marks", "flatten-partials", "float-vector", "float-vector*", "float-vector+",
- "float-vector->channel", "float-vector->list", "float-vector->string", "float-vector-abs!", "float-vector-add!", "float-vector-copy",
+ "convolve?", "copy", "copy", "copy-context", "copy-sampler", "correlate",
+ "coverlet", "cross-fade (amplitude)", "cross-fade (frequency domain)", "cross-synthesis", "curlet", "current-font",
+ "cursor", "cursor-color", "cursor-context", "cursor-location-offset", "cursor-position", "cursor-size",
+ "cursor-style", "cursor-update-interval", "cutlet", "cyclic-sequences", "dac-combines-channels", "dac-size",
+ "data-color", "data-location", "data-size", "db->linear", "default-output-chans", "default-output-header-type",
+ "default-output-sample-type", "default-output-srate", "defgenerator", "define*", "define-constant", "define-envelope",
+ "define-expansion", "define-macro", "define-macro*", "define-selection-via-marks", "defined?", "degrees->radians",
+ "delay", "delay-channel-mixes", "delay-tick", "delay?", "delete-colormap", "delete-file-filter",
+ "delete-file-sorter", "delete-mark", "delete-marks", "delete-sample", "delete-samples", "delete-samples-and-smooth",
+ "delete-selection", "delete-selection-and-smooth", "delete-transform", "describe-hook", "describe-mark", "dht",
+ "dialog-widgets", "dilambda", "disable-control-panel", "display-bark-fft", "display-correlation", "display-db",
+ "display-edits", "display-energy", "dissolve-fade", "dither-channel", "dither-sound", "dolph",
+ "dot-product", "dot-size", "down-oct", "draw-axes", "draw-dot", "draw-dots",
+ "draw-line", "draw-lines", "draw-mark-hook", "draw-mix-hook", "draw-string", "drone",
+ "drop sites", "drop-hook", "during-open-hook", "edit-fragment", "edit-header-dialog", "edit-hook",
+ "edit-list->function", "edit-position", "edit-properties", "edit-property", "edit-tree", "edits",
+ "edot-product", "effects-hook", "elliptic filters", "env", "env-any", "env-channel",
+ "env-channel-with-base", "env-expt-channel", "env-interp", "env-mixes", "env-selection", "env-sound",
+ "env-sound-interp", "env-squared-channel", "env?", "enved-base", "enved-clip?", "enved-dialog",
+ "enved-envelope", "enved-filter", "enved-filter-order", "enved-hook", "enved-in-dB", "enved-power",
+ "enved-style", "enved-target", "enved-wave?", "enved-waveform-color", "envelope-interp", "enveloped-mix",
+ "eoddcos", "eoddcos?", "eps-bottom-margin", "eps-file", "eps-left-margin", "eps-size",
+ "ercos", "ercos?", "*error-hook*", "erssb", "erssb?", "even-multiple",
+ "even-weight", "every-sample?", "exit", "exit-hook", "expand-control", "expand-control-bounds",
+ "expand-control-hop", "expand-control-jitter", "expand-control-length", "expand-control-ramp", "expand-control?", "explode-sf2",
+ "exponentially-weighted-moving-average", "expsnd", "expsrc", "*features*", "feedback fm", "fft",
+ "fft-cancel", "fft-edit", "fft-env-edit", "fft-env-interp", "fft-log-frequency", "fft-log-magnitude",
+ "fft-smoother", "fft-squelch", "fft-window", "fft-window-alpha", "fft-window-beta", "fft-with-phases",
+ "file database", "file->array", "file->frample", "file->frample?", "file->sample", "file->sample?",
+ "file-name", "fill!", "fill-polygon", "fill-rectangle", "filter", "filter-channel",
+ "filter-control-coeffs", "filter-control-envelope", "filter-control-in-dB", "filter-control-in-hz", "filter-control-order", "filter-control-waveform-color",
+ "filter-control?", "filter-fft", "filter-selection", "filter-selection-and-smooth", "filter-sound", "filter?",
+ "filtered-comb", "filtered-comb-bank", "filtered-comb-bank?", "filtered-comb?", "find-dialog", "find-mark",
+ "find-mix", "find-sound", "finfo", "finish-progress-report", "fir-filter", "fir-filter?",
+ "firmant", "firmant?", "fit-selection-between-marks", "flatten-partials", "float-vector", "float-vector*",
+ "float-vector+", "float-vector->channel", "float-vector->list", "float-vector->string", "float-vector-abs!", "float-vector-add!",
"float-vector-equal?", "float-vector-fill!", "float-vector-length", "float-vector-max", "float-vector-min", "float-vector-move!",
"float-vector-multiply!", "float-vector-offset!", "float-vector-peak", "float-vector-polynomial", "float-vector-ref", "float-vector-reverse!",
"float-vector-scale!", "float-vector-set!", "float-vector-subseq", "float-vector-subtract!", "float-vector?", "flocsig",
@@ -100,177 +100,172 @@ static const char *help_names[HELP_NAMES_SIZE] = {
"krksin", "krksin?", "ladspa-descriptor", "ladspa-dir", "lambda*", "lbj-piano",
"left-sample", "let->list", "let-ref", "let-set!", "let-temporarily", "let?",
"linear->db", "linear-src-channel", "lint for scheme", "lisp-graph-hook", "lisp-graph-style", "lisp-graph?",
- "list->float-vector", "list->vct", "list-ladspa", "listener-click-hook", "listener-color", "listener-colorized",
- "listener-font", "listener-prompt", "listener-selection", "listener-text-color", "little-endian?", "*load-hook*",
- "*load-path*", "locate-zero", "locsig", "locsig-ref", "locsig-reverb-ref", "locsig-reverb-set!",
- "locsig-set!", "locsig-type", "locsig?", "log-freq-start", "lpc-coeffs", "lpc-predict",
- "macro?", "macroexpand", "main-menu", "main-widgets", "make-abcos", "make-absin",
- "make-adjustable-sawtooth-wave", "make-adjustable-square-wave", "make-adjustable-triangle-wave", "make-all-pass", "make-all-pass-bank", "make-asyfm",
- "make-asymmetric-fm", "make-bandpass", "make-bandstop", "make-bess", "make-biquad", "make-birds",
- "make-blackman", "make-brown-noise", "make-byte-vector", "make-channel-drop-site", "make-color", "make-comb",
- "make-comb-bank", "make-convolve", "make-delay", "make-differentiator", "make-env", "make-eoddcos",
- "make-ercos", "make-erssb", "make-fft-window", "make-file->frample", "make-file->sample", "make-filter",
- "make-filtered-comb", "make-filtered-comb-bank", "make-fir-coeffs", "make-fir-filter", "make-firmant", "make-float-vector",
- "make-flocsig", "make-fmssb", "make-formant", "make-formant-bank", "make-frample->file", "make-granulate",
- "make-graph-data", "make-green-noise", "make-green-noise-interp", "make-hash-table", "make-highpass", "make-hilbert-transform",
- "make-hook", "make-iir-filter", "make-int-vector", "make-iterator", "make-izcos", "make-j0evencos",
- "make-j0j1cos", "make-j2cos", "make-jjcos", "make-jncos", "make-jpcos", "make-jycos",
- "make-k2cos", "make-k2sin", "make-k2ssb", "make-k3sin", "make-krksin", "make-locsig",
- "make-lowpass", "make-mix-sampler", "make-move-sound", "make-moving-autocorrelation", "make-moving-average", "make-moving-fft",
- "make-moving-max", "make-moving-norm", "make-moving-pitch", "make-moving-scentroid", "make-moving-spectrum", "make-n1cos",
- "make-nchoosekcos", "make-ncos", "make-nkssb", "make-noddcos", "make-noddsin", "make-noddssb",
- "make-noid", "make-notch", "make-nrcos", "make-nrsin", "make-nrssb", "make-nrxycos",
- "make-nrxysin", "make-nsin", "make-nsincos", "make-nssb", "make-nxy1cos", "make-nxy1sin",
- "make-nxycos", "make-nxysin", "make-one-pole", "make-one-pole-all-pass", "make-one-zero", "make-oscil",
- "make-oscil-bank", "make-phase-vocoder", "make-pink-noise", "make-pixmap", "make-player", "make-polyoid",
- "make-polyshape", "make-polywave", "make-pulse-train", "make-pulsed-env", "make-r2k!cos", "make-r2k2cos",
- "make-ramp", "make-rand", "make-rand-interp", "make-rcos", "make-readin", "make-region",
- "make-region-sampler", "make-rk!cos", "make-rk!ssb", "make-rkcos", "make-rkoddssb", "make-rksin",
- "make-rkssb", "make-round-interp", "make-rssb", "make-rxycos", "make-rxyk!cos", "make-rxyk!sin",
- "make-rxysin", "make-sample->file", "make-sampler", "make-sawtooth-wave", "make-selection", "make-sinc-train",
- "make-snd->sample", "make-sound-box", "make-spencer-filter", "make-square-wave", "make-src", "make-ssb-am",
- "make-table-lookup", "make-table-lookup-with-env", "make-tanhsin", "make-triangle-wave", "make-two-pole", "make-two-zero",
- "make-variable-display", "make-variable-graph", "make-vct", "make-wave-train", "make-wave-train-with-env", "map-channel",
- "map-sound-files", "maracas", "mark->integer", "mark-click-hook", "mark-click-info", "mark-color",
- "mark-context", "mark-drag-hook", "mark-explode", "mark-home", "mark-hook", "mark-loops",
- "mark-name", "mark-name->id", "mark-properties", "mark-property", "mark-sample", "mark-sync",
- "mark-sync-color", "mark-sync-max", "mark-tag-height", "mark-tag-width", "mark?", "marks",
- "match-sound-files", "max-envelope", "max-regions", "max-transform-peaks", "maxamp", "maxamp-position",
- "menu-widgets", "menus, optional", "min-dB", "mix", "mix->float-vector", "mix->integer",
- "mix-amp", "mix-amp-env", "mix-channel", "mix-click-hook", "mix-click-info", "mix-click-sets-amp",
- "mix-color", "mix-dialog-mix", "mix-drag-hook", "mix-file-dialog", "mix-home", "mix-length",
- "mix-maxamp", "mix-name", "mix-name->id", "mix-position", "mix-properties", "mix-property",
- "mix-region", "mix-release-hook", "mix-sampler?", "mix-selection", "mix-sound", "mix-speed",
- "mix-sync", "mix-sync-max", "mix-tag-height", "mix-tag-width", "mix-tag-y", "mix-vct",
- "mix-waveform-height", "mix?", "mixes", "mono->stereo", "moog-filter", "morally-equal?",
- "mouse-click-hook", "mouse-drag-hook", "mouse-enter-graph-hook", "mouse-enter-label-hook", "mouse-enter-listener-hook", "mouse-enter-text-hook",
- "mouse-leave-graph-hook", "mouse-leave-label-hook", "mouse-leave-listener-hook", "mouse-leave-text-hook", "mouse-press-hook", "move-locsig",
- "move-mixes", "move-sound", "move-sound?", "move-syncd-marks", "moving-autocorrelation", "moving-autocorrelation?",
- "moving-average", "moving-average?", "moving-fft", "moving-fft?", "moving-length", "moving-max",
- "moving-max?", "moving-norm", "moving-norm?", "moving-pitch", "moving-pitch?", "moving-rms",
- "moving-scentroid", "moving-scentroid?", "moving-spectrum", "moving-spectrum?", "moving-sum", "mpg",
- "mus-alsa-buffer-size", "mus-alsa-buffers", "mus-alsa-capture-device", "mus-alsa-device", "mus-alsa-playback-device", "mus-alsa-squelch-warning",
- "mus-array-print-length", "mus-bytes-per-sample", "mus-channel", "mus-channels", "mus-chebyshev-tu-sum", "mus-clipping",
- "mus-close", "mus-copy", "mus-data", "mus-describe", "mus-error-hook", "mus-error-type->string",
- "mus-expand-filename", "mus-feedback", "mus-feedforward", "mus-fft", "mus-file-buffer-size", "mus-file-clipping",
- "mus-file-mix", "mus-file-name", "mus-float-equal-fudge-factor", "mus-frequency", "mus-generator?", "mus-header-raw-defaults",
- "mus-header-type->string", "mus-header-type-name", "mus-hop", "mus-increment", "mus-input?", "mus-interp-type",
- "mus-interpolate", "mus-length", "mus-location", "mus-max-malloc", "mus-max-table-size", "mus-name",
- "mus-offset", "mus-order", "mus-oss-set-buffers", "mus-output?", "mus-phase", "mus-ramp",
- "mus-rand-seed", "mus-random", "mus-reset", "mus-run", "mus-sample-type->string", "mus-sample-type-name",
- "mus-scaler", "mus-sound-chans", "mus-sound-close-input", "mus-sound-close-output", "mus-sound-comment", "mus-sound-data-location",
- "mus-sound-datum-size", "mus-sound-duration", "mus-sound-forget", "mus-sound-framples", "mus-sound-header-type", "mus-sound-length",
- "mus-sound-loop-info", "mus-sound-mark-info", "mus-sound-maxamp", "mus-sound-maxamp-exists?", "mus-sound-open-input", "mus-sound-open-output",
- "mus-sound-path", "mus-sound-preload", "mus-sound-prune", "mus-sound-read", "mus-sound-reopen-output", "mus-sound-report-cache",
- "mus-sound-sample-type", "mus-sound-samples", "mus-sound-seek-frample", "mus-sound-srate", "mus-sound-type-specifier", "mus-sound-write",
- "mus-sound-write-date", "mus-srate", "mus-width", "mus-xcoeff", "mus-xcoeffs", "mus-ycoeff",
- "mus-ycoeffs", "n1cos", "n1cos?", "name-click-hook", "nchoosekcos", "nchoosekcos?",
- "ncos", "ncos2?", "ncos4?", "ncos?", "new-sound", "new-sound-dialog",
- "new-sound-hook", "new-widget-hook", "next-sample", "nkssb", "nkssb-interp", "nkssb?",
- "noddcos", "noddcos?", "noddsin", "noddsin?", "noddssb", "noddssb?",
- "noid", "normalize-channel", "normalize-envelope", "normalize-partials", "normalize-sound", "normalized-mix",
- "notch", "notch-channel", "notch-selection", "notch-sound", "notch?", "npcos?",
- "nrcos", "nrcos?", "nrev", "nrsin", "nrsin?", "nrssb",
- "nrssb-interp", "nrssb?", "nrxycos", "nrxycos?", "nrxysin", "nrxysin?",
- "nsin", "nsin?", "nsincos", "nsincos?", "nssb", "nssb?",
- "nxy1cos", "nxy1cos?", "nxy1sin", "nxy1sin?", "nxycos", "nxycos?",
- "nxysin", "nxysin?", "object->let", "object->string", "odd-multiple", "odd-weight",
- "offset-channel", "offset-sound", "one-pole", "one-pole-all-pass", "one-pole-all-pass?", "one-pole?",
- "one-zero", "one-zero?", "open-file-dialog", "open-file-dialog-directory", "open-hook", "open-next-file-in-directory",
- "open-raw-sound", "open-raw-sound-hook", "open-sound", "openlet", "openlet?", "orientation-hook",
- "oscil", "oscil-bank", "oscil-bank?", "oscil?", "out-any", "out-bank",
- "outa", "outlet", "*output*", "output-comment-hook", "overlay-rms-env", "owlet",
- "pad-channel", "pad-marks", "pad-sound", "pair-filename", "pair-line-number", "pan-mix",
- "pan-mix-float-vector", "partials->polynomial", "partials->wave", "pausing", "peak-env-dir", "peaks",
- "peaks-font", "phase-partials->wave", "phase-vocoder", "phase-vocoder?", "piano model", "pink-noise",
- "pink-noise?", "pins", "place-sound", "play", "play-arrow-size", "play-between-marks",
- "play-hook", "play-mixes", "play-often", "play-region-forever", "play-sine", "play-sines",
- "play-syncd-marks", "play-until-c-g", "play-with-envs", "player-home", "player?", "players",
- "playing", "pluck", "polar->rectangular", "polynomial", "polynomial operations", "polyoid",
- "polyoid-env", "polyoid?", "polyshape", "polyshape?", "polywave", "polywave?",
- "port-filename", "port-line-number", "position->x", "position->y", "position-color", "power-env",
- "pqw", "pqw-vox", "preferences-dialog", "previous-sample", "print-dialog", "print-length",
- "procedure-documentation", "procedure-setter", "procedure-signature", "procedure-source", "progress-report", "pulse-train",
- "pulse-train?", "pulsed-env", "pulsed-env?", "r2k!cos", "r2k!cos?", "r2k2cos",
- "r2k2cos?", "radians->degrees", "radians->hz", "ramp-channel", "rand", "rand-interp",
- "rand-interp?", "rand?", "random", "random-state", "random-state?", "rcos",
- "rcos?", "*read-error-hook*", "read-hook", "read-mix-sample", "read-only", "read-region-sample",
- "read-sample", "read-sample-with-direction", "reader-cond", "readin", "readin?", "rectangular->magnitudes",
- "rectangular->polar", "redo", "region->integer", "region->vct", "region-chans", "region-framples",
- "region-graph-style", "region-home", "region-maxamp", "region-maxamp-position", "region-play-list", "region-position",
- "region-rms", "region-sample", "region-sampler?", "region-srate", "region?", "regions",
- "remember-sound-state", "remove-clicks", "remove-from-menu", "replace-with-selection", "report-mark-names", "require",
- "reset-all-hooks", "reset-controls", "reset-listener-cursor", "reson", "restore-controls", "*reverb*",
- "reverb-control-decay", "reverb-control-feedback", "reverb-control-length", "reverb-control-length-bounds", "reverb-control-lowpass", "reverb-control-scale",
- "reverb-control-scale-bounds", "reverb-control?", "reverse!", "reverse-by-blocks", "reverse-channel", "reverse-envelope",
- "reverse-selection", "reverse-sound", "revert-sound", "right-sample", "ring-modulate", "rk!cos",
- "rk!cos?", "rk!ssb", "rk!ssb?", "rkcos", "rkcos?", "rkoddssb",
- "rkoddssb?", "rksin", "rksin?", "rkssb", "rkssb?", "rms",
- "rms, gain, balance gens", "rms-envelope", "rootlet", "*rootlet-redefinition-hook*", "round-interp", "round-interp?",
- "rssb", "rssb-interp", "rssb?", "rubber-sound", "rxycos", "rxycos?",
- "rxyk!cos", "rxyk!cos?", "rxyk!sin", "rxyk!sin?", "rxysin", "rxysin?",
- "sample", "sample->file", "sample->file?", "sample-type", "sampler-at-end?", "sampler-home",
- "sampler-position", "sampler?", "samples", "samples->seconds", "sash-color", "save-as-dialog-auto-comment",
- "save-as-dialog-src", "save-controls", "save-dir", "save-edit-history", "save-envelopes", "save-hook",
- "save-listener", "save-mark-properties", "save-marks", "save-mix", "save-region", "save-region-dialog",
- "save-selection", "save-selection-dialog", "save-sound", "save-sound-as", "save-sound-dialog", "save-state",
- "save-state-file", "save-state-hook", "savitzky-golay-filter", "sawtooth-wave", "sawtooth-wave?", "scale-by",
- "scale-channel", "scale-envelope", "scale-mixes", "scale-selection-by", "scale-selection-to", "scale-sound",
- "scale-tempo", "scale-to", "scan-channel", "scanned synthesis", "scentroid", "scratch",
- "script-arg", "script-args", "search-for-click", "search-procedure", "seconds->samples", "select-all",
- "select-channel", "select-channel-hook", "select-sound", "select-sound-hook", "selected-channel", "selected-data-color",
- "selected-graph-color", "selected-sound", "selection", "selection->mix", "selection-chans", "selection-color",
- "selection-context", "selection-creates-region", "selection-framples", "selection-maxamp", "selection-maxamp-position", "selection-member?",
- "selection-members", "selection-position", "selection-rms", "selection-srate", "selection?", "set-samples",
- "short-file-name", "show-axes", "show-controls", "show-disk-space", "show-full-duration", "show-full-range",
- "show-grid", "show-indices", "show-listener", "show-marks", "show-mix-waveforms", "show-selection",
- "show-selection-transform", "show-sonogram-cursor", "show-transform-peaks", "show-widget", "show-y-zero", "silence-all-mixes",
- "silence-mixes", "sinc-train", "sinc-train?", "sinc-width", "sine-env-channel", "sine-ramp",
- "singer", "smooth-channel", "smooth-selection", "smooth-sound", "SMS synthesis", "snap-mark-to-beat",
- "snap-marks", "snap-mix-to-beat", "snd->sample", "snd->sample?", "snd-color", "snd-error",
- "snd-error-hook", "snd-font", "snd-gcs", "snd-help", "snd-hooks", "*snd-opened-sound*",
- "snd-print", "snd-spectrum", "snd-tempnam", "snd-url", "snd-urls", "snd-version",
- "snd-warning", "snd-warning-hook", "sndwarp", "sort!", "sound->amp-env", "sound->integer",
- "sound-file-extensions", "sound-file?", "sound-files-in-directory", "sound-interp", "sound-loop-info", "sound-properties",
- "sound-property", "sound-widgets", "sound?", "soundfont-info", "sounds", "sounds->segment-data",
- "spectra", "spectral interpolation", "spectral-polynomial", "spectro-hop", "spectro-x-angle", "spectro-x-scale",
- "spectro-y-angle", "spectro-y-scale", "spectro-z-angle", "spectro-z-scale", "spectrum", "spectrum->coeffs",
- "spectrum-end", "spectrum-start", "speed-control", "speed-control-bounds", "speed-control-style", "speed-control-tones",
- "spot-freq", "square-wave", "square-wave?", "squelch-update", "squelch-vowels", "srate",
- "src", "src-channel", "src-duration", "src-fit-envelope", "src-mixes", "src-selection",
- "src-sound", "src?", "ssb-am", "ssb-am?", "ssb-bank", "ssb-bank-env",
- "ssb-fm", "start-dac", "start-playing", "start-playing-hook", "start-playing-selection-hook", "start-progress-report",
- "status-report", "stdin-prompt", "stereo->mono", "stereo-flute", "stop-player", "stop-playing",
- "stop-playing-hook", "stop-playing-selection-hook", "stretch-envelope", "stretch-sound-via-dft", "string->byte-vector", "string-position",
- "sublet", "superimpose-ffts", "swap-channels", "swap-selection-channels", "symbol->dynamic-value", "symbol->value",
- "symbol-access", "symbol-table", "sync", "sync-everything", "sync-max", "sync-style",
- "syncd-marks", "syncd-mixes", "syncup", "table-lookup", "table-lookup?", "tanhsin",
- "tanhsin?", "tap", "tap?", "telephone", "temp-dir", "text-focus-color",
- "time-graph-style", "time-graph-type", "time-graph?", "times->samples", "tiny-font", "touch-tone",
- "trace", "tracking-cursor-style", "transform->integer", "transform->vct", "transform-dialog", "transform-framples",
- "transform-graph-style", "transform-graph-type", "transform-graph?", "transform-normalization", "transform-sample", "transform-size",
- "transform-type", "transform?", "transpose-mixes", "triangle-wave", "triangle-wave?", "tubebell",
- "tubular bell", "two-pole", "two-pole?", "two-tab", "two-zero", "two-zero?",
- "unbind-key", "*unbound-variable-hook*", "unclip-channel", "undo", "undo-hook", "unlet",
- "unselect-all", "update-graphs", "update-hook", "update-lisp-graph", "update-sound", "update-time-graph",
- "update-transform-graph", "upon-save-yourself", "user interface extensions", "variable-display", "variable-graph?", "varlet",
- "vct", "vct*", "vct+", "vct->channel", "vct->list", "vct->string",
- "vct->vector", "vct-abs!", "vct-add!", "vct-copy", "vct-equal?", "vct-fill!",
- "vct-length", "vct-max", "vct-min", "vct-move!", "vct-multiply!", "vct-offset!",
- "vct-peak", "vct-ref", "vct-reverse!", "vct-scale!", "vct-set!", "vct-subseq",
- "vct-subtract!", "vct?", "vector->vct", "vibrating-uniform-circular-string", "view-files-amp", "view-files-amp-env",
- "view-files-dialog", "view-files-files", "view-files-select-hook", "view-files-selected-files", "view-files-sort", "view-files-speed",
- "view-files-speed-style", "view-mixes-dialog", "view-regions-dialog", "view-sound", "voice physical model", "voiced->unvoiced",
- "volterra-filter", "vox", "wave-train", "wave-train?", "wavelet-type", "waveshaping voice",
- "wavo-hop", "wavo-trace", "weighted-moving-average", "widget-position", "widget-size", "widget-text",
- "window-height", "window-samples", "window-width", "window-x", "window-y", "with-background-processes",
- "with-baffle", "with-file-monitor", "with-gl", "with-inset-graph", "with-interrupts", "with-let",
- "with-local-hook", "with-menu-icons", "with-mix-tags", "with-pointer-focus", "with-relative-panes", "with-smpte-label",
- "with-sound", "with-temporary-selection", "with-toolbar", "with-tooltips", "with-tracking-cursor", "with-verbose-cursor",
- "x->position", "x-axis-label", "x-axis-style", "x-bounds", "x-position-slider", "x-zoom-slider",
- "xb-open", "xramp-channel", "y->position", "y-axis-label", "y-bounds", "y-position-slider",
- "y-zoom-slider", "z-transform", "zecho", "zero+", "zero-pad", "zero-phase",
- "zip-sound", "zipper", "zoom-color", "zoom-focus-style"};
+ "list->float-vector", "list-ladspa", "listener-click-hook", "listener-color", "listener-colorized", "listener-font",
+ "listener-prompt", "listener-selection", "listener-text-color", "little-endian?", "*load-hook*", "*load-path*",
+ "locate-zero", "locsig", "locsig-ref", "locsig-reverb-ref", "locsig-reverb-set!", "locsig-set!",
+ "locsig-type", "locsig?", "log-freq-start", "lpc-coeffs", "lpc-predict", "macro?",
+ "macroexpand", "main-menu", "main-widgets", "make-abcos", "make-absin", "make-adjustable-sawtooth-wave",
+ "make-adjustable-square-wave", "make-adjustable-triangle-wave", "make-all-pass", "make-all-pass-bank", "make-asyfm", "make-asymmetric-fm",
+ "make-bandpass", "make-bandstop", "make-bess", "make-biquad", "make-birds", "make-blackman",
+ "make-brown-noise", "make-byte-vector", "make-channel-drop-site", "make-color", "make-comb", "make-comb-bank",
+ "make-convolve", "make-delay", "make-differentiator", "make-env", "make-eoddcos", "make-ercos",
+ "make-erssb", "make-fft-window", "make-file->frample", "make-file->sample", "make-filter", "make-filtered-comb",
+ "make-filtered-comb-bank", "make-fir-coeffs", "make-fir-filter", "make-firmant", "make-float-vector", "make-flocsig",
+ "make-fmssb", "make-formant", "make-formant-bank", "make-frample->file", "make-granulate", "make-graph-data",
+ "make-green-noise", "make-green-noise-interp", "make-hash-table", "make-highpass", "make-hilbert-transform", "make-hook",
+ "make-iir-filter", "make-int-vector", "make-iterator", "make-izcos", "make-j0evencos", "make-j0j1cos",
+ "make-j2cos", "make-jjcos", "make-jncos", "make-jpcos", "make-jycos", "make-k2cos",
+ "make-k2sin", "make-k2ssb", "make-k3sin", "make-krksin", "make-locsig", "make-lowpass",
+ "make-mix-sampler", "make-move-sound", "make-moving-autocorrelation", "make-moving-average", "make-moving-fft", "make-moving-max",
+ "make-moving-norm", "make-moving-pitch", "make-moving-scentroid", "make-moving-spectrum", "make-n1cos", "make-nchoosekcos",
+ "make-ncos", "make-nkssb", "make-noddcos", "make-noddsin", "make-noddssb", "make-noid",
+ "make-notch", "make-nrcos", "make-nrsin", "make-nrssb", "make-nrxycos", "make-nrxysin",
+ "make-nsin", "make-nsincos", "make-nssb", "make-nxy1cos", "make-nxy1sin", "make-nxycos",
+ "make-nxysin", "make-one-pole", "make-one-pole-all-pass", "make-one-zero", "make-oscil", "make-oscil-bank",
+ "make-phase-vocoder", "make-pink-noise", "make-pixmap", "make-player", "make-polyoid", "make-polyshape",
+ "make-polywave", "make-pulse-train", "make-pulsed-env", "make-r2k!cos", "make-r2k2cos", "make-ramp",
+ "make-rand", "make-rand-interp", "make-rcos", "make-readin", "make-region", "make-region-sampler",
+ "make-rk!cos", "make-rk!ssb", "make-rkcos", "make-rkoddssb", "make-rksin", "make-rkssb",
+ "make-round-interp", "make-rssb", "make-rxycos", "make-rxyk!cos", "make-rxyk!sin", "make-rxysin",
+ "make-sample->file", "make-sampler", "make-sawtooth-wave", "make-selection", "make-sinc-train", "make-snd->sample",
+ "make-sound-box", "make-spencer-filter", "make-square-wave", "make-src", "make-ssb-am", "make-table-lookup",
+ "make-table-lookup-with-env", "make-tanhsin", "make-triangle-wave", "make-two-pole", "make-two-zero", "make-variable-display",
+ "make-variable-graph", "make-wave-train", "make-wave-train-with-env", "map-channel", "map-sound-files", "maracas",
+ "mark->integer", "mark-click-hook", "mark-click-info", "mark-color", "mark-context", "mark-drag-hook",
+ "mark-explode", "mark-home", "mark-hook", "mark-loops", "mark-name", "mark-name->id",
+ "mark-properties", "mark-property", "mark-sample", "mark-sync", "mark-sync-color", "mark-sync-max",
+ "mark-tag-height", "mark-tag-width", "mark?", "marks", "match-sound-files", "max-envelope",
+ "max-regions", "max-transform-peaks", "maxamp", "maxamp-position", "menu-widgets", "menus, optional",
+ "min-dB", "mix", "mix->float-vector", "mix->integer", "mix-amp", "mix-amp-env",
+ "mix-channel", "mix-click-hook", "mix-click-info", "mix-click-sets-amp", "mix-color", "mix-dialog-mix",
+ "mix-drag-hook", "mix-file-dialog", "mix-float-vector", "mix-home", "mix-length", "mix-maxamp",
+ "mix-name", "mix-name->id", "mix-position", "mix-properties", "mix-property", "mix-region",
+ "mix-release-hook", "mix-sampler?", "mix-selection", "mix-sound", "mix-speed", "mix-sync",
+ "mix-sync-max", "mix-tag-height", "mix-tag-width", "mix-tag-y", "mix-waveform-height", "mix?",
+ "mixes", "mono->stereo", "moog-filter", "morally-equal?", "mouse-click-hook", "mouse-drag-hook",
+ "mouse-enter-graph-hook", "mouse-enter-label-hook", "mouse-enter-listener-hook", "mouse-enter-text-hook", "mouse-leave-graph-hook", "mouse-leave-label-hook",
+ "mouse-leave-listener-hook", "mouse-leave-text-hook", "mouse-press-hook", "move-locsig", "move-mixes", "move-sound",
+ "move-sound?", "move-syncd-marks", "moving-autocorrelation", "moving-autocorrelation?", "moving-average", "moving-average?",
+ "moving-fft", "moving-fft?", "moving-length", "moving-max", "moving-max?", "moving-norm",
+ "moving-norm?", "moving-pitch", "moving-pitch?", "moving-rms", "moving-scentroid", "moving-scentroid?",
+ "moving-spectrum", "moving-spectrum?", "moving-sum", "mpg", "mus-alsa-buffer-size", "mus-alsa-buffers",
+ "mus-alsa-capture-device", "mus-alsa-device", "mus-alsa-playback-device", "mus-alsa-squelch-warning", "mus-array-print-length", "mus-bytes-per-sample",
+ "mus-channel", "mus-channels", "mus-chebyshev-tu-sum", "mus-clipping", "mus-close", "mus-copy",
+ "mus-data", "mus-describe", "mus-error-hook", "mus-error-type->string", "mus-expand-filename", "mus-feedback",
+ "mus-feedforward", "mus-fft", "mus-file-buffer-size", "mus-file-clipping", "mus-file-mix", "mus-file-name",
+ "mus-float-equal-fudge-factor", "mus-frequency", "mus-generator?", "mus-header-raw-defaults", "mus-header-type->string", "mus-header-type-name",
+ "mus-hop", "mus-increment", "mus-input?", "mus-interp-type", "mus-interpolate", "mus-length",
+ "mus-location", "mus-max-malloc", "mus-max-table-size", "mus-name", "mus-offset", "mus-order",
+ "mus-oss-set-buffers", "mus-output?", "mus-phase", "mus-ramp", "mus-rand-seed", "mus-random",
+ "mus-reset", "mus-run", "mus-sample-type->string", "mus-sample-type-name", "mus-scaler", "mus-sound-chans",
+ "mus-sound-close-input", "mus-sound-close-output", "mus-sound-comment", "mus-sound-data-location", "mus-sound-datum-size", "mus-sound-duration",
+ "mus-sound-forget", "mus-sound-framples", "mus-sound-header-type", "mus-sound-length", "mus-sound-loop-info", "mus-sound-mark-info",
+ "mus-sound-maxamp", "mus-sound-maxamp-exists?", "mus-sound-open-input", "mus-sound-open-output", "mus-sound-path", "mus-sound-preload",
+ "mus-sound-prune", "mus-sound-read", "mus-sound-reopen-output", "mus-sound-report-cache", "mus-sound-sample-type", "mus-sound-samples",
+ "mus-sound-seek-frample", "mus-sound-srate", "mus-sound-type-specifier", "mus-sound-write", "mus-sound-write-date", "mus-srate",
+ "mus-width", "mus-xcoeff", "mus-xcoeffs", "mus-ycoeff", "mus-ycoeffs", "n1cos",
+ "n1cos?", "name-click-hook", "nchoosekcos", "nchoosekcos?", "ncos", "ncos2?",
+ "ncos4?", "ncos?", "new-sound", "new-sound-dialog", "new-sound-hook", "new-widget-hook",
+ "next-sample", "nkssb", "nkssb-interp", "nkssb?", "noddcos", "noddcos?",
+ "noddsin", "noddsin?", "noddssb", "noddssb?", "noid", "normalize-channel",
+ "normalize-envelope", "normalize-partials", "normalize-sound", "normalized-mix", "notch", "notch-channel",
+ "notch-selection", "notch-sound", "notch?", "npcos?", "nrcos", "nrcos?",
+ "nrev", "nrsin", "nrsin?", "nrssb", "nrssb-interp", "nrssb?",
+ "nrxycos", "nrxycos?", "nrxysin", "nrxysin?", "nsin", "nsin?",
+ "nsincos", "nsincos?", "nssb", "nssb?", "nxy1cos", "nxy1cos?",
+ "nxy1sin", "nxy1sin?", "nxycos", "nxycos?", "nxysin", "nxysin?",
+ "object->let", "object->string", "odd-multiple", "odd-weight", "offset-channel", "offset-sound",
+ "one-pole", "one-pole-all-pass", "one-pole-all-pass?", "one-pole?", "one-zero", "one-zero?",
+ "open-file-dialog", "open-file-dialog-directory", "open-hook", "open-next-file-in-directory", "open-raw-sound", "open-raw-sound-hook",
+ "open-sound", "openlet", "openlet?", "orientation-hook", "oscil", "oscil-bank",
+ "oscil-bank?", "oscil?", "out-any", "out-bank", "outa", "outlet",
+ "*output*", "output-comment-hook", "overlay-rms-env", "owlet", "pad-channel", "pad-marks",
+ "pad-sound", "pair-filename", "pair-line-number", "pan-mix", "pan-mix-float-vector", "partials->polynomial",
+ "partials->wave", "pausing", "peak-env-dir", "peaks", "peaks-font", "phase-partials->wave",
+ "phase-vocoder", "phase-vocoder?", "piano model", "pink-noise", "pink-noise?", "pins",
+ "place-sound", "play", "play-arrow-size", "play-between-marks", "play-hook", "play-mixes",
+ "play-often", "play-region-forever", "play-sine", "play-sines", "play-syncd-marks", "play-until-c-g",
+ "play-with-envs", "player-home", "player?", "players", "playing", "pluck",
+ "polar->rectangular", "polynomial", "polynomial operations", "polyoid", "polyoid-env", "polyoid?",
+ "polyshape", "polyshape?", "polywave", "polywave?", "port-filename", "port-line-number",
+ "position->x", "position->y", "position-color", "power-env", "pqw", "pqw-vox",
+ "preferences-dialog", "previous-sample", "print-dialog", "print-length", "procedure-documentation", "procedure-setter",
+ "procedure-signature", "procedure-source", "progress-report", "pulse-train", "pulse-train?", "pulsed-env",
+ "pulsed-env?", "r2k!cos", "r2k!cos?", "r2k2cos", "r2k2cos?", "radians->degrees",
+ "radians->hz", "ramp-channel", "rand", "rand-interp", "rand-interp?", "rand?",
+ "random", "random-state", "random-state?", "rcos", "rcos?", "*read-error-hook*",
+ "read-hook", "read-mix-sample", "read-only", "read-region-sample", "read-sample", "read-sample-with-direction",
+ "reader-cond", "readin", "readin?", "rectangular->magnitudes", "rectangular->polar", "redo",
+ "region->float-vector", "region->integer", "region-chans", "region-framples", "region-graph-style", "region-home",
+ "region-maxamp", "region-maxamp-position", "region-play-list", "region-position", "region-rms", "region-sample",
+ "region-sampler?", "region-srate", "region?", "regions", "remember-sound-state", "remove-clicks",
+ "remove-from-menu", "replace-with-selection", "report-mark-names", "require", "reset-all-hooks", "reset-controls",
+ "reset-listener-cursor", "reson", "restore-controls", "*reverb*", "reverb-control-decay", "reverb-control-feedback",
+ "reverb-control-length", "reverb-control-length-bounds", "reverb-control-lowpass", "reverb-control-scale", "reverb-control-scale-bounds", "reverb-control?",
+ "reverse!", "reverse-by-blocks", "reverse-channel", "reverse-envelope", "reverse-selection", "reverse-sound",
+ "revert-sound", "right-sample", "ring-modulate", "rk!cos", "rk!cos?", "rk!ssb",
+ "rk!ssb?", "rkcos", "rkcos?", "rkoddssb", "rkoddssb?", "rksin",
+ "rksin?", "rkssb", "rkssb?", "rms", "rms, gain, balance gens", "rms-envelope",
+ "rootlet", "*rootlet-redefinition-hook*", "round-interp", "round-interp?", "rssb", "rssb-interp",
+ "rssb?", "rubber-sound", "rxycos", "rxycos?", "rxyk!cos", "rxyk!cos?",
+ "rxyk!sin", "rxyk!sin?", "rxysin", "rxysin?", "sample", "sample->file",
+ "sample->file?", "sample-type", "sampler-at-end?", "sampler-home", "sampler-position", "sampler?",
+ "samples", "samples->seconds", "sash-color", "save-as-dialog-auto-comment", "save-as-dialog-src", "save-controls",
+ "save-dir", "save-edit-history", "save-envelopes", "save-hook", "save-listener", "save-mark-properties",
+ "save-marks", "save-mix", "save-region", "save-region-dialog", "save-selection", "save-selection-dialog",
+ "save-sound", "save-sound-as", "save-sound-dialog", "save-state", "save-state-file", "save-state-hook",
+ "savitzky-golay-filter", "sawtooth-wave", "sawtooth-wave?", "scale-by", "scale-channel", "scale-envelope",
+ "scale-mixes", "scale-selection-by", "scale-selection-to", "scale-sound", "scale-tempo", "scale-to",
+ "scan-channel", "scanned synthesis", "scentroid", "scratch", "script-arg", "script-args",
+ "search-for-click", "search-procedure", "seconds->samples", "select-all", "select-channel", "select-channel-hook",
+ "select-sound", "select-sound-hook", "selected-channel", "selected-data-color", "selected-graph-color", "selected-sound",
+ "selection", "selection->mix", "selection-chans", "selection-color", "selection-context", "selection-creates-region",
+ "selection-framples", "selection-maxamp", "selection-maxamp-position", "selection-member?", "selection-members", "selection-position",
+ "selection-rms", "selection-srate", "selection?", "set-samples", "short-file-name", "show-axes",
+ "show-controls", "show-disk-space", "show-full-duration", "show-full-range", "show-grid", "show-indices",
+ "show-listener", "show-marks", "show-mix-waveforms", "show-selection", "show-selection-transform", "show-sonogram-cursor",
+ "show-transform-peaks", "show-widget", "show-y-zero", "silence-all-mixes", "silence-mixes", "sinc-train",
+ "sinc-train?", "sinc-width", "sine-env-channel", "sine-ramp", "singer", "smooth-channel",
+ "smooth-selection", "smooth-sound", "SMS synthesis", "snap-mark-to-beat", "snap-marks", "snap-mix-to-beat",
+ "snd->sample", "snd->sample?", "snd-color", "snd-error", "snd-error-hook", "snd-font",
+ "snd-gcs", "snd-help", "snd-hooks", "*snd-opened-sound*", "snd-print", "snd-spectrum",
+ "snd-tempnam", "snd-url", "snd-urls", "snd-version", "snd-warning", "snd-warning-hook",
+ "sndwarp", "sort!", "sound->amp-env", "sound->integer", "sound-file-extensions", "sound-file?",
+ "sound-files-in-directory", "sound-interp", "sound-loop-info", "sound-properties", "sound-property", "sound-widgets",
+ "sound?", "soundfont-info", "sounds", "sounds->segment-data", "spectra", "spectral interpolation",
+ "spectral-polynomial", "spectro-hop", "spectro-x-angle", "spectro-x-scale", "spectro-y-angle", "spectro-y-scale",
+ "spectro-z-angle", "spectro-z-scale", "spectrum", "spectrum->coeffs", "spectrum-end", "spectrum-start",
+ "speed-control", "speed-control-bounds", "speed-control-style", "speed-control-tones", "spot-freq", "square-wave",
+ "square-wave?", "squelch-update", "squelch-vowels", "srate", "src", "src-channel",
+ "src-duration", "src-fit-envelope", "src-mixes", "src-selection", "src-sound", "src?",
+ "ssb-am", "ssb-am?", "ssb-bank", "ssb-bank-env", "ssb-fm", "start-dac",
+ "start-playing", "start-playing-hook", "start-playing-selection-hook", "start-progress-report", "status-report", "stdin-prompt",
+ "stereo->mono", "stereo-flute", "stop-player", "stop-playing", "stop-playing-hook", "stop-playing-selection-hook",
+ "stretch-envelope", "stretch-sound-via-dft", "string->byte-vector", "string-position", "sublet", "superimpose-ffts",
+ "swap-channels", "swap-selection-channels", "symbol->dynamic-value", "symbol->value", "symbol-access", "symbol-table",
+ "sync", "sync-everything", "sync-max", "sync-style", "syncd-marks", "syncd-mixes",
+ "syncup", "table-lookup", "table-lookup?", "tanhsin", "tanhsin?", "tap",
+ "tap?", "telephone", "temp-dir", "text-focus-color", "time-graph-style", "time-graph-type",
+ "time-graph?", "times->samples", "tiny-font", "touch-tone", "trace", "tracking-cursor-style",
+ "transform->float-vector", "transform->integer", "transform-dialog", "transform-framples", "transform-graph-style", "transform-graph-type",
+ "transform-graph?", "transform-normalization", "transform-sample", "transform-size", "transform-type", "transform?",
+ "transpose-mixes", "triangle-wave", "triangle-wave?", "tubebell", "tubular bell", "two-pole",
+ "two-pole?", "two-tab", "two-zero", "two-zero?", "type-of", "unbind-key",
+ "*unbound-variable-hook*", "unclip-channel", "undo", "undo-hook", "unlet", "unselect-all",
+ "update-graphs", "update-hook", "update-lisp-graph", "update-sound", "update-time-graph", "update-transform-graph",
+ "upon-save-yourself", "user interface extensions", "variable-display", "variable-graph?", "varlet", "vibrating-uniform-circular-string",
+ "view-files-amp", "view-files-amp-env", "view-files-dialog", "view-files-files", "view-files-select-hook", "view-files-selected-files",
+ "view-files-sort", "view-files-speed", "view-files-speed-style", "view-mixes-dialog", "view-regions-dialog", "view-sound",
+ "voice physical model", "voiced->unvoiced", "volterra-filter", "vox", "wave-train", "wave-train?",
+ "wavelet-type", "waveshaping voice", "wavo-hop", "wavo-trace", "weighted-moving-average", "widget-position",
+ "widget-size", "widget-text", "window-height", "window-samples", "window-width", "window-x",
+ "window-y", "with-background-processes", "with-baffle", "with-file-monitor", "with-gl", "with-inset-graph",
+ "with-interrupts", "with-let", "with-local-hook", "with-menu-icons", "with-mix-tags", "with-pointer-focus",
+ "with-relative-panes", "with-smpte-label", "with-sound", "with-temporary-selection", "with-toolbar", "with-tooltips",
+ "with-tracking-cursor", "with-verbose-cursor", "x->position", "x-axis-label", "x-axis-style", "x-bounds",
+ "x-position-slider", "x-zoom-slider", "xb-open", "xramp-channel", "y->position", "y-axis-label",
+ "y-bounds", "y-position-slider", "y-zoom-slider", "z-transform", "zecho", "zero+",
+ "zero-pad", "zero-phase", "zip-sound", "zipper", "zoom-color", "zoom-focus-style"};
#endif
#if HAVE_RUBY
static const char *help_names[HELP_NAMES_SIZE] = {
@@ -293,7 +288,7 @@ static const char *help_names[HELP_NAMES_SIZE] = {
"bold_peaks_font", "break", "brown_noise", "brown_noise?", "butterworth_filters", "byte_vector",
"byte_vector_ref", "byte_vector_set!", "byte_vector?", "c_define", "c_g?", "c_object?",
"c_pointer", "c_pointer?", "call_with_exit", "canter", "cascade2canonical", "catch",
- "cellon", "chain_dsps", "channel2vct", "channel_amp_envs", "channel_data", "channel_envelope",
+ "cellon", "chain_dsps", "channel2float_vector", "channel_amp_envs", "channel_data", "channel_envelope",
"channel_polynomial", "channel_properties", "channel_property", "channel_rms", "channel_style", "channel_sync",
"channel_widgets", "channels", "channels_equal?", "channels_?", "chans", "char_position",
"cheby_hka", "chebyshev_filters", "check_mix_tags", "chordalize", "chorus", "clean_channel",
@@ -305,42 +300,42 @@ static const char *help_names[HELP_NAMES_SIZE] = {
"constant?", "continuation?", "continue_frample2file", "continue_sample2file", "contrast_channel", "contrast_control",
"contrast_control_amp", "contrast_control_bounds", "contrast_control?", "contrast_enhancement", "contrast_sound", "controls2channel",
"convolution", "convolution_reverb", "convolve", "convolve_files", "convolve_selection_with", "convolve_with",
- "convolve?", "copy", "Copy_context", "copy_sampler", "correlate", "coverlet",
- "cross_fade__amplitude_", "cross_fade__frequency_domain_", "cross_synthesis", "curlet", "current_font", "cursor",
- "cursor_color", "Cursor_context", "cursor_location_offset", "cursor_position", "cursor_size", "cursor_style",
- "cursor_update_interval", "cutlet", "cyclic_sequences", "dac_combines_channels", "dac_size", "data_color",
- "data_location", "data_size", "db2linear", "default_output_chans", "default_output_header_type", "default_output_sample_type",
- "default_output_srate", "defgenerator", "define_", "define_constant", "define_envelope", "define_expansion",
- "define_macro", "define_macro_", "define_selection_via_marks", "defined?", "degrees2radians", "delay",
- "delay_channel_mixes", "delay_tick", "delay?", "delete_colormap", "delete_file_filter", "delete_file_sorter",
- "delete_mark", "delete_marks", "delete_sample", "delete_samples", "delete_samples_and_smooth", "delete_selection",
- "delete_selection_and_smooth", "delete_transform", "describe_hook", "describe_mark", "dht", "dialog_widgets",
- "dilambda", "disable_control_panel", "display_bark_fft", "display_correlation", "display_db", "display_edits",
- "display_energy", "dissolve_fade", "dither_channel", "dither_sound", "dolph", "dot_product",
- "dot_size", "down_oct", "draw_axes", "draw_dot", "draw_dots", "draw_line",
- "draw_lines", "draw_mark_hook", "draw_mix_hook", "draw_string", "drone", "drop_sites",
- "drop_hook", "during_open_hook", "edit_fragment", "edit_header_dialog", "edit_hook", "edit_list2function",
- "edit_position", "edit_properties", "edit_property", "edit_tree", "edits", "edot_product",
- "effects_hook", "elliptic_filters", "env", "env_any", "env_channel", "env_channel_with_base",
- "env_expt_channel", "env_interp", "env_mixes", "env_selection", "env_sound", "env_sound_interp",
- "env_squared_channel", "env?", "enved_base", "enved_clip?", "enved_dialog", "enved_envelope",
- "enved_filter", "enved_filter_order", "enved_hook", "enved_in_dB", "enved_power", "enved_style",
- "enved_target", "enved_wave?", "enved_waveform_color", "envelope_interp", "enveloped_mix", "eoddcos",
- "eoddcos?", "eps_bottom_margin", "eps_file", "eps_left_margin", "eps_size", "ercos",
- "ercos?", "_error_hook_", "erssb", "erssb?", "even_multiple", "even_weight",
- "every_sample?", "exit", "exit_hook", "expand_control", "expand_control_bounds", "expand_control_hop",
- "expand_control_jitter", "expand_control_length", "expand_control_ramp", "expand_control?", "explode_sf2", "exponentially_weighted_moving_average",
- "expsnd", "expsrc", "_features_", "feedback_fm", "fft", "fft_cancel",
- "fft_edit", "fft_env_edit", "fft_env_interp", "fft_log_frequency", "fft_log_magnitude", "fft_smoother",
- "fft_squelch", "fft_window", "fft_window_alpha", "fft_window_beta", "fft_with_phases", "file_database",
- "file2array", "file2frample", "file2frample?", "file2sample", "file2sample?", "file_name",
- "fill!", "fill_polygon", "fill_rectangle", "filter", "filter_channel", "filter_control_coeffs",
- "filter_control_envelope", "filter_control_in_dB", "filter_control_in_hz", "filter_control_order", "filter_control_waveform_color", "filter_control?",
- "filter_fft", "filter_selection", "filter_selection_and_smooth", "filter_sound", "filter?", "filtered_comb",
- "filtered_comb_bank", "filtered_comb_bank?", "filtered_comb?", "find_dialog", "find_mark", "find_mix",
- "find_sound", "finfo", "finish_progress_report", "fir_filter", "fir_filter?", "firmant",
- "firmant?", "fit_selection_between_marks", "flatten_partials", "float_vector", "float-vector_multiply", "float-vector_add",
- "float_vector2channel", "float_vector2list", "float_vector2string", "float_vector_abs!", "float_vector_add!", "float_vector_copy",
+ "convolve?", "copy", "copy", "Copy_context", "copy_sampler", "correlate",
+ "coverlet", "cross_fade__amplitude_", "cross_fade__frequency_domain_", "cross_synthesis", "curlet", "current_font",
+ "cursor", "cursor_color", "Cursor_context", "cursor_location_offset", "cursor_position", "cursor_size",
+ "cursor_style", "cursor_update_interval", "cutlet", "cyclic_sequences", "dac_combines_channels", "dac_size",
+ "data_color", "data_location", "data_size", "db2linear", "default_output_chans", "default_output_header_type",
+ "default_output_sample_type", "default_output_srate", "defgenerator", "define_", "define_constant", "define_envelope",
+ "define_expansion", "define_macro", "define_macro_", "define_selection_via_marks", "defined?", "degrees2radians",
+ "delay", "delay_channel_mixes", "delay_tick", "delay?", "delete_colormap", "delete_file_filter",
+ "delete_file_sorter", "delete_mark", "delete_marks", "delete_sample", "delete_samples", "delete_samples_and_smooth",
+ "delete_selection", "delete_selection_and_smooth", "delete_transform", "describe_hook", "describe_mark", "dht",
+ "dialog_widgets", "dilambda", "disable_control_panel", "display_bark_fft", "display_correlation", "display_db",
+ "display_edits", "display_energy", "dissolve_fade", "dither_channel", "dither_sound", "dolph",
+ "dot_product", "dot_size", "down_oct", "draw_axes", "draw_dot", "draw_dots",
+ "draw_line", "draw_lines", "draw_mark_hook", "draw_mix_hook", "draw_string", "drone",
+ "drop_sites", "drop_hook", "during_open_hook", "edit_fragment", "edit_header_dialog", "edit_hook",
+ "edit_list2function", "edit_position", "edit_properties", "edit_property", "edit_tree", "edits",
+ "edot_product", "effects_hook", "elliptic_filters", "env", "env_any", "env_channel",
+ "env_channel_with_base", "env_expt_channel", "env_interp", "env_mixes", "env_selection", "env_sound",
+ "env_sound_interp", "env_squared_channel", "env?", "enved_base", "enved_clip?", "enved_dialog",
+ "enved_envelope", "enved_filter", "enved_filter_order", "enved_hook", "enved_in_dB", "enved_power",
+ "enved_style", "enved_target", "enved_wave?", "enved_waveform_color", "envelope_interp", "enveloped_mix",
+ "eoddcos", "eoddcos?", "eps_bottom_margin", "eps_file", "eps_left_margin", "eps_size",
+ "ercos", "ercos?", "_error_hook_", "erssb", "erssb?", "even_multiple",
+ "even_weight", "every_sample?", "exit", "exit_hook", "expand_control", "expand_control_bounds",
+ "expand_control_hop", "expand_control_jitter", "expand_control_length", "expand_control_ramp", "expand_control?", "explode_sf2",
+ "exponentially_weighted_moving_average", "expsnd", "expsrc", "_features_", "feedback_fm", "fft",
+ "fft_cancel", "fft_edit", "fft_env_edit", "fft_env_interp", "fft_log_frequency", "fft_log_magnitude",
+ "fft_smoother", "fft_squelch", "fft_window", "fft_window_alpha", "fft_window_beta", "fft_with_phases",
+ "file_database", "file2array", "file2frample", "file2frample?", "file2sample", "file2sample?",
+ "file_name", "fill!", "fill_polygon", "fill_rectangle", "filter", "filter_channel",
+ "filter_control_coeffs", "filter_control_envelope", "filter_control_in_dB", "filter_control_in_hz", "filter_control_order", "filter_control_waveform_color",
+ "filter_control?", "filter_fft", "filter_selection", "filter_selection_and_smooth", "filter_sound", "filter?",
+ "filtered_comb", "filtered_comb_bank", "filtered_comb_bank?", "filtered_comb?", "find_dialog", "find_mark",
+ "find_mix", "find_sound", "finfo", "finish_progress_report", "fir_filter", "fir_filter?",
+ "firmant", "firmant?", "fit_selection_between_marks", "flatten_partials", "float_vector", "float-vector_multiply",
+ "float-vector_add", "float_vector2channel", "float_vector2list", "float_vector2string", "float_vector_abs!", "float_vector_add!",
"float_vector_equal?", "float_vector_fill!", "float_vector_length", "float_vector_max", "float_vector_min", "float_vector_move!",
"float_vector_multiply!", "float_vector_offset!", "float_vector_peak", "float_vector_polynomial", "float_vector_ref", "float_vector_reverse!",
"float_vector_scale!", "float_vector_set!", "float_vector_subseq", "float_vector_subtract!", "float_vector?", "flocsig",
@@ -372,177 +367,172 @@ static const char *help_names[HELP_NAMES_SIZE] = {
"krksin", "krksin?", "ladspa_descriptor", "ladspa_dir", "lambda_", "lbj_piano",
"left_sample", "let2list", "let_ref", "let_set!", "let_temporarily", "let?",
"linear2db", "linear_src_channel", "lint_for_scheme", "lisp_graph_hook", "lisp_graph_style", "lisp_graph?",
- "list2float_vector", "list2vct", "list_ladspa", "listener_click_hook", "listener_color", "listener_colorized",
- "listener_font", "listener_prompt", "listener_selection", "listener_text_color", "little_endian?", "_load_hook_",
- "_load_path_", "locate_zero", "locsig", "locsig_ref", "locsig_reverb_ref", "locsig_reverb_set!",
- "locsig_set!", "locsig_type", "locsig?", "log_freq_start", "lpc_coeffs", "lpc_predict",
- "macro?", "macroexpand", "main_menu", "main_widgets", "make_abcos", "make_absin",
- "make_adjustable_sawtooth_wave", "make_adjustable_square_wave", "make_adjustable_triangle_wave", "make_all_pass", "make_all_pass_bank", "make_asyfm",
- "make_asymmetric_fm", "make_bandpass", "make_bandstop", "make_bess", "make_biquad", "make_birds",
- "make_blackman", "make_brown_noise", "make_byte_vector", "make_channel_drop_site", "make_color", "make_comb",
- "make_comb_bank", "make_convolve", "make_delay", "make_differentiator", "make_env", "make_eoddcos",
- "make_ercos", "make_erssb", "make_fft_window", "make_file2frample", "make_file2sample", "make_filter",
- "make_filtered_comb", "make_filtered_comb_bank", "make_fir_coeffs", "make_fir_filter", "make_firmant", "make_float_vector",
- "make_flocsig", "make_fmssb", "make_formant", "make_formant_bank", "make_frample2file", "make_granulate",
- "make_graph_data", "make_green_noise", "make_green_noise_interp", "make_hash_table", "make_highpass", "make_hilbert_transform",
- "make_hook", "make_iir_filter", "make_int_vector", "make_iterator", "make_izcos", "make_j0evencos",
- "make_j0j1cos", "make_j2cos", "make_jjcos", "make_jncos", "make_jpcos", "make_jycos",
- "make_k2cos", "make_k2sin", "make_k2ssb", "make_k3sin", "make_krksin", "make_locsig",
- "make_lowpass", "make_mix_sampler", "make_move_sound", "make_moving_autocorrelation", "make_moving_average", "make_moving_fft",
- "make_moving_max", "make_moving_norm", "make_moving_pitch", "make_moving_scentroid", "make_moving_spectrum", "make_n1cos",
- "make_nchoosekcos", "make_ncos", "make_nkssb", "make_noddcos", "make_noddsin", "make_noddssb",
- "make_noid", "make_notch", "make_nrcos", "make_nrsin", "make_nrssb", "make_nrxycos",
- "make_nrxysin", "make_nsin", "make_nsincos", "make_nssb", "make_nxy1cos", "make_nxy1sin",
- "make_nxycos", "make_nxysin", "make_one_pole", "make_one_pole_all_pass", "make_one_zero", "make_oscil",
- "make_oscil_bank", "make_phase_vocoder", "make_pink_noise", "make_pixmap", "make_player", "make_polyoid",
- "make_polyshape", "make_polywave", "make_pulse_train", "make_pulsed_env", "make_r2k!cos", "make_r2k2cos",
- "make_ramp", "make_rand", "make_rand_interp", "make_rcos", "make_readin", "make_region",
- "make_region_sampler", "make_rk!cos", "make_rk!ssb", "make_rkcos", "make_rkoddssb", "make_rksin",
- "make_rkssb", "make_round_interp", "make_rssb", "make_rxycos", "make_rxyk!cos", "make_rxyk!sin",
- "make_rxysin", "make_sample2file", "make_sampler", "make_sawtooth_wave", "make_selection", "make_sinc_train",
- "make_snd2sample", "make_sound_box", "make_spencer_filter", "make_square_wave", "make_src", "make_ssb_am",
- "make_table_lookup", "make_table_lookup_with_env", "make_tanhsin", "make_triangle_wave", "make_two_pole", "make_two_zero",
- "make_variable_display", "make_variable_graph", "make_vct", "make_wave_train", "make_wave_train_with_env", "map_channel",
- "map_sound_files", "maracas", "mark2integer", "mark_click_hook", "mark_click_info", "mark_color",
- "Mark_context", "mark_drag_hook", "mark_explode", "mark_home", "mark_hook", "mark_loops",
- "mark_name", "mark_name2id", "mark_properties", "mark_property", "mark_sample", "mark_sync",
- "mark_sync_color", "mark_sync_max", "mark_tag_height", "mark_tag_width", "mark?", "marks",
- "match_sound_files", "max_envelope", "max_regions", "max_transform_peaks", "maxamp", "maxamp_position",
- "menu_widgets", "menus__optional", "min_dB", "mix", "mix2float_vector", "mix2integer",
- "mix_amp", "mix_amp_env", "mix_channel", "mix_click_hook", "mix_click_info", "mix_click_sets_amp",
- "mix_color", "mix_dialog_mix", "mix_drag_hook", "mix_file_dialog", "mix_home", "mix_length",
- "mix_maxamp", "mix_name", "mix_name2id", "mix_position", "mix_properties", "mix_property",
- "mix_region", "mix_release_hook", "mix_sampler?", "mix_selection", "mix_sound", "mix_speed",
- "mix_sync", "mix_sync_max", "mix_tag_height", "mix_tag_width", "mix_tag_y", "mix_vct",
- "mix_waveform_height", "mix?", "mixes", "mono2stereo", "moog_filter", "morally_equal?",
- "mouse_click_hook", "mouse_drag_hook", "mouse_enter_graph_hook", "mouse_enter_label_hook", "mouse_enter_listener_hook", "mouse_enter_text_hook",
- "mouse_leave_graph_hook", "mouse_leave_label_hook", "mouse_leave_listener_hook", "mouse_leave_text_hook", "mouse_press_hook", "move_locsig",
- "move_mixes", "move_sound", "move_sound?", "move_syncd_marks", "moving_autocorrelation", "moving_autocorrelation?",
- "moving_average", "moving_average?", "moving_fft", "moving_fft?", "moving_length", "moving_max",
- "moving_max?", "moving_norm", "moving_norm?", "moving_pitch", "moving_pitch?", "moving_rms",
- "moving_scentroid", "moving_scentroid?", "moving_spectrum", "moving_spectrum?", "moving_sum", "mpg",
- "mus_alsa_buffer_size", "mus_alsa_buffers", "mus_alsa_capture_device", "mus_alsa_device", "mus_alsa_playback_device", "mus_alsa_squelch_warning",
- "mus_array_print_length", "mus_bytes_per_sample", "mus_channel", "mus_channels", "mus_chebyshev_tu_sum", "mus_clipping",
- "mus_close", "mus_copy", "mus_data", "mus_describe", "mus_error_hook", "mus_error_type2string",
- "mus_expand_filename", "mus_feedback", "mus_feedforward", "mus_fft", "mus_file_buffer_size", "mus_file_clipping",
- "mus_file_mix", "mus_file_name", "mus_float_equal_fudge_factor", "mus_frequency", "mus_generator?", "mus_header_raw_defaults",
- "mus_header_type2string", "mus_header_type_name", "mus_hop", "mus_increment", "mus_input?", "mus_interp_type",
- "mus_interpolate", "mus_length", "mus_location", "mus_max_malloc", "mus_max_table_size", "mus_name",
- "mus_offset", "mus_order", "mus_oss_set_buffers", "mus_output?", "mus_phase", "mus_ramp",
- "mus_rand_seed", "mus_random", "mus_reset", "mus_run", "mus_sample_type2string", "mus_sample_type_name",
- "mus_scaler", "mus_sound_chans", "mus_sound_close_input", "mus_sound_close_output", "mus_sound_comment", "mus_sound_data_location",
- "mus_sound_datum_size", "mus_sound_duration", "mus_sound_forget", "mus_sound_framples", "mus_sound_header_type", "mus_sound_length",
- "mus_sound_loop_info", "mus_sound_mark_info", "mus_sound_maxamp", "mus_sound_maxamp_exists?", "mus_sound_open_input", "mus_sound_open_output",
- "mus_sound_path", "mus_sound_preload", "mus_sound_prune", "mus_sound_read", "mus_sound_reopen_output", "mus_sound_report_cache",
- "mus_sound_sample_type", "mus_sound_samples", "mus_sound_seek_frample", "mus_sound_srate", "mus_sound_type_specifier", "mus_sound_write",
- "mus_sound_write_date", "mus_srate", "mus_width", "mus_xcoeff", "mus_xcoeffs", "mus_ycoeff",
- "mus_ycoeffs", "n1cos", "n1cos?", "name_click_hook", "nchoosekcos", "nchoosekcos?",
- "ncos", "ncos2?", "ncos4?", "ncos?", "new_sound", "new_sound_dialog",
- "new_sound_hook", "new_widget_hook", "next_sample", "nkssb", "nkssb_interp", "nkssb?",
- "noddcos", "noddcos?", "noddsin", "noddsin?", "noddssb", "noddssb?",
- "noid", "normalize_channel", "normalize_envelope", "normalize_partials", "normalize_sound", "normalized_mix",
- "notch", "notch_channel", "notch_selection", "notch_sound", "notch?", "npcos?",
- "nrcos", "nrcos?", "nrev", "nrsin", "nrsin?", "nrssb",
- "nrssb_interp", "nrssb?", "nrxycos", "nrxycos?", "nrxysin", "nrxysin?",
- "nsin", "nsin?", "nsincos", "nsincos?", "nssb", "nssb?",
- "nxy1cos", "nxy1cos?", "nxy1sin", "nxy1sin?", "nxycos", "nxycos?",
- "nxysin", "nxysin?", "object2let", "object2string", "odd_multiple", "odd_weight",
- "offset_channel", "offset_sound", "one_pole", "one_pole_all_pass", "one_pole_all_pass?", "one_pole?",
- "one_zero", "one_zero?", "open_file_dialog", "open_file_dialog_directory", "open_hook", "open_next_file_in_directory",
- "open_raw_sound", "open_raw_sound_hook", "open_sound", "openlet", "openlet?", "orientation_hook",
- "oscil", "oscil_bank", "oscil_bank?", "oscil?", "out_any", "out_bank",
- "outa", "outlet", "_output_", "output_comment_hook", "overlay_rms_env", "owlet",
- "pad_channel", "pad_marks", "pad_sound", "pair_filename", "pair_line_number", "pan_mix",
- "pan_mix_float_vector", "partials2polynomial", "partials2wave", "pausing", "peak_env_dir", "peaks",
- "peaks_font", "phase_partials2wave", "phase_vocoder", "phase_vocoder?", "piano_model", "pink_noise",
- "pink_noise?", "pins", "place_sound", "play", "play_arrow_size", "play_between_marks",
- "play_hook", "play_mixes", "play_often", "play_region_forever", "play_sine", "play_sines",
- "play_syncd_marks", "play_until_c_g", "play_with_envs", "player_home", "player?", "players",
- "playing", "pluck", "polar2rectangular", "polynomial", "polynomial_operations", "polyoid",
- "polyoid_env", "polyoid?", "polyshape", "polyshape?", "polywave", "polywave?",
- "port_filename", "port_line_number", "position2x", "position2y", "position_color", "power_env",
- "pqw", "pqw_vox", "preferences_dialog", "previous_sample", "print_dialog", "print_length",
- "procedure_documentation", "procedure_setter", "procedure_signature", "procedure_source", "progress_report", "pulse_train",
- "pulse_train?", "pulsed_env", "pulsed_env?", "r2k!cos", "r2k!cos?", "r2k2cos",
- "r2k2cos?", "radians2degrees", "radians2hz", "ramp_channel", "rand", "rand_interp",
- "rand_interp?", "rand?", "random", "random_state", "random_state?", "rcos",
- "rcos?", "_read_error_hook_", "read_hook", "read_mix_sample", "read_only", "read_region_sample",
- "read_sample", "read_sample_with_direction", "reader_cond", "readin", "readin?", "rectangular2magnitudes",
- "rectangular2polar", "redo_edit", "region2integer", "region2vct", "region_chans", "region_framples",
- "region_graph_style", "region_home", "region_maxamp", "region_maxamp_position", "region_play_list", "region_position",
- "region_rms", "region_sample", "region_sampler?", "region_srate", "region?", "regions",
- "remember_sound_state", "remove_clicks", "remove_from_menu", "replace_with_selection", "report_mark_names", "require",
- "reset_all_hooks", "reset_controls", "reset_listener_cursor", "reson", "restore_controls", "_reverb_",
- "reverb_control_decay", "reverb_control_feedback", "reverb_control_length", "reverb_control_length_bounds", "reverb_control_lowpass", "reverb_control_scale",
- "reverb_control_scale_bounds", "reverb_control?", "reverse!", "reverse_by_blocks", "reverse_channel", "reverse_envelope",
- "reverse_selection", "reverse_sound", "revert_sound", "right_sample", "ring_modulate", "rk!cos",
- "rk!cos?", "rk!ssb", "rk!ssb?", "rkcos", "rkcos?", "rkoddssb",
- "rkoddssb?", "rksin", "rksin?", "rkssb", "rkssb?", "rms",
- "rms__gain__balance_gens", "rms_envelope", "rootlet", "_rootlet_redefinition_hook_", "round_interp", "round_interp?",
- "rssb", "rssb_interp", "rssb?", "rubber_sound", "rxycos", "rxycos?",
- "rxyk!cos", "rxyk!cos?", "rxyk!sin", "rxyk!sin?", "rxysin", "rxysin?",
- "sample", "sample2file", "sample2file?", "sample_type", "sampler_at_end?", "sampler_home",
- "sampler_position", "sampler?", "samples", "samples2seconds", "sash_color", "save_as_dialog_auto_comment",
- "save_as_dialog_src", "save_controls", "save_dir", "save_edit_history", "save_envelopes", "save_hook",
- "save_listener", "save_mark_properties", "save_marks", "save_mix", "save_region", "save_region_dialog",
- "save_selection", "save_selection_dialog", "save_sound", "save_sound_as", "save_sound_dialog", "save_state",
- "save_state_file", "save_state_hook", "savitzky_golay_filter", "sawtooth_wave", "sawtooth_wave?", "scale_by",
- "scale_channel", "scale_envelope", "scale_mixes", "scale_selection_by", "scale_selection_to", "scale_sound",
- "scale_tempo", "scale_to", "scan_channel", "scanned_synthesis", "scentroid", "scratch",
- "script_arg", "script_args", "search_for_click", "search_procedure", "seconds2samples", "select_all",
- "select_channel", "select_channel_hook", "select_sound", "select_sound_hook", "selected_channel", "selected_data_color",
- "selected_graph_color", "selected_sound", "selection", "selection2mix", "selection_chans", "selection_color",
- "Selection_context", "selection_creates_region", "selection_framples", "selection_maxamp", "selection_maxamp_position", "selection_member?",
- "selection_members", "selection_position", "selection_rms", "selection_srate", "selection?", "set_samples",
- "short_file_name", "show_axes", "show_controls", "show_disk_space", "show_full_duration", "show_full_range",
- "show_grid", "show_indices", "show_listener", "show_marks", "show_mix_waveforms", "show_selection",
- "show_selection_transform", "show_sonogram_cursor", "show_transform_peaks", "show_widget", "show_y_zero", "silence_all_mixes",
- "silence_mixes", "sinc_train", "sinc_train?", "sinc_width", "sine_env_channel", "sine_ramp",
- "singer", "smooth_channel", "smooth_selection", "smooth_sound", "SMS_synthesis", "snap_mark_to_beat",
- "snap_marks", "snap_mix_to_beat", "snd2sample", "snd2sample?", "snd_color", "snd_error",
- "snd_error_hook", "snd_font", "snd_gcs", "snd_help", "snd_hooks", "_snd_opened_sound_",
- "snd_print", "snd_spectrum", "snd_tempnam", "snd_url", "snd_urls", "snd_version",
- "snd_warning", "snd_warning_hook", "sndwarp", "sort!", "sound2amp_env", "sound2integer",
- "sound_file_extensions", "sound_file?", "sound_files_in_directory", "sound_interp", "sound_loop_info", "sound_properties",
- "sound_property", "sound_widgets", "sound?", "soundfont_info", "sounds", "sounds2segment_data",
- "spectra", "spectral_interpolation", "spectral_polynomial", "spectro_hop", "spectro_x_angle", "spectro_x_scale",
- "spectro_y_angle", "spectro_y_scale", "spectro_z_angle", "spectro_z_scale", "spectrum", "spectrum2coeffs",
- "spectrum_end", "spectrum_start", "speed_control", "speed_control_bounds", "speed_control_style", "speed_control_tones",
- "spot_freq", "square_wave", "square_wave?", "squelch_update", "squelch_vowels", "srate",
- "src", "src_channel", "src_duration", "src_fit_envelope", "src_mixes", "src_selection",
- "src_sound", "src?", "ssb_am", "ssb_am?", "ssb_bank", "ssb_bank_env",
- "ssb_fm", "start_dac", "start_playing", "start_playing_hook", "start_playing_selection_hook", "start_progress_report",
- "status_report", "stdin_prompt", "stereo2mono", "stereo_flute", "stop_player", "stop_playing",
- "stop_playing_hook", "stop_playing_selection_hook", "stretch_envelope", "stretch_sound_via_dft", "string2byte_vector", "string_position",
- "sublet", "superimpose_ffts", "swap_channels", "swap_selection_channels", "symbol2dynamic_value", "symbol2value",
- "symbol_access", "symbol_table", "sync", "sync_everything", "sync_max", "sync_style",
- "syncd_marks", "syncd_mixes", "syncup", "table_lookup", "table_lookup?", "tanhsin",
- "tanhsin?", "tap", "tap?", "telephone", "temp_dir", "text_focus_color",
- "time_graph_style", "time_graph_type", "time_graph?", "times2samples", "tiny_font", "touch_tone",
- "trace", "tracking_cursor_style", "transform2integer", "transform2vct", "transform_dialog", "transform_framples",
- "transform_graph_style", "transform_graph_type", "transform_graph?", "transform_normalization", "transform_sample", "transform_size",
- "transform_type", "transform?", "transpose_mixes", "triangle_wave", "triangle_wave?", "tubebell",
- "tubular_bell", "two_pole", "two_pole?", "two_tab", "two_zero", "two_zero?",
- "unbind_key", "_unbound_variable_hook_", "unclip_channel", "undo", "undo_hook", "unlet",
- "unselect_all", "update_graphs", "update_hook", "update_lisp_graph", "update_sound", "update_time_graph",
- "update_transform_graph", "upon_save_yourself", "user_interface_extensions", "variable_display", "variable_graph?", "varlet",
- "vct", "vct_", "vct_", "vct2channel", "vct2list", "vct2string",
- "vct2vector", "vct_abs!", "vct_add!", "vct_copy", "vct_equal?", "vct_fill!",
- "vct_length", "vct_max", "vct_min", "vct_move!", "vct_multiply!", "vct_offset!",
- "vct_peak", "vct_ref", "vct_reverse!", "vct_scale!", "vct_set!", "vct_subseq",
- "vct_subtract!", "vct?", "vector2vct", "vibrating_uniform_circular_string", "view_files_amp", "view_files_amp_env",
- "view_files_dialog", "view_files_files", "view_files_select_hook", "view_files_selected_files", "view_files_sort", "view_files_speed",
- "view_files_speed_style", "view_mixes_dialog", "view_regions_dialog", "view_sound", "voice_physical_model", "voiced2unvoiced",
- "volterra_filter", "vox", "wave_train", "wave_train?", "wavelet_type", "waveshaping_voice",
- "wavo_hop", "wavo_trace", "weighted_moving_average", "widget_position", "widget_size", "widget_text",
- "window_height", "window_samples", "window_width", "window_x", "window_y", "with_background_processes",
- "with_baffle", "with_file_monitor", "with_gl", "with_inset_graph", "with_interrupts", "with_let",
- "with_local_hook", "with_menu_icons", "with_mix_tags", "with_pointer_focus", "with_relative_panes", "with_smpte_label",
- "with_sound", "with_temporary_selection", "with_toolbar", "with_tooltips", "with_tracking_cursor", "with_verbose_cursor",
- "x2position", "x_axis_label", "x_axis_style", "x_bounds", "x_position_slider", "x_zoom_slider",
- "xb_open", "xramp_channel", "y2position", "y_axis_label", "y_bounds", "y_position_slider",
- "y_zoom_slider", "z_transform", "zecho", "zero_", "zero_pad", "zero_phase",
- "zip_sound", "zipper", "zoom_color", "zoom_focus_style"};
+ "list2float_vector", "list_ladspa", "listener_click_hook", "listener_color", "listener_colorized", "listener_font",
+ "listener_prompt", "listener_selection", "listener_text_color", "little_endian?", "_load_hook_", "_load_path_",
+ "locate_zero", "locsig", "locsig_ref", "locsig_reverb_ref", "locsig_reverb_set!", "locsig_set!",
+ "locsig_type", "locsig?", "log_freq_start", "lpc_coeffs", "lpc_predict", "macro?",
+ "macroexpand", "main_menu", "main_widgets", "make_abcos", "make_absin", "make_adjustable_sawtooth_wave",
+ "make_adjustable_square_wave", "make_adjustable_triangle_wave", "make_all_pass", "make_all_pass_bank", "make_asyfm", "make_asymmetric_fm",
+ "make_bandpass", "make_bandstop", "make_bess", "make_biquad", "make_birds", "make_blackman",
+ "make_brown_noise", "make_byte_vector", "make_channel_drop_site", "make_color", "make_comb", "make_comb_bank",
+ "make_convolve", "make_delay", "make_differentiator", "make_env", "make_eoddcos", "make_ercos",
+ "make_erssb", "make_fft_window", "make_file2frample", "make_file2sample", "make_filter", "make_filtered_comb",
+ "make_filtered_comb_bank", "make_fir_coeffs", "make_fir_filter", "make_firmant", "make_float_vector", "make_flocsig",
+ "make_fmssb", "make_formant", "make_formant_bank", "make_frample2file", "make_granulate", "make_graph_data",
+ "make_green_noise", "make_green_noise_interp", "make_hash_table", "make_highpass", "make_hilbert_transform", "make_hook",
+ "make_iir_filter", "make_int_vector", "make_iterator", "make_izcos", "make_j0evencos", "make_j0j1cos",
+ "make_j2cos", "make_jjcos", "make_jncos", "make_jpcos", "make_jycos", "make_k2cos",
+ "make_k2sin", "make_k2ssb", "make_k3sin", "make_krksin", "make_locsig", "make_lowpass",
+ "make_mix_sampler", "make_move_sound", "make_moving_autocorrelation", "make_moving_average", "make_moving_fft", "make_moving_max",
+ "make_moving_norm", "make_moving_pitch", "make_moving_scentroid", "make_moving_spectrum", "make_n1cos", "make_nchoosekcos",
+ "make_ncos", "make_nkssb", "make_noddcos", "make_noddsin", "make_noddssb", "make_noid",
+ "make_notch", "make_nrcos", "make_nrsin", "make_nrssb", "make_nrxycos", "make_nrxysin",
+ "make_nsin", "make_nsincos", "make_nssb", "make_nxy1cos", "make_nxy1sin", "make_nxycos",
+ "make_nxysin", "make_one_pole", "make_one_pole_all_pass", "make_one_zero", "make_oscil", "make_oscil_bank",
+ "make_phase_vocoder", "make_pink_noise", "make_pixmap", "make_player", "make_polyoid", "make_polyshape",
+ "make_polywave", "make_pulse_train", "make_pulsed_env", "make_r2k!cos", "make_r2k2cos", "make_ramp",
+ "make_rand", "make_rand_interp", "make_rcos", "make_readin", "make_region", "make_region_sampler",
+ "make_rk!cos", "make_rk!ssb", "make_rkcos", "make_rkoddssb", "make_rksin", "make_rkssb",
+ "make_round_interp", "make_rssb", "make_rxycos", "make_rxyk!cos", "make_rxyk!sin", "make_rxysin",
+ "make_sample2file", "make_sampler", "make_sawtooth_wave", "make_selection", "make_sinc_train", "make_snd2sample",
+ "make_sound_box", "make_spencer_filter", "make_square_wave", "make_src", "make_ssb_am", "make_table_lookup",
+ "make_table_lookup_with_env", "make_tanhsin", "make_triangle_wave", "make_two_pole", "make_two_zero", "make_variable_display",
+ "make_variable_graph", "make_wave_train", "make_wave_train_with_env", "map_channel", "map_sound_files", "maracas",
+ "mark2integer", "mark_click_hook", "mark_click_info", "mark_color", "Mark_context", "mark_drag_hook",
+ "mark_explode", "mark_home", "mark_hook", "mark_loops", "mark_name", "mark_name2id",
+ "mark_properties", "mark_property", "mark_sample", "mark_sync", "mark_sync_color", "mark_sync_max",
+ "mark_tag_height", "mark_tag_width", "mark?", "marks", "match_sound_files", "max_envelope",
+ "max_regions", "max_transform_peaks", "maxamp", "maxamp_position", "menu_widgets", "menus__optional",
+ "min_dB", "mix", "mix2float_vector", "mix2integer", "mix_amp", "mix_amp_env",
+ "mix_channel", "mix_click_hook", "mix_click_info", "mix_click_sets_amp", "mix_color", "mix_dialog_mix",
+ "mix_drag_hook", "mix_file_dialog", "mix_float_vector", "mix_home", "mix_length", "mix_maxamp",
+ "mix_name", "mix_name2id", "mix_position", "mix_properties", "mix_property", "mix_region",
+ "mix_release_hook", "mix_sampler?", "mix_selection", "mix_sound", "mix_speed", "mix_sync",
+ "mix_sync_max", "mix_tag_height", "mix_tag_width", "mix_tag_y", "mix_waveform_height", "mix?",
+ "mixes", "mono2stereo", "moog_filter", "morally_equal?", "mouse_click_hook", "mouse_drag_hook",
+ "mouse_enter_graph_hook", "mouse_enter_label_hook", "mouse_enter_listener_hook", "mouse_enter_text_hook", "mouse_leave_graph_hook", "mouse_leave_label_hook",
+ "mouse_leave_listener_hook", "mouse_leave_text_hook", "mouse_press_hook", "move_locsig", "move_mixes", "move_sound",
+ "move_sound?", "move_syncd_marks", "moving_autocorrelation", "moving_autocorrelation?", "moving_average", "moving_average?",
+ "moving_fft", "moving_fft?", "moving_length", "moving_max", "moving_max?", "moving_norm",
+ "moving_norm?", "moving_pitch", "moving_pitch?", "moving_rms", "moving_scentroid", "moving_scentroid?",
+ "moving_spectrum", "moving_spectrum?", "moving_sum", "mpg", "mus_alsa_buffer_size", "mus_alsa_buffers",
+ "mus_alsa_capture_device", "mus_alsa_device", "mus_alsa_playback_device", "mus_alsa_squelch_warning", "mus_array_print_length", "mus_bytes_per_sample",
+ "mus_channel", "mus_channels", "mus_chebyshev_tu_sum", "mus_clipping", "mus_close", "mus_copy",
+ "mus_data", "mus_describe", "mus_error_hook", "mus_error_type2string", "mus_expand_filename", "mus_feedback",
+ "mus_feedforward", "mus_fft", "mus_file_buffer_size", "mus_file_clipping", "mus_file_mix", "mus_file_name",
+ "mus_float_equal_fudge_factor", "mus_frequency", "mus_generator?", "mus_header_raw_defaults", "mus_header_type2string", "mus_header_type_name",
+ "mus_hop", "mus_increment", "mus_input?", "mus_interp_type", "mus_interpolate", "mus_length",
+ "mus_location", "mus_max_malloc", "mus_max_table_size", "mus_name", "mus_offset", "mus_order",
+ "mus_oss_set_buffers", "mus_output?", "mus_phase", "mus_ramp", "mus_rand_seed", "mus_random",
+ "mus_reset", "mus_run", "mus_sample_type2string", "mus_sample_type_name", "mus_scaler", "mus_sound_chans",
+ "mus_sound_close_input", "mus_sound_close_output", "mus_sound_comment", "mus_sound_data_location", "mus_sound_datum_size", "mus_sound_duration",
+ "mus_sound_forget", "mus_sound_framples", "mus_sound_header_type", "mus_sound_length", "mus_sound_loop_info", "mus_sound_mark_info",
+ "mus_sound_maxamp", "mus_sound_maxamp_exists?", "mus_sound_open_input", "mus_sound_open_output", "mus_sound_path", "mus_sound_preload",
+ "mus_sound_prune", "mus_sound_read", "mus_sound_reopen_output", "mus_sound_report_cache", "mus_sound_sample_type", "mus_sound_samples",
+ "mus_sound_seek_frample", "mus_sound_srate", "mus_sound_type_specifier", "mus_sound_write", "mus_sound_write_date", "mus_srate",
+ "mus_width", "mus_xcoeff", "mus_xcoeffs", "mus_ycoeff", "mus_ycoeffs", "n1cos",
+ "n1cos?", "name_click_hook", "nchoosekcos", "nchoosekcos?", "ncos", "ncos2?",
+ "ncos4?", "ncos?", "new_sound", "new_sound_dialog", "new_sound_hook", "new_widget_hook",
+ "next_sample", "nkssb", "nkssb_interp", "nkssb?", "noddcos", "noddcos?",
+ "noddsin", "noddsin?", "noddssb", "noddssb?", "noid", "normalize_channel",
+ "normalize_envelope", "normalize_partials", "normalize_sound", "normalized_mix", "notch", "notch_channel",
+ "notch_selection", "notch_sound", "notch?", "npcos?", "nrcos", "nrcos?",
+ "nrev", "nrsin", "nrsin?", "nrssb", "nrssb_interp", "nrssb?",
+ "nrxycos", "nrxycos?", "nrxysin", "nrxysin?", "nsin", "nsin?",
+ "nsincos", "nsincos?", "nssb", "nssb?", "nxy1cos", "nxy1cos?",
+ "nxy1sin", "nxy1sin?", "nxycos", "nxycos?", "nxysin", "nxysin?",
+ "object2let", "object2string", "odd_multiple", "odd_weight", "offset_channel", "offset_sound",
+ "one_pole", "one_pole_all_pass", "one_pole_all_pass?", "one_pole?", "one_zero", "one_zero?",
+ "open_file_dialog", "open_file_dialog_directory", "open_hook", "open_next_file_in_directory", "open_raw_sound", "open_raw_sound_hook",
+ "open_sound", "openlet", "openlet?", "orientation_hook", "oscil", "oscil_bank",
+ "oscil_bank?", "oscil?", "out_any", "out_bank", "outa", "outlet",
+ "_output_", "output_comment_hook", "overlay_rms_env", "owlet", "pad_channel", "pad_marks",
+ "pad_sound", "pair_filename", "pair_line_number", "pan_mix", "pan_mix_float_vector", "partials2polynomial",
+ "partials2wave", "pausing", "peak_env_dir", "peaks", "peaks_font", "phase_partials2wave",
+ "phase_vocoder", "phase_vocoder?", "piano_model", "pink_noise", "pink_noise?", "pins",
+ "place_sound", "play", "play_arrow_size", "play_between_marks", "play_hook", "play_mixes",
+ "play_often", "play_region_forever", "play_sine", "play_sines", "play_syncd_marks", "play_until_c_g",
+ "play_with_envs", "player_home", "player?", "players", "playing", "pluck",
+ "polar2rectangular", "polynomial", "polynomial_operations", "polyoid", "polyoid_env", "polyoid?",
+ "polyshape", "polyshape?", "polywave", "polywave?", "port_filename", "port_line_number",
+ "position2x", "position2y", "position_color", "power_env", "pqw", "pqw_vox",
+ "preferences_dialog", "previous_sample", "print_dialog", "print_length", "procedure_documentation", "procedure_setter",
+ "procedure_signature", "procedure_source", "progress_report", "pulse_train", "pulse_train?", "pulsed_env",
+ "pulsed_env?", "r2k!cos", "r2k!cos?", "r2k2cos", "r2k2cos?", "radians2degrees",
+ "radians2hz", "ramp_channel", "rand", "rand_interp", "rand_interp?", "rand?",
+ "random", "random_state", "random_state?", "rcos", "rcos?", "_read_error_hook_",
+ "read_hook", "read_mix_sample", "read_only", "read_region_sample", "read_sample", "read_sample_with_direction",
+ "reader_cond", "readin", "readin?", "rectangular2magnitudes", "rectangular2polar", "redo_edit",
+ "region2float_vector", "region2integer", "region_chans", "region_framples", "region_graph_style", "region_home",
+ "region_maxamp", "region_maxamp_position", "region_play_list", "region_position", "region_rms", "region_sample",
+ "region_sampler?", "region_srate", "region?", "regions", "remember_sound_state", "remove_clicks",
+ "remove_from_menu", "replace_with_selection", "report_mark_names", "require", "reset_all_hooks", "reset_controls",
+ "reset_listener_cursor", "reson", "restore_controls", "_reverb_", "reverb_control_decay", "reverb_control_feedback",
+ "reverb_control_length", "reverb_control_length_bounds", "reverb_control_lowpass", "reverb_control_scale", "reverb_control_scale_bounds", "reverb_control?",
+ "reverse!", "reverse_by_blocks", "reverse_channel", "reverse_envelope", "reverse_selection", "reverse_sound",
+ "revert_sound", "right_sample", "ring_modulate", "rk!cos", "rk!cos?", "rk!ssb",
+ "rk!ssb?", "rkcos", "rkcos?", "rkoddssb", "rkoddssb?", "rksin",
+ "rksin?", "rkssb", "rkssb?", "rms", "rms__gain__balance_gens", "rms_envelope",
+ "rootlet", "_rootlet_redefinition_hook_", "round_interp", "round_interp?", "rssb", "rssb_interp",
+ "rssb?", "rubber_sound", "rxycos", "rxycos?", "rxyk!cos", "rxyk!cos?",
+ "rxyk!sin", "rxyk!sin?", "rxysin", "rxysin?", "sample", "sample2file",
+ "sample2file?", "sample_type", "sampler_at_end?", "sampler_home", "sampler_position", "sampler?",
+ "samples", "samples2seconds", "sash_color", "save_as_dialog_auto_comment", "save_as_dialog_src", "save_controls",
+ "save_dir", "save_edit_history", "save_envelopes", "save_hook", "save_listener", "save_mark_properties",
+ "save_marks", "save_mix", "save_region", "save_region_dialog", "save_selection", "save_selection_dialog",
+ "save_sound", "save_sound_as", "save_sound_dialog", "save_state", "save_state_file", "save_state_hook",
+ "savitzky_golay_filter", "sawtooth_wave", "sawtooth_wave?", "scale_by", "scale_channel", "scale_envelope",
+ "scale_mixes", "scale_selection_by", "scale_selection_to", "scale_sound", "scale_tempo", "scale_to",
+ "scan_channel", "scanned_synthesis", "scentroid", "scratch", "script_arg", "script_args",
+ "search_for_click", "search_procedure", "seconds2samples", "select_all", "select_channel", "select_channel_hook",
+ "select_sound", "select_sound_hook", "selected_channel", "selected_data_color", "selected_graph_color", "selected_sound",
+ "selection", "selection2mix", "selection_chans", "selection_color", "Selection_context", "selection_creates_region",
+ "selection_framples", "selection_maxamp", "selection_maxamp_position", "selection_member?", "selection_members", "selection_position",
+ "selection_rms", "selection_srate", "selection?", "set_samples", "short_file_name", "show_axes",
+ "show_controls", "show_disk_space", "show_full_duration", "show_full_range", "show_grid", "show_indices",
+ "show_listener", "show_marks", "show_mix_waveforms", "show_selection", "show_selection_transform", "show_sonogram_cursor",
+ "show_transform_peaks", "show_widget", "show_y_zero", "silence_all_mixes", "silence_mixes", "sinc_train",
+ "sinc_train?", "sinc_width", "sine_env_channel", "sine_ramp", "singer", "smooth_channel",
+ "smooth_selection", "smooth_sound", "SMS_synthesis", "snap_mark_to_beat", "snap_marks", "snap_mix_to_beat",
+ "snd2sample", "snd2sample?", "snd_color", "snd_error", "snd_error_hook", "snd_font",
+ "snd_gcs", "snd_help", "snd_hooks", "_snd_opened_sound_", "snd_print", "snd_spectrum",
+ "snd_tempnam", "snd_url", "snd_urls", "snd_version", "snd_warning", "snd_warning_hook",
+ "sndwarp", "sort!", "sound2amp_env", "sound2integer", "sound_file_extensions", "sound_file?",
+ "sound_files_in_directory", "sound_interp", "sound_loop_info", "sound_properties", "sound_property", "sound_widgets",
+ "sound?", "soundfont_info", "sounds", "sounds2segment_data", "spectra", "spectral_interpolation",
+ "spectral_polynomial", "spectro_hop", "spectro_x_angle", "spectro_x_scale", "spectro_y_angle", "spectro_y_scale",
+ "spectro_z_angle", "spectro_z_scale", "spectrum", "spectrum2coeffs", "spectrum_end", "spectrum_start",
+ "speed_control", "speed_control_bounds", "speed_control_style", "speed_control_tones", "spot_freq", "square_wave",
+ "square_wave?", "squelch_update", "squelch_vowels", "srate", "src", "src_channel",
+ "src_duration", "src_fit_envelope", "src_mixes", "src_selection", "src_sound", "src?",
+ "ssb_am", "ssb_am?", "ssb_bank", "ssb_bank_env", "ssb_fm", "start_dac",
+ "start_playing", "start_playing_hook", "start_playing_selection_hook", "start_progress_report", "status_report", "stdin_prompt",
+ "stereo2mono", "stereo_flute", "stop_player", "stop_playing", "stop_playing_hook", "stop_playing_selection_hook",
+ "stretch_envelope", "stretch_sound_via_dft", "string2byte_vector", "string_position", "sublet", "superimpose_ffts",
+ "swap_channels", "swap_selection_channels", "symbol2dynamic_value", "symbol2value", "symbol_access", "symbol_table",
+ "sync", "sync_everything", "sync_max", "sync_style", "syncd_marks", "syncd_mixes",
+ "syncup", "table_lookup", "table_lookup?", "tanhsin", "tanhsin?", "tap",
+ "tap?", "telephone", "temp_dir", "text_focus_color", "time_graph_style", "time_graph_type",
+ "time_graph?", "times2samples", "tiny_font", "touch_tone", "trace", "tracking_cursor_style",
+ "transform2float_vector", "transform2integer", "transform_dialog", "transform_framples", "transform_graph_style", "transform_graph_type",
+ "transform_graph?", "transform_normalization", "transform_sample", "transform_size", "transform_type", "transform?",
+ "transpose_mixes", "triangle_wave", "triangle_wave?", "tubebell", "tubular_bell", "two_pole",
+ "two_pole?", "two_tab", "two_zero", "two_zero?", "type_of", "unbind_key",
+ "_unbound_variable_hook_", "unclip_channel", "undo", "undo_hook", "unlet", "unselect_all",
+ "update_graphs", "update_hook", "update_lisp_graph", "update_sound", "update_time_graph", "update_transform_graph",
+ "upon_save_yourself", "user_interface_extensions", "variable_display", "variable_graph?", "varlet", "vibrating_uniform_circular_string",
+ "view_files_amp", "view_files_amp_env", "view_files_dialog", "view_files_files", "view_files_select_hook", "view_files_selected_files",
+ "view_files_sort", "view_files_speed", "view_files_speed_style", "view_mixes_dialog", "view_regions_dialog", "view_sound",
+ "voice_physical_model", "voiced2unvoiced", "volterra_filter", "vox", "wave_train", "wave_train?",
+ "wavelet_type", "waveshaping_voice", "wavo_hop", "wavo_trace", "weighted_moving_average", "widget_position",
+ "widget_size", "widget_text", "window_height", "window_samples", "window_width", "window_x",
+ "window_y", "with_background_processes", "with_baffle", "with_file_monitor", "with_gl", "with_inset_graph",
+ "with_interrupts", "with_let", "with_local_hook", "with_menu_icons", "with_mix_tags", "with_pointer_focus",
+ "with_relative_panes", "with_smpte_label", "with_sound", "with_temporary_selection", "with_toolbar", "with_tooltips",
+ "with_tracking_cursor", "with_verbose_cursor", "x2position", "x_axis_label", "x_axis_style", "x_bounds",
+ "x_position_slider", "x_zoom_slider", "xb_open", "xramp_channel", "y2position", "y_axis_label",
+ "y_bounds", "y_position_slider", "y_zoom_slider", "z_transform", "zecho", "zero_",
+ "zero_pad", "zero_phase", "zip_sound", "zipper", "zoom_color", "zoom_focus_style"};
#endif
#if (!HAVE_EXTENSION_LANGUAGE)
static const char **help_names = NULL;
@@ -577,7 +567,7 @@ static const char *help_urls[HELP_NAMES_SIZE] = {
"s7.html#bytevectorp", "s7.html#definecfunction", "extsnd.html#cgp", "s7.html#cobject",
"s7.html#cpoint", "s7.html#cpointer", "s7.html#callwithexit", "sndscm.html#bagpipe",
"sndscm.html#cascadetocanonical", "s7.html#catch", "sndscm.html#cellon", "sndscm.html#chaindsps",
- "extsnd.html#channeltovct", "extsnd.html#channelampenvs", "extsnd.html#channeldata", "sndscm.html#channelenvelope",
+ "extsnd.html#channeltofv", "extsnd.html#channelampenvs", "extsnd.html#channeldata", "sndscm.html#channelenvelope",
"sndscm.html#channelpolynomial", "extsnd.html#channelproperties", "extsnd.html#channelproperty", "sndscm.html#channelrms",
"extsnd.html#channelstyle", "sndscm.html#channelsync", "extsnd.html#channelwidgets", "extsnd.html#channels",
"sndscm.html#channelsequal", "sndscm.html#channelseq", "extsnd.html#chans", "s7.html#charposition",
@@ -594,63 +584,63 @@ static const char *help_urls[HELP_NAMES_SIZE] = {
"sndscm.html#contrastchannel", "extsnd.html#contrastcontrol", "extsnd.html#contrastcontrolamp", "extsnd.html#contrastcontrolbounds",
"extsnd.html#contrastcontrolp", "sndclm.html#contrast-enhancement", "sndscm.html#contrastsound", "extsnd.html#controlstochannel",
"sndclm.html#convolution", "extsnd.html#convolvewith", "sndclm.html#convolve", "sndclm.html#convolvefiles",
- "extsnd.html#convolveselectionwith", "extsnd.html#convolvewith", "sndclm.html#convolve?", "s7.html#s7copy",
- "extsnd.html#copycontext", "extsnd.html#copysampler", "sndclm.html#correlate", "s7.html#coverlet",
- "sndscm.html#mixdoc", "sndscm.html#fadedoc", "sndscm.html#crosssynthesis", "s7.html#curlet",
- "extsnd.html#currentfont", "extsnd.html#cursor", "extsnd.html#cursorcolor", "extsnd.html#cursorcontext",
- "extsnd.html#cursorlocationoffset", "extsnd.html#cursorposition", "extsnd.html#cursorsize", "extsnd.html#cursorstyle",
- "extsnd.html#cursorupdateinterval", "s7.html#cutlet", "s7.html#cyclicsequences", "extsnd.html#dacfolding",
- "extsnd.html#dacsize", "extsnd.html#datacolor", "extsnd.html#datalocation", "extsnd.html#datasize",
- "sndclm.html#dbtolinear", "extsnd.html#defaultoutputchans", "extsnd.html#defaultoutputheadertype", "extsnd.html#defaultoutputsampletype",
- "extsnd.html#defaultoutputsrate", "sndclm.html#defgenerator", "s7.html#definestar", "s7.html#defineconstant",
- "extsnd.html#defineenvelope", "s7.html#expansion", "s7.html#definemacro", "s7.html#definemacrostar",
- "sndscm.html#defineselectionviamarks", "s7.html#definedp", "sndclm.html#degreestoradians", "sndclm.html#delay",
- "sndscm.html#delaychannelmixes", "sndclm.html#delaytick", "sndclm.html#delay?", "extsnd.html#deletecolormap",
- "extsnd.html#deletefilefilter", "extsnd.html#deletefilesorter", "extsnd.html#deletemark", "extsnd.html#deletemarks",
- "extsnd.html#deletesample", "extsnd.html#deletesamples", "extsnd.html#deletesamplesandsmooth", "extsnd.html#deleteselection",
- "extsnd.html#deleteselectionandsmooth", "extsnd.html#deletetransform", "sndscm.html#describehook", "sndscm.html#describemark",
- "sndscm.html#dht", "extsnd.html#dialogwidgets", "s7.html#dilambda", "sndscm.html#disablecontrolpanel",
- "sndscm.html#displaybarkfft", "sndscm.html#displaycorrelation", "sndscm.html#displaydb", "extsnd.html#displayedits",
- "sndscm.html#displayenergy", "sndscm.html#dissolvefade", "sndscm.html#ditherchannel", "sndscm.html#dithersound",
- "sndscm.html#dolph", "sndclm.html#dot-product", "extsnd.html#dotsize", "sndscm.html#downoct",
- "extsnd.html#drawaxes", "extsnd.html#drawdot", "extsnd.html#drawdots", "extsnd.html#drawline",
- "extsnd.html#drawlines", "extsnd.html#drawmarkhook", "extsnd.html#drawmixhook", "extsnd.html#drawstring",
- "sndscm.html#drone", "sndscm.html#makedropsite", "extsnd.html#drophook", "extsnd.html#duringopenhook",
- "extsnd.html#editfragment", "extsnd.html#editheaderdialog", "extsnd.html#edithook", "extsnd.html#editlisttofunction",
- "extsnd.html#editposition", "extsnd.html#editproperties", "extsnd.html#editproperty", "extsnd.html#edittree",
- "extsnd.html#edits", "sndclm.html#edot-product", "extsnd.html#effectshook", "sndscm.html#analogfilterdoc",
- "sndclm.html#env", "sndclm.html#env-any", "extsnd.html#envchannel", "extsnd.html#envchannelwithbase",
- "sndscm.html#envexptchannel", "sndclm.html#env-interp", "sndscm.html#envmixes", "extsnd.html#envselection",
- "extsnd.html#envsound", "sndscm.html#envsoundinterp", "sndscm.html#envsquaredchannel", "sndclm.html#env?",
- "extsnd.html#envedbase", "extsnd.html#envedclipping", "extsnd.html#enveddialog", "extsnd.html#envedenvelope",
- "extsnd.html#filterenv", "extsnd.html#filterenvorder", "extsnd.html#envedhook", "extsnd.html#envedin-dB",
- "extsnd.html#envedpower", "extsnd.html#envedstyle", "extsnd.html#envedtarget", "extsnd.html#envedwaving",
- "extsnd.html#envedwaveformcolor", "sndclm.html#envelopeinterp", "sndscm.html#envelopedmix", "sndclm.html#eoddcos",
- "sndclm.html#eoddcos?", "extsnd.html#epsbottommargin", "extsnd.html#epsfile", "extsnd.html#epsleftmargin",
- "extsnd.html#epssize", "sndclm.html#ercos", "sndclm.html#ercos?", "s7.html#errorhook",
- "sndclm.html#erssb", "sndclm.html#erssb?", "sndclm.html#evenmultiple", "sndclm.html#evenweight",
- "sndscm.html#everysample", "extsnd.html#exit", "extsnd.html#exithook", "extsnd.html#expandcontrol",
- "extsnd.html#expandcontrolbounds", "extsnd.html#expandcontrolhop", "extsnd.html#expandcontroljitter", "extsnd.html#expandcontrollength",
- "extsnd.html#expandcontrolramp", "extsnd.html#expandcontrolp", "sndscm.html#explodesf2", "sndclm.html#exponentially-weighted-moving-average",
- "sndscm.html#expsnd", "sndscm.html#expsrc", "s7.html#featureslist", "sndscm.html#cellon",
- "extsnd.html#fft", "sndscm.html#fftcancel", "sndscm.html#fftedit", "sndscm.html#fftenvedit",
- "sndscm.html#fftenvinterp", "extsnd.html#fftlogfrequency", "extsnd.html#fftlogmagnitude", "sndscm.html#fftsmoother",
- "sndscm.html#fftsquelch", "extsnd.html#fftwindow", "extsnd.html#fftalpha", "extsnd.html#fftbeta",
- "extsnd.html#fftwithphases", "sndscm.html#nbdoc", "sndclm.html#filetoarray", "sndclm.html#filetoframple",
- "sndclm.html#filetoframple?", "sndclm.html#filetosample", "sndclm.html#filetosample?", "extsnd.html#filename",
- "s7.html#fillb", "extsnd.html#fillpolygon", "extsnd.html#fillrectangle", "sndclm.html#filter",
- "extsnd.html#filterchannel", "extsnd.html#filtercontrolcoeffs", "extsnd.html#filtercontrolenvelope", "extsnd.html#filtercontrolindB",
- "extsnd.html#filtercontrolinhz", "extsnd.html#filtercontrolorder", "extsnd.html#filterwaveformcolor", "extsnd.html#filtercontrolp",
- "sndscm.html#filterfft", "extsnd.html#filterselection", "sndscm.html#filterselectionandsmooth", "extsnd.html#filtersound",
- "sndclm.html#filter?", "sndclm.html#filtered-comb", "sndclm.html#filteredcombbank", "sndclm.html#filteredcombbankp",
- "sndclm.html#filtered-comb?", "extsnd.html#finddialog", "extsnd.html#findmark", "sndscm.html#findmix",
- "extsnd.html#findsound", "sndscm.html#finfo", "extsnd.html#finishprogressreport", "sndclm.html#fir-filter",
- "sndclm.html#fir-filter?", "sndclm.html#firmant", "sndclm.html#firmant?", "sndscm.html#fitselectionbetweenmarks",
- "sndscm.html#flattenpartials", "extsnd.html#fv", "extsnd.html#fvtimes", "extsnd.html#fvplus",
- "extsnd.html#fvtochannel", "extsnd.html#fvtolist", "extsnd.html#fvtostring", "extsnd.html#fvabs",
- "extsnd.html#fvadd", "extsnd.html#fvcopy", "extsnd.html#fvequal", "extsnd.html#fvfill",
+ "extsnd.html#convolveselectionwith", "extsnd.html#convolvewith", "sndclm.html#convolve?", "extsnd.html#fvcopy",
+ "s7.html#s7copy", "extsnd.html#copycontext", "extsnd.html#copysampler", "sndclm.html#correlate",
+ "s7.html#coverlet", "sndscm.html#mixdoc", "sndscm.html#fadedoc", "sndscm.html#crosssynthesis",
+ "s7.html#curlet", "extsnd.html#currentfont", "extsnd.html#cursor", "extsnd.html#cursorcolor",
+ "extsnd.html#cursorcontext", "extsnd.html#cursorlocationoffset", "extsnd.html#cursorposition", "extsnd.html#cursorsize",
+ "extsnd.html#cursorstyle", "extsnd.html#cursorupdateinterval", "s7.html#cutlet", "s7.html#cyclicsequences",
+ "extsnd.html#dacfolding", "extsnd.html#dacsize", "extsnd.html#datacolor", "extsnd.html#datalocation",
+ "extsnd.html#datasize", "sndclm.html#dbtolinear", "extsnd.html#defaultoutputchans", "extsnd.html#defaultoutputheadertype",
+ "extsnd.html#defaultoutputsampletype", "extsnd.html#defaultoutputsrate", "sndclm.html#defgenerator", "s7.html#definestar",
+ "s7.html#defineconstant", "extsnd.html#defineenvelope", "s7.html#expansion", "s7.html#definemacro",
+ "s7.html#definemacrostar", "sndscm.html#defineselectionviamarks", "s7.html#definedp", "sndclm.html#degreestoradians",
+ "sndclm.html#delay", "sndscm.html#delaychannelmixes", "sndclm.html#delaytick", "sndclm.html#delay?",
+ "extsnd.html#deletecolormap", "extsnd.html#deletefilefilter", "extsnd.html#deletefilesorter", "extsnd.html#deletemark",
+ "extsnd.html#deletemarks", "extsnd.html#deletesample", "extsnd.html#deletesamples", "extsnd.html#deletesamplesandsmooth",
+ "extsnd.html#deleteselection", "extsnd.html#deleteselectionandsmooth", "extsnd.html#deletetransform", "sndscm.html#describehook",
+ "sndscm.html#describemark", "sndscm.html#dht", "extsnd.html#dialogwidgets", "s7.html#dilambda",
+ "sndscm.html#disablecontrolpanel", "sndscm.html#displaybarkfft", "sndscm.html#displaycorrelation", "sndscm.html#displaydb",
+ "extsnd.html#displayedits", "sndscm.html#displayenergy", "sndscm.html#dissolvefade", "sndscm.html#ditherchannel",
+ "sndscm.html#dithersound", "sndscm.html#dolph", "sndclm.html#dot-product", "extsnd.html#dotsize",
+ "sndscm.html#downoct", "extsnd.html#drawaxes", "extsnd.html#drawdot", "extsnd.html#drawdots",
+ "extsnd.html#drawline", "extsnd.html#drawlines", "extsnd.html#drawmarkhook", "extsnd.html#drawmixhook",
+ "extsnd.html#drawstring", "sndscm.html#drone", "sndscm.html#makedropsite", "extsnd.html#drophook",
+ "extsnd.html#duringopenhook", "extsnd.html#editfragment", "extsnd.html#editheaderdialog", "extsnd.html#edithook",
+ "extsnd.html#editlisttofunction", "extsnd.html#editposition", "extsnd.html#editproperties", "extsnd.html#editproperty",
+ "extsnd.html#edittree", "extsnd.html#edits", "sndclm.html#edot-product", "extsnd.html#effectshook",
+ "sndscm.html#analogfilterdoc", "sndclm.html#env", "sndclm.html#env-any", "extsnd.html#envchannel",
+ "extsnd.html#envchannelwithbase", "sndscm.html#envexptchannel", "sndclm.html#env-interp", "sndscm.html#envmixes",
+ "extsnd.html#envselection", "extsnd.html#envsound", "sndscm.html#envsoundinterp", "sndscm.html#envsquaredchannel",
+ "sndclm.html#env?", "extsnd.html#envedbase", "extsnd.html#envedclipping", "extsnd.html#enveddialog",
+ "extsnd.html#envedenvelope", "extsnd.html#filterenv", "extsnd.html#filterenvorder", "extsnd.html#envedhook",
+ "extsnd.html#envedin-dB", "extsnd.html#envedpower", "extsnd.html#envedstyle", "extsnd.html#envedtarget",
+ "extsnd.html#envedwaving", "extsnd.html#envedwaveformcolor", "sndclm.html#envelopeinterp", "sndscm.html#envelopedmix",
+ "sndclm.html#eoddcos", "sndclm.html#eoddcos?", "extsnd.html#epsbottommargin", "extsnd.html#epsfile",
+ "extsnd.html#epsleftmargin", "extsnd.html#epssize", "sndclm.html#ercos", "sndclm.html#ercos?",
+ "s7.html#errorhook", "sndclm.html#erssb", "sndclm.html#erssb?", "sndclm.html#evenmultiple",
+ "sndclm.html#evenweight", "sndscm.html#everysample", "extsnd.html#exit", "extsnd.html#exithook",
+ "extsnd.html#expandcontrol", "extsnd.html#expandcontrolbounds", "extsnd.html#expandcontrolhop", "extsnd.html#expandcontroljitter",
+ "extsnd.html#expandcontrollength", "extsnd.html#expandcontrolramp", "extsnd.html#expandcontrolp", "sndscm.html#explodesf2",
+ "sndclm.html#exponentially-weighted-moving-average", "sndscm.html#expsnd", "sndscm.html#expsrc", "s7.html#featureslist",
+ "sndscm.html#cellon", "extsnd.html#fft", "sndscm.html#fftcancel", "sndscm.html#fftedit",
+ "sndscm.html#fftenvedit", "sndscm.html#fftenvinterp", "extsnd.html#fftlogfrequency", "extsnd.html#fftlogmagnitude",
+ "sndscm.html#fftsmoother", "sndscm.html#fftsquelch", "extsnd.html#fftwindow", "extsnd.html#fftalpha",
+ "extsnd.html#fftbeta", "extsnd.html#fftwithphases", "sndscm.html#nbdoc", "sndclm.html#filetoarray",
+ "sndclm.html#filetoframple", "sndclm.html#filetoframple?", "sndclm.html#filetosample", "sndclm.html#filetosample?",
+ "extsnd.html#filename", "s7.html#fillb", "extsnd.html#fillpolygon", "extsnd.html#fillrectangle",
+ "sndclm.html#filter", "extsnd.html#filterchannel", "extsnd.html#filtercontrolcoeffs", "extsnd.html#filtercontrolenvelope",
+ "extsnd.html#filtercontrolindB", "extsnd.html#filtercontrolinhz", "extsnd.html#filtercontrolorder", "extsnd.html#filterwaveformcolor",
+ "extsnd.html#filtercontrolp", "sndscm.html#filterfft", "extsnd.html#filterselection", "sndscm.html#filterselectionandsmooth",
+ "extsnd.html#filtersound", "sndclm.html#filter?", "sndclm.html#filtered-comb", "sndclm.html#filteredcombbank",
+ "sndclm.html#filteredcombbankp", "sndclm.html#filtered-comb?", "extsnd.html#finddialog", "extsnd.html#findmark",
+ "sndscm.html#findmix", "extsnd.html#findsound", "sndscm.html#finfo", "extsnd.html#finishprogressreport",
+ "sndclm.html#fir-filter", "sndclm.html#fir-filter?", "sndclm.html#firmant", "sndclm.html#firmant?",
+ "sndscm.html#fitselectionbetweenmarks", "sndscm.html#flattenpartials", "extsnd.html#fv", "extsnd.html#fvtimes",
+ "extsnd.html#fvplus", "extsnd.html#fvtochannel", "extsnd.html#fvtolist", "extsnd.html#fvtostring",
+ "extsnd.html#fvabs", "extsnd.html#fvadd", "extsnd.html#fvequal", "extsnd.html#fvfill",
"extsnd.html#fvlength", "extsnd.html#fvmax", "extsnd.html#fvmin", "extsnd.html#fvmove",
- "extsnd.html#fvmultiply", "extsnd.html#fvoffset", "extsnd.html#fvpeak", "sndscm.html#vctpolynomial",
+ "extsnd.html#fvmultiply", "extsnd.html#fvoffset", "extsnd.html#fvpeak", "sndscm.html#fvpolynomial",
"extsnd.html#fvref", "extsnd.html#fvreverse", "extsnd.html#fvscale", "extsnd.html#fvset",
"extsnd.html#fvsubseq", "extsnd.html#fvsubtract", "extsnd.html#fvp", "sndclm.html#flocsig",
"sndclm.html#flocsig?", "sndscm.html#stereoflute", "sndscm.html#fmbell", "sndscm.html#fmdrum",
@@ -695,244 +685,237 @@ static const char *help_urls[HELP_NAMES_SIZE] = {
"extsnd.html#leftsample", "s7.html#lettolist", "s7.html#letref", "s7.html#letset",
"s7.html#lettemporarily", "s7.html#letp", "sndclm.html#lineartodb", "sndscm.html#linearsrcchannel",
"sndscm.html#lintdoc", "extsnd.html#lispgraphhook", "extsnd.html#lispgraphstyle", "extsnd.html#lispgraphp",
- "extsnd.html#listtofv", "extsnd.html#listtovct", "grfsnd.html#listladspa", "extsnd.html#listenerclickhook",
- "extsnd.html#listenercolor", "extsnd.html#listenercolorized", "extsnd.html#listenerfont", "extsnd.html#listenerprompt",
- "extsnd.html#listenerselection", "extsnd.html#listenertextcolor", "extsnd.html#littleendianp", "s7.html#loadhook",
- "s7.html#loadpath", "sndscm.html#locatezero", "sndclm.html#locsig", "sndclm.html#locsig-ref",
- "sndclm.html#locsig-reverb-ref", "sndclm.html#locsig-reverb-set!", "sndclm.html#locsig-set!", "sndclm.html#locsig-type",
- "sndclm.html#locsig?", "extsnd.html#logfreqstart", "sndscm.html#lpccoeffs", "sndscm.html#lpcpredict",
- "s7.html#macrop", "s7.html#macroexpand", "extsnd.html#mainmenu", "extsnd.html#mainwidgets",
- "sndclm.html#make-abcos", "sndclm.html#make-absin", "sndclm.html#make-adjustable-sawtooth-wave", "sndclm.html#make-adjustable-square-wave",
- "sndclm.html#make-adjustable-triangle-wave", "sndclm.html#make-all-pass", "sndclm.html#makeallpassbank", "sndclm.html#make-asyfm",
- "sndclm.html#make-asymmetric-fm", "sndscm.html#makebandpass", "sndscm.html#makebandstop", "sndclm.html#make-bess",
- "sndscm.html#makebiquad", "sndscm.html#makebirds", "sndclm.html#make-blackman", "sndclm.html#make-brown-noise",
- "s7.html#makebytevector", "sndscm.html#makedropsite", "extsnd.html#makecolor", "sndclm.html#make-comb",
- "sndclm.html#makecombbank", "sndclm.html#make-convolve", "sndclm.html#make-delay", "sndscm.html#makedifferentiator",
- "sndclm.html#make-env", "sndclm.html#make-eoddcos", "sndclm.html#make-ercos", "sndclm.html#make-erssb",
- "sndclm.html#make-fft-window", "sndclm.html#make-filetoframple", "sndclm.html#make-filetosample", "sndclm.html#make-filter",
- "sndclm.html#make-filtered-comb", "sndclm.html#makefilteredcombbank", "sndclm.html#make-fir-coeffs", "sndclm.html#make-fir-filter",
- "sndclm.html#make-firmant", "extsnd.html#makefv", "sndclm.html#make-flocsig", "sndclm.html#make-fmssb",
- "sndclm.html#make-formant", "sndclm.html#makeformantbank", "sndclm.html#make-frampletofile", "sndclm.html#make-granulate",
- "extsnd.html#makegraphdata", "sndclm.html#make-green-noise", "sndclm.html#make-green-noise-interp", "s7.html#makehashtable",
- "sndscm.html#makehighpass", "sndscm.html#makehilberttransform", "s7.html#makehook", "sndclm.html#make-iir-filter",
- "s7.html#makeintvector", "s7.html#makeiterator", "sndclm.html#make-izcos", "sndclm.html#make-j0evencos",
- "sndclm.html#make-j0j1cos", "sndclm.html#make-j2cos", "sndclm.html#make-jjcos", "sndclm.html#make-jncos",
- "sndclm.html#make-jpcos", "sndclm.html#make-jycos", "sndclm.html#make-k2cos", "sndclm.html#make-k2sin",
- "sndclm.html#make-k2ssb", "sndclm.html#make-k3sin", "sndclm.html#make-krksin", "sndclm.html#make-locsig",
- "sndscm.html#makelowpass", "extsnd.html#makemixsampler", "sndclm.html#make-move-sound", "sndclm.html#make-moving-autocorrelation",
- "sndclm.html#make-moving-average", "sndclm.html#make-moving-fft", "sndclm.html#make-moving-max", "sndclm.html#make-moving-norm",
- "sndclm.html#make-moving-pitch", "sndclm.html#make-moving-scentroid", "sndclm.html#make-moving-spectrum", "sndclm.html#make-n1cos",
- "sndclm.html#make-nchoosekcos", "sndclm.html#make-ncos", "sndclm.html#make-nkssb", "sndclm.html#make-noddcos",
- "sndclm.html#make-noddsin", "sndclm.html#make-noddssb", "sndclm.html#make-noid", "sndclm.html#make-notch",
- "sndclm.html#make-nrcos", "sndclm.html#make-nrsin", "sndclm.html#make-nrssb", "sndclm.html#make-nrxycos",
- "sndclm.html#make-nrxysin", "sndclm.html#make-nsin", "sndclm.html#make-nsincos", "sndclm.html#make-nssb",
- "sndclm.html#make-nxy1cos", "sndclm.html#make-nxy1sin", "sndclm.html#make-nxycos", "sndclm.html#make-nxysin",
- "sndclm.html#make-one-pole", "sndclm.html#make-one-pole-all-pass", "sndclm.html#make-one-zero", "sndclm.html#make-oscil",
- "sndclm.html#make-oscil-bank", "sndclm.html#make-phase-vocoder", "sndclm.html#make-pink-noise", "sndscm.html#makepixmap",
- "extsnd.html#makeplayer", "sndclm.html#make-polyoid", "sndclm.html#make-polyshape", "sndclm.html#make-polywave",
- "sndclm.html#make-pulse-train", "sndclm.html#make-pulsed-env", "sndclm.html#make-r2k!cos", "sndclm.html#make-r2k2cos",
- "sndscm.html#makeramp", "sndclm.html#make-rand", "sndclm.html#make-rand-interp", "sndclm.html#make-rcos",
- "sndclm.html#make-readin", "extsnd.html#makeregion", "extsnd.html#makeregionsampler", "sndclm.html#make-rk!cos",
- "sndclm.html#make-rk!ssb", "sndclm.html#make-rkcos", "sndclm.html#make-rkoddssb", "sndclm.html#make-rksin",
- "sndclm.html#make-rkssb", "sndclm.html#make-round-interp", "sndclm.html#make-rssb", "sndclm.html#make-rxycos",
- "sndclm.html#make-rxyk!cos", "sndclm.html#make-rxyk!sin", "sndclm.html#make-rxysin", "sndclm.html#make-sampletofile",
- "extsnd.html#makesampler", "sndclm.html#make-sawtooth-wave", "sndscm.html#makeselection", "sndclm.html#make-sinc-train",
- "extsnd.html#makesndtosample", "sndscm.html#makesoundbox", "sndscm.html#makespencerfilter", "sndclm.html#make-square-wave",
- "sndclm.html#make-src", "sndclm.html#make-ssb-am", "sndclm.html#make-table-lookup", "sndclm.html#make-table-lookup-with-env",
- "sndclm.html#make-tanhsin", "sndclm.html#make-triangle-wave", "sndclm.html#make-two-pole", "sndclm.html#make-two-zero",
- "sndscm.html#makevariabledisplay", "extsnd.html#makevariablegraph", "extsnd.html#makevct", "sndclm.html#make-wave-train",
- "sndclm.html#make-wave-train-with-env", "extsnd.html#mapchannel", "sndscm.html#mapsoundfiles", "sndscm.html#maracadoc",
- "extsnd.html#marktointeger", "extsnd.html#markclickhook", "sndscm.html#markclickinfo", "extsnd.html#markcolor",
- "extsnd.html#markcontext", "extsnd.html#markdraghook", "sndscm.html#markexplode", "extsnd.html#markhome",
- "extsnd.html#markhook", "sndscm.html#markloops", "extsnd.html#markname", "sndscm.html#marknametoid",
- "extsnd.html#markproperties", "extsnd.html#markproperty", "extsnd.html#marksample", "extsnd.html#marksync",
- "sndscm.html#marksynccolor", "extsnd.html#marksyncmax", "extsnd.html#marktagheight", "extsnd.html#marktagwidth",
- "extsnd.html#markp", "extsnd.html#emarks", "sndscm.html#matchsoundfiles", "sndscm.html#maxenvelope",
- "extsnd.html#maxregions", "extsnd.html#maxfftpeaks", "extsnd.html#maxamp", "extsnd.html#maxampposition",
- "extsnd.html#menuwidgets", "sndscm.html#menusdoc", "extsnd.html#mindb", "extsnd.html#mix",
- "sndscm.html#mixtovct", "extsnd.html#mixtointeger", "extsnd.html#mixamp", "extsnd.html#mixampenv",
- "sndscm.html#mixchannel", "extsnd.html#mixclickhook", "sndscm.html#mixclickinfo", "sndscm.html#mixclicksetsamp",
- "extsnd.html#mixcolor", "extsnd.html#mixdialogmix", "extsnd.html#mixdraghook", "extsnd.html#mixfiledialog",
- "extsnd.html#mixhome", "extsnd.html#mixlength", "sndscm.html#mixmaxamp", "extsnd.html#mixname",
- "sndscm.html#mixnametoid", "extsnd.html#mixposition", "extsnd.html#mixproperties", "extsnd.html#mixproperty",
- "extsnd.html#mixregion", "extsnd.html#mixreleasehook", "extsnd.html#mixsamplerQ", "extsnd.html#mixselection",
- "sndscm.html#mixsound", "extsnd.html#mixspeed", "extsnd.html#mixsync", "extsnd.html#mixsyncmax",
- "extsnd.html#mixtagheight", "extsnd.html#mixtagwidth", "extsnd.html#mixtagy", "extsnd.html#mixvct",
- "extsnd.html#mixwaveformheight", "extsnd.html#mixp", "extsnd.html#mixes", "sndscm.html#monotostereo",
- "sndscm.html#moogfilter", "s7.html#morallyequalp", "extsnd.html#mouseclickhook", "extsnd.html#mousedraghook",
- "extsnd.html#mouseentergraphhook", "extsnd.html#mouseenterlabelhook", "extsnd.html#mouseenterlistenerhook", "extsnd.html#mouseentertexthook",
- "extsnd.html#mouseleavegraphhook", "extsnd.html#mouseleavelabelhook", "extsnd.html#mousleavelistenerhook", "extsnd.html#mousleavetexthook",
- "extsnd.html#mousepresshook", "sndclm.html#move-locsig", "sndscm.html#movemixes", "sndclm.html#move-sound",
- "sndclm.html#move-sound?", "sndscm.html#movesyncdmarks", "sndclm.html#moving-autocorrelation", "sndclm.html#moving-autocorrelation?",
- "sndclm.html#moving-average", "sndclm.html#moving-average?", "sndclm.html#moving-fft", "sndclm.html#moving-fft?",
- "sndclm.html#moving-length", "sndclm.html#moving-max", "sndclm.html#moving-max?", "sndclm.html#moving-norm",
- "sndclm.html#moving-norm?", "sndclm.html#moving-pitch", "sndclm.html#moving-pitch?", "sndclm.html#moving-rms",
- "sndclm.html#moving-scentroid", "sndclm.html#moving-scentroid?", "sndclm.html#moving-spectrum", "sndclm.html#moving-spectrum?",
- "sndclm.html#moving-sum", "sndscm.html#mpg", "extsnd.html#musalsabuffersize", "extsnd.html#musalsabuffers",
- "extsnd.html#musalsacapturedevice", "extsnd.html#musalsadevice", "extsnd.html#musalsaplaybackdevice", "extsnd.html#musalsasquelchwarning",
- "sndclm.html#musarrayprintlength", "extsnd.html#musbytespersample", "sndclm.html#mus-channel", "sndclm.html#mus-channels",
- "sndclm.html#mus-chebyshev-tu-sum", "extsnd.html#musclipping", "sndclm.html#mus-close", "sndclm.html#mus-copy",
- "sndclm.html#mus-data", "sndclm.html#mus-describe", "extsnd.html#muserrorhook", "extsnd.html#muserrortypetostring",
- "extsnd.html#musexpandfilename", "sndclm.html#mus-feedback", "sndclm.html#mus-feedforward", "sndclm.html#fft",
- "sndclm.html#musfilebuffersize", "extsnd.html#musfileclipping", "sndscm.html#musfilemix", "sndclm.html#mus-file-name",
- "sndclm.html#musfloatequalfudgefactor", "sndclm.html#mus-frequency", "sndclm.html#musgeneratorp", "extsnd.html#musheaderrawdefaults",
- "extsnd.html#musheadertypetostring", "extsnd.html#musheadertypename", "sndclm.html#mus-hop", "sndclm.html#mus-increment",
- "sndclm.html#mus-input?", "sndclm.html#mus-interp-type", "sndclm.html#mus-interpolate", "sndclm.html#mus-length",
- "sndclm.html#mus-location", "extsnd.html#musmaxmalloc", "extsnd.html#musmaxtablesize", "sndclm.html#mus-name",
- "sndclm.html#mus-offset", "sndclm.html#mus-order", "extsnd.html#musosssetbuffers", "sndclm.html#mus-output?",
- "sndclm.html#mus-phase", "sndclm.html#mus-ramp", "sndclm.html#mus-rand-seed", "sndclm.html#mus-random",
- "sndclm.html#mus-reset", "sndclm.html#mus-run", "extsnd.html#mussampletypetostring", "extsnd.html#mussampletypename",
- "sndclm.html#mus-scaler", "extsnd.html#mussoundchans", "extsnd.html#mussoundcloseinput", "extsnd.html#mussoundcloseoutput",
- "extsnd.html#mussoundcomment", "extsnd.html#mussounddatalocation", "extsnd.html#mussounddatumsize", "extsnd.html#mussoundduration",
- "extsnd.html#mussoundforget", "extsnd.html#mussoundframples", "extsnd.html#mussoundheadertype", "extsnd.html#mussoundlength",
- "extsnd.html#mussoundloopinfo", "extsnd.html#mussoundmarkinfo", "extsnd.html#mussoundmaxamp", "extsnd.html#mussoundmaxampexists",
- "extsnd.html#mussoundopeninput", "extsnd.html#mussoundopenoutput", "extsnd.html#mussoundpath", "extsnd.html#mussoundpreload",
- "extsnd.html#mussoundprune", "extsnd.html#mussoundread", "extsnd.html#mussoundreopenoutput", "extsnd.html#mussoundreportcache",
- "extsnd.html#mussoundsampletype", "extsnd.html#mussoundsamples", "extsnd.html#mussoundseekframple", "extsnd.html#mussoundsrate",
- "extsnd.html#mussoundtypespecifier", "extsnd.html#mussoundwrite", "extsnd.html#mussoundwritedate", "sndclm.html#mussrate",
- "sndclm.html#mus-width", "sndclm.html#mus-xcoeff", "sndclm.html#mus-xcoeffs", "sndclm.html#mus-ycoeff",
- "sndclm.html#mus-ycoeffs", "sndclm.html#n1cos", "sndclm.html#n1cos?", "extsnd.html#nameclickhook",
- "sndclm.html#nchoosekcos", "sndclm.html#nchoosekcos?", "sndclm.html#ncos", "sndclm.html#ncos2?",
- "sndclm.html#ncos4?", "sndclm.html#ncos?", "extsnd.html#newsound", "extsnd.html#newsounddialog",
- "extsnd.html#newsoundhook", "extsnd.html#newwidgethook", "extsnd.html#nextsample", "sndclm.html#nkssb",
- "sndclm.html#nkssbinterp", "sndclm.html#nkssb?", "sndclm.html#noddcos", "sndclm.html#noddcos?",
- "sndclm.html#noddsin", "sndclm.html#noddsin?", "sndclm.html#noddssb", "sndclm.html#noddssb?",
- "sndclm.html#noid", "extsnd.html#normalizechannel", "sndscm.html#normalizeenvelope", "sndclm.html#normalizepartials",
- "sndscm.html#normalizesound", "sndscm.html#normalizedmix", "sndclm.html#notch", "sndscm.html#notchchannel",
- "sndscm.html#notchselection", "sndscm.html#notchsound", "sndclm.html#notch?", "sndclm.html#npcos?",
- "sndclm.html#nrcos", "sndclm.html#nrcos?", "sndscm.html#nrev", "sndclm.html#nrsin",
- "sndclm.html#nrsin?", "sndclm.html#nrssb", "sndclm.html#nrssbinterp", "sndclm.html#nrssb?",
- "sndclm.html#nrxycos", "sndclm.html#nrxycos?", "sndclm.html#nrxysin", "sndclm.html#nrxysin?",
- "sndclm.html#nsin", "sndclm.html#nsin?", "sndclm.html#nsincos", "sndclm.html#nsincos?",
- "sndclm.html#nssb", "sndclm.html#nssb?", "sndclm.html#nxy1cos", "sndclm.html#nxy1cos?",
- "sndclm.html#nxy1sin", "sndclm.html#nxy1sin?", "sndclm.html#nxycos", "sndclm.html#nxycos?",
- "sndclm.html#nxysin", "sndclm.html#nxysin?", "s7.html#objecttolet", "s7.html#objecttostring",
- "sndclm.html#oddmultiple", "sndclm.html#oddweight", "sndscm.html#offsetchannel", "sndscm.html#offsetsound",
- "sndclm.html#one-pole", "sndclm.html#one-pole-all-pass", "sndclm.html#one-pole-all-pass?", "sndclm.html#one-pole?",
- "sndclm.html#one-zero", "sndclm.html#one-zero?", "extsnd.html#openfiledialog", "extsnd.html#openfiledialogdirectory",
- "extsnd.html#openhook", "sndscm.html#opennextfileindirectory", "extsnd.html#openrawsound", "extsnd.html#openrawsoundhook",
- "extsnd.html#opensound", "s7.html#openlet", "s7.html#openletp", "extsnd.html#orientationhook",
- "sndclm.html#oscil", "sndclm.html#oscil-bank", "sndclm.html#oscil-bank?", "sndclm.html#oscil?",
- "sndclm.html#out-any", "sndclm.html#outbank", "sndclm.html#outa", "s7.html#outlet",
- "sndclm.html#*output*", "extsnd.html#outputcommenthook", "sndscm.html#overlayrmsenv", "s7.html#owlet",
- "extsnd.html#padchannel", "sndscm.html#padmarks", "sndscm.html#padsound", "s7.html#pairfilename",
- "s7.html#pairlinenumber", "sndscm.html#panmix", "sndscm.html#panmixvct", "sndclm.html#partialstopolynomial",
- "sndclm.html#partialstowave", "extsnd.html#pausing", "extsnd.html#peakenvdir", "extsnd.html#peaks",
- "extsnd.html#peaksfont", "sndclm.html#phase-partialstowave", "sndclm.html#phase-vocoder", "sndclm.html#phase-vocoder?",
- "sndscm.html#pianodoc", "sndclm.html#pink-noise", "sndclm.html#pink-noise?", "sndscm.html#pins",
- "sndscm.html#placesound", "extsnd.html#play", "extsnd.html#playarrowsize", "sndscm.html#playbetweenmarks",
- "extsnd.html#playhook", "sndscm.html#playmixes", "sndscm.html#playoften", "sndscm.html#playregionforever",
- "sndscm.html#playsine", "sndscm.html#playsines", "sndscm.html#playsyncdmarks", "sndscm.html#playuntilcg",
- "sndscm.html#playwithenvs", "extsnd.html#playerhome", "extsnd.html#playerQ", "extsnd.html#players",
- "extsnd.html#playing", "sndscm.html#pluck", "sndclm.html#polartorectangular", "sndclm.html#polynomial",
- "sndscm.html#polydoc", "sndclm.html#polyoid", "sndclm.html#polyoidenv", "sndclm.html#polyoid?",
- "sndclm.html#polyshape", "sndclm.html#polyshape?", "sndclm.html#polywave", "sndclm.html#polywave?",
- "s7.html#portfilename", "s7.html#portlinenumber", "extsnd.html#positiontox", "extsnd.html#positiontoy",
- "extsnd.html#positioncolor", "sndscm.html#powerenv", "sndscm.html#pqw", "sndscm.html#pqwvox",
- "extsnd.html#preferencesdialog", "extsnd.html#previoussample", "extsnd.html#printdialog", "extsnd.html#printlength",
- "s7.html#proceduredocumentation", "s7.html#proceduresetter", "s7.html#proceduresignature", "s7.html#proceduresource",
- "extsnd.html#progressreport", "sndclm.html#pulse-train", "sndclm.html#pulse-train?", "sndclm.html#pulsedenv",
- "sndclm.html#pulsedenv?", "sndclm.html#r2k!cos", "sndclm.html#r2k!cos?", "sndclm.html#r2k2cos",
- "sndclm.html#r2k2cos?", "sndclm.html#radianstodegrees", "sndclm.html#radianstohz", "extsnd.html#rampchannel",
- "sndclm.html#rand", "sndclm.html#rand-interp", "sndclm.html#rand-interp?", "sndclm.html#rand?",
- "s7.html#random", "s7.html#randomstate", "s7.html#randomstatep", "sndclm.html#rcos",
- "sndclm.html#rcos?", "s7.html#readerrorhook", "extsnd.html#readhook", "extsnd.html#readmixsample",
- "extsnd.html#readonly", "extsnd.html#readregionsample", "extsnd.html#readsample", "extsnd.html#readsamplewithdirection",
- "s7.html#readercond", "sndclm.html#readin", "sndclm.html#readin?", "sndclm.html#rectangulartomagnitudes",
- "sndclm.html#rectangulartopolar", "extsnd.html#redo", "extsnd.html#regiontointeger", "extsnd.html#regiontovct",
- "extsnd.html#regionchans", "extsnd.html#regionframples", "extsnd.html#regiongraphstyle", "extsnd.html#regionhome",
- "extsnd.html#regionmaxamp", "extsnd.html#regionmaxampposition", "sndscm.html#regionplaylist", "extsnd.html#regionposition",
- "sndscm.html#regionrms", "extsnd.html#regionsample", "extsnd.html#regionsamplerQ", "extsnd.html#regionsrate",
- "extsnd.html#regionok", "extsnd.html#eregions", "extsnd.html#remembersoundstate", "sndscm.html#removeclicks",
- "extsnd.html#removefrommenu", "sndscm.html#replacewithselection", "sndscm.html#reportmarknames", "s7.html#requires7",
- "sndscm.html#resetallhooks", "extsnd.html#resetcontrols", "extsnd.html#resetlistenercursor", "sndscm.html#reson",
- "extsnd.html#restorecontrols", "sndclm.html#*reverb*", "extsnd.html#reverbdecay", "extsnd.html#reverbcontrolfeedback",
- "extsnd.html#reverbcontrollength", "extsnd.html#reverbcontrollengthbounds", "extsnd.html#reverbcontrollowpass", "extsnd.html#reverbcontrolscale",
- "extsnd.html#reverbcontrolscalebounds", "extsnd.html#reverbcontrolp", "s7.html#reverseb", "sndscm.html#reversebyblocks",
- "extsnd.html#reversechannel", "sndscm.html#reverseenvelope", "extsnd.html#reverseselection", "extsnd.html#reversesound",
- "extsnd.html#revertsound", "extsnd.html#rightsample", "sndclm.html#ring-modulate", "sndclm.html#rk!cos",
- "sndclm.html#rk!cos?", "sndclm.html#rk!ssb", "sndclm.html#rk!ssb?", "sndclm.html#rkcos",
- "sndclm.html#rkcos?", "sndclm.html#rkoddssb", "sndclm.html#rkoddssb?", "sndclm.html#rksin",
- "sndclm.html#rksin?", "sndclm.html#rkssb", "sndclm.html#rkssb?", "sndscm.html#rmsgain",
- "sndscm.html#rmsgain", "sndscm.html#rmsenvelope", "s7.html#rootlet", "s7.html#rootletredefinitionhook",
- "sndclm.html#round-interp", "sndclm.html#round-interp?", "sndclm.html#rssb", "sndclm.html#rssbinterp",
- "sndclm.html#rssb?", "sndscm.html#rubbersound", "sndclm.html#rxycos", "sndclm.html#rxycos?",
- "sndclm.html#rxyk!cos", "sndclm.html#rxyk!cos?", "sndclm.html#rxyk!sin", "sndclm.html#rxyk!sin?",
- "sndclm.html#rxysin", "sndclm.html#rxysin?", "extsnd.html#sample", "sndclm.html#sampletofile",
- "sndclm.html#sampletofile?", "extsnd.html#sampletype", "extsnd.html#sampleratendQ", "extsnd.html#samplerhome",
- "extsnd.html#samplerposition", "extsnd.html#samplerQ", "extsnd.html#samples", "sndclm.html#samplestoseconds",
- "extsnd.html#sashcolor", "extsnd.html#saveasdialogautocomment", "extsnd.html#saveasdialogsrc", "extsnd.html#savecontrols",
- "extsnd.html#savedir", "extsnd.html#saveedithistory", "extsnd.html#saveenvelopes", "extsnd.html#savehook",
- "extsnd.html#savelistener", "sndscm.html#savemarkproperties", "extsnd.html#savemarks", "extsnd.html#savemix",
- "extsnd.html#saveregion", "extsnd.html#saveregiondialog", "extsnd.html#saveselection", "extsnd.html#saveselectiondialog",
- "extsnd.html#savesound", "extsnd.html#savesoundas", "extsnd.html#savesounddialog", "extsnd.html#savestate",
- "extsnd.html#savestatefile", "extsnd.html#savestatehook", "sndscm.html#sgfilter", "sndclm.html#sawtooth-wave",
- "sndclm.html#sawtooth-wave?", "extsnd.html#scaleby", "extsnd.html#scalechannel", "sndscm.html#scaleenvelope",
- "sndscm.html#scalemixes", "extsnd.html#scaleselectionby", "extsnd.html#scaleselectionto", "sndscm.html#scalesound",
- "sndscm.html#scaletempo", "extsnd.html#scaleto", "extsnd.html#scanchannel", "sndscm.html#dspdocscanned",
- "sndscm.html#scentroid", "sndscm.html#scratch", "extsnd.html#scriptarg", "extsnd.html#scriptargs",
- "sndscm.html#searchforclick", "extsnd.html#searchprocedure", "sndclm.html#secondstosamples", "extsnd.html#selectall",
- "extsnd.html#selectchannel", "extsnd.html#selectchannelhook", "extsnd.html#selectsound", "extsnd.html#selectsoundhook",
- "extsnd.html#selectedchannel", "extsnd.html#selecteddatacolor", "extsnd.html#selectedgraphcolor", "extsnd.html#selectedsound",
- "extsnd.html#selection", "extsnd.html#selectiontomix", "extsnd.html#selectionchans", "extsnd.html#selectioncolor",
- "extsnd.html#selectioncontext", "extsnd.html#selectioncreatesregion", "extsnd.html#selectionframples", "extsnd.html#selectionmaxamp",
- "extsnd.html#selectionmaxampposition", "extsnd.html#selectionmember", "sndscm.html#selectionmembers", "extsnd.html#selectionposition",
- "sndscm.html#selectionrms", "extsnd.html#selectionsrate", "extsnd.html#selectionok", "extsnd.html#setsamples",
- "extsnd.html#shortfilename", "extsnd.html#showaxes", "extsnd.html#showcontrols", "sndscm.html#showdiskspace",
- "extsnd.html#showfullduration", "extsnd.html#showfullrange", "extsnd.html#showgrid", "extsnd.html#showindices",
- "extsnd.html#showlistener", "extsnd.html#showmarks", "extsnd.html#showmixwaveforms", "extsnd.html#showselection",
- "extsnd.html#showselectiontransform", "extsnd.html#showsonogramcursor", "extsnd.html#showtransformpeaks", "extsnd.html#showwidget",
- "extsnd.html#showyzero", "sndscm.html#silenceallmixes", "sndscm.html#silencemixes", "sndclm.html#sinc-train",
- "sndclm.html#sinc-train?", "extsnd.html#sincwidth", "sndscm.html#sineenvchannel", "sndscm.html#sineramp",
- "sndscm.html#singerdoc", "extsnd.html#smoothchannel", "extsnd.html#smoothselection", "extsnd.html#smoothsound",
- "sndscm.html#pins", "sndscm.html#snapmarktobeat", "sndscm.html#snapmarks", "sndscm.html#snapmixtobeat",
- "extsnd.html#sndtosample", "extsnd.html#sndtosamplep", "extsnd.html#sndcolor", "extsnd.html#snderror",
- "extsnd.html#snderrorhook", "extsnd.html#sndfont", "extsnd.html#sndgcs", "extsnd.html#sndhelp",
- "sndscm.html#sndscmhooks", "extsnd.html#sndopenedsound", "extsnd.html#sndprint", "extsnd.html#sndspectrum",
- "extsnd.html#sndtempnam", "extsnd.html#sndurl", "extsnd.html#sndurls", "extsnd.html#sndversion",
- "extsnd.html#sndwarning", "extsnd.html#sndwarninghook", "sndscm.html#sndwarp", "s7.html#sortb",
- "sndscm.html#soundtoamp_env", "extsnd.html#soundtointeger", "extsnd.html#soundfileextensions", "extsnd.html#soundfilep",
- "extsnd.html#soundfilesindirectory", "sndscm.html#soundinterp", "extsnd.html#soundloopinfo", "extsnd.html#soundproperties",
- "extsnd.html#soundproperty", "extsnd.html#soundwidgets", "extsnd.html#soundp", "extsnd.html#soundfontinfo",
- "extsnd.html#sounds", "sndscm.html#soundstosegmentdata", "sndscm.html#spectra", "sndscm.html#twotab",
- "sndscm.html#spectralpolynomial", "extsnd.html#spectrohop", "extsnd.html#spectroxangle", "extsnd.html#spectroxscale",
- "extsnd.html#spectroyangle", "extsnd.html#spectroyscale", "extsnd.html#spectrozangle", "extsnd.html#spectrozscale",
- "sndclm.html#spectrum", "sndscm.html#spectrumtocoeffs", "extsnd.html#spectrumend", "extsnd.html#spectrumstart",
- "extsnd.html#speedcontrol", "extsnd.html#speedcontrolbounds", "extsnd.html#speedstyle", "extsnd.html#speedtones",
- "sndscm.html#spotfreq", "sndclm.html#square-wave", "sndclm.html#square-wave?", "extsnd.html#squelchupdate",
- "sndscm.html#squelchvowels", "extsnd.html#srate", "sndclm.html#src", "extsnd.html#srcchannel",
- "sndscm.html#srcduration", "sndscm.html#srcfitenvelope", "sndscm.html#srcmixes", "extsnd.html#srcsoundselection",
- "extsnd.html#srcsound", "sndclm.html#src?", "sndclm.html#ssb-am", "sndclm.html#ssb-am?",
- "sndscm.html#ssbbank", "sndscm.html#ssbbankenv", "sndscm.html#ssbfm", "sndscm.html#startdac",
- "extsnd.html#startplaying", "extsnd.html#startplayinghook", "extsnd.html#startplayingselectionhook", "extsnd.html#startprogressreport",
- "extsnd.html#statusreport", "extsnd.html#stdinprompt", "sndscm.html#stereotomono", "sndscm.html#stereoflute",
- "extsnd.html#stopplayer", "extsnd.html#stopplaying", "extsnd.html#stopplayinghook", "extsnd.html#stopplayingselectionhook",
- "sndscm.html#stretchenvelope", "sndscm.html#stretchsoundviadft", "s7.html#stringtobytevector", "s7.html#stringposition",
- "s7.html#sublet", "sndscm.html#superimposeffts", "extsnd.html#swapchannels", "sndscm.html#swapselectionchannels",
- "s7.html#symboltodynamicvalue", "s7.html#symboltovalue", "s7.html#symbolaccess", "s7.html#symboltable",
- "extsnd.html#sync", "sndscm.html#sync-everything", "extsnd.html#syncmax", "extsnd.html#syncstyle",
- "extsnd.html#syncdmarks", "sndscm.html#syncdmixes", "sndscm.html#syncup", "sndclm.html#table-lookup",
- "sndclm.html#table-lookup?", "sndclm.html#tanhsin", "sndclm.html#tanhsin?", "sndclm.html#tap",
- "sndclm.html#tap?", "sndscm.html#telephone", "extsnd.html#tempdir", "extsnd.html#textfocuscolor",
- "extsnd.html#timegraphstyle", "extsnd.html#timegraphtype", "extsnd.html#timegraphp", "sndclm.html#timestosamples",
- "extsnd.html#tinyfont", "sndscm.html#telephone", "s7.html#trace", "extsnd.html#trackingcursorstyle",
- "extsnd.html#transformtointeger", "extsnd.html#transformtovct", "extsnd.html#transformdialog", "extsnd.html#transformframples",
- "extsnd.html#transformgraphstyle", "extsnd.html#transformgraphtype", "extsnd.html#transformgraphp", "extsnd.html#normalizefft",
- "extsnd.html#transformsample", "extsnd.html#transformsize", "extsnd.html#transformtype", "extsnd.html#transformp",
- "sndscm.html#transposemixes", "sndclm.html#triangle-wave", "sndclm.html#triangle-wave?", "sndscm.html#tubebell",
- "sndscm.html#tubebell", "sndclm.html#two-pole", "sndclm.html#two-pole?", "sndscm.html#twotab",
- "sndclm.html#two-zero", "sndclm.html#two-zero?", "extsnd.html#unbindkey", "s7.html#unboundvariablehook",
- "sndscm.html#unclipchannel", "extsnd.html#undo", "extsnd.html#undohook", "s7.html#unlet",
- "extsnd.html#unselectall", "sndscm.html#updategraphs", "extsnd.html#updatehook", "extsnd.html#updatelispgraph",
- "extsnd.html#updatesound", "extsnd.html#updatetimegraph", "extsnd.html#updatetransformgraph", "sndscm.html#uponsaveyourself",
- "sndscm.html#sndmotifdoc", "sndscm.html#variabledisplay", "extsnd.html#variablegraphp", "s7.html#varlet",
- "extsnd.html#vct", "extsnd.html#vcttimes", "extsnd.html#vctplus", "extsnd.html#vcttochannel",
- "extsnd.html#vcttolist", "extsnd.html#vcttostring", "extsnd.html#vcttovector", "extsnd.html#vctabs",
- "extsnd.html#vctadd", "extsnd.html#vctcopy", "extsnd.html#vctequal", "extsnd.html#vctfill",
- "extsnd.html#vctlength", "extsnd.html#vctmax", "extsnd.html#vctmin", "extsnd.html#vctmove",
- "extsnd.html#vctmultiply", "extsnd.html#vctoffset", "extsnd.html#vctpeak", "extsnd.html#vctref",
- "extsnd.html#vctreverse", "extsnd.html#vctscale", "extsnd.html#vctset", "extsnd.html#vctsubseq",
- "extsnd.html#vctsubtract", "extsnd.html#vctp", "extsnd.html#vectortovct", "sndscm.html#vibratinguniformcircularstring",
+ "extsnd.html#listtofv", "grfsnd.html#listladspa", "extsnd.html#listenerclickhook", "extsnd.html#listenercolor",
+ "extsnd.html#listenercolorized", "extsnd.html#listenerfont", "extsnd.html#listenerprompt", "extsnd.html#listenerselection",
+ "extsnd.html#listenertextcolor", "extsnd.html#littleendianp", "s7.html#loadhook", "s7.html#loadpath",
+ "sndscm.html#locatezero", "sndclm.html#locsig", "sndclm.html#locsig-ref", "sndclm.html#locsig-reverb-ref",
+ "sndclm.html#locsig-reverb-set!", "sndclm.html#locsig-set!", "sndclm.html#locsig-type", "sndclm.html#locsig?",
+ "extsnd.html#logfreqstart", "sndscm.html#lpccoeffs", "sndscm.html#lpcpredict", "s7.html#macrop",
+ "s7.html#macroexpand", "extsnd.html#mainmenu", "extsnd.html#mainwidgets", "sndclm.html#make-abcos",
+ "sndclm.html#make-absin", "sndclm.html#make-adjustable-sawtooth-wave", "sndclm.html#make-adjustable-square-wave", "sndclm.html#make-adjustable-triangle-wave",
+ "sndclm.html#make-all-pass", "sndclm.html#makeallpassbank", "sndclm.html#make-asyfm", "sndclm.html#make-asymmetric-fm",
+ "sndscm.html#makebandpass", "sndscm.html#makebandstop", "sndclm.html#make-bess", "sndscm.html#makebiquad",
+ "sndscm.html#makebirds", "sndclm.html#make-blackman", "sndclm.html#make-brown-noise", "s7.html#makebytevector",
+ "sndscm.html#makedropsite", "extsnd.html#makecolor", "sndclm.html#make-comb", "sndclm.html#makecombbank",
+ "sndclm.html#make-convolve", "sndclm.html#make-delay", "sndscm.html#makedifferentiator", "sndclm.html#make-env",
+ "sndclm.html#make-eoddcos", "sndclm.html#make-ercos", "sndclm.html#make-erssb", "sndclm.html#make-fft-window",
+ "sndclm.html#make-filetoframple", "sndclm.html#make-filetosample", "sndclm.html#make-filter", "sndclm.html#make-filtered-comb",
+ "sndclm.html#makefilteredcombbank", "sndclm.html#make-fir-coeffs", "sndclm.html#make-fir-filter", "sndclm.html#make-firmant",
+ "extsnd.html#makefv", "sndclm.html#make-flocsig", "sndclm.html#make-fmssb", "sndclm.html#make-formant",
+ "sndclm.html#makeformantbank", "sndclm.html#make-frampletofile", "sndclm.html#make-granulate", "extsnd.html#makegraphdata",
+ "sndclm.html#make-green-noise", "sndclm.html#make-green-noise-interp", "s7.html#makehashtable", "sndscm.html#makehighpass",
+ "sndscm.html#makehilberttransform", "s7.html#makehook", "sndclm.html#make-iir-filter", "s7.html#makeintvector",
+ "s7.html#makeiterator", "sndclm.html#make-izcos", "sndclm.html#make-j0evencos", "sndclm.html#make-j0j1cos",
+ "sndclm.html#make-j2cos", "sndclm.html#make-jjcos", "sndclm.html#make-jncos", "sndclm.html#make-jpcos",
+ "sndclm.html#make-jycos", "sndclm.html#make-k2cos", "sndclm.html#make-k2sin", "sndclm.html#make-k2ssb",
+ "sndclm.html#make-k3sin", "sndclm.html#make-krksin", "sndclm.html#make-locsig", "sndscm.html#makelowpass",
+ "extsnd.html#makemixsampler", "sndclm.html#make-move-sound", "sndclm.html#make-moving-autocorrelation", "sndclm.html#make-moving-average",
+ "sndclm.html#make-moving-fft", "sndclm.html#make-moving-max", "sndclm.html#make-moving-norm", "sndclm.html#make-moving-pitch",
+ "sndclm.html#make-moving-scentroid", "sndclm.html#make-moving-spectrum", "sndclm.html#make-n1cos", "sndclm.html#make-nchoosekcos",
+ "sndclm.html#make-ncos", "sndclm.html#make-nkssb", "sndclm.html#make-noddcos", "sndclm.html#make-noddsin",
+ "sndclm.html#make-noddssb", "sndclm.html#make-noid", "sndclm.html#make-notch", "sndclm.html#make-nrcos",
+ "sndclm.html#make-nrsin", "sndclm.html#make-nrssb", "sndclm.html#make-nrxycos", "sndclm.html#make-nrxysin",
+ "sndclm.html#make-nsin", "sndclm.html#make-nsincos", "sndclm.html#make-nssb", "sndclm.html#make-nxy1cos",
+ "sndclm.html#make-nxy1sin", "sndclm.html#make-nxycos", "sndclm.html#make-nxysin", "sndclm.html#make-one-pole",
+ "sndclm.html#make-one-pole-all-pass", "sndclm.html#make-one-zero", "sndclm.html#make-oscil", "sndclm.html#make-oscil-bank",
+ "sndclm.html#make-phase-vocoder", "sndclm.html#make-pink-noise", "sndscm.html#makepixmap", "extsnd.html#makeplayer",
+ "sndclm.html#make-polyoid", "sndclm.html#make-polyshape", "sndclm.html#make-polywave", "sndclm.html#make-pulse-train",
+ "sndclm.html#make-pulsed-env", "sndclm.html#make-r2k!cos", "sndclm.html#make-r2k2cos", "sndscm.html#makeramp",
+ "sndclm.html#make-rand", "sndclm.html#make-rand-interp", "sndclm.html#make-rcos", "sndclm.html#make-readin",
+ "extsnd.html#makeregion", "extsnd.html#makeregionsampler", "sndclm.html#make-rk!cos", "sndclm.html#make-rk!ssb",
+ "sndclm.html#make-rkcos", "sndclm.html#make-rkoddssb", "sndclm.html#make-rksin", "sndclm.html#make-rkssb",
+ "sndclm.html#make-round-interp", "sndclm.html#make-rssb", "sndclm.html#make-rxycos", "sndclm.html#make-rxyk!cos",
+ "sndclm.html#make-rxyk!sin", "sndclm.html#make-rxysin", "sndclm.html#make-sampletofile", "extsnd.html#makesampler",
+ "sndclm.html#make-sawtooth-wave", "sndscm.html#makeselection", "sndclm.html#make-sinc-train", "extsnd.html#makesndtosample",
+ "sndscm.html#makesoundbox", "sndscm.html#makespencerfilter", "sndclm.html#make-square-wave", "sndclm.html#make-src",
+ "sndclm.html#make-ssb-am", "sndclm.html#make-table-lookup", "sndclm.html#make-table-lookup-with-env", "sndclm.html#make-tanhsin",
+ "sndclm.html#make-triangle-wave", "sndclm.html#make-two-pole", "sndclm.html#make-two-zero", "sndscm.html#makevariabledisplay",
+ "extsnd.html#makevariablegraph", "sndclm.html#make-wave-train", "sndclm.html#make-wave-train-with-env", "extsnd.html#mapchannel",
+ "sndscm.html#mapsoundfiles", "sndscm.html#maracadoc", "extsnd.html#marktointeger", "extsnd.html#markclickhook",
+ "sndscm.html#markclickinfo", "extsnd.html#markcolor", "extsnd.html#markcontext", "extsnd.html#markdraghook",
+ "sndscm.html#markexplode", "extsnd.html#markhome", "extsnd.html#markhook", "sndscm.html#markloops",
+ "extsnd.html#markname", "sndscm.html#marknametoid", "extsnd.html#markproperties", "extsnd.html#markproperty",
+ "extsnd.html#marksample", "extsnd.html#marksync", "sndscm.html#marksynccolor", "extsnd.html#marksyncmax",
+ "extsnd.html#marktagheight", "extsnd.html#marktagwidth", "extsnd.html#markp", "extsnd.html#emarks",
+ "sndscm.html#matchsoundfiles", "sndscm.html#maxenvelope", "extsnd.html#maxregions", "extsnd.html#maxfftpeaks",
+ "extsnd.html#maxamp", "extsnd.html#maxampposition", "extsnd.html#menuwidgets", "sndscm.html#menusdoc",
+ "extsnd.html#mindb", "extsnd.html#mix", "sndscm.html#mixtofv", "extsnd.html#mixtointeger",
+ "extsnd.html#mixamp", "extsnd.html#mixampenv", "sndscm.html#mixchannel", "extsnd.html#mixclickhook",
+ "sndscm.html#mixclickinfo", "sndscm.html#mixclicksetsamp", "extsnd.html#mixcolor", "extsnd.html#mixdialogmix",
+ "extsnd.html#mixdraghook", "extsnd.html#mixfiledialog", "extsnd.html#mixfv", "extsnd.html#mixhome",
+ "extsnd.html#mixlength", "sndscm.html#mixmaxamp", "extsnd.html#mixname", "sndscm.html#mixnametoid",
+ "extsnd.html#mixposition", "extsnd.html#mixproperties", "extsnd.html#mixproperty", "extsnd.html#mixregion",
+ "extsnd.html#mixreleasehook", "extsnd.html#mixsamplerQ", "extsnd.html#mixselection", "sndscm.html#mixsound",
+ "extsnd.html#mixspeed", "extsnd.html#mixsync", "extsnd.html#mixsyncmax", "extsnd.html#mixtagheight",
+ "extsnd.html#mixtagwidth", "extsnd.html#mixtagy", "extsnd.html#mixwaveformheight", "extsnd.html#mixp",
+ "extsnd.html#mixes", "sndscm.html#monotostereo", "sndscm.html#moogfilter", "s7.html#morallyequalp",
+ "extsnd.html#mouseclickhook", "extsnd.html#mousedraghook", "extsnd.html#mouseentergraphhook", "extsnd.html#mouseenterlabelhook",
+ "extsnd.html#mouseenterlistenerhook", "extsnd.html#mouseentertexthook", "extsnd.html#mouseleavegraphhook", "extsnd.html#mouseleavelabelhook",
+ "extsnd.html#mousleavelistenerhook", "extsnd.html#mousleavetexthook", "extsnd.html#mousepresshook", "sndclm.html#move-locsig",
+ "sndscm.html#movemixes", "sndclm.html#move-sound", "sndclm.html#move-sound?", "sndscm.html#movesyncdmarks",
+ "sndclm.html#moving-autocorrelation", "sndclm.html#moving-autocorrelation?", "sndclm.html#moving-average", "sndclm.html#moving-average?",
+ "sndclm.html#moving-fft", "sndclm.html#moving-fft?", "sndclm.html#moving-length", "sndclm.html#moving-max",
+ "sndclm.html#moving-max?", "sndclm.html#moving-norm", "sndclm.html#moving-norm?", "sndclm.html#moving-pitch",
+ "sndclm.html#moving-pitch?", "sndclm.html#moving-rms", "sndclm.html#moving-scentroid", "sndclm.html#moving-scentroid?",
+ "sndclm.html#moving-spectrum", "sndclm.html#moving-spectrum?", "sndclm.html#moving-sum", "sndscm.html#mpg",
+ "extsnd.html#musalsabuffersize", "extsnd.html#musalsabuffers", "extsnd.html#musalsacapturedevice", "extsnd.html#musalsadevice",
+ "extsnd.html#musalsaplaybackdevice", "extsnd.html#musalsasquelchwarning", "sndclm.html#musarrayprintlength", "extsnd.html#musbytespersample",
+ "sndclm.html#mus-channel", "sndclm.html#mus-channels", "sndclm.html#mus-chebyshev-tu-sum", "extsnd.html#musclipping",
+ "sndclm.html#mus-close", "sndclm.html#mus-copy", "sndclm.html#mus-data", "sndclm.html#mus-describe",
+ "extsnd.html#muserrorhook", "extsnd.html#muserrortypetostring", "extsnd.html#musexpandfilename", "sndclm.html#mus-feedback",
+ "sndclm.html#mus-feedforward", "sndclm.html#fft", "sndclm.html#musfilebuffersize", "extsnd.html#musfileclipping",
+ "sndscm.html#musfilemix", "sndclm.html#mus-file-name", "sndclm.html#musfloatequalfudgefactor", "sndclm.html#mus-frequency",
+ "sndclm.html#musgeneratorp", "extsnd.html#musheaderrawdefaults", "extsnd.html#musheadertypetostring", "extsnd.html#musheadertypename",
+ "sndclm.html#mus-hop", "sndclm.html#mus-increment", "sndclm.html#mus-input?", "sndclm.html#mus-interp-type",
+ "sndclm.html#mus-interpolate", "sndclm.html#mus-length", "sndclm.html#mus-location", "extsnd.html#musmaxmalloc",
+ "extsnd.html#musmaxtablesize", "sndclm.html#mus-name", "sndclm.html#mus-offset", "sndclm.html#mus-order",
+ "extsnd.html#musosssetbuffers", "sndclm.html#mus-output?", "sndclm.html#mus-phase", "sndclm.html#mus-ramp",
+ "sndclm.html#mus-rand-seed", "sndclm.html#mus-random", "sndclm.html#mus-reset", "sndclm.html#mus-run",
+ "extsnd.html#mussampletypetostring", "extsnd.html#mussampletypename", "sndclm.html#mus-scaler", "extsnd.html#mussoundchans",
+ "extsnd.html#mussoundcloseinput", "extsnd.html#mussoundcloseoutput", "extsnd.html#mussoundcomment", "extsnd.html#mussounddatalocation",
+ "extsnd.html#mussounddatumsize", "extsnd.html#mussoundduration", "extsnd.html#mussoundforget", "extsnd.html#mussoundframples",
+ "extsnd.html#mussoundheadertype", "extsnd.html#mussoundlength", "extsnd.html#mussoundloopinfo", "extsnd.html#mussoundmarkinfo",
+ "extsnd.html#mussoundmaxamp", "extsnd.html#mussoundmaxampexists", "extsnd.html#mussoundopeninput", "extsnd.html#mussoundopenoutput",
+ "extsnd.html#mussoundpath", "extsnd.html#mussoundpreload", "extsnd.html#mussoundprune", "extsnd.html#mussoundread",
+ "extsnd.html#mussoundreopenoutput", "extsnd.html#mussoundreportcache", "extsnd.html#mussoundsampletype", "extsnd.html#mussoundsamples",
+ "extsnd.html#mussoundseekframple", "extsnd.html#mussoundsrate", "extsnd.html#mussoundtypespecifier", "extsnd.html#mussoundwrite",
+ "extsnd.html#mussoundwritedate", "sndclm.html#mussrate", "sndclm.html#mus-width", "sndclm.html#mus-xcoeff",
+ "sndclm.html#mus-xcoeffs", "sndclm.html#mus-ycoeff", "sndclm.html#mus-ycoeffs", "sndclm.html#n1cos",
+ "sndclm.html#n1cos?", "extsnd.html#nameclickhook", "sndclm.html#nchoosekcos", "sndclm.html#nchoosekcos?",
+ "sndclm.html#ncos", "sndclm.html#ncos2?", "sndclm.html#ncos4?", "sndclm.html#ncos?",
+ "extsnd.html#newsound", "extsnd.html#newsounddialog", "extsnd.html#newsoundhook", "extsnd.html#newwidgethook",
+ "extsnd.html#nextsample", "sndclm.html#nkssb", "sndclm.html#nkssbinterp", "sndclm.html#nkssb?",
+ "sndclm.html#noddcos", "sndclm.html#noddcos?", "sndclm.html#noddsin", "sndclm.html#noddsin?",
+ "sndclm.html#noddssb", "sndclm.html#noddssb?", "sndclm.html#noid", "extsnd.html#normalizechannel",
+ "sndscm.html#normalizeenvelope", "sndclm.html#normalizepartials", "sndscm.html#normalizesound", "sndscm.html#normalizedmix",
+ "sndclm.html#notch", "sndscm.html#notchchannel", "sndscm.html#notchselection", "sndscm.html#notchsound",
+ "sndclm.html#notch?", "sndclm.html#npcos?", "sndclm.html#nrcos", "sndclm.html#nrcos?",
+ "sndscm.html#nrev", "sndclm.html#nrsin", "sndclm.html#nrsin?", "sndclm.html#nrssb",
+ "sndclm.html#nrssbinterp", "sndclm.html#nrssb?", "sndclm.html#nrxycos", "sndclm.html#nrxycos?",
+ "sndclm.html#nrxysin", "sndclm.html#nrxysin?", "sndclm.html#nsin", "sndclm.html#nsin?",
+ "sndclm.html#nsincos", "sndclm.html#nsincos?", "sndclm.html#nssb", "sndclm.html#nssb?",
+ "sndclm.html#nxy1cos", "sndclm.html#nxy1cos?", "sndclm.html#nxy1sin", "sndclm.html#nxy1sin?",
+ "sndclm.html#nxycos", "sndclm.html#nxycos?", "sndclm.html#nxysin", "sndclm.html#nxysin?",
+ "s7.html#objecttolet", "s7.html#objecttostring", "sndclm.html#oddmultiple", "sndclm.html#oddweight",
+ "sndscm.html#offsetchannel", "sndscm.html#offsetsound", "sndclm.html#one-pole", "sndclm.html#one-pole-all-pass",
+ "sndclm.html#one-pole-all-pass?", "sndclm.html#one-pole?", "sndclm.html#one-zero", "sndclm.html#one-zero?",
+ "extsnd.html#openfiledialog", "extsnd.html#openfiledialogdirectory", "extsnd.html#openhook", "sndscm.html#opennextfileindirectory",
+ "extsnd.html#openrawsound", "extsnd.html#openrawsoundhook", "extsnd.html#opensound", "s7.html#openlet",
+ "s7.html#openletp", "extsnd.html#orientationhook", "sndclm.html#oscil", "sndclm.html#oscil-bank",
+ "sndclm.html#oscil-bank?", "sndclm.html#oscil?", "sndclm.html#out-any", "sndclm.html#outbank",
+ "sndclm.html#outa", "s7.html#outlet", "sndclm.html#*output*", "extsnd.html#outputcommenthook",
+ "sndscm.html#overlayrmsenv", "s7.html#owlet", "extsnd.html#padchannel", "sndscm.html#padmarks",
+ "sndscm.html#padsound", "s7.html#pairfilename", "s7.html#pairlinenumber", "sndscm.html#panmix",
+ "sndscm.html#panmixfv", "sndclm.html#partialstopolynomial", "sndclm.html#partialstowave", "extsnd.html#pausing",
+ "extsnd.html#peakenvdir", "extsnd.html#peaks", "extsnd.html#peaksfont", "sndclm.html#phase-partialstowave",
+ "sndclm.html#phase-vocoder", "sndclm.html#phase-vocoder?", "sndscm.html#pianodoc", "sndclm.html#pink-noise",
+ "sndclm.html#pink-noise?", "sndscm.html#pins", "sndscm.html#placesound", "extsnd.html#play",
+ "extsnd.html#playarrowsize", "sndscm.html#playbetweenmarks", "extsnd.html#playhook", "sndscm.html#playmixes",
+ "sndscm.html#playoften", "sndscm.html#playregionforever", "sndscm.html#playsine", "sndscm.html#playsines",
+ "sndscm.html#playsyncdmarks", "sndscm.html#playuntilcg", "sndscm.html#playwithenvs", "extsnd.html#playerhome",
+ "extsnd.html#playerQ", "extsnd.html#players", "extsnd.html#playing", "sndscm.html#pluck",
+ "sndclm.html#polartorectangular", "sndclm.html#polynomial", "sndscm.html#polydoc", "sndclm.html#polyoid",
+ "sndclm.html#polyoidenv", "sndclm.html#polyoid?", "sndclm.html#polyshape", "sndclm.html#polyshape?",
+ "sndclm.html#polywave", "sndclm.html#polywave?", "s7.html#portfilename", "s7.html#portlinenumber",
+ "extsnd.html#positiontox", "extsnd.html#positiontoy", "extsnd.html#positioncolor", "sndscm.html#powerenv",
+ "sndscm.html#pqw", "sndscm.html#pqwvox", "extsnd.html#preferencesdialog", "extsnd.html#previoussample",
+ "extsnd.html#printdialog", "extsnd.html#printlength", "s7.html#proceduredocumentation", "s7.html#proceduresetter",
+ "s7.html#proceduresignature", "s7.html#proceduresource", "extsnd.html#progressreport", "sndclm.html#pulse-train",
+ "sndclm.html#pulse-train?", "sndclm.html#pulsedenv", "sndclm.html#pulsedenv?", "sndclm.html#r2k!cos",
+ "sndclm.html#r2k!cos?", "sndclm.html#r2k2cos", "sndclm.html#r2k2cos?", "sndclm.html#radianstodegrees",
+ "sndclm.html#radianstohz", "extsnd.html#rampchannel", "sndclm.html#rand", "sndclm.html#rand-interp",
+ "sndclm.html#rand-interp?", "sndclm.html#rand?", "s7.html#random", "s7.html#randomstate",
+ "s7.html#randomstatep", "sndclm.html#rcos", "sndclm.html#rcos?", "s7.html#readerrorhook",
+ "extsnd.html#readhook", "extsnd.html#readmixsample", "extsnd.html#readonly", "extsnd.html#readregionsample",
+ "extsnd.html#readsample", "extsnd.html#readsamplewithdirection", "s7.html#readercond", "sndclm.html#readin",
+ "sndclm.html#readin?", "sndclm.html#rectangulartomagnitudes", "sndclm.html#rectangulartopolar", "extsnd.html#redo",
+ "extsnd.html#regiontofv", "extsnd.html#regiontointeger", "extsnd.html#regionchans", "extsnd.html#regionframples",
+ "extsnd.html#regiongraphstyle", "extsnd.html#regionhome", "extsnd.html#regionmaxamp", "extsnd.html#regionmaxampposition",
+ "sndscm.html#regionplaylist", "extsnd.html#regionposition", "sndscm.html#regionrms", "extsnd.html#regionsample",
+ "extsnd.html#regionsamplerQ", "extsnd.html#regionsrate", "extsnd.html#regionok", "extsnd.html#eregions",
+ "extsnd.html#remembersoundstate", "sndscm.html#removeclicks", "extsnd.html#removefrommenu", "sndscm.html#replacewithselection",
+ "sndscm.html#reportmarknames", "s7.html#requires7", "sndscm.html#resetallhooks", "extsnd.html#resetcontrols",
+ "extsnd.html#resetlistenercursor", "sndscm.html#reson", "extsnd.html#restorecontrols", "sndclm.html#*reverb*",
+ "extsnd.html#reverbdecay", "extsnd.html#reverbcontrolfeedback", "extsnd.html#reverbcontrollength", "extsnd.html#reverbcontrollengthbounds",
+ "extsnd.html#reverbcontrollowpass", "extsnd.html#reverbcontrolscale", "extsnd.html#reverbcontrolscalebounds", "extsnd.html#reverbcontrolp",
+ "s7.html#reverseb", "sndscm.html#reversebyblocks", "extsnd.html#reversechannel", "sndscm.html#reverseenvelope",
+ "extsnd.html#reverseselection", "extsnd.html#reversesound", "extsnd.html#revertsound", "extsnd.html#rightsample",
+ "sndclm.html#ring-modulate", "sndclm.html#rk!cos", "sndclm.html#rk!cos?", "sndclm.html#rk!ssb",
+ "sndclm.html#rk!ssb?", "sndclm.html#rkcos", "sndclm.html#rkcos?", "sndclm.html#rkoddssb",
+ "sndclm.html#rkoddssb?", "sndclm.html#rksin", "sndclm.html#rksin?", "sndclm.html#rkssb",
+ "sndclm.html#rkssb?", "sndscm.html#rmsgain", "sndscm.html#rmsgain", "sndscm.html#rmsenvelope",
+ "s7.html#rootlet", "s7.html#rootletredefinitionhook", "sndclm.html#round-interp", "sndclm.html#round-interp?",
+ "sndclm.html#rssb", "sndclm.html#rssbinterp", "sndclm.html#rssb?", "sndscm.html#rubbersound",
+ "sndclm.html#rxycos", "sndclm.html#rxycos?", "sndclm.html#rxyk!cos", "sndclm.html#rxyk!cos?",
+ "sndclm.html#rxyk!sin", "sndclm.html#rxyk!sin?", "sndclm.html#rxysin", "sndclm.html#rxysin?",
+ "extsnd.html#sample", "sndclm.html#sampletofile", "sndclm.html#sampletofile?", "extsnd.html#sampletype",
+ "extsnd.html#sampleratendQ", "extsnd.html#samplerhome", "extsnd.html#samplerposition", "extsnd.html#samplerQ",
+ "extsnd.html#samples", "sndclm.html#samplestoseconds", "extsnd.html#sashcolor", "extsnd.html#saveasdialogautocomment",
+ "extsnd.html#saveasdialogsrc", "extsnd.html#savecontrols", "extsnd.html#savedir", "extsnd.html#saveedithistory",
+ "extsnd.html#saveenvelopes", "extsnd.html#savehook", "extsnd.html#savelistener", "sndscm.html#savemarkproperties",
+ "extsnd.html#savemarks", "extsnd.html#savemix", "extsnd.html#saveregion", "extsnd.html#saveregiondialog",
+ "extsnd.html#saveselection", "extsnd.html#saveselectiondialog", "extsnd.html#savesound", "extsnd.html#savesoundas",
+ "extsnd.html#savesounddialog", "extsnd.html#savestate", "extsnd.html#savestatefile", "extsnd.html#savestatehook",
+ "sndscm.html#sgfilter", "sndclm.html#sawtooth-wave", "sndclm.html#sawtooth-wave?", "extsnd.html#scaleby",
+ "extsnd.html#scalechannel", "sndscm.html#scaleenvelope", "sndscm.html#scalemixes", "extsnd.html#scaleselectionby",
+ "extsnd.html#scaleselectionto", "sndscm.html#scalesound", "sndscm.html#scaletempo", "extsnd.html#scaleto",
+ "extsnd.html#scanchannel", "sndscm.html#dspdocscanned", "sndscm.html#scentroid", "sndscm.html#scratch",
+ "extsnd.html#scriptarg", "extsnd.html#scriptargs", "sndscm.html#searchforclick", "extsnd.html#searchprocedure",
+ "sndclm.html#secondstosamples", "extsnd.html#selectall", "extsnd.html#selectchannel", "extsnd.html#selectchannelhook",
+ "extsnd.html#selectsound", "extsnd.html#selectsoundhook", "extsnd.html#selectedchannel", "extsnd.html#selecteddatacolor",
+ "extsnd.html#selectedgraphcolor", "extsnd.html#selectedsound", "extsnd.html#selection", "extsnd.html#selectiontomix",
+ "extsnd.html#selectionchans", "extsnd.html#selectioncolor", "extsnd.html#selectioncontext", "extsnd.html#selectioncreatesregion",
+ "extsnd.html#selectionframples", "extsnd.html#selectionmaxamp", "extsnd.html#selectionmaxampposition", "extsnd.html#selectionmember",
+ "sndscm.html#selectionmembers", "extsnd.html#selectionposition", "sndscm.html#selectionrms", "extsnd.html#selectionsrate",
+ "extsnd.html#selectionok", "extsnd.html#setsamples", "extsnd.html#shortfilename", "extsnd.html#showaxes",
+ "extsnd.html#showcontrols", "sndscm.html#showdiskspace", "extsnd.html#showfullduration", "extsnd.html#showfullrange",
+ "extsnd.html#showgrid", "extsnd.html#showindices", "extsnd.html#showlistener", "extsnd.html#showmarks",
+ "extsnd.html#showmixwaveforms", "extsnd.html#showselection", "extsnd.html#showselectiontransform", "extsnd.html#showsonogramcursor",
+ "extsnd.html#showtransformpeaks", "extsnd.html#showwidget", "extsnd.html#showyzero", "sndscm.html#silenceallmixes",
+ "sndscm.html#silencemixes", "sndclm.html#sinc-train", "sndclm.html#sinc-train?", "extsnd.html#sincwidth",
+ "sndscm.html#sineenvchannel", "sndscm.html#sineramp", "sndscm.html#singerdoc", "extsnd.html#smoothchannel",
+ "extsnd.html#smoothselection", "extsnd.html#smoothsound", "sndscm.html#pins", "sndscm.html#snapmarktobeat",
+ "sndscm.html#snapmarks", "sndscm.html#snapmixtobeat", "extsnd.html#sndtosample", "extsnd.html#sndtosamplep",
+ "extsnd.html#sndcolor", "extsnd.html#snderror", "extsnd.html#snderrorhook", "extsnd.html#sndfont",
+ "extsnd.html#sndgcs", "extsnd.html#sndhelp", "sndscm.html#sndscmhooks", "extsnd.html#sndopenedsound",
+ "extsnd.html#sndprint", "extsnd.html#sndspectrum", "extsnd.html#sndtempnam", "extsnd.html#sndurl",
+ "extsnd.html#sndurls", "extsnd.html#sndversion", "extsnd.html#sndwarning", "extsnd.html#sndwarninghook",
+ "sndscm.html#sndwarp", "s7.html#sortb", "sndscm.html#soundtoamp_env", "extsnd.html#soundtointeger",
+ "extsnd.html#soundfileextensions", "extsnd.html#soundfilep", "extsnd.html#soundfilesindirectory", "sndscm.html#soundinterp",
+ "extsnd.html#soundloopinfo", "extsnd.html#soundproperties", "extsnd.html#soundproperty", "extsnd.html#soundwidgets",
+ "extsnd.html#soundp", "extsnd.html#soundfontinfo", "extsnd.html#sounds", "sndscm.html#soundstosegmentdata",
+ "sndscm.html#spectra", "sndscm.html#twotab", "sndscm.html#spectralpolynomial", "extsnd.html#spectrohop",
+ "extsnd.html#spectroxangle", "extsnd.html#spectroxscale", "extsnd.html#spectroyangle", "extsnd.html#spectroyscale",
+ "extsnd.html#spectrozangle", "extsnd.html#spectrozscale", "sndclm.html#spectrum", "sndscm.html#spectrumtocoeffs",
+ "extsnd.html#spectrumend", "extsnd.html#spectrumstart", "extsnd.html#speedcontrol", "extsnd.html#speedcontrolbounds",
+ "extsnd.html#speedstyle", "extsnd.html#speedtones", "sndscm.html#spotfreq", "sndclm.html#square-wave",
+ "sndclm.html#square-wave?", "extsnd.html#squelchupdate", "sndscm.html#squelchvowels", "extsnd.html#srate",
+ "sndclm.html#src", "extsnd.html#srcchannel", "sndscm.html#srcduration", "sndscm.html#srcfitenvelope",
+ "sndscm.html#srcmixes", "extsnd.html#srcsoundselection", "extsnd.html#srcsound", "sndclm.html#src?",
+ "sndclm.html#ssb-am", "sndclm.html#ssb-am?", "sndscm.html#ssbbank", "sndscm.html#ssbbankenv",
+ "sndscm.html#ssbfm", "sndscm.html#startdac", "extsnd.html#startplaying", "extsnd.html#startplayinghook",
+ "extsnd.html#startplayingselectionhook", "extsnd.html#startprogressreport", "extsnd.html#statusreport", "extsnd.html#stdinprompt",
+ "sndscm.html#stereotomono", "sndscm.html#stereoflute", "extsnd.html#stopplayer", "extsnd.html#stopplaying",
+ "extsnd.html#stopplayinghook", "extsnd.html#stopplayingselectionhook", "sndscm.html#stretchenvelope", "sndscm.html#stretchsoundviadft",
+ "s7.html#stringtobytevector", "s7.html#stringposition", "s7.html#sublet", "sndscm.html#superimposeffts",
+ "extsnd.html#swapchannels", "sndscm.html#swapselectionchannels", "s7.html#symboltodynamicvalue", "s7.html#symboltovalue",
+ "s7.html#symbolaccess", "s7.html#symboltable", "extsnd.html#sync", "sndscm.html#sync-everything",
+ "extsnd.html#syncmax", "extsnd.html#syncstyle", "extsnd.html#syncdmarks", "sndscm.html#syncdmixes",
+ "sndscm.html#syncup", "sndclm.html#table-lookup", "sndclm.html#table-lookup?", "sndclm.html#tanhsin",
+ "sndclm.html#tanhsin?", "sndclm.html#tap", "sndclm.html#tap?", "sndscm.html#telephone",
+ "extsnd.html#tempdir", "extsnd.html#textfocuscolor", "extsnd.html#timegraphstyle", "extsnd.html#timegraphtype",
+ "extsnd.html#timegraphp", "sndclm.html#timestosamples", "extsnd.html#tinyfont", "sndscm.html#telephone",
+ "s7.html#trace", "extsnd.html#trackingcursorstyle", "extsnd.html#transformtofv", "extsnd.html#transformtointeger",
+ "extsnd.html#transformdialog", "extsnd.html#transformframples", "extsnd.html#transformgraphstyle", "extsnd.html#transformgraphtype",
+ "extsnd.html#transformgraphp", "extsnd.html#normalizefft", "extsnd.html#transformsample", "extsnd.html#transformsize",
+ "extsnd.html#transformtype", "extsnd.html#transformp", "sndscm.html#transposemixes", "sndclm.html#triangle-wave",
+ "sndclm.html#triangle-wave?", "sndscm.html#tubebell", "sndscm.html#tubebell", "sndclm.html#two-pole",
+ "sndclm.html#two-pole?", "sndscm.html#twotab", "sndclm.html#two-zero", "sndclm.html#two-zero?",
+ "s7.html#typeof", "extsnd.html#unbindkey", "s7.html#unboundvariablehook", "sndscm.html#unclipchannel",
+ "extsnd.html#undo", "extsnd.html#undohook", "s7.html#unlet", "extsnd.html#unselectall",
+ "sndscm.html#updategraphs", "extsnd.html#updatehook", "extsnd.html#updatelispgraph", "extsnd.html#updatesound",
+ "extsnd.html#updatetimegraph", "extsnd.html#updatetransformgraph", "sndscm.html#uponsaveyourself", "sndscm.html#sndmotifdoc",
+ "sndscm.html#variabledisplay", "extsnd.html#variablegraphp", "s7.html#varlet", "sndscm.html#vibratinguniformcircularstring",
"extsnd.html#viewfilesamp", "extsnd.html#viewfilesampenv", "extsnd.html#viewfilesdialog", "extsnd.html#viewfilesfiles",
"extsnd.html#viewfilesselecthook", "extsnd.html#viewfilesselectedfiles", "extsnd.html#viewfilessort", "extsnd.html#viewfilesspeed",
"extsnd.html#viewfilesspeedstyle", "extsnd.html#viewmixesdialog", "extsnd.html#viewregionsdialog", "extsnd.html#viewsound",
@@ -987,13 +970,13 @@ static const char *Copying_urls[] = {
NULL,
NULL,
NULL,
- "sndscm.html#mixtovct",
+ "sndscm.html#mixtofv",
"extsnd.html#copysampler",
"extsnd.html#clonesoundas",
- "extsnd.html#channeltovct",
- "extsnd.html#selection2vct",
- "extsnd.html#regiontovct",
- "extsnd.html#transformtovct",
+ "extsnd.html#channeltofv",
+ "extsnd.html#selection2fv",
+ "extsnd.html#regiontofv",
+ "extsnd.html#transformtofv",
NULL};
static const char *Marking_xrefs[] = {
@@ -1038,11 +1021,11 @@ static const char *Mixing_xrefs[] = {
"mix channel: see {mix-channel} in extensions.scm",
"mix region: {mix-region}",
"mix selection: {mix-selection}",
- "mix vct: {mix-vct}",
+ "mix float-vector: {mix-float-vector}",
"enveloped mix: see {enveloped-mix} in extensions.scm",
"read mix samples: {make-mix-sampler}",
"mix data maxamp: {mix-maxamp}",
- "mix data to vct: {mix->vct}",
+ "mix data to float-vector: {mix->float-vector}",
"save mix data in file: {save-mix}",
"mix property list: {mix-property} in mix.scm",
"pan mono sound into stereo: see {place-sound} in examp.scm",
@@ -1061,11 +1044,11 @@ static const char *Mixing_urls[] = {
"sndscm.html#mixchannel",
"extsnd.html#mixregion",
"extsnd.html#mixselection",
- "extsnd.html#mixvct",
+ "extsnd.html#mixfv",
"sndscm.html#envelopedmix",
"extsnd.html#makemixsampler",
"sndscm.html#mixmaxamp",
- "sndscm.html#mixtovct",
+ "sndscm.html#mixtofv",
"extsnd.html#savemix",
"extsnd.html#mixproperty",
"sndscm.html#placesound",
@@ -1353,7 +1336,7 @@ static const char *Insertions_xrefs[] = {
"insert a silence: {pad-channel}, {insert-silence}, {pad-sound}",
"insert a region: {insert-region}",
"insert the selection: {insert-selection}",
- "insert a vct of samples: {insert-samples}",
+ "insert a float-vector of samples: {insert-samples}",
"insert a sound: {insert-sound}",
"append a sound and silence: {append-sound}",
NULL};
@@ -1472,7 +1455,7 @@ static const char *Reversing_xrefs[] = {
"reverse order of channels: {reverse-channels}",
"reverse a list: reverse and reverse!",
"reverse a string: in Ruby: reverse",
- "reverse vct: {vct-reverse!}",
+ "reverse float-vector: reverse!",
NULL};
static const char *Reversing_urls[] = {
@@ -1487,7 +1470,7 @@ static const char *Reversing_urls[] = {
"extsnd.html#reversechannels",
NULL,
NULL,
- "extsnd.html#vctreverse",
+ NULL,
NULL};
static const char *Saving_xrefs[] = {
@@ -1765,7 +1748,7 @@ static const char *Reverb_urls[] = {
#if HAVE_SCHEME
-static const char *snd_names[11652] = {
+static const char *snd_names[11596] = {
"*clm-array-print-length*", "ws.scm",
"*clm-channels*", "ws.scm",
"*clm-clipped*", "ws.scm",
@@ -1975,6 +1958,7 @@ static const char *snd_names[11652] = {
"FILENAME_MAX", "libc.scm",
"FLT_DIG", "libc.scm",
"FLT_EPSILON", "libc.scm",
+ "FLT_EVAL_METHOD", "libc.scm",
"FLT_MANT_DIG", "libc.scm",
"FLT_MAX", "libc.scm",
"FLT_MAX_10_EXP", "libc.scm",
@@ -2017,44 +2001,28 @@ static const char *snd_names[11652] = {
"F_ULOCK", "libc.scm",
"F_UNLCK", "libc.scm",
"F_WRLCK", "libc.scm",
- "GDBM_BAD_FILE_OFFSET", "libgdbm.scm",
"GDBM_BAD_MAGIC_NUMBER", "libgdbm.scm",
- "GDBM_BAD_OPEN_FLAGS", "libgdbm.scm",
"GDBM_BLOCK_SIZE_ERROR", "libgdbm.scm",
- "GDBM_BYTE_SWAPPED", "libgdbm.scm",
"GDBM_CACHESIZE", "libgdbm.scm",
"GDBM_CANNOT_REPLACE", "libgdbm.scm",
"GDBM_CANT_BE_READER", "libgdbm.scm",
"GDBM_CANT_BE_WRITER", "libgdbm.scm",
"GDBM_CENTFREE", "libgdbm.scm",
- "GDBM_CLOEXEC", "libgdbm.scm",
"GDBM_COALESCEBLKS", "libgdbm.scm",
"GDBM_EMPTY_DATABASE", "libgdbm.scm",
"GDBM_FAST", "libgdbm.scm",
"GDBM_FASTMODE", "libgdbm.scm",
- "GDBM_FILE_EOF", "libgdbm.scm",
"GDBM_FILE_OPEN_ERROR", "libgdbm.scm",
"GDBM_FILE_READ_ERROR", "libgdbm.scm",
"GDBM_FILE_SEEK_ERROR", "libgdbm.scm",
- "GDBM_FILE_STAT_ERROR", "libgdbm.scm",
"GDBM_FILE_WRITE_ERROR", "libgdbm.scm",
- "GDBM_GETCACHESIZE", "libgdbm.scm",
- "GDBM_GETCENTFREE", "libgdbm.scm",
- "GDBM_GETCOALESCEBLKS", "libgdbm.scm",
- "GDBM_GETDBNAME", "libgdbm.scm",
- "GDBM_GETFLAGS", "libgdbm.scm",
- "GDBM_GETMAXMAPSIZE", "libgdbm.scm",
- "GDBM_GETMMAP", "libgdbm.scm",
- "GDBM_GETSYNCMODE", "libgdbm.scm",
"GDBM_ILLEGAL_DATA", "libgdbm.scm",
"GDBM_INSERT", "libgdbm.scm",
"GDBM_ITEM_NOT_FOUND", "libgdbm.scm",
"GDBM_MALLOC_ERROR", "libgdbm.scm",
"GDBM_NEWDB", "libgdbm.scm",
"GDBM_NOLOCK", "libgdbm.scm",
- "GDBM_NOMMAP", "libgdbm.scm",
"GDBM_NO_ERROR", "libgdbm.scm",
- "GDBM_OPENMASK", "libgdbm.scm",
"GDBM_OPT_ALREADY_SET", "libgdbm.scm",
"GDBM_OPT_ILLEGAL", "libgdbm.scm",
"GDBM_READER", "libgdbm.scm",
@@ -2063,18 +2031,8 @@ static const char *snd_names[11652] = {
"GDBM_READER_CANT_STORE", "libgdbm.scm",
"GDBM_REORGANIZE_FAILED", "libgdbm.scm",
"GDBM_REPLACE", "libgdbm.scm",
- "GDBM_SETCACHESIZE", "libgdbm.scm",
- "GDBM_SETCENTFREE", "libgdbm.scm",
- "GDBM_SETCOALESCEBLKS", "libgdbm.scm",
- "GDBM_SETMAXMAPSIZE", "libgdbm.scm",
- "GDBM_SETMMAP", "libgdbm.scm",
- "GDBM_SETSYNCMODE", "libgdbm.scm",
"GDBM_SYNC", "libgdbm.scm",
"GDBM_SYNCMODE", "libgdbm.scm",
- "GDBM_UNKNOWN_UPDATE", "libgdbm.scm",
- "GDBM_VERSION_MAJOR", "libgdbm.scm",
- "GDBM_VERSION_MINOR", "libgdbm.scm",
- "GDBM_VERSION_PATCH", "libgdbm.scm",
"GDBM_WRCREAT", "libgdbm.scm",
"GDBM_WRITER", "libgdbm.scm",
"GLOB_ABORTED", "libc.scm",
@@ -4179,7 +4137,6 @@ static const char *snd_names[11652] = {
"files-popdown-info", "nb.scm",
"files-popup-info", "nb.scm",
"fill-in", "musglyphs.scm",
- "fill-rectangle-1", "musglyphs.scm",
"fillfnc", "jcvoi.scm",
"filter-fft", "examp.scm",
"filter-selection-and-smooth", "selection.scm",
@@ -6644,7 +6601,6 @@ static const char *snd_names[11652] = {
"mkfifo", "libc.scm",
"mknod", "libc.scm",
"mkstemp", "libc.scm",
- "mktemp", "libc.scm",
"mktime", "libc.scm",
"mock->string", "mockery.scm",
"mockery.scm", "mockery.scm",
@@ -7411,7 +7367,6 @@ static const char *snd_names[11652] = {
"tcsendbreak", "libc.scm",
"tcsetattr", "libc.scm",
"tcsetpgrp", "libc.scm",
- "tempnam", "libc.scm",
"tenth", "stuff.scm",
"termios.c_lflag", "libc.scm",
"termios.make", "libc.scm",
@@ -7596,7 +7551,7 @@ static const char *snd_names[11652] = {
static void autoload_info(s7_scheme *sc)
{
- s7_autoload_set_names(sc, snd_names, 5826);
+ s7_autoload_set_names(sc, snd_names, 5798);
}
#endif
diff --git a/snd.h b/snd.h
index 610a47f..7a45b93 100644
--- a/snd.h
+++ b/snd.h
@@ -53,11 +53,11 @@
#include "snd-strings.h"
-#define SND_DATE "16-Jan-17"
+#define SND_DATE "27-June-17"
#ifndef SND_VERSION
-#define SND_VERSION "17.1"
+#define SND_VERSION "17.5"
#endif
#define SND_MAJOR_VERSION "17"
-#define SND_MINOR_VERSION "1"
+#define SND_MINOR_VERSION "5"
#endif
diff --git a/snd.html b/snd.html
index cdf04d6..9d0ac73 100644
--- a/snd.html
+++ b/snd.html
@@ -206,7 +206,7 @@ related documentation:
<li><a href="extsnd.html#sndobjects">Snd's objects</a>
<ul>
<li><a href="extsnd.html#samplers">Samplers</a>
- <li><a href="extsnd.html#Vcts">Vcts</a>
+ <li><a href="extsnd.html#Floatvectors">Float-vectors</a>
<li><a href="extsnd.html#extsndlib">Sndlib</a>
<li><a href="extsnd.html#sndmarks">Marks</a>
<li><a href="extsnd.html#sndmixes">Mixes</a>
diff --git a/sndscm.html b/sndscm.html
index 39ee341..665d592 100644
--- a/sndscm.html
+++ b/sndscm.html
@@ -3648,7 +3648,7 @@ parameters refer to channel numbers.
<pre class="indented">
<em class=def id="channelpolynomial">channel-polynomial</em> coeffs snd chn
<em class=def id="spectralpolynomial">spectral-polynomial</em> coeffs snd chn
-<em class=def id="vctpolynomial">float-vector-polynomial</em> v coeffs
+<em class=def id="fvpolynomial">float-vector-polynomial</em> v coeffs
</pre>
<p>float-vector-polynomial returns the evaluation of the polynomial (given its coefficients) over an entire
@@ -5447,7 +5447,7 @@ directories, returning a text file with segment start and end times, and segment
<p>window-samples returns (in a float-vector) the samples
displayed in the current window for the given channel.
-This is just a trivial wrapper for <a href="extsnd.html#channeltovct">channel->float-vector</a>.
+This is just a trivial wrapper for <a href="extsnd.html#channeltofv">channel->float-vector</a>.
</p>
<div class="spacer"></div>
@@ -6918,7 +6918,7 @@ mix-sound mixes 'file' (all chans) into the currently selected sound at 'start'.
<!-- mix->float-vector -->
<pre class="indented">
-<em class=def id="mixtovct">mix->float-vector</em> mix
+<em class=def id="mixtofv">mix->float-vector</em> mix
</pre>
mix->float-vector returns a mix's samples in a float-vector.
<div class="spacer"></div>
@@ -7002,7 +7002,7 @@ pan-mix-selection is similar to pan-mix above, but mixes the current selection,
<!-- pan-mix-float-vector -->
<pre class="indented">
-<em class=def id="panmixvct">pan-mix-float-vector</em> data beg env snd
+<em class=def id="panmixfv">pan-mix-float-vector</em> data beg env snd
</pre>
pan-mix-float-vector is similar to pan-mix above, but mixes a float-vector, rather than a file.
The argument 'data' represents one channel of sound.
@@ -8806,10 +8806,10 @@ 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.046 0.5005 | 3 1.739 0.5035 | 10 3.559 0.5513 | 8 3.263 0.5687
-1024 33.411 0.5062 | 512 23.717 0.5075 | 8 3.198 0.5590 | 256 23.955 0.5728
-512 23.631 0.5070 | 256 16.933 0.5102 | 9 3.454 0.5641 | 7 3.062 0.5750
-2048 50.205 0.5136 | 1024 34.393 0.5104 | 7 3.047 0.5726 | 6 2.805 0.5757
+256 16.008 0.5001 | 3 1.739 0.5035 | 10 3.559 0.5513 | 8 3.263 0.5687
+512 23.443 0.5057 | 512 23.717 0.5075 | 8 3.198 0.5590 | 256 23.955 0.5728
+1024 33.379 0.5061 | 256 16.933 0.5102 | 9 3.454 0.5641 | 7 3.062 0.5750
+2048 49.897 0.5128 | 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
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
diff --git a/sound.c b/sound.c
index 415482f..ada0b85 100644
--- a/sound.c
+++ b/sound.c
@@ -1210,7 +1210,7 @@ bool mus_sound_maxamp_exists(const char *ifile)
mus_long_t mus_sound_maxamps(const char *ifile, int chans, mus_float_t *vals, mus_long_t *times)
{
mus_long_t framples;
- int ichans, chn;
+ unsigned int ichans, chn;
sound_file *sf;
sf = get_sf(ifile);
@@ -1221,7 +1221,7 @@ mus_long_t mus_sound_maxamps(const char *ifile, int chans, mus_float_t *vals, mu
{
if (chans > sf->maxamps_size)
ichans = sf->maxamps_size;
- else ichans = chans;
+ else ichans = (unsigned int)chans;
for (chn = 0; chn < ichans; chn++)
{
times[chn] = sf->maxtimes[chn];
@@ -1240,9 +1240,9 @@ mus_long_t mus_sound_maxamps(const char *ifile, int chans, mus_float_t *vals, mu
ifd = mus_sound_open_input(ifile);
if (ifd == MUS_ERROR) return(MUS_ERROR);
- ichans = mus_sound_chans(ifile);
+ ichans = (unsigned int)mus_sound_chans(ifile);
framples = mus_sound_framples(ifile);
- if (framples == 0)
+ if ((framples == 0) || (ichans > MUS_MAX_CHANS))
{
mus_sound_close_input(ifd);
return(0);
@@ -1252,8 +1252,8 @@ mus_long_t mus_sound_maxamps(const char *ifile, int chans, mus_float_t *vals, mu
ibufs = (mus_float_t **)calloc(ichans, sizeof(mus_float_t *));
bufnum = 8192;
- for (j = 0; j < ichans; j++)
- ibufs[j] = (mus_float_t *)calloc(bufnum, sizeof(mus_float_t));
+ for (chn = 0; chn < ichans; chn++)
+ ibufs[chn] = (mus_float_t *)calloc(bufnum, sizeof(mus_float_t));
time = (mus_long_t *)calloc(ichans, sizeof(mus_long_t));
samp = (mus_float_t *)calloc(ichans, sizeof(mus_float_t));
@@ -1285,7 +1285,7 @@ mus_long_t mus_sound_maxamps(const char *ifile, int chans, mus_float_t *vals, mu
/* fprintf(stderr, "set in mus_sound_maxamps\n"); */
mus_sound_set_maxamps(ifile, ichans, samp, time); /* save the complete set */
- if (ichans > chans) ichans = chans;
+ if ((int)ichans > chans) ichans = chans;
for (chn = 0; chn < ichans; chn++)
{
times[chn] = time[chn];
@@ -1293,7 +1293,7 @@ mus_long_t mus_sound_maxamps(const char *ifile, int chans, mus_float_t *vals, mu
}
free(time);
free(samp);
- for (j = 0; j < ichans; j++) free(ibufs[j]);
+ for (j = 0; j < (int)ichans; j++) free(ibufs[j]);
free(ibufs);
return(framples);
}
diff --git a/spokenword.scm b/spokenword.scm
index dda1cec..5766a98 100644
--- a/spokenword.scm
+++ b/spokenword.scm
@@ -70,17 +70,17 @@
(define next-phrase
(lambda (position)
- (do ((i 0 (+ i 1)) (found #f))
+ (do ((i 0 (+ i 1))
+ (found #f (phrase-start? position)))
((or (= i 100) found (= position (framples))) position)
- (set! position (min (framples) (+ position jump-length)))
- (set! found (phrase-start? position)))))
+ (set! position (min (framples) (+ position jump-length))))))
(define previous-phrase
(lambda (position)
- (do ((i 0 (+ i 1)) (found #f))
+ (do ((i 0 (+ i 1))
+ (found #f (phrase-start? position)))
((or (= i 100) found (= position 0)) position)
- (set! position (max 0 (- position jump-length)))
- (set! found (phrase-start? position)))))
+ (set! position (max 0 (- position jump-length))))))
(define mark-out
(lambda (position)
@@ -194,4 +194,4 @@
(bind-key "Left" 4
(lambda () ; Move cursor to previous interesting position
(set! (cursor) (previous-phrase (cursor)))
- cursor-in-view))
\ No newline at end of file
+ cursor-in-view))
diff --git a/stuff.scm b/stuff.scm
index 4b23217..197a61e 100644
--- a/stuff.scm
+++ b/stuff.scm
@@ -67,8 +67,8 @@
(values "~% ~S" (car x)))))
(format p "~%"))
(set! history (cons (car x) history))
- (set! lines (cons (pair-line-number (car x)) lines))
- (set! files (cons (pair-filename (car x)) files)))))
+ (set! lines (cons (and (pair? (car x)) (pair-line-number (car x))) lines))
+ (set! files (cons (and (pair? (car x)) (pair-filename (car x))) files)))))
;; show the enclosing contexts
(let ((old-print-length (*s7* 'print-length)))
@@ -734,6 +734,7 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.")
(append rest (map (lambda (subset) (cons (car set) subset)) rest)))))))))
;;; ----------------
+;;; now superseded by built-in type-of
(define ->predicate
(let ((predicates (list integer? rational? real? complex? number?
byte-vector? string?
@@ -786,12 +787,12 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.")
(cond ,@(map (lambda (clause)
(if (memq (car clause) '(#t else))
clause
- (if (= (length (car clause)) 1)
- (cons (list (caar clause) obj) (cdr clause))
- (cons (cons 'or (map (lambda (type)
+ (cons (if (= (length (car clause)) 1)
+ (list (caar clause) obj)
+ (cons 'or (map (lambda (type)
(list type obj))
- (car clause)))
- (cdr clause)))))
+ (car clause))))
+ (cdr clause))))
clauses)))))
@@ -2128,6 +2129,7 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.")
(rootlet))
(sublet lt)))))))
+;;; (sandbox '(let ((x 1)) (+ x 2))) -> 3
(define sandbox
(let ((documentation "(sandbox code) evaluates code in an environment where nothing outside that code can be affected by its evaluation.")
@@ -2169,7 +2171,7 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.")
float-vector-ref int-vector make-int-vector int-vector-set! int-vector-ref string->byte-vector
byte-vector make-byte-vector hash-table hash-table* make-hash-table hash-table-ref
hash-table-set! hash-table-entries cyclic-sequences call/cc call-with-current-continuation
- call-with-exit apply for-each map dynamic-wind values
+ call-with-exit apply for-each map dynamic-wind values type-of
catch throw error procedure-documentation procedure-signature help procedure-source
procedure-setter arity aritable? not eq? eqv? equal? morally-equal? s7-version
dilambda make-hook hook-functions stacktrace tree-leaves tree-memq object->let
@@ -2179,7 +2181,7 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.")
quote if begin let let* letrec letrec* cond case or and do set! unless when else
with-let with-baffle
lambda lambda* define define*
- define-macro define-macro* define-bacro define-bacro*))
+ define-macro define-macro* define-bacro define-bacro* macroexpand)) ; not sure about macroexpand
ht))
(baddies (list #_eval #_eval-string #_load #_autoload #_define-constant #_define-expansion #_require
#_string->symbol #_symbol->value #_symbol->dynamic-value #_symbol-table #_symbol #_keyword->symbol
@@ -2242,8 +2244,9 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.")
((hook-functions *error-hook*) ())
((hook-functions *read-error-hook*) ())
((hook-functions *rootlet-redefinition-hook*) ())
- ((current-output-port) *stdout*)
- ((current-error-port) *stderr*))
+ (reader-cond ((not (provided? 'pure-s7))
+ ((current-output-port) *stdout*)
+ ((current-error-port) *stderr*))))
(catch #t
(lambda ()
(eval new-code (sublet (rootlet) (unlet))))
@@ -2254,3 +2257,4 @@ Unlike full-find-if, safe-find-if can handle any circularity in the sequences.")
(apply format #f (cadr args)))
(lambda args
(copy "?"))))))))))))
+
diff --git a/tools/compare-calls.scm b/tools/compare-calls.scm
index 354003e..4addb77 100644
--- a/tools/compare-calls.scm
+++ b/tools/compare-calls.scm
@@ -57,6 +57,7 @@
((= i 25))
(read-line))
;; read about 500 lines and store in a hash table as (func . timing)
+ ;; names can match!
(let ((h (make-hash-table)))
(call-with-exit
(lambda (quit)
@@ -75,10 +76,17 @@
(let ((num (string->number-ignoring-commas (substring line k end))))
(when num
(let ((func-end (char-position #\space line (+ end 2))))
- (when (and (number? func-end)
+ (when (and (integer? func-end)
(> func-end (+ end 2)))
- (let ((func (string->symbol (substring line (+ end 2) func-end))))
- (set! (h func) num))))))))))))))))
+ (let ((func (substring line (+ end 2) func-end)))
+ (let ((colon-pos (char-position #\: func)))
+ (if (integer? colon-pos)
+ (let ((isra-pos (char-position #\. func colon-pos)))
+ (if (integer? isra-pos)
+ (set! func (substring func 0 isra-pos))))))
+ (let ((sym (string->symbol func)))
+ (let ((curval (h sym)))
+ (set! (h sym) (+ (or curval 0) num)))))))))))))))))))
h))
@@ -191,8 +199,8 @@
(define (combine-latest)
(let ((file-names (list "v-eq" "v-iter" "v-map" "v-form" "v-hash" "v-cop"
- "v-lg" "v-gen" "v-auto" "v-index" "v-call" "v-all"
- "v-test" "/home/bil/test/bench/src/v-b")))
+ "v-lt" "v-gen" "v-auto" "v-index" "v-call" "v-all"
+ "v-test" "/home/bil/test/scheme/bench/src/v-b")))
(define (next-file f)
(let ((name (system (format #f "ls -t ~A*" f) #t)))
@@ -209,5 +217,5 @@
#|
(combine "v-call53" "v-map52" "v-all98" "v-hash31" "v-gen72" "v-auto51"
"v-lg73" "v-cop55" "v-form66" "v-eq46" "v-test57" "v-iter70" "v-index22"
- "/home/bil/test/bench/src/v-b28")
+ "/home/bil/test/scheme/bench/src/v-b28")
|#
diff --git a/tools/compsnd b/tools/compsnd
index 00e6d68..60b7728 100755
--- a/tools/compsnd
+++ b/tools/compsnd
@@ -60,13 +60,13 @@ ffitest
gcc s7.c -o repl -Wall -DWITH_MAIN -DUSE_SND=0 -I. -O2 -g3 -Wl,-export-dynamic -ldl -lm
echo '#define WITH_SYSTEM_EXTRAS 0' >mus-config.h
-cc -c s7.c -o s7.o -Wall
+gcc -c s7.c -o s7.o -Wall
rm s7.o
echo '#define WITH_C_LOADER 0' >mus-config.h
-cc -c s7.c -o s7.o -Wall
+gcc -c s7.c -o s7.o -Wall
rm s7.o
echo '#define WITH_EXTRA_EXPONENT_MARKERS 1' >mus-config.h
-cc -c s7.c -o s7.o -Wall
+gcc -c s7.c -o s7.o -Wall
rm s7.o
make clmclean
@@ -295,9 +295,9 @@ make allclean
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-forth --with-motif --with-editres --with-gl ---- '
+echo ' ----- --with-forth --with-motif --with-gl ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet --with-forth --with-motif --with-editres --with-gl LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include"
+./configure --quiet --with-forth --with-motif --with-gl LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include"
make
./snd --version
./snd -noinit --features "'clm 'snd-forth 'xm 'gl"
@@ -720,7 +720,7 @@ echo ' '
echo ' -------------------------------------------------------------------------------- '
echo ' ----- --with-gl --with-gl2ps ------ '
echo ' -------------------------------------------------------------------------------- '
-./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-motif --with-gl --quiet --with-gl2ps
+./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-motif --with-gl --quiet --with-gl2ps --without-gsl
make
./snd --version
./snd -noinit --features "'clm 'xm 'gl2ps"
diff --git a/tools/crossref.c b/tools/crossref.c
index 5e38618..e3978eb 100644
--- a/tools/crossref.c
+++ b/tools/crossref.c
@@ -221,7 +221,7 @@ static int greater_compare(const void *a, const void *b)
int main(int argc, char **argv)
{
- int i, j, fd, chars, k, in_comment = 0, in_cpp_comment = 0, in_white = 0, calls = 0, in_parens = 0, in_quotes = 0, in_define = 0, in_curly = 0, in_enum = 0;
+ int i, j, fd, chars, k, in_comment = 0, in_cpp_comment = 0, calls = 0, in_parens = 0, in_quotes = 0, in_define = 0, in_curly = 0, in_enum = 0;
int maxc[NAME_SIZE], maxf[NAME_SIZE], maxg[NAME_SIZE], mcalls[NAME_SIZE];
qdata **qs;
char input[MAX_CHARS];
@@ -351,27 +351,23 @@ int main(int argc, char **argv)
add_file("ffitest.c");
add_file("tools/gcall.c");
- add_file("/home/bil/test/s7webserver/s7webserver.cpp");
- add_file("/home/bil/test/radium-3.4.2/embedded_scheme/scheme.cpp");
+ add_file("/home/bil/dist/snd/s7webserver/s7webserver.cpp");
+ add_file("/home/bil/test/scheme/radium-3.4.2/embedded_scheme/scheme.cpp");
- add_file("/home/bil/test/cm308/cm-3.8.0/src/CmSupport.cpp");
- add_file("/home/bil/test/cm308/cm-3.8.0/src/Scheme.cpp");
- add_file("/home/bil/test/cm308/cm-3.8.0/src/SndLib.cpp");
- add_file("/home/bil/test/cm308/cm-3.8.0/src/SndLibBridge.cpp");
-
- add_file("/home/bil/test/cm390/cm/src/CmSupport.cpp");
- add_file("/home/bil/test/cm390/cm/src/Scheme.cpp");
- add_file("/home/bil/test/cm390/cm/src/SndLib.cpp");
- add_file("/home/bil/test/cm390/cm/src/SndLibBridge.cpp");
- add_file("/home/bil/test/cm390/cm/src/s7.cpp");
- add_file("/home/bil/test/cm390/cm/src/Osc.cpp");
- add_file("/home/bil/test/cm390/cm/src/SchemeSources.cpp");
+ add_file("/home/bil/test/cm/src/CmSupport.cpp");
+ add_file("/home/bil/test/cm/src/Scheme.cpp");
+ add_file("/home/bil/test/cm/src/SndLib.cpp");
+ add_file("/home/bil/test/cm/src/SndLibBridge.cpp");
+ add_file("/home/bil/test/cm/src/s7.cpp");
+ add_file("/home/bil/test/cm/src/OscPack.cpp");
+ add_file("/home/bil/test/cm/src/SchemeSources.cpp");
+ add_file("/home/bil/test/cm/src/OpenSoundControl.cpp");
+ add_file("/home/bil/test/cm/src/Liblo.cpp");
for (i = 0; i < headers_ctr; i++)
{
k = 0;
in_quotes = 0;
- in_white = 0;
in_parens = 0;
in_comment = 0;
in_cpp_comment = 0;
@@ -389,14 +385,12 @@ int main(int argc, char **argv)
{
if ((isalpha(input[j])) || (isdigit(input[j])) || (input[j] == '_'))
{
- in_white = 0;
if (k < ID_SIZE)
curname[k++] = input[j];
else fprintf(stderr, "0: curname overflow: %s[%d]: %s%c\n", headers[i], j, curname, input[j]);
}
else
{
- in_white = 1;
if (k < ID_SIZE)
curname[k] = 0;
else fprintf(stderr, "1: curname overflow: %s[%d]: %s\n", headers[i], j, curname);
@@ -499,10 +493,8 @@ int main(int argc, char **argv)
{
fprintf(stderr, "%d names ", names_ctr);
- k = 0;
in_comment = 0;
in_cpp_comment = 0;
- in_white = 0;
in_define = 0;
in_enum = 0;
for (i = 0; i < files_ctr; i++)
@@ -756,7 +748,7 @@ int main(int argc, char **argv)
for (i = 0; i < names_ctr; i++)
{
qdata *q;
- q = calloc(1, sizeof(qdata));
+ q = (qdata *)calloc(1, sizeof(qdata));
qs[i] = q;
q->i = i;
q->v = voids[i];
@@ -771,7 +763,7 @@ int main(int argc, char **argv)
for (i = 0; i < names_ctr; i++)
{
bool menu_case, file_case, nonogui_case, static_case, x_case = true, ffitest_case;
- int menu_count = 0, file_count = 0, rec_count = 0, x_count = 0;
+ int menu_count = 0, file_count = 0, x_count = 0;
int nfiles;
nfiles = 0;
/* try to get rid of a bunch of annoying false positives */
@@ -824,7 +816,6 @@ int main(int argc, char **argv)
menu_count = 0;
file_count = 0;
- rec_count = 0;
nonogui_case = in_nogui_h(qs[i]->name);
if ((nonogui_case) && (counts[qs[i]->i]))
diff --git a/tools/ffitest.c b/tools/ffitest.c
index e6f38f1..c9fb6ec 100644
--- a/tools/ffitest.c
+++ b/tools/ffitest.c
@@ -1441,7 +1441,7 @@ int main(int argc, char **argv)
iter = s7_make_iterator(sc, s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), TO_S7_INT(3)));
if (!s7_is_iterator(iter))
fprintf(stderr, "%d: %s is not an interator\n", __LINE__, TO_STR(iter));
- if (s7_iterator_is_at_end(iter))
+ if (s7_iterator_is_at_end(sc, iter))
fprintf(stderr, "%d: %s is prematurely done\n", __LINE__, TO_STR(iter));
x = s7_iterate(sc, iter);
if ((!s7_is_integer(x)) || (s7_integer(x) != 1))
@@ -1453,7 +1453,7 @@ int main(int argc, char **argv)
if ((!s7_is_integer(x)) || (s7_integer(x) != 3))
fprintf(stderr, "%d: %s should be 3\n", __LINE__, TO_STR(x));
x = s7_iterate(sc, iter);
- if ((x != s7_eof_object(sc)) || (!s7_iterator_is_at_end(iter)))
+ if ((x != s7_eof_object(sc)) || (!s7_iterator_is_at_end(sc, iter)))
fprintf(stderr, "%d: %s should be #<eof> and iter should be done\n", __LINE__, TO_STR(x));
}
diff --git a/tools/gcall.c b/tools/gcall.c
index a1f1886..e523f53 100644
--- a/tools/gcall.c
+++ b/tools/gcall.c
@@ -199,7 +199,12 @@ int main(int argc, char **argv)
s7 = s7_init();
+#if (GTK_CHECK_VERSION(3, 90, 0))
+ gtk_init();
+#else
gtk_init(&argc, &argv);
+#endif
+
shell = gtk_window_new(GTK_WINDOW_TOPLEVEL);
g_signal_connect(G_OBJECT(shell), "delete_event", G_CALLBACK(quit_repl), NULL);
diff --git a/tools/gdbinit b/tools/gdbinit
index a6e8862..658bc89 100644
--- a/tools/gdbinit
+++ b/tools/gdbinit
@@ -1,5 +1,5 @@
define s7print
-print s7_object_to_c_string(hidden_sc, $arg0)
+print s7_object_to_c_string(cur_sc, $arg0)
end
document s7print
interpret the argument as an s7 value and display it
@@ -13,7 +13,7 @@ end
define s7eval
-print s7_object_to_c_string(hidden_sc, s7_eval_c_string(hidden_sc, $arg0))
+print s7_object_to_c_string(cur_sc, s7_eval_c_string(cur_sc, $arg0))
end
document s7eval
eval the argument (a string)
@@ -21,7 +21,7 @@ end
define s7stack
-print s7_object_to_c_string(hidden_sc, s7_stacktrace(sc))
+print s7_object_to_c_string(cur_sc, s7_stacktrace(sc))
end
document s7stack
display the currently active local environments
@@ -29,13 +29,21 @@ end
define s7value
-print s7_object_to_c_string(hidden_sc, s7_name_to_value(hidden_sc, $arg0))
+print s7_object_to_c_string(cur_sc, s7_name_to_value(cur_sc, $arg0))
end
document s7value
print the value of the variable passed by its print name: s7v "*features*"
end
+define s7let
+print s7_show_let(cur_sc)
+end
+document s7let
+show all non-global variables that are currently accessible
+end
+
+
define s7bt
set logging overwrite on
set logging redirect on
@@ -69,13 +77,13 @@ define s7cell
set $type = $cell.tf.type_field
set $is_bad_type = (($type <= T_FREE) || ($type >= NUM_TYPES))
- printf "%s\n", describe_type_bits(hidden_sc, $cell)
+ printf "%s\n", describe_type_bits(cur_sc, $cell)
printf "hloc: %d, ", $cell.hloc
printf "fields: %p %p %p %p %p\n",\
$cell.object.cons.car, $cell.object.cons.cdr, $cell.object.cons.opt1, $cell.object.cons.opt2, $cell.object.cons.opt3
- if (($type == T_NIL) || ($type == T_BOOLEAN) || ($type == T_UNIQUE))
+ if (($type == T_NIL) || ($type == T_BOOLEAN) || ($type == T_UNDEFINED) || ($type == T_EOF_OBJECT))
printf "constant: %s\n", $cell.object.unq.name
end
@@ -208,7 +216,7 @@ define s7cell
end
if (($type == T_SYMBOL) || ($is_bad_type))
- printf "sym: name: %p, global_slot: %p, local_slot: %p, \n id: %d, tag: %d, accessor: %d\n", \
+ printf "sym: name: %p, global_slot: %p, local_slot: %p, \n id: %d, tag: %d, accessor: %u\n", \
$cell.object.sym.name, $cell.object.sym.global_slot, $cell.object.sym.local_slot, $cell.object.sym.id, $cell.object.sym.tag, $cell.object.string.str_ext.accessor
end
@@ -239,22 +247,29 @@ define s7cell
end
if (($type == T_CATCH) || ($is_bad_type))
- printf "rcatch: goto_loc: %d, op_stack_loc: %d, tag: %p, handler: %p\n", \
+ printf "rcatch: goto_loc: %d, op_stack_loc: %d, tag: %p, handler: %p\n", \
$cell.object.rcatch.goto_loc, $cell.object.rcatch.op_stack_loc, $cell.object.rcatch.tag, $cell.object.rcatch.handler
end
if (($type == T_GOTO) || ($is_bad_type))
- printf "rexit: goto_loc: %d, op_stack_loc: %d, active: %d\n", $cell.object.rexit.goto_loc, $cell.object.rexit.op_stack_loc, $cell.object.rexit.active
+ printf "rexit: goto_loc: %d, op_stack_loc: %d, active: %d\n", $cell.object.rexit.goto_loc, $cell.object.rexit.op_stack_loc, $cell.object.rexit.active
end
if (($type == T_DYNAMIC_WIND) || ($is_bad_type))
- printf "winder: in: %p, out: %p, body: %p, state: %d\n", \
+ printf "winder: in: %p, out: %p, body: %p, state: %d\n", \
$cell.object.winder.in, $cell.object.winder.out, $cell.object.winder.body, $cell.object.winder.state
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", \
+ $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
+ end
+
if (($type == T_CLOSURE) || ($type == T_CLOSURE_STAR) || ($type == T_MACRO) || ($type == T_BACRO) || ($is_bad_type))
- printf "func: args: %p, body: %p, env: %p, setter: %p, arity: %d\n", \
- $cell.object.func.args, $cell.object.func.body, $cell.object.func.env, $cell.object.func.setter, $cell.object.func.arity
+ printf "func: args: %p, body: %p, env: %p, setter: %p, arity: %d, opt_addr: %d\n", \
+ $cell.object.func.args, $cell.object.func.body, $cell.object.func.env, $cell.object.func.setter, \
+ $cell.object.func.arity, $cell.object.func.opt_addr
end
if (($type >= T_C_FUNCTION_STAR) || ($is_bad_type))
diff --git a/tools/gtk-header-diffs b/tools/gtk-header-diffs
index 4e698e3..88ef0f0 100755
--- a/tools/gtk-header-diffs
+++ b/tools/gtk-header-diffs
@@ -1,13 +1,13 @@
#!/bin/csh -f
-set gtkolddir = /home/bil/test/gtk+-3.89.1
-set gtknewdir = /home/bil/test/gtk+-3.89.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
-set glibnewdir = /home/bil/test/glib-2.49.6
-set cairoolddir = /home/bil/test/cairo-1.14.0
-set caironewdir = /home/bil/test/cairo-1.14.6
+set gtkolddir = /home/bil/test/gtk+-3.90.0
+set gtknewdir = /home/bil/test/gtk+-3.91.0
+# 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
+# set glibnewdir = /home/bil/test/glib-2.49.6
+# set cairoolddir = /home/bil/test/cairo-1.14.0
+# set caironewdir = /home/bil/test/cairo-1.14.6
set curdir = $cwd
@@ -34,63 +34,63 @@ foreach file (*.h)
endif
end
-chdir $pangonewdir/pango
-foreach file (*.h)
- echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
- if (-e $pangoolddir/pango/$file) then
- diff -bcw $pangoolddir/pango/$file $pangonewdir/pango/$file >> $curdir/hi
- else
- echo '(new)' >> $curdir/hi
- endif
-end
-
-chdir $glibnewdir/glib
-foreach file (*.h)
- echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
- if (-e $glibolddir/glib/$file) then
- diff -bcw $glibolddir/glib/$file $glibnewdir/glib/$file >> $curdir/hi
- else
- echo '(new)' >> $curdir/hi
- endif
-end
-
-chdir $glibnewdir/gio
-foreach file (*.h)
- echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
- if (-e $glibolddir/gio/$file) then
- diff -bcw $glibolddir/gio/$file $glibnewdir/gio/$file >> $curdir/hi
- else
- echo '(new)' >> $curdir/hi
- endif
-end
-
-chdir $glibnewdir/gobject
-foreach file (*.h)
- echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
- if (-e $glibolddir/gobject/$file) then
- diff -bcw $glibolddir/gobject/$file $glibnewdir/gobject/$file >> $curdir/hi
- else
- echo '(new)' >> $curdir/hi
- endif
-end
-
-chdir $glibnewdir/gmodule
-foreach file (*.h)
- echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
- if (-e $glibolddir/gmodule/$file) then
- diff -bcw $glibolddir/gmodule/$file $glibnewdir/gmodule/$file >> $curdir/hi
- else
- echo '(new)' >> $curdir/hi
- endif
-end
-
-chdir $caironewdir/src
-foreach file (*.h)
- echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
- if (-e $cairoolddir/src/$file) then
- diff -bcw $cairoolddir/src/$file $caironewdir/src/$file >> $curdir/hi
- else
- echo '(new)' >> $curdir/hi
- endif
-end
+# chdir $pangonewdir/pango
+# foreach file (*.h)
+# echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
+# if (-e $pangoolddir/pango/$file) then
+# diff -bcw $pangoolddir/pango/$file $pangonewdir/pango/$file >> $curdir/hi
+# else
+# echo '(new)' >> $curdir/hi
+# endif
+# end
+#
+# chdir $glibnewdir/glib
+# foreach file (*.h)
+# echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
+# if (-e $glibolddir/glib/$file) then
+# diff -bcw $glibolddir/glib/$file $glibnewdir/glib/$file >> $curdir/hi
+# else
+# echo '(new)' >> $curdir/hi
+# endif
+# end
+#
+# chdir $glibnewdir/gio
+# foreach file (*.h)
+# echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
+# if (-e $glibolddir/gio/$file) then
+# diff -bcw $glibolddir/gio/$file $glibnewdir/gio/$file >> $curdir/hi
+# else
+# echo '(new)' >> $curdir/hi
+# endif
+# end
+#
+# chdir $glibnewdir/gobject
+# foreach file (*.h)
+# echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
+# if (-e $glibolddir/gobject/$file) then
+# diff -bcw $glibolddir/gobject/$file $glibnewdir/gobject/$file >> $curdir/hi
+# else
+# echo '(new)' >> $curdir/hi
+# endif
+# end
+#
+# chdir $glibnewdir/gmodule
+# foreach file (*.h)
+# echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
+# if (-e $glibolddir/gmodule/$file) then
+# diff -bcw $glibolddir/gmodule/$file $glibnewdir/gmodule/$file >> $curdir/hi
+# else
+# echo '(new)' >> $curdir/hi
+# endif
+# end
+#
+# chdir $caironewdir/src
+# foreach file (*.h)
+# echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
+# if (-e $cairoolddir/src/$file) then
+# diff -bcw $cairoolddir/src/$file $caironewdir/src/$file >> $curdir/hi
+# else
+# echo '(new)' >> $curdir/hi
+# endif
+# end
diff --git a/tools/make-index.scm b/tools/make-index.scm
index 9fa7b9c..8615315 100644
--- a/tools/make-index.scm
+++ b/tools/make-index.scm
@@ -99,14 +99,13 @@
x))
sequence)))
-#|
+
(define (count-table commands)
(do ((count 0 (+ count 1))
(c (memq 'table commands) (memq 'table (cdr c))))
((not c) count)))
-;;; but sadly the for-each version below is faster.
-|#
+#|
(define (count-table commands)
(let ((count 0))
(for-each
@@ -115,7 +114,7 @@
(set! count (+ count 1))))
commands)
count))
-
+|#
(define (string</* a b)
@@ -477,7 +476,8 @@
(when (pair? binding)
(let ((symbol (car binding))
(value (cdr binding)))
- (when (procedure? value)
+ (when (and (procedure? value)
+ (let? (funclet value)))
(let ((file (let ((addr (with-let (funclet value) __func__)))
;; this misses scheme-side pws because their environment is (probably) the global env
(and (pair? addr)
@@ -1620,3 +1620,5 @@
(s7-version)
(exit)
+
+
diff --git a/tools/makexg.scm b/tools/makexg.scm
index ffb75d8..1be5401 100755
--- a/tools/makexg.scm
+++ b/tools/makexg.scm
@@ -1567,7 +1567,7 @@
(cdr all-types))
(define other-types
- (list 'idler 'GtkCellRendererPixbuf_ 'GtkCheckButton_ 'GtkScrollbar_ 'GtkSeparator_ 'GtkSeparatorMenuItem_
+ (list 'idler 'GtkCellRendererPixbuf_ 'GtkScrollbar_ 'GtkSeparator_ 'GtkSeparatorMenuItem_
'GdkEventExpose_ 'GdkEventNoExpose_ 'GdkEventVisibility_ 'GdkEventButton_ 'GdkEventScroll_ 'GdkEventCrossing_
'GdkEventFocus_ 'GdkEventConfigure_ 'GdkEventProperty_ 'GdkEventSelection_ 'GdkEventProximity_ 'GdkEventSetting_
'GdkEventWindowState_ 'GdkEventDND_ 'GtkFileChooserDialog_ 'GtkFileChooserWidget_ 'GtkColorButton_ 'GtkAccelMap
@@ -1579,7 +1579,8 @@
(for-each
(lambda (typ)
- (hey ", xg_~A_symbol" typ))
+ (if (not (member typ all-types))
+ (hey ", xg_~A_symbol" typ)))
other-types)
(hey ";~%~%")
@@ -2334,6 +2335,20 @@
(hey "#endif~%")
(hey "~%")
+(hey "#if (GTK_CHECK_VERSION(3, 90, 0))~%")
+(hey "static Xen gxg_gtk_init(void)~%")
+(hey "{~%")
+(hey " #define H_gtk_init \"void gtk_init(void)\" ~%")
+(hey " gtk_init();~%")
+(hey " return(Xen_false);~%")
+(hey "}~%")
+(hey "static Xen gxg_gtk_init_check(void)~%")
+(hey "{~%")
+(hey " #define H_gtk_init_check \"void gtk_init_check(void)\" ~%")
+(hey " gtk_init_check();~%")
+(hey " return(Xen_false);~%")
+(hey "}~%")
+(hey "#else~%")
;;; from Mike Scholz -- improve the error checking
(hey "static Xen gxg_gtk_init(Xen argc, Xen argv) ~%")
(hey "{ ~%")
@@ -2391,6 +2406,7 @@
(hey " result = C_to_Xen_gboolean(gtk_init_check(&ref_argc, &ref_argv));~%")
(hey " return(Xen_list_3(result, C_to_Xen_int(ref_argc), C_to_Xen_char__(ref_argv)));~%")
(hey " }~%")
+(hey "#endif~%")
(hey "}~%~%")
(hey "static Xen gxg_make_target_entry(Xen lst)~%")
@@ -2659,8 +2675,13 @@
(hey "Xen_wrap_3_args(xg_object_set_w, xg_object_set)~%")
(hey "Xen_wrap_1_arg(xg_gtk_event_keyval_w, xg_gtk_event_keyval)~%")
+(hey "#if (GTK_CHECK_VERSION(3, 90, 0))~%")
+(hey "Xen_wrap_no_args(gxg_gtk_init_w, gxg_gtk_init)~%")
+(hey "Xen_wrap_no_args(gxg_gtk_init_check_w, gxg_gtk_init_check)~%")
+(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 "#endif~%")
(define (ruby-cast func) (hey "Xen_wrap_1_arg(gxg_~A_w, gxg_~A)~%" (no-arg (car func)) (no-arg (car func))))
(for-each ruby-cast (reverse casts))
@@ -2881,8 +2902,13 @@
(hey " Xg_define_procedure(g_object_set, xg_object_set_w, 3, 0, 0, NULL, NULL);~%")
(hey " Xg_define_procedure(gtk_event_keyval, xg_gtk_event_keyval_w, 1, 0, 0, NULL, NULL);~%")
+(hey "#if (GTK_CHECK_VERSION(3, 90, 0))~%")
+(hey " Xg_define_procedure(gtk_init, gxg_gtk_init_w, 0, 0, 0, H_gtk_init, NULL);~%")
+(hey " Xg_define_procedure(gtk_init_check, gxg_gtk_init_check_w, 0, 0, 0, H_gtk_init_check, NULL);~%")
+(hey "#else~%")
(hey " Xg_define_procedure(gtk_init, gxg_gtk_init_w, 0, 2, 0, H_gtk_init, NULL);~%")
(hey " Xg_define_procedure(gtk_init_check, gxg_gtk_init_check_w, 0, 2, 0, H_gtk_init_check, NULL);~%")
+(hey "#endif~%")
(define (check-out func)
(let ((f (car func)))
@@ -3146,10 +3172,14 @@
(hey " define_lint();~%")
(hey " #endif~%")
(hey " Xen_provide_feature(\"xg\");~%")
-(hey " #if GTK_CHECK_VERSION(3, 0, 0)~%")
-(hey " Xen_provide_feature(\"gtk3\");~%")
+(hey " #if GTK_CHECK_VERSION(3, 90, 0)~%")
+(hey " Xen_provide_feature(\"gtk4\");~%")
(hey " #else~%")
-(hey " Xen_provide_feature(\"gtk2\");~%")
+(hey " #if GTK_CHECK_VERSION(3, 0, 0)~%")
+(hey " Xen_provide_feature(\"gtk3\");~%")
+(hey " #else~%")
+(hey " Xen_provide_feature(\"gtk2\");~%")
+(hey " #endif~%")
(hey " #endif~%")
(hey " Xen_define(\"xg-version\", C_string_to_Xen_string(\"~A\"));~%" (strftime "%d-%b-%y" (localtime (current-time))))
(hey " xg_already_inited = true;~%")
diff --git a/tools/sam.c b/tools/sam.c
index 7fe04a6..1df6bb5 100644
--- a/tools/sam.c
+++ b/tools/sam.c
@@ -1547,7 +1547,7 @@ static void ticks_command(int cmd)
char *dot;
int i, len;
len = strlen(filename);
- output_filename = malloc(len + 1);
+ output_filename = (char *)malloc(len + 1);
strcpy(output_filename, filename);
/* dot = strchr(output_filename, '.');
* can be confused by ../test/TEST.SAM
diff --git a/tools/t101.scm b/tools/t101.scm
index 6d6caa7..d4ba916 100644
--- a/tools/t101.scm
+++ b/tools/t101.scm
@@ -8,8 +8,10 @@
(let ((aux-file (format #f "t101-aux-~D.scm" (set! aux-counter (+ aux-counter 1)))))
(call-with-output-file aux-file
(lambda (p)
- (format p "(define-macro (test tst expected) ~A)~%(load \"s7test.scm\")~%(exit)~%" test-case)))
- (format *stderr* "test: ~S~%" test-case)
+ (format p "(define-macro (test tst expected) ~A)~%" test-case)
+ (format p "(define-macro (num-test tst expected) ~A)~%" (string-append "`(nok? " (substring test-case 5)))
+ (format p "(load \"s7test.scm\")~%(exit)~%")))
+ (format *stderr* "~%~NC~%test: ~S~%" 80 #\- test-case)
(system (string-append "./repl " aux-file))))
(list
"`(ok? ',tst (lambda () (eval ',tst)) ,expected)"
@@ -18,25 +20,25 @@
"`(ok? ',tst (let () (define (_s7_) ,tst) (define (_call_) (_s7_))) ,expected)"
"`(ok? ',tst (lambda () (let ((_s7_ #f)) (set! _s7_ ,tst))) ,expected)"
"`(ok? ',tst (lambda () (let ((_s7_ ,tst)) _s7_)) ,expected)"
- "`(ok? ',tst (catch #t (lambda () (lambda* ((_a_ ,tst)) _a_)) (lambda any (lambda () 'error))) ,expected)"
- "`(ok? ',tst (lambda () (do ((_a_ ,tst)) (#t _a_))) ,expected)"
+ "`(ok? ',tst (catch #t (lambda () (lambda* (($a$ ,tst)) $a$)) (lambda any (lambda () 'error))) ,expected)"
+ "`(ok? ',tst (lambda () (do (($a$ ,tst)) (#t $a$))) ,expected)"
"`(ok? ',tst (lambda () (do ((__i__ 0 (+ __i__ 1))) ((= __i__ 1) ,expected) ,tst)) ,expected)"
+ "`(ok? ',tst (lambda () (let ((__x__ #f)) (define (__f__) (do ((__i__ 0 (+ __i__ 1))) ((= __i__ 1) __x__) (set! __x__ ,tst))) (__f__))) ,expected)"
"`(ok? ',tst (lambda () (define ($f$) (let (($v$ (vector #f))) (do (($i$ 0 (+ $i$ 1))) ((= $i$ 1) ($v$ 0)) (vector-set! $v$ 0 ,tst)))) ($f$)) ,expected)"
"`(ok? ',tst (lambda () (define ($f$) (let (($v$ #f)) (do (($i$ 0 (+ $i$ 1))) ((= $i$ 1) $v$) (set! $v$ ,tst)))) ($f$)) ,expected)"
- "`(ok? ',tst (lambda () (define ($f$) (let ((x (map (lambda (a) ,tst) '(0)))) (car x))) ($f$)) ,expected)"
- "`(ok? ',tst (lambda () (call-with-exit (lambda (_a_) (_a_ ,tst)))) ,expected)"
- "`(ok? ',tst (lambda () (call/cc (lambda (_a_) (_a_ ,tst)))) ,expected)"
+ "`(ok? ',tst (lambda () (define ($f$) (let (($x$ (map (lambda ($a$) ,tst) '(0)))) (car $x$))) ($f$)) ,expected)"
+ "`(ok? ',tst (lambda () (call-with-exit (lambda ($a$) ($a$ ,tst)))) ,expected)"
+ "`(ok? ',tst (lambda () (call/cc (lambda ($a$) ($a$ ,tst)))) ,expected)"
"`(ok? ',tst (lambda () (values ,tst)) ,expected)"
- "`(ok? ',tst (lambda () ((lambda (a b) b) (values #f ,tst))) ,expected)"
- "`(ok? ',tst (lambda () (define (_s7_ _a_) _a_) (_s7_ ,tst)) ,expected)"
+ "`(ok? ',tst (lambda () ((lambda ($a$ $b$) $b$) (values #f ,tst))) ,expected)"
+ "`(ok? ',tst (lambda () (define (_s7_ $a$) $a$) (_s7_ ,tst)) ,expected)"
"`(ok? ',tst (lambda () (let ((___x #f)) (set! ___x ,tst))) ,expected)"
"`(ok? ',tst (lambda () (let ((___x #(#f))) (set! (___x 0) ,tst))) ,expected)"
"`(ok? ',tst (lambda () (let ((___x #(#f))) (vector-set! ___x 0 ,tst))) ,expected)"
- "`(ok? ',tst (lambda () (define* (_s7_ (_a_ #f)) (or _a_)) (_s7_ ,tst)) ,expected)"
"`(ok? ',tst (lambda () (dynamic-wind (lambda () #f) (lambda () ,tst) (lambda () #f))) ,expected)"
"`(ok? ',tst (lambda () (caadr (catch 'receive (lambda () (throw 'receive ,tst)) (lambda any any)))) ,expected)"
"`(ok? ',tst (lambda () (stacktrace (- (random 100) 50) (- (random 100) 50) (- (random 100) 50) (- (random 100) 50) (> (random 100) 50)) ,tst) ,expected)"
- "(list-values 'ok? (list-values quote tst) (list-values lambda () tst) expected)"
+ "`(ok? ',tst (lambda () (let ((__val__ (s7-optimize '(,tst)))) (if (eq? __val__ #<undefined>) ,tst __val__))) ,expected)"
))
(format *stderr* "~NC ffitest ~NC~%" 20 #\- 20 #\-)
@@ -115,9 +117,9 @@
(system "./snd -l snd-test.scm")
(format *stderr* "~NC bench ~NC~%" 20 #\- 20 #\-)
-(system "(cd /home/bil/test/bench/src ; /home/bil/cl/snd test-all.scm)")
+(system "(cd /home/bil/test/scheme/bench/src ; /home/bil/cl/snd test-all.scm)")
-(format *stderr* "~NC lg ~NC~%" 20 #\- 20 #\-)
-(system "./repl lg.scm")
+;(format *stderr* "~NC lg ~NC~%" 20 #\- 20 #\-)
+;(system "./repl lg.scm")
(exit)
diff --git a/tools/tauto.scm b/tools/tauto.scm
index a43187d..80b05b0 100644
--- a/tools/tauto.scm
+++ b/tools/tauto.scm
@@ -32,14 +32,14 @@
;(define value 1) ; this causes an infinite loop somewhere
;(openlet (inlet 'i 0 'list-set! (lambda (l . args) (apply #_list-set! l ((car args) 'i) (cdr args))))))
-(define-constant constants (list #f #t () #\a (/ most-positive-fixnum) (/ -1 most-positive-fixnum) 1.5+i
+(define-constant auto-constants (list #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 ()) #()
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 #\xff (string #\xff) 1e308
most-positive-fixnum most-negative-fixnum (- most-positive-fixnum 1) (+ most-negative-fixnum 1)
-1 0 0.0 1 1.5 1.0-1.0i 3/4 #\null -63 (make-hash-table) (hash-table '(a . 2) '(b . 3))
- '((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
+ '((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)
*load-hook* *error-hook* (random-state 123)
@@ -49,11 +49,11 @@
#<undefined> #<unspecified> (make-int-vector 3) (make-float-vector 3 -1.4)
(make-vector '(2 3) "hi") #("hiho" "hi" "hoho") (make-shared-vector (make-int-vector '(2 3) 1) '(6))
(make-shared-vector (make-shared-vector (make-float-vector '(2 3) 1.0) '(6)) '(2 2))
- (vector-ref #2d((#(1 2 3)) (#(3 4 5))) 0 0) (define-macro (m a) `(+ ,a 1))
+ (vector-ref #2d((#i(1 2 3)) (#i(3 4 5))) 0 0) (define-macro (m a) `(+ ,a 1))
(c-pointer 0) (c-pointer -1) :readable :else (define-bacro* (m (a 1)) `(+ ,a 1))
(byte-vector 0 1 2) (byte-vector) (byte-vector 255 0 127) (make-iterator #((a . 2)))
(lambda (dir) 1.0) (float-vector) (make-float-vector '(2 32))
- '((a . 1)) #(1) '((((A . B) C . D) (E . F) G . H) ((I . J) K . L) (M . N) O . P)
+ '((a . 1)) #i(1) '((((A . B) C . D) (E . F) G . H) ((I . J) K . L) (M . N) O . P)
(mock-number 0) (mock-number 1-i) (mock-number 4/3) (mock-number 2.0)
(mock-string #\h #\o #\h #\o)
@@ -65,11 +65,11 @@
np mp nv mv ns ms (gensym)
))
-(define car-constants (car constants))
-(define-constant cdr-constants (cdr constants))
+(define car-auto-constants (car auto-constants))
+(define-constant cdr-auto-constants (cdr auto-constants))
(define low 0)
-(define-constant arglists (vector (make-list 1) (make-list 2) (make-list 3) (make-list 4) (make-list 5) (make-list 6)))
+(define-constant auto-arglists (vector (make-list 1) (make-list 2) (make-list 3) (make-list 4) (make-list 5) (make-list 6)))
(define-constant (autotest func args args-now args-left sig)
;; args-left is at least 1, args-now starts at 0, args starts at ()
@@ -88,14 +88,33 @@
(memq (car any) '(wrong-type-arg wrong-number-of-args syntax-error)))
(quit)))))
- (let ((c-args (vector-ref arglists args-now)))
+ (let ((c-args (vector-ref auto-arglists args-now)))
(copy args c-args)
- (let ((p (list-tail c-args args-now)))
+ (let ((p (list-tail c-args args-now))
+ (checker (and (pair? sig) (car sig))))
+
+ (define (call-func1 c)
+ (when (checker c)
+ (catch #t
+ (lambda ()
+ (set-car! p c)
+ (apply func c-args))
+ (lambda any
+ 'error))))
+
+ (define (call-func2 c)
+ (catch #t
+ (lambda ()
+ (set-car! p c)
+ (apply func c-args))
+ (lambda any
+ 'error)))
+
(if (= args-left 1)
(call-with-exit
(lambda (quit)
- (set-car! p car-constants)
+ (set-car! p car-auto-constants)
(catch #t
(lambda ()
(apply func c-args))
@@ -107,41 +126,22 @@
(< (caddr (cadr any)) low))
(quit))))
- (let ((checker (and (pair? sig) (car sig))))
- (if checker
- (for-each
- (lambda (c)
- (when (checker c)
- (catch #t
- (lambda ()
- (set-car! p c)
- (apply func c-args))
- (lambda any
- 'error))))
- cdr-constants)
- (for-each
- (lambda (c)
- (catch #t
- (lambda ()
- (set-car! p c)
- (apply func c-args))
- (lambda any
- 'error)))
- cdr-constants)))))
+ (if checker ; map-values -> function here
+ (for-each call-func1 cdr-auto-constants)
+ (for-each call-func2 cdr-auto-constants))))
- (let ((checker (and (pair? sig) (car sig))))
- (if checker
- (for-each
- (lambda (c)
- (when (checker c)
- (set-car! p c)
- (autotest func c-args (+ args-now 1) (- args-left 1) (if (pair? sig) (cdr sig) ()))))
- constants)
- (for-each
- (lambda (c)
+ (if checker
+ (for-each
+ (lambda (c)
+ (when (checker c)
(set-car! p c)
- (autotest func c-args (+ args-now 1) (- args-left 1) (if (pair? sig) (cdr sig) ())))
- constants)))))))))
+ (autotest func c-args (+ args-now 1) (- args-left 1) (if (pair? sig) (cdr sig) ()))))
+ auto-constants)
+ (for-each
+ (lambda (c)
+ (set-car! p c)
+ (autotest func c-args (+ args-now 1) (- args-left 1) (if (pair? sig) (cdr sig) ())))
+ auto-constants))))))))
(define safe-fill!
(let ((signature '(#t sequence? #t)))
@@ -161,7 +161,7 @@
(and (pair? (car lst))
(apply lambda '(x) (list (list 'or (list (caar lst) 'x) (list (cadar lst) 'x)))))))))
-(define baddies '(exit emergency-exit abort autotest
+(define baddies '(exit emergency-exit abort autotest s7-optimize
all delete-file system set-cdr! stacktrace test-sym
cutlet varlet gc cond-expand reader-cond
openlet coverlet eval vector list cons hash-table* hash-table values
@@ -174,9 +174,9 @@
mock-symbol mock-port mock-hash-table m
*mock-number* *mock-pair* *mock-string* *mock-char* *mock-vector*
*mock-symbol* *mock-port* *mock-hash-table*
-
+
c-define-1 apropos map-values ;set-current-output-port
- outlet-member make-method make-object))
+ tree-count outlet-member make-method make-object))
(define (test-sym sym)
(if (and (not (memq sym baddies))
@@ -208,9 +208,10 @@
;(test-sym 'object->string)
;(test-sym 'for-each)
(format *stderr* "~%all done~%")
- (s7-version)
))
;(test-sym 'write)
(all)
+
+(s7-version)
(exit)
diff --git a/tools/tcopy.scm b/tools/tcopy.scm
index 956b671..caa9859 100644
--- a/tools/tcopy.scm
+++ b/tools/tcopy.scm
@@ -240,7 +240,6 @@
(test (length bvec) (* size size))
)))
-
(define (t)
(do ((i 0 (+ i 1)))
((= i 10000))
@@ -251,5 +250,16 @@
(t)
+#|
+(format *stderr* "copy~%")
+(test-copy 100000)
+;100000 : .1
+;1000000 : 4.6
+;10000000 : 356 = about 120 million objects = about 6Gbytes, mark_pair/gc
+;(format *stderr* "append~%")
+;(test-append 10000)
+|#
+
(s7-version)
(exit)
+
diff --git a/tools/teq.scm b/tools/teq.scm
index ba9457b..0c755ca 100644
--- a/tools/teq.scm
+++ b/tools/teq.scm
@@ -63,7 +63,7 @@
(define hash-3 (hash-table* :a vect-0 :b list-0))
(define hash-4 (hash-table* :a hash-1))
-(define-constant vars (vector list-0 list-1 list-2 list-3 list-4
+(define-constant teq-vars (list list-0 list-1 list-2 list-3 list-4
vect-0 vect-1 vect-2 vect-3 vect-4
hash-0 hash-1 hash-2 hash-3 hash-4
let-0 let-1 let-2 let-3 let-4))
@@ -71,22 +71,22 @@
;(format *stderr* "~A ~A ~A ~A ~A~%" (length hash-0) (length hash-1) (length hash-2) (length hash-3) (length hash-4))
(set! (*s7* 'initial-string-port-length) 64)
-
+#|
(define (tests size)
(let ((str #f)
(p (open-output-string))
(iter #f))
(do ((i 0 (+ i 1)))
((= i size))
- (set! iter (make-iterator vars))
+ (set! iter (make-iterator teq-vars))
(do ((j 0 (+ j 1))
(vj (iterate iter) (iterate iter)))
((= j 20))
(do ((k 0 (+ k 1)))
((= k 20))
- (if (equal? vj (vector-ref vars k))
+ (if (equal? vj (vector-ref teq-vars k))
(if (not (= j k))
- (format *stderr* "oops! (~D ~D): ~A ~A~%" j k vj (vector-ref vars k)))))
+ (format *stderr* "oops! (~D ~D): ~A ~A~%" j k vj (vector-ref teq-vars k)))))
;;(display "oops"))))
(write vj p)
(set! str (get-output-string p #t))
@@ -94,18 +94,18 @@
(set! str (format #f "~A~%" vj))
(set! str (cyclic-sequences vj))))
(close-output-port p)))
+|#
-#|
(define (tests size)
(let ((str #f)
(vj #f)
(p (open-output-string)))
(do ((i 0 (+ i 1)))
((= i size))
- (do ((a vars (cdr a)))
+ (do ((a teq-vars (cdr a)))
((null? a))
(set! vj (car a))
- (do ((b vars (cdr b)))
+ (do ((b teq-vars (cdr b)))
((null? b))
(if (equal? vj (car b))
(if (not (eq? a b))
@@ -116,7 +116,7 @@
(set! str (format #f "~A~%" vj))
(set! str (cyclic-sequences vj))))
(close-output-port p)))
-
+#|
;; almost as fast
(define (tests size)
(let ((str #f)
@@ -134,14 +134,14 @@
(if (not (= j k))
(format *stderr* "oops! (~D ~D): ~A ~A~%" j k vj w)))
(set! j (+ j 1)))
- vars)
+ teq-vars)
(set! k (+ k 1))
(write vj p)
(set! str (get-output-string p #t))
(set! str (object->string vj))
(set! str (format #f "~A~%" vj))
(set! str (cyclic-sequences vj)))
- vars))
+ teq-vars))
(close-output-port p)))
|#
@@ -151,4 +151,6 @@
(s7-version)
(exit)
+
+
diff --git a/tools/testsnd b/tools/testsnd
index 8ec1bd0..ae68e84 100755
--- a/tools/testsnd
+++ b/tools/testsnd
@@ -91,22 +91,6 @@ echo ' -------------------------------- that was snd-test pure-s7 --------------
echo ' '
echo ' '
-echo ' -------------------------------- no opt -------------------------------- '
-make allclean
-rm -f snd
-rm -f config.cache
-./configure --quiet CFLAGS="-Wall -I/usr/local/include -DWITH_OPTIMIZATION=0" --without-gui --disable-deprecated
-make
-echo ' '
-echo ' '
-./snd --version
-./snd -l snd-test
-echo ' '
-echo ' '
-echo ' -------------------------------- that was snd-test without optimization -------------------------------- '
-echo ' '
-echo ' '
-
echo ' -------------------------------- no choosers -------------------------------- '
make allclean
rm -f snd
diff --git a/tools/tform.scm b/tools/tform.scm
index dfaba47..13cab71 100644
--- a/tools/tform.scm
+++ b/tools/tform.scm
@@ -42,7 +42,7 @@
(vector-ref #2d((#(1 2 3)) (#(3 4 5))) 0 0) (define-macro (m a) `(+ ,a 1))
(c-pointer 0) (c-pointer -1) :readable *s7* else (define-bacro* (m (a 1)) `(+ ,a 1))
(byte-vector 0 1 2) (byte-vector) (byte-vector 255 0 127) (make-iterator (vector '(a . 2)))
- (lambda (dir) 1.0) (float-vector) (make-float-vector '(2 32)) (int-vector 1 2 3) (int-vector)
+ (lambda (dir) 1.0) (float-vector) (make-float-vector '(2 2)) (int-vector 1 2 3) (int-vector)
(inlet 'value 1 '+ (lambda args 1)) (inlet) (make-iterator (inlet 'a 1 'b 2) (cons #f #f))
(make-iterator "123456") (make-iterator '(1 2 3)) (make-iterator (hash-table* 'a 1 'b 2) (cons #f #f))
(open-input-string "123123") (open-input-file "/home/bil/cl/4.aiff")
@@ -56,7 +56,7 @@
(mock-vector 1 2 3 4)
(mock-hash-table* 'b 2)
- (make-block 32) (block) (make-iterator (block 1 2 3 4 5 6))
+ (make-block 4) (block) (make-iterator (block 1 2 3 4))
))
(define-constant constants-len (length constants))
@@ -74,53 +74,46 @@
(define (test-chars)
(let ((op (open-output-string))
(x #f) (y #f) (z #f))
- (do ((size 2 (+ size 1)))
+ (do ((size 2 (+ size 1))
+ (size1 3 (+ size1 1))
+ (tries 4000 (+ tries 2000))
+ (pos 0 0)
+ (ctrl-str ""))
((= size 15))
- (let ((tries (* size 2000))
- (size1 (+ size 1)))
- (format *stderr* "~D " size)
- (let ((ctrl-str (make-string size1))
- (pos 0))
- (string-set! ctrl-str 0 #\~)
- (do ((i 0 (+ i 1)))
- ((= i tries))
- (do ((j 1 (+ j 1)))
- ((= j size1))
- (string-set! ctrl-str j (string-ref ctrl-chars (random ctrl-chars-len))))
-
- (set! x (constants (random constants-len)))
- (set! y (constants (random constants-len)))
- (set! z (constants (random constants-len)))
-
- (object->string x)
- (display x op)
-
- (catch #t (lambda () (format #f "~{~^~S ~} ~{~|~S ~} ~W" x y z)) (lambda arg 'error))
- (catch #t (lambda () (format #f ctrl-str)) (lambda arg 'error))
- (catch #t (lambda () (format #f ctrl-str x)) (lambda arg 'error))
- (catch #t (lambda () (format #f ctrl-str y)) (lambda arg 'error))
- (catch #t (lambda () (format #f ctrl-str z)) (lambda arg 'error))
- (set! pos (char-position #\~ ctrl-str 1))
- (when pos
- (catch #t (lambda () (format #f ctrl-str x z)) (lambda arg 'error))
- (catch #t (lambda () (format #f ctrl-str x y)) (lambda arg 'error))
- (catch #t (lambda () (format #f ctrl-str y z)) (lambda arg 'error))
- (catch #t (lambda () (format #f ctrl-str z x)) (lambda arg 'error))
- (when (char-position #\~ ctrl-str (+ pos 1))
- (catch #t (lambda () (format #f ctrl-str x y z)) (lambda arg 'error))
- (catch #t (lambda () (format #f ctrl-str z y x)) (lambda arg 'error))))))
- (get-output-string op #t)))
+ (format *stderr* "~D " size)
+ (set! ctrl-str (make-string size1))
+ (string-set! ctrl-str 0 #\~)
+ (do ((i 0 (+ i 1)))
+ ((= i tries))
+ (do ((j 1 (+ j 1)))
+ ((= j size1))
+ (string-set! ctrl-str j (string-ref ctrl-chars (random ctrl-chars-len))))
+
+ (set! x (constants (random constants-len)))
+ (set! y (constants (random constants-len)))
+ (set! z (constants (random constants-len)))
+
+ (object->string x)
+ (display x op)
+
+ (catch #t (lambda () (format #f "~{~^~S ~} ~{~|~S ~} ~W" x y z)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str x)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str y)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str z)) (lambda arg 'error))
+ (set! pos (char-position #\~ ctrl-str 1))
+ (when pos
+ (catch #t (lambda () (format #f ctrl-str x z)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str x y)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str y z)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str z x)) (lambda arg 'error))
+ (when (char-position #\~ ctrl-str (+ pos 1))
+ (catch #t (lambda () (format #f ctrl-str x y z)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str z y x)) (lambda arg 'error)))))
+ (get-output-string op #t))
(close-output-port op)))
(test-chars)
(s7-version)
-
(exit)
-
-#|
-valgrind --vgdb=yes --vgdb-error=0 repl
-gdb repl
- target remote | /usr/local/lib/valgrind/../../bin/vgdb
- continue
-|#
diff --git a/tools/tgen.scm b/tools/tgen.scm
index 7e25d3f..76655bb 100644
--- a/tools/tgen.scm
+++ b/tools/tgen.scm
@@ -193,55 +193,55 @@
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
(do ((i 0 (+ i 1))) ((= i 10))
- (set! (V i) ,(copy form))))
+ (set! (V i) ,form)))
(define (tester-1)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1) (v (make-float-vector 10)))
(do ((i 0 (+ i 1))) ((= i 10) v)
- (float-vector-set! v i ,(copy form)))))
+ (float-vector-set! v i ,form))))
(define (tester-2)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
(set! *output* (make-float-vector 10))
(do ((i 0 (+ i 1))) ((= i 10) *output*)
- (outa i ,(copy form)))))
+ (outa i ,form))))
(define (tester-3)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
(set! *output* (make-float-vector 10))
(do ((i 0 (+ i 1))) ((= i 10) *output*)
- (out-any i ,(copy form) 0))))
+ (out-any i ,form 0))))
(define (tester-4)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
(do ((i 0 (+ i 1)) (lst ())) ((= i 10) (apply float-vector (reverse! lst)))
- (set! lst (cons ,(copy form) lst)))))
+ (set! lst (cons ,form lst)))))
(define (tester-5)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1) (v (make-float-vector 10)))
(set! *output* (make-sample->file "test.snd" 1 mus-ldouble mus-next "t816"))
(do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 10))
- (outa i ,(copy form)))
+ (outa i ,form))
(mus-close *output*)
(file->array "test.snd" 0 0 10 v)))
(define (tester-6)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (k 1) (v (make-float-vector 10)))
(do ((i 0 (+ i 1)) (y -0.5) (x 0.0 (+ x 0.1))) ((= i 10) v)
- (float-vector-set! v i ,(copy form)))))
+ (float-vector-set! v i ,form))))
(define (tester-11)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1) (v (make-float-vector 10)))
(do ((i 0 (+ i 1))) ((= i 10) v)
(let ((x (,gen o)))
- (set! (v i) ,(copy form))))))
+ (set! (v i) ,form)))))
(define (tester-12)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1))
(set! *output* (make-float-vector 10))
(do ((i 0 (+ i 1))) ((= i 10) *output*)
(let ((x (,gen o)))
- (outa i ,(copy form))))))
+ (outa i ,form)))))
(checkout-1 ',form V (tester-1) (tester-2) (tester-3) (tester-4) (tester-5) (tester-6) (tester-11) (tester-12))
)))
@@ -260,87 +260,86 @@
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
(do ((i 0 (+ i 1))) ((= i 10))
- (set! (V i) ,(copy form))))
+ (set! (V i) ,form)))
(define (tester-1)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1) (v (make-float-vector 10)))
(do ((i 0 (+ i 1))) ((= i 10) v)
- (float-vector-set! v i ,(copy form)))))
+ (float-vector-set! v i ,form))))
(define (tester-2)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
(set! *output* (make-float-vector 10))
(do ((i 0 (+ i 1))) ((= i 10) *output*)
- (outa i ,(copy form)))))
+ (outa i ,form))))
(define (tester-3)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
(set! *output* (make-float-vector 10))
(do ((i 0 (+ i 1))) ((= i 10) *output*)
- (out-any i ,(copy form) 0))))
+ (out-any i ,form 0))))
(define (tester-4)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
(do ((i 0 (+ i 1)) (lst ())) ((= i 10) (apply float-vector (reverse! lst)))
- (set! lst (cons ,(copy form) lst)))))
+ (set! lst (cons ,form lst)))))
(define (tester-5)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1) (v (make-float-vector 10)))
(set! *output* (make-sample->file "test.snd" 1 mus-ldouble mus-next "t816"))
(do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 10))
- (outa i ,(copy form)))
+ (outa i ,form))
(mus-close *output*)
(file->array "test.snd" 0 0 10 v)))
(define (tester-6)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (k 1) (v (make-float-vector 10)))
(do ((i 0 (+ i 1)) (y -0.5) (x 0.0 (+ x 0.1))) ((= i 10) v)
- (float-vector-set! v i ,(copy form)))))
+ (float-vector-set! v i ,form))))
(define (tester-7)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1) (v (make-float-vector 10)))
(do ((i 0 (+ i 1))) ((= i 10) v)
- (let ((z ,(copy form)))
+ (let ((z ,form))
(float-vector-set! v i (,gen o z))))))
(define (tester-8)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
(set! *output* (make-float-vector 10))
(do ((i 0 (+ i 1))) ((= i 10) *output*)
- (let ((z ,(copy form)))
+ (let ((z ,form))
(outa i (,gen o z))))))
(define (tester-9)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1) (v (make-float-vector 10)))
(do ((i 0 (+ i 1))) ((= i 10) v)
- (let ((z ,(copy form)))
+ (let ((z ,form))
(float-vector-set! v i (* (env a) (,gen o z)))))))
(define (tester-10)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
(set! *output* (make-float-vector 10))
(do ((i 0 (+ i 1))) ((= i 10) *output*)
- (let ((z ,(copy form)))
+ (let ((z ,form))
(outa i (* (env a) (,gen o z)))))))
(define (tester-11)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1) (v (make-float-vector 10)))
(do ((i 0 (+ i 1))) ((= i 10) v)
(let ((x (,gen o)))
- (set! (v i) ,(copy form))))))
+ (set! (v i) ,form)))))
(define (tester-12)
(let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1))
(set! *output* (make-float-vector 10))
(do ((i 0 (+ i 1))) ((= i 10) *output*)
(let ((x (,gen o)))
- (outa i ,(copy form))))))
+ (outa i ,form)))))
(checkout ',form V
(tester-1) (tester-2) (tester-3) (tester-4) (tester-5) (tester-6)
(tester-7) (tester-8) (tester-9) (tester-10) (tester-11) (tester-12))
)))
-
(define the-body (apply lambda () (list (copy body :readable))))
(the-body))))
@@ -356,81 +355,81 @@
(let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (z 0.1) (k 1))
(do ((i 0 (+ i 1))) ((= i 10))
- (float-vector-set! V i ,(copy form))))
+ (float-vector-set! V i ,form)))
(define (tester-1)
(let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (z 0.1) (k 1) (v (make-float-vector 10)))
(do ((i 0 (+ i 1))) ((= i 10) v)
- (float-vector-set! v i ,(copy form)))))
+ (float-vector-set! v i ,form))))
(define (tester-2)
(let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (z 0.1) (k 1))
(set! *output* (make-float-vector 10))
(do ((i 0 (+ i 1))) ((= i 10) *output*)
- (outa i ,(copy form)))))
+ (outa i ,form))))
(define (tester-3)
(let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (z 0.1) (k 1))
(set! *output* (make-float-vector 10))
(do ((i 0 (+ i 1))) ((= i 10) *output*)
- (out-any i ,(copy form) 0))))
+ (out-any i ,form 0))))
(define (tester-4)
(let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (k 1) (z 0.1))
(do ((i 0 (+ i 1)) (lst ())) ((= i 10) (apply float-vector (reverse! lst)))
- (set! lst (cons ,(copy form) lst)))))
+ (set! lst (cons ,form lst)))))
(define (tester-5)
(let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (y -0.5) (k 1) (z 0.1) (v (make-float-vector 10)))
(set! *output* (make-sample->file "test.snd" 1 mus-ldouble mus-next "t816"))
(do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 10))
- (outa i ,(copy form)))
+ (outa i ,form))
(mus-close *output*)
(file->array "test.snd" 0 0 10 v)))
(define (tester-6)
(let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (k 1) (v (make-float-vector 10)))
(do ((i 0 (+ i 1)) (y -0.5) (z 0.1) (x 0.0 (+ x 0.1))) ((= i 10) v)
- (set! (v i) ,(copy form)))))
+ (set! (v i) ,form))))
(define (tester-7)
(let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (k 1) (z 0.1) (v (make-float-vector 10)))
(do ((i 0 (+ i 1))) ((= i 10) v)
- (let ((zz ,(copy form)))
+ (let ((zz ,form))
(float-vector-set! v i (,gen o zz))))))
(define (tester-8)
(let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (z 0.1) (k 1))
(set! *output* (make-float-vector 10))
(do ((i 0 (+ i 1))) ((= i 10) *output*)
- (let ((zz ,(copy form)))
+ (let ((zz ,form))
(outa i (,gen o zz))))))
(define (tester-9)
(let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (z 0.1) (k 1) (v (make-float-vector 10)))
(do ((i 0 (+ i 1))) ((= i 10) v)
- (let ((zz ,(copy form)))
+ (let ((zz ,form))
(float-vector-set! v i (* (env a) (,gen o zz)))))))
(define (tester-10)
(let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (z 0.1) (k 1))
(set! *output* (make-float-vector 10))
(do ((i 0 (+ i 1))) ((= i 10) *output*)
- (let ((zz ,(copy form)))
+ (let ((zz ,form))
(outa i (* (env a) (,gen o zz)))))))
(define (tester-11)
(let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (y -0.5) (z 0.1) (k 1) (v (make-float-vector 10)))
(do ((i 0 (+ i 1))) ((= i 10) v)
(let ((x (,gen o)))
- (float-vector-set! v i ,(copy form))))))
+ (float-vector-set! v i ,form)))))
(define (tester-12)
(let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (y -0.5) (z 0.1) (k 1))
(set! *output* (make-float-vector 10))
(do ((i 0 (+ i 1))) ((= i 10) *output*)
(let ((x (,gen o)))
- (outa i ,(copy form))))))
+ (outa i ,form)))))
(if (= args 1)
(checkout-1 ',form V (tester-1) (tester-2) (tester-3) (tester-4) (tester-5) (tester-6) (tester-11) (tester-12))
@@ -438,7 +437,6 @@
(tester-1) (tester-2) (tester-3) (tester-4) (tester-5) (tester-6)
(tester-7) (tester-8) (tester-9) (tester-10) (tester-11) (tester-12))
))))
-
(define the-body (apply lambda () (list (copy body :readable))))
(the-body))))
@@ -707,5 +705,7 @@
)
;(gc)
+
(s7-version)
(exit)
+
diff --git a/tools/thash.scm b/tools/thash.scm
index fa01de5..bf2610f 100644
--- a/tools/thash.scm
+++ b/tools/thash.scm
@@ -4,10 +4,7 @@
(define-constant symbols (make-vector 1000000))
(define-constant strings (make-vector 1000000))
-(define (test-hash size)
-
- (format *stderr* "~D " size)
-
+(define (test1 size)
(let ((int-hash (make-hash-table size))
(p (cons #f #f)))
(do ((i 0 (+ i 1)))
@@ -21,8 +18,9 @@
(if (not (= (car key&value) (cdr key&value)))
(display "oops"))) ;(format *stderr* "hash iter ~A~%" key&value)))
(make-iterator int-hash p))
- (fill! int-hash #f))
+ (fill! int-hash #f)))
+(define (test2 size)
(let ((int-hash (make-hash-table size =)))
(do ((i 0 (+ i 1)))
((= i size))
@@ -31,9 +29,9 @@
((= i size))
(if (not (= (hash-table-ref int-hash i) i))
(display "oops")))
- (fill! int-hash #f))
-
+ (fill! int-hash #f)))
+(define (test3 size)
(let ((flt-hash (make-hash-table size)))
(do ((i 0 (+ i 1)))
((= i size))
@@ -42,9 +40,9 @@
((= i size))
(if (not (= (hash-table-ref flt-hash (* 2.0 i)) i))
(display "oops")))
- (fill! flt-hash #f))
-
+ (fill! flt-hash #f)))
+(define (test4 size)
(let ((sym-hash (make-hash-table size)))
(do ((i 0 (+ i 1)))
((= i size))
@@ -53,9 +51,9 @@
((= i size))
(if (not (= (hash-table-ref sym-hash (vector-ref symbols i)) i))
(display "oops")))
- (fill! sym-hash #f))
-
+ (fill! sym-hash #f)))
+(define (test5 size)
(let ((str-hash (make-hash-table size eq?)))
(do ((i 0 (+ i 1)))
((= i size))
@@ -64,9 +62,9 @@
((= i size))
(if (not (= (hash-table-ref str-hash (vector-ref strings i)) i))
(display "oops")))
- (fill! str-hash #f))
-
+ (fill! str-hash #f)))
+(define (test6 size)
(let ((sym-hash (make-hash-table size eq?)))
(do ((i 0 (+ i 1)))
((= i size))
@@ -75,9 +73,9 @@
((= i size))
(if (not (= (hash-table-ref sym-hash (vector-ref symbols i)) i))
(display "oops")))
- (fill! sym-hash #f))
-
+ (fill! sym-hash #f)))
+(define (test7 size)
(let ((chr-hash (make-hash-table 256)))
(do ((i 0 (+ i 1)))
((= i 256))
@@ -86,9 +84,9 @@
((= i 256))
(if (not (= (hash-table-ref chr-hash (integer->char i)) i))
(display "oops")))
- (fill! chr-hash #f))
-
+ (fill! chr-hash #f)))
+(define (test8 size)
(let ((any-hash (make-hash-table size eq?)))
(if (= size 1)
(hash-table-set! any-hash (vector-set! strings 0 (list 0)) 0)
@@ -101,9 +99,9 @@
((= i size))
(if (not (= i (hash-table-ref any-hash (vector-ref strings i))))
(display "oops")))
- (fill! any-hash #f))
-
+ (fill! any-hash #f)))
+(define (test9 size)
(let ((any-hash1 (make-hash-table size eq?)))
(if (= size 1)
(hash-table-set! any-hash1 (vector-set! strings 0 (inlet :a 0)) 0)
@@ -118,9 +116,9 @@
(if (not (= i (hash-table-ref any-hash1 (vector-ref strings i))))
(display "oops")))
(vector-fill! strings #f)
- (fill! any-hash1 #f))
-
+ (fill! any-hash1 #f)))
+(define (test10 size)
(let ((cmp-hash (make-hash-table size)))
(do ((i 0 (+ i 1)))
((= i size))
@@ -129,22 +127,29 @@
((= i size))
(if (not (= (hash-table-ref cmp-hash (complex i i)) i))
(display "oops")))
- (fill! cmp-hash #f))
-
- )
+ (fill! cmp-hash #f)))
+(define (test-hash size)
+ (format *stderr* "~D " size)
+ (test1 size)
+ (test2 size)
+ (test3 size)
+ (test4 size)
+ (test5 size)
+ (test6 size)
+ (test7 size)
+ (test8 size)
+ (test9 size)
+ (test10 size))
(for-each test-hash (list 1 10 100 1000 10000 100000 1000000))
;;; ----------------------------------------
-(format *stderr* "reader~%")
-
-(define data "/home/bil/test/bench/src/bib")
-(define counts (make-hash-table (expt 2 18) string=?))
(define (reader)
- (let ((port (open-input-file data))
- (new-pos 0))
+ (let ((port (open-input-file "/home/bil/test/scheme/bench/src/bib"))
+ (new-pos 0)
+ (counts (make-hash-table)))
(do ((line (read-line port) (read-line port)))
((eof-object? line))
(set! new-pos 0)
@@ -160,25 +165,26 @@
(char-alphabetic? (string-ref line k)))
(+ k 1)))))
(when (> end start)
- (let ((word (substring line start end)))
+ (let ((word (string->symbol (substring line start end))))
(let ((refs (or (hash-table-ref counts word) 0)))
(hash-table-set! counts word (+ refs 1)))))))
(set! new-pos (+ pos 1))))
-
+
(close-input-port port)
- (sort! (copy counts (make-vector (hash-table-entries counts)))
+ (sort! (copy counts (make-vector (hash-table-entries counts)))
(lambda (a b) (> (cdr a) (cdr b))))))
-(set! counts (reader))
+(format *stderr* "reader~%")
-(if (not (and (string=? (car (counts 0)) "the")
- (= (cdr (counts 0)) 62063)))
- (do ((i 0 (+ i 1)))
- ((= i 40))
- (format *stderr* "~A: ~A~%" (car (counts i)) (cdr (counts i)))))
+(let ((counts (reader)))
+ (if (not (and (eq? (car (counts 0)) 'the)
+ (= (cdr (counts 0)) 62063)))
+ (do ((i 0 (+ i 1)))
+ ((= i 40))
+ (format *stderr* "~A: ~A~%" (car (counts i)) (cdr (counts i))))))
;;; ----------------------------------------
;(gc)
-(s7-version)
+(s7-version)
(exit)
diff --git a/tools/titer.scm b/tools/titer.scm
index d462277..61167ce 100644
--- a/tools/titer.scm
+++ b/tools/titer.scm
@@ -52,7 +52,7 @@
(find-if-b (make-iterator vc))
(find-if-c (make-iterator vc))
(find-if-d (make-iterator vc)))))
- (d (let ((fv (make-float-vector size 0.0)))
+ (d (let ((fv (make-float-vector size 1.0)))
(list (find-if-a (make-iterator fv))
(find-if-b (make-iterator fv))
(find-if-c (make-iterator fv))
@@ -99,3 +99,4 @@
(s7-version)
(exit)
+
diff --git a/tools/tmap.scm b/tools/tmap.scm
index b75e2fd..f226910 100644
--- a/tools/tmap.scm
+++ b/tools/tmap.scm
@@ -1,14 +1,14 @@
;;; sequence tests
(define (less-than a b)
- (or (< a b) #f))
+ (or (< a b) (> b a)))
(define (less-than-2 a b)
(if (not (real? a)) (display "oops"))
(cond ((< a b) #t) (#t #f)))
(define (char-less-than a b)
- (cond ((char<? a b) #t) (#t #f)))
+ (cond ((char<? a b) #t) (else #f)))
(define (fv-tst len)
@@ -194,7 +194,7 @@
((null? p))
(set-car! p (- (random 100000) 50000)))
(let ((fv-ran (copy fv)))
- (sort! fv <)
+ (set! fv (sort! fv <))
(call-with-exit
(lambda (quit)
(do ((p0 fv (cdr p0))
@@ -204,7 +204,7 @@
(when (> (car p0) (car p1))
(format *stderr* "list: ~A > ~A at ~D~%" (car p0) (car p1) i)
(quit)))))
- (sort! fv-ran (lambda (a b) (< a b)))
+ (set! fv-ran (sort! fv-ran (lambda (a b) (< a b))))
(if (not (equal? fv fv-ran))
(format *stderr* "pair closure not equal~%")))
@@ -316,4 +316,5 @@
-;;; unsafe, strings, precheck types in vect cases
\ No newline at end of file
+
+;;; unsafe, strings, precheck types in vect cases
diff --git a/tools/valcall.scm b/tools/valcall.scm
index 12ec688..a743f5f 100644
--- a/tools/valcall.scm
+++ b/tools/valcall.scm
@@ -1,16 +1,22 @@
-(define file-names '(("teq.scm" . "v-eq")
- ("titer.scm" . "v-iter")
- ("tmap.scm" . "v-map")
- ("tform.scm" . "v-form")
- ("thash.scm" . "v-hash")
+(define file-names '(("make-index.scm" . "v-index")
+ ("tmac.scm" . "v-mac")
+ ("teq.scm" . "v-eq")
+ ("tfft.scm" . "v-fft")
+ ("tref.scm" . "v-ref")
+ ("tlet.scm" . "v-let")
+ ("tauto.scm" . "v-auto")
+ ("s7test.scm" . "v-test")
("tcopy.scm" . "v-cop")
+ ("lt.scm" . "v-lt")
+ ("tform.scm" . "v-form")
+ ("tmap.scm" . "v-map")
;("lg.scm" . "v-lg")
+ ("titer.scm" . "v-iter")
+ ("tsort.scm" . "v-sort")
+ ("thash.scm" . "v-hash")
("tgen.scm" . "v-gen")
- ("tauto.scm" . "v-auto")
- ("make-index.scm" . "v-index")
- ("snd-test.scm" . "v-call")
("tall.scm" . "v-all")
- ("s7test.scm" . "v-test")
+ ("snd-test.scm" . "v-call")
))
(define (last-callg)
@@ -35,19 +41,32 @@
(lambda (caller+file)
(system "rm callg*")
(format *stderr* "~%~NC~%~NC ~A ~NC~%~NC~%" 40 #\- 16 #\- (cadr caller+file) 16 #\- 40 #\-)
- (system (format #f "valgrind --tool=callgrind ./~A ~A" (car caller+file) (cadr caller+file)))
+ (system (format #f "/home/bil/test/valgrind-3.12.0/vg-in-place --tool=callgrind ./~A ~A" (car caller+file) (cadr caller+file)))
+ ;; new valgrind blathers endlessly -- I made this change:
+ ;; /home/bil/test/valgrind-3.12.0/coregrind/m_syswrap/syswrap-generic.c
+ ;; comment out lines 1333 to 1341
(let ((outfile (cdr (assoc (cadr caller+file) file-names))))
(let ((next (next-file outfile)))
- (system (format #f "callgrind_annotate --auto=yes --threshold=100 ~A > ~A~D" (last-callg) outfile next))
+ (system (format #f "/home/bil/test/valgrind-3.12.0/callgrind/callgrind_annotate --auto=yes --threshold=100 ~A > ~A~D" (last-callg) outfile next))
+ ;; new callgrind blathers endlessly -- I made this change:
+ ;; (line 825) my $space = ' ' x ($CC_col_widths->[$i] - length($count));
+ ;; my $space = ' ' x max($CC_col_widths->[$i] - length($count), 0);
(format *stderr* "~NC ~A~D -> ~A~D: ~NC~%" 8 #\space outfile (- next 1) outfile next 8 #\space)
- (system (format #f "./snd compare-calls.scm -e '(compare-calls \"~A~D\" \"~A~D\")'" outfile (- next 1) outfile next)))))
- (list (list "repl" "teq.scm")
- (list "repl" "s7test.scm")
+ (system (format #f "./snd compare-calls.scm -e '(compare-calls \"~A~D\" \"~A~D\")'" outfile (- next 1) outfile next))))
+ (system (format #f "/home/bil/test/valgrind-3.12.0/vg-in-place ./~A ~A" (car caller+file) (cadr caller+file))))
+ (list (list "repl" "tmac.scm")
(list "snd -noinit" "make-index.scm")
+ (list "repl" "tref.scm")
+ (list "repl" "teq.scm")
+ (list "repl" "s7test.scm")
+ (list "repl" "tlet.scm")
+ (list "repl" "lt.scm")
(list "repl" "tmap.scm")
- (list "repl" "tform.scm")
(list "repl" "tcopy.scm")
(list "repl" "tauto.scm")
+ (list "repl" "tform.scm")
+ (list "repl" "tfft.scm")
+ (list "repl" "tsort.scm")
(list "repl" "titer.scm")
;(list "repl" "lg.scm")
(list "repl" "thash.scm")
@@ -64,4 +83,4 @@
(load "compare-calls.scm")
(combine-latest)
-(exit)
\ No newline at end of file
+(exit)
diff --git a/tools/xgdata.scm b/tools/xgdata.scm
index f414318..8173d4c 100644
--- a/tools/xgdata.scm
+++ b/tools/xgdata.scm
@@ -1638,8 +1638,8 @@
(CCAST "GTK_BOX(obj)" "GtkBox*")
(CCHK "GTK_IS_BOX(obj)" "GtkBox*")
;;;;(CFNC "GType gtk_box_get_type void")
-(CFNC "void gtk_box_pack_start GtkBox* box GtkWidget* child gboolean expand gboolean fill guint padding")
-(CFNC "void gtk_box_pack_end GtkBox* box GtkWidget* child gboolean expand gboolean fill guint padding")
+;;; 3.91.0 (CFNC "void gtk_box_pack_start GtkBox* box GtkWidget* child gboolean expand gboolean fill guint padding")
+;;; 3.91.0 (CFNC "void gtk_box_pack_end GtkBox* box GtkWidget* child gboolean expand gboolean fill guint padding")
;;; out 2.13.5 (CFNC "void gtk_box_pack_start_defaults GtkBox* box GtkWidget* widget")
;;; out 2.13.5 (CFNC "void gtk_box_pack_end_defaults GtkBox* box GtkWidget* widget")
(CFNC "void gtk_box_set_homogeneous GtkBox* box gboolean homogeneous")
@@ -2430,6 +2430,7 @@
;;; (CFNC "void gtk_init int* {argc} char*** |argv|")
;;; (CFNC "gboolean gtk_init_check int* {argc} char*** |argv|")
;;; these two are done by hand in makexg.scm to improve error handling
+;;; both out gtk 4
;(CFNC "void gtk_init_abi_check int* argc char*** argv int num_checks size_t sizeof_GtkWindow")
;(CFNC "gboolean gtk_init_check_abi_check int* argc char*** argv int num_checks size_t sizeof_GtkWindow")
@@ -3344,13 +3345,13 @@
(CFNC "GtkWidget* gtk_toggle_button_new void")
(CFNC "GtkWidget* gtk_toggle_button_new_with_label gchar* label")
(CFNC "GtkWidget* gtk_toggle_button_new_with_mnemonic gchar* label")
-(CFNC "void gtk_toggle_button_set_mode GtkToggleButton* toggle_button gboolean draw_indicator")
-(CFNC "gboolean gtk_toggle_button_get_mode GtkToggleButton* toggle_button")
+;;; gtk 4 (CFNC "void gtk_toggle_button_set_mode GtkToggleButton* toggle_button gboolean draw_indicator")
+;;; gtk 4 (CFNC "gboolean gtk_toggle_button_get_mode GtkToggleButton* toggle_button")
(CFNC "void gtk_toggle_button_set_active GtkToggleButton* toggle_button gboolean is_active")
(CFNC "gboolean gtk_toggle_button_get_active GtkToggleButton* toggle_button")
(CFNC "void gtk_toggle_button_toggled GtkToggleButton* toggle_button")
-(CFNC "void gtk_toggle_button_set_inconsistent GtkToggleButton* toggle_button gboolean setting")
-(CFNC "gboolean gtk_toggle_button_get_inconsistent GtkToggleButton* toggle_button")
+;;; gtk 4 (CFNC "void gtk_toggle_button_set_inconsistent GtkToggleButton* toggle_button gboolean setting")
+;;; gtk 4 (CFNC "gboolean gtk_toggle_button_get_inconsistent GtkToggleButton* toggle_button")
(CCAST "GTK_TOOLBAR(obj)" "GtkToolbar*")
(CCHK "GTK_IS_TOOLBAR(obj)" "GtkToolbar*")
;;; out 2.3 (CINT "GTK_TOOLBAR_CHILD_SPACE" "GtkToolbarChildType")
@@ -3633,7 +3634,7 @@
(CFNC "gboolean gtk_tree_view_get_reorderable GtkTreeView* tree_view")
(CFNC "void gtk_tree_view_set_cursor GtkTreeView* tree_view GtkTreePath* path GtkTreeViewColumn* focus_column gboolean start_editing")
(CFNC "void gtk_tree_view_get_cursor GtkTreeView* tree_view GtkTreePath** [path] GtkTreeViewColumn** [focus_column]")
-(CFNC "GdkWindow* gtk_tree_view_get_bin_window GtkTreeView* tree_view")
+;;; gtk 4 (CFNC "GdkWindow* gtk_tree_view_get_bin_window GtkTreeView* tree_view")
(CFNC "gboolean gtk_tree_view_get_path_at_pos GtkTreeView* tree_view gint x gint y GtkTreePath** [path] GtkTreeViewColumn** [column] gint* [cell_x] gint* [cell_y]")
(CFNC "void gtk_tree_view_get_cell_area GtkTreeView* tree_view GtkTreePath* @path GtkTreeViewColumn* @column GdkRectangle* rect")
(CFNC "void gtk_tree_view_get_background_area GtkTreeView* tree_view GtkTreePath* @path GtkTreeViewColumn* @column GdkRectangle* rect")
@@ -3775,7 +3776,7 @@
(CFNC "void gtk_widget_show GtkWidget* widget")
(CFNC "void gtk_widget_show_now GtkWidget* widget")
(CFNC "void gtk_widget_hide GtkWidget* widget")
-(CFNC "void gtk_widget_show_all GtkWidget* widget")
+;;; gtk 4 (CFNC "void gtk_widget_show_all GtkWidget* widget")
;;; (CFNC-gtk2 "void gtk_widget_hide_all GtkWidget* widget")
(CFNC "void gtk_widget_map GtkWidget* widget")
(CFNC "void gtk_widget_unmap GtkWidget* widget")
@@ -3885,7 +3886,7 @@
;(CFNC "void gtk_decorated_window_move_resize_window GtkWindow* window gint x gint y gint width gint height")
(CFNC "gboolean gtk_widget_can_activate_accel GtkWidget* widget guint signal_id")
(CFNC "gboolean gtk_window_is_active GtkWindow* window")
-(CFNC "gboolean gtk_window_has_toplevel_focus GtkWindow* window")
+;;; 3.90.0 (CFNC "gboolean gtk_window_has_toplevel_focus GtkWindow* window")
(CCAST "GTK_WINDOW(obj)" "GtkWindow*")
(CCHK "GTK_IS_WINDOW(obj)" "GtkWindow*")
;;;;(CFNC "GType gtk_window_get_type void")
@@ -4642,8 +4643,8 @@
;;;(CFNC "void gtk_toolbar_unhighlight_drop_location GtkToolbar* toolbar")
(CFNC "void gtk_tree_view_column_set_expand GtkTreeViewColumn* tree_column gboolean expand")
(CFNC "gboolean gtk_tree_view_column_get_expand GtkTreeViewColumn* tree_column")
-(CFNC "void gtk_widget_set_no_show_all GtkWidget* widget gboolean no_show_all")
-(CFNC "gboolean gtk_widget_get_no_show_all GtkWidget* widget")
+;;; gtk 4 (CFNC "void gtk_widget_set_no_show_all GtkWidget* widget gboolean no_show_all")
+;;; gtk 4 (CFNC "gboolean gtk_widget_get_no_show_all GtkWidget* widget")
(CFNC "void gtk_widget_queue_resize_no_redraw GtkWidget* widget")
(CFNC "void gtk_window_set_default_icon GdkPixbuf* icon")
(CFNC "void gtk_window_set_keep_above GtkWindow* window gboolean setting")
@@ -5511,8 +5512,8 @@
;;; 3.89 (CFNC "void gtk_button_set_image GtkButton* button GtkWidget* image")
;;; 3.89 (CFNC "GtkWidget* gtk_button_get_image GtkButton* button")
;;; 3.12? (CFNC "void gtk_dialog_set_alternative_button_order_from_array GtkDialog* dialog gint n_params gint* new_order")
-(CFNC "void gtk_label_set_angle GtkLabel* label gdouble angle")
-(CFNC "gdouble gtk_label_get_angle GtkLabel* label")
+;;; 3.91.0 (CFNC "void gtk_label_set_angle GtkLabel* label gdouble angle")
+;;; 3.91.0 (CFNC "gdouble gtk_label_get_angle GtkLabel* label")
;;; missed earlier somehow
(CFNC "void gtk_menu_set_screen GtkMenu* menu GdkScreen* @screen")
@@ -6906,7 +6907,7 @@
(CFNC-2.14 "gboolean gtk_accel_group_get_is_locked GtkAccelGroup* accel_group")
;;; 3.3.16 (CFNC-2.14 "GtkWidget* gtk_color_selection_dialog_get_color_selection GtkColorSelectionDialog* colorsel")
-(CFNC-2.14 "GtkWidget* gtk_container_get_focus_child GtkContainer* container")
+;;; 3.90.0 (CFNC-2.14 "GtkWidget* gtk_container_get_focus_child GtkContainer* container")
;;; 3.12? (CFNC-2.14 "GtkWidget* gtk_dialog_get_action_area GtkDialog* dialog")
(CFNC-2.14 "GtkWidget* gtk_dialog_get_content_area GtkDialog* dialog")
(CFNC-2.14 "void gtk_entry_set_overwrite_mode GtkEntry* entry gboolean overwrite")
@@ -7220,7 +7221,7 @@
;;; 2.19.0
(CFNC-2.20 "GtkWidget* gtk_dialog_get_widget_for_response GtkDialog* dialog gint response_id")
;;; (CFNC-2.20 "void gtk_tooltip_set_icon_from_gicon GtkTooltip* tooltip GIcon* gicon GtkIconSize size")
-(CFNC-2.20 "GdkWindow* gtk_viewport_get_bin_window GtkViewport* viewport")
+;;; gtk 4 (CFNC-2.20 "GdkWindow* gtk_viewport_get_bin_window GtkViewport* viewport")
(CFNC-2.20 "GtkWidget* gtk_spinner_new void")
(CFNC-2.20 "void gtk_spinner_start GtkSpinner* spinner")
(CFNC-2.20 "void gtk_spinner_stop GtkSpinner* spinner")
@@ -7399,7 +7400,7 @@
(CFNC-3.0 "void gtk_calendar_mark_day GtkCalendar* calendar guint day")
(CFNC-3.0 "void gtk_calendar_unmark_day GtkCalendar* calendar guint day")
(CFNC-3.0 "GdkWindow* gdk_drag_context_get_source_window GdkDragContext* context")
-(CFNC-3.0 "GdkWindow* gtk_viewport_get_view_window GtkViewport* viewport")
+;;; gtk 4 (CFNC-3.0 "GdkWindow* gtk_viewport_get_view_window GtkViewport* viewport")
;;; 2.90.4
;;; 2.90.6 (CFNC-3.0 "gpointer gdk_image_get_pixels GdkImage* image")
@@ -7639,10 +7640,10 @@
(CFNC-3.0 "gchar* gtk_notebook_get_group_name GtkNotebook* notebook" 'const-return)
(CFNC-3.0 "void gtk_widget_draw GtkWidget* widget cairo_t* cr")
(CFNC-3.0 "GtkSizeRequestMode gtk_widget_get_request_mode GtkWidget* widget")
-(CFNC-3.0 "void gtk_widget_get_preferred_width GtkWidget* widget gint* [minimum_width] gint* [natural_width]")
-(CFNC-3.0 "void gtk_widget_get_preferred_height_for_width GtkWidget* widget gint width gint* [minimum_height] gint* [natural_height]")
-(CFNC-3.0 "void gtk_widget_get_preferred_height GtkWidget* widget gint* [minimum_height] gint* [natural_height]")
-(CFNC-3.0 "void gtk_widget_get_preferred_width_for_height GtkWidget* widget gint height gint* [minimum_width] gint* [natural_width]")
+;;; 3.91.0 (CFNC-3.0 "void gtk_widget_get_preferred_width GtkWidget* widget gint* [minimum_width] gint* [natural_width]")
+;;; 3.91.0 (CFNC-3.0 "void gtk_widget_get_preferred_height_for_width GtkWidget* widget gint width gint* [minimum_height] gint* [natural_height]")
+;;; 3.91.0 (CFNC-3.0 "void gtk_widget_get_preferred_height GtkWidget* widget gint* [minimum_height] gint* [natural_height]")
+;;; 3.91.0 (CFNC-3.0 "void gtk_widget_get_preferred_width_for_height GtkWidget* widget gint height gint* [minimum_width] gint* [natural_width]")
;(CFNC-3.0 "void gtk_widget_get_preferred_size GtkWidget* widget GtkRequisition* [minimum_size] GtkRequisition* [natural_size]")
(CFNC-3.0 "int gtk_widget_get_allocated_width GtkWidget* widget")
(CFNC-3.0 "int gtk_widget_get_allocated_height GtkWidget* widget")
@@ -7914,7 +7915,7 @@
(CFNC-3.0 "void gtk_tooltip_trigger_tooltip_query GdkDisplay* display")
;;; 3.89 (CFNC-3.0 "void gtk_button_set_image_position GtkButton* button GtkPositionType position")
;;; 3.89 (CFNC-3.0 "GtkPositionType gtk_button_get_image_position GtkButton* button")
-(CFNC-3.0 "gboolean gtk_show_uri GdkScreen* screen gchar* uri guint32 timestamp GError** [error]" 'const)
+;;; 3.89 (CFNC-3.0 "gboolean gtk_show_uri GdkScreen* screen gchar* uri guint32 timestamp GError** [error]" 'const)
(CFNC-3.0 "GtkTreeViewColumn* gtk_tree_view_column_new_with_area GtkCellArea* area")
(CFNC-3.0 "GtkWidget* gtk_tree_view_column_get_button GtkTreeViewColumn* tree_column")
(CFNC-3.0 "void gtk_tree_view_column_focus_cell GtkTreeViewColumn* tree_column GtkCellRenderer* cell")
@@ -7933,7 +7934,7 @@
(CFNC-3.0 "void gtk_orientable_set_orientation GtkOrientable* orientable GtkOrientation orientation")
(CFNC-3.0 "GtkOrientation gtk_orientable_get_orientation GtkOrientable* orientable")
-(CFNC-3.0 "void gtk_parse_args int* {argc} char*** |argv|")
+;;; gtk 4 (CFNC-3.0 "void gtk_parse_args int* {argc} char*** |argv|")
(CFNC-3.0 "guint gtk_get_major_version void" 'const-return)
(CFNC-3.0 "guint gtk_get_minor_version void" 'const-return)
(CFNC-3.0 "guint gtk_get_micro_version void" 'const-return)
@@ -7967,7 +7968,7 @@
(CFNC-3.0 "gboolean gtk_container_get_focus_chain GtkContainer* container GList** [focusable_widgets]")
(CFNC-3.0 "void gtk_container_unset_focus_chain GtkContainer* container")
;;; 3.13.2 (CFNC-3.0 "void gtk_container_set_reallocate_redraws GtkContainer* container gboolean needs_redraws")
-(CFNC-3.0 "void gtk_container_set_focus_child GtkContainer* container GtkWidget* child")
+;;; 3.90.0 (CFNC-3.0 "void gtk_container_set_focus_child GtkContainer* container GtkWidget* child")
(CFNC-3.0 "void gtk_container_set_focus_vadjustment GtkContainer* container GtkAdjustment* adjustment")
(CFNC-3.0 "GtkAdjustment* gtk_container_get_focus_vadjustment GtkContainer* container")
(CFNC-3.0 "void gtk_container_set_focus_hadjustment GtkContainer* container GtkAdjustment* adjustment")
@@ -8092,8 +8093,8 @@
(CFNC-3.0 "void gtk_cell_view_set_draw_sensitive GtkCellView* cell_view gboolean draw_sensitive")
(CFNC-3.0 "gboolean gtk_cell_view_get_fit_model GtkCellView* cell_view")
(CFNC-3.0 "void gtk_cell_view_set_fit_model GtkCellView* cell_view gboolean fit_model")
-(CFNC-3.0 "GtkWidget* gtk_combo_box_new_with_area GtkCellArea* area")
-(CFNC-3.0 "GtkWidget* gtk_combo_box_new_with_area_and_entry GtkCellArea* area")
+;;; gtk 4 (CFNC-3.0 "GtkWidget* gtk_combo_box_new_with_area GtkCellArea* area")
+;;; gtk 4 (CFNC-3.0 "GtkWidget* gtk_combo_box_new_with_area_and_entry GtkCellArea* area")
(CFNC-3.0 "GtkWidget* gtk_icon_view_new_with_area GtkCellArea* area")
(CFNC-3.0 "void gtk_menu_item_set_reserve_indicator GtkMenuItem* menu_item gboolean reserve")
(CFNC-3.0 "gboolean gtk_menu_item_get_reserve_indicator GtkMenuItem* menu_item")
@@ -8306,8 +8307,8 @@
(CFNC-3.4 "gchar* gtk_entry_completion_compute_prefix GtkEntryCompletion* completion char* key" 'const)
(CFNC-3.4 "void gtk_scale_set_has_origin GtkScale* scale gboolean has_origin")
(CFNC-3.4 "gboolean gtk_scale_get_has_origin GtkScale* scale")
-(CFNC-3.4 "void gtk_window_set_hide_titlebar_when_maximized GtkWindow* window gboolean setting")
-(CFNC-3.4 "gboolean gtk_window_get_hide_titlebar_when_maximized GtkWindow* window")
+;;; 3.91.0 (CFNC-3.4 "void gtk_window_set_hide_titlebar_when_maximized GtkWindow* window gboolean setting")
+;;; 3.91.0 (CFNC-3.4 "gboolean gtk_window_get_hide_titlebar_when_maximized GtkWindow* window")
(CFNC-3.4 "GtkWidget* gtk_application_window_new GtkApplication* application")
(CFNC-3.4 "void gtk_application_window_set_show_menubar GtkApplicationWindow* window gboolean show_menubar")
(CFNC-3.4 "gboolean gtk_application_window_get_show_menubar GtkApplicationWindow* window")
@@ -8536,7 +8537,7 @@
;;; 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")
-(CFNC-3.10 "GtkAlign gtk_widget_get_valign_with_baseline GtkWidget* widget")
+;;; 3.89.5 (CFNC-3.10 "GtkAlign gtk_widget_get_valign_with_baseline GtkWidget* widget")
(CFNC-3.10 "void gtk_widget_init_template GtkWidget* widget")
;;; (CFNC-3.10 "GObject* gtk_widget_get_automated_child GtkWidget* widget GType widget_type gchar* name" 'const)
;;; GObject* is apparently the problem here
@@ -8860,8 +8861,8 @@
;;; 3.11.6
;;; gtkmodelbutton.h
-(CFNC-3.12 "void gtk_box_set_center_widget GtkBox* box GtkWidget* widget")
-(CFNC-3.12 "GtkWidget* gtk_box_get_center_widget GtkBox* box")
+;;; 3.91.0 (CFNC-3.12 "void gtk_box_set_center_widget GtkBox* box GtkWidget* widget")
+;;; 3.91.0 (CFNC-3.12 "GtkWidget* gtk_box_get_center_widget GtkBox* box")
(CFNC-3.12 "void gtk_entry_set_max_width_chars GtkEntry* entry gint n_chars")
(CFNC-3.12 "gint gtk_entry_get_max_width_chars GtkEntry* entry")
@@ -9518,6 +9519,8 @@
;;; 3.22.2: nothing new (many deprecations)
;;; 3.22.3: same
;;; 3.22.4: no changes
+;;; 3.89 changed type? (CFNC-3.22 "gboolean gtk_show_uri_on_window GdkWindow* parent char* uri guint32 timestamp GError** [error]" 'const)
+;;; 3.22 reports gtk_show_uri is deprecated, but it isn't??
;;; 3.89.1:
@@ -9551,4 +9554,39 @@
(CFNC-3.99 "GdkDrawingContext* gdk_window_begin_draw_frame GdkWindow* window GdkDrawContext* context cairo_region_t* region")
(CFNC-3.99 "GtkFlowBoxChild* gtk_flow_box_get_child_at_pos GtkFlowBox* box gint x gint y")
-
+;;; 3.89.4
+
+;; widget_show_all gone
+
+(CFNC-3.99 "gchar* gtk_about_dialog_get_system_information GtkAboutDialog* about" 'const-return)
+(CFNC-3.99 "void gtk_about_dialog_set_system_information GtkAboutDialog* about gchar* system_information" 'const)
+(CFNC-3.99 "void gtk_action_bar_set_revealed GtkActionBar* action_bar gboolean revealed")
+(CFNC-3.99 "gboolean gtk_action_bar_get_revealed GtkActionBar* action_bar")
+(CFNC-3.99 "void gtk_check_button_set_draw_indicator GtkCheckButton* check_button gboolean draw_indicator")
+(CFNC-3.99 "gboolean gtk_check_button_get_draw_indicator GtkCheckButton* check_button")
+(CFNC-3.99 "void gtk_check_button_set_inconsistent GtkCheckButton* check_button gboolean inconsistent")
+(CFNC-3.99 "gboolean gtk_check_button_get_inconsistent GtkCheckButton* check_button")
+(CFNC-3.99 "void gtk_info_bar_set_revealed GtkInfoBar* info_bar gboolean revealed")
+(CFNC-3.99 "gboolean gtk_info_bar_get_revealed GtkInfoBar* info_bar")
+;(CFNC-3.99 "void gtk_init void")
+;(CFNC-3.99 "gboolean gtk_init_check void")
+;handled in makexg.scm
+(CFNC-3.99 "GtkWidget* gtk_widget_get_first_child GtkWidget* widget")
+(CFNC-3.99 "GtkWidget* gtk_widget_get_last_child GtkWidget* widget")
+(CFNC-3.99 "GtkWidget* gtk_widget_get_next_sibling GtkWidget* widget")
+(CFNC-3.99 "GtkWidget* gtk_widget_get_prev_sibling GtkWidget* widget")
+(CFNC-3.99 "void gtk_widget_set_focus_child GtkWidget* widget GtkWidget* child")
+;(CFNC-3.99 "void gtk_widget_snapshot_child GtkWidget* widget GtkWidget* child GtkSnapshot* snapshot")
+
+;;; 3.89.5
+
+(CFNC-3.99 "gboolean gtk_show_uri_on_window GtkWindow* parent char* uri guint32 timestamp GError** [error]" 'const)
+
+;;; 3.90.0
+;;; 3.91.0
+
+(CFNC-3.99 "void gtk_box_pack_start GtkBox* box GtkWidget* child")
+(CFNC-3.99 "void gtk_box_pack_end GtkBox* box GtkWidget* child")
+(CFNC-3.99 "void gtk_widget_insert_after GtkWidget* widget GtkWidget* parent GtkWidget* previous_sibling")
+(CFNC-3.99 "void gtk_widget_insert_before GtkWidget* widget GtkWidget* parent GtkWidget* next_sibling")
+
diff --git a/vct.c b/vct.c
index 3596e27..7ffc870 100644
--- a/vct.c
+++ b/vct.c
@@ -78,6 +78,7 @@ mus_float_t *mus_vct_data(vct *v) {return(v->data);}
#endif
#if HAVE_SCHEME
+
#define S_make_vct "make-float-vector"
#define S_vct_add "float-vector-add!"
#define S_vct_subtract "float-vector-subtract!"
@@ -442,7 +443,7 @@ static Xen g_vct_copy(Xen obj)
if (len > 0)
{
copied_data = (mus_float_t *)malloc(len * sizeof(mus_float_t));
- memcpy((void *)copied_data, (void *)(mus_vct_data(v)), (len * sizeof(mus_float_t)));
+ copy_floats(copied_data, mus_vct_data(v), len);
}
return(xen_make_vct(len, copied_data));
}
@@ -758,7 +759,7 @@ static Xen g_vct_equal(Xen uv1, Xen uv2, Xen udiff)
static void vct_scale(mus_float_t *d, mus_float_t scl, mus_long_t len)
{
if (scl == 0.0)
- memset((void *)d, 0, len * sizeof(mus_float_t));
+ clear_floats(d, len);
else
{
if (scl != 1.0)
@@ -896,7 +897,7 @@ static Xen g_vct_fill(Xen obj1, Xen obj2)
scl = Xen_real_to_C_double(obj2);
if (scl == 0.0)
- memset((void *)d, 0, mus_vct_length(v1) * sizeof(mus_float_t));
+ clear_floats(d, mus_vct_length(v1));
else
{
mus_long_t lim8;
@@ -1212,6 +1213,13 @@ static mus_float_t vct_max(mus_float_t *d, mus_long_t len)
return(mx);
}
+#if HAVE_SCHEME
+static s7_double float_vector_max_d_p(s7_pointer v)
+{
+ return(vct_max(s7_float_vector_elements(v), s7_vector_length(v)));
+}
+#endif
+
static Xen g_vct_max(Xen vobj)
{
#define H_vct_max "(" S_vct_max " v): returns the maximum element of " S_vct
@@ -1239,6 +1247,13 @@ static mus_float_t vct_min(mus_float_t *d, mus_long_t len)
return(mx);
}
+#if HAVE_SCHEME
+static s7_double float_vector_min_d_p(s7_pointer v)
+{
+ return(vct_min(s7_float_vector_elements(v), s7_vector_length(v)));
+}
+#endif
+
static Xen g_vct_min(Xen vobj)
{
#define H_vct_min "(" S_vct_min " v): returns the minimum element of " S_vct
@@ -1541,200 +1556,6 @@ vct( 0.5 0.3 0.1 ) .g => #<vct[len=3]: 0.500 0.300 0.100>"
#endif
-#if HAVE_SCHEME
-
-#define PF_TO_RF(CName, Cfnc) \
- static s7_double CName ## _rf_a(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pf_t f; \
- s7_pointer x; \
- f = (s7_pf_t)(**p); (*p)++; \
- x = f(sc, p); \
- return(Cfnc); \
- } \
- static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) \
- { \
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_null(sc, s7_cddr(expr))) && \
- (s7_arg_to_pf(sc, s7_cadr(expr)))) \
- return(CName ## _rf_a); \
- return(NULL); \
- }
-
-static s7_double c_vct_max(s7_scheme *sc, s7_pointer x)
-{
- s7_int len;
- if (!s7_is_float_vector(x)) s7_wrong_type_arg_error(sc, S_vct_max, 1, x, "a float-vector");
- len = s7_vector_length(x);
- if (len == 0) return(0.0);
- return(vct_max(s7_float_vector_elements(x), len));
-}
-
-PF_TO_RF(float_vector_max, c_vct_max(sc, x))
-
-static s7_double c_vct_min(s7_scheme *sc, s7_pointer x)
-{
- s7_int len;
- if (!s7_is_float_vector(x)) s7_wrong_type_arg_error(sc, S_vct_min, 1, x, "a float-vector");
- len = s7_vector_length(x);
- if (len == 0) return(0.0);
- return(vct_min(s7_float_vector_elements(x), len));
-}
-
-PF_TO_RF(float_vector_min, c_vct_min(sc, x))
-
-PF_TO_RF(float_vector_peak, mus_vct_peak(x))
-
-
-
-#define PF2_TO_PF(CName, Cfnc) \
- static s7_pointer CName ## _pf_a(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pf_t f; \
- s7_pointer x, y; \
- f = (s7_pf_t)(**p); (*p)++; \
- x = f(sc, p); \
- f = (s7_pf_t)(**p); (*p)++; \
- y = f(sc, p); \
- return(Cfnc); \
- } \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) \
- { \
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) && \
- (s7_arg_to_pf(sc, s7_cadr(expr))) && \
- (s7_arg_to_pf(sc, s7_caddr(expr)))) \
- return(CName ## _pf_a); \
- return(NULL); \
- }
-
-static s7_pointer c_vct_add(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- s7_int len1, lim;
- if (!s7_is_float_vector(x)) s7_wrong_type_arg_error(sc, S_vct_add, 1, x, "a float-vector");
- if (!s7_is_float_vector(y)) s7_wrong_type_arg_error(sc, S_vct_add, 2, y, "a float-vector");
- len1 = s7_vector_length(x);
- lim = s7_vector_length(y);
- if (lim > len1) lim = len1;
- if (lim == 0) return(x);
- vct_add(s7_float_vector_elements(x), s7_float_vector_elements(y), lim);
- return(x);
-}
-
-PF2_TO_PF(float_vector_add, c_vct_add(sc, x, y))
-
-static s7_pointer c_vct_subtract(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- s7_int i, len1, lim;
- s7_double *fx, *fy;
- if (!s7_is_float_vector(x)) s7_wrong_type_arg_error(sc, S_vct_subtract, 1, x, "a float-vector");
- if (!s7_is_float_vector(y)) s7_wrong_type_arg_error(sc, S_vct_subtract, 2, y, "a float-vector");
- len1 = s7_vector_length(x);
- lim = s7_vector_length(y);
- if (lim > len1) lim = len1;
- if (lim == 0) return(x);
- fx = s7_float_vector_elements(x);
- fy = s7_float_vector_elements(y);
- for (i = 0; i < lim; i++) fx[i] -= fy[i];
- return(x);
-}
-
-PF2_TO_PF(float_vector_subtract, c_vct_subtract(sc, x, y))
-
-static s7_pointer c_vct_multiply(s7_scheme *sc, s7_pointer x, s7_pointer y)
-{
- s7_int i, len1, lim;
- s7_double *fx, *fy;
- if (!s7_is_float_vector(x)) s7_wrong_type_arg_error(sc, S_vct_multiply, 1, x, "a float-vector");
- if (!s7_is_float_vector(y)) s7_wrong_type_arg_error(sc, S_vct_multiply, 2, y, "a float-vector");
- len1 = s7_vector_length(x);
- lim = s7_vector_length(y);
- if (lim > len1) lim = len1;
- if (lim == 0) return(x);
- fx = s7_float_vector_elements(x);
- fy = s7_float_vector_elements(y);
- for (i = 0; i < lim; i++) fx[i] *= fy[i];
- return(x);
-}
-
-PF2_TO_PF(float_vector_multiply, c_vct_multiply(sc, x, y))
-
-#define PRF_TO_PF(CName, Cfnc) \
- static s7_pointer CName ## _pf_a(s7_scheme *sc, s7_pointer **p) \
- { \
- s7_pf_t f; \
- s7_rf_t r; \
- s7_pointer x; \
- s7_double y; \
- f = (s7_pf_t)(**p); (*p)++; \
- x = f(sc, p); \
- r = (s7_rf_t)(**p); (*p)++; \
- y = r(sc, p); \
- return(Cfnc); \
- } \
- static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) \
- { \
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) && \
- (s7_arg_to_pf(sc, s7_cadr(expr))) && \
- (s7_arg_to_rf(sc, s7_caddr(expr)))) \
- return(CName ## _pf_a); \
- return(NULL); \
- }
-
-
-static s7_pointer c_vct_scale(s7_scheme *sc, s7_pointer x, s7_double y)
-{
- s7_int len;
- if (!s7_is_float_vector(x)) s7_wrong_type_arg_error(sc, S_vct_scale, 1, x, "a float-vector");
- len = s7_vector_length(x);
- if (len == 0) return(x);
- vct_scale(s7_float_vector_elements(x), y, len);
- return(x);
-}
-
-PRF_TO_PF(float_vector_scale, c_vct_scale(sc, x, y))
-
-static s7_pointer c_vct_offset(s7_scheme *sc, s7_pointer x, s7_double y)
-{
- s7_int i, len;
- s7_double *fx;
- if (!s7_is_float_vector(x)) s7_wrong_type_arg_error(sc, S_vct_offset, 1, x, "a float-vector");
- len = s7_vector_length(x);
- if (len == 0) return(x);
- fx = s7_float_vector_elements(x);
- for (i = 0; i < len; i++) fx[i] += y;
- return(x);
-}
-
-PRF_TO_PF(float_vector_offset, c_vct_offset(sc, x, y))
-
-
-static s7_pointer vct_abs_pf_a(s7_scheme *sc, s7_pointer **p)
-{
- s7_pf_t f;
- s7_pointer x;
- s7_int i, len;
- s7_double *fx;
-
- f = (s7_pf_t)(**p); (*p)++;
- x = f(sc, p);
- if (!s7_is_float_vector(x)) s7_wrong_type_arg_error(sc, S_vct_abs, 1, x, "a float-vector");
- len = s7_vector_length(x);
- if (len == 0) return(x);
- fx = s7_float_vector_elements(x);
- for (i = 0; i < len; i++) fx[i] = fabs(fx[i]);
- return(x);
-}
-
-static s7_pf_t float_vector_abs_pf(s7_scheme *sc, s7_pointer expr)
-{
- if ((s7_is_pair(s7_cdr(expr))) && (s7_is_null(sc, s7_cddr(expr))) &&
- (s7_arg_to_pf(sc, s7_cadr(expr))))
- return(vct_abs_pf_a); \
- return(NULL);
-}
-#endif
-
-
-
#if (!HAVE_SCHEME)
Xen_wrap_2_optional_args(g_make_vct_w, g_make_vct)
Xen_wrap_2_args(g_vct_fill_w, g_vct_fill)
@@ -1913,15 +1734,7 @@ void mus_vct_init(void)
Xen_define_typed_procedure(S_vct_spatter, g_vct_spatter_w, 4, 0, 0, H_vct_spatter, pl_rfvir);
Xen_define_typed_procedure(S_vct_interpolate, g_vct_interpolate_w, 7, 0, 0, H_vct_interpolate, pl_rfiir);
- s7_pf_set_function(s7_name_to_value(s7, S_vct_add), float_vector_add_pf);
- s7_pf_set_function(s7_name_to_value(s7, S_vct_subtract), float_vector_subtract_pf);
- s7_pf_set_function(s7_name_to_value(s7, S_vct_multiply), float_vector_multiply_pf);
- s7_pf_set_function(s7_name_to_value(s7, S_vct_scale), float_vector_scale_pf);
- s7_pf_set_function(s7_name_to_value(s7, S_vct_offset), float_vector_offset_pf);
- s7_pf_set_function(s7_name_to_value(s7, S_vct_abs), float_vector_abs_pf);
-
- s7_rf_set_function(s7_name_to_value(s7, S_vct_min), float_vector_min_rf);
- s7_rf_set_function(s7_name_to_value(s7, S_vct_max), float_vector_max_rf);
- s7_rf_set_function(s7_name_to_value(s7, S_vct_peak), float_vector_peak_rf);
+ s7_set_d_p_function(s7_name_to_value(s7, S_vct_min), float_vector_min_d_p);
+ s7_set_d_p_function(s7_name_to_value(s7, S_vct_max), float_vector_max_d_p);
#endif
}
diff --git a/write.scm b/write.scm
index 5395524..5f38733 100644
--- a/write.scm
+++ b/write.scm
@@ -14,626 +14,626 @@
(for-each (lambda (arg) (if (not (f arg)) (return #f))) sequence)
#t)))))
- (define pretty-print-1
- (let ((newlines 0))
+ (define pretty-print-1
+ (letrec ((messy-number (lambda (z)
+ (if (real? z)
+ (if (or (nan? z)
+ (infinite? z))
+ (object->string z)
+ (if (= z pi)
+ (copy "pi")
+ (format #f *pretty-print-float-format* z)))
+ (format #f "~A~A~Ai"
+ (messy-number (real-part z))
+ (if (negative? (imag-part z)) "-" "+")
+ (messy-number (abs (imag-part z)))))))
+
+ (any-keyword? (lambda (lst)
+ (and (pair? lst)
+ (or (keyword? (car lst))
+ (any-keyword? (cdr lst)))))))
- (define (spaces port n)
- (set! newlines (+ newlines 1))
- (format port "~%~NC" (+ n *pretty-print-left-margin*) #\space))
-
- (define (stacked-list port lst col)
- (do ((p lst (cdr p))
- (added 0 0))
- ((not (pair? p)))
- (let ((obj (car p)))
- (if (not (eq? p lst))
- (spaces port col))
- (let ((len (length (object->string obj))))
- (if (and (keyword? obj)
- (pair? (cdr p)))
- (begin
- (write obj port)
- (write-char #\space port)
- (set! added (+ 1 len))
- (set! p (cdr p))
- (set! obj (car p)))) ; pair? cdr p above
-
- (cond ((or (hash-table? obj)
- (let? obj))
- (pretty-print-1 obj port col))
-
- ((and (pair? obj)
- (pair? (cdr obj))
- (null? (cddr obj))
- (> len (/ *pretty-print-length* 2)))
- (if (eq? (car obj) 'quote)
- (write-char #\' port)
- (begin
- (write-char #\( port)
- (pretty-print-1 (car obj) port col)
- (spaces port (+ col 1))))
- (pretty-print-1 (cadr obj) port (+ col 1))
- (if (not (eq? (car obj) 'quote))
- (write-char #\) port)))
-
- (else
- (pretty-print-1 obj port (+ col added))))))))
-
- (define (stacked-split-list port lst col)
- (if (not (pair? lst))
- (write lst port)
- (do ((p lst (cdr p)))
- ((not (pair? p)))
- (if (not (eq? p lst)) (spaces port col))
- (if (pair? (car p))
- (begin
- (format port "(~S " (caar p))
- (if (and (pair? (cdar p))
- (symbol? (caar p)))
- (pretty-print-1 (cadar p) port (+ col (length (symbol->string (caar p))) 2))
- (write (cdar p) port))
- (write-char #\) port))
- (write (car p) port))))) ; pretty-print? (it's always a symbol)
-
- (define (messy-number z)
- (if (real? z)
- (if (or (nan? z)
- (infinite? z))
- (object->string z)
- (if (= z pi)
- (copy "pi")
- (format #f *pretty-print-float-format* z)))
- (format #f "~A~A~Ai"
- (messy-number (real-part z))
- (if (negative? (imag-part z)) "-" "+")
- (messy-number (abs (imag-part z))))))
-
- (define (any-keyword? lst)
- (and (pair? lst)
- (or (keyword? (car lst))
- (any-keyword? (cdr lst)))))
-
- (let ((writers
- (let ((h (make-hash-table)))
-
- ;; -------- quote
- (define (w-quote obj port column)
- (if (not (pair? (cdr obj))) ; (quote) or (quote . 1)
- (write obj port)
- (begin
- (write-char #\' port)
- (pretty-print-1 (cadr obj) port column))))
- (hash-table-set! h 'quote w-quote)
-
- ;; -------- define
- (define (w-define obj port column)
- (if (not (pair? (cdr obj)))
- (write obj port)
- (begin
- (format port "(~A ~A " (car obj) (cadr obj))
- (if (pair? (cadr obj))
+ (let ((newlines 0))
+
+ (define (spaces port n)
+ (set! newlines (+ newlines 1))
+ (format port "~%~NC" (+ n *pretty-print-left-margin*) #\space))
+
+ (define (stacked-list port lst col)
+ (do ((p lst (cdr p))
+ (added 0 0))
+ ((not (pair? p)))
+ (let ((obj (car p)))
+ (if (not (eq? p lst))
+ (spaces port col))
+ (let ((len (length (object->string obj))))
+ (if (and (keyword? obj)
+ (pair? (cdr p)))
+ (begin
+ (write obj port)
+ (write-char #\space port)
+ (set! added (+ 1 len))
+ (set! p (cdr p))
+ (set! obj (car p)))) ; pair? cdr p above
+
+ (cond ((or (hash-table? obj)
+ (let? obj))
+ (pretty-print-1 obj port col))
+
+ ((and (pair? obj)
+ (pair? (cdr obj))
+ (null? (cddr obj))
+ (> len (/ *pretty-print-length* 2)))
+ (if (eq? (car obj) 'quote)
+ (write-char #\' port)
(begin
- (spaces port (+ column *pretty-print-spacing*))
- (stacked-list port (cddr obj) (+ column *pretty-print-spacing*)))
- (if (pair? (cddr obj))
- (let ((str (object->string (caddr obj))))
- (if (> (length str) 60)
- (begin
- (spaces port (+ column *pretty-print-spacing*))
- (pretty-print-1 (caddr obj) port (+ column *pretty-print-spacing*)))
- (write (caddr obj) port)))
- (write (cddr obj) port)))
- (write-char #\) port))))
- (hash-table-set! h 'define w-define)
-
- ;; -------- if
- (define (w-if obj port column)
- (let ((objstr (object->string obj))
- (ifcol (+ column 4)))
- (if (< (length objstr) 40)
- (display objstr port)
+ (write-char #\( port)
+ (pretty-print-1 (car obj) port col)
+ (spaces port (+ col 1))))
+ (pretty-print-1 (cadr obj) port (+ col 1))
+ (if (not (eq? (car obj) 'quote))
+ (write-char #\) port)))
+
+ (else
+ (pretty-print-1 obj port (+ col added))))))))
+
+ (define (stacked-split-list port lst col)
+ (if (not (pair? lst))
+ (write lst port)
+ (do ((p lst (cdr p)))
+ ((not (pair? p)))
+ (if (not (eq? p lst)) (spaces port col))
+ (if (pair? (car p))
+ (begin
+ (format port "(~S " (caar p))
+ (if (and (pair? (cdar p))
+ (symbol? (caar p)))
+ (pretty-print-1 (cadar p) port (+ col (length (symbol->string (caar p))) 2))
+ (write (cdar p) port))
+ (write-char #\) port))
+ (write (car p) port))))) ; pretty-print? (it's always a symbol)
+
+ (let ((writers
+ (let ((h (make-hash-table)))
+
+ ;; -------- quote
+ (define (w-quote obj port column)
+ (if (not (pair? (cdr obj))) ; (quote) or (quote . 1)
+ (write obj port)
(begin
- (format port "(if ")
- (pretty-print-1 (cadr obj) port ifcol)
- (when (pair? (cddr obj)) ; might be a messed-up if
- (spaces port ifcol)
- (pretty-print-1 (caddr obj) port ifcol)
- (when (pair? (cdddr obj))
+ (write-char #\' port)
+ (pretty-print-1 (cadr obj) port column))))
+ (hash-table-set! h 'quote w-quote)
+
+ ;; -------- define
+ (define (w-define obj port column)
+ (if (not (pair? (cdr obj)))
+ (write obj port)
+ (begin
+ (format port "(~A ~A " (car obj) (cadr obj))
+ (if (pair? (cadr obj))
+ (begin
+ (spaces port (+ column *pretty-print-spacing*))
+ (stacked-list port (cddr obj) (+ column *pretty-print-spacing*)))
+ (if (pair? (cddr obj))
+ (let ((str (object->string (caddr obj))))
+ (if (> (length str) 60)
+ (begin
+ (spaces port (+ column *pretty-print-spacing*))
+ (pretty-print-1 (caddr obj) port (+ column *pretty-print-spacing*)))
+ (write (caddr obj) port)))
+ (write (cddr obj) port)))
+ (write-char #\) port))))
+ (hash-table-set! h 'define w-define)
+
+ ;; -------- if
+ (define (w-if obj port column)
+ (let ((objstr (object->string obj))
+ (ifcol (+ column 4)))
+ (if (< (length objstr) 40)
+ (display objstr port)
+ (begin
+ (format port "(if ")
+ (pretty-print-1 (cadr obj) port ifcol)
+ (when (pair? (cddr obj)) ; might be a messed-up if
(spaces port ifcol)
- (pretty-print-1 (cadddr obj) port ifcol)))
- (write-char #\) port)))))
- (hash-table-set! h 'if w-if)
-
- ;; -------- when unless
- (define (w-when obj port column)
- (let ((objstr (object->string obj)))
- (if (< (length objstr) 40)
- (display objstr port)
+ (pretty-print-1 (caddr obj) port ifcol)
+ (when (pair? (cdddr obj))
+ (spaces port ifcol)
+ (pretty-print-1 (cadddr obj) port ifcol)))
+ (write-char #\) port)))))
+ (hash-table-set! h 'if w-if)
+
+ ;; -------- when unless
+ (define (w-when obj port column)
+ (let ((objstr (object->string obj)))
+ (if (< (length objstr) 40)
+ (display objstr port)
+ (begin
+ (format port "(~A " (car obj))
+ (pretty-print-1 (cadr obj) port (+ column (if (eq? (car obj) 'when) 6 8)))
+ (spaces port (+ column *pretty-print-spacing*))
+ (when (pair? (cddr obj))
+ (stacked-list port (cddr obj) (+ column *pretty-print-spacing*)))
+ (write-char #\) port)))))
+ (hash-table-set! h 'when w-when)
+ (hash-table-set! h 'unless w-when)
+
+ ;; -------- let let* letrec letrec*
+ (define (w-let obj port column)
+ (if (not (and (pair? (cdr obj))
+ (pair? (cddr obj))))
+ (write obj port)
(begin
- (format port "(~A " (car obj))
- (pretty-print-1 (cadr obj) port (+ column (if (eq? (car obj) 'when) 6 8)))
+ (let ((head-len (length (symbol->string (car obj)))))
+ (if (symbol? (cadr obj))
+ (begin
+ (format port "(~A ~A (" (car obj) (cadr obj))
+ (if (pair? (cddr obj))
+ (if (pair? (caddr obj)) ; (let x () ...)
+ (stacked-split-list port (caddr obj) (+ column head-len (length (symbol->string (cadr obj))) 4))
+ (if (not (null? (caddr obj)))
+ (write (caddr obj) port))) ; () is already being written
+ (if (not (null? (cddr obj)))
+ (format port " . ~S" (cddr obj)))))
+ (begin
+ (format port "(~A (" (car obj))
+ (if (pair? (cadr obj))
+ (stacked-split-list port (cadr obj) (+ column head-len 3))))))
+ (write-char #\) port)
(spaces port (+ column *pretty-print-spacing*))
- (when (pair? (cddr obj))
- (stacked-list port (cddr obj) (+ column *pretty-print-spacing*)))
- (write-char #\) port)))))
- (hash-table-set! h 'when w-when)
- (hash-table-set! h 'unless w-when)
-
- ;; -------- let let* letrec letrec*
- (define (w-let obj port column)
- (if (not (and (pair? (cdr obj))
- (pair? (cddr obj))))
- (write obj port)
- (begin
- (let ((head-len (length (symbol->string (car obj)))))
- (if (symbol? (cadr obj))
- (begin
- (format port "(~A ~A (" (car obj) (cadr obj))
- (if (pair? (cddr obj))
- (if (pair? (caddr obj)) ; (let x () ...)
- (stacked-split-list port (caddr obj) (+ column head-len (length (symbol->string (cadr obj))) 4))
- (if (not (null? (caddr obj)))
- (write (caddr obj) port))) ; () is already being written
- (if (not (null? (cddr obj)))
- (format port " . ~S" (cddr obj)))))
- (begin
- (format port "(~A (" (car obj))
- (if (pair? (cadr obj))
- (stacked-split-list port (cadr obj) (+ column head-len 3))))))
- (write-char #\) port)
- (spaces port (+ column *pretty-print-spacing*))
- (if (pair? ((if (symbol? (cadr obj)) cdddr cddr) obj))
- (stacked-list port ((if (symbol? (cadr obj)) cdddr cddr) obj) (+ column *pretty-print-spacing*)))
- (write-char #\) port))))
- (for-each
- (lambda (f)
- (hash-table-set! h f w-let))
- '(let let* letrec letrec*))
-
- ;; -------- set!
- (define (w-set obj port column)
- (let ((str (object->string obj)))
- (if (<= (length str) 60)
- (display str port)
- (let ((settee (object->string (cadr obj))))
- (format port "(set! ~A" settee)
- (if (pair? (cddr obj))
- (if (> (length settee) 20)
- (begin
- (spaces port (+ column 6))
- (pretty-print-1 (caddr obj) port (+ column 6)))
- (begin
- (write-char #\space port)
- (pretty-print-1 (caddr obj) port (+ column 7 (length settee))))))
- (write-char #\) port)))))
- (hash-table-set! h 'set! w-set)
-
- ;; -------- cond
- (define (w-cond obj port column)
- (format port "(cond ")
- (do ((lst (cdr obj) (cdr lst)))
- ((not (pair? lst)))
- (if (not (eq? lst (cdr obj)))
- (spaces port (+ column 6)))
- (if (not (pair? (car lst)))
- (write (car lst) port)
- (let ((has=> (and (pair? (cdar lst))
- (eq? (cadar lst) '=>))))
- (let ((extras (and (pair? (cdar lst))
- (pair? (cddar lst))
- (or (not has=>)
- (pair? (cdddar lst)))))
- (too-long (> (length (object->string (cdar lst))) 50)))
- (write-char #\( port)
- (let ((oldlines newlines))
- (pretty-print-1 (caar lst) port (+ column 7))
- (if (or extras
- (not (= oldlines newlines))
- too-long)
- (spaces port (+ column 7))
- (if (and (pair? (cdar lst))
- (or (not has=>)
- (= oldlines newlines)))
- (write-char #\space port)))
- (if (and (pair? (cdar lst))
- (not extras)
- (not too-long))
- (begin
- (write (cadar lst) port)
- (when (and has=>
- (pair? (cddar lst)))
+ (if (pair? ((if (symbol? (cadr obj)) cdddr cddr) obj))
+ (stacked-list port ((if (symbol? (cadr obj)) cdddr cddr) obj) (+ column *pretty-print-spacing*)))
+ (write-char #\) port))))
+ (for-each
+ (lambda (f)
+ (hash-table-set! h f w-let))
+ '(let let* letrec letrec*))
+
+ ;; -------- set!
+ (define (w-set obj port column)
+ (let ((str (object->string obj)))
+ (if (<= (length str) 60)
+ (display str port)
+ (let ((settee (object->string (cadr obj))))
+ (format port "(set! ~A" settee)
+ (if (pair? (cddr obj))
+ (if (> (length settee) 20)
+ (begin
+ (spaces port (+ column 6))
+ (pretty-print-1 (caddr obj) port (+ column 6)))
+ (begin
(write-char #\space port)
- (write (caddar lst) port)))
- (if (not (null? (cdar lst)))
- (stacked-list port (cdar lst) (+ column 7)))))
+ (pretty-print-1 (caddr obj) port (+ column 7 (length settee))))))
(write-char #\) port)))))
- (write-char #\) port))
- (hash-table-set! h 'cond w-cond)
-
- ;; -------- and or
- (define (w-and obj port column)
- (if (> (length (object->string obj)) 40)
- (begin
- (format port "(~A " (car obj))
- (stacked-list port (cdr obj) (+ column *pretty-print-spacing* (length (symbol->string (car obj)))))
- (write-char #\) port))
- (write obj port)))
- (hash-table-set! h 'and w-and)
- (hash-table-set! h 'or w-and)
-
- ;; -------- case
- (define (w-case obj port column)
- (if (not (and (pair? (cdr obj))
- (pair? (cddr obj))))
- (write obj port)
- (begin
- (format port "(case ~A" (cadr obj)) ; send out the selector
- (for-each
- (lambda (lst)
- (spaces port (+ column *pretty-print-spacing*))
- (if (not (pair? lst))
- (write lst port)
- (begin
- (write-char #\( port)
- (if (not (pair? (car lst)))
- (write (car lst) port)
- (let ((len (length (car lst))))
- (if (< len 6)
- (write (car lst) port)
- (let ((p (car lst)))
- (write-char #\( port)
- (do ((i 0 (+ i 6)))
- ((>= i len))
- (do ((j 0 (+ j 1)))
- ((or (= j 6) (null? p)) (if (pair? p) (spaces port (+ column 4))))
- (write (car p) port)
- (set! p (cdr p))
- (if (pair? p)
- (write-char #\space port))))
- (write-char #\) port)))))
- (if (not (null? (cdr lst)))
- (if (and (pair? (cdr lst))
- (or (and (null? (cddr lst))
- (< (length (object->string (cadr lst))) 60))
- (and (eq? (cadr lst) '=>)
- (null? (cdddr lst))
- (< (length (object->string (caddr lst))) 60))))
- (begin
- (write-char #\space port)
- (write (cadr lst) port)
- (if (and (eq? (cadr lst) '=>)
- (pair? (cddr lst)))
- (begin
- (write-char #\space port)
- (write (caddr lst) port))))
- (begin
- (spaces port (+ column 3))
- (stacked-list port (cdr lst) (+ column 3)))))
- (write-char #\) port))))
- (cddr obj))
- (write-char #\) port))))
- (hash-table-set! h 'case w-case)
-
- ;; -------- map for-each
- (define (w-map obj port column)
- (let* ((objstr (object->string obj))
- (strlen (length objstr)))
- (if (< (+ column strlen) *pretty-print-length*)
- (display objstr port)
+ (hash-table-set! h 'set! w-set)
+
+ ;; -------- cond
+ (define (w-cond obj port column)
+ (format port "(cond ")
+ (do ((lst (cdr obj) (cdr lst)))
+ ((not (pair? lst)))
+ (if (not (eq? lst (cdr obj)))
+ (spaces port (+ column 6)))
+ (if (not (pair? (car lst)))
+ (write (car lst) port)
+ (let ((has=> (and (pair? (cdar lst))
+ (eq? (cadar lst) '=>))))
+ (let ((extras (and (pair? (cdar lst))
+ (pair? (cddar lst))
+ (or (not has=>)
+ (pair? (cdddar lst)))))
+ (too-long (> (length (object->string (cdar lst))) 50)))
+ (write-char #\( port)
+ (let ((oldlines newlines))
+ (pretty-print-1 (caar lst) port (+ column 7))
+ (if (or extras
+ (not (= oldlines newlines))
+ too-long)
+ (spaces port (+ column 7))
+ (if (and (pair? (cdar lst))
+ (or (not has=>)
+ (= oldlines newlines)))
+ (write-char #\space port)))
+ (if (and (pair? (cdar lst))
+ (not extras)
+ (not too-long))
+ (begin
+ (write (cadar lst) port)
+ (when (and has=>
+ (pair? (cddar lst)))
+ (write-char #\space port)
+ (write (caddar lst) port)))
+ (if (not (null? (cdar lst)))
+ (stacked-list port (cdar lst) (+ column 7)))))
+ (write-char #\) port)))))
+ (write-char #\) port))
+ (hash-table-set! h 'cond w-cond)
+
+ ;; -------- and or
+ (define (w-and obj port column)
+ (if (> (length (object->string obj)) 40)
(begin
- (format port "(~A" (car obj))
- (if (pair? (cdr obj))
- (begin
- (write-char #\space port)
- (stacked-list port (cdr obj) (+ column *pretty-print-spacing*))))
- (write-char #\) port)))))
- (hash-table-set! h 'map w-map)
- (hash-table-set! h 'for-each w-map)
-
- ;; -------- do
- (define (w-do obj port column)
- (if (not (pair? (cdr obj)))
- (write obj port)
- (begin
- (format port "(do ")
- (if (list? (cadr obj))
- (write-char #\( port)
- (display (cadr obj) port))
- (if (pair? (cadr obj))
- (stacked-list port (cadr obj) (+ column 5)))
- (if (list? (cadr obj))
- (write-char #\) port))
- (when (pair? (cddr obj))
- (spaces port (+ column 4))
- (let ((end (caddr obj)))
- (if (< (length (object->string end)) (- *pretty-print-length* column))
- (write end port)
+ (format port "(~A " (car obj))
+ (stacked-list port (cdr obj) (+ column *pretty-print-spacing* (length (symbol->string (car obj)))))
+ (write-char #\) port))
+ (write obj port)))
+ (hash-table-set! h 'and w-and)
+ (hash-table-set! h 'or w-and)
+
+ ;; -------- case
+ (define (w-case obj port column)
+ (if (not (and (pair? (cdr obj))
+ (pair? (cddr obj))))
+ (write obj port)
+ (begin
+ (format port "(case ~A" (cadr obj)) ; send out the selector
+ (for-each
+ (lambda (lst)
+ (spaces port (+ column *pretty-print-spacing*))
+ (if (not (pair? lst))
+ (write lst port)
+ (begin
+ (write-char #\( port)
+ (if (not (pair? (car lst)))
+ (write (car lst) port)
+ (let ((len (length (car lst))))
+ (if (< len 6)
+ (write (car lst) port)
+ (let ((p (car lst)))
+ (write-char #\( port)
+ (do ((i 0 (+ i 6)))
+ ((>= i len))
+ (do ((j 0 (+ j 1)))
+ ((or (= j 6) (null? p)) (if (pair? p) (spaces port (+ column 4))))
+ (write (car p) port)
+ (set! p (cdr p))
+ (if (pair? p)
+ (write-char #\space port))))
+ (write-char #\) port)))))
+ (if (not (null? (cdr lst)))
+ (if (and (pair? (cdr lst))
+ (or (and (null? (cddr lst))
+ (< (length (object->string (cadr lst))) 60))
+ (and (eq? (cadr lst) '=>)
+ (null? (cdddr lst))
+ (< (length (object->string (caddr lst))) 60))))
+ (begin
+ (write-char #\space port)
+ (write (cadr lst) port)
+ (if (and (eq? (cadr lst) '=>)
+ (pair? (cddr lst)))
+ (begin
+ (write-char #\space port)
+ (write (caddr lst) port))))
+ (begin
+ (spaces port (+ column 3))
+ (stacked-list port (cdr lst) (+ column 3)))))
+ (write-char #\) port))))
+ (cddr obj))
+ (write-char #\) port))))
+ (hash-table-set! h 'case w-case)
+
+ ;; -------- map for-each
+ (define (w-map obj port column)
+ (let* ((objstr (object->string obj))
+ (strlen (length objstr)))
+ (if (< (+ column strlen) *pretty-print-length*)
+ (display objstr port)
+ (begin
+ (format port "(~A" (car obj))
+ (if (pair? (cdr obj))
(begin
- (write-char #\( port)
- (pretty-print-1 (car end) port (+ column 4))
- (spaces port (+ column 5))
- (stacked-list port (cdr end) (+ column 5))
- (write-char #\) port))))
- (when (pair? (cdddr obj))
- (spaces port (+ column *pretty-print-spacing*))
- (stacked-list port (cdddr obj) (+ column *pretty-print-spacing*))))
- (write-char #\) port))))
- (hash-table-set! h 'do w-do)
-
- ;; -------- begin etc
- (define (w-begin obj port column)
- (format port "(~A" (car obj))
- (if (pair? (cdr obj))
- (begin
- (spaces port (+ column *pretty-print-spacing*))
- (stacked-list port (cdr obj) (+ column *pretty-print-spacing*))))
- (write-char #\) port))
- (for-each
- (lambda (f)
- (hash-table-set! h f w-begin))
- '(begin call-with-exit call/cc call-with-current-continuation
- with-baffle with-output-to-string call-with-output-string hash-table inlet))
-
- ;; -------- dynamic-wind call-with-values
- (define (w-dynwind obj port column)
- (format port "(~A" (car obj))
- (spaces port (+ column *pretty-print-spacing*))
- (stacked-list port (cdr obj) (+ column *pretty-print-spacing*))
- (write-char #\) port))
- (hash-table-set! h 'dynamic-wind w-dynwind)
- (hash-table-set! h 'call-with-values w-dynwind)
-
- ;; -------- lambda etc
- (define (w-lambda obj port column)
- (if (not (and (pair? (cdr obj))
- (pair? (cddr obj))))
- (write obj port)
- (begin
- (format port "(~A " (car obj)); (cadr obj))
- (pretty-print-1 (cadr obj) port (+ column *pretty-print-spacing* (length (symbol->string (car obj)))))
- (spaces port (+ column *pretty-print-spacing*))
- (stacked-list port (cddr obj) (+ column *pretty-print-spacing*))
- (write-char #\) port))))
- (for-each
- (lambda (f)
- (hash-table-set! h f w-lambda))
- '(lambda lambda* define* define-macro define-macro* define-bacro define-bacro* with-let
- call-with-input-string call-with-input-file call-with-output-file
- with-input-from-file with-input-from-string with-output-to-file))
-
- ;; -------- defmacro defmacro*
- (define (w-defmacro obj port column)
- (if (not (and (pair? (cdr obj))
- (pair? (cddr obj))))
- (write obj port)
- (begin
- (format port "(~A ~A ~A" (car obj) (cadr obj) (caddr obj))
- (spaces port (+ column *pretty-print-spacing*))
- (stacked-list port (cdddr obj) (+ column *pretty-print-spacing*))
- (write-char #\) port))))
- (hash-table-set! h 'defmacro w-defmacro)
- (hash-table-set! h 'defmacro* w-defmacro)
-
- ;; -------- catch
- (define (w-catch obj port column)
- (if (not (pair? (cdr obj))) ; (catch) or (catch . 1)
- (write obj port)
- (begin
- (format port "(~A ~S" catch (cadr obj))
- (spaces port (+ column *pretty-print-spacing*))
- (stacked-list port (cddr obj) (+ column *pretty-print-spacing*))
- (write-char #\) port))))
- (hash-table-set! h 'catch w-catch)
-
- h)))
-
- ;; pretty-print-1
- (lambda (obj port column)
-
- (cond ((number? obj)
- (if (rational? obj)
- (write obj port)
- (display (messy-number obj) port)))
-
- ((hash-table? obj)
- (display "(hash-table" port)
- (for-each (lambda (field)
- (let ((symstr (object->string (car field))))
- (spaces port (+ column 2))
- (format port "'(~A . " symstr)
- (pretty-print-1 (cdr field) port (+ column 4 (length symstr)))
- (write-char #\) port)))
- obj)
- (write-char #\) port))
-
- ((let? obj)
- (if (and (openlet? obj)
- (defined? 'pretty-print obj))
- ((obj 'pretty-print) obj port column)
- (begin
- (display "(inlet" port)
- (for-each (lambda (field)
- (let ((symstr (symbol->string (car field))))
- (spaces port (+ column 2))
- (format port ":~A " symstr)
- (pretty-print-1 (cdr field) port (+ column 2 (length symstr)))))
- obj)
- (write-char #\) port))))
-
- ((or (int-vector? obj)
- (float-vector? obj))
- (if (> (length (vector-dimensions obj)) 1)
- (write obj port)
- (let* ((objstr (object->string obj))
- (strlen (length objstr)))
- (if (< (+ column strlen) *pretty-print-length*)
- (display objstr port)
- (let ((name-len (if (int-vector? obj) 10 12)))
- (display (if (int-vector? obj) "(int-vector " "(float-vector ") port)
- (set! column (+ column 2))
- (if (< (- *pretty-print-length* column) 30)
- (spaces port column)
- (set! column (+ column name-len)))
- (do ((len (min (length obj) (*s7* 'print-length)))
- (col column)
- (i 0 (+ i 1)))
- ((= i len)
- (if (> len (*s7* 'print-length))
- (write-string " ...)" port)
- (write-char #\) port)))
- (let* ((numstr (number->string (obj i)))
- (numlen (length numstr)))
- (if (not (= col column))
- (if (> (+ col numlen) *pretty-print-length*)
- (begin
- (spaces port column)
- (set! col column))
- (display #\space port)))
- (display numstr port)
- (set! col (+ col numlen 1)))))))))
+ (write-char #\space port)
+ (stacked-list port (cdr obj) (+ column *pretty-print-spacing*))))
+ (write-char #\) port)))))
+ (hash-table-set! h 'map w-map)
+ (hash-table-set! h 'for-each w-map)
- ((vector? obj)
- (if (> (length (vector-dimensions obj)) 1)
- (write obj port)
- (let* ((objstr (object->string obj))
- (strlen (length objstr)))
- (if (< (+ column strlen) *pretty-print-length*)
- (display objstr port)
- (begin
- (display "(vector " port)
- (set! column (+ column 2))
- (if (< (- *pretty-print-length* column) 30)
- (spaces port column)
- (set! column (+ column 6)))
- (do ((len (min (length obj) (*s7* 'print-length)))
- (col column)
- (i 0 (+ i 1)))
- ((= i len)
- (if (> len (*s7* 'print-length))
- (write-string " ...)" port)
- (write-char #\) port)))
- (let ((olen (length (object->string (obj i)))))
- (if (not (= col column))
- (if (> (+ col olen) *pretty-print-length*)
- (begin
- (spaces port column)
- (set! col column))
- (display #\space port)))
- (pretty-print-1 (obj i) port col)
- (set! col (+ col olen 1)))))))))
-
- ((not (pair? obj))
- (write obj port))
-
- ((hash-table-ref writers (car obj))
- => (lambda (f) (f obj port column)))
-
- ((any? (lambda (p)
- (or (hash-table? p)
- (let? p)))
- obj)
- (let ((first #t))
- (write-char #\( port)
- (for-each (lambda (p)
- (if first (set! first #f) (spaces port (+ column 4)))
- (pretty-print-1 p port (+ column 4)))
+ ;; -------- do
+ (define (w-do obj port column)
+ (if (not (pair? (cdr obj)))
+ (write obj port)
+ (begin
+ (format port "(do ")
+ (if (list? (cadr obj))
+ (write-char #\( port)
+ (display (cadr obj) port))
+ (if (pair? (cadr obj))
+ (stacked-list port (cadr obj) (+ column 5)))
+ (if (list? (cadr obj))
+ (write-char #\) port))
+ (when (pair? (cddr obj))
+ (spaces port (+ column 4))
+ (let ((end (caddr obj)))
+ (if (< (length (object->string end)) (- *pretty-print-length* column))
+ (write end port)
+ (begin
+ (write-char #\( port)
+ (pretty-print-1 (car end) port (+ column 4))
+ (spaces port (+ column 5))
+ (stacked-list port (cdr end) (+ column 5))
+ (write-char #\) port))))
+ (when (pair? (cdddr obj))
+ (spaces port (+ column *pretty-print-spacing*))
+ (stacked-list port (cdddr obj) (+ column *pretty-print-spacing*))))
+ (write-char #\) port))))
+ (hash-table-set! h 'do w-do)
+
+ ;; -------- begin etc
+ (define (w-begin obj port column)
+ (format port "(~A" (car obj))
+ (if (pair? (cdr obj))
+ (begin
+ (spaces port (+ column *pretty-print-spacing*))
+ (stacked-list port (cdr obj) (+ column *pretty-print-spacing*))))
+ (write-char #\) port))
+ (for-each
+ (lambda (f)
+ (hash-table-set! h f w-begin))
+ '(begin call-with-exit call/cc call-with-current-continuation
+ with-baffle with-output-to-string call-with-output-string hash-table inlet))
+
+ ;; -------- dynamic-wind call-with-values
+ (define (w-dynwind obj port column)
+ (format port "(~A" (car obj))
+ (spaces port (+ column *pretty-print-spacing*))
+ (stacked-list port (cdr obj) (+ column *pretty-print-spacing*))
+ (write-char #\) port))
+ (hash-table-set! h 'dynamic-wind w-dynwind)
+ (hash-table-set! h 'call-with-values w-dynwind)
+
+ ;; -------- lambda etc
+ (define (w-lambda obj port column)
+ (if (not (and (pair? (cdr obj))
+ (pair? (cddr obj))))
+ (write obj port)
+ (begin
+ (format port "(~A " (car obj)); (cadr obj))
+ (pretty-print-1 (cadr obj) port (+ column *pretty-print-spacing* (length (symbol->string (car obj)))))
+ (spaces port (+ column *pretty-print-spacing*))
+ (stacked-list port (cddr obj) (+ column *pretty-print-spacing*))
+ (write-char #\) port))))
+ (for-each
+ (lambda (f)
+ (hash-table-set! h f w-lambda))
+ '(lambda lambda* define* define-macro define-macro* define-bacro define-bacro* with-let
+ call-with-input-string call-with-input-file call-with-output-file
+ with-input-from-file with-input-from-string with-output-to-file))
+
+ ;; -------- defmacro defmacro*
+ (define (w-defmacro obj port column)
+ (if (not (and (pair? (cdr obj))
+ (pair? (cddr obj))))
+ (write obj port)
+ (begin
+ (format port "(~A ~A ~A" (car obj) (cadr obj) (caddr obj))
+ (spaces port (+ column *pretty-print-spacing*))
+ (stacked-list port (cdddr obj) (+ column *pretty-print-spacing*))
+ (write-char #\) port))))
+ (hash-table-set! h 'defmacro w-defmacro)
+ (hash-table-set! h 'defmacro* w-defmacro)
+
+ ;; -------- catch
+ (define (w-catch obj port column)
+ (if (not (pair? (cdr obj))) ; (catch) or (catch . 1)
+ (write obj port)
+ (begin
+ (format port "(~A ~S" catch (cadr obj))
+ (spaces port (+ column *pretty-print-spacing*))
+ (stacked-list port (cddr obj) (+ column *pretty-print-spacing*))
+ (write-char #\) port))))
+ (hash-table-set! h 'catch w-catch)
+
+ h)))
+
+ ;; pretty-print-1
+ (lambda (obj port column)
+
+ (cond ((number? obj)
+ (if (rational? obj)
+ (write obj port)
+ (display (messy-number obj) port)))
+
+ ((hash-table? obj)
+ (display "(hash-table" port)
+ (for-each (lambda (field)
+ (let ((symstr (object->string (car field))))
+ (spaces port (+ column 2))
+ (format port "'(~A . " symstr)
+ (pretty-print-1 (cdr field) port (+ column 4 (length symstr)))
+ (write-char #\) port)))
obj)
- (write-char #\) port)))
-
- (else
- (let* ((objstr (object->string obj))
- (strlen (length objstr)))
- (if (< (+ column strlen) *pretty-print-length*)
- (display objstr port)
- (let ((lstlen (length obj)))
-
- (cond ((or (infinite? lstlen)
- (not (positive? lstlen)))
- (display objstr port))
-
- ((and (symbol? (car obj))
- (> (length (symbol->string (car obj))) 12)
- (pair? (cdr obj))
- (pair? (cadr obj))
- (memq (caadr obj) '(lambda lambda* let let* cond case letrec)))
- (write-char #\( port)
- (pretty-print-1 (car obj) port column)
- (spaces port (+ column 2))
- (stacked-list port (cdr obj) (+ column 2))
- (write-char #\) port))
-
- ((= lstlen 1)
- (if (pair? (car obj))
- (begin
- (write-char #\( port)
- (pretty-print-1 (car obj) port (+ column 1))
- (write-char #\) port))
- (display objstr port)))
-
- ((and (pair? (car obj))
- (memq (caar obj) '(lambda lambda* let let* letrec letrec* cond if case)))
- (write-char #\( port)
- (pretty-print-1 (car obj) port column)
- (spaces port (+ column 1))
- (if (and (memq (caar obj) '(cond if case))
- (do ((p (cdr obj) (cdr p)))
- ((or (null? p)
- (pair? (car p)))
- (null? p))))
- (do ((p (cdr obj) (cdr p)))
- ((null? p))
- (display (car p) port)
- (if (pair? (cdr p))
- (write-char #\space port)))
- (stacked-list port (cdr obj) (+ column 1)))
- (write-char #\) port))
-
- (else
- (let* ((carstr (object->string (car obj)))
- (carstrlen (length carstr)))
- (if (eq? (car obj) 'quote)
- (write-char #\' port)
- (format port "(~A" carstr))
- (if (any-keyword? (cdr obj))
+ (write-char #\) port))
+
+ ((let? obj)
+ (if (and (openlet? obj)
+ (defined? 'pretty-print obj))
+ ((obj 'pretty-print) obj port column)
+ (begin
+ (display "(inlet" port)
+ (for-each (lambda (field)
+ (let ((symstr (symbol->string (car field))))
+ (spaces port (+ column 2))
+ (format port ":~A " symstr)
+ (pretty-print-1 (cdr field) port (+ column 2 (length symstr)))))
+ obj)
+ (write-char #\) port))))
+
+ ((or (int-vector? obj)
+ (float-vector? obj))
+ (if (> (length (vector-dimensions obj)) 1)
+ (write obj port)
+ (let* ((objstr (object->string obj))
+ (strlen (length objstr)))
+ (if (< (+ column strlen) *pretty-print-length*)
+ (display objstr port)
+ (let ((name-len (if (int-vector? obj) 10 12)))
+ (display (if (int-vector? obj) "(int-vector " "(float-vector ") port)
+ (set! column (+ column 2))
+ (if (< (- *pretty-print-length* column) 30)
+ (spaces port column)
+ (set! column (+ column name-len)))
+ (do ((len (min (length obj) (let-ref *s7* 'print-length)))
+ (col column)
+ (i 0 (+ i 1)))
+ ((= i len)
+ (if (> len (let-ref *s7* 'print-length))
+ (write-string " ...)" port)
+ (write-char #\) port)))
+ (let* ((numstr (number->string (obj i)))
+ (numlen (length numstr)))
+ (if (not (= col column))
+ (if (> (+ col numlen) *pretty-print-length*)
+ (begin
+ (spaces port column)
+ (set! col column))
+ (display #\space port)))
+ (display numstr port)
+ (set! col (+ col numlen 1)))))))))
+
+ ((vector? obj)
+ (if (> (length (vector-dimensions obj)) 1)
+ (write obj port)
+ (let* ((objstr (object->string obj))
+ (strlen (length objstr)))
+ (if (< (+ column strlen) *pretty-print-length*)
+ (display objstr port)
+ (begin
+ (display "(vector " port)
+ (set! column (+ column 2))
+ (if (< (- *pretty-print-length* column) 30)
+ (spaces port column)
+ (set! column (+ column 6)))
+ (do ((len (min (length obj) (let-ref *s7* 'print-length)))
+ (col column)
+ (i 0 (+ i 1)))
+ ((= i len)
+ (if (> len (let-ref *s7* 'print-length))
+ (write-string " ...)" port)
+ (write-char #\) port)))
+ (let ((olen (length (object->string (obj i)))))
+ (if (not (= col column))
+ (if (> (+ col olen) *pretty-print-length*)
+ (begin
+ (spaces port column)
+ (set! col column))
+ (display #\space port)))
+ (pretty-print-1 (obj i) port col)
+ (set! col (+ col olen 1)))))))))
+
+ ((not (pair? obj))
+ (write obj port))
+
+ ((hash-table-ref writers (car obj))
+ => (lambda (f) (f obj port column)))
+
+ ((any? (lambda (p)
+ (or (hash-table? p)
+ (let? p)))
+ obj)
+ (let ((first #t))
+ (write-char #\( port)
+ (for-each (lambda (p)
+ (if first (set! first #f) (spaces port (+ column 4)))
+ (pretty-print-1 p port (+ column 4)))
+ obj)
+ (write-char #\) port)))
+
+ (else
+ (let* ((objstr (object->string obj))
+ (strlen (length objstr)))
+ (if (< (+ column strlen) *pretty-print-length*)
+ (display objstr port)
+ (let ((lstlen (length obj)))
+
+ (cond ((or (infinite? lstlen)
+ (not (positive? lstlen)))
+ (display objstr port))
+
+ ((and (symbol? (car obj))
+ (> (length (symbol->string (car obj))) 12)
+ (pair? (cdr obj))
+ (pair? (cadr obj))
+ (memq (caadr obj) '(lambda lambda* let let* cond case letrec)))
+ (write-char #\( port)
+ (pretty-print-1 (car obj) port column)
+ (spaces port (+ column 2))
+ (stacked-list port (cdr obj) (+ column 2))
+ (write-char #\) port))
+
+ ((= lstlen 1)
+ (if (pair? (car obj))
(begin
- (spaces port (+ column *pretty-print-spacing*))
- (stacked-list port (cdr obj) (+ column *pretty-print-spacing*)))
- (let ((line-start (+ column *pretty-print-spacing*
- (if (> carstrlen 16) 0 carstrlen))))
- (case lstlen
- ((2)
- (write-char #\space port)
- (pretty-print-1 (cadr obj) port line-start))
-
- ((3)
- (write-char #\space port)
- (stacked-list port (cdr obj) line-start))
-
- (else
- (do ((obj-start line-start)
- (lst (cdr obj) (cdr lst)))
- ((null? lst))
- (let* ((str (object->string (car lst)))
- (strlen1 (length str)))
- (if (and (> strlen1 (- *pretty-print-length* obj-start))
- (not (eq? lst (cdr obj))))
- (begin
- (set! obj-start (+ line-start 1 strlen1))
- (spaces port line-start)
- (pretty-print-1 (car lst) port line-start))
- (let ((at-line-start (= line-start obj-start)))
- (set! obj-start (+ obj-start 1 strlen1))
- (if (> strlen1 40)
- (begin
- (if at-line-start
- (write-char #\space port)
- (spaces port line-start))
- (pretty-print-1 (car lst) port line-start))
- (begin
- (write-char #\space port)
- (display str port)))))))))))
- (if (not (eq? (car obj) 'quote))
- (write-char #\) port))))))))))))))
+ (write-char #\( port)
+ (pretty-print-1 (car obj) port (+ column 1))
+ (write-char #\) port))
+ (display objstr port)))
+
+ ((and (pair? (car obj))
+ (memq (caar obj) '(lambda lambda* let let* letrec letrec* cond if case)))
+ (write-char #\( port)
+ (pretty-print-1 (car obj) port column)
+ (spaces port (+ column 1))
+ (if (and (memq (caar obj) '(cond if case))
+ (do ((p (cdr obj) (cdr p)))
+ ((or (null? p)
+ (pair? (car p)))
+ (null? p))))
+ (do ((p (cdr obj) (cdr p)))
+ ((null? p))
+ (display (car p) port)
+ (if (pair? (cdr p))
+ (write-char #\space port)))
+ (stacked-list port (cdr obj) (+ column 1)))
+ (write-char #\) port))
+
+ (else
+ (let* ((carstr (object->string (car obj)))
+ (carstrlen (length carstr)))
+ (if (eq? (car obj) 'quote)
+ (write-char #\' port)
+ (format port "(~A" carstr))
+ (if (any-keyword? (cdr obj))
+ (begin
+ (spaces port (+ column *pretty-print-spacing*))
+ (stacked-list port (cdr obj) (+ column *pretty-print-spacing*)))
+ (let ((line-start (+ column *pretty-print-spacing*
+ (if (> carstrlen 16) 0 carstrlen))))
+ (case lstlen
+ ((2)
+ (write-char #\space port)
+ (pretty-print-1 (cadr obj) port line-start))
+
+ ((3)
+ (write-char #\space port)
+ (stacked-list port (cdr obj) line-start))
+
+ (else
+ (do ((obj-start line-start)
+ (lst (cdr obj) (cdr lst)))
+ ((null? lst))
+ (let* ((str (object->string (car lst)))
+ (strlen1 (length str)))
+ (if (and (> strlen1 (- *pretty-print-length* obj-start))
+ (not (eq? lst (cdr obj))))
+ (begin
+ (set! obj-start (+ line-start 1 strlen1))
+ (spaces port line-start)
+ (pretty-print-1 (car lst) port line-start))
+ (let ((at-line-start (= line-start obj-start)))
+ (set! obj-start (+ obj-start 1 strlen1))
+ (if (> strlen1 40)
+ (begin
+ (if at-line-start
+ (write-char #\space port)
+ (spaces port line-start))
+ (pretty-print-1 (car lst) port line-start))
+ (begin
+ (write-char #\space port)
+ (display str port)))))))))))
+ (if (not (eq? (car obj) 'quote))
+ (write-char #\) port)))))))))))))))
;; pretty-print
(lambda* (obj (port (current-output-port)) (column 0))
@@ -685,7 +685,7 @@
(define* (pp-sequence seq)
(let ((iter (make-iterator seq))
(strs ())
- (plen (*s7* 'print-length)))
+ (plen (let-ref *s7* 'print-length)))
(do ((i 0 (+ i 1))
(entry (iterate iter) (iterate iter)))
((or (= i plen)
diff --git a/ws.scm b/ws.scm
index ef1eb6b..1f6c1cf 100644
--- a/ws.scm
+++ b/ws.scm
@@ -501,7 +501,7 @@
(dynamic-wind
(lambda ()
(set! *clm-notehook* (lambda (name . args)
- (set! mark-list (cons (append (list name) args) mark-list)))))
+ (set! mark-list (cons (cons name args) mark-list)))))
(lambda ()
(let* ((result (with-sound-helper (lambda () , at body) , at args))
diff --git a/xen.c b/xen.c
index d49fc54..e19a83a 100644
--- a/xen.c
+++ b/xen.c
@@ -1350,8 +1350,9 @@ void xen_repl(int argc, char **argv)
}
if (expr_ok)
{
- char *str, *temp;
+ char *temp;
#if USE_SND
+ char *str;
str = stdin_check_for_full_expression(buffer); /* "str" here is actually stdin_str, so we need to clear it explicitly */
if (!str) {expr_ok = false; continue;}
len = strlen(str) + 16;
@@ -1564,7 +1565,7 @@ static Xen g_current_time(void)
return(C_ulong_to_Xen_ulong(curtime));
}
-
+#if (!DISABLE_DEPRECATED)
static Xen g_tmpnam(void)
{
#define H_tmpnam "(tmpnam) returns a new (hopefully unused) temporary file name"
@@ -1598,12 +1599,15 @@ static Xen g_tmpnam(void)
if (!tmpdir) tmpdir = xen_strdup("/tmp");
#endif
- snprintf(str, BUFFER_SIZE, "%s/xen_%d_%d", tmpdir, (int)getpid(), file_ctr++);
+ if (tmpdir) /* try to make C happy... */
+ snprintf(str, BUFFER_SIZE, "%s/xen_%d_%d", tmpdir, (int)getpid(), file_ctr++);
+ else snprintf(str, BUFFER_SIZE, "/xen_%d_%d", (int)getpid(), file_ctr++);
if (tmpdir) free(tmpdir);
result = C_string_to_Xen_string(str);
free(str);
return(result);
}
+#endif
static Xen g_ftell(Xen fd)
@@ -1641,11 +1645,12 @@ Xen_wrap_no_args(g_getcwd_w, g_getcwd)
Xen_wrap_2_args(g_strftime_w, g_strftime)
Xen_wrap_1_arg(g_localtime_w, g_localtime)
Xen_wrap_no_args(g_current_time_w, g_current_time)
-Xen_wrap_no_args(g_tmpnam_w, g_tmpnam)
Xen_wrap_1_arg(g_ftell_w, g_ftell)
-
Xen_wrap_no_args(g_gc_off_w, g_gc_off)
Xen_wrap_no_args(g_gc_on_w, g_gc_on)
+#if (!DISABLE_DEPRECATED)
+Xen_wrap_no_args(g_tmpnam_w, g_tmpnam)
+#endif
#if ENABLE_WEBSERVER
#if USE_MOTIF
@@ -1709,7 +1714,6 @@ s7_scheme *s7_xen_initialize(s7_scheme *sc)
#endif
Xen_define_typed_procedure("getcwd", g_getcwd_w, 0, 0, 0, H_getcwd, s7_make_signature(s7, 1, s));
Xen_define_typed_procedure("strftime", g_strftime_w, 2, 0, 0, H_strftime, s7_make_signature(s7, 3, s, s, p));
- Xen_define_typed_procedure("tmpnam", g_tmpnam_w, 0, 0, 0, H_tmpnam, s7_make_signature(s7, 1, s));
Xen_define_typed_procedure("localtime", g_localtime_w, 1, 0, 0, H_localtime, s7_make_signature(s7, 2, p, i));
Xen_define_typed_procedure("current-time", g_current_time_w, 0, 0, 0, H_current_time, s7_make_signature(s7, 1, i));
Xen_define_typed_procedure("ftell", g_ftell_w, 1, 0, 0, "(ftell fd): lseek", s7_make_signature(s7, 2, i, i));
@@ -1732,6 +1736,7 @@ s7_scheme *s7_xen_initialize(s7_scheme *sc)
(else (loop (cdr l) (cons (car l) result)))))))");
#if (!DISABLE_DEPRECATED)
+ Xen_define_typed_procedure("tmpnam", g_tmpnam_w, 0, 0, 0, H_tmpnam, s7_make_signature(s7, 1, s));
Xen_eval_C_string("(define load-from-path load)");
Xen_eval_C_string("(define (1+ x) \"add 1 to arg\" (+ x 1))");
Xen_eval_C_string("(define (1- x) \"subtract 1 from arg\" (- x 1))");
diff --git a/xg.c b/xg.c
index 082dd7f..fd271ca 100644
--- a/xg.c
+++ b/xg.c
@@ -200,7 +200,7 @@ static void define_xm_obj(void)
#define Xg_field_pre "F"
#endif
-static Xen xg_GdkDrawContext__symbol, xg_GtkDrawingAreaDrawFunc_symbol, xg_const_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_GtkPrintOperationPreview__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_GtkCheckButton__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_GtkCheckButton__symbol, xg_GdkDrawContext__symbol, xg_GtkDrawingAreaDrawFunc_symbol, xg_const_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_GtkPrintOperationPreview__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;
#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))
@@ -969,6 +969,7 @@ Xm_type_Ptr_1(GtkDrawingArea_, GtkDrawingArea*)
Xm_type(const, const)
Xm_type(GtkDrawingAreaDrawFunc, GtkDrawingAreaDrawFunc)
Xm_type_Ptr(GdkDrawContext_, GdkDrawContext*)
+Xm_type_Ptr(GtkCheckButton_, GtkCheckButton*)
#endif
Xm_type_Ptr(cairo_surface_t_, cairo_surface_t*)
@@ -4180,34 +4181,6 @@ static Xen gxg_gtk_bin_get_child(Xen bin)
return(C_to_Xen_GtkWidget_(gtk_bin_get_child(Xen_to_C_GtkBin_(bin))));
}
-static Xen gxg_gtk_box_pack_start(Xen box, Xen child, Xen expand, Xen fill, Xen padding)
-{
- #define H_gtk_box_pack_start "void gtk_box_pack_start(GtkBox* box, GtkWidget* child, gboolean expand, \
-gboolean fill, guint padding)"
- Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_pack_start", "GtkBox*");
- Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_box_pack_start", "GtkWidget*");
- Xen_check_type(Xen_is_gboolean(expand), expand, 3, "gtk_box_pack_start", "gboolean");
- Xen_check_type(Xen_is_gboolean(fill), fill, 4, "gtk_box_pack_start", "gboolean");
- Xen_check_type(Xen_is_guint(padding), padding, 5, "gtk_box_pack_start", "guint");
- gtk_box_pack_start(Xen_to_C_GtkBox_(box), Xen_to_C_GtkWidget_(child), Xen_to_C_gboolean(expand), Xen_to_C_gboolean(fill),
- Xen_to_C_guint(padding));
- return(Xen_false);
-}
-
-static Xen gxg_gtk_box_pack_end(Xen box, Xen child, Xen expand, Xen fill, Xen padding)
-{
- #define H_gtk_box_pack_end "void gtk_box_pack_end(GtkBox* box, GtkWidget* child, gboolean expand, gboolean fill, \
-guint padding)"
- Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_pack_end", "GtkBox*");
- Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_box_pack_end", "GtkWidget*");
- Xen_check_type(Xen_is_gboolean(expand), expand, 3, "gtk_box_pack_end", "gboolean");
- Xen_check_type(Xen_is_gboolean(fill), fill, 4, "gtk_box_pack_end", "gboolean");
- Xen_check_type(Xen_is_guint(padding), padding, 5, "gtk_box_pack_end", "guint");
- gtk_box_pack_end(Xen_to_C_GtkBox_(box), Xen_to_C_GtkWidget_(child), Xen_to_C_gboolean(expand), Xen_to_C_gboolean(fill),
- Xen_to_C_guint(padding));
- return(Xen_false);
-}
-
static Xen gxg_gtk_box_set_homogeneous(Xen box, Xen homogeneous)
{
#define H_gtk_box_set_homogeneous "void gtk_box_set_homogeneous(GtkBox* box, gboolean homogeneous)"
@@ -9741,23 +9714,6 @@ static Xen gxg_gtk_toggle_button_new_with_mnemonic(Xen label)
return(C_to_Xen_GtkWidget_(gtk_toggle_button_new_with_mnemonic(Xen_to_C_gchar_(label))));
}
-static Xen gxg_gtk_toggle_button_set_mode(Xen toggle_button, Xen draw_indicator)
-{
- #define H_gtk_toggle_button_set_mode "void gtk_toggle_button_set_mode(GtkToggleButton* toggle_button, \
-gboolean draw_indicator)"
- Xen_check_type(Xen_is_GtkToggleButton_(toggle_button), toggle_button, 1, "gtk_toggle_button_set_mode", "GtkToggleButton*");
- Xen_check_type(Xen_is_gboolean(draw_indicator), draw_indicator, 2, "gtk_toggle_button_set_mode", "gboolean");
- gtk_toggle_button_set_mode(Xen_to_C_GtkToggleButton_(toggle_button), Xen_to_C_gboolean(draw_indicator));
- return(Xen_false);
-}
-
-static Xen gxg_gtk_toggle_button_get_mode(Xen toggle_button)
-{
- #define H_gtk_toggle_button_get_mode "gboolean gtk_toggle_button_get_mode(GtkToggleButton* toggle_button)"
- Xen_check_type(Xen_is_GtkToggleButton_(toggle_button), toggle_button, 1, "gtk_toggle_button_get_mode", "GtkToggleButton*");
- return(C_to_Xen_gboolean(gtk_toggle_button_get_mode(Xen_to_C_GtkToggleButton_(toggle_button))));
-}
-
static Xen gxg_gtk_toggle_button_set_active(Xen toggle_button, Xen is_active)
{
#define H_gtk_toggle_button_set_active "void gtk_toggle_button_set_active(GtkToggleButton* toggle_button, \
@@ -9783,23 +9739,6 @@ static Xen gxg_gtk_toggle_button_toggled(Xen toggle_button)
return(Xen_false);
}
-static Xen gxg_gtk_toggle_button_set_inconsistent(Xen toggle_button, Xen setting)
-{
- #define H_gtk_toggle_button_set_inconsistent "void gtk_toggle_button_set_inconsistent(GtkToggleButton* toggle_button, \
-gboolean setting)"
- Xen_check_type(Xen_is_GtkToggleButton_(toggle_button), toggle_button, 1, "gtk_toggle_button_set_inconsistent", "GtkToggleButton*");
- Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_toggle_button_set_inconsistent", "gboolean");
- gtk_toggle_button_set_inconsistent(Xen_to_C_GtkToggleButton_(toggle_button), Xen_to_C_gboolean(setting));
- return(Xen_false);
-}
-
-static Xen gxg_gtk_toggle_button_get_inconsistent(Xen toggle_button)
-{
- #define H_gtk_toggle_button_get_inconsistent "gboolean gtk_toggle_button_get_inconsistent(GtkToggleButton* toggle_button)"
- Xen_check_type(Xen_is_GtkToggleButton_(toggle_button), toggle_button, 1, "gtk_toggle_button_get_inconsistent", "GtkToggleButton*");
- return(C_to_Xen_gboolean(gtk_toggle_button_get_inconsistent(Xen_to_C_GtkToggleButton_(toggle_button))));
-}
-
static Xen gxg_gtk_toolbar_new(void)
{
#define H_gtk_toolbar_new "GtkWidget* gtk_toolbar_new( void)"
@@ -11646,13 +11585,6 @@ GtkTreeViewColumn** [focus_column])"
return(Xen_list_2(C_to_Xen_GtkTreePath_(ref_path), C_to_Xen_GtkTreeViewColumn_(ref_focus_column)));
}
-static Xen gxg_gtk_tree_view_get_bin_window(Xen tree_view)
-{
- #define H_gtk_tree_view_get_bin_window "GdkWindow* gtk_tree_view_get_bin_window(GtkTreeView* tree_view)"
- Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_bin_window", "GtkTreeView*");
- return(C_to_Xen_GdkWindow_(gtk_tree_view_get_bin_window(Xen_to_C_GtkTreeView_(tree_view))));
-}
-
static Xen gxg_gtk_tree_view_get_path_at_pos(Xen tree_view, Xen x, Xen y, Xen ignore_path, Xen ignore_column, Xen ignore_cell_x, Xen ignore_cell_y)
{
#define H_gtk_tree_view_get_path_at_pos "gboolean gtk_tree_view_get_path_at_pos(GtkTreeView* tree_view, \
@@ -11925,14 +11857,6 @@ static Xen gxg_gtk_widget_hide(Xen widget)
return(Xen_false);
}
-static Xen gxg_gtk_widget_show_all(Xen widget)
-{
- #define H_gtk_widget_show_all "void gtk_widget_show_all(GtkWidget* widget)"
- Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_show_all", "GtkWidget*");
- gtk_widget_show_all(Xen_to_C_GtkWidget_(widget));
- return(Xen_false);
-}
-
static Xen gxg_gtk_widget_map(Xen widget)
{
#define H_gtk_widget_map "void gtk_widget_map(GtkWidget* widget)"
@@ -12399,13 +12323,6 @@ static Xen gxg_gtk_window_is_active(Xen window)
return(C_to_Xen_gboolean(gtk_window_is_active(Xen_to_C_GtkWindow_(window))));
}
-static Xen gxg_gtk_window_has_toplevel_focus(Xen window)
-{
- #define H_gtk_window_has_toplevel_focus "gboolean gtk_window_has_toplevel_focus(GtkWindow* window)"
- Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_has_toplevel_focus", "GtkWindow*");
- return(C_to_Xen_gboolean(gtk_window_has_toplevel_focus(Xen_to_C_GtkWindow_(window))));
-}
-
static Xen gxg_gtk_window_new(Xen type)
{
#define H_gtk_window_new "GtkWidget* gtk_window_new(GtkWindowType type)"
@@ -15221,22 +15138,6 @@ static Xen gxg_gtk_tree_view_column_get_expand(Xen tree_column)
return(C_to_Xen_gboolean(gtk_tree_view_column_get_expand(Xen_to_C_GtkTreeViewColumn_(tree_column))));
}
-static Xen gxg_gtk_widget_set_no_show_all(Xen widget, Xen no_show_all)
-{
- #define H_gtk_widget_set_no_show_all "void gtk_widget_set_no_show_all(GtkWidget* widget, gboolean no_show_all)"
- Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_no_show_all", "GtkWidget*");
- Xen_check_type(Xen_is_gboolean(no_show_all), no_show_all, 2, "gtk_widget_set_no_show_all", "gboolean");
- gtk_widget_set_no_show_all(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(no_show_all));
- return(Xen_false);
-}
-
-static Xen gxg_gtk_widget_get_no_show_all(Xen widget)
-{
- #define H_gtk_widget_get_no_show_all "gboolean gtk_widget_get_no_show_all(GtkWidget* widget)"
- Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_no_show_all", "GtkWidget*");
- return(C_to_Xen_gboolean(gtk_widget_get_no_show_all(Xen_to_C_GtkWidget_(widget))));
-}
-
static Xen gxg_gtk_widget_queue_resize_no_redraw(Xen widget)
{
#define H_gtk_widget_queue_resize_no_redraw "void gtk_widget_queue_resize_no_redraw(GtkWidget* widget)"
@@ -18465,22 +18366,6 @@ gboolean writable)"
return(C_to_Xen_gboolean(gtk_selection_data_targets_include_image(Xen_to_C_GtkSelectionData_(selection_data), Xen_to_C_gboolean(writable))));
}
-static Xen gxg_gtk_label_set_angle(Xen label, Xen angle)
-{
- #define H_gtk_label_set_angle "void gtk_label_set_angle(GtkLabel* label, gdouble angle)"
- Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_angle", "GtkLabel*");
- Xen_check_type(Xen_is_gdouble(angle), angle, 2, "gtk_label_set_angle", "gdouble");
- gtk_label_set_angle(Xen_to_C_GtkLabel_(label), Xen_to_C_gdouble(angle));
- return(Xen_false);
-}
-
-static Xen gxg_gtk_label_get_angle(Xen label)
-{
- #define H_gtk_label_get_angle "gdouble gtk_label_get_angle(GtkLabel* label)"
- Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_angle", "GtkLabel*");
- return(C_to_Xen_gdouble(gtk_label_get_angle(Xen_to_C_GtkLabel_(label))));
-}
-
static Xen gxg_gtk_menu_set_screen(Xen menu, Xen screen)
{
#define H_gtk_menu_set_screen "void gtk_menu_set_screen(GtkMenu* menu, GdkScreen* screen)"
@@ -22640,13 +22525,6 @@ static Xen gxg_gtk_accel_group_get_is_locked(Xen accel_group)
return(C_to_Xen_gboolean(gtk_accel_group_get_is_locked(Xen_to_C_GtkAccelGroup_(accel_group))));
}
-static Xen gxg_gtk_container_get_focus_child(Xen container)
-{
- #define H_gtk_container_get_focus_child "GtkWidget* gtk_container_get_focus_child(GtkContainer* container)"
- Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_get_focus_child", "GtkContainer*");
- return(C_to_Xen_GtkWidget_(gtk_container_get_focus_child(Xen_to_C_GtkContainer_(container))));
-}
-
static Xen gxg_gtk_dialog_get_content_area(Xen dialog)
{
#define H_gtk_dialog_get_content_area "GtkWidget* gtk_dialog_get_content_area(GtkDialog* dialog)"
@@ -23918,13 +23796,6 @@ gint response_id)"
return(C_to_Xen_GtkWidget_(gtk_dialog_get_widget_for_response(Xen_to_C_GtkDialog_(dialog), Xen_to_C_gint(response_id))));
}
-static Xen gxg_gtk_viewport_get_bin_window(Xen viewport)
-{
- #define H_gtk_viewport_get_bin_window "GdkWindow* gtk_viewport_get_bin_window(GtkViewport* viewport)"
- Xen_check_type(Xen_is_GtkViewport_(viewport), viewport, 1, "gtk_viewport_get_bin_window", "GtkViewport*");
- return(C_to_Xen_GdkWindow_(gtk_viewport_get_bin_window(Xen_to_C_GtkViewport_(viewport))));
-}
-
static Xen gxg_gtk_spinner_new(void)
{
#define H_gtk_spinner_new "GtkWidget* gtk_spinner_new( void)"
@@ -24848,13 +24719,6 @@ static Xen gxg_gdk_drag_context_get_source_window(Xen context)
return(C_to_Xen_GdkWindow_(gdk_drag_context_get_source_window(Xen_to_C_GdkDragContext_(context))));
}
-static Xen gxg_gtk_viewport_get_view_window(Xen viewport)
-{
- #define H_gtk_viewport_get_view_window "GdkWindow* gtk_viewport_get_view_window(GtkViewport* viewport)"
- Xen_check_type(Xen_is_GtkViewport_(viewport), viewport, 1, "gtk_viewport_get_view_window", "GtkViewport*");
- return(C_to_Xen_GdkWindow_(gtk_viewport_get_view_window(Xen_to_C_GtkViewport_(viewport))));
-}
-
static Xen gxg_gtk_accessible_set_widget(Xen accessible, Xen widget)
{
#define H_gtk_accessible_set_widget "void gtk_accessible_set_widget(GtkAccessible* accessible, GtkWidget* widget)"
@@ -25238,52 +25102,6 @@ static Xen gxg_gtk_widget_get_request_mode(Xen widget)
return(C_to_Xen_GtkSizeRequestMode(gtk_widget_get_request_mode(Xen_to_C_GtkWidget_(widget))));
}
-static Xen gxg_gtk_widget_get_preferred_width(Xen widget, Xen ignore_minimum_width, Xen ignore_natural_width)
-{
- #define H_gtk_widget_get_preferred_width "void gtk_widget_get_preferred_width(GtkWidget* widget, gint* [minimum_width], \
-gint* [natural_width])"
- gint ref_minimum_width;
- gint ref_natural_width;
- Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_preferred_width", "GtkWidget*");
- gtk_widget_get_preferred_width(Xen_to_C_GtkWidget_(widget), &ref_minimum_width, &ref_natural_width);
- return(Xen_list_2(C_to_Xen_gint(ref_minimum_width), C_to_Xen_gint(ref_natural_width)));
-}
-
-static Xen gxg_gtk_widget_get_preferred_height_for_width(Xen widget, Xen width, Xen ignore_minimum_height, Xen ignore_natural_height)
-{
- #define H_gtk_widget_get_preferred_height_for_width "void gtk_widget_get_preferred_height_for_width(GtkWidget* widget, \
-gint width, gint* [minimum_height], gint* [natural_height])"
- gint ref_minimum_height;
- gint ref_natural_height;
- Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_preferred_height_for_width", "GtkWidget*");
- Xen_check_type(Xen_is_gint(width), width, 2, "gtk_widget_get_preferred_height_for_width", "gint");
- gtk_widget_get_preferred_height_for_width(Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(width), &ref_minimum_height, &ref_natural_height);
- return(Xen_list_2(C_to_Xen_gint(ref_minimum_height), C_to_Xen_gint(ref_natural_height)));
-}
-
-static Xen gxg_gtk_widget_get_preferred_height(Xen widget, Xen ignore_minimum_height, Xen ignore_natural_height)
-{
- #define H_gtk_widget_get_preferred_height "void gtk_widget_get_preferred_height(GtkWidget* widget, \
-gint* [minimum_height], gint* [natural_height])"
- gint ref_minimum_height;
- gint ref_natural_height;
- Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_preferred_height", "GtkWidget*");
- gtk_widget_get_preferred_height(Xen_to_C_GtkWidget_(widget), &ref_minimum_height, &ref_natural_height);
- return(Xen_list_2(C_to_Xen_gint(ref_minimum_height), C_to_Xen_gint(ref_natural_height)));
-}
-
-static Xen gxg_gtk_widget_get_preferred_width_for_height(Xen widget, Xen height, Xen ignore_minimum_width, Xen ignore_natural_width)
-{
- #define H_gtk_widget_get_preferred_width_for_height "void gtk_widget_get_preferred_width_for_height(GtkWidget* widget, \
-gint height, gint* [minimum_width], gint* [natural_width])"
- gint ref_minimum_width;
- gint ref_natural_width;
- Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_preferred_width_for_height", "GtkWidget*");
- Xen_check_type(Xen_is_gint(height), height, 2, "gtk_widget_get_preferred_width_for_height", "gint");
- gtk_widget_get_preferred_width_for_height(Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(height), &ref_minimum_width, &ref_natural_width);
- return(Xen_list_2(C_to_Xen_gint(ref_minimum_width), C_to_Xen_gint(ref_natural_width)));
-}
-
static Xen gxg_gtk_widget_get_allocated_width(Xen widget)
{
#define H_gtk_widget_get_allocated_width "int gtk_widget_get_allocated_width(GtkWidget* widget)"
@@ -26040,21 +25858,6 @@ static Xen gxg_gtk_tooltip_trigger_tooltip_query(Xen display)
return(Xen_false);
}
-static Xen gxg_gtk_show_uri(Xen screen, Xen uri, Xen timestamp, Xen ignore_error)
-{
- #define H_gtk_show_uri "gboolean gtk_show_uri(GdkScreen* screen, gchar* uri, guint32 timestamp, GError** [error])"
- GError* ref_error = NULL;
- Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gtk_show_uri", "GdkScreen*");
- Xen_check_type(Xen_is_gchar_(uri), uri, 2, "gtk_show_uri", "gchar*");
- Xen_check_type(Xen_is_guint32(timestamp), timestamp, 3, "gtk_show_uri", "guint32");
- {
- Xen result;
- result = C_to_Xen_gboolean(gtk_show_uri(Xen_to_C_GdkScreen_(screen), (const gchar*)Xen_to_C_gchar_(uri), Xen_to_C_guint32(timestamp),
- &ref_error));
- return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
- }
-}
-
static Xen gxg_gtk_tree_view_column_new_with_area(Xen area)
{
#define H_gtk_tree_view_column_new_with_area "GtkTreeViewColumn* gtk_tree_view_column_new_with_area(GtkCellArea* area)"
@@ -26122,23 +25925,6 @@ static Xen gxg_gtk_orientable_get_orientation(Xen orientable)
return(C_to_Xen_GtkOrientation(gtk_orientable_get_orientation(Xen_to_C_GtkOrientable_(orientable))));
}
-static Xen gxg_gtk_parse_args(Xen argc, Xen argv)
-{
- #define H_gtk_parse_args "void gtk_parse_args(int* {argc}, char*** |argv|)"
- int ref_argc;
- char** ref_argv = NULL;
- ref_argc = Xen_to_C_int(argc);
- ref_argv = (char**)calloc(ref_argc, sizeof(char*));
- {
- int i;
- Xen lst;
- lst = Xen_copy_arg(argv);
- for (i = 0; i < ref_argc; i++, lst = Xen_cdr(lst)) ref_argv[i] = Xen_to_C_char_(Xen_car(lst));
- }
- gtk_parse_args(&ref_argc, &ref_argv);
- return(Xen_list_2(C_to_Xen_int(ref_argc), C_to_Xen_char__(ref_argv)));
-}
-
static Xen gxg_gtk_get_major_version(void)
{
#define H_gtk_get_major_version "guint gtk_get_major_version( void)"
@@ -26276,16 +26062,6 @@ static Xen gxg_gtk_container_unset_focus_chain(Xen container)
return(Xen_false);
}
-static Xen gxg_gtk_container_set_focus_child(Xen container, Xen child)
-{
- #define H_gtk_container_set_focus_child "void gtk_container_set_focus_child(GtkContainer* container, \
-GtkWidget* child)"
- Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_set_focus_child", "GtkContainer*");
- Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_container_set_focus_child", "GtkWidget*");
- gtk_container_set_focus_child(Xen_to_C_GtkContainer_(container), Xen_to_C_GtkWidget_(child));
- return(Xen_false);
-}
-
static Xen gxg_gtk_container_set_focus_vadjustment(Xen container, Xen adjustment)
{
#define H_gtk_container_set_focus_vadjustment "void gtk_container_set_focus_vadjustment(GtkContainer* container, \
@@ -26682,20 +26458,6 @@ static Xen gxg_gtk_cell_view_set_fit_model(Xen cell_view, Xen fit_model)
return(Xen_false);
}
-static Xen gxg_gtk_combo_box_new_with_area(Xen area)
-{
- #define H_gtk_combo_box_new_with_area "GtkWidget* gtk_combo_box_new_with_area(GtkCellArea* area)"
- Xen_check_type(Xen_is_GtkCellArea_(area), area, 1, "gtk_combo_box_new_with_area", "GtkCellArea*");
- return(C_to_Xen_GtkWidget_(gtk_combo_box_new_with_area(Xen_to_C_GtkCellArea_(area))));
-}
-
-static Xen gxg_gtk_combo_box_new_with_area_and_entry(Xen area)
-{
- #define H_gtk_combo_box_new_with_area_and_entry "GtkWidget* gtk_combo_box_new_with_area_and_entry(GtkCellArea* area)"
- Xen_check_type(Xen_is_GtkCellArea_(area), area, 1, "gtk_combo_box_new_with_area_and_entry", "GtkCellArea*");
- return(C_to_Xen_GtkWidget_(gtk_combo_box_new_with_area_and_entry(Xen_to_C_GtkCellArea_(area))));
-}
-
static Xen gxg_gtk_icon_view_new_with_area(Xen area)
{
#define H_gtk_icon_view_new_with_area "GtkWidget* gtk_icon_view_new_with_area(GtkCellArea* area)"
@@ -27380,23 +27142,6 @@ static Xen gxg_gtk_scale_get_has_origin(Xen scale)
return(C_to_Xen_gboolean(gtk_scale_get_has_origin(Xen_to_C_GtkScale_(scale))));
}
-static Xen gxg_gtk_window_set_hide_titlebar_when_maximized(Xen window, Xen setting)
-{
- #define H_gtk_window_set_hide_titlebar_when_maximized "void gtk_window_set_hide_titlebar_when_maximized(GtkWindow* window, \
-gboolean setting)"
- Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_hide_titlebar_when_maximized", "GtkWindow*");
- Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_window_set_hide_titlebar_when_maximized", "gboolean");
- gtk_window_set_hide_titlebar_when_maximized(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(setting));
- return(Xen_false);
-}
-
-static Xen gxg_gtk_window_get_hide_titlebar_when_maximized(Xen window)
-{
- #define H_gtk_window_get_hide_titlebar_when_maximized "gboolean gtk_window_get_hide_titlebar_when_maximized(GtkWindow* window)"
- Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_hide_titlebar_when_maximized", "GtkWindow*");
- return(C_to_Xen_gboolean(gtk_window_get_hide_titlebar_when_maximized(Xen_to_C_GtkWindow_(window))));
-}
-
static Xen gxg_gtk_application_window_new(Xen application)
{
#define H_gtk_application_window_new "GtkWidget* gtk_application_window_new(GtkApplication* application)"
@@ -28083,13 +27828,6 @@ static Xen gxg_gtk_widget_get_allocated_baseline(Xen widget)
return(C_to_Xen_int(gtk_widget_get_allocated_baseline(Xen_to_C_GtkWidget_(widget))));
}
-static Xen gxg_gtk_widget_get_valign_with_baseline(Xen widget)
-{
- #define H_gtk_widget_get_valign_with_baseline "GtkAlign gtk_widget_get_valign_with_baseline(GtkWidget* widget)"
- Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_valign_with_baseline", "GtkWidget*");
- return(C_to_Xen_GtkAlign(gtk_widget_get_valign_with_baseline(Xen_to_C_GtkWidget_(widget))));
-}
-
static Xen gxg_gtk_widget_init_template(Xen widget)
{
#define H_gtk_widget_init_template "void gtk_widget_init_template(GtkWidget* widget)"
@@ -29563,22 +29301,6 @@ static Xen gxg_gtk_popover_get_modal(Xen popover)
return(C_to_Xen_gboolean(gtk_popover_get_modal(Xen_to_C_GtkPopover_(popover))));
}
-static Xen gxg_gtk_box_set_center_widget(Xen box, Xen widget)
-{
- #define H_gtk_box_set_center_widget "void gtk_box_set_center_widget(GtkBox* box, GtkWidget* widget)"
- Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_set_center_widget", "GtkBox*");
- Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_box_set_center_widget", "GtkWidget*");
- gtk_box_set_center_widget(Xen_to_C_GtkBox_(box), Xen_to_C_GtkWidget_(widget));
- return(Xen_false);
-}
-
-static Xen gxg_gtk_box_get_center_widget(Xen box)
-{
- #define H_gtk_box_get_center_widget "GtkWidget* gtk_box_get_center_widget(GtkBox* box)"
- Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_get_center_widget", "GtkBox*");
- return(C_to_Xen_GtkWidget_(gtk_box_get_center_widget(Xen_to_C_GtkBox_(box))));
-}
-
static Xen gxg_gtk_entry_set_max_width_chars(Xen entry, Xen n_chars)
{
#define H_gtk_entry_set_max_width_chars "void gtk_entry_set_max_width_chars(GtkEntry* entry, gint n_chars)"
@@ -32223,6 +31945,182 @@ gint x, gint y)"
return(C_to_Xen_GtkFlowBoxChild_(gtk_flow_box_get_child_at_pos(Xen_to_C_GtkFlowBox_(box), Xen_to_C_gint(x), Xen_to_C_gint(y))));
}
+static Xen gxg_gtk_about_dialog_get_system_information(Xen about)
+{
+ #define H_gtk_about_dialog_get_system_information "gchar* gtk_about_dialog_get_system_information(GtkAboutDialog* about)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_get_system_information", "GtkAboutDialog*");
+ return(C_to_Xen_gchar_((gchar*)gtk_about_dialog_get_system_information(Xen_to_C_GtkAboutDialog_(about))));
+}
+
+static Xen gxg_gtk_about_dialog_set_system_information(Xen about, Xen system_information)
+{
+ #define H_gtk_about_dialog_set_system_information "void gtk_about_dialog_set_system_information(GtkAboutDialog* about, \
+gchar* system_information)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_set_system_information", "GtkAboutDialog*");
+ Xen_check_type(Xen_is_gchar_(system_information), system_information, 2, "gtk_about_dialog_set_system_information", "gchar*");
+ gtk_about_dialog_set_system_information(Xen_to_C_GtkAboutDialog_(about), (const gchar*)Xen_to_C_gchar_(system_information));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_action_bar_set_revealed(Xen action_bar, Xen revealed)
+{
+ #define H_gtk_action_bar_set_revealed "void gtk_action_bar_set_revealed(GtkActionBar* action_bar, gboolean revealed)"
+ Xen_check_type(Xen_is_GtkActionBar_(action_bar), action_bar, 1, "gtk_action_bar_set_revealed", "GtkActionBar*");
+ Xen_check_type(Xen_is_gboolean(revealed), revealed, 2, "gtk_action_bar_set_revealed", "gboolean");
+ gtk_action_bar_set_revealed(Xen_to_C_GtkActionBar_(action_bar), Xen_to_C_gboolean(revealed));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_action_bar_get_revealed(Xen action_bar)
+{
+ #define H_gtk_action_bar_get_revealed "gboolean gtk_action_bar_get_revealed(GtkActionBar* action_bar)"
+ Xen_check_type(Xen_is_GtkActionBar_(action_bar), action_bar, 1, "gtk_action_bar_get_revealed", "GtkActionBar*");
+ return(C_to_Xen_gboolean(gtk_action_bar_get_revealed(Xen_to_C_GtkActionBar_(action_bar))));
+}
+
+static Xen gxg_gtk_check_button_set_draw_indicator(Xen check_button, Xen draw_indicator)
+{
+ #define H_gtk_check_button_set_draw_indicator "void gtk_check_button_set_draw_indicator(GtkCheckButton* check_button, \
+gboolean draw_indicator)"
+ Xen_check_type(Xen_is_GtkCheckButton_(check_button), check_button, 1, "gtk_check_button_set_draw_indicator", "GtkCheckButton*");
+ Xen_check_type(Xen_is_gboolean(draw_indicator), draw_indicator, 2, "gtk_check_button_set_draw_indicator", "gboolean");
+ gtk_check_button_set_draw_indicator(Xen_to_C_GtkCheckButton_(check_button), Xen_to_C_gboolean(draw_indicator));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_check_button_get_draw_indicator(Xen check_button)
+{
+ #define H_gtk_check_button_get_draw_indicator "gboolean gtk_check_button_get_draw_indicator(GtkCheckButton* check_button)"
+ Xen_check_type(Xen_is_GtkCheckButton_(check_button), check_button, 1, "gtk_check_button_get_draw_indicator", "GtkCheckButton*");
+ return(C_to_Xen_gboolean(gtk_check_button_get_draw_indicator(Xen_to_C_GtkCheckButton_(check_button))));
+}
+
+static Xen gxg_gtk_check_button_set_inconsistent(Xen check_button, Xen inconsistent)
+{
+ #define H_gtk_check_button_set_inconsistent "void gtk_check_button_set_inconsistent(GtkCheckButton* check_button, \
+gboolean inconsistent)"
+ Xen_check_type(Xen_is_GtkCheckButton_(check_button), check_button, 1, "gtk_check_button_set_inconsistent", "GtkCheckButton*");
+ Xen_check_type(Xen_is_gboolean(inconsistent), inconsistent, 2, "gtk_check_button_set_inconsistent", "gboolean");
+ gtk_check_button_set_inconsistent(Xen_to_C_GtkCheckButton_(check_button), Xen_to_C_gboolean(inconsistent));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_check_button_get_inconsistent(Xen check_button)
+{
+ #define H_gtk_check_button_get_inconsistent "gboolean gtk_check_button_get_inconsistent(GtkCheckButton* check_button)"
+ Xen_check_type(Xen_is_GtkCheckButton_(check_button), check_button, 1, "gtk_check_button_get_inconsistent", "GtkCheckButton*");
+ return(C_to_Xen_gboolean(gtk_check_button_get_inconsistent(Xen_to_C_GtkCheckButton_(check_button))));
+}
+
+static Xen gxg_gtk_info_bar_set_revealed(Xen info_bar, Xen revealed)
+{
+ #define H_gtk_info_bar_set_revealed "void gtk_info_bar_set_revealed(GtkInfoBar* info_bar, gboolean revealed)"
+ Xen_check_type(Xen_is_GtkInfoBar_(info_bar), info_bar, 1, "gtk_info_bar_set_revealed", "GtkInfoBar*");
+ Xen_check_type(Xen_is_gboolean(revealed), revealed, 2, "gtk_info_bar_set_revealed", "gboolean");
+ gtk_info_bar_set_revealed(Xen_to_C_GtkInfoBar_(info_bar), Xen_to_C_gboolean(revealed));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_info_bar_get_revealed(Xen info_bar)
+{
+ #define H_gtk_info_bar_get_revealed "gboolean gtk_info_bar_get_revealed(GtkInfoBar* info_bar)"
+ Xen_check_type(Xen_is_GtkInfoBar_(info_bar), info_bar, 1, "gtk_info_bar_get_revealed", "GtkInfoBar*");
+ return(C_to_Xen_gboolean(gtk_info_bar_get_revealed(Xen_to_C_GtkInfoBar_(info_bar))));
+}
+
+static Xen gxg_gtk_widget_get_first_child(Xen widget)
+{
+ #define H_gtk_widget_get_first_child "GtkWidget* gtk_widget_get_first_child(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_first_child", "GtkWidget*");
+ return(C_to_Xen_GtkWidget_(gtk_widget_get_first_child(Xen_to_C_GtkWidget_(widget))));
+}
+
+static Xen gxg_gtk_widget_get_last_child(Xen widget)
+{
+ #define H_gtk_widget_get_last_child "GtkWidget* gtk_widget_get_last_child(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_last_child", "GtkWidget*");
+ return(C_to_Xen_GtkWidget_(gtk_widget_get_last_child(Xen_to_C_GtkWidget_(widget))));
+}
+
+static Xen gxg_gtk_widget_get_next_sibling(Xen widget)
+{
+ #define H_gtk_widget_get_next_sibling "GtkWidget* gtk_widget_get_next_sibling(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_next_sibling", "GtkWidget*");
+ return(C_to_Xen_GtkWidget_(gtk_widget_get_next_sibling(Xen_to_C_GtkWidget_(widget))));
+}
+
+static Xen gxg_gtk_widget_get_prev_sibling(Xen widget)
+{
+ #define H_gtk_widget_get_prev_sibling "GtkWidget* gtk_widget_get_prev_sibling(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_prev_sibling", "GtkWidget*");
+ return(C_to_Xen_GtkWidget_(gtk_widget_get_prev_sibling(Xen_to_C_GtkWidget_(widget))));
+}
+
+static Xen gxg_gtk_widget_set_focus_child(Xen widget, Xen child)
+{
+ #define H_gtk_widget_set_focus_child "void gtk_widget_set_focus_child(GtkWidget* widget, GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_focus_child", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_widget_set_focus_child", "GtkWidget*");
+ gtk_widget_set_focus_child(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_show_uri_on_window(Xen parent, Xen uri, Xen timestamp, Xen ignore_error)
+{
+ #define H_gtk_show_uri_on_window "gboolean gtk_show_uri_on_window(GtkWindow* parent, char* uri, guint32 timestamp, \
+GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkWindow_(parent), parent, 1, "gtk_show_uri_on_window", "GtkWindow*");
+ Xen_check_type(Xen_is_char_(uri), uri, 2, "gtk_show_uri_on_window", "char*");
+ Xen_check_type(Xen_is_guint32(timestamp), timestamp, 3, "gtk_show_uri_on_window", "guint32");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_show_uri_on_window(Xen_to_C_GtkWindow_(parent), (const char*)Xen_to_C_char_(uri), Xen_to_C_guint32(timestamp),
+ &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
+}
+
+static Xen gxg_gtk_box_pack_start(Xen box, Xen child)
+{
+ #define H_gtk_box_pack_start "void gtk_box_pack_start(GtkBox* box, GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_pack_start", "GtkBox*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_box_pack_start", "GtkWidget*");
+ gtk_box_pack_start(Xen_to_C_GtkBox_(box), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_box_pack_end(Xen box, Xen child)
+{
+ #define H_gtk_box_pack_end "void gtk_box_pack_end(GtkBox* box, GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_pack_end", "GtkBox*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_box_pack_end", "GtkWidget*");
+ gtk_box_pack_end(Xen_to_C_GtkBox_(box), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_widget_insert_after(Xen widget, Xen parent, Xen previous_sibling)
+{
+ #define H_gtk_widget_insert_after "void gtk_widget_insert_after(GtkWidget* widget, GtkWidget* parent, \
+GtkWidget* previous_sibling)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_insert_after", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(parent), parent, 2, "gtk_widget_insert_after", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(previous_sibling), previous_sibling, 3, "gtk_widget_insert_after", "GtkWidget*");
+ gtk_widget_insert_after(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkWidget_(parent), Xen_to_C_GtkWidget_(previous_sibling));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_widget_insert_before(Xen widget, Xen parent, Xen next_sibling)
+{
+ #define H_gtk_widget_insert_before "void gtk_widget_insert_before(GtkWidget* widget, GtkWidget* parent, \
+GtkWidget* next_sibling)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_insert_before", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(parent), parent, 2, "gtk_widget_insert_before", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(next_sibling), next_sibling, 3, "gtk_widget_insert_before", "GtkWidget*");
+ gtk_widget_insert_before(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkWidget_(parent), Xen_to_C_GtkWidget_(next_sibling));
+ return(Xen_false);
+}
+
#endif
static Xen gxg_cairo_create(Xen target)
@@ -35153,6 +35051,20 @@ static Xen gxg_free_cairo(Xen cr)
}
#endif
+#if (GTK_CHECK_VERSION(3, 90, 0))
+static Xen gxg_gtk_init(void)
+{
+ #define H_gtk_init "void gtk_init(void)"
+ gtk_init();
+ return(Xen_false);
+}
+static Xen gxg_gtk_init_check(void)
+{
+ #define H_gtk_init_check "void gtk_init_check(void)"
+ gtk_init_check();
+ return(Xen_false);
+}
+#else
static Xen gxg_gtk_init(Xen argc, Xen argv)
{
#define H_gtk_init "void gtk_init(int* argc, char*** argv)"
@@ -35209,6 +35121,7 @@ static Xen gxg_gtk_init_check(Xen argc, Xen argv)
result = C_to_Xen_gboolean(gtk_init_check(&ref_argc, &ref_argv));
return(Xen_list_3(result, C_to_Xen_int(ref_argc), C_to_Xen_char__(ref_argv)));
}
+#endif
}
static Xen gxg_make_target_entry(Xen lst)
@@ -35844,8 +35757,6 @@ Xen_wrap_1_arg(gxg_gtk_binding_set_by_class_w, gxg_gtk_binding_set_by_class)
Xen_wrap_1_arg(gxg_gtk_binding_set_find_w, gxg_gtk_binding_set_find)
Xen_wrap_3_args(gxg_gtk_binding_entry_remove_w, gxg_gtk_binding_entry_remove)
Xen_wrap_1_arg(gxg_gtk_bin_get_child_w, gxg_gtk_bin_get_child)
-Xen_wrap_5_args(gxg_gtk_box_pack_start_w, gxg_gtk_box_pack_start)
-Xen_wrap_5_args(gxg_gtk_box_pack_end_w, gxg_gtk_box_pack_end)
Xen_wrap_2_args(gxg_gtk_box_set_homogeneous_w, gxg_gtk_box_set_homogeneous)
Xen_wrap_1_arg(gxg_gtk_box_get_homogeneous_w, gxg_gtk_box_get_homogeneous)
Xen_wrap_2_args(gxg_gtk_box_set_spacing_w, gxg_gtk_box_set_spacing)
@@ -36443,13 +36354,9 @@ Xen_wrap_1_arg(gxg_gtk_text_view_get_tabs_w, gxg_gtk_text_view_get_tabs)
Xen_wrap_no_args(gxg_gtk_toggle_button_new_w, gxg_gtk_toggle_button_new)
Xen_wrap_1_arg(gxg_gtk_toggle_button_new_with_label_w, gxg_gtk_toggle_button_new_with_label)
Xen_wrap_1_arg(gxg_gtk_toggle_button_new_with_mnemonic_w, gxg_gtk_toggle_button_new_with_mnemonic)
-Xen_wrap_2_args(gxg_gtk_toggle_button_set_mode_w, gxg_gtk_toggle_button_set_mode)
-Xen_wrap_1_arg(gxg_gtk_toggle_button_get_mode_w, gxg_gtk_toggle_button_get_mode)
Xen_wrap_2_args(gxg_gtk_toggle_button_set_active_w, gxg_gtk_toggle_button_set_active)
Xen_wrap_1_arg(gxg_gtk_toggle_button_get_active_w, gxg_gtk_toggle_button_get_active)
Xen_wrap_1_arg(gxg_gtk_toggle_button_toggled_w, gxg_gtk_toggle_button_toggled)
-Xen_wrap_2_args(gxg_gtk_toggle_button_set_inconsistent_w, gxg_gtk_toggle_button_set_inconsistent)
-Xen_wrap_1_arg(gxg_gtk_toggle_button_get_inconsistent_w, gxg_gtk_toggle_button_get_inconsistent)
Xen_wrap_no_args(gxg_gtk_toolbar_new_w, gxg_gtk_toolbar_new)
Xen_wrap_2_args(gxg_gtk_toolbar_set_style_w, gxg_gtk_toolbar_set_style)
Xen_wrap_1_arg(gxg_gtk_toolbar_unset_style_w, gxg_gtk_toolbar_unset_style)
@@ -36630,7 +36537,6 @@ Xen_wrap_2_args(gxg_gtk_tree_view_set_reorderable_w, gxg_gtk_tree_view_set_reord
Xen_wrap_1_arg(gxg_gtk_tree_view_get_reorderable_w, gxg_gtk_tree_view_get_reorderable)
Xen_wrap_4_args(gxg_gtk_tree_view_set_cursor_w, gxg_gtk_tree_view_set_cursor)
Xen_wrap_3_optional_args(gxg_gtk_tree_view_get_cursor_w, gxg_gtk_tree_view_get_cursor)
-Xen_wrap_1_arg(gxg_gtk_tree_view_get_bin_window_w, gxg_gtk_tree_view_get_bin_window)
Xen_wrap_7_optional_args(gxg_gtk_tree_view_get_path_at_pos_w, gxg_gtk_tree_view_get_path_at_pos)
Xen_wrap_4_args(gxg_gtk_tree_view_get_cell_area_w, gxg_gtk_tree_view_get_cell_area)
Xen_wrap_4_args(gxg_gtk_tree_view_get_background_area_w, gxg_gtk_tree_view_get_background_area)
@@ -36657,7 +36563,6 @@ Xen_wrap_1_arg(gxg_gtk_widget_unparent_w, gxg_gtk_widget_unparent)
Xen_wrap_1_arg(gxg_gtk_widget_show_w, gxg_gtk_widget_show)
Xen_wrap_1_arg(gxg_gtk_widget_show_now_w, gxg_gtk_widget_show_now)
Xen_wrap_1_arg(gxg_gtk_widget_hide_w, gxg_gtk_widget_hide)
-Xen_wrap_1_arg(gxg_gtk_widget_show_all_w, gxg_gtk_widget_show_all)
Xen_wrap_1_arg(gxg_gtk_widget_map_w, gxg_gtk_widget_map)
Xen_wrap_1_arg(gxg_gtk_widget_unmap_w, gxg_gtk_widget_unmap)
Xen_wrap_1_arg(gxg_gtk_widget_realize_w, gxg_gtk_widget_realize)
@@ -36712,7 +36617,6 @@ Xen_wrap_1_arg(gxg_gtk_widget_set_default_direction_w, gxg_gtk_widget_set_defaul
Xen_wrap_no_args(gxg_gtk_widget_get_default_direction_w, gxg_gtk_widget_get_default_direction)
Xen_wrap_2_args(gxg_gtk_widget_can_activate_accel_w, gxg_gtk_widget_can_activate_accel)
Xen_wrap_1_arg(gxg_gtk_window_is_active_w, gxg_gtk_window_is_active)
-Xen_wrap_1_arg(gxg_gtk_window_has_toplevel_focus_w, gxg_gtk_window_has_toplevel_focus)
Xen_wrap_1_arg(gxg_gtk_window_new_w, gxg_gtk_window_new)
Xen_wrap_2_args(gxg_gtk_window_set_title_w, gxg_gtk_window_set_title)
Xen_wrap_1_arg(gxg_gtk_window_set_auto_startup_notification_w, gxg_gtk_window_set_auto_startup_notification)
@@ -37032,8 +36936,6 @@ Xen_wrap_1_arg(gxg_gtk_toolbar_get_show_arrow_w, gxg_gtk_toolbar_get_show_arrow)
Xen_wrap_3_args(gxg_gtk_toolbar_get_drop_index_w, gxg_gtk_toolbar_get_drop_index)
Xen_wrap_2_args(gxg_gtk_tree_view_column_set_expand_w, gxg_gtk_tree_view_column_set_expand)
Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_expand_w, gxg_gtk_tree_view_column_get_expand)
-Xen_wrap_2_args(gxg_gtk_widget_set_no_show_all_w, gxg_gtk_widget_set_no_show_all)
-Xen_wrap_1_arg(gxg_gtk_widget_get_no_show_all_w, gxg_gtk_widget_get_no_show_all)
Xen_wrap_1_arg(gxg_gtk_widget_queue_resize_no_redraw_w, gxg_gtk_widget_queue_resize_no_redraw)
Xen_wrap_1_arg(gxg_gtk_window_set_default_icon_w, gxg_gtk_window_set_default_icon)
Xen_wrap_2_args(gxg_gtk_window_set_keep_above_w, gxg_gtk_window_set_keep_above)
@@ -37393,8 +37295,6 @@ Xen_wrap_1_arg(gxg_gtk_label_get_single_line_mode_w, gxg_gtk_label_get_single_li
Xen_wrap_2_args(gxg_gtk_progress_bar_set_ellipsize_w, gxg_gtk_progress_bar_set_ellipsize)
Xen_wrap_1_arg(gxg_gtk_progress_bar_get_ellipsize_w, gxg_gtk_progress_bar_get_ellipsize)
Xen_wrap_2_args(gxg_gtk_selection_data_targets_include_image_w, gxg_gtk_selection_data_targets_include_image)
-Xen_wrap_2_args(gxg_gtk_label_set_angle_w, gxg_gtk_label_set_angle)
-Xen_wrap_1_arg(gxg_gtk_label_get_angle_w, gxg_gtk_label_get_angle)
Xen_wrap_2_args(gxg_gtk_menu_set_screen_w, gxg_gtk_menu_set_screen)
Xen_wrap_3_args(gxg_pango_attr_underline_color_new_w, gxg_pango_attr_underline_color_new)
Xen_wrap_3_args(gxg_pango_attr_strikethrough_color_new_w, gxg_pango_attr_strikethrough_color_new)
@@ -37835,7 +37735,6 @@ Xen_wrap_2_args(gxg_gtk_calendar_set_detail_height_rows_w, gxg_gtk_calendar_set_
Xen_wrap_1_arg(gxg_gtk_calendar_get_detail_width_chars_w, gxg_gtk_calendar_get_detail_width_chars)
Xen_wrap_1_arg(gxg_gtk_calendar_get_detail_height_rows_w, gxg_gtk_calendar_get_detail_height_rows)
Xen_wrap_1_arg(gxg_gtk_accel_group_get_is_locked_w, gxg_gtk_accel_group_get_is_locked)
-Xen_wrap_1_arg(gxg_gtk_container_get_focus_child_w, gxg_gtk_container_get_focus_child)
Xen_wrap_1_arg(gxg_gtk_dialog_get_content_area_w, gxg_gtk_dialog_get_content_area)
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)
@@ -37989,7 +37888,6 @@ Xen_wrap_1_arg(gxg_gtk_widget_get_receives_default_w, gxg_gtk_widget_get_receive
#if GTK_CHECK_VERSION(2, 20, 0)
Xen_wrap_2_args(gxg_gtk_dialog_get_widget_for_response_w, gxg_gtk_dialog_get_widget_for_response)
-Xen_wrap_1_arg(gxg_gtk_viewport_get_bin_window_w, gxg_gtk_viewport_get_bin_window)
Xen_wrap_no_args(gxg_gtk_spinner_new_w, gxg_gtk_spinner_new)
Xen_wrap_1_arg(gxg_gtk_spinner_start_w, gxg_gtk_spinner_start)
Xen_wrap_1_arg(gxg_gtk_spinner_stop_w, gxg_gtk_spinner_stop)
@@ -38096,7 +37994,6 @@ Xen_wrap_3_args(gxg_gtk_calendar_select_month_w, gxg_gtk_calendar_select_month)
Xen_wrap_2_args(gxg_gtk_calendar_mark_day_w, gxg_gtk_calendar_mark_day)
Xen_wrap_2_args(gxg_gtk_calendar_unmark_day_w, gxg_gtk_calendar_unmark_day)
Xen_wrap_1_arg(gxg_gdk_drag_context_get_source_window_w, gxg_gdk_drag_context_get_source_window)
-Xen_wrap_1_arg(gxg_gtk_viewport_get_view_window_w, gxg_gtk_viewport_get_view_window)
Xen_wrap_2_args(gxg_gtk_accessible_set_widget_w, gxg_gtk_accessible_set_widget)
Xen_wrap_1_arg(gxg_gtk_message_dialog_get_message_area_w, gxg_gtk_message_dialog_get_message_area)
Xen_wrap_1_arg(gxg_gtk_selection_data_get_length_w, gxg_gtk_selection_data_get_length)
@@ -38138,10 +38035,6 @@ Xen_wrap_2_args(gxg_gtk_notebook_set_group_name_w, gxg_gtk_notebook_set_group_na
Xen_wrap_1_arg(gxg_gtk_notebook_get_group_name_w, gxg_gtk_notebook_get_group_name)
Xen_wrap_2_args(gxg_gtk_widget_draw_w, gxg_gtk_widget_draw)
Xen_wrap_1_arg(gxg_gtk_widget_get_request_mode_w, gxg_gtk_widget_get_request_mode)
-Xen_wrap_3_optional_args(gxg_gtk_widget_get_preferred_width_w, gxg_gtk_widget_get_preferred_width)
-Xen_wrap_4_optional_args(gxg_gtk_widget_get_preferred_height_for_width_w, gxg_gtk_widget_get_preferred_height_for_width)
-Xen_wrap_3_optional_args(gxg_gtk_widget_get_preferred_height_w, gxg_gtk_widget_get_preferred_height)
-Xen_wrap_4_optional_args(gxg_gtk_widget_get_preferred_width_for_height_w, gxg_gtk_widget_get_preferred_width_for_height)
Xen_wrap_1_arg(gxg_gtk_widget_get_allocated_width_w, gxg_gtk_widget_get_allocated_width)
Xen_wrap_1_arg(gxg_gtk_widget_get_allocated_height_w, gxg_gtk_widget_get_allocated_height)
Xen_wrap_1_arg(gxg_gtk_widget_get_halign_w, gxg_gtk_widget_get_halign)
@@ -38232,7 +38125,6 @@ Xen_wrap_2_args(gxg_gtk_tooltip_set_markup_w, gxg_gtk_tooltip_set_markup)
Xen_wrap_2_args(gxg_gtk_tooltip_set_icon_w, gxg_gtk_tooltip_set_icon)
Xen_wrap_2_args(gxg_gtk_tooltip_set_custom_w, gxg_gtk_tooltip_set_custom)
Xen_wrap_1_arg(gxg_gtk_tooltip_trigger_tooltip_query_w, gxg_gtk_tooltip_trigger_tooltip_query)
-Xen_wrap_4_optional_args(gxg_gtk_show_uri_w, gxg_gtk_show_uri)
Xen_wrap_1_arg(gxg_gtk_tree_view_column_new_with_area_w, gxg_gtk_tree_view_column_new_with_area)
Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_button_w, gxg_gtk_tree_view_column_get_button)
Xen_wrap_2_args(gxg_gtk_tree_view_column_focus_cell_w, gxg_gtk_tree_view_column_focus_cell)
@@ -38241,7 +38133,6 @@ Xen_wrap_3_args(gxg_gtk_toolbar_set_drop_highlight_item_w, gxg_gtk_toolbar_set_d
Xen_wrap_1_arg(gxg_gtk_tool_item_toolbar_reconfigured_w, gxg_gtk_tool_item_toolbar_reconfigured)
Xen_wrap_2_args(gxg_gtk_orientable_set_orientation_w, gxg_gtk_orientable_set_orientation)
Xen_wrap_1_arg(gxg_gtk_orientable_get_orientation_w, gxg_gtk_orientable_get_orientation)
-Xen_wrap_2_optional_args(gxg_gtk_parse_args_w, gxg_gtk_parse_args)
Xen_wrap_no_args(gxg_gtk_get_major_version_w, gxg_gtk_get_major_version)
Xen_wrap_no_args(gxg_gtk_get_minor_version_w, gxg_gtk_get_minor_version)
Xen_wrap_no_args(gxg_gtk_get_micro_version_w, gxg_gtk_get_micro_version)
@@ -38259,7 +38150,6 @@ Xen_wrap_3_args(gxg_gtk_container_propagate_draw_w, gxg_gtk_container_propagate_
Xen_wrap_2_args(gxg_gtk_container_set_focus_chain_w, gxg_gtk_container_set_focus_chain)
Xen_wrap_2_optional_args(gxg_gtk_container_get_focus_chain_w, gxg_gtk_container_get_focus_chain)
Xen_wrap_1_arg(gxg_gtk_container_unset_focus_chain_w, gxg_gtk_container_unset_focus_chain)
-Xen_wrap_2_args(gxg_gtk_container_set_focus_child_w, gxg_gtk_container_set_focus_child)
Xen_wrap_2_args(gxg_gtk_container_set_focus_vadjustment_w, gxg_gtk_container_set_focus_vadjustment)
Xen_wrap_1_arg(gxg_gtk_container_get_focus_vadjustment_w, gxg_gtk_container_get_focus_vadjustment)
Xen_wrap_2_args(gxg_gtk_container_set_focus_hadjustment_w, gxg_gtk_container_set_focus_hadjustment)
@@ -38306,8 +38196,6 @@ Xen_wrap_1_arg(gxg_gtk_cell_view_get_draw_sensitive_w, gxg_gtk_cell_view_get_dra
Xen_wrap_2_args(gxg_gtk_cell_view_set_draw_sensitive_w, gxg_gtk_cell_view_set_draw_sensitive)
Xen_wrap_1_arg(gxg_gtk_cell_view_get_fit_model_w, gxg_gtk_cell_view_get_fit_model)
Xen_wrap_2_args(gxg_gtk_cell_view_set_fit_model_w, gxg_gtk_cell_view_set_fit_model)
-Xen_wrap_1_arg(gxg_gtk_combo_box_new_with_area_w, gxg_gtk_combo_box_new_with_area)
-Xen_wrap_1_arg(gxg_gtk_combo_box_new_with_area_and_entry_w, gxg_gtk_combo_box_new_with_area_and_entry)
Xen_wrap_1_arg(gxg_gtk_icon_view_new_with_area_w, gxg_gtk_icon_view_new_with_area)
Xen_wrap_2_args(gxg_gtk_menu_item_set_reserve_indicator_w, gxg_gtk_menu_item_set_reserve_indicator)
Xen_wrap_1_arg(gxg_gtk_menu_item_get_reserve_indicator_w, gxg_gtk_menu_item_get_reserve_indicator)
@@ -38388,8 +38276,6 @@ Xen_wrap_2_args(gxg_gtk_application_set_menubar_w, gxg_gtk_application_set_menub
Xen_wrap_2_args(gxg_gtk_entry_completion_compute_prefix_w, gxg_gtk_entry_completion_compute_prefix)
Xen_wrap_2_args(gxg_gtk_scale_set_has_origin_w, gxg_gtk_scale_set_has_origin)
Xen_wrap_1_arg(gxg_gtk_scale_get_has_origin_w, gxg_gtk_scale_get_has_origin)
-Xen_wrap_2_args(gxg_gtk_window_set_hide_titlebar_when_maximized_w, gxg_gtk_window_set_hide_titlebar_when_maximized)
-Xen_wrap_1_arg(gxg_gtk_window_get_hide_titlebar_when_maximized_w, gxg_gtk_window_get_hide_titlebar_when_maximized)
Xen_wrap_1_arg(gxg_gtk_application_window_new_w, gxg_gtk_application_window_new)
Xen_wrap_2_args(gxg_gtk_application_window_set_show_menubar_w, gxg_gtk_application_window_set_show_menubar)
Xen_wrap_1_arg(gxg_gtk_application_window_get_show_menubar_w, gxg_gtk_application_window_get_show_menubar)
@@ -38477,7 +38363,6 @@ 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_get_valign_with_baseline_w, gxg_gtk_widget_get_valign_with_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)
Xen_wrap_no_args(gxg_gtk_places_sidebar_new_w, gxg_gtk_places_sidebar_new)
@@ -38651,8 +38536,6 @@ Xen_wrap_2_args(gxg_gtk_popover_set_position_w, gxg_gtk_popover_set_position)
Xen_wrap_1_arg(gxg_gtk_popover_get_position_w, gxg_gtk_popover_get_position)
Xen_wrap_2_args(gxg_gtk_popover_set_modal_w, gxg_gtk_popover_set_modal)
Xen_wrap_1_arg(gxg_gtk_popover_get_modal_w, gxg_gtk_popover_get_modal)
-Xen_wrap_2_args(gxg_gtk_box_set_center_widget_w, gxg_gtk_box_set_center_widget)
-Xen_wrap_1_arg(gxg_gtk_box_get_center_widget_w, gxg_gtk_box_get_center_widget)
Xen_wrap_2_args(gxg_gtk_entry_set_max_width_chars_w, gxg_gtk_entry_set_max_width_chars)
Xen_wrap_1_arg(gxg_gtk_entry_get_max_width_chars_w, gxg_gtk_entry_get_max_width_chars)
Xen_wrap_1_arg(gxg_gdk_device_get_last_event_window_w, gxg_gdk_device_get_last_event_window)
@@ -38961,6 +38844,26 @@ Xen_wrap_1_arg(gxg_gdk_rgba_is_clear_w, gxg_gdk_rgba_is_clear)
Xen_wrap_1_arg(gxg_gdk_rgba_is_opaque_w, gxg_gdk_rgba_is_opaque)
Xen_wrap_3_args(gxg_gdk_window_begin_draw_frame_w, gxg_gdk_window_begin_draw_frame)
Xen_wrap_3_args(gxg_gtk_flow_box_get_child_at_pos_w, gxg_gtk_flow_box_get_child_at_pos)
+Xen_wrap_1_arg(gxg_gtk_about_dialog_get_system_information_w, gxg_gtk_about_dialog_get_system_information)
+Xen_wrap_2_args(gxg_gtk_about_dialog_set_system_information_w, gxg_gtk_about_dialog_set_system_information)
+Xen_wrap_2_args(gxg_gtk_action_bar_set_revealed_w, gxg_gtk_action_bar_set_revealed)
+Xen_wrap_1_arg(gxg_gtk_action_bar_get_revealed_w, gxg_gtk_action_bar_get_revealed)
+Xen_wrap_2_args(gxg_gtk_check_button_set_draw_indicator_w, gxg_gtk_check_button_set_draw_indicator)
+Xen_wrap_1_arg(gxg_gtk_check_button_get_draw_indicator_w, gxg_gtk_check_button_get_draw_indicator)
+Xen_wrap_2_args(gxg_gtk_check_button_set_inconsistent_w, gxg_gtk_check_button_set_inconsistent)
+Xen_wrap_1_arg(gxg_gtk_check_button_get_inconsistent_w, gxg_gtk_check_button_get_inconsistent)
+Xen_wrap_2_args(gxg_gtk_info_bar_set_revealed_w, gxg_gtk_info_bar_set_revealed)
+Xen_wrap_1_arg(gxg_gtk_info_bar_get_revealed_w, gxg_gtk_info_bar_get_revealed)
+Xen_wrap_1_arg(gxg_gtk_widget_get_first_child_w, gxg_gtk_widget_get_first_child)
+Xen_wrap_1_arg(gxg_gtk_widget_get_last_child_w, gxg_gtk_widget_get_last_child)
+Xen_wrap_1_arg(gxg_gtk_widget_get_next_sibling_w, gxg_gtk_widget_get_next_sibling)
+Xen_wrap_1_arg(gxg_gtk_widget_get_prev_sibling_w, gxg_gtk_widget_get_prev_sibling)
+Xen_wrap_2_args(gxg_gtk_widget_set_focus_child_w, gxg_gtk_widget_set_focus_child)
+Xen_wrap_4_optional_args(gxg_gtk_show_uri_on_window_w, gxg_gtk_show_uri_on_window)
+Xen_wrap_2_args(gxg_gtk_box_pack_start_w, gxg_gtk_box_pack_start)
+Xen_wrap_2_args(gxg_gtk_box_pack_end_w, gxg_gtk_box_pack_end)
+Xen_wrap_3_args(gxg_gtk_widget_insert_after_w, gxg_gtk_widget_insert_after)
+Xen_wrap_3_args(gxg_gtk_widget_insert_before_w, gxg_gtk_widget_insert_before)
#endif
Xen_wrap_1_arg(gxg_cairo_create_w, gxg_cairo_create)
@@ -39236,8 +39139,13 @@ Xen_wrap_1_arg(gxg_make_target_entry_w, gxg_make_target_entry)
Xen_wrap_3_args(xg_object_get_w, xg_object_get)
Xen_wrap_3_args(xg_object_set_w, xg_object_set)
Xen_wrap_1_arg(xg_gtk_event_keyval_w, xg_gtk_event_keyval)
+#if (GTK_CHECK_VERSION(3, 90, 0))
+Xen_wrap_no_args(gxg_gtk_init_w, gxg_gtk_init)
+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)
+#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)
Xen_wrap_1_arg(gxg_GDK_KEYMAP_w, gxg_GDK_KEYMAP)
@@ -39699,7 +39607,7 @@ Xen_wrap_1_arg(gxg_GTK_IS_SHORTCUT_LABEL_w, gxg_GTK_IS_SHORTCUT_LABEL)
#if HAVE_SCHEME
static s7_pointer s_boolean, s_integer, s_real, s_string, s_any, s_pair, s_float, s_gtk_enum_t, s_pair_false;
-static s7_pointer pl_t, pl_isigutttiiu, pl_isi, pl_tts, pl_tti, pl_isgt, pl_sig, pl_si, pl_is, pl_igi, pl_gi, 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_s, pl_tsu, pl_tsb, pl_st, pl_tsig, pl_ts, pl_tsi, pl_tsiu, pl_tsiiuui, pl_tsiuui, pl_prrru, pl_dust, pl_dut, pl_du, pl_dusr, pl_dus, pl_pr, pl_g, pl_p, pl_tg, pl_tusiuiuit, 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_tuubbi, 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_tusrt, pl_tusi, pl_turt, pl_tuui, pl_tut, pl_tuur, pl_tuig, pl_tur, pl_tub, pl_tui, pl_tu, pl_tus, pl_tusb, 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_ssig, pl_ssi, pl_sg, pl_gs, 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_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_pur, pl_puit, 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_big, pl_bi, pl_b, pl_btiib, pl_bti, pl_bt, pl_tb, pl_bsu, pl_bsigb, pl_bur, pl_buug, pl_buut, 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_bui, pl_busu, pl_but, pl_buib, pl_buiu, pl_bub, pl_buub, pl_pb, pl_buig, pl_buuig, pl_iiit, pl_iit, pl_i, pl_tiu, pl_itiiub, pl_itsub, pl_itstttg, pl_itgiiut, pl_ti, pl_it, pl_bpt;
+static s7_pointer pl_prrru, pl_dust, pl_dut, pl_du, pl_dusr, pl_dus, pl_pr, pl_t, pl_tts, pl_tti, 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_puit, 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_tusiuiuit, 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_tusrt, pl_tusi, pl_turt, pl_tuui, pl_tut, pl_tuur, pl_tuig, pl_tur, pl_tub, pl_tui, pl_tu, pl_tus, pl_tusb, 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_igi, pl_gi, pl_bsu, pl_bsigb, pl_bur, pl_sg, pl_buug, pl_buut, 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_bui, pl_busu, pl_but, pl_buib, pl_buiu, pl_bub, pl_buub, pl_pb, pl_gs, pl_buig, pl_buuig, 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_iiit, pl_iit, pl_isigutttiiu, pl_isi, pl_isgt, pl_sig, pl_si, pl_is, 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_bpt;
#endif
static void define_functions(void)
@@ -39721,33 +39629,100 @@ static void define_functions(void)
s_gtk_enum_t = s7_make_symbol(s7, "gtk_enum_t?");
s_any = s7_t(s7);
+ pl_prrru = s7_make_circular_signature(s7, 4, 5, s_pair, s_real, s_real, s_real, s_pair_false);
+ pl_dust = s7_make_circular_signature(s7, 3, 4, s_float, s_pair_false, s_string, s_any);
+ pl_dut = s7_make_circular_signature(s7, 2, 3, s_float, s_pair_false, s_any);
+ pl_du = s7_make_circular_signature(s7, 1, 2, s_float, s_pair_false);
+ pl_dusr = s7_make_circular_signature(s7, 3, 4, s_float, s_pair_false, s_string, s_real);
+ pl_dus = s7_make_circular_signature(s7, 2, 3, s_float, s_pair_false, s_string);
+ pl_pr = s7_make_circular_signature(s7, 1, 2, s_pair, s_real);
pl_t = s7_make_circular_signature(s7, 0, 1, s_any);
- 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_tts = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_string);
pl_tti = s7_make_circular_signature(s7, 2, 3, s_any, s_any, 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_igi = s7_make_circular_signature(s7, 2, 3, s_integer, s_gtk_enum_t, s_integer);
- pl_gi = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_integer);
- pl_iur = s7_make_circular_signature(s7, 2, 3, s_integer, s_pair_false, s_real);
- pl_iugi = s7_make_circular_signature(s7, 3, 4, s_integer, s_pair_false, s_gtk_enum_t, s_integer);
- pl_iuisi = s7_make_circular_signature(s7, 4, 5, s_integer, s_pair_false, s_integer, s_string, s_integer);
- pl_iuuui = s7_make_circular_signature(s7, 4, 5, s_integer, s_pair_false, s_pair_false, s_pair_false, s_integer);
- pl_iuuuui = s7_make_circular_signature(s7, 5, 6, s_integer, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_integer);
- pl_iuis = s7_make_circular_signature(s7, 3, 4, s_integer, s_pair_false, s_integer, s_string);
- pl_iug = s7_make_circular_signature(s7, 2, 3, s_integer, s_pair_false, s_gtk_enum_t);
- pl_pit = s7_make_circular_signature(s7, 2, 3, s_pair, s_integer, s_any);
- pl_piu = s7_make_circular_signature(s7, 2, 3, s_pair, s_integer, s_pair_false);
- pl_ius = s7_make_circular_signature(s7, 2, 3, s_integer, s_pair_false, s_string);
- pl_iusi = s7_make_circular_signature(s7, 3, 4, s_integer, s_pair_false, s_string, s_integer);
- pl_iu = s7_make_circular_signature(s7, 1, 2, s_integer, s_pair_false);
- pl_iuui = s7_make_circular_signature(s7, 3, 4, s_integer, s_pair_false, s_pair_false, s_integer);
- pl_pi = s7_make_circular_signature(s7, 1, 2, s_pair, s_integer);
- pl_iui = s7_make_circular_signature(s7, 2, 3, s_integer, s_pair_false, s_integer);
- pl_iuisut = s7_make_circular_signature(s7, 5, 6, s_integer, s_pair_false, s_integer, s_string, s_pair_false, s_any);
+ pl_ssig = s7_make_circular_signature(s7, 3, 4, s_string, s_string, s_integer, s_gtk_enum_t);
+ pl_ssi = s7_make_circular_signature(s7, 2, 3, s_string, s_string, s_integer);
+ pl_psgi = s7_make_circular_signature(s7, 3, 4, s_pair, s_string, s_gtk_enum_t, s_integer);
+ pl_suiig = s7_make_circular_signature(s7, 4, 5, s_string, s_pair_false, s_integer, s_integer, s_gtk_enum_t);
+ pl_sug = s7_make_circular_signature(s7, 2, 3, s_string, s_pair_false, s_gtk_enum_t);
+ pl_psiuub = s7_make_circular_signature(s7, 5, 6, s_pair, s_string, s_integer, s_pair_false, s_pair_false, s_boolean);
+ pl_psgbiiiit = s7_make_circular_signature(s7, 8, 9, s_pair, s_string, s_gtk_enum_t, s_boolean, s_integer, s_integer, s_integer, s_integer, s_any);
+ pl_psrrrb = s7_make_circular_signature(s7, 5, 6, s_pair, s_string, s_real, s_real, s_real, s_boolean);
+ pl_sui = s7_make_circular_signature(s7, 2, 3, s_string, s_pair_false, s_integer);
+ pl_suuub = s7_make_circular_signature(s7, 4, 5, s_string, s_pair_false, s_pair_false, s_pair_false, s_boolean);
+ pl_psu = s7_make_circular_signature(s7, 2, 3, s_pair, s_string, s_pair_false);
+ pl_psb = s7_make_circular_signature(s7, 2, 3, s_pair, s_string, s_boolean);
+ pl_su = s7_make_circular_signature(s7, 1, 2, s_string, s_pair_false);
+ pl_sus = s7_make_circular_signature(s7, 2, 3, s_string, s_pair_false, s_string);
+ pl_ps = s7_make_circular_signature(s7, 1, 2, s_pair, s_string);
+ pl_psg = s7_make_circular_signature(s7, 2, 3, s_pair, s_string, s_gtk_enum_t);
+ pl_psi = s7_make_circular_signature(s7, 2, 3, s_pair, s_string, s_integer);
+ pl_psugt = s7_make_circular_signature(s7, 4, 5, s_pair, s_string, s_pair_false, s_gtk_enum_t, s_any);
+ pl_psiu = s7_make_circular_signature(s7, 3, 4, s_pair, s_string, s_integer, s_pair_false);
+ pl_psiiuusu = s7_make_circular_signature(s7, 7, 8, s_pair, s_string, s_integer, s_integer, s_pair_false, s_pair_false, s_string, s_pair_false);
+ pl_psut = s7_make_circular_signature(s7, 3, 4, s_pair, s_string, s_pair_false, s_any);
+ pl_pur = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_real);
+ pl_puit = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_integer, s_any);
+ pl_puuui = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_pair_false, s_pair_false, s_integer);
+ pl_pusiig = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_string, s_integer, s_integer, s_gtk_enum_t);
+ pl_pusiigu = s7_make_circular_signature(s7, 6, 7, s_pair, s_pair_false, s_string, s_integer, s_integer, s_gtk_enum_t, s_pair_false);
+ pl_pusiiugu = s7_make_circular_signature(s7, 7, 8, s_pair, s_pair_false, s_string, s_integer, s_integer, s_pair_false, s_gtk_enum_t, s_pair_false);
+ pl_puuiig = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_pair_false, s_integer, s_integer, s_gtk_enum_t);
+ pl_puur = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_pair_false, s_real);
+ pl_purru = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_real, s_real, s_pair_false);
+ pl_puiiui = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_integer, s_integer, s_pair_false, s_integer);
+ pl_pugi = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_gtk_enum_t, s_integer);
+ pl_puuig = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_pair_false, s_integer, s_gtk_enum_t);
+ pl_puttiiiu = s7_make_circular_signature(s7, 7, 8, s_pair, s_pair_false, s_any, s_any, s_integer, s_integer, s_integer, s_pair_false);
+ pl_pubi = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_boolean, s_integer);
+ pl_puiig = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_integer, s_integer, s_gtk_enum_t);
+ pl_puiigi = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_integer, s_integer, s_gtk_enum_t, s_integer);
+ pl_puigu = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_integer, s_gtk_enum_t, s_pair_false);
+ pl_puuusuug = s7_make_circular_signature(s7, 7, 8, s_pair, s_pair_false, s_pair_false, s_pair_false, s_string, s_pair_false, s_pair_false, s_gtk_enum_t);
+ pl_pusi = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_string, s_integer);
+ pl_pusiu = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_string, s_integer, s_pair_false);
+ pl_putu = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_any, s_pair_false);
+ pl_puri = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_real, s_integer);
+ pl_pusub = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_string, s_pair_false, s_boolean);
+ pl_pust = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_string, s_any);
+ pl_pub = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_boolean);
+ pl_puuiu = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_pair_false, s_integer, s_pair_false);
+ 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_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);
+ pl_pui = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_integer);
+ pl_pussu = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_string, s_string, s_pair_false);
+ pl_puibu = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_integer, s_boolean, s_pair_false);
+ pl_pus = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_string);
+ pl_pug = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_gtk_enum_t);
+ pl_put = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_any);
+ pl_pusigu = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_string, s_integer, s_gtk_enum_t, s_pair_false);
+ pl_pusig = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_string, s_integer, s_gtk_enum_t);
+ pl_puui = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_pair_false, s_integer);
+ pl_puiu = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_integer, s_pair_false);
+ pl_pusiuiu = s7_make_circular_signature(s7, 6, 7, s_pair, s_pair_false, s_string, s_integer, s_pair_false, s_integer, s_pair_false);
+ pl_pusiuibu = s7_make_circular_signature(s7, 7, 8, s_pair, s_pair_false, s_string, s_integer, s_pair_false, s_integer, s_boolean, s_pair_false);
+ pl_pusiiu = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_string, s_integer, s_integer, s_pair_false);
+ pl_puuiiu = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_pair_false, s_integer, s_integer, s_pair_false);
+ pl_b = s7_make_circular_signature(s7, 0, 1, s_boolean);
+ pl_btiib = s7_make_circular_signature(s7, 4, 5, s_boolean, s_any, s_integer, s_integer, s_boolean);
+ pl_bti = s7_make_circular_signature(s7, 2, 3, s_boolean, s_any, s_integer);
+ 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_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);
+ pl_itstttg = s7_make_circular_signature(s7, 6, 7, s_integer, s_any, s_string, s_any, s_any, s_any, s_gtk_enum_t);
+ pl_itgiiut = s7_make_circular_signature(s7, 6, 7, s_integer, s_any, s_gtk_enum_t, s_integer, s_integer, s_pair_false, s_any);
+ pl_ti = s7_make_circular_signature(s7, 1, 2, s_any, s_integer);
+ pl_it = s7_make_circular_signature(s7, 1, 2, s_integer, s_any);
pl_s = s7_make_circular_signature(s7, 0, 1, s_string);
pl_tsu = s7_make_circular_signature(s7, 2, 3, s_any, s_string, s_pair_false);
pl_tsb = s7_make_circular_signature(s7, 2, 3, s_any, s_string, s_boolean);
@@ -39758,16 +39733,7 @@ static void define_functions(void)
pl_tsiu = s7_make_circular_signature(s7, 3, 4, s_any, s_string, s_integer, s_pair_false);
pl_tsiiuui = s7_make_circular_signature(s7, 6, 7, s_any, s_string, s_integer, s_integer, s_pair_false, s_pair_false, s_integer);
pl_tsiuui = s7_make_circular_signature(s7, 5, 6, s_any, s_string, s_integer, s_pair_false, s_pair_false, s_integer);
- pl_prrru = s7_make_circular_signature(s7, 4, 5, s_pair, s_real, s_real, s_real, s_pair_false);
- pl_dust = s7_make_circular_signature(s7, 3, 4, s_float, s_pair_false, s_string, s_any);
- pl_dut = s7_make_circular_signature(s7, 2, 3, s_float, s_pair_false, s_any);
- pl_du = s7_make_circular_signature(s7, 1, 2, s_float, s_pair_false);
- pl_dusr = s7_make_circular_signature(s7, 3, 4, s_float, s_pair_false, s_string, s_real);
- pl_dus = s7_make_circular_signature(s7, 2, 3, s_float, s_pair_false, s_string);
- pl_pr = s7_make_circular_signature(s7, 1, 2, s_pair, s_real);
- pl_g = s7_make_circular_signature(s7, 0, 1, s_gtk_enum_t);
pl_p = s7_make_circular_signature(s7, 0, 1, s_pair);
- pl_tg = s7_make_circular_signature(s7, 1, 2, s_any, s_gtk_enum_t);
pl_tusiuiuit = s7_make_circular_signature(s7, 8, 9, s_any, s_pair_false, s_string, s_integer, s_pair_false, s_integer, s_pair_false, s_integer, s_any);
pl_tuuiu = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_pair_false, s_integer, s_pair_false);
pl_tussu = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_string, s_string, s_pair_false);
@@ -39801,7 +39767,6 @@ static void define_functions(void)
pl_tuuiiiirrrrgi = s7_make_circular_signature(s7, 12, 13, s_any, s_pair_false, s_pair_false, s_integer, s_integer, s_integer, s_integer, s_real, s_real, s_real, s_real, s_gtk_enum_t, s_integer);
pl_tuiggu = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_integer, s_gtk_enum_t, s_gtk_enum_t, s_pair_false);
pl_turrrb = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_real, s_real, s_real, s_boolean);
- pl_tuubbi = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_pair_false, s_boolean, s_boolean, s_integer);
pl_tuubbig = s7_make_circular_signature(s7, 6, 7, s_any, s_pair_false, s_pair_false, s_boolean, s_boolean, s_integer, s_gtk_enum_t);
pl_pt = s7_make_circular_signature(s7, 1, 2, s_pair, s_any);
pl_tuuti = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_pair_false, s_any, s_integer);
@@ -39860,101 +39825,14 @@ static void define_functions(void)
pl_tuuug = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_pair_false, s_pair_false, s_gtk_enum_t);
pl_tusuig = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_string, s_pair_false, s_integer, s_gtk_enum_t);
pl_tuuubr = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_pair_false, s_pair_false, s_boolean, s_real);
- pl_ssig = s7_make_circular_signature(s7, 3, 4, s_string, s_string, s_integer, s_gtk_enum_t);
- pl_ssi = s7_make_circular_signature(s7, 2, 3, s_string, s_string, s_integer);
- 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_psgi = s7_make_circular_signature(s7, 3, 4, s_pair, s_string, s_gtk_enum_t, s_integer);
- pl_suiig = s7_make_circular_signature(s7, 4, 5, s_string, s_pair_false, s_integer, s_integer, s_gtk_enum_t);
- pl_sug = s7_make_circular_signature(s7, 2, 3, s_string, s_pair_false, s_gtk_enum_t);
- pl_psiuub = s7_make_circular_signature(s7, 5, 6, s_pair, s_string, s_integer, s_pair_false, s_pair_false, s_boolean);
- pl_psgbiiiit = s7_make_circular_signature(s7, 8, 9, s_pair, s_string, s_gtk_enum_t, s_boolean, s_integer, s_integer, s_integer, s_integer, s_any);
- pl_psrrrb = s7_make_circular_signature(s7, 5, 6, s_pair, s_string, s_real, s_real, s_real, s_boolean);
- pl_sui = s7_make_circular_signature(s7, 2, 3, s_string, s_pair_false, s_integer);
- pl_suuub = s7_make_circular_signature(s7, 4, 5, s_string, s_pair_false, s_pair_false, s_pair_false, s_boolean);
- pl_psu = s7_make_circular_signature(s7, 2, 3, s_pair, s_string, s_pair_false);
- pl_psb = s7_make_circular_signature(s7, 2, 3, s_pair, s_string, s_boolean);
- pl_su = s7_make_circular_signature(s7, 1, 2, s_string, s_pair_false);
- pl_sus = s7_make_circular_signature(s7, 2, 3, s_string, s_pair_false, s_string);
- pl_ps = s7_make_circular_signature(s7, 1, 2, s_pair, s_string);
- pl_psg = s7_make_circular_signature(s7, 2, 3, s_pair, s_string, s_gtk_enum_t);
- pl_psi = s7_make_circular_signature(s7, 2, 3, s_pair, s_string, s_integer);
- pl_psugt = s7_make_circular_signature(s7, 4, 5, s_pair, s_string, s_pair_false, s_gtk_enum_t, s_any);
- pl_psiu = s7_make_circular_signature(s7, 3, 4, s_pair, s_string, s_integer, s_pair_false);
- pl_psiiuusu = s7_make_circular_signature(s7, 7, 8, s_pair, s_string, s_integer, s_integer, s_pair_false, s_pair_false, s_string, s_pair_false);
- pl_psut = s7_make_circular_signature(s7, 3, 4, s_pair, s_string, s_pair_false, s_any);
- 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);
- pl_guut = s7_make_circular_signature(s7, 3, 4, s_gtk_enum_t, s_pair_false, s_pair_false, s_any);
- pl_guuut = s7_make_circular_signature(s7, 4, 5, s_gtk_enum_t, s_pair_false, s_pair_false, s_pair_false, s_any);
- pl_guugbuut = s7_make_circular_signature(s7, 7, 8, s_gtk_enum_t, s_pair_false, s_pair_false, s_gtk_enum_t, s_boolean, s_pair_false, s_pair_false, s_any);
- pl_pgr = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_real);
- pl_pgu = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_pair_false);
- pl_pgi = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_integer);
- pl_gug = s7_make_circular_signature(s7, 2, 3, s_gtk_enum_t, s_pair_false, s_gtk_enum_t);
- pl_pgbi = s7_make_circular_signature(s7, 3, 4, s_pair, s_gtk_enum_t, s_boolean, s_integer);
- 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_pur = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_real);
- pl_puit = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_integer, s_any);
- pl_puuui = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_pair_false, s_pair_false, s_integer);
- pl_pusiig = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_string, s_integer, s_integer, s_gtk_enum_t);
- pl_pusiigu = s7_make_circular_signature(s7, 6, 7, s_pair, s_pair_false, s_string, s_integer, s_integer, s_gtk_enum_t, s_pair_false);
- pl_pusiiugu = s7_make_circular_signature(s7, 7, 8, s_pair, s_pair_false, s_string, s_integer, s_integer, s_pair_false, s_gtk_enum_t, s_pair_false);
- pl_puuiig = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_pair_false, s_integer, s_integer, s_gtk_enum_t);
- pl_puur = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_pair_false, s_real);
- pl_purru = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_real, s_real, s_pair_false);
- pl_puiiui = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_integer, s_integer, s_pair_false, s_integer);
- pl_pugi = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_gtk_enum_t, s_integer);
- pl_puuig = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_pair_false, s_integer, s_gtk_enum_t);
- pl_puttiiiu = s7_make_circular_signature(s7, 7, 8, s_pair, s_pair_false, s_any, s_any, s_integer, s_integer, s_integer, s_pair_false);
- pl_pubi = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_boolean, s_integer);
- pl_puiig = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_integer, s_integer, s_gtk_enum_t);
- pl_puiigi = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_integer, s_integer, s_gtk_enum_t, s_integer);
- pl_puigu = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_integer, s_gtk_enum_t, s_pair_false);
- pl_puuusuug = s7_make_circular_signature(s7, 7, 8, s_pair, s_pair_false, s_pair_false, s_pair_false, s_string, s_pair_false, s_pair_false, s_gtk_enum_t);
- pl_pusi = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_string, s_integer);
- pl_pusiu = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_string, s_integer, s_pair_false);
- pl_putu = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_any, s_pair_false);
- pl_puri = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_real, s_integer);
- pl_pusub = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_string, s_pair_false, s_boolean);
- pl_pust = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_string, s_any);
- pl_pub = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_boolean);
- pl_puuiu = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_pair_false, s_integer, s_pair_false);
- 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_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);
- pl_pui = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_integer);
- pl_pussu = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_string, s_string, s_pair_false);
- pl_puibu = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_integer, s_boolean, s_pair_false);
- pl_pus = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_string);
- pl_pug = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_gtk_enum_t);
- pl_put = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_any);
- pl_pusigu = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_string, s_integer, s_gtk_enum_t, s_pair_false);
- pl_pusig = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_string, s_integer, s_gtk_enum_t);
- pl_puui = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_pair_false, s_integer);
- pl_puiu = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_integer, s_pair_false);
- pl_pusiuiu = s7_make_circular_signature(s7, 6, 7, s_pair, s_pair_false, s_string, s_integer, s_pair_false, s_integer, s_pair_false);
- pl_pusiuibu = s7_make_circular_signature(s7, 7, 8, s_pair, s_pair_false, s_string, s_integer, s_pair_false, s_integer, s_boolean, s_pair_false);
- pl_pusiiu = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_string, s_integer, s_integer, s_pair_false);
- pl_puuiiu = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_pair_false, s_integer, s_integer, s_pair_false);
pl_big = s7_make_circular_signature(s7, 2, 3, s_boolean, s_integer, s_gtk_enum_t);
pl_bi = s7_make_circular_signature(s7, 1, 2, s_boolean, s_integer);
- pl_b = s7_make_circular_signature(s7, 0, 1, s_boolean);
- pl_btiib = s7_make_circular_signature(s7, 4, 5, s_boolean, s_any, s_integer, s_integer, s_boolean);
- pl_bti = s7_make_circular_signature(s7, 2, 3, s_boolean, s_any, s_integer);
- 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_igi = s7_make_circular_signature(s7, 2, 3, s_integer, s_gtk_enum_t, s_integer);
+ pl_gi = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_integer);
pl_bsu = s7_make_circular_signature(s7, 2, 3, s_boolean, s_string, s_pair_false);
pl_bsigb = s7_make_circular_signature(s7, 4, 5, s_boolean, s_string, s_integer, s_gtk_enum_t, s_boolean);
pl_bur = s7_make_circular_signature(s7, 2, 3, s_boolean, s_pair_false, s_real);
+ pl_sg = s7_make_circular_signature(s7, 1, 2, s_string, s_gtk_enum_t);
pl_buug = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_pair_false, s_gtk_enum_t);
pl_buut = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_pair_false, s_any);
pl_buigu = s7_make_circular_signature(s7, 4, 5, s_boolean, s_pair_false, s_integer, s_gtk_enum_t, s_pair_false);
@@ -39987,18 +39865,47 @@ static void define_functions(void)
pl_bub = s7_make_circular_signature(s7, 2, 3, s_boolean, s_pair_false, s_boolean);
pl_buub = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_pair_false, s_boolean);
pl_pb = s7_make_circular_signature(s7, 1, 2, s_pair, s_boolean);
+ pl_gs = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_string);
pl_buig = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_integer, s_gtk_enum_t);
pl_buuig = s7_make_circular_signature(s7, 4, 5, s_boolean, s_pair_false, s_pair_false, s_integer, s_gtk_enum_t);
+ 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);
+ pl_guut = s7_make_circular_signature(s7, 3, 4, s_gtk_enum_t, s_pair_false, s_pair_false, s_any);
+ pl_guuut = s7_make_circular_signature(s7, 4, 5, s_gtk_enum_t, s_pair_false, s_pair_false, s_pair_false, s_any);
+ pl_guugbuut = s7_make_circular_signature(s7, 7, 8, s_gtk_enum_t, s_pair_false, s_pair_false, s_gtk_enum_t, s_boolean, s_pair_false, s_pair_false, s_any);
+ pl_pgr = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_real);
+ pl_pgu = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_pair_false);
+ pl_pgi = s7_make_circular_signature(s7, 2, 3, s_pair, s_gtk_enum_t, s_integer);
+ pl_gug = s7_make_circular_signature(s7, 2, 3, s_gtk_enum_t, s_pair_false, s_gtk_enum_t);
+ pl_pgbi = s7_make_circular_signature(s7, 3, 4, s_pair, s_gtk_enum_t, s_boolean, s_integer);
+ 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_iiit = s7_make_circular_signature(s7, 3, 4, s_integer, s_integer, s_integer, s_any);
pl_iit = s7_make_circular_signature(s7, 2, 3, s_integer, s_integer, s_any);
- pl_i = s7_make_circular_signature(s7, 0, 1, s_integer);
- 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);
- pl_itstttg = s7_make_circular_signature(s7, 6, 7, s_integer, s_any, s_string, s_any, s_any, s_any, s_gtk_enum_t);
- pl_itgiiut = s7_make_circular_signature(s7, 6, 7, s_integer, s_any, s_gtk_enum_t, s_integer, s_integer, s_pair_false, s_any);
- pl_ti = s7_make_circular_signature(s7, 1, 2, s_any, s_integer);
- pl_it = s7_make_circular_signature(s7, 1, 2, s_integer, s_any);
+ 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_iur = s7_make_circular_signature(s7, 2, 3, s_integer, s_pair_false, s_real);
+ pl_iugi = s7_make_circular_signature(s7, 3, 4, s_integer, s_pair_false, s_gtk_enum_t, s_integer);
+ pl_iuisi = s7_make_circular_signature(s7, 4, 5, s_integer, s_pair_false, s_integer, s_string, s_integer);
+ pl_iuuui = s7_make_circular_signature(s7, 4, 5, s_integer, s_pair_false, s_pair_false, s_pair_false, s_integer);
+ pl_iuuuui = s7_make_circular_signature(s7, 5, 6, s_integer, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_integer);
+ pl_iuis = s7_make_circular_signature(s7, 3, 4, s_integer, s_pair_false, s_integer, s_string);
+ pl_iug = s7_make_circular_signature(s7, 2, 3, s_integer, s_pair_false, s_gtk_enum_t);
+ pl_pit = s7_make_circular_signature(s7, 2, 3, s_pair, s_integer, s_any);
+ pl_piu = s7_make_circular_signature(s7, 2, 3, s_pair, s_integer, s_pair_false);
+ pl_ius = s7_make_circular_signature(s7, 2, 3, s_integer, s_pair_false, s_string);
+ pl_iusi = s7_make_circular_signature(s7, 3, 4, s_integer, s_pair_false, s_string, s_integer);
+ pl_iu = s7_make_circular_signature(s7, 1, 2, s_integer, s_pair_false);
+ pl_iuui = s7_make_circular_signature(s7, 3, 4, s_integer, s_pair_false, s_pair_false, s_integer);
+ pl_pi = s7_make_circular_signature(s7, 1, 2, s_pair, s_integer);
+ pl_iui = s7_make_circular_signature(s7, 2, 3, s_integer, s_pair_false, s_integer);
+ pl_iuisut = s7_make_circular_signature(s7, 5, 6, s_integer, s_pair_false, s_integer, s_string, s_pair_false, s_any);
pl_bpt = s7_make_signature(s7, 2, s_pair_false, s_any);
#endif
@@ -40271,8 +40178,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_binding_set_find, gxg_gtk_binding_set_find_w, 1, 0, 0, H_gtk_binding_set_find, pl_ps);
Xg_define_procedure(gtk_binding_entry_remove, gxg_gtk_binding_entry_remove_w, 3, 0, 0, H_gtk_binding_entry_remove, pl_tuig);
Xg_define_procedure(gtk_bin_get_child, gxg_gtk_bin_get_child_w, 1, 0, 0, H_gtk_bin_get_child, pl_pu);
- Xg_define_procedure(gtk_box_pack_start, gxg_gtk_box_pack_start_w, 5, 0, 0, H_gtk_box_pack_start, pl_tuubbi);
- Xg_define_procedure(gtk_box_pack_end, gxg_gtk_box_pack_end_w, 5, 0, 0, H_gtk_box_pack_end, pl_tuubbi);
Xg_define_procedure(gtk_box_set_homogeneous, gxg_gtk_box_set_homogeneous_w, 2, 0, 0, H_gtk_box_set_homogeneous, pl_tub);
Xg_define_procedure(gtk_box_get_homogeneous, gxg_gtk_box_get_homogeneous_w, 1, 0, 0, H_gtk_box_get_homogeneous, pl_bu);
Xg_define_procedure(gtk_box_set_spacing, gxg_gtk_box_set_spacing_w, 2, 0, 0, H_gtk_box_set_spacing, pl_tui);
@@ -40870,13 +40775,9 @@ static void define_functions(void)
Xg_define_procedure(gtk_toggle_button_new, gxg_gtk_toggle_button_new_w, 0, 0, 0, H_gtk_toggle_button_new, pl_p);
Xg_define_procedure(gtk_toggle_button_new_with_label, gxg_gtk_toggle_button_new_with_label_w, 1, 0, 0, H_gtk_toggle_button_new_with_label, pl_ps);
Xg_define_procedure(gtk_toggle_button_new_with_mnemonic, gxg_gtk_toggle_button_new_with_mnemonic_w, 1, 0, 0, H_gtk_toggle_button_new_with_mnemonic, pl_ps);
- Xg_define_procedure(gtk_toggle_button_set_mode, gxg_gtk_toggle_button_set_mode_w, 2, 0, 0, H_gtk_toggle_button_set_mode, pl_tub);
- Xg_define_procedure(gtk_toggle_button_get_mode, gxg_gtk_toggle_button_get_mode_w, 1, 0, 0, H_gtk_toggle_button_get_mode, pl_bu);
Xg_define_procedure(gtk_toggle_button_set_active, gxg_gtk_toggle_button_set_active_w, 2, 0, 0, H_gtk_toggle_button_set_active, pl_tub);
Xg_define_procedure(gtk_toggle_button_get_active, gxg_gtk_toggle_button_get_active_w, 1, 0, 0, H_gtk_toggle_button_get_active, pl_bu);
Xg_define_procedure(gtk_toggle_button_toggled, gxg_gtk_toggle_button_toggled_w, 1, 0, 0, H_gtk_toggle_button_toggled, pl_tu);
- Xg_define_procedure(gtk_toggle_button_set_inconsistent, gxg_gtk_toggle_button_set_inconsistent_w, 2, 0, 0, H_gtk_toggle_button_set_inconsistent, pl_tub);
- Xg_define_procedure(gtk_toggle_button_get_inconsistent, gxg_gtk_toggle_button_get_inconsistent_w, 1, 0, 0, H_gtk_toggle_button_get_inconsistent, pl_bu);
Xg_define_procedure(gtk_toolbar_new, gxg_gtk_toolbar_new_w, 0, 0, 0, H_gtk_toolbar_new, pl_p);
Xg_define_procedure(gtk_toolbar_set_style, gxg_gtk_toolbar_set_style_w, 2, 0, 0, H_gtk_toolbar_set_style, pl_tug);
Xg_define_procedure(gtk_toolbar_unset_style, gxg_gtk_toolbar_unset_style_w, 1, 0, 0, H_gtk_toolbar_unset_style, pl_tu);
@@ -41057,7 +40958,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_tree_view_get_reorderable, gxg_gtk_tree_view_get_reorderable_w, 1, 0, 0, H_gtk_tree_view_get_reorderable, pl_bu);
Xg_define_procedure(gtk_tree_view_set_cursor, gxg_gtk_tree_view_set_cursor_w, 4, 0, 0, H_gtk_tree_view_set_cursor, pl_tuuub);
Xg_define_procedure(gtk_tree_view_get_cursor, gxg_gtk_tree_view_get_cursor_w, 1, 2, 0, H_gtk_tree_view_get_cursor, pl_pu);
- Xg_define_procedure(gtk_tree_view_get_bin_window, gxg_gtk_tree_view_get_bin_window_w, 1, 0, 0, H_gtk_tree_view_get_bin_window, pl_pu);
Xg_define_procedure(gtk_tree_view_get_path_at_pos, gxg_gtk_tree_view_get_path_at_pos_w, 3, 4, 0, H_gtk_tree_view_get_path_at_pos, pl_puiiu);
Xg_define_procedure(gtk_tree_view_get_cell_area, gxg_gtk_tree_view_get_cell_area_w, 4, 0, 0, H_gtk_tree_view_get_cell_area, pl_tu);
Xg_define_procedure(gtk_tree_view_get_background_area, gxg_gtk_tree_view_get_background_area_w, 4, 0, 0, H_gtk_tree_view_get_background_area, pl_tu);
@@ -41084,7 +40984,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_widget_show, gxg_gtk_widget_show_w, 1, 0, 0, H_gtk_widget_show, pl_tu);
Xg_define_procedure(gtk_widget_show_now, gxg_gtk_widget_show_now_w, 1, 0, 0, H_gtk_widget_show_now, pl_tu);
Xg_define_procedure(gtk_widget_hide, gxg_gtk_widget_hide_w, 1, 0, 0, H_gtk_widget_hide, pl_tu);
- Xg_define_procedure(gtk_widget_show_all, gxg_gtk_widget_show_all_w, 1, 0, 0, H_gtk_widget_show_all, pl_tu);
Xg_define_procedure(gtk_widget_map, gxg_gtk_widget_map_w, 1, 0, 0, H_gtk_widget_map, pl_tu);
Xg_define_procedure(gtk_widget_unmap, gxg_gtk_widget_unmap_w, 1, 0, 0, H_gtk_widget_unmap, pl_tu);
Xg_define_procedure(gtk_widget_realize, gxg_gtk_widget_realize_w, 1, 0, 0, H_gtk_widget_realize, pl_tu);
@@ -41139,7 +41038,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_widget_get_default_direction, gxg_gtk_widget_get_default_direction_w, 0, 0, 0, H_gtk_widget_get_default_direction, pl_g);
Xg_define_procedure(gtk_widget_can_activate_accel, gxg_gtk_widget_can_activate_accel_w, 2, 0, 0, H_gtk_widget_can_activate_accel, pl_bui);
Xg_define_procedure(gtk_window_is_active, gxg_gtk_window_is_active_w, 1, 0, 0, H_gtk_window_is_active, pl_bu);
- Xg_define_procedure(gtk_window_has_toplevel_focus, gxg_gtk_window_has_toplevel_focus_w, 1, 0, 0, H_gtk_window_has_toplevel_focus, pl_bu);
Xg_define_procedure(gtk_window_new, gxg_gtk_window_new_w, 1, 0, 0, H_gtk_window_new, pl_pg);
Xg_define_procedure(gtk_window_set_title, gxg_gtk_window_set_title_w, 2, 0, 0, H_gtk_window_set_title, pl_tus);
Xg_define_procedure(gtk_window_set_auto_startup_notification, gxg_gtk_window_set_auto_startup_notification_w, 1, 0, 0, H_gtk_window_set_auto_startup_notification, pl_tb);
@@ -41459,8 +41357,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_toolbar_get_drop_index, gxg_gtk_toolbar_get_drop_index_w, 3, 0, 0, H_gtk_toolbar_get_drop_index, pl_iui);
Xg_define_procedure(gtk_tree_view_column_set_expand, gxg_gtk_tree_view_column_set_expand_w, 2, 0, 0, H_gtk_tree_view_column_set_expand, pl_tub);
Xg_define_procedure(gtk_tree_view_column_get_expand, gxg_gtk_tree_view_column_get_expand_w, 1, 0, 0, H_gtk_tree_view_column_get_expand, pl_bu);
- Xg_define_procedure(gtk_widget_set_no_show_all, gxg_gtk_widget_set_no_show_all_w, 2, 0, 0, H_gtk_widget_set_no_show_all, pl_tub);
- Xg_define_procedure(gtk_widget_get_no_show_all, gxg_gtk_widget_get_no_show_all_w, 1, 0, 0, H_gtk_widget_get_no_show_all, pl_bu);
Xg_define_procedure(gtk_widget_queue_resize_no_redraw, gxg_gtk_widget_queue_resize_no_redraw_w, 1, 0, 0, H_gtk_widget_queue_resize_no_redraw, pl_tu);
Xg_define_procedure(gtk_window_set_default_icon, gxg_gtk_window_set_default_icon_w, 1, 0, 0, H_gtk_window_set_default_icon, pl_tu);
Xg_define_procedure(gtk_window_set_keep_above, gxg_gtk_window_set_keep_above_w, 2, 0, 0, H_gtk_window_set_keep_above, pl_tub);
@@ -41820,8 +41716,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_progress_bar_set_ellipsize, gxg_gtk_progress_bar_set_ellipsize_w, 2, 0, 0, H_gtk_progress_bar_set_ellipsize, pl_tug);
Xg_define_procedure(gtk_progress_bar_get_ellipsize, gxg_gtk_progress_bar_get_ellipsize_w, 1, 0, 0, H_gtk_progress_bar_get_ellipsize, pl_gu);
Xg_define_procedure(gtk_selection_data_targets_include_image, gxg_gtk_selection_data_targets_include_image_w, 2, 0, 0, H_gtk_selection_data_targets_include_image, pl_bub);
- Xg_define_procedure(gtk_label_set_angle, gxg_gtk_label_set_angle_w, 2, 0, 0, H_gtk_label_set_angle, pl_tur);
- Xg_define_procedure(gtk_label_get_angle, gxg_gtk_label_get_angle_w, 1, 0, 0, H_gtk_label_get_angle, pl_du);
Xg_define_procedure(gtk_menu_set_screen, gxg_gtk_menu_set_screen_w, 2, 0, 0, H_gtk_menu_set_screen, pl_tu);
Xg_define_procedure(pango_attr_underline_color_new, gxg_pango_attr_underline_color_new_w, 3, 0, 0, H_pango_attr_underline_color_new, pl_pi);
Xg_define_procedure(pango_attr_strikethrough_color_new, gxg_pango_attr_strikethrough_color_new_w, 3, 0, 0, H_pango_attr_strikethrough_color_new, pl_pi);
@@ -42262,7 +42156,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_calendar_get_detail_width_chars, gxg_gtk_calendar_get_detail_width_chars_w, 1, 0, 0, H_gtk_calendar_get_detail_width_chars, pl_iu);
Xg_define_procedure(gtk_calendar_get_detail_height_rows, gxg_gtk_calendar_get_detail_height_rows_w, 1, 0, 0, H_gtk_calendar_get_detail_height_rows, pl_iu);
Xg_define_procedure(gtk_accel_group_get_is_locked, gxg_gtk_accel_group_get_is_locked_w, 1, 0, 0, H_gtk_accel_group_get_is_locked, pl_bu);
- Xg_define_procedure(gtk_container_get_focus_child, gxg_gtk_container_get_focus_child_w, 1, 0, 0, H_gtk_container_get_focus_child, pl_pu);
Xg_define_procedure(gtk_dialog_get_content_area, gxg_gtk_dialog_get_content_area_w, 1, 0, 0, H_gtk_dialog_get_content_area, pl_pu);
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);
@@ -42416,7 +42309,6 @@ static void define_functions(void)
#if GTK_CHECK_VERSION(2, 20, 0)
Xg_define_procedure(gtk_dialog_get_widget_for_response, gxg_gtk_dialog_get_widget_for_response_w, 2, 0, 0, H_gtk_dialog_get_widget_for_response, pl_pui);
- Xg_define_procedure(gtk_viewport_get_bin_window, gxg_gtk_viewport_get_bin_window_w, 1, 0, 0, H_gtk_viewport_get_bin_window, pl_pu);
Xg_define_procedure(gtk_spinner_new, gxg_gtk_spinner_new_w, 0, 0, 0, H_gtk_spinner_new, pl_p);
Xg_define_procedure(gtk_spinner_start, gxg_gtk_spinner_start_w, 1, 0, 0, H_gtk_spinner_start, pl_tu);
Xg_define_procedure(gtk_spinner_stop, gxg_gtk_spinner_stop_w, 1, 0, 0, H_gtk_spinner_stop, pl_tu);
@@ -42523,7 +42415,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_calendar_mark_day, gxg_gtk_calendar_mark_day_w, 2, 0, 0, H_gtk_calendar_mark_day, pl_tui);
Xg_define_procedure(gtk_calendar_unmark_day, gxg_gtk_calendar_unmark_day_w, 2, 0, 0, H_gtk_calendar_unmark_day, pl_tui);
Xg_define_procedure(gdk_drag_context_get_source_window, gxg_gdk_drag_context_get_source_window_w, 1, 0, 0, H_gdk_drag_context_get_source_window, pl_pu);
- Xg_define_procedure(gtk_viewport_get_view_window, gxg_gtk_viewport_get_view_window_w, 1, 0, 0, H_gtk_viewport_get_view_window, pl_pu);
Xg_define_procedure(gtk_accessible_set_widget, gxg_gtk_accessible_set_widget_w, 2, 0, 0, H_gtk_accessible_set_widget, pl_tu);
Xg_define_procedure(gtk_message_dialog_get_message_area, gxg_gtk_message_dialog_get_message_area_w, 1, 0, 0, H_gtk_message_dialog_get_message_area, pl_pu);
Xg_define_procedure(gtk_selection_data_get_length, gxg_gtk_selection_data_get_length_w, 1, 0, 0, H_gtk_selection_data_get_length, pl_iu);
@@ -42565,10 +42456,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_notebook_get_group_name, gxg_gtk_notebook_get_group_name_w, 1, 0, 0, H_gtk_notebook_get_group_name, pl_su);
Xg_define_procedure(gtk_widget_draw, gxg_gtk_widget_draw_w, 2, 0, 0, H_gtk_widget_draw, pl_tu);
Xg_define_procedure(gtk_widget_get_request_mode, gxg_gtk_widget_get_request_mode_w, 1, 0, 0, H_gtk_widget_get_request_mode, pl_gu);
- Xg_define_procedure(gtk_widget_get_preferred_width, gxg_gtk_widget_get_preferred_width_w, 1, 2, 0, H_gtk_widget_get_preferred_width, pl_pu);
- Xg_define_procedure(gtk_widget_get_preferred_height_for_width, gxg_gtk_widget_get_preferred_height_for_width_w, 2, 2, 0, H_gtk_widget_get_preferred_height_for_width, pl_puiu);
- Xg_define_procedure(gtk_widget_get_preferred_height, gxg_gtk_widget_get_preferred_height_w, 1, 2, 0, H_gtk_widget_get_preferred_height, pl_pu);
- Xg_define_procedure(gtk_widget_get_preferred_width_for_height, gxg_gtk_widget_get_preferred_width_for_height_w, 2, 2, 0, H_gtk_widget_get_preferred_width_for_height, pl_puiu);
Xg_define_procedure(gtk_widget_get_allocated_width, gxg_gtk_widget_get_allocated_width_w, 1, 0, 0, H_gtk_widget_get_allocated_width, pl_iu);
Xg_define_procedure(gtk_widget_get_allocated_height, gxg_gtk_widget_get_allocated_height_w, 1, 0, 0, H_gtk_widget_get_allocated_height, pl_iu);
Xg_define_procedure(gtk_widget_get_halign, gxg_gtk_widget_get_halign_w, 1, 0, 0, H_gtk_widget_get_halign, pl_gu);
@@ -42659,7 +42546,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_tooltip_set_icon, gxg_gtk_tooltip_set_icon_w, 2, 0, 0, H_gtk_tooltip_set_icon, pl_tu);
Xg_define_procedure(gtk_tooltip_set_custom, gxg_gtk_tooltip_set_custom_w, 2, 0, 0, H_gtk_tooltip_set_custom, pl_tu);
Xg_define_procedure(gtk_tooltip_trigger_tooltip_query, gxg_gtk_tooltip_trigger_tooltip_query_w, 1, 0, 0, H_gtk_tooltip_trigger_tooltip_query, pl_tu);
- Xg_define_procedure(gtk_show_uri, gxg_gtk_show_uri_w, 3, 1, 0, H_gtk_show_uri, pl_pusiu);
Xg_define_procedure(gtk_tree_view_column_new_with_area, gxg_gtk_tree_view_column_new_with_area_w, 1, 0, 0, H_gtk_tree_view_column_new_with_area, pl_pu);
Xg_define_procedure(gtk_tree_view_column_get_button, gxg_gtk_tree_view_column_get_button_w, 1, 0, 0, H_gtk_tree_view_column_get_button, pl_pu);
Xg_define_procedure(gtk_tree_view_column_focus_cell, gxg_gtk_tree_view_column_focus_cell_w, 2, 0, 0, H_gtk_tree_view_column_focus_cell, pl_tu);
@@ -42668,7 +42554,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_tool_item_toolbar_reconfigured, gxg_gtk_tool_item_toolbar_reconfigured_w, 1, 0, 0, H_gtk_tool_item_toolbar_reconfigured, pl_tu);
Xg_define_procedure(gtk_orientable_set_orientation, gxg_gtk_orientable_set_orientation_w, 2, 0, 0, H_gtk_orientable_set_orientation, pl_tug);
Xg_define_procedure(gtk_orientable_get_orientation, gxg_gtk_orientable_get_orientation_w, 1, 0, 0, H_gtk_orientable_get_orientation, pl_gu);
- Xg_define_procedure(gtk_parse_args, gxg_gtk_parse_args_w, 0, 2, 0, H_gtk_parse_args, pl_pu);
Xg_define_procedure(gtk_get_major_version, gxg_gtk_get_major_version_w, 0, 0, 0, H_gtk_get_major_version, pl_i);
Xg_define_procedure(gtk_get_minor_version, gxg_gtk_get_minor_version_w, 0, 0, 0, H_gtk_get_minor_version, pl_i);
Xg_define_procedure(gtk_get_micro_version, gxg_gtk_get_micro_version_w, 0, 0, 0, H_gtk_get_micro_version, pl_i);
@@ -42686,7 +42571,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_container_set_focus_chain, gxg_gtk_container_set_focus_chain_w, 2, 0, 0, H_gtk_container_set_focus_chain, pl_tu);
Xg_define_procedure(gtk_container_get_focus_chain, gxg_gtk_container_get_focus_chain_w, 1, 1, 0, H_gtk_container_get_focus_chain, pl_pu);
Xg_define_procedure(gtk_container_unset_focus_chain, gxg_gtk_container_unset_focus_chain_w, 1, 0, 0, H_gtk_container_unset_focus_chain, pl_tu);
- Xg_define_procedure(gtk_container_set_focus_child, gxg_gtk_container_set_focus_child_w, 2, 0, 0, H_gtk_container_set_focus_child, pl_tu);
Xg_define_procedure(gtk_container_set_focus_vadjustment, gxg_gtk_container_set_focus_vadjustment_w, 2, 0, 0, H_gtk_container_set_focus_vadjustment, pl_tu);
Xg_define_procedure(gtk_container_get_focus_vadjustment, gxg_gtk_container_get_focus_vadjustment_w, 1, 0, 0, H_gtk_container_get_focus_vadjustment, pl_pu);
Xg_define_procedure(gtk_container_set_focus_hadjustment, gxg_gtk_container_set_focus_hadjustment_w, 2, 0, 0, H_gtk_container_set_focus_hadjustment, pl_tu);
@@ -42733,8 +42617,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_cell_view_set_draw_sensitive, gxg_gtk_cell_view_set_draw_sensitive_w, 2, 0, 0, H_gtk_cell_view_set_draw_sensitive, pl_tub);
Xg_define_procedure(gtk_cell_view_get_fit_model, gxg_gtk_cell_view_get_fit_model_w, 1, 0, 0, H_gtk_cell_view_get_fit_model, pl_bu);
Xg_define_procedure(gtk_cell_view_set_fit_model, gxg_gtk_cell_view_set_fit_model_w, 2, 0, 0, H_gtk_cell_view_set_fit_model, pl_tub);
- Xg_define_procedure(gtk_combo_box_new_with_area, gxg_gtk_combo_box_new_with_area_w, 1, 0, 0, H_gtk_combo_box_new_with_area, pl_pu);
- Xg_define_procedure(gtk_combo_box_new_with_area_and_entry, gxg_gtk_combo_box_new_with_area_and_entry_w, 1, 0, 0, H_gtk_combo_box_new_with_area_and_entry, pl_pu);
Xg_define_procedure(gtk_icon_view_new_with_area, gxg_gtk_icon_view_new_with_area_w, 1, 0, 0, H_gtk_icon_view_new_with_area, pl_pu);
Xg_define_procedure(gtk_menu_item_set_reserve_indicator, gxg_gtk_menu_item_set_reserve_indicator_w, 2, 0, 0, H_gtk_menu_item_set_reserve_indicator, pl_tub);
Xg_define_procedure(gtk_menu_item_get_reserve_indicator, gxg_gtk_menu_item_get_reserve_indicator_w, 1, 0, 0, H_gtk_menu_item_get_reserve_indicator, pl_bu);
@@ -42815,8 +42697,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_entry_completion_compute_prefix, gxg_gtk_entry_completion_compute_prefix_w, 2, 0, 0, H_gtk_entry_completion_compute_prefix, pl_sus);
Xg_define_procedure(gtk_scale_set_has_origin, gxg_gtk_scale_set_has_origin_w, 2, 0, 0, H_gtk_scale_set_has_origin, pl_tub);
Xg_define_procedure(gtk_scale_get_has_origin, gxg_gtk_scale_get_has_origin_w, 1, 0, 0, H_gtk_scale_get_has_origin, pl_bu);
- Xg_define_procedure(gtk_window_set_hide_titlebar_when_maximized, gxg_gtk_window_set_hide_titlebar_when_maximized_w, 2, 0, 0, H_gtk_window_set_hide_titlebar_when_maximized, pl_tub);
- Xg_define_procedure(gtk_window_get_hide_titlebar_when_maximized, gxg_gtk_window_get_hide_titlebar_when_maximized_w, 1, 0, 0, H_gtk_window_get_hide_titlebar_when_maximized, pl_bu);
Xg_define_procedure(gtk_application_window_new, gxg_gtk_application_window_new_w, 1, 0, 0, H_gtk_application_window_new, pl_pu);
Xg_define_procedure(gtk_application_window_set_show_menubar, gxg_gtk_application_window_set_show_menubar_w, 2, 0, 0, H_gtk_application_window_set_show_menubar, pl_tub);
Xg_define_procedure(gtk_application_window_get_show_menubar, gxg_gtk_application_window_get_show_menubar_w, 1, 0, 0, H_gtk_application_window_get_show_menubar, pl_bu);
@@ -42904,7 +42784,6 @@ static void define_functions(void)
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_get_valign_with_baseline, gxg_gtk_widget_get_valign_with_baseline_w, 1, 0, 0, H_gtk_widget_get_valign_with_baseline, pl_gu);
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);
Xg_define_procedure(gtk_places_sidebar_new, gxg_gtk_places_sidebar_new_w, 0, 0, 0, H_gtk_places_sidebar_new, pl_p);
@@ -43078,8 +42957,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_popover_get_position, gxg_gtk_popover_get_position_w, 1, 0, 0, H_gtk_popover_get_position, pl_gu);
Xg_define_procedure(gtk_popover_set_modal, gxg_gtk_popover_set_modal_w, 2, 0, 0, H_gtk_popover_set_modal, pl_tub);
Xg_define_procedure(gtk_popover_get_modal, gxg_gtk_popover_get_modal_w, 1, 0, 0, H_gtk_popover_get_modal, pl_bu);
- Xg_define_procedure(gtk_box_set_center_widget, gxg_gtk_box_set_center_widget_w, 2, 0, 0, H_gtk_box_set_center_widget, pl_tu);
- Xg_define_procedure(gtk_box_get_center_widget, gxg_gtk_box_get_center_widget_w, 1, 0, 0, H_gtk_box_get_center_widget, pl_pu);
Xg_define_procedure(gtk_entry_set_max_width_chars, gxg_gtk_entry_set_max_width_chars_w, 2, 0, 0, H_gtk_entry_set_max_width_chars, pl_tui);
Xg_define_procedure(gtk_entry_get_max_width_chars, gxg_gtk_entry_get_max_width_chars_w, 1, 0, 0, H_gtk_entry_get_max_width_chars, pl_iu);
Xg_define_procedure(gdk_device_get_last_event_window, gxg_gdk_device_get_last_event_window_w, 1, 0, 0, H_gdk_device_get_last_event_window, pl_pu);
@@ -43388,6 +43265,26 @@ static void define_functions(void)
Xg_define_procedure(gdk_rgba_is_opaque, gxg_gdk_rgba_is_opaque_w, 1, 0, 0, H_gdk_rgba_is_opaque, pl_bu);
Xg_define_procedure(gdk_window_begin_draw_frame, gxg_gdk_window_begin_draw_frame_w, 3, 0, 0, H_gdk_window_begin_draw_frame, pl_pu);
Xg_define_procedure(gtk_flow_box_get_child_at_pos, gxg_gtk_flow_box_get_child_at_pos_w, 3, 0, 0, H_gtk_flow_box_get_child_at_pos, pl_pui);
+ Xg_define_procedure(gtk_about_dialog_get_system_information, gxg_gtk_about_dialog_get_system_information_w, 1, 0, 0, H_gtk_about_dialog_get_system_information, pl_su);
+ Xg_define_procedure(gtk_about_dialog_set_system_information, gxg_gtk_about_dialog_set_system_information_w, 2, 0, 0, H_gtk_about_dialog_set_system_information, pl_tus);
+ Xg_define_procedure(gtk_action_bar_set_revealed, gxg_gtk_action_bar_set_revealed_w, 2, 0, 0, H_gtk_action_bar_set_revealed, pl_tub);
+ Xg_define_procedure(gtk_action_bar_get_revealed, gxg_gtk_action_bar_get_revealed_w, 1, 0, 0, H_gtk_action_bar_get_revealed, pl_bu);
+ Xg_define_procedure(gtk_check_button_set_draw_indicator, gxg_gtk_check_button_set_draw_indicator_w, 2, 0, 0, H_gtk_check_button_set_draw_indicator, pl_tub);
+ Xg_define_procedure(gtk_check_button_get_draw_indicator, gxg_gtk_check_button_get_draw_indicator_w, 1, 0, 0, H_gtk_check_button_get_draw_indicator, pl_bu);
+ Xg_define_procedure(gtk_check_button_set_inconsistent, gxg_gtk_check_button_set_inconsistent_w, 2, 0, 0, H_gtk_check_button_set_inconsistent, pl_tub);
+ Xg_define_procedure(gtk_check_button_get_inconsistent, gxg_gtk_check_button_get_inconsistent_w, 1, 0, 0, H_gtk_check_button_get_inconsistent, pl_bu);
+ Xg_define_procedure(gtk_info_bar_set_revealed, gxg_gtk_info_bar_set_revealed_w, 2, 0, 0, H_gtk_info_bar_set_revealed, pl_tub);
+ Xg_define_procedure(gtk_info_bar_get_revealed, gxg_gtk_info_bar_get_revealed_w, 1, 0, 0, H_gtk_info_bar_get_revealed, pl_bu);
+ Xg_define_procedure(gtk_widget_get_first_child, gxg_gtk_widget_get_first_child_w, 1, 0, 0, H_gtk_widget_get_first_child, pl_pu);
+ Xg_define_procedure(gtk_widget_get_last_child, gxg_gtk_widget_get_last_child_w, 1, 0, 0, H_gtk_widget_get_last_child, pl_pu);
+ Xg_define_procedure(gtk_widget_get_next_sibling, gxg_gtk_widget_get_next_sibling_w, 1, 0, 0, H_gtk_widget_get_next_sibling, pl_pu);
+ Xg_define_procedure(gtk_widget_get_prev_sibling, gxg_gtk_widget_get_prev_sibling_w, 1, 0, 0, H_gtk_widget_get_prev_sibling, pl_pu);
+ Xg_define_procedure(gtk_widget_set_focus_child, gxg_gtk_widget_set_focus_child_w, 2, 0, 0, H_gtk_widget_set_focus_child, pl_tu);
+ Xg_define_procedure(gtk_show_uri_on_window, gxg_gtk_show_uri_on_window_w, 3, 1, 0, H_gtk_show_uri_on_window, pl_pusiu);
+ Xg_define_procedure(gtk_box_pack_start, gxg_gtk_box_pack_start_w, 2, 0, 0, H_gtk_box_pack_start, pl_tu);
+ Xg_define_procedure(gtk_box_pack_end, gxg_gtk_box_pack_end_w, 2, 0, 0, H_gtk_box_pack_end, pl_tu);
+ Xg_define_procedure(gtk_widget_insert_after, gxg_gtk_widget_insert_after_w, 3, 0, 0, H_gtk_widget_insert_after, pl_tu);
+ Xg_define_procedure(gtk_widget_insert_before, gxg_gtk_widget_insert_before_w, 3, 0, 0, H_gtk_widget_insert_before, pl_tu);
#endif
Xg_define_procedure(cairo_create, gxg_cairo_create_w, 1, 0, 0, H_cairo_create, pl_pu);
@@ -43902,8 +43799,13 @@ static void define_functions(void)
Xg_define_procedure(g_object_get, xg_object_get_w, 3, 0, 0, NULL, NULL);
Xg_define_procedure(g_object_set, xg_object_set_w, 3, 0, 0, NULL, NULL);
Xg_define_procedure(gtk_event_keyval, xg_gtk_event_keyval_w, 1, 0, 0, NULL, NULL);
+#if (GTK_CHECK_VERSION(3, 90, 0))
+ Xg_define_procedure(gtk_init, gxg_gtk_init_w, 0, 0, 0, H_gtk_init, NULL);
+ Xg_define_procedure(gtk_init_check, gxg_gtk_init_check_w, 0, 0, 0, H_gtk_init_check, NULL);
+#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);
+#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 GDK_IS_DRAG_CONTEXT", pl_bt);
Xg_define_procedure(GDK_IS_DEVICE, gxg_GDK_IS_DEVICE_w, 1, 0, 0,
@@ -45752,6 +45654,7 @@ static void define_atoms(void)
static void define_symbols(void)
{
+ xg_GtkCheckButton__symbol = C_string_to_Xen_symbol("GtkCheckButton_");
xg_GdkDrawContext__symbol = C_string_to_Xen_symbol("GdkDrawContext_");
xg_GtkDrawingAreaDrawFunc_symbol = C_string_to_Xen_symbol("GtkDrawingAreaDrawFunc");
xg_const_symbol = C_string_to_Xen_symbol("const");
@@ -46240,7 +46143,6 @@ 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_GtkCheckButton__symbol = C_string_to_Xen_symbol("GtkCheckButton_");
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_");
@@ -47543,12 +47445,16 @@ void Init_libxg(void)
define_lint();
#endif
Xen_provide_feature("xg");
- #if GTK_CHECK_VERSION(3, 0, 0)
- Xen_provide_feature("gtk3");
+ #if GTK_CHECK_VERSION(3, 90, 0)
+ Xen_provide_feature("gtk4");
#else
- Xen_provide_feature("gtk2");
+ #if GTK_CHECK_VERSION(3, 0, 0)
+ Xen_provide_feature("gtk3");
+ #else
+ Xen_provide_feature("gtk2");
+ #endif
#endif
- Xen_define("xg-version", C_string_to_Xen_string("08-Jan-17"));
+ Xen_define("xg-version", C_string_to_Xen_string("25-Jun-17"));
xg_already_inited = true;
#if HAVE_SCHEME
#if USE_SND
diff --git a/xm.c b/xm.c
index 8471350..dbd149f 100644
--- a/xm.c
+++ b/xm.c
@@ -2819,7 +2819,7 @@ retrieves rendition resources"
Arg *args;
unsigned long *locs;
Xen val;
- int i, len, gcloc;
+ unsigned int i, len, gcloc;
XmRendition r;
Xen arg2;
arg2 = Xen_copy_arg(larg2);
@@ -2827,7 +2827,7 @@ retrieves rendition resources"
/* here we need to make sure the ref args are ok from C's point of view */
r = Xen_to_C_XmRendition(arg1);
len = Xen_to_C_INT_DEF(arg3, arg2);
- if (len <= 0) Xen_check_type(0, arg3, 3, "XmRenditionRetrieve", "positive integer");
+ if (len == 0) Xen_check_type(0, arg3, 3, "XmRenditionRetrieve", "positive integer");
args = (Arg *)calloc(len, sizeof(Arg));
locs = (unsigned long *)calloc(len, sizeof(unsigned long));
for (i = 0; i < len; i++, arg2 = Xen_cddr(arg2))
@@ -5761,7 +5761,7 @@ retrieves resource values set on a drop site"
Arg *args;
unsigned long *locs;
Xen val = Xen_false;
- int i, len, gcloc;
+ unsigned int i, len, gcloc;
Xen arg2;
Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmDropSiteRetrieve", "Widget");
Xen_check_type(Xen_is_list(larg2), larg2, 2, "XmDropSiteRetrieve", "ArgList");
@@ -5769,7 +5769,7 @@ retrieves resource values set on a drop site"
arg2 = Xen_copy_arg(larg2);
gcloc = xm_protect(arg2);
len = Xen_to_C_INT_DEF(arg3, larg2);
- if (len <= 0) Xen_check_type(0, arg3, 3, "XmDropSiteRetrieve", "positive integer");
+ if (len == 0) Xen_check_type(0, arg3, 3, "XmDropSiteRetrieve", "positive integer");
args = (Arg *)calloc(len, sizeof(Arg));
locs = (unsigned long *)calloc(len, sizeof(unsigned long));
for (i = 0; i < len; i++, arg2 = Xen_cddr(arg2))
@@ -8397,7 +8397,7 @@ pixel members of the XColor structures."
/* DIFF: XStoreColors arg 3 is list of XColor
*/
XColor *xc;
- int i, len;
+ unsigned int i, len;
Xen arg3;
Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XStoreColors", "Display*");
Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XStoreColors", "Colormap");
@@ -8405,7 +8405,7 @@ pixel members of the XColor structures."
Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XStoreColors", "int");
arg3 = Xen_copy_arg(larg3);
len = Xen_integer_to_C_int(arg4);
- if (len <= 0) Xen_check_type(0, arg4, 4, "XStoreColors", "positive integer");
+ if (len == 0) Xen_check_type(0, arg4, 4, "XStoreColors", "positive integer");
xc = (XColor *)calloc(len, sizeof(XColor));
for (i = 0; (i < len) && (!Xen_is_null(arg3)); i++, arg3 = Xen_cdr(arg3))
{
@@ -8785,7 +8785,7 @@ the specified GC to the specified list of rectangles and sets the clip origin."
/* DIFF: XSetClipRectangles XRectangle* arg (arg 5) is list of XRectangles
*/
XRectangle *pt;
- int i, len;
+ unsigned int i, len;
Xen arg5;
Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetClipRectangles", "Display*");
Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetClipRectangles", "GC");
@@ -8796,7 +8796,7 @@ the specified GC to the specified list of rectangles and sets the clip origin."
Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XSetClipRectangles", "int");
arg5 = Xen_copy_arg(larg5);
len = Xen_integer_to_C_int(arg6);
- if (len <= 0) Xen_check_type(0, arg6, 6, "XSetClipRectangles", "positive integer");
+ if (len == 0) Xen_check_type(0, arg6, 6, "XSetClipRectangles", "positive integer");
pt = (XRectangle *)calloc(len, sizeof(XRectangle));
for (i = 0; (i < len) && (!Xen_is_null(arg5)); i++, arg5 = Xen_cdr(arg5))
{
@@ -10219,7 +10219,7 @@ static Xen gxm_XFillPolygon(Xen arg1, Xen arg2, Xen arg3, Xen larg4, Xen arg5, X
/* DIFF: XFillPolygon Point* arg (arg 4) is list of XPoint
*/
XPoint *pt, *pt1;
- int i, len;
+ unsigned int i, len;
Xen arg4;
Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFillPolygon", "Display*");
Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XFillPolygon", "Drawable");
@@ -10230,7 +10230,7 @@ static Xen gxm_XFillPolygon(Xen arg1, Xen arg2, Xen arg3, Xen larg4, Xen arg5, X
Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XFillPolygon", "int");
arg4 = Xen_copy_arg(larg4);
len = Xen_integer_to_C_int(arg5);
- if (len <= 0) Xen_check_type(0, arg5, 5, "XFillPolygon", "positive integer");
+ if (len == 0) Xen_check_type(0, arg5, 5, "XFillPolygon", "positive integer");
pt = (XPoint *)calloc(len, sizeof(XPoint));
for (i = 0; (i < len) && (!Xen_is_null(arg4)); i++, arg4 = Xen_cdr(arg4))
{
@@ -10473,7 +10473,7 @@ static Xen gxm_XDrawPoints(Xen arg1, Xen arg2, Xen arg3, Xen larg4, Xen arg5, Xe
/* DIFF: XDrawPoints XPoint* arg (arg 4) is list of XPoints
*/
XPoint *pt, *pt1;
- int i, len;
+ unsigned int i, len;
Xen arg4;
Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDrawPoints", "Display*");
Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDrawPoints", "Drawable");
@@ -10483,7 +10483,7 @@ static Xen gxm_XDrawPoints(Xen arg1, Xen arg2, Xen arg3, Xen larg4, Xen arg5, Xe
Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XDrawPoints", "int");
arg4 = Xen_copy_arg(larg4);
len = Xen_integer_to_C_int(arg5);
- if (len <= 0) Xen_check_type(0, arg5, 5, "XDrawPoints", "positive integer");
+ if (len == 0) Xen_check_type(0, arg5, 5, "XDrawPoints", "positive integer");
pt = (XPoint *)calloc(len, sizeof(XPoint));
for (i = 0; (i < len) && (!Xen_is_null(arg4)); i++, arg4 = Xen_cdr(arg4))
{
@@ -10525,7 +10525,7 @@ between each pair of points (point[i], point[i+1]) in the array of XPoint struct
/* DIFF: XDrawLines XPoint* arg (arg 4) is list of XPoints
*/
XPoint *pt, *pt1;
- int i, len;
+ unsigned int i, len;
Xen arg4;
Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDrawLines", "Display*");
Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDrawLines", "Drawable");
@@ -10535,7 +10535,7 @@ between each pair of points (point[i], point[i+1]) in the array of XPoint struct
Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XDrawLines", "int");
arg4 = Xen_copy_arg(larg4);
len = Xen_integer_to_C_int(arg5);
- if (len <= 0) Xen_check_type(0, arg5, 5, "XDrawLines", "positive integer");
+ if (len == 0) Xen_check_type(0, arg5, 5, "XDrawLines", "positive integer");
pt = (XPoint *)calloc(len, sizeof(XPoint));
for (i = 0; (i < len) && (!Xen_is_null(arg4)); i++, arg4 = Xen_cdr(arg4))
{
@@ -10580,13 +10580,13 @@ static Xen gxm_XDrawLinesDirect(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5
static Xen gxm_Vector2XPoints(Xen arg1)
{
#define H_vector2XPoints "(vector->XPoints vect) packages point data in vect as (opaque) array of XPoints"
- int i, j, len;
+ unsigned int i, j, len;
/* vector assumed to be sequence of x y pairs (not XPoints from local view)
*/
XPoint *pt;
Xen_check_type(Xen_is_vector(arg1), arg1, 1, "vector->XPoints", "vector of x,y values");
len = Xen_vector_length(arg1) / 2;
- if (len <= 0) Xen_check_type(0, arg1, 1, "vector->XPoints", "positive integer");
+ if (len == 0) Xen_check_type(0, arg1, 1, "vector->XPoints", "positive integer");
pt = (XPoint *)calloc(len, sizeof(XPoint));
for (i = 0, j = 0; i < len; i++, j += 2)
{
@@ -11345,7 +11345,7 @@ static Xen gxm_XAllocColorPlanes(Xen args)
*/
unsigned long r,g,b;
unsigned long *ps;
- int len, val;
+ unsigned int len, val;
Xen lst = Xen_false;
Xen arg1, arg2, arg3, arg5, arg6, arg7, arg8;
arg1 = Xen_list_ref(args, 0);
@@ -11363,7 +11363,7 @@ static Xen gxm_XAllocColorPlanes(Xen args)
Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XAllocColorPlanes", "int");
Xen_check_type(Xen_is_integer(arg8), arg8, 8, "XAllocColorPlanes", "int");
len = Xen_integer_to_C_int(arg5);
- if (len <= 0) Xen_check_type(0, arg5, 5, "XAllocColorPlanes", "positive integer");
+ if (len == 0) Xen_check_type(0, arg5, 5, "XAllocColorPlanes", "positive integer");
ps = (unsigned long *)calloc(len, sizeof(unsigned long));
val = XAllocColorPlanes(Xen_to_C_Display(arg1),
Xen_to_C_Colormap(arg2),
@@ -12156,7 +12156,7 @@ pixmap of the given depth and then does a bitmap-format XPutImage of the data in
/* DIFF: XCreatePixmapFromBitmapData takes list of chars as arg3 (not char *)
*/
char *bits;
- int i, len;
+ unsigned int i, len;
Pixmap p;
Xen arg3;
Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCreatePixmapFromBitmapData", "Display*");
@@ -12168,7 +12168,7 @@ pixmap of the given depth and then does a bitmap-format XPutImage of the data in
Xen_check_type(Xen_is_Pixel(arg7), arg7, 7, "XCreatePixmapFromBitmapData", "pixel");
Xen_check_type(Xen_is_ulong(arg8), arg8, 8, "XCreatePixmapFromBitmapData", "unsigned int");
len = Xen_list_length(larg3);
- if (len <= 0) Xen_check_type(0, larg3, 3, "XCreatePixmapFromBitmapData", "positive integer");
+ if (len == 0) Xen_check_type(0, larg3, 3, "XCreatePixmapFromBitmapData", "positive integer");
arg3 = Xen_copy_arg(larg3);
bits = (char *)calloc(len, sizeof(char));
for (i = 0; i < len; i++, arg3 = Xen_cdr(arg3))
@@ -12190,7 +12190,7 @@ program a bitmap file that was written out by XWriteBitmapFile"
/* DIFF: XCreateBitmapFromData takes list of chars as arg3 (not char *)
*/
char *bits;
- int i, len;
+ unsigned int i, len;
Pixmap p;
Xen arg3;
Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCreateBitmapFromData", "Display*");
@@ -12199,7 +12199,7 @@ program a bitmap file that was written out by XWriteBitmapFile"
Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XCreateBitmapFromData", "unsigned int");
Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XCreateBitmapFromData", "unsigned int");
len = Xen_list_length(larg3);
- if (len <= 0) Xen_check_type(0, larg3, 3, "XCreateBitmapFromData", "positive integer");
+ if (len == 0) Xen_check_type(0, larg3, 3, "XCreateBitmapFromData", "positive integer");
arg3 = Xen_copy_arg(larg3);
bits = (char *)calloc(len, sizeof(char));
for (i = 0; i < len; i++, arg3 = Xen_cdr(arg3))
@@ -13673,12 +13673,12 @@ static Boolean gxm_XtFilePredicate(String filename)
static SubstitutionRec *gxm_make_subs(Xen lst_1)
{
- int len;
+ unsigned int len;
SubstitutionRec *subs = NULL;
- len = Xen_list_length(lst_1);
+ len = (unsigned int)Xen_list_length(lst_1);
if (len > 0)
{
- int i;
+ unsigned int i;
Xen lst;
lst = Xen_copy_arg(lst_1);
subs = (SubstitutionRec *)calloc(len, sizeof(SubstitutionRec));
@@ -14316,11 +14316,11 @@ static Xen gxm_XtAppSetFallbackResources(Xen app, Xen specs)
#define H_XtAppSetFallbackResources "XtAppSetFallbackResources(app, list-of-strings) sets the app's default resource values \
from the list of strings"
char **fallbacks;
- int i, len;
+ unsigned int i, len;
Xen lst;
Xen_check_type(Xen_is_XtAppContext(app), app, 1, "XtAppSetFallbackResources", "XtAppContext");
Xen_check_type(Xen_is_list(specs), specs, 2, "XtAppSetFallbackResources", "list of char*");
- len = Xen_list_length(specs);
+ len = (unsigned int)Xen_list_length(specs);
lst = Xen_copy_arg(specs);
fallbacks = (char **)calloc(len + 1, sizeof(char *)); /* +1 for null termination */
for (i = 0; i < len; i++, lst = Xen_cdr(lst))
@@ -14341,7 +14341,8 @@ of the arguments is slightly different from the C Xt call. The final arg is an
XtAppContext app;
Arg *args;
Widget res;
- int i, len = 0, argc, arglen;
+ unsigned int i, len = 0;
+ int argc, arglen;
char **argv = NULL;
char **fallbacks = NULL;
Xen_check_type(Xen_is_string(arg2), arg2, 1, "XtVaAppInitialize", "char*");
@@ -14357,7 +14358,7 @@ of the arguments is slightly different from the C Xt call. The final arg is an
Xen lst;
int gcloc;
len = Xen_list_length(specs);
- if (len <= 0) return(Xen_false);
+ if (len == 0) return(Xen_false);
lst = Xen_copy_arg(specs);
gcloc = xm_protect(lst);
fallbacks = (char **)calloc(len + 1, sizeof(char *)); /* +1 for null termination */
@@ -14417,7 +14418,7 @@ and the specified args and num_args and returns the created shell. The num_args
int argc, arglen;
char **argv = NULL;
char **fallbacks = NULL;
- int i, len = 0;
+ unsigned int i, len = 0;
Xen_check_type(Xen_is_string(arg2), arg2, 1, "XtAppInitialize", "char*");
Xen_check_type(Xen_is_integer(arg5), arg5, 2, "XtAppInitialize", "int");
Xen_check_type(Xen_is_list(arg6), arg6, 3, "XtAppInitialize", "list of String*");
@@ -14432,7 +14433,7 @@ and the specified args and num_args and returns the created shell. The num_args
{
Xen lst;
int gcloc;
- len = Xen_list_length(arg9);
+ len = (unsigned int)Xen_list_length(arg9);
lst = Xen_copy_arg(arg9);
gcloc = xm_protect(lst);
fallbacks = (char **)calloc(len + 1, sizeof(char *)); /* +1 for null termination */
@@ -14478,7 +14479,7 @@ static Xen gxm_XtVaOpenApplication(Xen arg1, Xen arg4, Xen arg5, Xen arg7, Xen a
int argc, arglen;
char **argv = NULL;
char **fallbacks = NULL;
- int i, len = 0;
+ unsigned int i, len = 0;
Xen_check_type(Xen_is_string(arg1), arg1, 1, "XtVaOpenApplication", "char*");
Xen_check_type(Xen_is_integer(arg4), arg4, 2, "XtVaOpenApplication", "int"); /* was arg3 by mistake, 11-Oct-02 */
Xen_check_type(Xen_is_list(arg5), arg5, 3, "XtVaOpenApplication", "list of String");
@@ -14492,7 +14493,7 @@ static Xen gxm_XtVaOpenApplication(Xen arg1, Xen arg4, Xen arg5, Xen arg7, Xen a
{
Xen lst;
int gcloc;
- len = Xen_list_length(specs);
+ len = (unsigned int)Xen_list_length(specs);
lst = Xen_copy_arg(specs);
gcloc = xm_protect(lst);
fallbacks = (char **)calloc(len + 1, sizeof(char *)); /* +1 for null termination */
@@ -14543,7 +14544,7 @@ of fallback resources."
int argc, arglen;
char **argv;
char **fallbacks = NULL;
- int i, len = 0;
+ unsigned int i, len = 0;
Xen_check_type(Xen_is_string(arg1), arg1, 1, "XtOpenApplication", "char*");
Xen_check_type(Xen_is_integer(arg4), arg4, 2, "XtOpenApplication", "int");
Xen_check_type(Xen_is_list(arg5), arg5, 3, "XtOpenApplication", "list of String*");
@@ -14558,7 +14559,7 @@ of fallback resources."
{
Xen lst;
int gcloc;
- len = Xen_list_length(arg9);
+ len = (unsigned int)Xen_list_length(arg9);
lst = Xen_copy_arg(arg9);
gcloc = xm_protect(lst);
fallbacks = (char **)calloc(len + 1, sizeof(char *)); /* +1 for null termination */
@@ -15923,7 +15924,7 @@ static Xen gxm_XtCallActionProc(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5
same manner and order as translation tables are bound. If found, the action routine is invoked with the specified widget, event pointer, \
and parameters."
char **params = NULL;
- int i, len = 0;
+ unsigned int i, len = 0;
Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtCallActionProc", "Widget");
Xen_check_type(Xen_is_string(arg2), arg2, 2, "XtCallActionProc", "char*");
Xen_check_type(Xen_is_XEvent(arg3) || Xen_is_false(arg3), arg3, 3, "XtCallActionProc", "XEvent*");
@@ -15932,8 +15933,8 @@ and parameters."
if (Xen_is_list(arg4))
{
if (Xen_is_integer(arg5))
- len = Xen_integer_to_C_int(arg5);
- else len = Xen_list_length(arg4);
+ len = (unsigned int)Xen_integer_to_C_int(arg5);
+ else len = (unsigned int)Xen_list_length(arg4);
}
if (len > 0)
{
@@ -16096,7 +16097,7 @@ static XtActionsRec *make_action_rec(int len, Xen larg2)
Xen arg2;
arg2 = Xen_copy_arg(larg2);
gcloc = xm_protect(arg2);
- act = (XtActionsRec *)calloc(len, sizeof(XtActionsRec));
+ act = (XtActionsRec *)calloc((unsigned int)len, sizeof(XtActionsRec));
for (i = 0; i < len; i++, arg2 = Xen_cdr(arg2))
{
Xen pair;
@@ -16646,7 +16647,8 @@ static Xen gxm_XpmCreatePixmapFromData(Xen arg1, Xen arg2, Xen larg3, Xen arg6)
/* DIFF: XpmCreatePixmapFromData omits and returns pixmap args, arg3 (bits) is list of strings
*/
Pixmap p1, p2;
- int val, i, len;
+ int val;
+ unsigned int i, len;
char **bits;
Xen arg3;
Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XpmCreatePixmapFromData", "Display*");
@@ -16655,7 +16657,7 @@ static Xen gxm_XpmCreatePixmapFromData(Xen arg1, Xen arg2, Xen larg3, Xen arg6)
Xen_check_type(Xen_is_XpmAttributes(arg6) || Xen_is_false(arg6), arg6, 6, "XpmCreatePixmapFromData", "XpmAttributes*");
arg3 = Xen_copy_arg(larg3);
len = Xen_list_length(arg3);
- if (len <= 0) Xen_check_type(0, arg3, 3, "XpmCreatePixmapFromData", "positive integer");
+ if (len == 0) Xen_check_type(0, arg3, 3, "XpmCreatePixmapFromData", "positive integer");
bits = (char **)calloc(len, sizeof(char *));
for (i = 0; i < len; i++, arg3 = Xen_cdr(arg3))
bits[i] = xen_strdup(Xen_string_to_C_string(Xen_car(arg3)));
@@ -16848,15 +16850,15 @@ static Xen gxm_colorsymbols(Xen ptr)
static Xen gxm_set_colorsymbols(Xen ptr, Xen vals)
{
XpmAttributes *atr;
- int len;
+ unsigned int len;
XM_set_field_assert_type(Xen_is_XpmAttributes(ptr), ptr, 1, "colorsymbols", "XpmAttributes");
XM_set_field_assert_type(Xen_is_list(vals), vals, 2, "colorsymbols", "list of XpmColorSymbols");
atr = Xen_to_C_XpmAttributes(ptr);
- len = Xen_list_length(vals);
+ len = (unsigned int)Xen_list_length(vals);
if (len > 0)
{
Xen lst;
- int i;
+ unsigned int i;
XpmColorSymbol *cols = NULL, *cur;
cols = (XpmColorSymbol *)calloc(len, sizeof(XpmColorSymbol));
for (lst = Xen_copy_arg(vals), i = 0; i < len; i++, lst = Xen_cdr(lst))
diff --git a/zip.scm b/zip.scm
index b7be3ee..4e06e75 100644
--- a/zip.scm
+++ b/zip.scm
@@ -74,20 +74,22 @@ an envelope (normally a ramp from 0 to 1) which sets where we are in the zipping
(fill! frame0 0.0)
(do ((samp2 (* 1.0 (/ frame-samples chunk-len))) ; this was floor (and also below)?
(k 0 (+ k 1))
- (start-ctr 0.0 (+ start-ctr samp2)))
+ (start-ctr 0.0))
((= k chunk-len))
(let ((ictr (floor start-ctr)))
(let ((y0 (float-vector-ref frame2 ictr))
(y1 (float-vector-ref frame2 (+ ictr 1))))
- (float-vector-set! frame0 k (+ y0 (* (- y1 y0) (- start-ctr ictr)))))))
+ (float-vector-set! frame0 k (+ y0 (* (- y1 y0) (- start-ctr ictr))))))
+ (set! start-ctr (+ start-ctr samp2)))
(do ((samp1 (* 1.0 (/ frame-samples (- frame-samples chunk-len))))
(k chunk-len (+ k 1))
- (start-ctr 0.0 (+ start-ctr samp1)))
+ (start-ctr 0.0))
((= k frame-samples))
(let ((ictr (floor start-ctr)))
(let ((y0 (float-vector-ref frame1 ictr))
(y1 (float-vector-ref frame1 (+ ictr 1))))
- (float-vector-set! frame0 k (+ y0 (* (- y1 y0) (- start-ctr ictr))))))))
+ (float-vector-set! frame0 k (+ y0 (* (- y1 y0) (- start-ctr ictr))))))
+ (set! start-ctr (+ start-ctr samp1))))
(let ((result (float-vector-ref frame0 frame-loc)))
(set! frame-loc (+ frame-loc 1))
result)))))))))
--
snd packaging
More information about the pkg-multimedia-commits
mailing list